source: git/kernel/kutil.cc @ a16248b

spielwiese
Last change on this file since a16248b was a16248b, checked in by Hans Schönemann <hannes@…>, 18 years ago
*hannes: twoPow git-svn-id: file:///usr/local/Singular/svn/trunk@8943 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.17 2006-02-15 12:59:03 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
1597long twoPow(long arg)
1598{
1599  return 1L << arg;
1600}
1601
1602/*2
1603*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
1604*superfluous elements in S will be deleted
1605*/
1606void enterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
1607{
1608#ifdef HAVE_RING2TOM
1609  // enter also zero divisor * poly, if this is non zero and of smaller degree
1610  if (currRing->cring == 1)
1611  {
1612    if (((long) ((h)->coef)) % 2 == 0)
1613    {
1614      long a = ((long) ((h)->coef)) / 2;
1615      long b = currRing->ch - 1;
1616      poly p = p_Copy(h->next, strat->tailRing);
1617      while (a % 2 == 0)
1618      {
1619        a = a / 2;
1620        b--;
1621      }
1622      p = p_Mult_nn(p, (number) twoPow(b), strat->tailRing);
1623
1624      if (p != NULL)
1625      {
1626        if (TEST_OPT_PROT)
1627        {
1628          PrintS("Z");
1629        }
1630        poly tmp = p_ISet((long) ((p)->coef), currRing);
1631        for (int i = 1; i <= currRing->N; i++) {
1632          pSetExp(tmp, i, p_GetExp(p, i, strat->tailRing));
1633        }
1634        p_Setm(tmp, currRing);
1635        p = p_LmDeleteAndNext(p, strat->tailRing);
1636        pNext(tmp) = p;
1637
1638        LObject h;
1639        h.p = tmp;
1640        h.tailRing = strat->tailRing;
1641        if (TEST_OPT_INTSTRATEGY)
1642        {
1643          //pContent(h.p);
1644          h.pCleardenom(); // also does a pContent
1645        }
1646        else
1647        {
1648          h.pNorm();
1649        }
1650        strat->initEcart(&h);
1651        int posx;
1652        if (h.p!=NULL)
1653        {
1654          if (strat->Ll==-1)
1655            posx =0;
1656          else
1657              posx = strat->posInL(strat->L,strat->Ll,&h,strat);
1658          h.sev = pGetShortExpVector(h.p);
1659          h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
1660          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
1661        }
1662      }
1663    }
1664  }
1665#endif
1666  int j=pos;
1667
1668  initenterpairs(h,k,ecart,0,strat, atR);
1669  if ( (!strat->fromT)
1670  && ((strat->syzComp==0)
1671    ||(pGetComp(h)<=strat->syzComp)))
1672  {
1673    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
1674    unsigned long h_sev = pGetShortExpVector(h);
1675    loop
1676    {
1677      if (j > k) break;
1678      clearS(h,h_sev, &j,&k,strat);
1679      j++;
1680    }
1681    //Print("end clearS sl=%d\n",strat->sl);
1682  }
1683 // PrintS("end enterpairs\n");
1684}
1685
1686/*2
1687*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
1688*superfluous elements in S will be deleted
1689*/
1690void enterpairsSpecial (poly h,int k,int ecart,int pos,kStrategy strat, int atR = -1)
1691{
1692  int j;
1693
1694  for (j=0; j<=k; j++)
1695  {
1696    if ((pGetComp(h)==pGetComp(strat->S[j]))
1697    || (0==pGetComp(strat->S[j])))
1698    {
1699      enterOnePairSpecial(j,h,ecart,strat, atR);
1700    }
1701  }
1702  j=pos;
1703  loop
1704  {
1705    unsigned long h_sev = pGetShortExpVector(h);
1706    if (j > k) break;
1707    clearS(h,h_sev,&j,&k,strat);
1708    j++;
1709  }
1710}
1711
1712/*2
1713*constructs the pairset at the beginning
1714*of the buchberger/mora algorithm
1715*/
1716void pairs (kStrategy strat)
1717{
1718  int j,i;
1719//  Print("pairs:sl=%d\n",strat->sl);
1720//  for (i=0; i<=strat->sl; i++)
1721//  {
1722//    Print("s%d:",i);pWrite(strat->S[i]);
1723//  }
1724  if (strat->fromQ!=NULL)
1725  {
1726    for (i=1; i<=strat->sl; i++)
1727    {
1728      initenterpairs(strat->S[i],i-1,strat->ecartS[i],strat->fromQ[i],strat);
1729    }
1730  }
1731  else
1732  {
1733    for (i=1; i<=strat->sl; i++)
1734    {
1735      initenterpairs(strat->S[i],i-1,strat->ecartS[i],0,strat);
1736    }
1737  }
1738  /*deletes superfluous elements in S*/
1739  i = -1;
1740  loop
1741  {
1742    i++;
1743    if (i >= strat->sl) break;
1744    if ((strat->syzComp==0) || (pGetComp(strat->S[i])<=strat->syzComp))
1745    {
1746      j=i;
1747      loop
1748      {
1749        j++;
1750        if (j > strat->sl) break;
1751        if (pLmShortDivisibleBy(strat->S[i], strat->sevS[i],
1752                              strat->S[j], ~ strat->sevS[j]))
1753        {
1754        //  Print("delete %d=",j);
1755        //  wrp(strat->S[j]);
1756        //  Print(" wegen %d=",i);
1757        //  wrp(strat->S[i]);
1758        //  Print("( fromQ=%d)\n", (strat->fromQ) ? strat->fromQ[j]:0);
1759          if ((strat->fromQ==NULL) || (strat->fromQ[j]==0))
1760          {
1761            deleteInS(j,strat);
1762            j--;
1763          }
1764        }
1765      }
1766    }
1767  }
1768}
1769
1770/*2
1771*reorders  s with respect to posInS,
1772*suc is the first changed index or zero
1773*/
1774void reorderS (int* suc,kStrategy strat)
1775{
1776  int i,j,at,ecart, s2r;
1777  int fq=0;
1778  unsigned long sev;
1779  poly  p;
1780
1781  *suc = -1;
1782  for (i=1; i<=strat->sl; i++)
1783  {
1784    at = posInS(strat,i-1,strat->S[i],strat->ecartS[i]);
1785    if (at != i)
1786    {
1787      if ((*suc > at) || (*suc == -1)) *suc = at;
1788      p = strat->S[i];
1789      ecart = strat->ecartS[i];
1790      sev = strat->sevS[i];
1791      s2r = strat->S_2_R[i];
1792      if (strat->fromQ!=NULL) fq=strat->fromQ[i];
1793      for (j=i; j>=at+1; j--)
1794      {
1795        strat->S[j] = strat->S[j-1];
1796        strat->ecartS[j] = strat->ecartS[j-1];
1797        strat->sevS[j] = strat->sevS[j-1];
1798        strat->S_2_R[j] = strat->S_2_R[j-1];
1799      }
1800      strat->S[at] = p;
1801      strat->ecartS[at] = ecart;
1802      strat->sevS[at] = sev;
1803      strat->S_2_R[at] = s2r;
1804      if (strat->fromQ!=NULL)
1805      {
1806        for (j=i; j>=at+1; j--)
1807        {
1808          strat->fromQ[j] = strat->fromQ[j-1];
1809        }
1810        strat->fromQ[at]=fq;
1811      }
1812    }
1813  }
1814}
1815
1816
1817/*2
1818*looks up the position of p in set
1819*set[0] is the smallest with respect to the ordering-procedure
1820*pComp
1821* Assumption: posInS only depends on the leading term
1822*             otherwise, bba has to be changed
1823*/
1824int posInS (kStrategy strat, int length,poly p, int ecart_p)
1825{
1826  if(length==-1) return 0;
1827  polyset set=strat->S;
1828  int i;
1829  int an = 0;
1830  int en= length;
1831  int cmp_int=pOrdSgn;
1832  if (currRing->MixedOrder)
1833  {
1834    int o=pWTotaldegree(p);
1835    int oo=pWTotaldegree(set[length]);
1836
1837    if ((oo<o)
1838    || ((o==oo) && (pLmCmp(set[length],p)!= cmp_int)))
1839      return length+1;
1840
1841    loop
1842    {
1843      if (an >= en-1)
1844      {
1845        if ((pWTotaldegree(set[an])>=o) && (pLmCmp(set[an],p) == cmp_int))
1846        {
1847          return an;
1848        }
1849        return en;
1850      }
1851      i=(an+en) / 2;
1852      if ((pWTotaldegree(set[an])>=o)
1853      && (pLmCmp(set[i],p) == cmp_int)) en=i;
1854      else                              an=i;
1855    }
1856  }
1857  else
1858  {
1859    if (pLmCmp(set[length],p)== -cmp_int)
1860      return length+1;
1861
1862    loop
1863    {
1864      if (an >= en-1)
1865      {
1866        if (pLmCmp(set[an],p) == cmp_int) return an;
1867        if (pLmCmp(set[an],p) == -cmp_int) return en;
1868        if ((cmp_int!=1)
1869        && ((strat->ecartS[an])>ecart_p))
1870          return an;
1871        return en;
1872      }
1873      i=(an+en) / 2;
1874      if (pLmCmp(set[i],p) == cmp_int) en=i;
1875      else if (pLmCmp(set[i],p) == -cmp_int) an=i;
1876      else
1877      {
1878        if ((cmp_int!=1)
1879        &&((strat->ecartS[i])<ecart_p))
1880          en=i;
1881        else
1882          an=i;
1883      }
1884    }
1885  }
1886}
1887
1888
1889/*2
1890* looks up the position of p in set
1891* the position is the last one
1892*/
1893int posInT0 (const TSet set,const int length,LObject &p)
1894{
1895  return (length+1);
1896}
1897
1898
1899/*2
1900* looks up the position of p in T
1901* set[0] is the smallest with respect to the ordering-procedure
1902* pComp
1903*/
1904int posInT1 (const TSet set,const int length,LObject &p)
1905{
1906  if (length==-1) return 0;
1907
1908  if (pLmCmp(set[length].p,p.p)!= pOrdSgn) return length+1;
1909
1910  int i;
1911  int an = 0;
1912  int en= length;
1913
1914  loop
1915  {
1916    if (an >= en-1)
1917    {
1918      if (pLmCmp(set[an].p,p.p) == pOrdSgn) return an;
1919      return en;
1920    }
1921    i=(an+en) / 2;
1922    if (pLmCmp(set[i].p,p.p) == pOrdSgn) en=i;
1923    else                                 an=i;
1924  }
1925}
1926
1927/*2
1928* looks up the position of p in T
1929* set[0] is the smallest with respect to the ordering-procedure
1930* length
1931*/
1932int posInT2 (const TSet set,const int length,LObject &p)
1933{
1934  if (length==-1)
1935    return 0;
1936  if (set[length].length<p.length)
1937    return length+1;
1938
1939  int i;
1940  int an = 0;
1941  int en= length;
1942
1943  loop
1944  {
1945    if (an >= en-1)
1946    {
1947      if (set[an].length>p.length) return an;
1948      return en;
1949    }
1950    i=(an+en) / 2;
1951    if (set[i].length>p.length) en=i;
1952    else                        an=i;
1953  }
1954}
1955
1956/*2
1957* looks up the position of p in T
1958* set[0] is the smallest with respect to the ordering-procedure
1959* totaldegree,pComp
1960*/
1961int posInT11 (const TSet set,const int length,LObject &p)
1962/*{
1963 * int j=0;
1964 * int o;
1965 *
1966 * o = p.GetpFDeg();
1967 * loop
1968 * {
1969 *   if ((pFDeg(set[j].p) > o)
1970 *   || ((pFDeg(set[j].p) == o) && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
1971 *   {
1972 *     return j;
1973 *   }
1974 *   j++;
1975 *   if (j > length) return j;
1976 * }
1977 *}
1978 */
1979{
1980  if (length==-1) return 0;
1981
1982  int o = p.GetpFDeg();
1983  int op = set[length].GetpFDeg();
1984
1985  if ((op < o)
1986  || ((op == o) && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
1987    return length+1;
1988
1989  int i;
1990  int an = 0;
1991  int en= length;
1992
1993  loop
1994  {
1995    if (an >= en-1)
1996    {
1997      op= set[an].GetpFDeg();
1998      if ((op > o)
1999      || (( op == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
2000        return an;
2001      return en;
2002    }
2003    i=(an+en) / 2;
2004    op = set[i].GetpFDeg();
2005    if (( op > o)
2006    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
2007      en=i;
2008    else
2009      an=i;
2010  }
2011}
2012
2013/*2
2014* looks up the position of p in T
2015* set[0] is the smallest with respect to the ordering-procedure
2016* totaldegree,pComp
2017*/
2018int posInT110 (const TSet set,const int length,LObject &p)
2019{
2020  if (length==-1) return 0;
2021
2022  int o = p.GetpFDeg();
2023  int op = set[length].GetpFDeg();
2024
2025  if (( op < o)
2026  || (( op == o) && (set[length].length<p.length))
2027  || (( op == o) && (set[length].length == p.length)
2028     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
2029    return length+1;
2030
2031  int i;
2032  int an = 0;
2033  int en= length;
2034  loop
2035  {
2036    if (an >= en-1)
2037    {
2038      op = set[an].GetpFDeg();
2039      if (( op > o)
2040      || (( op == o) && (set[an].length > p.length))
2041      || (( op == o) && (set[an].length == p.length)
2042         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
2043        return an;
2044      return en;
2045    }
2046    i=(an+en) / 2;
2047    op = set[i].GetpFDeg();
2048    if (( op > o)
2049    || (( op == o) && (set[i].length > p.length))
2050    || (( op == o) && (set[i].length == p.length)
2051       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
2052      en=i;
2053    else
2054      an=i;
2055  }
2056}
2057
2058/*2
2059* looks up the position of p in set
2060* set[0] is the smallest with respect to the ordering-procedure
2061* pFDeg
2062*/
2063int posInT13 (const TSet set,const int length,LObject &p)
2064{
2065  if (length==-1) return 0;
2066
2067  int o = p.GetpFDeg();
2068
2069  if (set[length].GetpFDeg() <= o)
2070    return length+1;
2071
2072  int i;
2073  int an = 0;
2074  int en= length;
2075  loop
2076  {
2077    if (an >= en-1)
2078    {
2079      if (set[an].GetpFDeg() > o)
2080        return an;
2081      return en;
2082    }
2083    i=(an+en) / 2;
2084    if (set[i].GetpFDeg() > o)
2085      en=i;
2086    else
2087      an=i;
2088  }
2089}
2090
2091// determines the position based on: 1.) Ecart 2.) pLength
2092int posInT_EcartpLength(const TSet set,const int length,LObject &p)
2093{
2094  if (length==-1) return 0;
2095
2096  int op=p.ecart;
2097  int ol = p.GetpLength();
2098
2099  int oo=set[length].ecart;
2100  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
2101    return length+1;
2102
2103  int i;
2104  int an = 0;
2105  int en= length;
2106  loop
2107    {
2108      if (an >= en-1)
2109      {
2110        int oo=set[an].ecart;
2111        if((oo > op)
2112           || ((oo==op) && (set[an].pLength > ol)))
2113          return an;
2114        return en;
2115      }
2116      i=(an+en) / 2;
2117      int oo=set[i].ecart;
2118      if ((oo > op)
2119          || ((oo == op) && (set[i].pLength > ol)))
2120        en=i;
2121      else
2122        an=i;
2123    }
2124}
2125
2126/*2
2127* looks up the position of p in set
2128* set[0] is the smallest with respect to the ordering-procedure
2129* maximaldegree, pComp
2130*/
2131int posInT15 (const TSet set,const int length,LObject &p)
2132/*{
2133 *int j=0;
2134 * int o;
2135 *
2136 * o = p.GetpFDeg()+p.ecart;
2137 * loop
2138 * {
2139 *   if ((set[j].GetpFDeg()+set[j].ecart > o)
2140 *   || ((set[j].GetpFDeg()+set[j].ecart == o)
2141 *     && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
2142 *   {
2143 *     return j;
2144 *   }
2145 *   j++;
2146 *   if (j > length) return j;
2147 * }
2148 *}
2149 */
2150{
2151  if (length==-1) return 0;
2152
2153  int o = p.GetpFDeg() + p.ecart;
2154  int op = set[length].GetpFDeg()+set[length].ecart;
2155
2156  if ((op < o)
2157  || ((op == o)
2158     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
2159    return length+1;
2160
2161  int i;
2162  int an = 0;
2163  int en= length;
2164  loop
2165  {
2166    if (an >= en-1)
2167    {
2168      op = set[an].GetpFDeg()+set[an].ecart;
2169      if (( op > o)
2170      || (( op  == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
2171        return an;
2172      return en;
2173    }
2174    i=(an+en) / 2;
2175    op = set[i].GetpFDeg()+set[i].ecart;
2176    if (( op > o)
2177    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
2178      en=i;
2179    else
2180      an=i;
2181  }
2182}
2183
2184/*2
2185* looks up the position of p in set
2186* set[0] is the smallest with respect to the ordering-procedure
2187* pFDeg+ecart, ecart, pComp
2188*/
2189int posInT17 (const TSet set,const int length,LObject &p)
2190/*
2191*{
2192* int j=0;
2193* int  o;
2194*
2195*  o = p.GetpFDeg()+p.ecart;
2196*  loop
2197*  {
2198*    if ((pFDeg(set[j].p)+set[j].ecart > o)
2199*    || (((pFDeg(set[j].p)+set[j].ecart == o)
2200*      && (set[j].ecart < p.ecart)))
2201*    || ((pFDeg(set[j].p)+set[j].ecart == o)
2202*      && (set[j].ecart==p.ecart)
2203*      && (pLmCmp(set[j].p,p.p)==pOrdSgn)))
2204*      return j;
2205*    j++;
2206*    if (j > length) return j;
2207*  }
2208* }
2209*/
2210{
2211  if (length==-1) return 0;
2212
2213  int o = p.GetpFDeg() + p.ecart;
2214  int op = set[length].GetpFDeg()+set[length].ecart;
2215
2216  if ((op < o)
2217  || (( op == o) && (set[length].ecart > p.ecart))
2218  || (( op == o) && (set[length].ecart==p.ecart)
2219     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
2220    return length+1;
2221
2222  int i;
2223  int an = 0;
2224  int en= length;
2225  loop
2226  {
2227    if (an >= en-1)
2228    {
2229      op = set[an].GetpFDeg()+set[an].ecart;
2230      if (( op > o)
2231      || (( op == o) && (set[an].ecart < p.ecart))
2232      || (( op  == o) && (set[an].ecart==p.ecart)
2233         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
2234        return an;
2235      return en;
2236    }
2237    i=(an+en) / 2;
2238    op = set[i].GetpFDeg()+set[i].ecart;
2239    if ((op > o)
2240    || (( op == o) && (set[i].ecart < p.ecart))
2241    || (( op == o) && (set[i].ecart == p.ecart)
2242       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
2243      en=i;
2244    else
2245      an=i;
2246  }
2247}
2248/*2
2249* looks up the position of p in set
2250* set[0] is the smallest with respect to the ordering-procedure
2251* pGetComp, pFDeg+ecart, ecart, pComp
2252*/
2253int posInT17_c (const TSet set,const int length,LObject &p)
2254{
2255  if (length==-1) return 0;
2256
2257  int cc = (-1+2*currRing->order[0]==ringorder_c);
2258  /* cc==1 for (c,..), cc==-1 for (C,..) */
2259  int o = p.GetpFDeg() + p.ecart;
2260  int c = pGetComp(p.p)*cc;
2261
2262  if (pGetComp(set[length].p)*cc < c)
2263    return length+1;
2264  if (pGetComp(set[length].p)*cc == c)
2265  {
2266    int op = set[length].GetpFDeg()+set[length].ecart;
2267    if ((op < o)
2268    || ((op == o) && (set[length].ecart > p.ecart))
2269    || ((op == o) && (set[length].ecart==p.ecart)
2270       && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
2271      return length+1;
2272  }
2273
2274  int i;
2275  int an = 0;
2276  int en= length;
2277  loop
2278  {
2279    if (an >= en-1)
2280    {
2281      if (pGetComp(set[an].p)*cc < c)
2282        return en;
2283      if (pGetComp(set[an].p)*cc == c)
2284      {
2285        int op = set[an].GetpFDeg()+set[an].ecart;
2286        if ((op > o)
2287        || ((op == o) && (set[an].ecart < p.ecart))
2288        || ((op == o) && (set[an].ecart==p.ecart)
2289           && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
2290          return an;
2291      }
2292      return en;
2293    }
2294    i=(an+en) / 2;
2295    if (pGetComp(set[i].p)*cc > c)
2296      en=i;
2297    else if (pGetComp(set[i].p)*cc == c)
2298    {
2299      int op = set[i].GetpFDeg()+set[i].ecart;
2300      if ((op > o)
2301      || ((op == o) && (set[i].ecart < p.ecart))
2302      || ((op == o) && (set[i].ecart == p.ecart)
2303         && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
2304        en=i;
2305      else
2306        an=i;
2307    }
2308    else
2309      an=i;
2310  }
2311}
2312
2313/*2
2314* looks up the position of p in set
2315* set[0] is the smallest with respect to
2316* ecart, pFDeg, length
2317*/
2318int posInT19 (const TSet set,const int length,LObject &p)
2319{
2320  if (length==-1) return 0;
2321
2322  int o = p.ecart;
2323  int op=p.GetpFDeg();
2324
2325  if (set[length].ecart < o)
2326    return length+1;
2327  if (set[length].ecart == o)
2328  {
2329     int oo=set[length].GetpFDeg();
2330     if ((oo < op) || ((oo==op) && (set[length].length < p.length)))
2331       return length+1;
2332  }
2333
2334  int i;
2335  int an = 0;
2336  int en= length;
2337  loop
2338  {
2339    if (an >= en-1)
2340    {
2341      if (set[an].ecart > o)
2342        return an;
2343      if (set[an].ecart == o)
2344      {
2345         int oo=set[an].GetpFDeg();
2346         if((oo > op)
2347         || ((oo==op) && (set[an].length > p.length)))
2348           return an;
2349      }
2350      return en;
2351    }
2352    i=(an+en) / 2;
2353    if (set[i].ecart > o)
2354      en=i;
2355    else if (set[i].ecart == o)
2356    {
2357       int oo=set[i].GetpFDeg();
2358       if ((oo > op)
2359       || ((oo == op) && (set[i].length > p.length)))
2360         en=i;
2361       else
2362        an=i;
2363    }
2364    else
2365      an=i;
2366  }
2367}
2368
2369/*2
2370*looks up the position of polynomial p in set
2371*set[length] is the smallest element in set with respect
2372*to the ordering-procedure pComp
2373*/
2374int posInLSpecial (const LSet set, const int length,
2375                   LObject *p,const kStrategy strat)
2376{
2377  if (length<0) return 0;
2378
2379  int d=p->GetpFDeg();
2380  int op=set[length].GetpFDeg();
2381
2382  if ((op > d)
2383  || ((op == d) && (p->p1!=NULL)&&(set[length].p1==NULL))
2384  || (pLmCmp(set[length].p,p->p)== pOrdSgn))
2385     return length+1;
2386
2387  int i;
2388  int an = 0;
2389  int en= length;
2390  loop
2391  {
2392    if (an >= en-1)
2393    {
2394      op=set[an].GetpFDeg();
2395      if ((op > d)
2396      || ((op == d) && (p->p1!=NULL) && (set[an].p1==NULL))
2397      || (pLmCmp(set[an].p,p->p)== pOrdSgn))
2398         return en;
2399      return an;
2400    }
2401    i=(an+en) / 2;
2402    op=set[i].GetpFDeg();
2403    if ((op>d)
2404    || ((op==d) && (p->p1!=NULL) && (set[i].p1==NULL))
2405    || (pLmCmp(set[i].p,p->p) == pOrdSgn))
2406      an=i;
2407    else
2408      en=i;
2409  }
2410}
2411
2412/*2
2413*looks up the position of polynomial p in set
2414*set[length] is the smallest element in set with respect
2415*to the ordering-procedure pComp
2416*/
2417int posInL0 (const LSet set, const int length,
2418             LObject* p,const kStrategy strat)
2419{
2420  if (length<0) return 0;
2421
2422  if (pLmCmp(set[length].p,p->p)== pOrdSgn)
2423    return length+1;
2424
2425  int i;
2426  int an = 0;
2427  int en= length;
2428  loop
2429  {
2430    if (an >= en-1)
2431    {
2432      if (pLmCmp(set[an].p,p->p) == pOrdSgn) return en;
2433      return an;
2434    }
2435    i=(an+en) / 2;
2436    if (pLmCmp(set[i].p,p->p) == pOrdSgn) an=i;
2437    else                                 en=i;
2438    /*aend. fuer lazy == in !=- machen */
2439  }
2440}
2441
2442/*2
2443* looks up the position of polynomial p in set
2444* e is the ecart of p
2445* set[length] is the smallest element in set with respect
2446* to the ordering-procedure totaldegree,pComp
2447*/
2448int posInL11 (const LSet set, const int length,
2449              LObject* p,const kStrategy strat)
2450/*{
2451 * int j=0;
2452 * int o;
2453 *
2454 * o = p->GetpFDeg();
2455 * loop
2456 * {
2457 *   if (j > length)            return j;
2458 *   if ((set[j].GetpFDeg() < o)) return j;
2459 *   if ((set[j].GetpFDeg() == o) && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
2460 *   {
2461 *     return j;
2462 *   }
2463 *   j++;
2464 * }
2465 *}
2466 */
2467{
2468  if (length<0) return 0;
2469
2470  int o = p->GetpFDeg();
2471  int op = set[length].GetpFDeg();
2472
2473  if ((op > o)
2474  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
2475    return length+1;
2476  int i;
2477  int an = 0;
2478  int en= length;
2479  loop
2480  {
2481    if (an >= en-1)
2482    {
2483      op = set[an].GetpFDeg();
2484      if ((op > o)
2485      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
2486        return en;
2487      return an;
2488    }
2489    i=(an+en) / 2;
2490    op = set[i].GetpFDeg();
2491    if ((op > o)
2492    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
2493      an=i;
2494    else
2495      en=i;
2496  }
2497}
2498
2499/*2
2500* looks up the position of polynomial p in set
2501* set[length] is the smallest element in set with respect
2502* to the ordering-procedure totaldegree,pLength0
2503*/
2504int posInL110 (const LSet set, const int length,
2505               LObject* p,const kStrategy strat)
2506{
2507  if (length<0) return 0;
2508
2509  int o = p->GetpFDeg();
2510  int op = set[length].GetpFDeg();
2511
2512  if ((op > o)
2513  || ((op == o) && (set[length].length >p->length))
2514  || ((op == o) && (set[length].length <= p->length)
2515     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
2516    return length+1;
2517  int i;
2518  int an = 0;
2519  int en= length;
2520  loop
2521  {
2522    if (an >= en-1)
2523    {
2524      op = set[an].GetpFDeg();
2525      if ((op > o)
2526      || ((op == o) && (set[an].length >p->length))
2527      || ((op == o) && (set[an].length <=p->length)
2528         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
2529        return en;
2530      return an;
2531    }
2532    i=(an+en) / 2;
2533    op = set[i].GetpFDeg();
2534    if ((op > o)
2535    || ((op == o) && (set[i].length > p->length))
2536    || ((op == o) && (set[i].length <= p->length)
2537       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
2538      an=i;
2539    else
2540      en=i;
2541  }
2542}
2543
2544/*2
2545* looks up the position of polynomial p in set
2546* e is the ecart of p
2547* set[length] is the smallest element in set with respect
2548* to the ordering-procedure totaldegree
2549*/
2550int posInL13 (const LSet set, const int length,
2551              LObject* p,const kStrategy strat)
2552{
2553  if (length<0) return 0;
2554
2555  int o = p->GetpFDeg();
2556
2557  if (set[length].GetpFDeg() > o)
2558    return length+1;
2559
2560  int i;
2561  int an = 0;
2562  int en= length;
2563  loop
2564  {
2565    if (an >= en-1)
2566    {
2567      if (set[an].GetpFDeg() >= o)
2568        return en;
2569      return an;
2570    }
2571    i=(an+en) / 2;
2572    if (set[i].GetpFDeg() >= o)
2573      an=i;
2574    else
2575      en=i;
2576  }
2577}
2578
2579/*2
2580* looks up the position of polynomial p in set
2581* e is the ecart of p
2582* set[length] is the smallest element in set with respect
2583* to the ordering-procedure maximaldegree,pComp
2584*/
2585int posInL15 (const LSet set, const int length,
2586              LObject* p,const kStrategy strat)
2587/*{
2588 * int j=0;
2589 * int o;
2590 *
2591 * o = p->ecart+p->GetpFDeg();
2592 * loop
2593 * {
2594 *   if (j > length)                       return j;
2595 *   if (set[j].GetpFDeg()+set[j].ecart < o) return j;
2596 *   if ((set[j].GetpFDeg()+set[j].ecart == o)
2597 *   && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
2598 *   {
2599 *     return j;
2600 *   }
2601 *   j++;
2602 * }
2603 *}
2604 */
2605{
2606  if (length<0) return 0;
2607
2608  int o = p->GetpFDeg() + p->ecart;
2609  int op = set[length].GetpFDeg() + set[length].ecart;
2610
2611  if ((op > o)
2612  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
2613    return length+1;
2614  int i;
2615  int an = 0;
2616  int en= length;
2617  loop
2618  {
2619    if (an >= en-1)
2620    {
2621      op = set[an].GetpFDeg() + set[an].ecart;
2622      if ((op > o)
2623      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
2624        return en;
2625      return an;
2626    }
2627    i=(an+en) / 2;
2628    op = set[i].GetpFDeg() + set[i].ecart;
2629    if ((op > o)
2630    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
2631      an=i;
2632    else
2633      en=i;
2634  }
2635}
2636
2637/*2
2638* looks up the position of polynomial p in set
2639* e is the ecart of p
2640* set[length] is the smallest element in set with respect
2641* to the ordering-procedure totaldegree
2642*/
2643int posInL17 (const LSet set, const int length,
2644              LObject* p,const kStrategy strat)
2645{
2646  if (length<0) return 0;
2647
2648  int o = p->GetpFDeg() + p->ecart;
2649
2650  if ((set[length].GetpFDeg() + set[length].ecart > o)
2651  || ((set[length].GetpFDeg() + set[length].ecart == o)
2652     && (set[length].ecart > p->ecart))
2653  || ((set[length].GetpFDeg() + set[length].ecart == o)
2654     && (set[length].ecart == p->ecart)
2655     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
2656    return length+1;
2657  int i;
2658  int an = 0;
2659  int en= length;
2660  loop
2661  {
2662    if (an >= en-1)
2663    {
2664      if ((set[an].GetpFDeg() + set[an].ecart > o)
2665      || ((set[an].GetpFDeg() + set[an].ecart == o)
2666         && (set[an].ecart > p->ecart))
2667      || ((set[an].GetpFDeg() + set[an].ecart == o)
2668         && (set[an].ecart == p->ecart)
2669         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
2670        return en;
2671      return an;
2672    }
2673    i=(an+en) / 2;
2674    if ((set[i].GetpFDeg() + set[i].ecart > o)
2675    || ((set[i].GetpFDeg() + set[i].ecart == o)
2676       && (set[i].ecart > p->ecart))
2677    || ((set[i].GetpFDeg() +set[i].ecart == o)
2678       && (set[i].ecart == p->ecart)
2679       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
2680      an=i;
2681    else
2682      en=i;
2683  }
2684}
2685/*2
2686* looks up the position of polynomial p in set
2687* e is the ecart of p
2688* set[length] is the smallest element in set with respect
2689* to the ordering-procedure pComp
2690*/
2691int posInL17_c (const LSet set, const int length,
2692                LObject* p,const kStrategy strat)
2693{
2694  if (length<0) return 0;
2695
2696  int cc = (-1+2*currRing->order[0]==ringorder_c);
2697  /* cc==1 for (c,..), cc==-1 for (C,..) */
2698  int c = pGetComp(p->p)*cc;
2699  int o = p->GetpFDeg() + p->ecart;
2700
2701  if (pGetComp(set[length].p)*cc > c)
2702    return length+1;
2703  if (pGetComp(set[length].p)*cc == c)
2704  {
2705    if ((set[length].GetpFDeg() + set[length].ecart > o)
2706    || ((set[length].GetpFDeg() + set[length].ecart == o)
2707       && (set[length].ecart > p->ecart))
2708    || ((set[length].GetpFDeg() + set[length].ecart == o)
2709       && (set[length].ecart == p->ecart)
2710       && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
2711      return length+1;
2712  }
2713  int i;
2714  int an = 0;
2715  int en= length;
2716  loop
2717  {
2718    if (an >= en-1)
2719    {
2720      if (pGetComp(set[an].p)*cc > c)
2721        return en;
2722      if (pGetComp(set[an].p)*cc == c)
2723      {
2724        if ((set[an].GetpFDeg() + set[an].ecart > o)
2725        || ((set[an].GetpFDeg() + set[an].ecart == o)
2726           && (set[an].ecart > p->ecart))
2727        || ((set[an].GetpFDeg() + set[an].ecart == o)
2728           && (set[an].ecart == p->ecart)
2729           && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
2730          return en;
2731      }
2732      return an;
2733    }
2734    i=(an+en) / 2;
2735    if (pGetComp(set[i].p)*cc > c)
2736      an=i;
2737    else if (pGetComp(set[i].p)*cc == c)
2738    {
2739      if ((set[i].GetpFDeg() + set[i].ecart > o)
2740      || ((set[i].GetpFDeg() + set[i].ecart == o)
2741         && (set[i].ecart > p->ecart))
2742      || ((set[i].GetpFDeg() +set[i].ecart == o)
2743         && (set[i].ecart == p->ecart)
2744         && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
2745        an=i;
2746      else
2747        en=i;
2748    }
2749    else
2750      en=i;
2751  }
2752}
2753
2754/***************************************************************
2755 *
2756 * Tail reductions
2757 *
2758 ***************************************************************/
2759TObject*
2760kFindDivisibleByInS(kStrategy strat, int pos, LObject* L, TObject *T,
2761                    long ecart)
2762{
2763  int j = 0;
2764  const unsigned long not_sev = ~L->sev;
2765  const unsigned long* sev = strat->sevS;
2766  poly p;
2767  ring r;
2768  L->GetLm(p, r);
2769
2770  assume(~not_sev == p_GetShortExpVector(p, r));
2771
2772  if (r == currRing)
2773  {
2774    loop
2775    {
2776      if (j > pos) return NULL;
2777#if defined(PDEBUG) || defined(PDIV_DEBUG)
2778      if (p_LmShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
2779          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
2780        break;
2781#else
2782      if (!(sev[j] & not_sev) &&
2783          (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
2784          p_LmDivisibleBy(strat->S[j], p, r))
2785        break;
2786
2787#endif
2788      j++;
2789    }
2790    // if called from NF, T objects do not exist:
2791    if (strat->tl < 0 || strat->S_2_R[j] == -1)
2792    {
2793      T->Set(strat->S[j], r, strat->tailRing);
2794      return T;
2795    }
2796    else
2797    {
2798      assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL &&
2799              strat->S_2_T(j)->p == strat->S[j]);
2800      return strat->S_2_T(j);
2801    }
2802  }
2803  else
2804  {
2805    TObject* t;
2806    loop
2807    {
2808      if (j > pos) return NULL;
2809      assume(strat->S_2_R[j] != -1);
2810#if defined(PDEBUG) || defined(PDIV_DEBUG)
2811      t = strat->S_2_T(j);
2812      assume(t != NULL && t->t_p != NULL && t->tailRing == r);
2813      if (p_LmShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
2814          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
2815        return t;
2816#else
2817      if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
2818      {
2819        t = strat->S_2_T(j);
2820        assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
2821        if (p_LmDivisibleBy(t->t_p, p, r)) return t;
2822      }
2823#endif
2824      j++;
2825    }
2826  }
2827}
2828/*
2829#ifdef HAVE_RING2TOM
2830TObject*
2831kRingFindDivisibleByInS(kStrategy strat, int pos, LObject* L, TObject *T,
2832                    long ecart)
2833{
2834  int j = 0;
2835  const unsigned long not_sev = ~L->sev;
2836  const unsigned long* sev = strat->sevS;
2837  poly p;
2838  ring r;
2839  L->GetLm(p, r);
2840
2841  assume(~not_sev == p_GetShortExpVector(p, r));
2842
2843  if (r == currRing)
2844  {
2845    loop
2846    {
2847      if (j > pos) return NULL;
2848#if defined(PDEBUG) || defined(PDIV_DEBUG)
2849      if (p_LmRingShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
2850          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
2851        break;
2852#else
2853      if (!(sev[j] & not_sev) &&
2854          (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
2855          p_LmRingDivisibleBy(strat->S[j], p, r))
2856        break;
2857
2858#endif
2859      j++;
2860    }
2861    // if called from NF, T objects do not exist:
2862    if (strat->tl < 0 || strat->S_2_R[j] == -1)
2863    {
2864      T->Set(strat->S[j], r, strat->tailRing);
2865      return T;
2866    }
2867    else
2868    {
2869      assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL &&
2870              strat->S_2_T(j)->p == strat->S[j]);
2871      return strat->S_2_T(j);
2872    }
2873  }
2874  else
2875  {
2876    TObject* t;
2877    loop
2878    {
2879      if (j > pos) return NULL;
2880      assume(strat->S_2_R[j] != -1);
2881#if defined(PDEBUG) || defined(PDIV_DEBUG)
2882      t = strat->S_2_T(j);
2883      assume(t != NULL && t->t_p != NULL && t->tailRing == r);
2884      if (p_LmRingShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
2885          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
2886        return t;
2887#else
2888      if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
2889      {
2890        t = strat->S_2_T(j);
2891        assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
2892        if (p_LmRingDivisibleBy(t->t_p, p, r)) return t;
2893      }
2894#endif
2895      j++;
2896    }
2897  }
2898}
2899#endif
2900*/
2901
2902poly redtail (LObject* L, int pos, kStrategy strat)
2903{
2904  poly h, hn;
2905  int j;
2906  unsigned long not_sev;
2907  strat->redTailChange=FALSE;
2908
2909  poly p = L->p;
2910  if (strat->noTailReduction || pNext(p) == NULL)
2911    return p;
2912
2913  LObject Ln(strat->tailRing);
2914  TObject* With;
2915  // placeholder in case strat->tl < 0
2916  TObject  With_s(strat->tailRing);
2917  h = p;
2918  hn = pNext(h);
2919  long op = strat->tailRing->pFDeg(hn, strat->tailRing);
2920  long e;
2921  int l;
2922  BOOLEAN save_HE=strat->kHEdgeFound;
2923  strat->kHEdgeFound |=
2924    ((Kstd1_deg>0) && (op<=Kstd1_deg)) || TEST_OPT_INFREDTAIL;
2925
2926  while(hn != NULL)
2927  {
2928    op = strat->tailRing->pFDeg(hn, strat->tailRing);
2929    if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
2930    e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
2931    loop
2932    {
2933      Ln.Set(hn, strat->tailRing);
2934      Ln.sev = p_GetShortExpVector(hn, strat->tailRing);
2935      if (strat->kHEdgeFound)
2936        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
2937      else
2938        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s, e);
2939      if (With == NULL) break;
2940      strat->redTailChange=TRUE;
2941      if (ksReducePolyTail(L, With, h, strat->kNoetherTail()))
2942      {
2943        // reducing the tail would violate the exp bound
2944        if (kStratChangeTailRing(strat, L))
2945        {
2946          strat->kHEdgeFound = save_HE;
2947          return redtail(L, pos, strat);
2948        }
2949        else
2950          return NULL;
2951      }
2952      hn = pNext(h);
2953      if (hn == NULL) goto all_done;
2954      op = strat->tailRing->pFDeg(hn, strat->tailRing);
2955      if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
2956      e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
2957    }
2958    h = hn;
2959    hn = pNext(h);
2960  }
2961
2962  all_done:
2963  if (strat->redTailChange)
2964  {
2965    L->last = 0;
2966    L->pLength = 0;
2967  }
2968  strat->kHEdgeFound = save_HE;
2969  return p;
2970}
2971
2972poly redtail (poly p, int pos, kStrategy strat)
2973{
2974  LObject L(p, currRing);
2975  return redtail(&L, pos, strat);
2976}
2977
2978poly redtailBba (LObject* L, int pos, kStrategy strat, BOOLEAN withT)
2979{
2980  strat->redTailChange=FALSE;
2981  if (strat->noTailReduction) return L->GetLmCurrRing();
2982  poly h, p;
2983  p = h = L->GetLmTailRing();
2984  if ((h==NULL) || (pNext(h)==NULL))
2985    return L->GetLmCurrRing();
2986
2987  TObject* With;
2988  // placeholder in case strat->tl < 0
2989  TObject  With_s(strat->tailRing);
2990
2991  LObject Ln(pNext(h), strat->tailRing);
2992  Ln.pLength = L->GetpLength() - 1;
2993
2994  pNext(h) = NULL;
2995  if (L->p != NULL) pNext(L->p) = NULL;
2996  L->pLength = 1;
2997
2998  Ln.PrepareRed(strat->use_buckets);
2999
3000  while(!Ln.IsNull())
3001  {
3002    loop
3003    {
3004      Ln.SetShortExpVector();
3005      if (! withT)
3006      {
3007/* obsolete
3008#ifdef HAVE_RING2TOM
3009        if (currRing->cring == 1) {
3010            With = kRingFindDivisibleByInS(strat, pos, &Ln, &With_s);
3011        } else
3012#endif
3013*/
3014            With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
3015        if (With == NULL) break;
3016      }
3017      else
3018      {
3019        int j;
3020/* Obsolete
3021#ifdef HAVE_RING2TOM
3022        if (currRing->cring == 1) {
3023           j = kRingFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
3024        } else
3025#endif
3026*/
3027           j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
3028        if (j < 0) break;
3029        With = &(strat->T[j]);
3030      }
3031      if (ksReducePolyTail(L, With, &Ln))
3032      {
3033        // reducing the tail would violate the exp bound
3034        pNext(h) = Ln.GetTP();
3035        L->pLength += Ln.GetpLength();
3036        if (L->p != NULL) pNext(L->p) = pNext(p);
3037        if (kStratChangeTailRing(strat, L))
3038          return redtailBba(L, pos, strat, withT);
3039        else
3040        { // should never get here -- need to fix this
3041          assume(0);
3042          return NULL;
3043        }
3044      }
3045      strat->redTailChange=TRUE;
3046      if (Ln.IsNull()) goto all_done;
3047      if (! withT) With_s.Init(currRing);
3048    }
3049    pNext(h) = Ln.LmExtractAndIter();
3050    pIter(h);
3051    L->pLength++;
3052  }
3053
3054  all_done:
3055  if (L->p != NULL) pNext(L->p) = pNext(p);
3056  assume(pLength(L->p != NULL ? L->p : L->t_p) == L->pLength);
3057
3058  if (strat->redTailChange)
3059  {
3060    L->last = NULL;
3061    L->length = 0;
3062  }
3063  L->Normalize(); // HANNES: should have a test
3064  kTest_L(L);
3065  return L->GetLmCurrRing();
3066}
3067
3068/*2
3069*checks the change degree and write progress report
3070*/
3071void message (int i,int* reduc,int* olddeg,kStrategy strat, int red_result)
3072{
3073  if (i != *olddeg)
3074  {
3075    Print("%d",i);
3076    *olddeg = i;
3077  }
3078  if (K_TEST_OPT_OLDSTD)
3079  {
3080    if (strat->Ll != *reduc)
3081    {
3082      if (strat->Ll != *reduc-1)
3083        Print("(%d)",strat->Ll+1);
3084      else
3085        PrintS("-");
3086      *reduc = strat->Ll;
3087    }
3088    else
3089      PrintS(".");
3090    mflush();
3091  }
3092  else
3093  {
3094    if (red_result == 0)
3095      PrintS("-");
3096    else if (red_result < 0)
3097      PrintS(".");
3098    if ((red_result > 0) || ((strat->Ll % 100)==99))
3099    {
3100      if (strat->Ll != *reduc && strat->Ll > 0)
3101      {
3102        Print("(%d)",strat->Ll+1);
3103        *reduc = strat->Ll;
3104      }
3105    }
3106  }
3107}
3108
3109/*2
3110*statistics
3111*/
3112void messageStat (int srmax,int lrmax,int hilbcount,kStrategy strat)
3113{
3114  //PrintS("\nUsage/Allocation of temporary storage:\n");
3115  //Print("%d/%d polynomials in standard base\n",srmax,IDELEMS(Shdl));
3116  //Print("%d/%d polynomials in set L (for lazy alg.)",lrmax+1,strat->Lmax);
3117  Print("\nproduct criterion:%d chain criterion:%d\n",strat->cp,strat->c3);
3118  if (hilbcount!=0) Print("hilbert series criterion:%d\n",hilbcount);
3119  /*mflush();*/
3120}
3121
3122#ifdef KDEBUG
3123/*2
3124*debugging output: all internal sets, if changed
3125*for testing purpuse only/has to be changed for later use
3126*/
3127void messageSets (kStrategy strat)
3128{
3129  int i;
3130  if (strat->news)
3131  {
3132    PrintS("set S");
3133    for (i=0; i<=strat->sl; i++)
3134    {
3135      Print("\n  %d:",i);
3136      p_wrp(strat->S[i], currRing, strat->tailRing);
3137    }
3138    strat->news = FALSE;
3139  }
3140  if (strat->newt)
3141  {
3142    PrintS("\nset T");
3143    for (i=0; i<=strat->tl; i++)
3144    {
3145      Print("\n  %d:",i);
3146      strat->T[i].wrp();
3147      Print(" o:%d e:%d l:%d",
3148        strat->T[i].pFDeg(),strat->T[i].ecart,strat->T[i].length);
3149    }
3150    strat->newt = FALSE;
3151  }
3152  PrintS("\nset L");
3153  for (i=strat->Ll; i>=0; i--)
3154  {
3155    Print("\n%d:",i);
3156    p_wrp(strat->L[i].p1, currRing, strat->tailRing);
3157    PrintS("  ");
3158    p_wrp(strat->L[i].p2, currRing, strat->tailRing);
3159    PrintS(" lcm: ");p_wrp(strat->L[i].lcm, currRing);
3160    PrintS("\n  p : ");
3161    strat->L[i].wrp();
3162    Print("  o:%d e:%d l:%d",
3163          strat->L[i].pFDeg(),strat->L[i].ecart,strat->L[i].length);
3164  }
3165  PrintLn();
3166}
3167
3168#endif
3169
3170
3171/*2
3172*construct the set s from F
3173*/
3174void initS (ideal F, ideal Q,kStrategy strat)
3175{
3176  int   i,pos;
3177
3178  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
3179  else i=setmaxT;
3180  strat->ecartS=initec(i);
3181  strat->sevS=initsevS(i);
3182  strat->S_2_R=initS_2_R(i);
3183  strat->fromQ=NULL;
3184  strat->Shdl=idInit(i,F->rank);
3185  strat->S=strat->Shdl->m;
3186  /*- put polys into S -*/
3187  if (Q!=NULL)
3188  {
3189    strat->fromQ=initec(i);
3190    memset(strat->fromQ,0,i*sizeof(int));
3191    for (i=0; i<IDELEMS(Q); i++)
3192    {
3193      if (Q->m[i]!=NULL)
3194      {
3195        LObject h;
3196        h.p = pCopy(Q->m[i]);
3197        if (TEST_OPT_INTSTRATEGY)
3198        {
3199          //pContent(h.p);
3200          h.pCleardenom(); // also does a pContent
3201        }
3202        else
3203        {
3204          h.pNorm();
3205        }
3206        strat->initEcart(&h);
3207        if (pOrdSgn==-1)
3208        {
3209          deleteHC(&h, strat);
3210        }
3211        if (h.p!=NULL)
3212        {
3213          if (strat->sl==-1)
3214            pos =0;
3215          else
3216          {
3217            pos = posInS(strat,strat->sl,h.p,h.ecart);
3218          }
3219          h.sev = pGetShortExpVector(h.p);
3220          strat->enterS(h,pos,strat,-1);
3221          strat->fromQ[pos]=1;
3222        }
3223      }
3224    }
3225  }
3226  for (i=0; i<IDELEMS(F); i++)
3227  {
3228    if (F->m[i]!=NULL)
3229    {
3230      LObject h;
3231      h.p = pCopy(F->m[i]);
3232      if (TEST_OPT_INTSTRATEGY)
3233      {
3234        //pContent(h.p);
3235        h.pCleardenom(); // also does a pContent
3236      }
3237      else
3238      {
3239        h.pNorm();
3240      }
3241      strat->initEcart(&h);
3242      if (pOrdSgn==-1)
3243      {
3244        cancelunit(&h);  /*- tries to cancel a unit -*/
3245        deleteHC(&h, strat);
3246      }
3247      if (h.p!=NULL)
3248      {
3249        if (strat->sl==-1)
3250          pos =0;
3251        else
3252          pos = posInS(strat,strat->sl,h.p,h.ecart);
3253        h.sev = pGetShortExpVector(h.p);
3254        strat->enterS(h,pos,strat,-1);
3255      }
3256    }
3257  }
3258  /*- test, if a unit is in F -*/
3259  if ((strat->sl>=0) && pIsConstant(strat->S[0]))
3260  {
3261    while (strat->sl>0) deleteInS(strat->sl,strat);
3262  }
3263}
3264
3265void initSL (ideal F, ideal Q,kStrategy strat)
3266{
3267  int   i,pos;
3268
3269  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
3270  else i=setmaxT;
3271  strat->ecartS=initec(i);
3272  strat->sevS=initsevS(i);
3273  strat->S_2_R=initS_2_R(i);
3274  strat->fromQ=NULL;
3275  strat->Shdl=idInit(i,F->rank);
3276  strat->S=strat->Shdl->m;
3277  /*- put polys into S -*/
3278  if (Q!=NULL)
3279  {
3280    strat->fromQ=initec(i);
3281    memset(strat->fromQ,0,i*sizeof(int));
3282    for (i=0; i<IDELEMS(Q); i++)
3283    {
3284      if (Q->m[i]!=NULL)
3285      {
3286        LObject h;
3287        h.p = pCopy(Q->m[i]);
3288        if (TEST_OPT_INTSTRATEGY)
3289        {
3290          //pContent(h.p);
3291          h.pCleardenom(); // also does a pContent
3292        }
3293        else
3294        {
3295          h.pNorm();
3296        }
3297        strat->initEcart(&h);
3298        if (pOrdSgn==-1)
3299        {
3300          deleteHC(&h,strat);
3301        }
3302        if (h.p!=NULL)
3303        {
3304          if (strat->sl==-1)
3305            pos =0;
3306          else
3307          {
3308            pos = posInS(strat,strat->sl,h.p,h.ecart);
3309          }
3310          h.sev = pGetShortExpVector(h.p);
3311          strat->enterS(h,pos,strat,-1);
3312          strat->fromQ[pos]=1;
3313        }
3314      }
3315    }
3316  }
3317  for (i=0; i<IDELEMS(F); i++)
3318  {
3319    if (F->m[i]!=NULL)
3320    {
3321      LObject h;
3322      h.p = pCopy(F->m[i]);
3323      if (TEST_OPT_INTSTRATEGY)
3324      {
3325        //pContent(h.p);
3326        h.pCleardenom(); // also does a pContent
3327      }
3328      else
3329      {
3330        h.pNorm();
3331      }
3332      strat->initEcart(&h);
3333      if (pOrdSgn==-1)
3334      {
3335        cancelunit(&h);  /*- tries to cancel a unit -*/
3336        deleteHC(&h, strat);
3337      }
3338      if (h.p!=NULL)
3339      {
3340        if (strat->Ll==-1)
3341          pos =0;
3342        else
3343          pos = strat->posInL(strat->L,strat->Ll,&h,strat);
3344        h.sev = pGetShortExpVector(h.p);
3345        enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
3346      }
3347    }
3348  }
3349  /*- test, if a unit is in F -*/
3350  if ((strat->Ll>=0) && pIsConstant(strat->L[strat->Ll].p))
3351  {
3352    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
3353  }
3354}
3355
3356
3357/*2
3358*construct the set s from F and {P}
3359*/
3360void initSSpecial (ideal F, ideal Q, ideal P,kStrategy strat)
3361{
3362  int   i,pos;
3363
3364  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
3365  else i=setmaxT;
3366  i=((i+IDELEMS(F)+15)/16)*16;
3367  strat->ecartS=initec(i);
3368  strat->sevS=initsevS(i);
3369  strat->S_2_R=initS_2_R(i);
3370  strat->fromQ=NULL;
3371  strat->Shdl=idInit(i,F->rank);
3372  strat->S=strat->Shdl->m;
3373
3374  /*- put polys into S -*/
3375  if (Q!=NULL)
3376  {
3377    strat->fromQ=initec(i);
3378    memset(strat->fromQ,0,i*sizeof(int));
3379    for (i=0; i<IDELEMS(Q); i++)
3380    {
3381      if (Q->m[i]!=NULL)
3382      {
3383        LObject h;
3384        h.p = pCopy(Q->m[i]);
3385        //if (TEST_OPT_INTSTRATEGY)
3386        //{
3387        //  //pContent(h.p);
3388        //  h.pCleardenom(); // also does a pContent
3389        //}
3390        //else
3391        //{
3392        //  h.pNorm();
3393        //}
3394        strat->initEcart(&h);
3395        if (pOrdSgn==-1)
3396        {
3397          deleteHC(&h,strat);
3398        }
3399        if (h.p!=NULL)
3400        {
3401          if (strat->sl==-1)
3402            pos =0;
3403          else
3404          {
3405            pos = posInS(strat,strat->sl,h.p,h.ecart);
3406          }
3407          h.sev = pGetShortExpVector(h.p);
3408          h.SetpFDeg();
3409          strat->enterS(h,pos,strat, strat->tl+1);
3410          enterT(h, strat);
3411          strat->fromQ[pos]=1;
3412        }
3413      }
3414    }
3415  }
3416  /*- put polys into S -*/
3417  for (i=0; i<IDELEMS(F); i++)
3418  {
3419    if (F->m[i]!=NULL)
3420    {
3421      LObject h;
3422      h.p = pCopy(F->m[i]);
3423      if (pOrdSgn==1)
3424      {
3425        h.p=redtailBba(h.p,strat->sl,strat);
3426      }
3427      strat->initEcart(&h);
3428      if (pOrdSgn==-1)
3429      {
3430        deleteHC(&h,strat);
3431      }
3432      if (h.p!=NULL)
3433      {
3434        if (strat->sl==-1)
3435          pos =0;
3436        else
3437          pos = posInS(strat,strat->sl,h.p,h.ecart);
3438        h.sev = pGetShortExpVector(h.p);
3439        strat->enterS(h,pos,strat, strat->tl+1);
3440        h.length = pLength(h.p);
3441        h.SetpFDeg();
3442        enterT(h,strat);
3443      }
3444    }
3445  }
3446  for (i=0; i<IDELEMS(P); i++)
3447  {
3448    if (P->m[i]!=NULL)
3449    {
3450      LObject h;
3451      h.p=pCopy(P->m[i]);
3452      strat->initEcart(&h);
3453      h.length = pLength(h.p);
3454      if (TEST_OPT_INTSTRATEGY)
3455      {
3456        h.pCleardenom();
3457      }
3458      else
3459      {
3460        h.pNorm();
3461      }
3462      if(strat->sl>=0)
3463      {
3464        if (pOrdSgn==1)
3465        {
3466          h.p=redBba(h.p,strat->sl,strat);
3467          if (h.p!=NULL)
3468            h.p=redtailBba(h.p,strat->sl,strat);
3469        }
3470        else
3471        {
3472          h.p=redMora(h.p,strat->sl,strat);
3473          strat->initEcart(&h);
3474        }
3475        if(h.p!=NULL)
3476        {
3477          if (TEST_OPT_INTSTRATEGY)
3478          {
3479            h.pCleardenom();
3480          }
3481          else
3482          {
3483            h.is_normalized = 0;
3484            h.pNorm();
3485          }
3486          h.sev = pGetShortExpVector(h.p);
3487          h.SetpFDeg();
3488          pos = posInS(strat,strat->sl,h.p,h.ecart);
3489          enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
3490          strat->enterS(h,pos,strat, strat->tl+1);
3491          enterT(h,strat);
3492        }
3493      }
3494      else
3495      {
3496        h.sev = pGetShortExpVector(h.p);
3497        h.SetpFDeg();
3498        strat->enterS(h,0,strat, strat->tl+1);
3499        enterT(h,strat);
3500      }
3501    }
3502  }
3503}
3504/*2
3505* reduces h using the set S
3506* procedure used in cancelunit1
3507*/
3508static poly redBba1 (poly h,int maxIndex,kStrategy strat)
3509{
3510  int j = 0;
3511  unsigned long not_sev = ~ pGetShortExpVector(h);
3512
3513  while (j <= maxIndex)
3514  {
3515    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j],h, not_sev))
3516       return ksOldSpolyRedNew(strat->S[j],h,strat->kNoetherTail());
3517    else j++;
3518  }
3519  return h;
3520}
3521
3522/*2
3523*tests if p.p=monomial*unit and cancels the unit
3524*/
3525void cancelunit1 (LObject* p,int *suc, int index,kStrategy strat )
3526{
3527  int k;
3528  poly r,h,h1,q;
3529
3530  if (!pIsVector((*p).p) && ((*p).ecart != 0))
3531  {
3532    k = 0;
3533    h1 = r = pCopy((*p).p);
3534    h =pNext(r);
3535    loop
3536    {
3537      if (h==NULL)
3538      {
3539        pDelete(&r);
3540        pDelete(&(pNext((*p).p)));
3541        (*p).ecart = 0;
3542        (*p).length = 1;
3543        (*suc)=0;
3544        return;
3545      }
3546      if (!pDivisibleBy(r,h))
3547      {
3548        q=redBba1(h,index ,strat);
3549        if (q != h)
3550        {
3551          k++;
3552          pDelete(&h);
3553          pNext(h1) = h = q;
3554        }
3555        else
3556        {
3557          pDelete(&r);
3558          return;
3559        }
3560      }
3561      else
3562      {
3563        h1 = h;
3564        pIter(h);
3565      }
3566      if (k > 10)
3567      {
3568        pDelete(&r);
3569        return;
3570      }
3571    }
3572  }
3573}
3574
3575/*2
3576* reduces h using the elements from Q in the set S
3577* procedure used in updateS
3578* must not be used for elements of Q or elements of an ideal !
3579*/
3580static poly redQ (poly h, int j, kStrategy strat)
3581{
3582  int start;
3583  unsigned long not_sev = ~ pGetShortExpVector(h);
3584  while ((j <= strat->sl) && (pGetComp(strat->S[j])!=0)) j++;
3585  start=j;
3586  while (j<=strat->sl)
3587  {
3588    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
3589    {
3590      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
3591      if (h==NULL) return NULL;
3592      j = start;
3593      not_sev = ~ pGetShortExpVector(h);
3594    }
3595    else j++;
3596  }
3597  return h;
3598}
3599
3600/*2
3601* reduces h using the set S
3602* procedure used in updateS
3603*/
3604static poly redBba (poly h,int maxIndex,kStrategy strat)
3605{
3606  int j = 0;
3607  unsigned long not_sev = ~ pGetShortExpVector(h);
3608
3609  while (j <= maxIndex)
3610  {
3611#ifdef HAVE_RING2TOM
3612    if ((currRing->cring == 1 && pLmRingShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev)) ||
3613        (currRing->cring == 0 && pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev)))
3614#else
3615    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
3616#endif
3617    {
3618      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
3619      if (h==NULL) return NULL;
3620      j = 0;
3621      not_sev = ~ pGetShortExpVector(h);    }
3622    else j++;
3623  }
3624  return h;
3625}
3626
3627/*2
3628* reduces h using the set S
3629*e is the ecart of h
3630*procedure used in updateS
3631*/
3632static poly redMora (poly h,int maxIndex,kStrategy strat)
3633{
3634  int  j=0;
3635  int  e,l;
3636  unsigned long not_sev = ~ pGetShortExpVector(h);
3637
3638  if (maxIndex >= 0)
3639  {
3640    e = pLDeg(h,&l,currRing)-pFDeg(h,currRing);
3641    do
3642    {
3643      if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev)
3644      && ((e >= strat->ecartS[j]) || strat->kHEdgeFound))
3645      {
3646#ifdef KDEBUG
3647        if (TEST_OPT_DEBUG)
3648          {PrintS("reduce ");wrp(h);Print(" with S[%d] (",j);wrp(strat->S[j]);}
3649
3650#endif
3651        h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
3652#ifdef KDEBUG
3653        if(TEST_OPT_DEBUG)
3654          {PrintS(")\nto "); wrp(h); PrintLn();}
3655
3656#endif
3657        // pDelete(&h);
3658        if (h == NULL) return NULL;
3659        e = pLDeg(h,&l,currRing)-pFDeg(h,currRing);
3660        j = 0;
3661        not_sev = ~ pGetShortExpVector(h);
3662      }
3663      else j++;
3664    }
3665    while (j <= maxIndex);
3666  }
3667  return h;
3668}
3669
3670/*2
3671*updates S:
3672*the result is a set of polynomials which are in
3673*normalform with respect to S
3674*/
3675void updateS(BOOLEAN toT,kStrategy strat)
3676{
3677  LObject h;
3678  int i, suc=0;
3679  poly redSi=NULL;
3680//  Print("nach initS: updateS start mit sl=%d\n",(strat->sl));
3681//  for (i=0; i<=(strat->sl); i++)
3682//  {
3683//    Print("s%d:",i);
3684//    if (strat->fromQ!=NULL) Print("(Q:%d) ",strat->fromQ[i]);
3685//    pWrite(strat->S[i]);
3686//  }
3687//  Print("pOrdSgn=%d\n", pOrdSgn);
3688  if (pOrdSgn==1)
3689  {
3690    while (suc != -1)
3691    {
3692      i=suc+1;
3693      while (i<=strat->sl)
3694      {
3695        if (((strat->syzComp==0) || (pGetComp(strat->S[i])<=strat->syzComp))
3696        && ((strat->fromQ==NULL) || (strat->fromQ[i]==0)))
3697        {
3698          pDelete(&redSi);
3699          redSi = pHead(strat->S[i]);
3700          strat->S[i] = redBba(strat->S[i],i-1,strat);
3701          if ((strat->ak!=0)&&(strat->S[i]!=NULL))
3702            strat->S[i]=redQ(strat->S[i],i+1,strat); /*reduce S[i] mod Q*/
3703          if (TEST_OPT_DEBUG && (pCmp(redSi,strat->S[i])!=0))
3704          {
3705            PrintS("reduce:");
3706            wrp(redSi);PrintS(" to ");p_wrp(strat->S[i], currRing, strat->tailRing);PrintLn();
3707          }
3708          if (TEST_OPT_PROT && (pCmp(redSi,strat->S[i])!=0))
3709          {
3710            if (strat->S[i]==NULL)
3711              PrintS("V");
3712            else
3713              PrintS("v");
3714            mflush();
3715          }
3716          if (strat->S[i]==NULL)
3717          {
3718            pDelete(&redSi);
3719            deleteInS(i,strat);
3720            i--;
3721          }
3722          else
3723          {
3724            pDelete(&redSi);
3725            if (TEST_OPT_INTSTRATEGY)
3726            {
3727              //pContent(strat->S[i]);
3728              pCleardenom(strat->S[i]);// also does a pContent
3729            }
3730            else
3731            {
3732              pNorm(strat->S[i]);
3733            }
3734            strat->sevS[i] = pGetShortExpVector(strat->S[i]);
3735          }
3736        }
3737        i++;
3738      }
3739      reorderS(&suc,strat);
3740    }
3741    if (toT)
3742    {
3743      for (i=0; i<=strat->sl; i++)
3744      {
3745        if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
3746        {
3747          h.p = redtailBba(strat->S[i],i-1,strat);
3748          if (TEST_OPT_INTSTRATEGY)
3749          {
3750            pCleardenom(h.p);// also does a pContent
3751          }
3752        }
3753        else
3754        {
3755          h.p = strat->S[i];
3756        }
3757        if (strat->honey)
3758        {
3759          strat->initEcart(&h);
3760          strat->ecartS[i] = h.ecart;
3761        }
3762        if (strat->sevS[i] == 0) {strat->sevS[i] = pGetShortExpVector(h.p);}
3763        else assume(strat->sevS[i] == pGetShortExpVector(h.p));
3764        h.sev = strat->sevS[i];
3765        h.SetpFDeg();
3766        /*puts the elements of S also to T*/
3767        enterT(h,strat);
3768        strat->S_2_R[i] = strat->tl;
3769      }
3770    }
3771  }
3772  else
3773  {
3774    while (suc != -1)
3775    {
3776      i=suc;
3777      while (i<=strat->sl)
3778      {
3779        if (((strat->syzComp==0) || (pGetComp(strat->S[i])<=strat->syzComp))
3780        && ((strat->fromQ==NULL) || (strat->fromQ[i]==0)))
3781        {
3782          pDelete(&redSi);
3783          redSi=pHead((strat->S)[i]);
3784          (strat->S)[i] = redMora((strat->S)[i],i-1,strat);
3785          if ((strat->S)[i]==NULL)
3786          {
3787            deleteInS(i,strat);
3788            i--;
3789          }
3790          else
3791          {
3792            if (TEST_OPT_INTSTRATEGY)
3793            {
3794              pDelete(&redSi);
3795              pCleardenom(strat->S[i]);// also does a pContent
3796              h.p = strat->S[i];
3797              strat->initEcart(&h);
3798              strat->ecartS[i] = h.ecart;
3799            }
3800            else
3801            {
3802              pDelete(&redSi);
3803              pNorm(strat->S[i]);
3804              h.p = strat->S[i];
3805              strat->initEcart(&h);
3806              strat->ecartS[i] = h.ecart;
3807            }
3808            h.sev =  pGetShortExpVector(h.p);
3809            strat->sevS[i] = h.sev;
3810          }
3811          kTest(strat);
3812        }
3813        i++;
3814      }
3815#ifdef KDEBUG
3816      kTest(strat);
3817#endif
3818      reorderS(&suc,strat);
3819      if (h.p!=NULL)
3820      {
3821        if (!strat->kHEdgeFound)
3822        {
3823          /*strat->kHEdgeFound =*/ HEckeTest(h.p,strat);
3824        }
3825        if (strat->kHEdgeFound)
3826          newHEdge(strat->S,strat);
3827      }
3828    }
3829    for (i=0; i<=strat->sl; i++)
3830    {
3831      if (((strat->fromQ==NULL) || (strat->fromQ[i]==0))
3832      )
3833      {
3834        strat->S[i] = h.p = redtail(strat->S[i],strat->sl,strat);
3835        strat->initEcart(&h);
3836        strat->ecartS[i] = h.ecart;
3837        h.sev = pGetShortExpVector(h.p);
3838        strat->sevS[i] = h.sev;
3839      }
3840      else
3841      {
3842        h.p = strat->S[i];
3843        h.ecart=strat->ecartS[i];
3844        h.sev = strat->sevS[i];
3845      }
3846      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
3847        cancelunit1(&h,&suc,strat->sl,strat);
3848      h.length = pLength(h.p);
3849      h.SetpFDeg();
3850      /*puts the elements of S also to T*/
3851      enterT(h,strat);
3852      strat->S_2_R[i] = strat->tl;
3853    }
3854    if (suc!= -1) updateS(toT,strat);
3855  }
3856  if (redSi!=NULL) pDeleteLm(&redSi);
3857#ifdef KDEBUG
3858  kTest(strat);
3859#endif
3860}
3861
3862
3863/*2
3864* -puts p to the standardbasis s at position at
3865* -saves the result in S
3866*/
3867void enterSBba (LObject p,int atS,kStrategy strat, int atR)
3868{
3869  int i;
3870  strat->news = TRUE;
3871  /*- puts p to the standardbasis s at position at -*/
3872  if (strat->sl == IDELEMS(strat->Shdl)-1)
3873  {
3874    strat->sevS = (unsigned long*) omRealloc0Size(strat->sevS,
3875                                    IDELEMS(strat->Shdl)*sizeof(unsigned long),
3876                                    (IDELEMS(strat->Shdl)+setmaxTinc)
3877                                                  *sizeof(unsigned long));
3878    strat->ecartS = (intset)omReallocSize(strat->ecartS,
3879                                          IDELEMS(strat->Shdl)*sizeof(int),
3880                                          (IDELEMS(strat->Shdl)+setmaxTinc)
3881                                                  *sizeof(int));
3882    strat->S_2_R = (int*) omRealloc0Size(strat->S_2_R,
3883                                         IDELEMS(strat->Shdl)*sizeof(int),
3884                                         (IDELEMS(strat->Shdl)+setmaxTinc)
3885                                                  *sizeof(int));
3886    if (strat->lenS!=NULL)
3887      strat->lenS=(int*)omRealloc0Size(strat->lenS,
3888                                       IDELEMS(strat->Shdl)*sizeof(int),
3889                                       (IDELEMS(strat->Shdl)+setmaxTinc)
3890                                                 *sizeof(int));
3891    if (strat->lenSw!=NULL)
3892      strat->lenSw=(wlen_type*)omRealloc0Size(strat->lenSw,
3893                                       IDELEMS(strat->Shdl)*sizeof(wlen_type),
3894                                       (IDELEMS(strat->Shdl)+setmaxTinc)
3895                                                 *sizeof(wlen_type));
3896    if (strat->fromQ!=NULL)
3897    {
3898      strat->fromQ = (intset)omReallocSize(strat->fromQ,
3899                                    IDELEMS(strat->Shdl)*sizeof(int),
3900                                    (IDELEMS(strat->Shdl)+setmaxTinc)*sizeof(int));
3901    }
3902    pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmaxTinc);
3903    IDELEMS(strat->Shdl)+=setmaxTinc;
3904    strat->Shdl->m=strat->S;
3905  }
3906  if (atS <= strat->sl)
3907  {
3908#ifdef ENTER_USE_MEMMOVE
3909// #if 0
3910    memmove(&(strat->S[atS+1]), &(strat->S[atS]),
3911            (strat->sl - atS + 1)*sizeof(poly));
3912    memmove(&(strat->ecartS[atS+1]), &(strat->ecartS[atS]),
3913            (strat->sl - atS + 1)*sizeof(int));
3914    memmove(&(strat->sevS[atS+1]), &(strat->sevS[atS]),
3915            (strat->sl - atS + 1)*sizeof(unsigned long));
3916    memmove(&(strat->S_2_R[atS+1]), &(strat->S_2_R[atS]),
3917            (strat->sl - atS + 1)*sizeof(int));
3918    if (strat->lenS!=NULL)
3919    memmove(&(strat->lenS[atS+1]), &(strat->lenS[atS]),
3920            (strat->sl - atS + 1)*sizeof(int));
3921    if (strat->lenSw!=NULL)
3922    memmove(&(strat->lenSw[atS+1]), &(strat->lenSw[atS]),
3923            (strat->sl - atS + 1)*sizeof(wlen_type));
3924#else
3925    for (i=strat->sl+1; i>=atS+1; i--)
3926    {
3927      strat->S[i] = strat->S[i-1];
3928      strat->ecartS[i] = strat->ecartS[i-1];
3929      strat->sevS[i] = strat->sevS[i-1];
3930      strat->S_2_R[i] = strat->S_2_R[i-1];
3931    }
3932    if (strat->lenS!=NULL)
3933    for (i=strat->sl+1; i>=atS+1; i--)
3934      strat->lenS[i] = strat->lenS[i-1];
3935    if (strat->lenSw!=NULL)
3936    for (i=strat->sl+1; i>=atS+1; i--)
3937      strat->lenSw[i] = strat->lenSw[i-1];
3938#endif
3939  }
3940  if (strat->fromQ!=NULL)
3941  {
3942#ifdef ENTER_USE_MEMMOVE
3943    memmove(&(strat->fromQ[atS+1]), &(strat->fromQ[atS]),
3944                  (strat->sl - atS + 1)*sizeof(int));
3945#else
3946    for (i=strat->sl+1; i>=atS+1; i--)
3947    {
3948      strat->fromQ[i] = strat->fromQ[i-1];
3949    }
3950#endif
3951    strat->fromQ[atS]=0;
3952  }
3953
3954  /*- save result -*/
3955  strat->S[atS] = p.p;
3956  if (strat->honey) strat->ecartS[atS] = p.ecart;
3957  if (p.sev == 0)
3958    p.sev = pGetShortExpVector(p.p);
3959  else
3960    assume(p.sev == pGetShortExpVector(p.p));
3961  strat->sevS[atS] = p.sev;
3962  strat->ecartS[atS] = p.ecart;
3963  strat->S_2_R[atS] = atR;
3964  strat->sl++;
3965}
3966
3967/*2
3968* puts p to the set T at position atT
3969*/
3970void enterT(LObject p, kStrategy strat, int atT)
3971{
3972  int i;
3973
3974  pp_Test(p.p, currRing, p.tailRing);
3975  assume(strat->tailRing == p.tailRing);
3976  // redMoraNF complains about this -- but, we don't really
3977  // neeed this so far
3978  // assume(p.pLength == 0 || pLength(p.p) == p.pLength);
3979  assume(p.FDeg == p.pFDeg());
3980  assume(!p.is_normalized || nIsOne(pGetCoeff(p.p)));
3981
3982  strat->newt = TRUE;
3983  if (atT < 0)
3984    atT = strat->posInT(strat->T, strat->tl, p);
3985  if (strat->tl == strat->tmax-1)
3986    enlargeT(strat->T,strat->R,strat->sevT,strat->tmax,setmaxTinc);
3987  if (atT <= strat->tl)
3988  {
3989#ifdef ENTER_USE_MEMMOVE
3990    memmove(&(strat->T[atT+1]), &(strat->T[atT]),
3991            (strat->tl-atT+1)*sizeof(TObject));
3992    memmove(&(strat->sevT[atT+1]), &(strat->sevT[atT]),
3993            (strat->tl-atT+1)*sizeof(unsigned long));
3994#endif
3995    for (i=strat->tl+1; i>=atT+1; i--)
3996    {
3997#ifndef ENTER_USE_MEMMOVE
3998      strat->T[i] = strat->T[i-1];
3999      strat->sevT[i] = strat->sevT[i-1];
4000#endif
4001      strat->R[strat->T[i].i_r] = &(strat->T[i]);
4002    }
4003  }
4004
4005  if (strat->tailBin != NULL && (pNext(p.p) != NULL))
4006  {
4007    pNext(p.p)=p_ShallowCopyDelete(pNext(p.p),
4008                                   (strat->tailRing != NULL ?
4009                                    strat->tailRing : currRing),
4010                                   strat->tailBin);
4011    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
4012  }
4013  strat->T[atT] = (TObject) p;
4014
4015  if (strat->tailRing != currRing && pNext(p.p) != NULL)
4016    strat->T[atT].max = p_GetMaxExpP(pNext(p.p), strat->tailRing);
4017  else
4018    strat->T[atT].max = NULL;
4019
4020  strat->tl++;
4021  strat->R[strat->tl] = &(strat->T[atT]);
4022  strat->T[atT].i_r = strat->tl;
4023  assume(p.sev == 0 || pGetShortExpVector(p.p) == p.sev);
4024  strat->sevT[atT] = (p.sev == 0 ? pGetShortExpVector(p.p) : p.sev);
4025  kTest_T(&(strat->T[atT]));
4026}
4027
4028void initHilbCrit(ideal F, ideal Q, intvec **hilb,kStrategy strat)
4029{
4030  if (strat->homog!=isHomog)
4031  {
4032    *hilb=NULL;
4033  }
4034}
4035
4036void initBuchMoraCrit(kStrategy strat)
4037{
4038  strat->sugarCrit =        TEST_OPT_SUGARCRIT;
4039  // obachman: Hmm.. I need BTEST1(2) for notBuckets ..
4040  //  strat->Gebauer =          BTEST1(2) || strat->homog || strat->sugarCrit;
4041  strat->Gebauer =          strat->homog || strat->sugarCrit;
4042  strat->honey =            !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
4043  if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
4044  strat->pairtest = NULL;
4045  /* alway use tailreduction, except:
4046  * - in local rings, - in lex order case, -in ring over extensions */
4047  strat->noTailReduction = !TEST_OPT_REDTAIL;
4048#ifdef HAVE_PLURAL
4049  // and r is plural_ring
4050  if (currRing->nc!=NULL)
4051    //or it has non-quasi-comm type... later
4052  {
4053    strat->sugarCrit = FALSE;
4054    strat->Gebauer = FALSE ;
4055    strat->honey = FALSE;
4056  }
4057#endif
4058  if (TEST_OPT_DEBUG)
4059  {
4060    if (strat->homog) PrintS("ideal/module is homogeneous\n");
4061    else              PrintS("ideal/module is not homogeneous\n");
4062  }
4063}
4064
4065BOOLEAN kPosInLDependsOnLength(int (*pos_in_l)
4066                               (const LSet set, const int length,
4067                                LObject* L,const kStrategy strat))
4068{
4069  if (pos_in_l == posInL110 ||
4070      pos_in_l == posInL10)
4071    return TRUE;
4072
4073  return FALSE;
4074}
4075
4076void initBuchMoraPos (kStrategy strat)
4077{
4078  if (pOrdSgn==1)
4079  {
4080    if (strat->honey)
4081    {
4082      strat->posInL = posInL15;
4083      // ok -- here is the deal: from my experiments for Singular-2-0
4084      // I conclude that that posInT_EcartpLength is the best of
4085      // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
4086      // see the table at the end of this file
4087      if (K_TEST_OPT_OLDSTD)
4088        strat->posInT = posInT15;
4089      else
4090        strat->posInT = posInT_EcartpLength;
4091    }
4092    else if (pLexOrder && !TEST_OPT_INTSTRATEGY)
4093    {
4094      strat->posInL = posInL11;
4095      strat->posInT = posInT11;
4096    }
4097    else if (TEST_OPT_INTSTRATEGY)
4098    {
4099      strat->posInL = posInL11;
4100      strat->posInT = posInT11;
4101    }
4102    else
4103    {
4104      strat->posInL = posInL0;
4105      strat->posInT = posInT0;
4106    }
4107    //if (strat->minim>0) strat->posInL =posInLSpecial;
4108    if (strat->homog)
4109    {
4110       strat->posInL = posInL110;
4111       strat->posInT = posInT110;
4112    }
4113  }
4114  else
4115  {
4116    if (strat->homog)
4117    {
4118      strat->posInL = posInL11;
4119      strat->posInT = posInT11;
4120    }
4121    else
4122    {
4123      if ((currRing->order[0]==ringorder_c)
4124      ||(currRing->order[0]==ringorder_C))
4125      {
4126        strat->posInL = posInL17_c;
4127        strat->posInT = posInT17_c;
4128      }
4129      else
4130      {
4131        strat->posInL = posInL17;
4132        strat->posInT = posInT17;
4133      }
4134    }
4135  }
4136  if (strat->minim>0) strat->posInL =posInLSpecial;
4137  // for further tests only
4138  if ((BTEST1(11)) || (BTEST1(12)))
4139    strat->posInL = posInL11;
4140  else if ((BTEST1(13)) || (BTEST1(14)))
4141    strat->posInL = posInL13;
4142  else if ((BTEST1(15)) || (BTEST1(16)))
4143    strat->posInL = posInL15;
4144  else if ((BTEST1(17)) || (BTEST1(18)))
4145    strat->posInL = posInL17;
4146  if (BTEST1(11))
4147    strat->posInT = posInT11;
4148  else if (BTEST1(13))
4149    strat->posInT = posInT13;
4150  else if (BTEST1(15))
4151    strat->posInT = posInT15;
4152  else if ((BTEST1(17)))
4153    strat->posInT = posInT17;
4154  else if ((BTEST1(19)))
4155    strat->posInT = posInT19;
4156  else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
4157    strat->posInT = posInT1;
4158  strat->posInLDependsOnLength = kPosInLDependsOnLength(strat->posInL);
4159}
4160
4161void initBuchMora (ideal F,ideal Q,kStrategy strat)
4162{
4163  strat->interpt = BTEST1(OPT_INTERRUPT);
4164  strat->kHEdge=NULL;
4165  if (pOrdSgn==1) strat->kHEdgeFound=FALSE;
4166  /*- creating temp data structures------------------- -*/
4167  strat->cp = 0;
4168  strat->c3 = 0;
4169  strat->tail = pInit();
4170  /*- set s -*/
4171  strat->sl = -1;
4172  /*- set L -*/
4173  strat->Lmax = setmaxL;
4174  strat->Ll = -1;
4175  strat->L = initL();
4176  /*- set B -*/
4177  strat->Bmax = setmaxL;
4178  strat->Bl = -1;
4179  strat->B = initL();
4180  /*- set T -*/
4181  strat->tl = -1;
4182  strat->tmax = setmaxT;
4183  strat->T = initT();
4184  strat->R = initR();
4185  strat->sevT = initsevT();
4186  /*- init local data struct.---------------------------------------- -*/
4187  strat->P.ecart=0;
4188  strat->P.length=0;
4189  if (pOrdSgn==-1)
4190  {
4191    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
4192    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
4193  }
4194  if(TEST_OPT_SB_1)
4195  {
4196    int i;
4197    ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
4198    for (i=strat->newIdeal;i<IDELEMS(F);i++)
4199    {
4200      P->m[i-strat->newIdeal] = F->m[i];
4201      F->m[i] = NULL;
4202    }
4203    initSSpecial(F,Q,P,strat);
4204    for (i=strat->newIdeal;i<IDELEMS(F);i++)
4205    {
4206      F->m[i] = P->m[i-strat->newIdeal];
4207      P->m[i-strat->newIdeal] = NULL;
4208    }
4209    idDelete(&P);
4210  }
4211  else
4212  {
4213    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
4214    // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
4215  }
4216  strat->kIdeal = NULL;
4217  strat->fromT = FALSE;
4218  strat->noTailReduction = !TEST_OPT_REDTAIL;
4219  if(!TEST_OPT_SB_1)
4220  {
4221    updateS(TRUE,strat);
4222    pairs(strat);
4223  }
4224  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
4225  strat->fromQ=NULL;
4226}
4227
4228void exitBuchMora (kStrategy strat)
4229{
4230  /*- release temp data -*/
4231  cleanT(strat);
4232  omFreeSize(strat->T,(strat->tmax)*sizeof(TObject));
4233  omFreeSize(strat->R,(strat->tmax)*sizeof(TObject*));
4234  omFreeSize(strat->sevT, (strat->tmax)*sizeof(unsigned long));
4235  omFreeSize(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
4236  omFreeSize(strat->sevS,IDELEMS(strat->Shdl)*sizeof(int));
4237  omFreeSize(strat->S_2_R,IDELEMS(strat->Shdl)*sizeof(int));
4238  /*- set L: should be empty -*/
4239  omFreeSize(strat->L,(strat->Lmax)*sizeof(LObject));
4240  /*- set B: should be empty -*/
4241  omFreeSize(strat->B,(strat->Bmax)*sizeof(LObject));
4242  pDeleteLm(&strat->tail);
4243  strat->syzComp=0;
4244  if (strat->kIdeal!=NULL)
4245  {
4246    omFreeBin(strat->kIdeal, sleftv_bin);
4247    strat->kIdeal=NULL;
4248  }
4249}
4250
4251/*2
4252* in the case of a standardbase of a module over a qring:
4253* replace polynomials in i by ak vectors,
4254* (the polynomial * unit vectors gen(1)..gen(ak)
4255* in every case (also for ideals:)
4256* deletes divisible vectors/polynomials
4257*/
4258void updateResult(ideal r,ideal Q, kStrategy strat)
4259{
4260  int l;
4261  if (strat->ak>0)
4262  {
4263    for (l=IDELEMS(r)-1;l>=0;l--)
4264    {
4265      if ((r->m[l]!=NULL) && (pGetComp(r->m[l])==0))
4266      {
4267        pDelete(&r->m[l]); // and set it to NULL
4268      }
4269    }
4270    int q;
4271    poly p;
4272    for (l=IDELEMS(r)-1;l>=0;l--)
4273    {
4274      if ((r->m[l]!=NULL)
4275      && (strat->syzComp>0)
4276      && (pGetComp(r->m[l])<=strat->syzComp))
4277      {
4278        for(q=IDELEMS(Q)-1; q>=0;q--)
4279        {
4280          if ((Q->m[q]!=NULL)
4281          &&(pLmDivisibleBy(Q->m[q],r->m[l])))
4282          {
4283            if (TEST_OPT_REDSB)
4284            {
4285              p=r->m[l];
4286              r->m[l]=kNF(Q,NULL,p);
4287              pDelete(&p);
4288            }
4289            else
4290            {
4291              pDelete(&r->m[l]); // and set it to NULL
4292            }
4293            break;
4294          }
4295        }
4296      }
4297    }
4298  }
4299  else
4300  {
4301    int q;
4302    poly p;
4303    for (l=IDELEMS(r)-1;l>=0;l--)
4304    {
4305      if (r->m[l]!=NULL)
4306      {
4307        for(q=IDELEMS(Q)-1; q>=0;q--)
4308        {
4309          if ((Q->m[q]!=NULL)
4310          &&(pLmEqual(r->m[l],Q->m[q])))
4311          {
4312            if (TEST_OPT_REDSB)
4313            {
4314              p=r->m[l];
4315              r->m[l]=kNF(Q,NULL,p);
4316              pDelete(&p);
4317            }
4318            else
4319            {
4320              pDelete(&r->m[l]); // and set it to NULL
4321            }
4322            break;
4323          }
4324        }
4325      }
4326    }
4327  }
4328  idSkipZeroes(r);
4329}
4330
4331void completeReduce (kStrategy strat)
4332{
4333  int i;
4334  int low = (pOrdSgn == 1 ? 1 : 0);
4335  LObject L;
4336
4337#ifdef KDEBUG
4338  // need to set this: during tailreductions of T[i], T[i].max is out of
4339  // sync
4340  sloppy_max = TRUE;
4341#endif
4342
4343  strat->noTailReduction = FALSE;
4344  if (TEST_OPT_PROT)
4345  {
4346    PrintLn();
4347    if (timerv) writeTime("standard base computed:");
4348  }
4349  if (TEST_OPT_PROT)
4350  {
4351    Print("(S:%d)",strat->sl);mflush();
4352  }
4353  for (i=strat->sl; i>=low; i--)
4354  {
4355    TObject* T_j = strat->s_2_t(i);
4356    if (T_j != NULL)
4357    {
4358      L = *T_j;
4359      poly p;
4360      if (pOrdSgn == 1)
4361        strat->S[i] = redtailBba(&L, i-1, strat, FALSE);
4362      else
4363        strat->S[i] = redtail(&L, strat->sl, strat);
4364
4365      if (strat->redTailChange && strat->tailRing != currRing)
4366      {
4367        if (T_j->max != NULL) p_LmFree(T_j->max, strat->tailRing);
4368        if (pNext(T_j->p) != NULL)
4369          T_j->max = p_GetMaxExpP(pNext(T_j->p), strat->tailRing);
4370        else
4371          T_j->max = NULL;
4372      }
4373      if (TEST_OPT_INTSTRATEGY)
4374        T_j->pCleardenom();
4375    }
4376    else
4377    {
4378      assume(currRing == strat->tailRing);
4379      if (pOrdSgn == 1)
4380        strat->S[i] = redtailBba(strat->S[i], i-1, strat);
4381      else
4382        strat->S[i] = redtail(strat->S[i], strat->sl, strat);
4383      if (TEST_OPT_INTSTRATEGY)
4384        pCleardenom(strat->S[i]);
4385    }
4386    if (TEST_OPT_PROT)
4387      PrintS("-");
4388  }
4389#ifdef KDEBUG
4390  sloppy_max = FALSE;
4391#endif
4392}
4393
4394
4395/*2
4396* computes the new strat->kHEdge and the new pNoether,
4397* returns TRUE, if pNoether has changed
4398*/
4399BOOLEAN newHEdge(polyset S, kStrategy strat)
4400{
4401  int i,j;
4402  poly newNoether;
4403
4404  scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
4405  if (strat->t_kHEdge != NULL) p_LmFree(strat->t_kHEdge, strat->tailRing);
4406  if (strat->tailRing != currRing)
4407    strat->t_kHEdge = k_LmInit_currRing_2_tailRing(strat->kHEdge, strat->tailRing);
4408  /* compare old and new noether*/
4409  newNoether = pLmInit(strat->kHEdge);
4410  j = pFDeg(newNoether,currRing);
4411  for (i=1; i<=pVariables; i++)
4412  {
4413    if (pGetExp(newNoether, i) > 0) pDecrExp(newNoether,i);
4414  }
4415  pSetm(newNoether);
4416  if (j < strat->HCord) /*- statistics -*/
4417  {
4418    if (TEST_OPT_PROT)
4419    {
4420      Print("H(%d)",j);
4421      mflush();
4422    }
4423    strat->HCord=j;
4424    if (TEST_OPT_DEBUG)
4425    {
4426      Print("H(%d):",j);
4427      wrp(strat->kHEdge);
4428      PrintLn();
4429    }
4430  }
4431  if (pCmp(strat->kNoether,newNoether)!=1)
4432  {
4433    pDelete(&strat->kNoether);
4434    strat->kNoether=newNoether;
4435    if (strat->t_kNoether != NULL) p_LmFree(strat->t_kNoether, strat->tailRing);
4436    if (strat->tailRing != currRing)
4437      strat->t_kNoether = k_LmInit_currRing_2_tailRing(strat->kNoether, strat->tailRing);
4438
4439    return TRUE;
4440  }
4441  pLmFree(newNoether);
4442  return FALSE;
4443}
4444
4445/***************************************************************
4446 *
4447 * Routines related for ring changes during std computations
4448 *
4449 ***************************************************************/
4450BOOLEAN kCheckSpolyCreation(LObject *L, kStrategy strat, poly &m1, poly &m2)
4451{
4452  assume(L->p1 != NULL && L->p2 != NULL);
4453  assume(L->i_r1 >= 0 && L->i_r1 <= strat->tl);
4454  assume(L->i_r2 >= 0 && L->i_r2 <= strat->tl);
4455  assume(strat->tailRing != currRing);
4456
4457  if (! k_GetLeadTerms(L->p1, L->p2, currRing, m1, m2, strat->tailRing))
4458    return FALSE;
4459  poly p1_max = (strat->R[L->i_r1])->max;
4460  poly p2_max = (strat->R[L->i_r2])->max;
4461
4462  if ((p1_max != NULL && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
4463      (p2_max != NULL && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
4464  {
4465    p_LmFree(m1, strat->tailRing);
4466    p_LmFree(m2, strat->tailRing);
4467    m1 = NULL;
4468    m2 = NULL;
4469    return FALSE;
4470  }
4471  return TRUE;
4472}
4473
4474BOOLEAN kStratChangeTailRing(kStrategy strat, LObject *L, TObject* T, unsigned long expbound)
4475{
4476  if (expbound == 0) expbound = strat->tailRing->bitmask << 1;
4477  if (expbound >= currRing->bitmask) return FALSE;
4478  ring new_tailRing = rModifyRing(currRing,
4479                                  // Hmmm .. the condition pFDeg == pDeg
4480                                  // might be too strong
4481                                  (strat->homog && pFDeg == pDeg),
4482                                  !strat->ak,
4483                                  expbound);
4484  if (new_tailRing == currRing) return TRUE;
4485
4486  strat->pOrigFDeg_TailRing = new_tailRing->pFDeg;
4487  strat->pOrigLDeg_TailRing = new_tailRing->pLDeg;
4488
4489  if (currRing->pFDeg != currRing->pFDegOrig)
4490  {
4491    new_tailRing->pFDeg = currRing->pFDeg;
4492    new_tailRing->pLDeg = currRing->pLDeg;
4493  }
4494
4495  if (TEST_OPT_PROT)
4496    Print("[%lu:%d", (unsigned long) new_tailRing->bitmask, new_tailRing->ExpL_Size);
4497  kTest_TS(strat);
4498  assume(new_tailRing != strat->tailRing);
4499  pShallowCopyDeleteProc p_shallow_copy_delete
4500    = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
4501
4502  omBin new_tailBin = omGetStickyBinOfBin(new_tailRing->PolyBin);
4503
4504  int i;
4505  for (i=0; i<=strat->tl; i++)
4506  {
4507    strat->T[i].ShallowCopyDelete(new_tailRing, new_tailBin,
4508                                  p_shallow_copy_delete);
4509  }
4510  for (i=0; i<=strat->Ll; i++)
4511  {
4512    assume(strat->L[i].p != NULL);
4513    if (pNext(strat->L[i].p) != strat->tail)
4514      strat->L[i].ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
4515  }
4516  if (strat->P.t_p != NULL ||
4517      (strat->P.p != NULL && pNext(strat->P.p) != strat->tail))
4518    strat->P.ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
4519
4520  if (L != NULL && L->tailRing != new_tailRing)
4521  {
4522    if (L->i_r < 0)
4523      L->ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
4524    else
4525    {
4526      assume(L->i_r <= strat->tl);
4527      TObject* t_l = strat->R[L->i_r];
4528      assume(t_l != NULL);
4529      L->tailRing = new_tailRing;
4530      L->p = t_l->p;
4531      L->t_p = t_l->t_p;
4532      L->max = t_l->max;
4533    }
4534  }
4535
4536  if (T != NULL && T->tailRing != new_tailRing && T->i_r < 0)
4537    T->ShallowCopyDelete(new_tailRing, new_tailBin, p_shallow_copy_delete);
4538
4539  omMergeStickyBinIntoBin(strat->tailBin, strat->tailRing->PolyBin);
4540  if (strat->tailRing != currRing)
4541    rKillModifiedRing(strat->tailRing);
4542
4543  strat->tailRing = new_tailRing;
4544  strat->tailBin = new_tailBin;
4545  strat->p_shallow_copy_delete
4546    = pGetShallowCopyDeleteProc(currRing, new_tailRing);
4547
4548  if (strat->kHEdge != NULL)
4549  {
4550    if (strat->t_kHEdge != NULL)
4551      p_LmFree(strat->t_kHEdge, strat->tailRing);
4552    strat->t_kHEdge=k_LmInit_currRing_2_tailRing(strat->kHEdge, new_tailRing);
4553  }
4554
4555  if (strat->kNoether != NULL)
4556  {
4557    if (strat->t_kNoether != NULL)
4558      p_LmFree(strat->t_kNoether, strat->tailRing);
4559    strat->t_kNoether=k_LmInit_currRing_2_tailRing(strat->kNoether,
4560                                                   new_tailRing);
4561  }
4562  kTest_TS(strat);
4563  if (TEST_OPT_PROT)
4564    PrintS("]");
4565  return TRUE;
4566}
4567
4568void kStratInitChangeTailRing(kStrategy strat)
4569{
4570  unsigned long l = 0;
4571  int i;
4572  Exponent_t e;
4573  ring new_tailRing;
4574
4575  assume(strat->tailRing == currRing);
4576
4577  for (i=0; i<= strat->Ll; i++)
4578  {
4579    l = p_GetMaxExpL(strat->L[i].p, currRing, l);
4580  }
4581  for (i=0; i<=strat->tl; i++)
4582  {
4583    // Hmm ... this we could do in one Step
4584    l = p_GetMaxExpL(strat->T[i].p, currRing, l);
4585  }
4586  e = p_GetMaxExp(l, currRing);
4587  if (e <= 1) e = 2;
4588
4589  kStratChangeTailRing(strat, NULL, NULL, e);
4590}
4591
4592skStrategy::skStrategy()
4593{
4594  memset(this, 0, sizeof(skStrategy));
4595#ifndef NDEBUG
4596  strat_nr++;
4597  nr=strat_nr;
4598  if (strat_fac_debug) Print("s(%d) created\n",nr);
4599#endif
4600  tailRing = currRing;
4601  P.tailRing = currRing;
4602  tl = -1;
4603  sl = -1;
4604#ifdef HAVE_LM_BIN
4605  lmBin = omGetStickyBinOfBin(currRing->PolyBin);
4606#endif
4607#ifdef HAVE_TAIL_BIN
4608  tailBin = omGetStickyBinOfBin(currRing->PolyBin);
4609#endif
4610  pOrigFDeg = pFDeg;
4611  pOrigLDeg = pLDeg;
4612}
4613
4614
4615skStrategy::~skStrategy()
4616{
4617  if (lmBin != NULL)
4618    omMergeStickyBinIntoBin(lmBin, currRing->PolyBin);
4619  if (tailBin != NULL)
4620    omMergeStickyBinIntoBin(tailBin,
4621                            (tailRing != NULL ? tailRing->PolyBin:
4622                             currRing->PolyBin));
4623  if (t_kHEdge != NULL)
4624    p_LmFree(t_kHEdge, tailRing);
4625  if (t_kNoether != NULL)
4626    p_LmFree(t_kNoether, tailRing);
4627
4628  if (currRing != tailRing)
4629    rKillModifiedRing(tailRing);
4630  pRestoreDegProcs(pOrigFDeg, pOrigLDeg);
4631}
4632
4633#if 0
4634Timings for the different possibilities of posInT:
4635            T15           EDL         DL          EL            L         1-2-3
4636Gonnet      43.26       42.30       38.34       41.98       38.40      100.04
4637Hairer_2_1   1.11        1.15        1.04        1.22        1.08        4.7
4638Twomat3      1.62        1.69        1.70        1.65        1.54       11.32
4639ahml         4.48        4.03        4.03        4.38        4.96       26.50
4640c7          15.02       13.98       15.16       13.24       17.31       47.89
4641c8         505.09      407.46      852.76      413.21      499.19        n/a
4642f855        12.65        9.27       14.97        8.78       14.23       33.12
4643gametwo6    11.47       11.35       14.57       11.20       12.02       35.07
4644gerhard_3    2.73        2.83        2.93        2.64        3.12        6.24
4645ilias13     22.89       22.46       24.62       20.60       23.34       53.86
4646noon8       40.68       37.02       37.99       36.82       35.59      877.16
4647rcyclic_19  48.22       42.29       43.99       45.35       51.51      204.29
4648rkat9       82.37       79.46       77.20       77.63       82.54      267.92
4649schwarz_11  16.46       16.81       16.76       16.81       16.72       35.56
4650test016     16.39       14.17       14.40       13.50       14.26       34.07
4651test017     34.70       36.01       33.16       35.48       32.75       71.45
4652test042     10.76       10.99       10.27       11.57       10.45       23.04
4653test058      6.78        6.75        6.51        6.95        6.22        9.47
4654test066     10.71       10.94       10.76       10.61       10.56       19.06
4655test073     10.75       11.11       10.17       10.79        8.63       58.10
4656test086     12.23       11.81       12.88       12.24       13.37       66.68
4657test103      5.05        4.80        5.47        4.64        4.89       11.90
4658test154     12.96       11.64       13.51       12.46       14.61       36.35
4659test162     65.27       64.01       67.35       59.79       67.54      196.46
4660test164      7.50        6.50        7.68        6.70        7.96       17.13
4661virasoro     3.39        3.50        3.35        3.47        3.70        7.66
4662#endif
4663
4664
4665#ifdef HAVE_MORE_POS_IN_T
4666// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
4667int posInT_EcartFDegpLength(const TSet set,const int length,LObject &p)
4668{
4669
4670  if (length==-1) return 0;
4671
4672  int o = p.ecart;
4673  int op=p.GetpFDeg();
4674  int ol = p.GetpLength();
4675
4676  if (set[length].ecart < o)
4677    return length+1;
4678  if (set[length].ecart == o)
4679  {
4680     int oo=set[length].GetpFDeg();
4681     if ((oo < op) || ((oo==op) && (set[length].length < ol)))
4682       return length+1;
4683  }
4684
4685  int i;
4686  int an = 0;
4687  int en= length;
4688  loop
4689  {
4690    if (an >= en-1)
4691    {
4692      if (set[an].ecart > o)
4693        return an;
4694      if (set[an].ecart == o)
4695      {
4696         int oo=set[an].GetpFDeg();
4697         if((oo > op)
4698         || ((oo==op) && (set[an].pLength > ol)))
4699           return an;
4700      }
4701      return en;
4702    }
4703    i=(an+en) / 2;
4704    if (set[i].ecart > o)
4705      en=i;
4706    else if (set[i].ecart == o)
4707    {
4708       int oo=set[i].GetpFDeg();
4709       if ((oo > op)
4710       || ((oo == op) && (set[i].pLength > ol)))
4711         en=i;
4712       else
4713        an=i;
4714    }
4715    else
4716      an=i;
4717  }
4718}
4719
4720// determines the position based on: 1.) FDeg 2.) pLength
4721int posInT_FDegpLength(const TSet set,const int length,LObject &p)
4722{
4723
4724  if (length==-1) return 0;
4725
4726  int op=p.GetpFDeg();
4727  int ol = p.GetpLength();
4728
4729  int oo=set[length].GetpFDeg();
4730  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
4731    return length+1;
4732
4733  int i;
4734  int an = 0;
4735  int en= length;
4736  loop
4737    {
4738      if (an >= en-1)
4739      {
4740        int oo=set[an].GetpFDeg();
4741        if((oo > op)
4742           || ((oo==op) && (set[an].pLength > ol)))
4743          return an;
4744        return en;
4745      }
4746      i=(an+en) / 2;
4747      int oo=set[i].GetpFDeg();
4748      if ((oo > op)
4749          || ((oo == op) && (set[i].pLength > ol)))
4750        en=i;
4751      else
4752        an=i;
4753    }
4754}
4755
4756
4757// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
4758int posInT_pLength(const TSet set,const int length,LObject &p)
4759{
4760  if (length==-1)
4761    return 0;
4762  if (set[length].length<p.length)
4763    return length+1;
4764
4765  int i;
4766  int an = 0;
4767  int en= length;
4768  int ol = p.GetpLength();
4769
4770  loop
4771  {
4772    if (an >= en-1)
4773    {
4774      if (set[an].pLength>ol) return an;
4775      return en;
4776    }
4777    i=(an+en) / 2;
4778    if (set[i].pLength>ol) en=i;
4779    else                        an=i;
4780  }
4781}
4782
4783#endif
4784
4785#endif // KUTIL_CC
Note: See TracBrowser for help on using the repository browser.