source: git/kernel/kutil.cc @ c5f67b5

spielwiese
Last change on this file since c5f67b5 was c5f67b5, checked in by Hans Schönemann <hannes@…>, 18 years ago
*hannes: HAVE_RING2TOM git-svn-id: file:///usr/local/Singular/svn/trunk@8947 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 114.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kutil.cc,v 1.18 2006-02-15 14:08:17 Singular Exp $ */
5/*
6* ABSTRACT: kernel: utils for kStd
7*/
8
9#ifndef KUTIL_CC
10#define KUTIL_CC
11
12// #define PDEBUG 2
13// #define PDIV_DEBUG
14#include <stdlib.h>
15#include <string.h>
16#include "mod2.h"
17#include <mylimits.h>
18#include "structs.h"
19#ifdef HAVE_PLURAL
20#include "gring.h"
21#endif
22#ifdef KDEBUG
23#undef KDEBUG
24#define KDEBUG 2
25#endif
26
27// define if enterL, enterT should use memmove instead of doing it manually
28// on topgun, this is slightly faster (see monodromy_l.tst, homog_gonnet.sing)
29#ifndef SunOS_4
30#define ENTER_USE_MEMMOVE
31#endif
32
33// define, if the my_memmove inlines should be used instead of
34// system memmove -- it does not seem to pay off, though
35// #define ENTER_USE_MYMEMMOVE
36
37#include "kutil.h"
38#include "febase.h"
39#include "omalloc.h"
40#include "numbers.h"
41#include "polys.h"
42#include "ring.h"
43#include "ideals.h"
44#include "timer.h"
45//#include "cntrlc.h"
46#include "stairc.h"
47#include "kstd1.h"
48#include "pShallowCopyDelete.h"
49
50#ifdef KDEBUG
51#undef KDEBUG
52#define KDEBUG 2
53#endif
54
55#ifdef ENTER_USE_MYMEMMOVE
56inline void _my_memmove_d_gt_s(unsigned long* d, unsigned long* s, long l)
57{
58  register unsigned long* _dl = (unsigned long*) d;
59  register unsigned long* _sl = (unsigned long*) s;
60  register long _i = l - 1;
61
62  do
63  {
64    _dl[_i] = _sl[_i];
65    _i--;
66  }
67  while (_i >= 0);
68}
69
70inline void _my_memmove_d_lt_s(unsigned long* d, unsigned long* s, long l)
71{
72  register long _ll = l;
73  register unsigned long* _dl = (unsigned long*) d;
74  register unsigned long* _sl = (unsigned long*) s;
75  register long _i = 0;
76
77  do
78  {
79    _dl[_i] = _sl[_i];
80    _i++;
81  }
82  while (_i < _ll);
83}
84
85inline void _my_memmove(void* d, void* s, long l)
86{
87  unsigned long _d = (unsigned long) d;
88  unsigned long _s = (unsigned long) s;
89  unsigned long _l = ((l) + SIZEOF_LONG - 1) >> LOG_SIZEOF_LONG;
90
91  if (_d > _s) _my_memmove_d_gt_s(_d, _s, _l);
92  else _my_memmove_d_lt_s(_d, _s, _l);
93}
94
95#undef memmove
96#define memmove(d,s,l) _my_memmove(d, s, l)
97#endif
98
99
100static poly redMora (poly h,int maxIndex,kStrategy strat);
101static poly redBba (poly h,int maxIndex,kStrategy strat);
102
103static inline int pDivComp(poly p, poly q)
104{
105  if (pGetComp(p) == pGetComp(q))
106  {
107    BOOLEAN a=FALSE, b=FALSE;
108    int i;
109    unsigned long la, lb;
110    unsigned long divmask = currRing->divmask;
111    for (i=0; i<currRing->VarL_Size; i++)
112    {
113      la = p->exp[currRing->VarL_Offset[i]];
114      lb = q->exp[currRing->VarL_Offset[i]];
115      if (la != lb)
116      {
117        if (la < lb)
118        {
119          if (b) return 0;
120          if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
121            return 0;
122          a = TRUE;
123        }
124        else
125        {
126          if (a) return 0;
127          if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
128            return 0;
129          b = TRUE;
130        }
131      }
132    }
133    if (a) return 1;
134    if (b) return -1;
135  }
136  return 0;
137}
138
139
140BITSET  test=(BITSET)0;
141int     HCord;
142int     Kstd1_deg;
143int     mu=32000;
144
145/*2
146*deletes higher monomial of p, re-compute ecart and length
147*works only for orderings with ecart =pFDeg(end)-pFDeg(start)
148*/
149void deleteHC(LObject *L, kStrategy strat, BOOLEAN fromNext)
150{
151  if (strat->kHEdgeFound)
152  {
153    kTest_L(L);
154    poly p1;
155    poly p = L->GetLmTailRing();
156    int l = 1;
157    kBucket_pt bucket = NULL;
158    if (L->bucket != NULL)
159    {
160      kBucketClear(L->bucket, &pNext(p), &L->pLength);
161      L->pLength++;
162      bucket = L->bucket;
163      L->bucket = NULL;
164      L->last = NULL;
165    }
166
167    if (!fromNext && p_Cmp(p,strat->kNoetherTail(), L->tailRing) == -1)
168    {
169      L->Delete();
170      L->Clear();
171      L->ecart = -1;
172      if (bucket != NULL) kBucketDestroy(&bucket);
173      return;
174    }
175    p1 = p;
176    while (pNext(p1)!=NULL)
177    {
178      if (p_LmCmp(pNext(p1), strat->kNoetherTail(), L->tailRing) == -1)
179      {
180        L->last = p1;
181        p_Delete(&pNext(p1), L->tailRing);
182        if (p1 == p)
183        {
184          if (L->t_p != NULL)
185          {
186            assume(L->p != NULL && p == L->t_p);
187            pNext(L->p) = NULL;
188          }
189          L->max  = NULL;
190        }
191        else if (fromNext)
192          L->max  = p_GetMaxExpP(pNext(L->p), L->tailRing ); // p1;
193        if (L->pLength != 0) L->pLength = l;
194        // Hmmm when called from updateT, then only
195        // reset ecart when cut
196        if (fromNext)
197          L->ecart = L->pLDeg() - L->GetpFDeg();
198        break;
199      }
200      l++;
201      pIter(p1);
202    }
203    if (! fromNext)
204    {
205      L->SetpFDeg();
206      L->ecart = L->pLDeg(strat->LDegLast) - L->GetpFDeg();
207    }
208    if (bucket != NULL)
209    {
210      if (L->pLength > 1)
211      {
212        kBucketInit(bucket, pNext(p), L->pLength - 1);
213        pNext(p) = NULL;
214        if (L->t_p != NULL) pNext(L->t_p) = NULL;
215        L->pLength = 0;
216        L->bucket = bucket;
217        L->last = NULL;
218      }
219      else
220        kBucketDestroy(&bucket);
221    }
222    kTest_L(L);
223  }
224}
225
226void deleteHC(poly* p, int* e, int* l,kStrategy strat)
227{
228  LObject L(*p, currRing, strat->tailRing);
229
230  deleteHC(&L, strat);
231  *p = L.p;
232  *e = L.ecart;
233  *l = L.length;
234  if (L.t_p != NULL) p_LmFree(L.t_p, strat->tailRing);
235}
236
237/*2
238*tests if p.p=monomial*unit and cancels the unit
239*/
240void cancelunit (LObject* L)
241{
242  int  i;
243  poly h;
244
245  if(currRing->OrdSgn != -1) return;
246  if(TEST_OPT_CANCELUNIT) return;
247
248  ring r = L->tailRing;
249  poly p = L->GetLmTailRing();
250
251  if(p_GetComp(p, r) != 0 && !p_OneComp(p, r)) return;
252
253  if (L->ecart != 0)
254  {
255//    for(i=r->N;i>0;i--)
256//    {
257//      if ((p_GetExp(p,i,r)>0) && (rIsPolyVar(i, r)==TRUE)) return;
258//    }
259    h = pNext(p);
260    loop
261    {
262      if (h==NULL)
263      {
264        p_Delete(&pNext(p), r);
265        number eins=nInit(1);
266        if (L->p != NULL)  pSetCoeff(L->p,eins);
267        else if (L->t_p != NULL) nDelete(&pGetCoeff(L->t_p));
268        if (L->t_p != NULL) pSetCoeff0(L->t_p,eins);
269        L->ecart = 0;
270        L->length = 1;
271        if (L->pLength > 0) L->pLength = 1;
272        if (L->last != NULL) L->last = p;
273
274        if (L->t_p != NULL && pNext(L->t_p) != NULL)
275          pNext(L->t_p) = NULL;
276        if (L->p != NULL && pNext(L->p) != NULL)
277          pNext(L->p) = NULL;
278        return;
279      }
280      i = 0;
281      loop
282      {
283        i++;
284        if (p_GetExp(p,i,r) > p_GetExp(h,i,r)) return ; // does not divide
285        if (i == r->N) break; // does divide, try next monom
286      }
287      pIter(h);
288    }
289  }
290}
291
292/*2
293*pp is the new element in s
294*returns TRUE (in strat->kHEdgeFound) if
295*-HEcke is allowed
296*-we are in the last componente of the vector
297*-on all axis are monomials (all elements in NotUsedAxis are FALSE)
298*returns FALSE for pLexOrderings,
299*assumes in module case an ordering of type c* !!
300* HEckeTest is only called with strat->kHEdgeFound==FALSE !
301*/
302void HEckeTest (poly pp,kStrategy strat)
303{
304  int   j,k,p;
305
306  strat->kHEdgeFound=FALSE;
307  if (pLexOrder || currRing->MixedOrder)
308  {
309    return;
310  }
311  if (strat->ak > 1)           /*we are in the module case*/
312  {
313    return; // until ....
314    //if (!pVectorOut)     /*pVectorOut <=> order = c,* */
315    //  return FALSE;
316    //if (pGetComp(pp) < strat->ak) /* ak is the number of the last component */
317    //  return FALSE;
318  }
319  k = 0;
320  p=pIsPurePower(pp);
321  if (p!=0) strat->NotUsedAxis[p] = FALSE;
322  /*- the leading term of pp is a power of the p-th variable -*/
323  for (j=pVariables;j>0; j--)
324  {
325    if (strat->NotUsedAxis[j])
326    {
327      return;
328    }
329  }
330  strat->kHEdgeFound=TRUE;
331}
332
333/*2
334*utilities for TSet, LSet
335*/
336inline static intset initec (const int maxnr)
337{
338  return (intset)omAlloc(maxnr*sizeof(int));
339}
340
341inline static unsigned long* initsevS (const int maxnr)
342{
343  return (unsigned long*)omAlloc0(maxnr*sizeof(unsigned long));
344}
345inline static int* initS_2_R (const int maxnr)
346{
347  return (int*)omAlloc0(maxnr*sizeof(int));
348}
349
350static inline void enlargeT (TSet &T, TObject** &R, unsigned long* &sevT,
351                             int &length, const int incr)
352{
353  assume(T!=NULL);
354  assume(sevT!=NULL);
355  assume(R!=NULL);
356  assume((length+incr) > 0);
357
358  int i;
359  T = (TSet)omRealloc0Size(T, length*sizeof(TObject),
360                           (length+incr)*sizeof(TObject));
361
362  sevT = (unsigned long*) omReallocSize(sevT, length*sizeof(long*),
363                           (length+incr)*sizeof(long*));
364
365  R = (TObject**)omRealloc0Size(R,length*sizeof(TObject*),
366                                (length+incr)*sizeof(TObject*));
367  for (i=length-1;i>=0;i--) R[T[i].i_r] = &(T[i]);
368  length += incr;
369}
370
371void cleanT (kStrategy strat)
372{
373  int i,j;
374  poly  p;
375  assume(currRing == strat->tailRing || strat->tailRing != NULL);
376
377  pShallowCopyDeleteProc p_shallow_copy_delete =
378    (strat->tailRing != currRing ?
379     pGetShallowCopyDeleteProc(strat->tailRing, currRing) :
380     NULL);
381
382  for (j=0; j<=strat->tl; j++)
383  {
384    p = strat->T[j].p;
385    strat->T[j].p=NULL;
386    if (strat->T[j].max != NULL)
387      p_LmFree(strat->T[j].max, strat->tailRing);
388    i = -1;
389    loop
390    {
391      i++;
392      if (i>strat->sl)
393      {
394        if (strat->T[j].t_p != NULL)
395        {
396          p_Delete(&(strat->T[j].t_p), strat->tailRing);
397          p_LmFree(p, currRing);
398        }
399        else
400          pDelete(&p);
401        break;
402      }
403      if (p == strat->S[i])
404      {
405        if (strat->T[j].t_p != NULL)
406        {
407          assume(p_shallow_copy_delete != NULL);
408          pNext(p) = p_shallow_copy_delete(pNext(p),strat->tailRing,currRing,
409                                           currRing->PolyBin);
410          p_LmFree(strat->T[j].t_p, strat->tailRing);
411        }
412        break;
413      }
414    }
415  }
416  strat->tl=-1;
417}
418
419LSet initL ()
420{
421  int i;
422  LSet l = (LSet)omAlloc(setmaxL*sizeof(LObject));
423  for (i=setmaxL-1;i>=0;i--)
424  {
425    l[i].tailRing = currRing;
426    l[i].i_r1 = -1;
427    l[i].i_r2 = -1;
428    l[i].i_r = -1;
429  }
430  return l;
431}
432
433static inline void enlargeL (LSet* L,int* length,const int incr)
434{
435  assume((*L)!=NULL);
436  assume((length+incr)>0);
437
438  *L = (LSet)omReallocSize((*L),(*length)*sizeof(LObject),
439                                   ((*length)+incr)*sizeof(LObject));
440  (*length) += incr;
441}
442
443void initPairtest(kStrategy strat)
444{
445  strat->pairtest = (BOOLEAN *)omAlloc0((strat->sl+2)*sizeof(BOOLEAN));
446}
447
448/*2
449*test whether (p1,p2) or (p2,p1) is in L up position length
450*it returns TRUE if yes and the position k
451*/
452BOOLEAN isInPairsetL(int length,poly p1,poly p2,int*  k,kStrategy strat)
453{
454  LObject *p=&(strat->L[length]);
455
456  *k = length;
457  loop
458  {
459    if ((*k) < 0) return FALSE;
460    if (((p1 == (*p).p1) && (p2 == (*p).p2))
461    ||  ((p1 == (*p).p2) && (p2 == (*p).p1)))
462      return TRUE;
463    (*k)--;
464    p--;
465  }
466}
467
468/*2
469*in B all pairs have the same element p on the right
470*it tests whether (q,p) is in B and returns TRUE if yes
471*and the position k
472*/
473BOOLEAN isInPairsetB(poly q,int*  k,kStrategy strat)
474{
475  LObject *p=&(strat->B[strat->Bl]);
476
477  *k = strat->Bl;
478  loop
479  {
480    if ((*k) < 0) return FALSE;
481    if (q == (*p).p1)
482      return TRUE;
483    (*k)--;
484    p--;
485  }
486}
487
488int kFindInT(poly p, TSet T, int tlength)
489{
490  int i;
491
492  for (i=0; i<=tlength; i++)
493  {
494    if (T[i].p == p) return i;
495  }
496  return -1;
497}
498
499int kFindInT(poly p, kStrategy strat)
500{
501  int i;
502  do
503  {
504    i = kFindInT(p, strat->T, strat->tl);
505    if (i >= 0) return i;
506    strat = strat->next;
507  }
508  while (strat != NULL);
509  return -1;
510}
511
512#ifdef KDEBUG
513
514void sTObject::wrp()
515{
516  if (t_p != NULL) p_wrp(t_p, tailRing);
517  else if (p != NULL) p_wrp(p, currRing, tailRing);
518  else ::wrp(NULL);
519}
520
521#define kFalseReturn(x) do { if (!x) return FALSE;} while (0)
522
523// check that Lm's of a poly from T are "equal"
524static const char* kTest_LmEqual(poly p, poly t_p, ring tailRing)
525{
526  int i;
527  for (i=1; i<=tailRing->N; i++)
528  {
529    if (p_GetExp(p, i, currRing) != p_GetExp(t_p, i, tailRing))
530      return "Lm[i] different";
531  }
532  if (p_GetComp(p, currRing) != p_GetComp(t_p, tailRing))
533    return "Lm[0] different";
534  if (pNext(p) != pNext(t_p))
535    return "Lm.next different";
536  if (pGetCoeff(p) != pGetCoeff(t_p))
537    return "Lm.coeff different";
538  return NULL;
539}
540
541static BOOLEAN sloppy_max = FALSE;
542BOOLEAN kTest_T(TObject * T, ring strat_tailRing, int i, char TN)
543{
544  ring tailRing = T->tailRing;
545  if (strat_tailRing == NULL) strat_tailRing = tailRing;
546  r_assume(strat_tailRing == tailRing);
547
548  poly p = T->p;
549  ring r = currRing;
550
551  if (T->p == NULL && T->t_p == NULL && i >= 0)
552    return dReportError("%c[%d].poly is NULL", TN, i);
553
554  if (T->tailRing != currRing)
555  {
556    if (T->t_p == NULL && i > 0)
557      return dReportError("%c[%d].t_p is NULL", TN, i);
558    pFalseReturn(p_Test(T->t_p, T->tailRing));
559    if (T->p != NULL) pFalseReturn(p_LmTest(T->p, currRing));
560    if (T->p != NULL && T->t_p != NULL)
561    {
562      const char* msg = kTest_LmEqual(T->p, T->t_p, T->tailRing);
563      if (msg != NULL)
564        return dReportError("%c[%d] %s", TN, i, msg);
565      r = T->tailRing;
566      p = T->t_p;
567    }
568    if (T->p == NULL)
569    {
570      p = T->t_p;
571      r = T->tailRing;
572    }
573    if (T->t_p != NULL && i >= 0 && TN == 'T')
574    {
575      if (pNext(T->t_p) == NULL)
576      {
577        if (T->max != NULL)
578          return dReportError("%c[%d].max is not NULL as it should be", TN, i);
579      }
580      else
581      {
582        if (T->max == NULL)
583          return dReportError("%c[%d].max is NULL", TN, i);
584        if (pNext(T->max) != NULL)
585          return dReportError("pNext(%c[%d].max) != NULL", TN, i);
586
587        pFalseReturn(p_CheckPolyRing(T->max, tailRing));
588        omCheckBinAddrSize(T->max, (tailRing->PolyBin->sizeW)*SIZEOF_LONG);
589#if KDEBUG > 0
590        if (! sloppy_max)
591        {
592          poly test_max = p_GetMaxExpP(pNext(T->t_p), tailRing);
593          p_Setm(T->max, tailRing);
594          p_Setm(test_max, tailRing);
595          BOOLEAN equal = p_ExpVectorEqual(T->max, test_max, tailRing);
596          if (! equal)
597            return dReportError("%c[%d].max out of sync", TN, i);
598          p_LmFree(test_max, tailRing);
599        }
600#endif
601      }
602    }
603  }
604  else
605  {
606    if (T->max != NULL)
607      return dReportError("%c[%d].max != NULL but tailRing == currRing",TN,i);
608    if (T->t_p != NULL)
609      return dReportError("%c[%d].t_p != NULL but tailRing == currRing",TN,i);
610    if (T->p == NULL && i > 0)
611      return dReportError("%c[%d].p is NULL", TN, i);
612    pFalseReturn(p_Test(T->p, currRing));
613  }
614
615  if (i >= 0 && T->pLength != 0 && T->pLength != pLength(p))
616  {
617    return dReportError("%c[%d] pLength error: has %d, specified to have %d",
618                        TN, i , pLength(p), T->pLength);
619  }
620
621  // check FDeg,  for elements in L and T
622  if (i >= 0 && (TN == 'T' || TN == 'L'))
623  {
624    // FDeg has ir element from T of L set
625    if (T->FDeg  != T->pFDeg())
626      return dReportError("%c[%d] FDeg error: has %d, specified to have %d",
627                          TN, i , T->pFDeg(), T->FDeg);
628  }
629
630  // check is_normalized for elements in T
631  if (i >= 0 && TN == 'T')
632  {
633    if (T->is_normalized && ! nIsOne(pGetCoeff(p)))
634      return dReportError("T[%d] is_normalized error", i);
635
636  }
637  return TRUE;
638}
639
640BOOLEAN kTest_L(LObject *L, ring strat_tailRing,
641                BOOLEAN testp, int lpos, TSet T, int tlength)
642{
643  if (testp)
644  {
645    poly pn = NULL;
646    if (L->bucket != NULL)
647    {
648      kFalseReturn(kbTest(L->bucket));
649      r_assume(L->bucket->bucket_ring == L->tailRing);
650      if (L->p != NULL && pNext(L->p) != NULL)
651      {
652        pn = pNext(L->p);
653        pNext(L->p) = NULL;
654      }
655    }
656    kFalseReturn(kTest_T(L, strat_tailRing, lpos, 'L'));
657    if (pn != NULL)
658      pNext(L->p) = pn;
659
660    ring r;
661    poly p;
662    L->GetLm(p, r);
663    if (L->sev != 0 && p_GetShortExpVector(p, r) != L->sev)
664    {
665      return dReportError("L[%d] wrong sev: has %o, specified to have %o",
666                          lpos, p_GetShortExpVector(p, r), L->sev);
667    }
668    if (lpos > 0 && L->last != NULL && pLast(p) != L->last)
669    {
670      return dReportError("L[%d] last wrong: has %p specified to have %p",
671                          lpos, pLast(p), L->last);
672    }
673  }
674  if (L->p1 == NULL)
675  {
676    // L->p2 either NULL or "normal" poly
677    pFalseReturn(pp_Test(L->p2, currRing, L->tailRing));
678  }
679  else if (tlength > 0 && T != NULL && (lpos >=0))
680  {
681    // now p1 and p2 must be != NULL and must be contained in T
682    int i;
683    i = kFindInT(L->p1, T, tlength);
684    if (i < 0)
685      return dReportError("L[%d].p1 not in T",lpos);
686    i = kFindInT(L->p2, T, tlength);
687    if (i < 0)
688      return dReportError("L[%d].p2 not in T",lpos);
689  }
690  return TRUE;
691}
692
693BOOLEAN kTest (kStrategy strat)
694{
695  int i;
696
697  // test P
698  kFalseReturn(kTest_L(&(strat->P), strat->tailRing,
699                       (strat->P.p != NULL && pNext(strat->P.p)!=strat->tail),
700                       -1, strat->T, strat->tl));
701
702  // test T
703  if (strat->T != NULL)
704  {
705    for (i=0; i<=strat->tl; i++)
706    {
707      kFalseReturn(kTest_T(&(strat->T[i]), strat->tailRing, i, 'T'));
708      if (strat->sevT[i] != pGetShortExpVector(strat->T[i].p))
709        return dReportError("strat->sevT[%d] out of sync", i);
710    }
711  }
712
713  // test L
714  if (strat->L != NULL)
715  {
716    for (i=0; i<=strat->Ll; i++)
717    {
718      kFalseReturn(kTest_L(&(strat->L[i]), strat->tailRing,
719                           strat->L[i].Next() != strat->tail, i,
720                           strat->T, strat->tl));
721      if (strat->use_buckets && strat->L[i].Next() != strat->tail &&
722          strat->L[i].Next() != NULL && strat->L[i].p1 != NULL)
723      {
724        assume(strat->L[i].bucket != NULL);
725      }
726    }
727  }
728
729  // test S
730  if (strat->S != NULL)
731    kFalseReturn(kTest_S(strat));
732
733  return TRUE;
734}
735
736BOOLEAN kTest_S(kStrategy strat)
737{
738  int i;
739  BOOLEAN ret = TRUE;
740  for (i=0; i<=strat->sl; i++)
741  {
742    if (strat->S[i] != NULL &&
743        strat->sevS[i] != pGetShortExpVector(strat->S[i]))
744    {
745      return dReportError("S[%d] wrong sev: has %o, specified to have %o",
746                          i , pGetShortExpVector(strat->S[i]), strat->sevS[i]);
747    }
748  }
749  return ret;
750}
751
752
753
754BOOLEAN kTest_TS(kStrategy strat)
755{
756  int i, j;
757  BOOLEAN ret = TRUE;
758  kFalseReturn(kTest(strat));
759
760  // test strat->R, strat->T[i].i_r
761  for (i=0; i<=strat->tl; i++)
762  {
763    if (strat->T[i].i_r < 0 || strat->T[i].i_r > strat->tl)
764      return dReportError("strat->T[%d].i_r == %d out of bounds", i,
765                          strat->T[i].i_r);
766    if (strat->R[strat->T[i].i_r] != &(strat->T[i]))
767      return dReportError("T[%d].i_r with R out of sync", i);
768  }
769  // test containment of S inT
770  if (strat->S != NULL)
771  {
772    for (i=0; i<=strat->sl; i++)
773    {
774      j = kFindInT(strat->S[i], strat->T, strat->tl);
775      if (j < 0)
776        return dReportError("S[%d] not in T", i);
777      if (strat->S_2_R[i] != strat->T[j].i_r)
778        return dReportError("S_2_R[%d]=%d != T[%d].i_r=%d\n",
779                            i, strat->S_2_R[i], j, strat->T[j].i_r);
780    }
781  }
782  // test strat->L[i].i_r1
783  for (i=0; i<=strat->Ll; i++)
784  {
785    if (strat->L[i].p1 != NULL && strat->L[i].p2)
786    {
787      if (strat->L[i].i_r1 < 0 ||
788          strat->L[i].i_r1 > strat->tl ||
789          strat->L[i].T_1(strat)->p != strat->L[i].p1)
790        return dReportError("L[%d].i_r1 out of sync", i);
791      if (strat->L[i].i_r2 < 0 ||
792          strat->L[i].i_r2 > strat->tl ||
793          strat->L[i].T_2(strat)->p != strat->L[i].p2);
794    }
795    else
796    {
797      if (strat->L[i].i_r1 != -1)
798        return dReportError("L[%d].i_r1 out of sync", i);
799      if (strat->L[i].i_r2 != -1)
800        return dReportError("L[%d].i_r2 out of sync", i);
801    }
802    if (strat->L[i].i_r != -1)
803      return dReportError("L[%d].i_r out of sync", i);
804  }
805  return TRUE;
806}
807
808#endif // KDEBUG
809
810/*2
811*cancels the i-th polynomial in the standardbase s
812*/
813void deleteInS (int i,kStrategy strat)
814{
815#ifdef ENTER_USE_MEMMOVE
816  memmove(&(strat->S[i]), &(strat->S[i+1]), (strat->sl - i)*sizeof(poly));
817  memmove(&(strat->ecartS[i]),&(strat->ecartS[i+1]),(strat->sl - i)*sizeof(int));
818  memmove(&(strat->sevS[i]),&(strat->sevS[i+1]),(strat->sl - i)*sizeof(long));
819  memmove(&(strat->S_2_R[i]),&(strat->S_2_R[i+1]),(strat->sl - i)*sizeof(int));
820#else
821  int j;
822  for (j=i; j<strat->sl; j++)
823  {
824    strat->S[j] = strat->S[j+1];
825    strat->ecartS[j] = strat->ecartS[j+1];
826    strat->sevS[j] = strat->sevS[j+1];
827    strat->S_2_R[j] = strat->S_2_R[j+1];
828  }
829#endif
830  if (strat->lenS!=NULL)
831  {
832#ifdef ENTER_USE_MEMMOVE
833    memmove(&(strat->lenS[i]),&(strat->lenS[i+1]),(strat->sl - i)*sizeof(int));
834#else
835    for (j=i; j<strat->sl; j++) strat->lenS[j] = strat->lenS[j+1];
836#endif
837  }
838  if (strat->lenSw!=NULL)
839  {
840#ifdef ENTER_USE_MEMMOVE
841    memmove(&(strat->lenSw[i]),&(strat->lenSw[i+1]),(strat->sl - i)*sizeof(wlen_type));
842#else
843    for (j=i; j<strat->sl; j++) strat->lenSw[j] = strat->lenSw[j+1];
844#endif
845  }
846  if (strat->fromQ!=NULL)
847  {
848#ifdef ENTER_USE_MEMMOVE
849    memmove(&(strat->fromQ[i]),&(strat->fromQ[i+1]),(strat->sl - i)*sizeof(int));
850#else
851    for (j=i; j<strat->sl; j++)
852    {
853      strat->fromQ[j] = strat->fromQ[j+1];
854    }
855#endif
856  }
857  strat->S[strat->sl] = NULL;
858  strat->sl--;
859}
860
861/*2
862*cancels the j-th polynomial in the set
863*/
864void deleteInL (LSet set, int *length, int j,kStrategy strat)
865{
866  if (set[j].lcm!=NULL)
867    pLmFree(set[j].lcm);
868  if (set[j].p!=NULL)
869  {
870    if (pNext(set[j].p) == strat->tail)
871    {
872      pLmFree(set[j].p);
873      /*- tail belongs to several int spolys -*/
874    }
875    else
876    {
877      // search p in T, if it is there, do not delete it
878      if (pOrdSgn != -1 || kFindInT(set[j].p, strat) < 0)
879      {
880        // assure that for global ordereings kFindInT fails
881        assume(pOrdSgn == -1 || kFindInT(set[j].p, strat) < 0);
882        set[j].Delete();
883      }
884    }
885  }
886  if (*length > 0 && j < *length)
887  {
888#ifdef ENTER_USE_MEMMOVE
889    memmove(&(set[j]), &(set[j+1]), (*length - j)*sizeof(LObject));
890#else
891    int i;
892    for (i=j; i < (*length); i++)
893      set[i] = set[i+1];
894#endif
895  }
896#ifdef KDEBUG
897  memset(&(set[*length]),0,sizeof(LObject));
898#endif
899  (*length)--;
900}
901
902/*2
903*is used after updating the pairset,if the leading term of p
904*divides the leading term of some S[i] it will be canceled
905*/
906static inline void clearS (poly p, unsigned long p_sev, int* at, int* k,
907                    kStrategy strat)
908{
909  assume(p_sev == pGetShortExpVector(p));
910  if (!pLmShortDivisibleBy(p,p_sev, strat->S[*at], ~ strat->sevS[*at])) return;
911  deleteInS((*at),strat);
912  (*at)--;
913  (*k)--;
914}
915
916/*2
917*enters p at position at in L
918*/
919#ifdef PDEBUG
920/* int zaehler=0; */
921/* for counting number of pairs in Plural */
922#endif /*PDEBUG*/
923
924void enterL (LSet *set,int *length, int *LSetmax, LObject p,int at)
925{
926#ifdef PDEBUG
927  /*  zaehler++; */
928#endif /*PDEBUG*/
929  int i;
930  // this should be corrected
931  assume(p.FDeg == p.pFDeg());
932
933  if ((*length)>=0)
934  {
935    if ((*length) == (*LSetmax)-1) enlargeL(set,LSetmax,setmaxLinc);
936    if (at <= (*length))
937#ifdef ENTER_USE_MEMMOVE
938      memmove(&((*set)[at+1]), &((*set)[at]), ((*length)-at+1)*sizeof(LObject));
939#else
940    for (i=(*length)+1; i>=at+1; i--) (*set)[i] = (*set)[i-1];
941#endif
942  }
943  else at = 0;
944  (*set)[at] = p;
945  (*length)++;
946}
947
948/*2
949* computes the normal ecart;
950* used in mora case and if pLexOrder & sugar in bba case
951*/
952void initEcartNormal (LObject* h)
953{
954  h->FDeg = h->pFDeg();
955  h->ecart = h->pLDeg() - h->FDeg;
956}
957
958void initEcartBBA (LObject* h)
959{
960  h->FDeg = h->pFDeg();
961  (*h).ecart = 0;
962  (*h).length = 0;
963}
964
965void initEcartPairBba (LObject* Lp,poly f,poly g,int ecartF,int ecartG)
966{
967  Lp->FDeg = Lp->pFDeg();
968  (*Lp).ecart = 0;
969  (*Lp).length = 0;
970}
971
972void initEcartPairMora (LObject* Lp,poly f,poly g,int ecartF,int ecartG)
973{
974  Lp->FDeg = Lp->pFDeg();
975  (*Lp).ecart = si_max(ecartF,ecartG);
976  (*Lp).ecart = (*Lp).ecart- (Lp->FDeg -pFDeg((*Lp).lcm,currRing));
977  (*Lp).length = 0;
978}
979
980/*2
981*if ecart1<=ecart2 it returns TRUE
982*/
983BOOLEAN sugarDivisibleBy(int ecart1, int ecart2)
984{
985  return (ecart1 <= ecart2);
986}
987
988/*2
989* put the pair (s[i],p)  into the set B, ecart=ecart(p)
990*/
991
992void enterOnePair (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
993{
994  assume(i<=strat->sl);
995  int      l,j,compare;
996  LObject  Lp;
997
998  if (strat->interred_flag) return;
999#ifdef KDEBUG
1000  Lp.ecart=0; Lp.length=0;
1001#endif
1002  /*- computes the lcm(s[i],p) -*/
1003  Lp.lcm = pInit();
1004
1005  pLcm(p,strat->S[i],Lp.lcm);
1006  pSetm(Lp.lcm);
1007#ifdef HAVE_RING2TOM_DEACT
1008  if (strat->sugarCrit && currRing->cring == 0)
1009#else
1010  if (strat->sugarCrit)
1011#endif
1012  {
1013    if(
1014    (!((strat->ecartS[i]>0)&&(ecart>0)))
1015    && pHasNotCF(p,strat->S[i]))
1016    {
1017    /*
1018    *the product criterion has applied for (s,p),
1019    *i.e. lcm(s,p)=product of the leading terms of s and p.
1020    *Suppose (s,r) is in L and the leading term
1021    *of p divides lcm(s,r)
1022    *(==> the leading term of p divides the leading term of r)
1023    *but the leading term of s does not divide the leading term of r
1024    *(notice that tis condition is automatically satisfied if r is still
1025    *in S), then (s,r) can be cancelled.
1026    *This should be done here because the
1027    *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
1028    *
1029    *Moreover, skipping (s,r) holds also for the noncommutative case.
1030    */
1031      strat->cp++;
1032      pLmFree(Lp.lcm);
1033      Lp.lcm=NULL;
1034      return;
1035    }
1036    else
1037      Lp.ecart = si_max(ecart,strat->ecartS[i]);
1038    if (strat->fromT && (strat->ecartS[i]>ecart))
1039    {
1040      pLmFree(Lp.lcm);
1041      Lp.lcm=NULL;
1042      return;
1043      /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
1044    }
1045    /*
1046    *the set B collects the pairs of type (S[j],p)
1047    *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
1048    *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1049    *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1050    */
1051    {
1052      j = strat->Bl;
1053      loop
1054      {
1055        if (j < 0)  break;
1056        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
1057        if ((compare==1)
1058        &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
1059        {
1060          strat->c3++;
1061          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1062          {
1063            pLmFree(Lp.lcm);
1064            return;
1065          }
1066          break;
1067        }
1068        else
1069        if ((compare ==-1)
1070        && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
1071        {
1072          deleteInL(strat->B,&strat->Bl,j,strat);
1073          strat->c3++;
1074        }
1075        j--;
1076      }
1077    }
1078  }
1079  else /*sugarcrit*/
1080  {
1081#ifdef HAVE_RING2TOM_DEACT
1082    if (currRing->cring == 0) {
1083#endif
1084#ifdef HAVE_PLURAL
1085    if (!rIsPluralRing(currRing))
1086    {
1087      // if currRing->nc_type!=quasi (or skew)
1088#endif
1089      if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
1090      pHasNotCF(p,strat->S[i]))
1091      {
1092      /*
1093      *the product criterion has applied for (s,p),
1094      *i.e. lcm(s,p)=product of the leading terms of s and p.
1095      *Suppose (s,r) is in L and the leading term
1096      *of p devides lcm(s,r)
1097      *(==> the leading term of p devides the leading term of r)
1098      *but the leading term of s does not devide the leading term of r
1099      *(notice that tis condition is automatically satisfied if r is still
1100      *in S), then (s,r) can be canceled.
1101      *This should be done here because the
1102      *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
1103      */
1104          strat->cp++;
1105          pLmFree(Lp.lcm);
1106          Lp.lcm=NULL;
1107          return;
1108      }
1109      if (strat->fromT && (strat->ecartS[i]>ecart))
1110      {
1111        pLmFree(Lp.lcm);
1112        Lp.lcm=NULL;
1113        return;
1114        /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
1115      }
1116      /*
1117      *the set B collects the pairs of type (S[j],p)
1118      *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
1119      *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1120      *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1121      */
1122      for(j = strat->Bl;j>=0;j--)
1123      {
1124        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
1125        if (compare==1)
1126        {
1127          strat->c3++;
1128          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1129          {
1130            pLmFree(Lp.lcm);
1131            return;
1132          }
1133          break;
1134        }
1135        else
1136        if (compare ==-1)
1137        {
1138          deleteInL(strat->B,&strat->Bl,j,strat);
1139          strat->c3++;
1140        }
1141      }
1142    }
1143#ifdef HAVE_PLURAL
1144  }
1145#endif
1146#ifdef HAVE_RING2TOM_DEACT
1147  }
1148#endif
1149  /*
1150  *the pair (S[i],p) enters B if the spoly != 0
1151  */
1152  /*-  compute the short s-polynomial -*/
1153  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
1154    pNorm(p);
1155  if ((strat->S[i]==NULL) || (p==NULL))
1156    return;
1157  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
1158    Lp.p=NULL;
1159  else
1160  {
1161#ifdef HAVE_PLURAL
1162    if (currRing->nc!=NULL)
1163    {
1164      if ((currRing->nc->type==nc_lie) && (pHasNotCF(p,strat->S[i])))
1165        /* generalized prod-crit for lie-type */
1166      {
1167          strat->cp++;
1168          Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i]);
1169      }
1170      else  Lp.p = nc_CreateSpoly(strat->S[i],p,NULL,currRing);
1171    }
1172    else
1173    {
1174#endif
1175    Lp.p = ksCreateShortSpoly(strat->S[i],p, strat->tailRing);
1176#ifdef HAVE_PLURAL
1177    }
1178#endif
1179  }
1180  if (Lp.p == NULL)
1181  {
1182    /*- the case that the s-poly is 0 -*/
1183    if (strat->pairtest==NULL) initPairtest(strat);
1184    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
1185    strat->pairtest[strat->sl+1] = TRUE;
1186    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
1187    /*
1188    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
1189    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
1190    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
1191    *term of p devides the lcm(s,r)
1192    *(this canceling should be done here because
1193    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
1194    *the first case is handeled in chainCrit
1195    */
1196    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
1197  }
1198  else
1199  {
1200    /*- the pair (S[i],p) enters B -*/
1201    Lp.p1 = strat->S[i];
1202    Lp.p2 = p;
1203
1204#ifdef HAVE_PLURAL
1205    if (currRing->nc==NULL)
1206    {
1207#endif
1208
1209     pNext(Lp.p) = strat->tail;
1210
1211#ifdef HAVE_PLURAL
1212    }
1213#endif
1214
1215    if (atR >= 0)
1216    {
1217      Lp.i_r2 = atR;
1218      Lp.i_r1 = strat->S_2_R[i];
1219    }
1220    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1221    if (TEST_OPT_INTSTRATEGY)
1222    {
1223
1224#ifdef HAVE_PLURAL
1225      if (currRing->nc==NULL)
1226      {
1227#endif
1228
1229      nDelete(&(Lp.p->coef));
1230
1231#ifdef HAVE_PLURAL
1232      }
1233#endif
1234
1235    }
1236    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
1237    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
1238  }
1239}
1240
1241/*2
1242* put the pair (s[i],p) into the set L, ecart=ecart(p)
1243* in the case that s forms a SB of (s)
1244*/
1245void enterOnePairSpecial (int i,poly p,int ecart,kStrategy strat, int atR = -1)
1246{
1247  //PrintS("try ");wrp(strat->S[i]);PrintS(" and ");wrp(p);PrintLn();
1248  if(pHasNotCF(p,strat->S[i]))
1249  {
1250    //PrintS("prod-crit\n");
1251      if (!rIsPluralRing(currRing))
1252      {
1253        strat->cp++;
1254        return;
1255      }
1256  }
1257
1258  int      l,j,compare;
1259  LObject  Lp;
1260
1261  Lp.lcm = pInit();
1262  pLcm(p,strat->S[i],Lp.lcm);
1263  pSetm(Lp.lcm);
1264  for(j = strat->Ll;j>=0;j--)
1265  {
1266    compare=pDivComp(strat->L[j].lcm,Lp.lcm);
1267    if ((compare==1) || (pLmEqual(strat->L[j].lcm,Lp.lcm)))
1268    {
1269      //PrintS("c3-crit\n");
1270      strat->c3++;
1271      pLmFree(Lp.lcm);
1272      return;
1273    }
1274    else if (compare ==-1)
1275    {
1276      //Print("c3-crit with L[%d]\n",j);
1277      deleteInL(strat->L,&strat->Ll,j,strat);
1278      strat->c3++;
1279    }
1280  }
1281  /*-  compute the short s-polynomial -*/
1282
1283  Lp.p = ksCreateShortSpoly(strat->S[i],p,strat->tailRing);
1284  if (Lp.p == NULL)
1285  {
1286     pLmFree(Lp.lcm);
1287  }
1288  else
1289  {
1290    /*- the pair (S[i],p) enters L -*/
1291    Lp.p1 = strat->S[i];
1292    Lp.p2 = p;
1293    if (atR >= 0)
1294    {
1295      Lp.i_r1 = strat->S_2_R[i];
1296      Lp.i_r2 = atR;
1297    }
1298    pNext(Lp.p) = strat->tail;
1299    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1300    if (TEST_OPT_INTSTRATEGY)
1301    {
1302      nDelete(&(Lp.p->coef));
1303    }
1304    l = strat->posInL(strat->L,strat->Ll,&Lp,strat);
1305    //Print("-> L[%d]\n",l);
1306    enterL(&strat->L,&strat->Ll,&strat->Lmax,Lp,l);
1307  }
1308}
1309
1310/*2
1311*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
1312*using the chain-criterion in B and L and enters B to L
1313*/
1314void chainCrit (poly p,int ecart,kStrategy strat)
1315{
1316  int i,j,l;
1317
1318  /*
1319  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
1320  *In this case all elements in B such
1321  *that their lcm is divisible by the leading term of S[i] can be canceled
1322  */
1323  if (strat->pairtest!=NULL)
1324  {
1325    {
1326      /*- i.e. there is an i with pairtest[i]==TRUE -*/
1327      for (j=0; j<=strat->sl; j++)
1328      {
1329        if (strat->pairtest[j])
1330        {
1331          for (i=strat->Bl; i>=0; i--)
1332          {
1333            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
1334            {
1335              deleteInL(strat->B,&strat->Bl,i,strat);
1336              strat->c3++;
1337            }
1338          }
1339        }
1340      }
1341    }
1342    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
1343    strat->pairtest=NULL;
1344  }
1345  if (strat->Gebauer || strat->fromT)
1346  {
1347    if (strat->sugarCrit)
1348    {
1349    /*
1350    *suppose L[j] == (s,r) and p/lcm(s,r)
1351    *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
1352    *and in case the sugar is o.k. then L[j] can be canceled
1353    */
1354      for (j=strat->Ll; j>=0; j--)
1355      {
1356        if (sugarDivisibleBy(ecart,strat->L[j].ecart)
1357        && ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
1358        && pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1359        {
1360          if (strat->L[j].p == strat->tail)
1361          {
1362              deleteInL(strat->L,&strat->Ll,j,strat);
1363              strat->c3++;
1364          }
1365        }
1366      }
1367      /*
1368      *this is GEBAUER-MOELLER:
1369      *in B all elements with the same lcm except the "best"
1370      *(i.e. the last one in B with this property) will be canceled
1371      */
1372      j = strat->Bl;
1373      loop /*cannot be changed into a for !!! */
1374      {
1375        if (j <= 0) break;
1376        i = j-1;
1377        loop
1378        {
1379          if (i <  0) break;
1380          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
1381          {
1382            strat->c3++;
1383            if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
1384            {
1385              deleteInL(strat->B,&strat->Bl,i,strat);
1386              j--;
1387            }
1388            else
1389            {
1390              deleteInL(strat->B,&strat->Bl,j,strat);
1391              break;
1392            }
1393          }
1394          i--;
1395        }
1396        j--;
1397      }
1398    }
1399    else /*sugarCrit*/
1400    {
1401      /*
1402      *suppose L[j] == (s,r) and p/lcm(s,r)
1403      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
1404      *and in case the sugar is o.k. then L[j] can be canceled
1405      */
1406      for (j=strat->Ll; j>=0; j--)
1407      {
1408        if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1409        {
1410          if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
1411          {
1412            deleteInL(strat->L,&strat->Ll,j,strat);
1413            strat->c3++;
1414          }
1415        }
1416      }
1417      /*
1418      *this is GEBAUER-MOELLER:
1419      *in B all elements with the same lcm except the "best"
1420      *(i.e. the last one in B with this property) will be canceled
1421      */
1422      j = strat->Bl;
1423      loop   /*cannot be changed into a for !!! */
1424      {
1425        if (j <= 0) break;
1426        for(i=j-1; i>=0; i--)
1427        {
1428          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
1429          {
1430            strat->c3++;
1431            deleteInL(strat->B,&strat->Bl,i,strat);
1432            j--;
1433          }
1434        }
1435        j--;
1436      }
1437    }
1438    /*
1439    *the elements of B enter L/their order with respect to B is kept
1440    *j = posInL(L,j,B[i]) would permutate the order
1441    *if once B is ordered different from L
1442    *then one should use j = posInL(L,Ll,B[i])
1443    */
1444    j = strat->Ll+1;
1445    for (i=strat->Bl; i>=0; i--)
1446    {
1447      j = strat->posInL(strat->L,j-1,&(strat->B[i]),strat);
1448      enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
1449    }
1450    strat->Bl = -1;
1451  }
1452  else
1453  {
1454    for (j=strat->Ll; j>=0; j--)
1455    {
1456      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1457      {
1458        if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
1459        {
1460          deleteInL(strat->L,&strat->Ll,j,strat);
1461          strat->c3++;
1462        }
1463      }
1464    }
1465    /*
1466    *this is our MODIFICATION of GEBAUER-MOELLER:
1467    *First the elements of B enter L,
1468    *then we fix a lcm and the "best" element in L
1469    *(i.e the last in L with this lcm and of type (s,p))
1470    *and cancel all the other elements of type (r,p) with this lcm
1471    *except the case the element (s,r) has also the same lcm
1472    *and is on the worst position with respect to (s,p) and (r,p)
1473    */
1474    /*
1475    *B enters to L/their order with respect to B is permutated for elements
1476    *B[i].p with the same leading term
1477    */
1478    j = strat->Ll;
1479    for (i=strat->Bl; i>=0; i--)
1480    {
1481      j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
1482      enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
1483    }
1484    strat->Bl = -1;
1485    j = strat->Ll;
1486    loop  /*cannot be changed into a for !!! */
1487    {
1488      if (j <= 0)
1489      {
1490        /*now L[0] cannot be canceled any more and the tail can be removed*/
1491        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
1492        break;
1493      }
1494      if (strat->L[j].p2 == p)
1495      {
1496        i = j-1;
1497        loop
1498        {
1499          if (i < 0)  break;
1500          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
1501          {
1502            /*L[i] could be canceled but we search for a better one to cancel*/
1503            strat->c3++;
1504            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
1505            && (pNext(strat->L[l].p) == strat->tail)
1506            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
1507            && pDivisibleBy(p,strat->L[l].lcm))
1508            {
1509              /*
1510              *"NOT equal(...)" because in case of "equal" the element L[l]
1511              *is "older" and has to be from theoretical point of view behind
1512              *L[i], but we do not want to reorder L
1513              */
1514              strat->L[i].p2 = strat->tail;
1515              /*
1516              *L[l] will be canceled, we cannot cancel L[i] later on,
1517              *so we mark it with "tail"
1518              */
1519              deleteInL(strat->L,&strat->Ll,l,strat);
1520              i--;
1521            }
1522            else
1523            {
1524              deleteInL(strat->L,&strat->Ll,i,strat);
1525            }
1526            j--;
1527          }
1528          i--;
1529        }
1530      }
1531      else if (strat->L[j].p2 == strat->tail)
1532      {
1533        /*now L[j] cannot be canceled any more and the tail can be removed*/
1534        strat->L[j].p2 = p;
1535      }
1536      j--;
1537    }
1538  }
1539}
1540
1541/*2
1542*(s[0],h),...,(s[k],h) will be put to the pairset L
1543*/
1544void initenterpairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
1545{
1546
1547  if ((strat->syzComp==0)
1548  || (pGetComp(h)<=strat->syzComp))
1549  {
1550    int j;
1551    BOOLEAN new_pair=FALSE;
1552
1553    if (pGetComp(h)==0)
1554    {
1555      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
1556      if ((isFromQ)&&(strat->fromQ!=NULL))
1557      {
1558        for (j=0; j<=k; j++)
1559        {
1560          if (!strat->fromQ[j])
1561          {
1562            new_pair=TRUE;
1563            enterOnePair(j,h,ecart,isFromQ,strat, atR);
1564          //Print("j:%d, Ll:%d\n",j,strat->Ll);
1565          }
1566        }
1567      }
1568      else
1569      {
1570        new_pair=TRUE;
1571        for (j=0; j<=k; j++)
1572        {
1573          enterOnePair(j,h,ecart,isFromQ,strat, atR);
1574          //Print("j:%d, Ll:%d\n",j,strat->Ll);
1575        }
1576      }
1577    }
1578    else
1579    {
1580      for (j=0; j<=k; j++)
1581      {
1582        if ((pGetComp(h)==pGetComp(strat->S[j]))
1583        || (pGetComp(strat->S[j])==0))
1584        {
1585          new_pair=TRUE;
1586          enterOnePair(j,h,ecart,isFromQ,strat, atR);
1587        //Print("j:%d, Ll:%d\n",j,strat->Ll);
1588        }
1589      }
1590    }
1591
1592    if (new_pair) chainCrit(h,ecart,strat);
1593
1594  }
1595}
1596
1597#ifdef HAVE_RING2TOM
1598long twoPow(long arg)
1599{
1600  return 1L << arg;
1601}
1602#endif
1603
1604/*2
1605*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
1606*superfluous elements in S will be deleted
1607*/
1608void enterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
1609{
1610#ifdef HAVE_RING2TOM
1611  // enter also zero divisor * poly, if this is non zero and of smaller degree
1612  if (currRing->cring == 1)
1613  {
1614    if (((long) ((h)->coef)) % 2 == 0)
1615    {
1616      long a = ((long) ((h)->coef)) / 2;
1617      long b = currRing->ch - 1;
1618      poly p = p_Copy(h->next, strat->tailRing);
1619      while (a % 2 == 0)
1620      {
1621        a = a / 2;
1622        b--;
1623      }
1624      p = p_Mult_nn(p, (number) twoPow(b), strat->tailRing);
1625
1626      if (p != NULL)
1627      {
1628        if (TEST_OPT_PROT)
1629        {
1630          PrintS("Z");
1631        }
1632        poly tmp = p_ISet((long) ((p)->coef), currRing);
1633        for (int i = 1; i <= currRing->N; i++) {
1634          pSetExp(tmp, i, p_GetExp(p, i, strat->tailRing));
1635        }
1636        p_Setm(tmp, currRing);
1637        p = p_LmDeleteAndNext(p, strat->tailRing);
1638        pNext(tmp) = p;
1639
1640        LObject h;
1641        h.p = tmp;
1642        h.tailRing = strat->tailRing;
1643        if (TEST_OPT_INTSTRATEGY)
1644        {
1645          //pContent(h.p);
1646          h.pCleardenom(); // also does a pContent
1647        }
1648        else
1649        {
1650          h.pNorm();
1651        }
1652        strat->initEcart(&h);
1653        int posx;
1654        if (h.p!=NULL)
1655        {
1656          if (strat->Ll==-1)
1657            posx =0;
1658          else
1659              posx = strat->posInL(strat->L,strat->Ll,&h,strat);
1660          h.sev = pGetShortExpVector(h.p);
1661          h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
1662          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
1663        }
1664      }
1665    }
1666  }
1667#endif
1668  int j=pos;
1669
1670  initenterpairs(h,k,ecart,0,strat, atR);
1671  if ( (!strat->fromT)
1672  && ((strat->syzComp==0)
1673    ||(pGetComp(h)<=strat->syzComp)))
1674  {
1675    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
1676    unsigned long h_sev = pGetShortExpVector(h);
1677    loop
1678    {
1679      if (j > k) break;
1680      clearS(h,h_sev, &j,&k,strat);
1681      j++;
1682    }
1683    //Print("end clearS sl=%d\n",strat->sl);
1684  }
1685 // PrintS("end enterpairs\n");
1686}
1687
1688/*2
1689*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
1690*superfluous elements in S will be deleted
1691*/
1692void enterpairsSpecial (poly h,int k,int ecart,int pos,kStrategy strat, int atR = -1)
1693{
1694  int j;
1695
1696  for (j=0; j<=k; j++)
1697  {
1698    if ((pGetComp(h)==pGetComp(strat->S[j]))
1699    || (0==pGetComp(strat->S[j])))
1700    {
1701      enterOnePairSpecial(j,h,ecart,strat, atR);
1702    }
1703  }
1704  j=pos;
1705  loop
1706  {
1707    unsigned long h_sev = pGetShortExpVector(h);
1708    if (j > k) break;
1709    clearS(h,h_sev,&j,&k,strat);
1710    j++;
1711  }
1712}
1713
1714/*2
1715*constructs the pairset at the beginning
1716*of the buchberger/mora algorithm
1717*/
1718void pairs (kStrategy strat)
1719{
1720  int j,i;
1721//  Print("pairs:sl=%d\n",strat->sl);
1722//  for (i=0; i<=strat->sl; i++)
1723//  {
1724//    Print("s%d:",i);pWrite(strat->S[i]);
1725//  }
1726  if (strat->fromQ!=NULL)
1727  {
1728    for (i=1; i<=strat->sl; i++)
1729    {
1730      initenterpairs(strat->S[i],i-1,strat->ecartS[i],strat->fromQ[i],strat);
1731    }
1732  }
1733  else
1734  {
1735    for (i=1; i<=strat->sl; i++)
1736    {
1737      initenterpairs(strat->S[i],i-1,strat->ecartS[i],0,strat);
1738    }
1739  }
1740  /*deletes superfluous elements in S*/
1741  i = -1;
1742  loop
1743  {
1744    i++;
1745    if (i >= strat->sl) break;
1746    if ((strat->syzComp==0) || (pGetComp(strat->S[i])<=strat->syzComp))
1747    {
1748      j=i;
1749      loop
1750      {
1751        j++;
1752        if (j > strat->sl) break;
1753        if (pLmShortDivisibleBy(strat->S[i], strat->sevS[i],
1754                              strat->S[j], ~ strat->sevS[j]))
1755        {
1756        //  Print("delete %d=",j);
1757        //  wrp(strat->S[j]);
1758        //  Print(" wegen %d=",i);
1759        //  wrp(strat->S[i]);
1760        //  Print("( fromQ=%d)\n", (strat->fromQ) ? strat->fromQ[j]:0);
1761          if ((strat->fromQ==NULL) || (strat->fromQ[j]==0))
1762          {
1763            deleteInS(j,strat);
1764            j--;
1765          }
1766        }
1767      }
1768    }
1769  }
1770}
1771
1772/*2
1773*reorders  s with respect to posInS,
1774*suc is the first changed index or zero
1775*/
1776void reorderS (int* suc,kStrategy strat)
1777{
1778  int i,j,at,ecart, s2r;
1779  int fq=0;
1780  unsigned long sev;
1781  poly  p;
1782
1783  *suc = -1;
1784  for (i=1; i<=strat->sl; i++)
1785  {
1786    at = posInS(strat,i-1,strat->S[i],strat->ecartS[i]);
1787    if (at != i)
1788    {
1789      if ((*suc > at) || (*suc == -1)) *suc = at;
1790      p = strat->S[i];
1791      ecart = strat->ecartS[i];
1792      sev = strat->sevS[i];
1793      s2r = strat->S_2_R[i];
1794      if (strat->fromQ!=NULL) fq=strat->fromQ[i];
1795      for (j=i; j>=at+1; j--)
1796      {
1797        strat->S[j] = strat->S[j-1];
1798        strat->ecartS[j] = strat->ecartS[j-1];
1799        strat->sevS[j] = strat->sevS[j-1];
1800        strat->S_2_R[j] = strat->S_2_R[j-1];
1801      }
1802      strat->S[at] = p;
1803      strat->ecartS[at] = ecart;
1804      strat->sevS[at] = sev;
1805      strat->S_2_R[at] = s2r;
1806      if (strat->fromQ!=NULL)
1807      {
1808        for (j=i; j>=at+1; j--)
1809        {
1810          strat->fromQ[j] = strat->fromQ[j-1];
1811        }
1812        strat->fromQ[at]=fq;
1813      }
1814    }
1815  }
1816}
1817
1818
1819/*2
1820*looks up the position of p in set
1821*set[0] is the smallest with respect to the ordering-procedure
1822*pComp
1823* Assumption: posInS only depends on the leading term
1824*             otherwise, bba has to be changed
1825*/
1826int posInS (kStrategy strat, int length,poly p, int ecart_p)
1827{
1828  if(length==-1) return 0;
1829  polyset set=strat->S;
1830  int i;
1831  int an = 0;
1832  int en= length;
1833  int cmp_int=pOrdSgn;
1834  if (currRing->MixedOrder)
1835  {
1836    int o=pWTotaldegree(p);
1837    int oo=pWTotaldegree(set[length]);
1838
1839    if ((oo<o)
1840    || ((o==oo) && (pLmCmp(set[length],p)!= cmp_int)))
1841      return length+1;
1842
1843    loop
1844    {
1845      if (an >= en-1)
1846      {
1847        if ((pWTotaldegree(set[an])>=o) && (pLmCmp(set[an],p) == cmp_int))
1848        {
1849          return an;
1850        }
1851        return en;
1852      }
1853      i=(an+en) / 2;
1854      if ((pWTotaldegree(set[an])>=o)
1855      && (pLmCmp(set[i],p) == cmp_int)) en=i;
1856      else                              an=i;
1857    }
1858  }
1859  else
1860  {
1861    if (pLmCmp(set[length],p)== -cmp_int)
1862      return length+1;
1863
1864    loop
1865    {
1866      if (an >= en-1)
1867      {
1868        if (pLmCmp(set[an],p) == cmp_int) return an;
1869        if (pLmCmp(set[an],p) == -cmp_int) return en;
1870        if ((cmp_int!=1)
1871        && ((strat->ecartS[an])>ecart_p))
1872          return an;
1873        return en;
1874      }
1875      i=(an+en) / 2;
1876      if (pLmCmp(set[i],p) == cmp_int) en=i;
1877      else if (pLmCmp(set[i],p) == -cmp_int) an=i;
1878      else
1879      {
1880        if ((cmp_int!=1)
1881        &&((strat->ecartS[i])<ecart_p))
1882          en=i;
1883        else
1884          an=i;
1885      }
1886    }
1887  }
1888}
1889
1890
1891/*2
1892* looks up the position of p in set
1893* the position is the last one
1894*/
1895int posInT0 (const TSet set,const int length,LObject &p)
1896{
1897  return (length+1);
1898}
1899
1900
1901/*2
1902* looks up the position of p in T
1903* set[0] is the smallest with respect to the ordering-procedure
1904* pComp
1905*/
1906int posInT1 (const TSet set,const int length,LObject &p)
1907{
1908  if (length==-1) return 0;
1909
1910  if (pLmCmp(set[length].p,p.p)!= pOrdSgn) return length+1;
1911
1912  int i;
1913  int an = 0;
1914  int en= length;
1915
1916  loop
1917  {
1918    if (an >= en-1)
1919    {
1920      if (pLmCmp(set[an].p,p.p) == pOrdSgn) return an;
1921      return en;
1922    }
1923    i=(an+en) / 2;
1924    if (pLmCmp(set[i].p,p.p) == pOrdSgn) en=i;
1925    else                                 an=i;
1926  }
1927}
1928
1929/*2
1930* looks up the position of p in T
1931* set[0] is the smallest with respect to the ordering-procedure
1932* length
1933*/
1934int posInT2 (const TSet set,const int length,LObject &p)
1935{
1936  if (length==-1)
1937    return 0;
1938  if (set[length].length<p.length)
1939    return length+1;
1940
1941  int i;
1942  int an = 0;
1943  int en= length;
1944
1945  loop
1946  {
1947    if (an >= en-1)
1948    {
1949      if (set[an].length>p.length) return an;
1950      return en;
1951    }
1952    i=(an+en) / 2;
1953    if (set[i].length>p.length) en=i;
1954    else                        an=i;
1955  }
1956}
1957
1958/*2
1959* looks up the position of p in T
1960* set[0] is the smallest with respect to the ordering-procedure
1961* totaldegree,pComp
1962*/
1963int posInT11 (const TSet set,const int length,LObject &p)
1964/*{
1965 * int j=0;
1966 * int o;
1967 *
1968 * o = p.GetpFDeg();
1969 * loop
1970 * {
1971 *   if ((pFDeg(set[j].p) > o)
1972 *   || ((pFDeg(set[j].p) == o) && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
1973 *   {
1974 *     return j;
1975 *   }
1976 *   j++;
1977 *   if (j > length) return j;
1978 * }
1979 *}
1980 */
1981{
1982  if (length==-1) return 0;
1983
1984  int o = p.GetpFDeg();
1985  int op = set[length].GetpFDeg();
1986
1987  if ((op < o)
1988  || ((op == o) && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
1989    return length+1;
1990
1991  int i;
1992  int an = 0;
1993  int en= length;
1994
1995  loop
1996  {
1997    if (an >= en-1)
1998    {
1999      op= set[an].GetpFDeg();
2000      if ((op > o)
2001      || (( op == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
2002        return an;
2003      return en;
2004    }
2005    i=(an+en) / 2;
2006    op = set[i].GetpFDeg();
2007    if (( op > o)
2008    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
2009      en=i;
2010    else
2011      an=i;
2012  }
2013}
2014
2015/*2
2016* looks up the position of p in T
2017* set[0] is the smallest with respect to the ordering-procedure
2018* totaldegree,pComp
2019*/
2020int posInT110 (const TSet set,const int length,LObject &p)
2021{
2022  if (length==-1) return 0;
2023
2024  int o = p.GetpFDeg();
2025  int op = set[length].GetpFDeg();
2026
2027  if (( op < o)
2028  || (( op == o) && (set[length].length<p.length))
2029  || (( op == o) && (set[length].length == p.length)
2030     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
2031    return length+1;
2032
2033  int i;
2034  int an = 0;
2035  int en= length;
2036  loop
2037  {
2038    if (an >= en-1)
2039    {
2040      op = set[an].GetpFDeg();
2041      if (( op > o)
2042      || (( op == o) && (set[an].length > p.length))
2043      || (( op == o) && (set[an].length == p.length)
2044         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
2045        return an;
2046      return en;
2047    }
2048    i=(an+en) / 2;
2049    op = set[i].GetpFDeg();
2050    if (( op > o)
2051    || (( op == o) && (set[i].length > p.length))
2052    || (( op == o) && (set[i].length == p.length)
2053       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
2054      en=i;
2055    else
2056      an=i;
2057  }
2058}
2059
2060/*2
2061* looks up the position of p in set
2062* set[0] is the smallest with respect to the ordering-procedure
2063* pFDeg
2064*/
2065int posInT13 (const TSet set,const int length,LObject &p)
2066{
2067  if (length==-1) return 0;
2068
2069  int o = p.GetpFDeg();
2070
2071  if (set[length].GetpFDeg() <= o)
2072    return length+1;
2073
2074  int i;
2075  int an = 0;
2076  int en= length;
2077  loop
2078  {
2079    if (an >= en-1)
2080    {
2081      if (set[an].GetpFDeg() > o)
2082        return an;
2083      return en;
2084    }
2085    i=(an+en) / 2;
2086    if (set[i].GetpFDeg() > o)
2087      en=i;
2088    else
2089      an=i;
2090  }
2091}
2092
2093// determines the position based on: 1.) Ecart 2.) pLength
2094int posInT_EcartpLength(const TSet set,const int length,LObject &p)
2095{
2096  if (length==-1) return 0;
2097
2098  int op=p.ecart;
2099  int ol = p.GetpLength();
2100
2101  int oo=set[length].ecart;
2102  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
2103    return length+1;
2104
2105  int i;
2106  int an = 0;
2107  int en= length;
2108  loop
2109    {
2110      if (an >= en-1)
2111      {
2112        int oo=set[an].ecart;
2113        if((oo > op)
2114           || ((oo==op) && (set[an].pLength > ol)))
2115          return an;
2116        return en;
2117      }
2118      i=(an+en) / 2;
2119      int oo=set[i].ecart;
2120      if ((oo > op)
2121          || ((oo == op) && (set[i].pLength > ol)))
2122        en=i;
2123      else
2124        an=i;
2125    }
2126}
2127
2128/*2
2129* looks up the position of p in set
2130* set[0] is the smallest with respect to the ordering-procedure
2131* maximaldegree, pComp
2132*/
2133int posInT15 (const TSet set,const int length,LObject &p)
2134/*{
2135 *int j=0;
2136 * int o;
2137 *
2138 * o = p.GetpFDeg()+p.ecart;
2139 * loop
2140 * {
2141 *   if ((set[j].GetpFDeg()+set[j].ecart > o)
2142 *   || ((set[j].GetpFDeg()+set[j].ecart == o)
2143 *     && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
2144 *   {
2145 *     return j;
2146 *   }
2147 *   j++;
2148 *   if (j > length) return j;
2149 * }
2150 *}
2151 */
2152{
2153  if (length==-1) return 0;
2154
2155  int o = p.GetpFDeg() + p.ecart;
2156  int op = set[length].GetpFDeg()+set[length].ecart;
2157
2158  if ((op < o)
2159  || ((op == o)
2160     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
2161    return length+1;
2162
2163  int i;
2164  int an = 0;
2165  int en= length;
2166  loop
2167  {
2168    if (an >= en-1)
2169    {
2170      op = set[an].GetpFDeg()+set[an].ecart;
2171      if (( op > o)
2172      || (( op  == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
2173        return an;
2174      return en;
2175    }
2176    i=(an+en) / 2;
2177    op = set[i].GetpFDeg()+set[i].ecart;
2178    if (( op > o)
2179    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
2180      en=i;
2181    else
2182      an=i;
2183  }
2184}
2185
2186/*2
2187* looks up the position of p in set
2188* set[0] is the smallest with respect to the ordering-procedure
2189* pFDeg+ecart, ecart, pComp
2190*/
2191int posInT17 (const TSet set,const int length,LObject &p)
2192/*
2193*{
2194* int j=0;
2195* int  o;
2196*
2197*  o = p.GetpFDeg()+p.ecart;
2198*  loop
2199*  {
2200*    if ((pFDeg(set[j].p)+set[j].ecart > o)
2201*    || (((pFDeg(set[j].p)+set[j].ecart == o)
2202*      && (set[j].ecart < p.ecart)))
2203*    || ((pFDeg(set[j].p)+set[j].ecart == o)
2204*      && (set[j].ecart==p.ecart)
2205*      && (pLmCmp(set[j].p,p.p)==pOrdSgn)))
2206*      return j;
2207*    j++;
2208*    if (j > length) return j;
2209*  }
2210* }
2211*/
2212{
2213  if (length==-1) return 0;
2214
2215  int o = p.GetpFDeg() + p.ecart;
2216  int op = set[length].GetpFDeg()+set[length].ecart;
2217
2218  if ((op < o)
2219  || (( op == o) && (set[length].ecart > p.ecart))
2220  || (( op == o) && (set[length].ecart==p.ecart)
2221     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
2222    return length+1;
2223
2224  int i;
2225  int an = 0;
2226  int en= length;
2227  loop
2228  {
2229    if (an >= en-1)
2230    {
2231      op = set[an].GetpFDeg()+set[an].ecart;
2232      if (( op > o)
2233      || (( op == o) && (set[an].ecart < p.ecart))
2234      || (( op  == o) && (set[an].ecart==p.ecart)
2235         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
2236        return an;
2237      return en;
2238    }
2239    i=(an+en) / 2;
2240    op = set[i].GetpFDeg()+set[i].ecart;
2241    if ((op > o)
2242    || (( op == o) && (set[i].ecart < p.ecart))
2243    || (( op == o) && (set[i].ecart == p.ecart)
2244       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
2245      en=i;
2246    else
2247      an=i;
2248  }
2249}
2250/*2
2251* looks up the position of p in set
2252* set[0] is the smallest with respect to the ordering-procedure
2253* pGetComp, pFDeg+ecart, ecart, pComp
2254*/
2255int posInT17_c (const TSet set,const int length,LObject &p)
2256{
2257  if (length==-1) return 0;
2258
2259  int cc = (-1+2*currRing->order[0]==ringorder_c);
2260  /* cc==1 for (c,..), cc==-1 for (C,..) */
2261  int o = p.GetpFDeg() + p.ecart;
2262  int c = pGetComp(p.p)*cc;
2263
2264  if (pGetComp(set[length].p)*cc < c)
2265    return length+1;
2266  if (pGetComp(set[length].p)*cc == c)
2267  {
2268    int op = set[length].GetpFDeg()+set[length].ecart;
2269    if ((op < o)
2270    || ((op == o) && (set[length].ecart > p.ecart))
2271    || ((op == o) && (set[length].ecart==p.ecart)
2272       && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
2273      return length+1;
2274  }
2275
2276  int i;
2277  int an = 0;
2278  int en= length;
2279  loop
2280  {
2281    if (an >= en-1)
2282    {
2283      if (pGetComp(set[an].p)*cc < c)
2284        return en;
2285      if (pGetComp(set[an].p)*cc == c)
2286      {
2287        int op = set[an].GetpFDeg()+set[an].ecart;
2288        if ((op > o)
2289        || ((op == o) && (set[an].ecart < p.ecart))
2290        || ((op == o) && (set[an].ecart==p.ecart)
2291           && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
2292          return an;
2293      }
2294      return en;
2295    }
2296    i=(an+en) / 2;
2297    if (pGetComp(set[i].p)*cc > c)
2298      en=i;
2299    else if (pGetComp(set[i].p)*cc == c)
2300    {
2301      int op = set[i].GetpFDeg()+set[i].ecart;
2302      if ((op > o)
2303      || ((op == o) && (set[i].ecart < p.ecart))
2304      || ((op == o) && (set[i].ecart == p.ecart)
2305         && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
2306        en=i;
2307      else
2308        an=i;
2309    }
2310    else
2311      an=i;
2312  }
2313}
2314
2315/*2
2316* looks up the position of p in set
2317* set[0] is the smallest with respect to
2318* ecart, pFDeg, length
2319*/
2320int posInT19 (const TSet set,const int length,LObject &p)
2321{
2322  if (length==-1) return 0;
2323
2324  int o = p.ecart;
2325  int op=p.GetpFDeg();
2326
2327  if (set[length].ecart < o)
2328    return length+1;
2329  if (set[length].ecart == o)
2330  {
2331     int oo=set[length].GetpFDeg();
2332     if ((oo < op) || ((oo==op) && (set[length].length < p.length)))
2333       return length+1;
2334  }
2335
2336  int i;
2337  int an = 0;
2338  int en= length;
2339  loop
2340  {
2341    if (an >= en-1)
2342    {
2343      if (set[an].ecart > o)
2344        return an;
2345      if (set[an].ecart == o)
2346      {
2347         int oo=set[an].GetpFDeg();
2348         if((oo > op)
2349         || ((oo==op) && (set[an].length > p.length)))
2350           return an;
2351      }
2352      return en;
2353    }
2354    i=(an+en) / 2;
2355    if (set[i].ecart > o)
2356      en=i;
2357    else if (set[i].ecart == o)
2358    {
2359       int oo=set[i].GetpFDeg();
2360       if ((oo > op)
2361       || ((oo == op) && (set[i].length > p.length)))
2362         en=i;
2363       else
2364        an=i;
2365    }
2366    else
2367      an=i;
2368  }
2369}
2370
2371/*2
2372*looks up the position of polynomial p in set
2373*set[length] is the smallest element in set with respect
2374*to the ordering-procedure pComp
2375*/
2376int posInLSpecial (const LSet set, const int length,
2377                   LObject *p,const kStrategy strat)
2378{
2379  if (length<0) return 0;
2380
2381  int d=p->GetpFDeg();
2382  int op=set[length].GetpFDeg();
2383
2384  if ((op > d)
2385  || ((op == d) && (p->p1!=NULL)&&(set[length].p1==NULL))
2386  || (pLmCmp(set[length].p,p->p)== pOrdSgn))
2387     return length+1;
2388
2389  int i;
2390  int an = 0;
2391  int en= length;
2392  loop
2393  {
2394    if (an >= en-1)
2395    {
2396      op=set[an].GetpFDeg();
2397      if ((op > d)
2398      || ((op == d) && (p->p1!=NULL) && (set[an].p1==NULL))
2399      || (pLmCmp(set[an].p,p->p)== pOrdSgn))
2400         return en;
2401      return an;
2402    }
2403    i=(an+en) / 2;
2404    op=set[i].GetpFDeg();
2405    if ((op>d)
2406    || ((op==d) && (p->p1!=NULL) && (set[i].p1==NULL))
2407    || (pLmCmp(set[i].p,p->p) == pOrdSgn))
2408      an=i;
2409    else
2410      en=i;
2411  }
2412}
2413
2414/*2
2415*looks up the position of polynomial p in set
2416*set[length] is the smallest element in set with respect
2417*to the ordering-procedure pComp
2418*/
2419int posInL0 (const LSet set, const int length,
2420             LObject* p,const kStrategy strat)
2421{
2422  if (length<0) return 0;
2423
2424  if (pLmCmp(set[length].p,p->p)== pOrdSgn)
2425    return length+1;
2426
2427  int i;
2428  int an = 0;
2429  int en= length;
2430  loop
2431  {
2432    if (an >= en-1)
2433    {
2434      if (pLmCmp(set[an].p,p->p) == pOrdSgn) return en;
2435      return an;
2436    }
2437    i=(an+en) / 2;
2438    if (pLmCmp(set[i].p,p->p) == pOrdSgn) an=i;
2439    else                                 en=i;
2440    /*aend. fuer lazy == in !=- machen */
2441  }
2442}
2443
2444/*2
2445* looks up the position of polynomial p in set
2446* e is the ecart of p
2447* set[length] is the smallest element in set with respect
2448* to the ordering-procedure totaldegree,pComp
2449*/
2450int posInL11 (const LSet set, const int length,
2451              LObject* p,const kStrategy strat)
2452/*{
2453 * int j=0;
2454 * int o;
2455 *
2456 * o = p->GetpFDeg();
2457 * loop
2458 * {
2459 *   if (j > length)            return j;
2460 *   if ((set[j].GetpFDeg() < o)) return j;
2461 *   if ((set[j].GetpFDeg() == o) && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
2462 *   {
2463 *     return j;
2464 *   }
2465 *   j++;
2466 * }
2467 *}
2468 */
2469{
2470  if (length<0) return 0;
2471
2472  int o = p->GetpFDeg();
2473  int op = set[length].GetpFDeg();
2474
2475  if ((op > o)
2476  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
2477    return length+1;
2478  int i;
2479  int an = 0;
2480  int en= length;
2481  loop
2482  {
2483    if (an >= en-1)
2484    {
2485      op = set[an].GetpFDeg();
2486      if ((op > o)
2487      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
2488        return en;
2489      return an;
2490    }
2491    i=(an+en) / 2;
2492    op = set[i].GetpFDeg();
2493    if ((op > o)
2494    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
2495      an=i;
2496    else
2497      en=i;
2498  }
2499}
2500
2501/*2
2502* looks up the position of polynomial p in set
2503* set[length] is the smallest element in set with respect
2504* to the ordering-procedure totaldegree,pLength0
2505*/
2506int posInL110 (const LSet set, const int length,
2507               LObject* p,const kStrategy strat)
2508{
2509  if (length<0) return 0;
2510
2511  int o = p->GetpFDeg();
2512  int op = set[length].GetpFDeg();
2513
2514  if ((op > o)
2515  || ((op == o) && (set[length].length >p->length))
2516  || ((op == o) && (set[length].length <= p->length)
2517     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
2518    return length+1;
2519  int i;
2520  int an = 0;
2521  int en= length;
2522  loop
2523  {
2524    if (an >= en-1)
2525    {
2526      op = set[an].GetpFDeg();
2527      if ((op > o)
2528      || ((op == o) && (set[an].length >p->length))
2529      || ((op == o) && (set[an].length <=p->length)
2530         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
2531        return en;
2532      return an;
2533    }
2534    i=(an+en) / 2;
2535    op = set[i].GetpFDeg();
2536    if ((op > o)
2537    || ((op == o) && (set[i].length > p->length))
2538    || ((op == o) && (set[i].length <= p->length)
2539       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
2540      an=i;
2541    else
2542      en=i;
2543  }
2544}
2545
2546/*2
2547* looks up the position of polynomial p in set
2548* e is the ecart of p
2549* set[length] is the smallest element in set with respect
2550* to the ordering-procedure totaldegree
2551*/
2552int posInL13 (const LSet set, const int length,
2553              LObject* p,const kStrategy strat)
2554{
2555  if (length<0) return 0;
2556
2557  int o = p->GetpFDeg();
2558
2559  if (set[length].GetpFDeg() > o)
2560    return length+1;
2561
2562  int i;
2563  int an = 0;
2564  int en= length;
2565  loop
2566  {
2567    if (an >= en-1)
2568    {
2569      if (set[an].GetpFDeg() >= o)
2570        return en;
2571      return an;
2572    }
2573    i=(an+en) / 2;
2574    if (set[i].GetpFDeg() >= o)
2575      an=i;
2576    else
2577      en=i;
2578  }
2579}
2580
2581/*2
2582* looks up the position of polynomial p in set
2583* e is the ecart of p
2584* set[length] is the smallest element in set with respect
2585* to the ordering-procedure maximaldegree,pComp
2586*/
2587int posInL15 (const LSet set, const int length,
2588              LObject* p,const kStrategy strat)
2589/*{
2590 * int j=0;
2591 * int o;
2592 *
2593 * o = p->ecart+p->GetpFDeg();
2594 * loop
2595 * {
2596 *   if (j > length)                       return j;
2597 *   if (set[j].GetpFDeg()+set[j].ecart < o) return j;
2598 *   if ((set[j].GetpFDeg()+set[j].ecart == o)
2599 *   && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
2600 *   {
2601 *     return j;
2602 *   }
2603 *   j++;
2604 * }
2605 *}
2606 */
2607{
2608  if (length<0) return 0;
2609
2610  int o = p->GetpFDeg() + p->ecart;
2611  int op = set[length].GetpFDeg() + set[length].ecart;
2612
2613  if ((op > o)
2614  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
2615    return length+1;
2616  int i;
2617  int an = 0;
2618  int en= length;
2619  loop
2620  {
2621    if (an >= en-1)
2622    {
2623      op = set[an].GetpFDeg() + set[an].ecart;
2624      if ((op > o)
2625      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
2626        return en;
2627      return an;
2628    }
2629    i=(an+en) / 2;
2630    op = set[i].GetpFDeg() + set[i].ecart;
2631    if ((op > o)
2632    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
2633      an=i;
2634    else
2635      en=i;
2636  }
2637}
2638
2639/*2
2640* looks up the position of polynomial p in set
2641* e is the ecart of p
2642* set[length] is the smallest element in set with respect
2643* to the ordering-procedure totaldegree
2644*/
2645int posInL17 (const LSet set, const int length,
2646              LObject* p,const kStrategy strat)
2647{
2648  if (length<0) return 0;
2649
2650  int o = p->GetpFDeg() + p->ecart;
2651
2652  if ((set[length].GetpFDeg() + set[length].ecart > o)
2653  || ((set[length].GetpFDeg() + set[length].ecart == o)
2654     && (set[length].ecart > p->ecart))
2655  || ((set[length].GetpFDeg() + set[length].ecart == o)
2656     && (set[length].ecart == p->ecart)
2657     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
2658    return length+1;
2659  int i;
2660  int an = 0;
2661  int en= length;
2662  loop
2663  {
2664    if (an >= en-1)
2665    {
2666      if ((set[an].GetpFDeg() + set[an].ecart > o)
2667      || ((set[an].GetpFDeg() + set[an].ecart == o)
2668         && (set[an].ecart > p->ecart))
2669      || ((set[an].GetpFDeg() + set[an].ecart == o)
2670         && (set[an].ecart == p->ecart)
2671         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
2672        return en;
2673      return an;
2674    }
2675    i=(an+en) / 2;
2676    if ((set[i].GetpFDeg() + set[i].ecart > o)
2677    || ((set[i].GetpFDeg() + set[i].ecart == o)
2678       && (set[i].ecart > p->ecart))
2679    || ((set[i].GetpFDeg() +set[i].ecart == o)
2680       && (set[i].ecart == p->ecart)
2681       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
2682      an=i;
2683    else
2684      en=i;
2685  }
2686}
2687/*2
2688* looks up the position of polynomial p in set
2689* e is the ecart of p
2690* set[length] is the smallest element in set with respect
2691* to the ordering-procedure pComp
2692*/
2693int posInL17_c (const LSet set, const int length,
2694                LObject* p,const kStrategy strat)
2695{
2696  if (length<0) return 0;
2697
2698  int cc = (-1+2*currRing->order[0]==ringorder_c);
2699  /* cc==1 for (c,..), cc==-1 for (C,..) */
2700  int c = pGetComp(p->p)*cc;
2701  int o = p->GetpFDeg() + p->ecart;
2702
2703  if (pGetComp(set[length].p)*cc > c)
2704    return length+1;
2705  if (pGetComp(set[length].p)*cc == c)
2706  {
2707    if ((set[length].GetpFDeg() + set[length].ecart > o)
2708    || ((set[length].GetpFDeg() + set[length].ecart == o)
2709       && (set[length].ecart > p->ecart))
2710    || ((set[length].GetpFDeg() + set[length].ecart == o)
2711       && (set[length].ecart == p->ecart)
2712       && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
2713      return length+1;
2714  }
2715  int i;
2716  int an = 0;
2717  int en= length;
2718  loop
2719  {
2720    if (an >= en-1)
2721    {
2722      if (pGetComp(set[an].p)*cc > c)
2723        return en;
2724      if (pGetComp(set[an].p)*cc == c)
2725      {
2726        if ((set[an].GetpFDeg() + set[an].ecart > o)
2727        || ((set[an].GetpFDeg() + set[an].ecart == o)
2728           && (set[an].ecart > p->ecart))
2729        || ((set[an].GetpFDeg() + set[an].ecart == o)
2730           && (set[an].ecart == p->ecart)
2731           && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
2732          return en;
2733      }
2734      return an;
2735    }
2736    i=(an+en) / 2;
2737    if (pGetComp(set[i].p)*cc > c)
2738      an=i;
2739    else if (pGetComp(set[i].p)*cc == c)
2740    {
2741      if ((set[i].GetpFDeg() + set[i].ecart > o)
2742      || ((set[i].GetpFDeg() + set[i].ecart == o)
2743         && (set[i].ecart > p->ecart))
2744      || ((set[i].GetpFDeg() +set[i].ecart == o)
2745         && (set[i].ecart == p->ecart)
2746         && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
2747        an=i;
2748      else
2749        en=i;
2750    }
2751    else
2752      en=i;
2753  }
2754}
2755
2756/***************************************************************
2757 *
2758 * Tail reductions
2759 *
2760 ***************************************************************/
2761TObject*
2762kFindDivisibleByInS(kStrategy strat, int pos, LObject* L, TObject *T,
2763                    long ecart)
2764{
2765  int j = 0;
2766  const unsigned long not_sev = ~L->sev;
2767  const unsigned long* sev = strat->sevS;
2768  poly p;
2769  ring r;
2770  L->GetLm(p, r);
2771
2772  assume(~not_sev == p_GetShortExpVector(p, r));
2773
2774  if (r == currRing)
2775  {
2776    loop
2777    {
2778      if (j > pos) return NULL;
2779#if defined(PDEBUG) || defined(PDIV_DEBUG)
2780      if (p_LmShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
2781          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
2782        break;
2783#else
2784      if (!(sev[j] & not_sev) &&
2785          (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
2786          p_LmDivisibleBy(strat->S[j], p, r))
2787        break;
2788
2789#endif
2790      j++;
2791    }
2792    // if called from NF, T objects do not exist:
2793    if (strat->tl < 0 || strat->S_2_R[j] == -1)
2794    {
2795      T->Set(strat->S[j], r, strat->tailRing);
2796      return T;
2797    }
2798    else
2799    {
2800      assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL &&
2801              strat->S_2_T(j)->p == strat->S[j]);
2802      return strat->S_2_T(j);
2803    }
2804  }
2805  else
2806  {
2807    TObject* t;
2808    loop
2809    {
2810      if (j > pos) return NULL;
2811      assume(strat->S_2_R[j] != -1);
2812#if defined(PDEBUG) || defined(PDIV_DEBUG)
2813      t = strat->S_2_T(j);
2814      assume(t != NULL && t->t_p != NULL && t->tailRing == r);
2815      if (p_LmShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
2816          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
2817        return t;
2818#else
2819      if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
2820      {
2821        t = strat->S_2_T(j);
2822        assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
2823        if (p_LmDivisibleBy(t->t_p, p, r)) return t;
2824      }
2825#endif
2826      j++;
2827    }
2828  }
2829}
2830/*
2831#ifdef HAVE_RING2TOM
2832TObject*
2833kRingFindDivisibleByInS(kStrategy strat, int pos, LObject* L, TObject *T,
2834                    long ecart)
2835{
2836  int j = 0;
2837  const unsigned long not_sev = ~L->sev;
2838  const unsigned long* sev = strat->sevS;
2839  poly p;
2840  ring r;
2841  L->GetLm(p, r);
2842
2843  assume(~not_sev == p_GetShortExpVector(p, r));
2844
2845  if (r == currRing)
2846  {
2847    loop
2848    {
2849      if (j > pos) return NULL;
2850#if defined(PDEBUG) || defined(PDIV_DEBUG)
2851      if (p_LmRingShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
2852          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
2853        break;
2854#else
2855      if (!(sev[j] & not_sev) &&
2856          (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
2857          p_LmRingDivisibleBy(strat->S[j], p, r))
2858        break;
2859
2860#endif
2861      j++;
2862    }
2863    // if called from NF, T objects do not exist:
2864    if (strat->tl < 0 || strat->S_2_R[j] == -1)
2865    {
2866      T->Set(strat->S[j], r, strat->tailRing);
2867      return T;
2868    }
2869    else
2870    {
2871      assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL &&
2872              strat->S_2_T(j)->p == strat->S[j]);
2873      return strat->S_2_T(j);
2874    }
2875  }
2876  else
2877  {
2878    TObject* t;
2879    loop
2880    {
2881      if (j > pos) return NULL;
2882      assume(strat->S_2_R[j] != -1);
2883#if defined(PDEBUG) || defined(PDIV_DEBUG)
2884      t = strat->S_2_T(j);
2885      assume(t != NULL && t->t_p != NULL && t->tailRing == r);
2886      if (p_LmRingShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
2887          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
2888        return t;
2889#else
2890      if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
2891      {
2892        t = strat->S_2_T(j);
2893        assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
2894        if (p_LmRingDivisibleBy(t->t_p, p, r)) return t;
2895      }
2896#endif
2897      j++;
2898    }
2899  }
2900}
2901#endif
2902*/
2903
2904poly redtail (LObject* L, int pos, kStrategy strat)
2905{
2906  poly h, hn;
2907  int j;
2908  unsigned long not_sev;
2909  strat->redTailChange=FALSE;
2910
2911  poly p = L->p;
2912  if (strat->noTailReduction || pNext(p) == NULL)
2913    return p;
2914
2915  LObject Ln(strat->tailRing);
2916  TObject* With;
2917  // placeholder in case strat->tl < 0
2918  TObject  With_s(strat->tailRing);
2919  h = p;
2920  hn = pNext(h);
2921  long op = strat->tailRing->pFDeg(hn, strat->tailRing);
2922  long e;
2923  int l;
2924  BOOLEAN save_HE=strat->kHEdgeFound;
2925  strat->kHEdgeFound |=
2926    ((Kstd1_deg>0) && (op<=Kstd1_deg)) || TEST_OPT_INFREDTAIL;
2927
2928  while(hn != NULL)
2929  {
2930    op = strat->tailRing->pFDeg(hn, strat->tailRing);
2931    if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
2932    e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
2933    loop
2934    {
2935      Ln.Set(hn, strat->tailRing);
2936      Ln.sev = p_GetShortExpVector(hn, strat->tailRing);
2937      if (strat->kHEdgeFound)
2938        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
2939      else
2940        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s, e);
2941      if (With == NULL) break;
2942      strat->redTailChange=TRUE;
2943      if (ksReducePolyTail(L, With, h, strat->kNoetherTail()))
2944      {
2945        // reducing the tail would violate the exp bound
2946        if (kStratChangeTailRing(strat, L))
2947        {
2948          strat->kHEdgeFound = save_HE;
2949          return redtail(L, pos, strat);
2950        }
2951        else
2952          return NULL;
2953      }
2954      hn = pNext(h);
2955      if (hn == NULL) goto all_done;
2956      op = strat->tailRing->pFDeg(hn, strat->tailRing);
2957      if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
2958      e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
2959    }
2960    h = hn;
2961    hn = pNext(h);
2962  }
2963
2964  all_done:
2965  if (strat->redTailChange)
2966  {
2967    L->last = 0;
2968    L->pLength = 0;
2969  }
2970  strat->kHEdgeFound = save_HE;
2971  return p;
2972}
2973
2974poly redtail (poly p, int pos, kStrategy strat)
2975{
2976  LObject L(p, currRing);
2977  return redtail(&L, pos, strat);
2978}
2979
2980poly redtailBba (LObject* L, int pos, kStrategy strat, BOOLEAN withT)
2981{
2982  strat->redTailChange=FALSE;
2983  if (strat->noTailReduction) return L->GetLmCurrRing();
2984  poly h, p;
2985  p = h = L->GetLmTailRing();
2986  if ((h==NULL) || (pNext(h)==NULL))
2987    return L->GetLmCurrRing();
2988
2989  TObject* With;
2990  // placeholder in case strat->tl < 0
2991  TObject  With_s(strat->tailRing);
2992
2993  LObject Ln(pNext(h), strat->tailRing);
2994  Ln.pLength = L->GetpLength() - 1;
2995
2996  pNext(h) = NULL;
2997  if (L->p != NULL) pNext(L->p) = NULL;
2998  L->pLength = 1;
2999
3000  Ln.PrepareRed(strat->use_buckets);
3001
3002  while(!Ln.IsNull())
3003  {
3004    loop
3005    {
3006      Ln.SetShortExpVector();
3007      if (! withT)
3008      {
3009/* obsolete
3010#ifdef HAVE_RING2TOM
3011        if (currRing->cring == 1) {
3012            With = kRingFindDivisibleByInS(strat, pos, &Ln, &With_s);
3013        } else
3014#endif
3015*/
3016            With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
3017        if (With == NULL) break;
3018      }
3019      else
3020      {
3021        int j;
3022/* Obsolete
3023#ifdef HAVE_RING2TOM
3024        if (currRing->cring == 1) {
3025           j = kRingFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
3026        } else
3027#endif
3028*/
3029           j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
3030        if (j < 0) break;
3031        With = &(strat->T[j]);
3032      }
3033      if (ksReducePolyTail(L, With, &Ln))
3034      {
3035        // reducing the tail would violate the exp bound
3036        pNext(h) = Ln.GetTP();
3037        L->pLength += Ln.GetpLength();
3038        if (L->p != NULL) pNext(L->p) = pNext(p);
3039        if (kStratChangeTailRing(strat, L))
3040          return redtailBba(L, pos, strat, withT);
3041        else
3042        { // should never get here -- need to fix this
3043          assume(0);
3044          return NULL;
3045        }
3046      }
3047      strat->redTailChange=TRUE;
3048      if (Ln.IsNull()) goto all_done;
3049      if (! withT) With_s.Init(currRing);
3050    }
3051    pNext(h) = Ln.LmExtractAndIter();
3052    pIter(h);
3053    L->pLength++;
3054  }
3055
3056  all_done:
3057  if (L->p != NULL) pNext(L->p) = pNext(p);
3058  assume(pLength(L->p != NULL ? L->p : L->t_p) == L->pLength);
3059
3060  if (strat->redTailChange)
3061  {
3062    L->last = NULL;
3063    L->length = 0;
3064  }
3065  L->Normalize(); // HANNES: should have a test
3066  kTest_L(L);
3067  return L->GetLmCurrRing();
3068}
3069
3070/*2
3071*checks the change degree and write progress report
3072*/
3073void message (int i,int* reduc,int* olddeg,kStrategy strat, int red_result)
3074{
3075  if (i != *olddeg)
3076  {
3077    Print("%d",i);
3078    *olddeg = i;
3079  }
3080  if (K_TEST_OPT_OLDSTD)
3081  {
3082    if (strat->Ll != *reduc)
3083    {
3084      if (strat->Ll != *reduc-1)
3085        Print("(%d)",strat->Ll+1);
3086      else
3087        PrintS("-");
3088      *reduc = strat->Ll;
3089    }
3090    else
3091      PrintS(".");
3092    mflush();
3093  }
3094  else
3095  {
3096    if (red_result == 0)
3097      PrintS("-");
3098    else if (red_result < 0)
3099      PrintS(".");
3100    if ((red_result > 0) || ((strat->Ll % 100)==99))
3101    {
3102      if (strat->Ll != *reduc && strat->Ll > 0)
3103      {
3104        Print("(%d)",strat->Ll+1);
3105        *reduc = strat->Ll;
3106      }
3107    }
3108  }
3109}
3110
3111/*2
3112*statistics
3113*/
3114void messageStat (int srmax,int lrmax,int hilbcount,kStrategy strat)
3115{
3116  //PrintS("\nUsage/Allocation of temporary storage:\n");
3117  //Print("%d/%d polynomials in standard base\n",srmax,IDELEMS(Shdl));
3118  //Print("%d/%d polynomials in set L (for lazy alg.)",lrmax+1,strat->Lmax);
3119  Print("\nproduct criterion:%d chain criterion:%d\n",strat->cp,strat->c3);
3120  if (hilbcount!=0) Print("hilbert series criterion:%d\n",hilbcount);
3121  /*mflush();*/
3122}
3123
3124#ifdef KDEBUG
3125/*2
3126*debugging output: all internal sets, if changed
3127*for testing purpuse only/has to be changed for later use
3128*/
3129void messageSets (kStrategy strat)
3130{
3131  int i;
3132  if (strat->news)
3133  {
3134    PrintS("set S");
3135    for (i=0; i<=strat->sl; i++)
3136    {
3137      Print("\n  %d:",i);
3138      p_wrp(strat->S[i], currRing, strat->tailRing);
3139    }
3140    strat->news = FALSE;
3141  }
3142  if (strat->newt)
3143  {
3144    PrintS("\nset T");
3145    for (i=0; i<=strat->tl; i++)
3146    {
3147      Print("\n  %d:",i);
3148      strat->T[i].wrp();
3149      Print(" o:%d e:%d l:%d",
3150        strat->T[i].pFDeg(),strat->T[i].ecart,strat->T[i].length);
3151    }
3152    strat->newt = FALSE;
3153  }
3154  PrintS("\nset L");
3155  for (i=strat->Ll; i>=0; i--)
3156  {
3157    Print("\n%d:",i);
3158    p_wrp(strat->L[i].p1, currRing, strat->tailRing);
3159    PrintS("  ");
3160    p_wrp(strat->L[i].p2, currRing, strat->tailRing);
3161    PrintS(" lcm: ");p_wrp(strat->L[i].lcm, currRing);
3162    PrintS("\n  p : ");
3163    strat->L[i].wrp();
3164    Print("  o:%d e:%d l:%d",
3165          strat->L[i].pFDeg(),strat->L[i].ecart,strat->L[i].length);
3166  }
3167  PrintLn();
3168}
3169
3170#endif
3171
3172
3173/*2
3174*construct the set s from F
3175*/
3176void initS (ideal F, ideal Q,kStrategy strat)
3177{
3178  int   i,pos;
3179
3180  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
3181  else i=setmaxT;
3182  strat->ecartS=initec(i);
3183  strat->sevS=initsevS(i);
3184  strat->S_2_R=initS_2_R(i);
3185  strat->fromQ=NULL;
3186  strat->Shdl=idInit(i,F->rank);
3187  strat->S=strat->Shdl->m;
3188  /*- put polys into S -*/
3189  if (Q!=NULL)
3190  {
3191    strat->fromQ=initec(i);
3192    memset(strat->fromQ,0,i*sizeof(int));
3193    for (i=0; i<IDELEMS(Q); i++)
3194    {
3195      if (Q->m[i]!=NULL)
3196      {
3197        LObject h;
3198        h.p = pCopy(Q->m[i]);
3199        if (TEST_OPT_INTSTRATEGY)
3200        {
3201          //pContent(h.p);
3202          h.pCleardenom(); // also does a pContent
3203        }
3204        else
3205        {
3206          h.pNorm();
3207        }
3208        strat->initEcart(&h);
3209        if (pOrdSgn==-1)
3210        {
3211          deleteHC(&h, strat);
3212        }
3213        if (h.p!=NULL)
3214        {
3215          if (strat->sl==-1)
3216            pos =0;
3217          else
3218          {
3219            pos = posInS(strat,strat->sl,h.p,h.ecart);
3220          }
3221          h.sev = pGetShortExpVector(h.p);
3222          strat->enterS(h,pos,strat,-1);
3223          strat->fromQ[pos]=1;
3224        }
3225      }
3226    }
3227  }
3228  for (i=0; i<IDELEMS(F); i++)
3229  {
3230    if (F->m[i]!=NULL)
3231    {
3232      LObject h;
3233      h.p = pCopy(F->m[i]);
3234      if (TEST_OPT_INTSTRATEGY)
3235      {
3236        //pContent(h.p);
3237        h.pCleardenom(); // also does a pContent
3238      }
3239      else
3240      {
3241        h.pNorm();
3242      }
3243      strat->initEcart(&h);
3244      if (pOrdSgn==-1)
3245      {
3246        cancelunit(&h);  /*- tries to cancel a unit -*/
3247        deleteHC(&h, strat);
3248      }
3249      if (h.p!=NULL)
3250      {
3251        if (strat->sl==-1)
3252          pos =0;
3253        else
3254          pos = posInS(strat,strat->sl,h.p,h.ecart);
3255        h.sev = pGetShortExpVector(h.p);
3256        strat->enterS(h,pos,strat,-1);
3257      }
3258    }
3259  }
3260  /*- test, if a unit is in F -*/
3261  if ((strat->sl>=0) && pIsConstant(strat->S[0]))
3262  {
3263    while (strat->sl>0) deleteInS(strat->sl,strat);
3264  }
3265}
3266
3267void initSL (ideal F, ideal Q,kStrategy strat)
3268{
3269  int   i,pos;
3270
3271  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
3272  else i=setmaxT;
3273  strat->ecartS=initec(i);
3274  strat->sevS=initsevS(i);
3275  strat->S_2_R=initS_2_R(i);
3276  strat->fromQ=NULL;
3277  strat->Shdl=idInit(i,F->rank);
3278  strat->S=strat->Shdl->m;
3279  /*- put polys into S -*/
3280  if (Q!=NULL)
3281  {
3282    strat->fromQ=initec(i);
3283    memset(strat->fromQ,0,i*sizeof(int));
3284    for (i=0; i<IDELEMS(Q); i++)
3285    {
3286      if (Q->m[i]!=NULL)
3287      {
3288        LObject h;
3289        h.p = pCopy(Q->m[i]);
3290        if (TEST_OPT_INTSTRATEGY)
3291        {
3292          //pContent(h.p);
3293          h.pCleardenom(); // also does a pContent
3294        }
3295        else
3296        {
3297          h.pNorm();
3298        }
3299        strat->initEcart(&h);
3300        if (pOrdSgn==-1)
3301        {
3302          deleteHC(&h,strat);
3303        }
3304        if (h.p!=NULL)
3305        {
3306          if (strat->sl==-1)
3307            pos =0;
3308          else
3309          {
3310            pos = posInS(strat,strat->sl,h.p,h.ecart);
3311          }
3312          h.sev = pGetShortExpVector(h.p);
3313          strat->enterS(h,pos,strat,-1);
3314          strat->fromQ[pos]=1;
3315        }
3316      }
3317    }
3318  }
3319  for (i=0; i<IDELEMS(F); i++)
3320  {
3321    if (F->m[i]!=NULL)
3322    {
3323      LObject h;
3324      h.p = pCopy(F->m[i]);
3325      if (TEST_OPT_INTSTRATEGY)
3326      {
3327        //pContent(h.p);
3328        h.pCleardenom(); // also does a pContent
3329      }
3330      else
3331      {
3332        h.pNorm();
3333      }
3334      strat->initEcart(&h);
3335      if (pOrdSgn==-1)
3336      {
3337        cancelunit(&h);  /*- tries to cancel a unit -*/
3338        deleteHC(&h, strat);
3339      }
3340      if (h.p!=NULL)
3341      {
3342        if (strat->Ll==-1)
3343          pos =0;
3344        else
3345          pos = strat->posInL(strat->L,strat->Ll,&h,strat);
3346        h.sev = pGetShortExpVector(h.p);
3347        enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
3348      }
3349    }
3350  }
3351  /*- test, if a unit is in F -*/
3352  if ((strat->Ll>=0) && pIsConstant(strat->L[strat->Ll].p))
3353  {
3354    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
3355  }
3356}
3357
3358
3359/*2
3360*construct the set s from F and {P}
3361*/
3362void initSSpecial (ideal F, ideal Q, ideal P,kStrategy strat)
3363{
3364  int   i,pos;
3365
3366  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
3367  else i=setmaxT;
3368  i=((i+IDELEMS(F)+15)/16)*16;
3369  strat->ecartS=initec(i);
3370  strat->sevS=initsevS(i);
3371  strat->S_2_R=initS_2_R(i);
3372  strat->fromQ=NULL;
3373  strat->Shdl=idInit(i,F->rank);
3374  strat->S=strat->Shdl->m;
3375
3376  /*- put polys into S -*/
3377  if (Q!=NULL)
3378  {
3379    strat->fromQ=initec(i);
3380    memset(strat->fromQ,0,i*sizeof(int));
3381    for (i=0; i<IDELEMS(Q); i++)
3382    {
3383      if (Q->m[i]!=NULL)
3384      {
3385        LObject h;
3386        h.p = pCopy(Q->m[i]);
3387        //if (TEST_OPT_INTSTRATEGY)
3388        //{
3389        //  //pContent(h.p);
3390        //  h.pCleardenom(); // also does a pContent
3391        //}
3392        //else
3393        //{
3394        //  h.pNorm();
3395        //}
3396        strat->initEcart(&h);
3397        if (pOrdSgn==-1)
3398        {
3399          deleteHC(&h,strat);
3400        }
3401        if (h.p!=NULL)
3402        {
3403          if (strat->sl==-1)
3404            pos =0;
3405          else
3406          {
3407            pos = posInS(strat,strat->sl,h.p,h.ecart);
3408          }
3409          h.sev = pGetShortExpVector(h.p);
3410          h.SetpFDeg();
3411          strat->enterS(h,pos,strat, strat->tl+1);
3412          enterT(h, strat);
3413          strat->fromQ[pos]=1;
3414        }
3415      }
3416    }
3417  }
3418  /*- put polys into S -*/
3419  for (i=0; i<IDELEMS(F); i++)
3420  {
3421    if (F->m[i]!=NULL)
3422    {
3423      LObject h;
3424      h.p = pCopy(F->m[i]);
3425      if (pOrdSgn==1)
3426      {
3427        h.p=redtailBba(h.p,strat->sl,strat);
3428      }
3429      strat->initEcart(&h);
3430      if (pOrdSgn==-1)
3431      {
3432        deleteHC(&h,strat);
3433      }
3434      if (h.p!=NULL)
3435      {
3436        if (strat->sl==-1)
3437          pos =0;
3438        else
3439          pos = posInS(strat,strat->sl,h.p,h.ecart);
3440        h.sev = pGetShortExpVector(h.p);
3441        strat->enterS(h,pos,strat, strat->tl+1);
3442        h.length = pLength(h.p);
3443        h.SetpFDeg();
3444        enterT(h,strat);
3445      }
3446    }
3447  }
3448  for (i=0; i<IDELEMS(P); i++)
3449  {
3450    if (P->m[i]!=NULL)
3451    {
3452      LObject h;
3453      h.p=pCopy(P->m[i]);
3454      strat->initEcart(&h);
3455      h.length = pLength(h.p);
3456      if (TEST_OPT_INTSTRATEGY)
3457      {
3458        h.pCleardenom();
3459      }
3460      else
3461      {
3462        h.pNorm();
3463      }
3464      if(strat->sl>=0)
3465      {
3466        if (pOrdSgn==1)
3467        {
3468          h.p=redBba(h.p,strat->sl,strat);
3469          if (h.p!=NULL)
3470            h.p=redtailBba(h.p,strat->sl,strat);
3471        }
3472        else
3473        {
3474          h.p=redMora(h.p,strat->sl,strat);
3475          strat->initEcart(&h);
3476        }
3477        if(h.p!=NULL)
3478        {
3479          if (TEST_OPT_INTSTRATEGY)
3480          {
3481            h.pCleardenom();
3482          }
3483          else
3484          {
3485            h.is_normalized = 0;
3486            h.pNorm();
3487          }
3488          h.sev = pGetShortExpVector(h.p);
3489          h.SetpFDeg();
3490          pos = posInS(strat,strat->sl,h.p,h.ecart);
3491          enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
3492          strat->enterS(h,pos,strat, strat->tl+1);
3493          enterT(h,strat);
3494        }
3495      }
3496      else
3497      {
3498        h.sev = pGetShortExpVector(h.p);
3499        h.SetpFDeg();
3500        strat->enterS(h,0,strat, strat->tl+1);
3501        enterT(h,strat);
3502      }
3503    }
3504  }
3505}
3506/*2
3507* reduces h using the set S
3508* procedure used in cancelunit1
3509*/
3510static poly redBba1 (poly h,int maxIndex,kStrategy strat)
3511{
3512  int j = 0;
3513  unsigned long not_sev = ~ pGetShortExpVector(h);
3514
3515  while (j <= maxIndex)
3516  {
3517    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j],h, not_sev))
3518       return ksOldSpolyRedNew(strat->S[j],h,strat->kNoetherTail());
3519    else j++;
3520  }
3521  return h;
3522}
3523
3524/*2
3525*tests if p.p=monomial*unit and cancels the unit
3526*/
3527void cancelunit1 (LObject* p,int *suc, int index,kStrategy strat )
3528{
3529  int k;
3530  poly r,h,h1,q;
3531
3532  if (!pIsVector((*p).p) && ((*p).ecart != 0))
3533  {
3534    k = 0;
3535    h1 = r = pCopy((*p).p);
3536    h =pNext(r);
3537    loop
3538    {
3539      if (h==NULL)
3540      {
3541        pDelete(&r);
3542        pDelete(&(pNext((*p).p)));
3543        (*p).ecart = 0;
3544        (*p).length = 1;
3545        (*suc)=0;
3546        return;
3547      }
3548      if (!pDivisibleBy(r,h))
3549      {
3550        q=redBba1(h,index ,strat);
3551        if (q != h)
3552        {
3553          k++;
3554          pDelete(&h);
3555          pNext(h1) = h = q;
3556        }
3557        else
3558        {
3559          pDelete(&r);
3560          return;
3561        }
3562      }
3563      else
3564      {
3565        h1 = h;
3566        pIter(h);
3567      }
3568      if (k > 10)
3569      {
3570        pDelete(&r);
3571        return;
3572      }
3573    }
3574  }
3575}
3576
3577/*2
3578* reduces h using the elements from Q in the set S
3579* procedure used in updateS
3580* must not be used for elements of Q or elements of an ideal !
3581*/
3582static poly redQ (poly h, int j, kStrategy strat)
3583{
3584  int start;
3585  unsigned long not_sev = ~ pGetShortExpVector(h);
3586  while ((j <= strat->sl) && (pGetComp(strat->S[j])!=0)) j++;
3587  start=j;
3588  while (j<=strat->sl)
3589  {
3590    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
3591    {
3592      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
3593      if (h==NULL) return NULL;
3594      j = start;
3595      not_sev = ~ pGetShortExpVector(h);
3596    }
3597    else j++;
3598  }
3599  return h;
3600}
3601
3602/*2
3603* reduces h using the set S
3604* procedure used in updateS
3605*/
3606static poly redBba (poly h,int maxIndex,kStrategy strat)
3607{
3608  int j = 0;
3609  unsigned long not_sev = ~ pGetShortExpVector(h);
3610
3611  while (j <= maxIndex)
3612  {
3613#ifdef HAVE_RING2TOM
3614    if ((currRing->cring == 1 && pLmRingShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev)) ||
3615        (currRing->cring == 0 && pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev)))
3616#else
3617    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
3618#endif
3619    {
3620      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
3621      if (h==NULL) return NULL;
3622      j = 0;
3623      not_sev = ~ pGetShortExpVector(h);    }
3624    else j++;
3625  }
3626  return h;
3627}
3628
3629/*2
3630* reduces h using the set S
3631*e is the ecart of h
3632*procedure used in updateS
3633*/
3634static poly redMora (poly h,int maxIndex,kStrategy strat)
3635{
3636  int  j=0;
3637  int  e,l;
3638  unsigned long not_sev = ~ pGetShortExpVector(h);
3639
3640  if (maxIndex >= 0)
3641  {
3642    e = pLDeg(h,&l,currRing)-pFDeg(h,currRing);
3643    do
3644    {
3645      if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev)
3646      && ((e >= strat->ecartS[j]) || strat->kHEdgeFound))
3647      {
3648#ifdef KDEBUG
3649        if (TEST_OPT_DEBUG)
3650          {PrintS("reduce ");wrp(h);Print(" with S[%d] (",j);wrp(strat->S[j]);}
3651
3652#endif
3653        h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
3654#ifdef KDEBUG
3655        if(TEST_OPT_DEBUG)
3656          {PrintS(")\nto "); wrp(h); PrintLn();}
3657
3658#endif
3659        // pDelete(&h);
3660        if (h == NULL) return NULL;
3661        e = pLDeg(h,&l,currRing)-pFDeg(h,currRing);
3662        j = 0;
3663        not_sev = ~ pGetShortExpVector(h);
3664      }
3665      else j++;
3666    }
3667    while (j <= maxIndex);
3668  }
3669  return h;
3670}
3671
3672/*2
3673*updates S:
3674*the result is a set of polynomials which are in
3675*normalform with respect to S
3676*/
3677void updateS(BOOLEAN toT,kStrategy strat)
3678{
3679  LObject h;
3680  int i, suc=0;
3681  poly redSi=NULL;
3682//  Print("nach initS: updateS start mit sl=%d\n",(strat->sl));
3683//  for (i=0; i<=(strat->sl); i++)
3684//  {
3685//    Print("s%d:",i);
3686//    if (strat->fromQ!=NULL) Print("(Q:%d) ",strat->fromQ[i]);
3687//    pWrite(strat->S[i]);
3688//  }
3689//  Print("pOrdSgn=%d\n", pOrdSgn);
3690  if (pOrdSgn==1)
3691  {
3692    while (suc != -1)
3693    {
3694      i=suc+1;
3695      while (i<=strat->sl)
3696      {
3697        if (((strat->syzComp==0) || (pGetComp(strat->S[i])<=strat->syzComp))
3698        && ((strat->fromQ==NULL) || (strat->fromQ[i]==0)))
3699        {
3700          pDelete(&redSi);
3701          redSi = pHead(strat->S[i]);
3702          strat->S[i] = redBba(strat->S[i],i-1,strat);
3703          if ((strat->ak!=0)&&(strat->S[i]!=NULL))
3704            strat->S[i]=redQ(strat->S[i],i+1,strat); /*reduce S[i] mod Q*/
3705          if (TEST_OPT_DEBUG && (pCmp(redSi,strat->S[i])!=0))
3706          {
3707            PrintS("reduce:");
3708            wrp(redSi);PrintS(" to ");p_wrp(strat->S[i], currRing, strat->tailRing);PrintLn();
3709          }
3710          if (TEST_OPT_PROT && (pCmp(redSi,strat->S[i])!=0))
3711          {
3712            if (strat->S[i]==NULL)
3713              PrintS("V");
3714            else
3715              PrintS("v");
3716            mflush();
3717          }
3718          if (strat->S[i]==NULL)
3719          {
3720            pDelete(&redSi);
3721            deleteInS(i,strat);
3722            i--;
3723          }
3724          else
3725          {
3726            pDelete(&redSi);
3727            if (TEST_OPT_INTSTRATEGY)
3728            {
3729              //pContent(strat->S[i]);
3730              pCleardenom(strat->S[i]);// also does a pContent
3731            }
3732            else
3733            {
3734              pNorm(strat->S[i]);
3735            }
3736            strat->sevS[i] = pGetShortExpVector(strat->S[i]);
3737          }
3738        }
3739        i++;
3740      }
3741      reorderS(&suc,strat);
3742    }
3743    if (toT)
3744    {
3745      for (i=0; i<=strat->sl; i++)
3746      {
3747        if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
3748        {
3749          h.p = redtailBba(strat->S[i],i-1,strat);
3750          if (TEST_OPT_INTSTRATEGY)
3751          {
3752            pCleardenom(h.p);// also does a pContent
3753          }
3754        }
3755        else
3756        {
3757          h.p = strat->S[i];
3758        }
3759        if (strat->honey)
3760        {
3761          strat->initEcart(&h);
3762          strat->ecartS[i] = h.ecart;
3763        }
3764        if (strat->sevS[i] == 0) {strat->sevS[i] = pGetShortExpVector(h.p);}
3765        else assume(strat->sevS[i] == pGetShortExpVector(h.p));
3766        h.sev = strat->sevS[i];
3767        h.SetpFDeg();
3768        /*puts the elements of S also to T*/
3769        enterT(h,strat);
3770        strat->S_2_R[i] = strat->tl;
3771      }
3772    }
3773  }
3774  else
3775  {
3776    while (suc != -1)
3777    {
3778      i=suc;
3779      while (i<=strat->sl)
3780      {
3781        if (((strat->syzComp==0) || (pGetComp(strat->S[i])<=strat->syzComp))
3782        && ((strat->fromQ==NULL) || (strat->fromQ[i]==0)))
3783        {
3784          pDelete(&redSi);
3785          redSi=pHead((strat->S)[i]);
3786          (strat->S)[i] = redMora((strat->S)[i],i-1,strat);
3787          if ((strat->S)[i]==NULL)
3788          {
3789            deleteInS(i,strat);
3790            i--;
3791          }
3792          else
3793          {
3794            if (TEST_OPT_INTSTRATEGY)
3795            {
3796              pDelete(&redSi);
3797              pCleardenom(strat->S[i]);// also does a pContent
3798              h.p = strat->S[i];
3799              strat->initEcart(&h);
3800              strat->ecartS[i] = h.ecart;
3801            }
3802            else
3803            {
3804              pDelete(&redSi);
3805              pNorm(strat->S[i]);
3806              h.p = strat->S[i];
3807              strat->initEcart(&h);
3808              strat->ecartS[i] = h.ecart;
3809            }
3810            h.sev =  pGetShortExpVector(h.p);
3811            strat->sevS[i] = h.sev;
3812          }
3813          kTest(strat);
3814        }
3815        i++;
3816      }
3817#ifdef KDEBUG
3818      kTest(strat);
3819#endif
3820      reorderS(&suc,strat);
3821      if (h.p!=NULL)
3822      {
3823        if (!strat->kHEdgeFound)
3824        {
3825          /*strat->kHEdgeFound =*/ HEckeTest(h.p,strat);
3826        }
3827        if (strat->kHEdgeFound)
3828          newHEdge(strat->S,strat);
3829      }
3830    }
3831    for (i=0; i<=strat->sl; i++)
3832    {
3833      if (((strat->fromQ==NULL) || (strat->fromQ[i]==0))
3834      )
3835      {
3836        strat->S[i] = h.p = redtail(strat->S[i],strat->sl,strat);
3837        strat->initEcart(&h);
3838        strat->ecartS[i] = h.ecart;
3839        h.sev = pGetShortExpVector(h.p);
3840        strat->sevS[i] = h.sev;
3841      }
3842      else
3843      {
3844        h.p = strat->S[i];
3845        h.ecart=strat->ecartS[i];
3846        h.sev = strat->sevS[i];
3847      }
3848      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
3849        cancelunit1(&h,&suc,strat->sl,strat);
3850      h.length = pLength(h.p);
3851      h.SetpFDeg();
3852      /*puts the elements of S also to T*/
3853      enterT(h,strat);
3854      strat->S_2_R[i] = strat->tl;
3855    }
3856    if (suc!= -1) updateS(toT,strat);
3857  }
3858  if (redSi!=NULL) pDeleteLm(&redSi);
3859#ifdef KDEBUG
3860  kTest(strat);
3861#endif
3862}
3863
3864
3865/*2
3866* -puts p to the standardbasis s at position at
3867* -saves the result in S
3868*/
3869void enterSBba (LObject p,int atS,kStrategy strat, int atR)
3870{
3871  int i;
3872  strat->news = TRUE;
3873  /*- puts p to the standardbasis s at position at -*/
3874  if (strat->sl == IDELEMS(strat->Shdl)-1)
3875  {
3876    strat->sevS = (unsigned long*) omRealloc0Size(strat->sevS,
3877                                    IDELEMS(strat->Shdl)*sizeof(unsigned long),
3878                                    (IDELEMS(strat->Shdl)+setmaxTinc)
3879                                                  *sizeof(unsigned long));
3880    strat->ecartS = (intset)omReallocSize(strat->ecartS,
3881                                          IDELEMS(strat->Shdl)*sizeof(int),
3882                                          (IDELEMS(strat->Shdl)+setmaxTinc)
3883                                                  *sizeof(int));
3884    strat->S_2_R = (int*) omRealloc0Size(strat->S_2_R,
3885                                         IDELEMS(strat->Shdl)*sizeof(int),
3886                                         (IDELEMS(strat->Shdl)+setmaxTinc)
3887                                                  *sizeof(int));
3888    if (strat->lenS!=NULL)
3889      strat->lenS=(int*)omRealloc0Size(strat->lenS,
3890                                       IDELEMS(strat->Shdl)*sizeof(int),
3891                                       (IDELEMS(strat->Shdl)+setmaxTinc)
3892                                                 *sizeof(int));
3893    if (strat->lenSw!=NULL)
3894      strat->lenSw=(wlen_type*)omRealloc0Size(strat->lenSw,
3895                                       IDELEMS(strat->Shdl)*sizeof(wlen_type),
3896                                       (IDELEMS(strat->Shdl)+setmaxTinc)
3897                                                 *sizeof(wlen_type));
3898    if (strat->fromQ!=NULL)
3899    {
3900      strat->fromQ = (intset)omReallocSize(strat->fromQ,
3901                                    IDELEMS(strat->Shdl)*sizeof(int),
3902                                    (IDELEMS(strat->Shdl)+setmaxTinc)*sizeof(int));
3903    }
3904    pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmaxTinc);
3905    IDELEMS(strat->Shdl)+=setmaxTinc;
3906    strat->Shdl->m=strat->S;
3907  }
3908  if (atS <= strat->sl)
3909  {
3910#ifdef ENTER_USE_MEMMOVE
3911// #if 0
3912    memmove(&(strat->S[atS+1]), &(strat->S[atS]),
3913            (strat->sl - atS + 1)*sizeof(poly));
3914    memmove(&(strat->ecartS[atS+1]), &(strat->ecartS[atS]),
3915            (strat->sl - atS + 1)*sizeof(int));
3916    memmove(&(strat->sevS[atS+1]), &(strat->sevS[atS]),
3917            (strat->sl - atS + 1)*sizeof(unsigned long));
3918    memmove(&(strat->S_2_R[atS+1]), &(strat->S_2_R[atS]),
3919            (strat->sl - atS + 1)*sizeof(int));
3920    if (strat->lenS!=NULL)
3921    memmove(&(strat->lenS[atS+1]), &(strat->lenS[atS]),
3922            (strat->sl - atS + 1)*sizeof(int));
3923    if (strat->lenSw!=NULL)
3924    memmove(&(strat->lenSw[atS+1]), &(strat->lenSw[atS]),
3925            (strat->sl - atS + 1)*sizeof(wlen_type));
3926#else
3927    for (i=strat->sl+1; i>=atS+1; i--)
3928    {
3929      strat->S[i] = strat->S[i-1];
3930      strat->ecartS[i] = strat->ecartS[i-1];
3931      strat->sevS[i] = strat->sevS[i-1];
3932      strat->S_2_R[i] = strat->S_2_R[i-1];
3933    }
3934    if (strat->lenS!=NULL)
3935    for (i=strat->sl+1; i>=atS+1; i--)
3936      strat->lenS[i] = strat->lenS[i-1];
3937    if (strat->lenSw!=NULL)
3938    for (i=strat->sl+1; i>=atS+1; i--)
3939      strat->lenSw[i] = strat->lenSw[i-1];
3940#endif
3941  }
3942  if (strat->fromQ!=NULL)
3943  {
3944#ifdef ENTER_USE_MEMMOVE
3945    memmove(&(strat->fromQ[atS+1]), &(strat->fromQ[atS]),
3946                  (strat->sl - atS + 1)*sizeof(int));
3947#else
3948    for (i=strat->sl+1; i>=atS+1; i--)
3949    {
3950      strat->fromQ[i] = strat->fromQ[i-1];
3951    }
3952#endif
3953    strat->fromQ[atS]=0;
3954  }
3955
3956  /*- save result -*/
3957  strat->S[atS] = p.p;
3958  if (strat->honey) strat->ecartS[atS] = p.ecart;
3959  if (p.sev == 0)
3960    p.sev = pGetShortExpVector(p.p);
3961  else
3962    assume(p.sev == pGetShortExpVector(p.p));
3963  strat->sevS[atS] = p.sev;
3964  strat->ecartS[atS] = p.ecart;
3965  strat->S_2_R[atS] = atR;
3966  strat->sl++;
3967}
3968
3969/*2
3970* puts p to the set T at position atT
3971*/
3972void enterT(LObject p, kStrategy strat, int atT)
3973{
3974  int i;
3975
3976  pp_Test(p.p, currRing, p.tailRing);
3977  assume(strat->tailRing == p.tailRing);
3978  // redMoraNF complains about this -- but, we don't really
3979  // neeed this so far
3980  // assume(p.pLength == 0 || pLength(p.p) == p.pLength);
3981  assume(p.FDeg == p.pFDeg());
3982  assume(!p.is_normalized || nIsOne(pGetCoeff(p.p)));
3983
3984  strat->newt = TRUE;
3985  if (atT < 0)
3986    atT = strat->posInT(strat->T, strat->tl, p);
3987  if (strat->tl == strat->tmax-1)
3988    enlargeT(strat->T,strat->R,strat->sevT,strat->tmax,setmaxTinc);
3989  if (atT <= strat->tl)
3990  {
3991#ifdef ENTER_USE_MEMMOVE
3992    memmove(&(strat->T[atT+1]), &(strat->T[atT]),
3993            (strat->tl-atT+1)*sizeof(TObject));
3994    memmove(&(strat->sevT[atT+1]), &(strat->sevT[atT]),
3995            (strat->tl-atT+1)*sizeof(unsigned long));
3996#endif
3997    for (i=strat->tl+1; i>=atT+1; i--)
3998    {
3999#ifndef ENTER_USE_MEMMOVE
4000      strat->T[i] = strat->T[i-1];
4001      strat->sevT[i] = strat->sevT[i-1];
4002#endif
4003      strat->R[strat->T[i].i_r] = &(strat->T[i]);
4004    }
4005  }
4006
4007  if (strat->tailBin != NULL && (pNext(p.p) != NULL))
4008  {
4009    pNext(p.p)=p_ShallowCopyDelete(pNext(p.p),
4010                                   (strat->tailRing != NULL ?
4011                                    strat->tailRing : currRing),
4012                                   strat->tailBin);
4013    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
4014  }
4015  strat->T[atT] = (TObject) p;
4016
4017  if (strat->tailRing != currRing && pNext(p.p) != NULL)
4018    strat->T[atT].max = p_GetMaxExpP(pNext(p.p), strat->tailRing);
4019  else
4020    strat->T[atT].max = NULL;
4021
4022  strat->tl++;
4023  strat->R[strat->tl] = &(strat->T[atT]);
4024  strat->T[atT].i_r = strat->tl;
4025  assume(p.sev == 0 || pGetShortExpVector(p.p) == p.sev);
4026  strat->sevT[atT] = (p.sev == 0 ? pGetShortExpVector(p.p) : p.sev);
4027  kTest_T(&(strat->T[atT]));
4028}
4029
4030void initHilbCrit(ideal F, ideal Q, intvec **hilb,kStrategy strat)
4031{
4032  if (strat->homog!=isHomog)
4033  {
4034    *hilb=NULL;
4035  }
4036}
4037
4038void initBuchMoraCrit(kStrategy strat)
4039{
4040  strat->sugarCrit =        TEST_OPT_SUGARCRIT;
4041  // obachman: Hmm.. I need BTEST1(2) for notBuckets ..
4042  //  strat->Gebauer =          BTEST1(2) || strat->homog || strat->sugarCrit;
4043  strat->Gebauer =          strat->homog || strat->sugarCrit;
4044  strat->honey =            !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
4045  if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
4046  strat->pairtest = NULL;
4047  /* alway use tailreduction, except:
4048  * - in local rings, - in lex order case, -in ring over extensions */
4049  strat->noTailReduction = !TEST_OPT_REDTAIL;
4050#ifdef HAVE_PLURAL
4051  // and r is plural_ring
4052  if (currRing->nc!=NULL)
4053    //or it has non-quasi-comm type... later
4054  {
4055    strat->sugarCrit = FALSE;
4056    strat->Gebauer = FALSE ;
4057    strat->honey = FALSE;
4058  }
4059#endif
4060  if (TEST_OPT_DEBUG)
4061  {
4062    if (strat->homog) PrintS("ideal/module is homogeneous\n");
4063    else              PrintS("ideal/module is not homogeneous\n");
4064  }
4065}
4066
4067BOOLEAN kPosInLDependsOnLength(int (*pos_in_l)
4068                               (const LSet set, const int length,
4069                                LObject* L,const kStrategy strat))
4070{
4071  if (pos_in_l == posInL110 ||
4072      pos_in_l == posInL10)
4073    return TRUE;
4074
4075  return FALSE;
4076}
4077
4078void initBuchMoraPos (kStrategy strat)
4079{
4080  if (pOrdSgn==1)
4081  {
4082    if (strat->honey)
4083    {
4084      strat->posInL = posInL15;
4085      // ok -- here is the deal: from my experiments for Singular-2-0
4086      // I conclude that that posInT_EcartpLength is the best of
4087      // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
4088      // see the table at the end of this file
4089      if (K_TEST_OPT_OLDSTD)
4090        strat->posInT = posInT15;
4091      else
4092        strat->posInT = posInT_EcartpLength;
4093    }
4094    else if (pLexOrder && !TEST_OPT_INTSTRATEGY)
4095    {
4096      strat->posInL = posInL11;
4097      strat->posInT = posInT11;
4098    }
4099    else if (TEST_OPT_INTSTRATEGY)
4100    {
4101      strat->posInL = posInL11;
4102      strat->posInT = posInT11;
4103    }
4104    else
4105    {
4106      strat->posInL = posInL0;
4107      strat->posInT = posInT0;
4108    }
4109    //if (strat->minim>0) strat->posInL =posInLSpecial;
4110    if (strat->homog)
4111    {
4112       strat->posInL = posInL110;
4113       strat->posInT = posInT110;
4114    }
4115  }
4116  else
4117  {
4118    if (strat->homog)
4119    {
4120      strat->posInL = posInL11;
4121      strat->posInT = posInT11;
4122    }
4123    else
4124    {
4125      if ((currRing->order[0]==ringorder_c)
4126      ||(currRing->order[0]==ringorder_C))
4127      {
4128        strat->posInL = posInL17_c;
4129        strat->posInT = posInT17_c;
4130      }
4131      else
4132      {
4133        strat->posInL = posInL17;
4134        strat->posInT = posInT17;
4135      }
4136    }
4137  }
4138  if (strat->minim>0) strat->posInL =posInLSpecial;
4139  // for further tests only
4140  if ((BTEST1(11)) || (BTEST1(12)))
4141    strat->posInL = posInL11;
4142  else if ((BTEST1(13)) || (BTEST1(14)))
4143    strat->posInL = posInL13;
4144  else if ((BTEST1(15)) || (BTEST1(16)))
4145    strat->posInL = posInL15;
4146  else if ((BTEST1(17)) || (BTEST1(18)))
4147    strat->posInL = posInL17;
4148  if (BTEST1(11))
4149    strat->posInT = posInT11;
4150  else if (BTEST1(13))
4151    strat->posInT = posInT13;
4152  else if (BTEST1(15))
4153    strat->posInT = posInT15;
4154  else if ((BTEST1(17)))
4155    strat->posInT = posInT17;
4156  else if ((BTEST1(19)))
4157    strat->posInT = posInT19;
4158  else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
4159    strat->posInT = posInT1;
4160  strat->posInLDependsOnLength = kPosInLDependsOnLength(strat->posInL);
4161}
4162
4163void initBuchMora (ideal F,ideal Q,kStrategy strat)
4164{
4165  strat->interpt = BTEST1(OPT_INTERRUPT);
4166  strat->kHEdge=NULL;
4167  if (pOrdSgn==1) strat->kHEdgeFound=FALSE;
4168  /*- creating temp data structures------------------- -*/
4169  strat->cp = 0;
4170  strat->c3 = 0;
4171  strat->tail = pInit();
4172  /*- set s -*/
4173  strat->sl = -1;
4174  /*- set L -*/
4175  strat->Lmax = setmaxL;
4176  strat->Ll = -1;
4177  strat->L = initL();
4178  /*- set B -*/
4179  strat->Bmax = setmaxL;
4180  strat->Bl = -1;
4181  strat->B = initL();
4182  /*- set T -*/
4183  strat->tl = -1;
4184  strat->tmax = setmaxT;
4185  strat->T = initT();
4186  strat->R = initR();
4187  strat->sevT = initsevT();
4188  /*- init local data struct.---------------------------------------- -*/
4189  strat->P.ecart=0;
4190  strat->P.length=0;
4191  if (pOrdSgn==-1)
4192  {
4193    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
4194    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
4195  }
4196  if(TEST_OPT_SB_1)
4197  {
4198    int i;
4199    ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
4200    for (i=strat->newIdeal;i<IDELEMS(F);i++)
4201    {
4202      P->m[i-strat->newIdeal] = F->m[i];
4203      F->m[i] = NULL;
4204    }
4205    initSSpecial(F,Q,P,strat);
4206    for (i=strat->newIdeal;i<IDELEMS(F);i++)
4207    {
4208      F->m[i] = P->m[i-strat->newIdeal];
4209      P->m[i-strat->newIdeal] = NULL;
4210    }
4211    idDelete(&P);
4212  }
4213  else
4214  {
4215    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
4216    // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
4217  }
4218  strat->kIdeal = NULL;
4219  strat->fromT = FALSE;
4220  strat->noTailReduction = !TEST_OPT_REDTAIL;
4221  if(!TEST_OPT_SB_1)
4222  {
4223    updateS(TRUE,strat);
4224    pairs(strat);
4225  }
4226  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
4227  strat->fromQ=NULL;
4228}
4229
4230void exitBuchMora (kStrategy strat)
4231{
4232  /*- release temp data -*/
4233  cleanT(strat);
4234  omFreeSize(strat->T,(strat->tmax)*sizeof(TObject));
4235  omFreeSize(strat->R,(strat->tmax)*sizeof(TObject*));
4236  omFreeSize(strat->sevT, (strat->tmax)*sizeof(unsigned long));
4237  omFreeSize(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
4238  omFreeSize(strat->sevS,IDELEMS(strat->Shdl)*sizeof(int));
4239  omFreeSize(strat->S_2_R,IDELEMS(strat->Shdl)*sizeof(int));
4240  /*- set L: should be empty -*/
4241  omFreeSize(strat->L,(strat->Lmax)*sizeof(LObject));
4242  /*- set B: should be empty -*/
4243  omFreeSize(strat->B,(strat->Bmax)*sizeof(LObject));
4244  pDeleteLm(&strat->tail);
4245  strat->syzComp=0;
4246  if (strat->kIdeal!=NULL)
4247  {
4248    omFreeBin(strat->kIdeal, sleftv_bin);
4249    strat->kIdeal=NULL;
4250  }
4251}
4252
4253/*2
4254* in the case of a standardbase of a module over a qring:
4255* replace polynomials in i by ak vectors,
4256* (the polynomial * unit vectors gen(1)..gen(ak)
4257* in every case (also for ideals:)
4258* deletes divisible vectors/polynomials
4259*/
4260void updateResult(ideal r,ideal Q, kStrategy strat)
4261{
4262  int l;
4263  if (strat->ak>0)
4264  {
4265    for (l=IDELEMS(r)-1;l>=0;l--)
4266    {
4267      if ((r->m[l]!=NULL) && (pGetComp(r->m[l])==0))
4268      {
4269        pDelete(&r->m[l]); // and set it to NULL
4270      }
4271    }
4272    int q;
4273    poly p;
4274    for (l=IDELEMS(r)-1;l>=0;l--)
4275    {
4276      if ((r->m[l]!=NULL)
4277      && (strat->syzComp>0)
4278      && (pGetComp(r->m[l])<=strat->syzComp))
4279      {
4280        for(q=IDELEMS(Q)-1; q>=0;q--)
4281        {
4282          if ((Q->m[q]!=NULL)
4283          &&(pLmDivisibleBy(Q->m[q],r->m[l])))
4284          {
4285            if (TEST_OPT_REDSB)
4286            {
4287              p=r->m[l];
4288              r->m[l]=kNF(Q,NULL,p);
4289              pDelete(&p);
4290            }
4291            else
4292            {
4293              pDelete(&r->m[l]); // and set it to NULL
4294            }
4295            break;
4296          }
4297        }
4298      }
4299    }
4300  }
4301  else
4302  {
4303    int q;
4304    poly p;
4305    for (l=IDELEMS(r)-1;l>=0;l--)
4306    {
4307      if (r->m[l]!=NULL)
4308      {
4309        for(q=IDELEMS(Q)-1; q>=0;q--)
4310        {
4311          if ((Q->m[q]!=NULL)
4312          &&(pLmEqual(r->m[l],Q->m[q])))
4313          {
4314            if (TEST_OPT_REDSB)
4315            {
4316              p=r->m[l];
4317              r->m[l]=kNF(Q,NULL,p);
4318              pDelete(&p);
4319            }
4320            else
4321            {
4322              pDelete(&r->m[l]); // and set it to NULL
4323            }
4324            break;
4325          }
4326        }
4327      }
4328    }
4329  }
4330  idSkipZeroes(r);
4331}
4332
4333void completeReduce (kStrategy strat)
4334{
4335  int i;
4336  int low = (pOrdSgn == 1 ? 1 : 0);
4337  LObject L;
4338
4339#ifdef KDEBUG
4340  // need to set this: during tailreductions of T[i], T[i].max is out of
4341  // sync
4342  sloppy_max = TRUE;
4343#endif
4344
4345  strat->noTailReduction = FALSE;
4346  if (TEST_OPT_PROT)
4347  {
4348    PrintLn();
4349    if (timerv) writeTime("standard base computed:");
4350  }
4351  if (TEST_OPT_PROT)
4352  {
4353    Print("(S:%d)",strat->sl);mflush();
4354  }
4355  for (i=strat->sl; i>=low; i--)
4356  {
4357    TObject* T_j = strat->s_2_t(i);
4358    if (T_j != NULL)
4359    {
4360      L = *T_j;
4361      poly p;
4362      if (pOrdSgn == 1)
4363        strat->S[i] = redtailBba(&L, i-1, strat, FALSE);
4364      else
4365        strat->S[i] = redtail(&L, strat->sl, strat);
4366
4367      if (strat->redTailChange && strat->tailRing != currRing)
4368      {
4369        if (T_j->max != NULL) p_LmFree(T_j->max, strat->tailRing);
4370        if (pNext(T_j->p) != NULL)
4371          T_j->max = p_GetMaxExpP(pNext(T_j->p), strat->tailRing);
4372        else
4373          T_j->max = NULL;
4374      }
4375      if (TEST_OPT_INTSTRATEGY)
4376        T_j->pCleardenom();
4377    }
4378    else
4379    {
4380      assume(currRing == strat->tailRing);
4381      if (pOrdSgn == 1)
4382        strat->S[i] = redtailBba(strat->S[i], i-1, strat);
4383      else
4384        strat->S[i] = redtail(strat->S[i], strat->sl, strat);
4385      if (TEST_OPT_INTSTRATEGY)
4386        pCleardenom(strat->S[i]);
4387    }
4388    if (TEST_OPT_PROT)
4389      PrintS("-");
4390  }
4391#ifdef KDEBUG
4392  sloppy_max = FALSE;
4393#endif
4394}
4395
4396
4397/*2
4398* computes the new strat->kHEdge and the new pNoether,
4399* returns TRUE, if pNoether has changed
4400*/
4401BOOLEAN newHEdge(polyset S, kStrategy strat)
4402{
4403  int i,j;
4404  poly newNoether;
4405
4406  scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
4407  if (strat->t_kHEdge != NULL) p_LmFree(strat->t_kHEdge, strat->tailRing);
4408  if (strat->tailRing != currRing)
4409    strat->t_kHEdge = k_LmInit_currRing_2_tailRing(strat->kHEdge, strat->tailRing);
4410  /* compare old and new noether*/
4411  newNoether = pLmInit(strat->kHEdge);
4412  j = pFDeg(newNoether,currRing);
4413  for (i=1; i<=pVariables; i++)
4414  {
4415    if (pGetExp(newNoether, i) > 0) pDecrExp(newNoether,i);
4416  }
4417  pSetm(newNoether);
4418  if (j < strat->HCord) /*- statistics -*/
4419  {
4420    if (TEST_OPT_PROT)
4421    {
4422      Print("H(%d)",j);
4423      mflush();
4424    }
4425    strat->HCord=j;
4426    if (TEST_OPT_DEBUG)
4427    {
4428      Print("H(%d):",j);
4429      wrp(strat->kHEdge);
4430      PrintLn();
4431    }
4432  }
4433  if (pCmp(strat->kNoether,newNoether)!=1)
4434  {
4435    pDelete(&strat->kNoether);
4436    strat->kNoether=newNoether;
4437    if (strat->t_kNoether != NULL) p_LmFree(strat->t_kNoether, strat->tailRing);
4438    if (strat->tailRing != currRing)
4439      strat->t_kNoether = k_LmInit_currRing_2_tailRing(strat->kNoether, strat->tailRing);
4440
4441    return TRUE;
4442  }
4443  pLmFree(newNoether);
4444  return FALSE;
4445}
4446
4447/***************************************************************
4448 *
4449 * Routines related for ring changes during std computations
4450 *
4451 ***************************************************************/
4452BOOLEAN kCheckSpolyCreation(LObject *L, kStrategy strat, poly &m1, poly &m2)
4453{
4454  assume(L->p1 != NULL && L->p2 != NULL);
4455  assume(L->i_r1 >= 0 && L->i_r1 <= strat->tl);
4456  assume(L->i_r2 >= 0 && L->i_r2 <= strat->tl);
4457  assume(strat->tailRing != currRing);
4458
4459  if (! k_GetLeadTerms(L->p1, L->p2, currRing, m1, m2, strat->tailRing))
4460    return FALSE;
4461  poly p1_max = (strat->R[L->i_r1])->max;
4462  poly p2_max = (strat->R[L->i_r2])->max;
4463
4464  if ((p1_max != NULL && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
4465      (p2_max != NULL && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
4466  {
4467    p_LmFree(m1, strat->tailRing);
4468    p_LmFree(m2, strat->tailRing);
4469    m1 = NULL;
4470    m2 = NULL;
4471    return FALSE;
4472  }
4473  return TRUE;
4474}
4475
4476BOOLEAN kStratChangeTailRing(kStrategy strat, LObject *L, TObject* T, unsigned long expbound)
4477{
4478  if (expbound == 0) expbound = strat->tailRing->bitmask << 1;
4479  if (expbound >= currRing->bitmask) return FALSE;
4480  ring new_tailRing = rModifyRing(currRing,
4481                                  // Hmmm .. the condition pFDeg == pDeg
4482                                  // might be too strong
4483                                  (strat->homog && pFDeg == pDeg),
4484                                  !strat->ak,
4485                                  expbound);
4486  if (new_tailRing == currRing) return TRUE;
4487
4488  strat->pOrigFDeg_TailRing = new_tailRing->pFDeg;
4489  strat->pOrigLDeg_TailRing = new_tailRing->pLDeg;
4490
4491  if (currRing->pFDeg != currRing->pFDegOrig)
4492  {
4493    new_tailRing->pFDeg = currRing->pFDeg;
4494    new_tailRing->pLDeg = currRing->pLDeg;
4495  }
4496
4497  if (TEST_OPT_PROT)
4498    Print("[%lu:%d", (unsigned long) new_tailRing->bitmask, new_tailRing->ExpL_Size);
4499  kTest_TS(strat);
4500  assume(new_tailRing != strat->tailRing);
4501  pShallowCopyDeleteProc p_shallow_copy_delete
4502    = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
4503
4504  omBin new_tailBin = omGetStickyBinOfBin(new_tailRing->PolyBin);
4505
4506  int i;
4507  for (i=0; i<=strat->tl; i++)
4508  {
4509    strat->T[i].ShallowCopyDelete(new_tailRing, new_tailBin,
4510                                  p_shallow_copy_delete);
4511  }
4512  for (i=0; i<=strat->Ll; i++)
4513  {
4514    assume(strat->L[i].p != NULL);
4515    if (pNext(strat->L[i].p) != strat->tail)
4516      strat->L[i].ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
4517  }
4518  if (strat->P.t_p != NULL ||
4519      (strat->P.p != NULL && pNext(strat->P.p) != strat->tail))
4520    strat->P.ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
4521
4522  if (L != NULL && L->tailRing != new_tailRing)
4523  {
4524    if (L->i_r < 0)
4525      L->ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
4526    else
4527    {
4528      assume(L->i_r <= strat->tl);
4529      TObject* t_l = strat->R[L->i_r];
4530      assume(t_l != NULL);
4531      L->tailRing = new_tailRing;
4532      L->p = t_l->p;
4533      L->t_p = t_l->t_p;
4534      L->max = t_l->max;
4535    }
4536  }
4537
4538  if (T != NULL && T->tailRing != new_tailRing && T->i_r < 0)
4539    T->ShallowCopyDelete(new_tailRing, new_tailBin, p_shallow_copy_delete);
4540
4541  omMergeStickyBinIntoBin(strat->tailBin, strat->tailRing->PolyBin);
4542  if (strat->tailRing != currRing)
4543    rKillModifiedRing(strat->tailRing);
4544
4545  strat->tailRing = new_tailRing;
4546  strat->tailBin = new_tailBin;
4547  strat->p_shallow_copy_delete
4548    = pGetShallowCopyDeleteProc(currRing, new_tailRing);
4549
4550  if (strat->kHEdge != NULL)
4551  {
4552    if (strat->t_kHEdge != NULL)
4553      p_LmFree(strat->t_kHEdge, strat->tailRing);
4554    strat->t_kHEdge=k_LmInit_currRing_2_tailRing(strat->kHEdge, new_tailRing);
4555  }
4556
4557  if (strat->kNoether != NULL)
4558  {
4559    if (strat->t_kNoether != NULL)
4560      p_LmFree(strat->t_kNoether, strat->tailRing);
4561    strat->t_kNoether=k_LmInit_currRing_2_tailRing(strat->kNoether,
4562                                                   new_tailRing);
4563  }
4564  kTest_TS(strat);
4565  if (TEST_OPT_PROT)
4566    PrintS("]");
4567  return TRUE;
4568}
4569
4570void kStratInitChangeTailRing(kStrategy strat)
4571{
4572  unsigned long l = 0;
4573  int i;
4574  Exponent_t e;
4575  ring new_tailRing;
4576
4577  assume(strat->tailRing == currRing);
4578
4579  for (i=0; i<= strat->Ll; i++)
4580  {
4581    l = p_GetMaxExpL(strat->L[i].p, currRing, l);
4582  }
4583  for (i=0; i<=strat->tl; i++)
4584  {
4585    // Hmm ... this we could do in one Step
4586    l = p_GetMaxExpL(strat->T[i].p, currRing, l);
4587  }
4588  e = p_GetMaxExp(l, currRing);
4589  if (e <= 1) e = 2;
4590
4591  kStratChangeTailRing(strat, NULL, NULL, e);
4592}
4593
4594skStrategy::skStrategy()
4595{
4596  memset(this, 0, sizeof(skStrategy));
4597#ifndef NDEBUG
4598  strat_nr++;
4599  nr=strat_nr;
4600  if (strat_fac_debug) Print("s(%d) created\n",nr);
4601#endif
4602  tailRing = currRing;
4603  P.tailRing = currRing;
4604  tl = -1;
4605  sl = -1;
4606#ifdef HAVE_LM_BIN
4607  lmBin = omGetStickyBinOfBin(currRing->PolyBin);
4608#endif
4609#ifdef HAVE_TAIL_BIN
4610  tailBin = omGetStickyBinOfBin(currRing->PolyBin);
4611#endif
4612  pOrigFDeg = pFDeg;
4613  pOrigLDeg = pLDeg;
4614}
4615
4616
4617skStrategy::~skStrategy()
4618{
4619  if (lmBin != NULL)
4620    omMergeStickyBinIntoBin(lmBin, currRing->PolyBin);
4621  if (tailBin != NULL)
4622    omMergeStickyBinIntoBin(tailBin,
4623                            (tailRing != NULL ? tailRing->PolyBin:
4624                             currRing->PolyBin));
4625  if (t_kHEdge != NULL)
4626    p_LmFree(t_kHEdge, tailRing);
4627  if (t_kNoether != NULL)
4628    p_LmFree(t_kNoether, tailRing);
4629
4630  if (currRing != tailRing)
4631    rKillModifiedRing(tailRing);
4632  pRestoreDegProcs(pOrigFDeg, pOrigLDeg);
4633}
4634
4635#if 0
4636Timings for the different possibilities of posInT:
4637            T15           EDL         DL          EL            L         1-2-3
4638Gonnet      43.26       42.30       38.34       41.98       38.40      100.04
4639Hairer_2_1   1.11        1.15        1.04        1.22        1.08        4.7
4640Twomat3      1.62        1.69        1.70        1.65        1.54       11.32
4641ahml         4.48        4.03        4.03        4.38        4.96       26.50
4642c7          15.02       13.98       15.16       13.24       17.31       47.89
4643c8         505.09      407.46      852.76      413.21      499.19        n/a
4644f855        12.65        9.27       14.97        8.78       14.23       33.12
4645gametwo6    11.47       11.35       14.57       11.20       12.02       35.07
4646gerhard_3    2.73        2.83        2.93        2.64        3.12        6.24
4647ilias13     22.89       22.46       24.62       20.60       23.34       53.86
4648noon8       40.68       37.02       37.99       36.82       35.59      877.16
4649rcyclic_19  48.22       42.29       43.99       45.35       51.51      204.29
4650rkat9       82.37       79.46       77.20       77.63       82.54      267.92
4651schwarz_11  16.46       16.81       16.76       16.81       16.72       35.56
4652test016     16.39       14.17       14.40       13.50       14.26       34.07
4653test017     34.70       36.01       33.16       35.48       32.75       71.45
4654test042     10.76       10.99       10.27       11.57       10.45       23.04
4655test058      6.78        6.75        6.51        6.95        6.22        9.47
4656test066     10.71       10.94       10.76       10.61       10.56       19.06
4657test073     10.75       11.11       10.17       10.79        8.63       58.10
4658test086     12.23       11.81       12.88       12.24       13.37       66.68
4659test103      5.05        4.80        5.47        4.64        4.89       11.90
4660test154     12.96       11.64       13.51       12.46       14.61       36.35
4661test162     65.27       64.01       67.35       59.79       67.54      196.46
4662test164      7.50        6.50        7.68        6.70        7.96       17.13
4663virasoro     3.39        3.50        3.35        3.47        3.70        7.66
4664#endif
4665
4666
4667#ifdef HAVE_MORE_POS_IN_T
4668// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
4669int posInT_EcartFDegpLength(const TSet set,const int length,LObject &p)
4670{
4671
4672  if (length==-1) return 0;
4673
4674  int o = p.ecart;
4675  int op=p.GetpFDeg();
4676  int ol = p.GetpLength();
4677
4678  if (set[length].ecart < o)
4679    return length+1;
4680  if (set[length].ecart == o)
4681  {
4682     int oo=set[length].GetpFDeg();
4683     if ((oo < op) || ((oo==op) && (set[length].length < ol)))
4684       return length+1;
4685  }
4686
4687  int i;
4688  int an = 0;
4689  int en= length;
4690  loop
4691  {
4692    if (an >= en-1)
4693    {
4694      if (set[an].ecart > o)
4695        return an;
4696      if (set[an].ecart == o)
4697      {
4698         int oo=set[an].GetpFDeg();
4699         if((oo > op)
4700         || ((oo==op) && (set[an].pLength > ol)))
4701           return an;
4702      }
4703      return en;
4704    }
4705    i=(an+en) / 2;
4706    if (set[i].ecart > o)
4707      en=i;
4708    else if (set[i].ecart == o)
4709    {
4710       int oo=set[i].GetpFDeg();
4711       if ((oo > op)
4712       || ((oo == op) && (set[i].pLength > ol)))
4713         en=i;
4714       else
4715        an=i;
4716    }
4717    else
4718      an=i;
4719  }
4720}
4721
4722// determines the position based on: 1.) FDeg 2.) pLength
4723int posInT_FDegpLength(const TSet set,const int length,LObject &p)
4724{
4725
4726  if (length==-1) return 0;
4727
4728  int op=p.GetpFDeg();
4729  int ol = p.GetpLength();
4730
4731  int oo=set[length].GetpFDeg();
4732  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
4733    return length+1;
4734
4735  int i;
4736  int an = 0;
4737  int en= length;
4738  loop
4739    {
4740      if (an >= en-1)
4741      {
4742        int oo=set[an].GetpFDeg();
4743        if((oo > op)
4744           || ((oo==op) && (set[an].pLength > ol)))
4745          return an;
4746        return en;
4747      }
4748      i=(an+en) / 2;
4749      int oo=set[i].GetpFDeg();
4750      if ((oo > op)
4751          || ((oo == op) && (set[i].pLength > ol)))
4752        en=i;
4753      else
4754        an=i;
4755    }
4756}
4757
4758
4759// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
4760int posInT_pLength(const TSet set,const int length,LObject &p)
4761{
4762  if (length==-1)
4763    return 0;
4764  if (set[length].length<p.length)
4765    return length+1;
4766
4767  int i;
4768  int an = 0;
4769  int en= length;
4770  int ol = p.GetpLength();
4771
4772  loop
4773  {
4774    if (an >= en-1)
4775    {
4776      if (set[an].pLength>ol) return an;
4777      return en;
4778    }
4779    i=(an+en) / 2;
4780    if (set[i].pLength>ol) en=i;
4781    else                        an=i;
4782  }
4783}
4784
4785#endif
4786
4787#endif // KUTIL_CC
Note: See TracBrowser for help on using the repository browser.