source: git/kernel/kutil.cc @ a76e11

spielwiese
Last change on this file since a76e11 was a76e11, checked in by Oliver Wienand <wienand@…>, 16 years ago
kutilc.cc: use pp_Mult_nn instead of copy and p_Mult_nn p_Minus...: compute length correct pp_Mult: return null in case of null git-svn-id: file:///usr/local/Singular/svn/trunk@10567 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 159.8 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kutil.cc,v 1.80 2008-02-07 08:40:59 wienand 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#include "gring.h"
20#include "sca.h"
21#ifdef KDEBUG
22#undef KDEBUG
23#define KDEBUG 2
24#endif
25
26#ifdef HAVE_RING2TOM
27#include "ideals.h"
28#endif
29
30// define if enterL, enterT should use memmove instead of doing it manually
31// on topgun, this is slightly faster (see monodromy_l.tst, homog_gonnet.sing)
32#ifndef SunOS_4
33#define ENTER_USE_MEMMOVE
34#endif
35
36// define, if the my_memmove inlines should be used instead of
37// system memmove -- it does not seem to pay off, though
38// #define ENTER_USE_MYMEMMOVE
39
40#include "kutil.h"
41#include "febase.h"
42#include "omalloc.h"
43#include "numbers.h"
44#include "polys.h"
45#include "ring.h"
46#include "ideals.h"
47#include "timer.h"
48//#include "cntrlc.h"
49#include "stairc.h"
50#include "kstd1.h"
51#include "pShallowCopyDelete.h"
52
53/* shiftgb stuff */
54#include "shiftgb.h"
55
56#ifdef KDEBUG
57#undef KDEBUG
58#define KDEBUG 2
59#endif
60
61
62#ifdef ENTER_USE_MYMEMMOVE
63inline void _my_memmove_d_gt_s(unsigned long* d, unsigned long* s, long l)
64{
65  register unsigned long* _dl = (unsigned long*) d;
66  register unsigned long* _sl = (unsigned long*) s;
67  register long _i = l - 1;
68
69  do
70  {
71    _dl[_i] = _sl[_i];
72    _i--;
73  }
74  while (_i >= 0);
75}
76
77inline void _my_memmove_d_lt_s(unsigned long* d, unsigned long* s, long l)
78{
79  register long _ll = l;
80  register unsigned long* _dl = (unsigned long*) d;
81  register unsigned long* _sl = (unsigned long*) s;
82  register long _i = 0;
83
84  do
85  {
86    _dl[_i] = _sl[_i];
87    _i++;
88  }
89  while (_i < _ll);
90}
91
92inline void _my_memmove(void* d, void* s, long l)
93{
94  unsigned long _d = (unsigned long) d;
95  unsigned long _s = (unsigned long) s;
96  unsigned long _l = ((l) + SIZEOF_LONG - 1) >> LOG_SIZEOF_LONG;
97
98  if (_d > _s) _my_memmove_d_gt_s(_d, _s, _l);
99  else _my_memmove_d_lt_s(_d, _s, _l);
100}
101
102#undef memmove
103#define memmove(d,s,l) _my_memmove(d, s, l)
104#endif
105
106static poly redMora (poly h,int maxIndex,kStrategy strat);
107static poly redBba (poly h,int maxIndex,kStrategy strat);
108
109#ifdef HAVE_RINGS
110#define pDivComp_EQUAL 2
111#define pDivComp_LESS 1
112#define pDivComp_GREATER -1
113#define pDivComp_INCOMP 0
114/* Checks the relation of LM(p) and LM(q)
115     LM(p) = LM(q) => return pDivComp_EQUAL
116     LM(p) | LM(q) => return pDivComp_LESS
117     LM(q) | LM(p) => return pDivComp_GREATER
118     else return pDivComp_INCOMP */
119static inline int pDivCompRing(poly p, poly q)
120{
121  if (pGetComp(p) == pGetComp(q))
122  {
123    BOOLEAN a=FALSE, b=FALSE;
124    int i;
125    unsigned long la, lb;
126    unsigned long divmask = currRing->divmask;
127    for (i=0; i<currRing->VarL_Size; i++)
128    {
129      la = p->exp[currRing->VarL_Offset[i]];
130      lb = q->exp[currRing->VarL_Offset[i]];
131      if (la != lb)
132      {
133        if (la < lb)
134        {
135          if (b) return pDivComp_INCOMP;
136          if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
137            return pDivComp_INCOMP;
138          a = TRUE;
139        }
140        else
141        {
142          if (a) return pDivComp_INCOMP;
143          if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
144            return pDivComp_INCOMP;
145          b = TRUE;
146        }
147      }
148    }
149    if (a) return pDivComp_LESS;
150    if (b) return pDivComp_GREATER;
151    if (!a & !b) return pDivComp_EQUAL;
152  }
153  return 0;
154}
155#endif
156
157static inline int pDivComp(poly p, poly q)
158{
159  if (pGetComp(p) == pGetComp(q))
160  {
161    BOOLEAN a=FALSE, b=FALSE;
162    int i;
163    unsigned long la, lb;
164    unsigned long divmask = currRing->divmask;
165    for (i=0; i<currRing->VarL_Size; i++)
166    {
167      la = p->exp[currRing->VarL_Offset[i]];
168      lb = q->exp[currRing->VarL_Offset[i]];
169      if (la != lb)
170      {
171        if (la < lb)
172        {
173          if (b) return 0;
174          if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
175            return 0;
176          a = TRUE;
177        }
178        else
179        {
180          if (a) return 0;
181          if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
182            return 0;
183          b = TRUE;
184        }
185      }
186    }
187    if (a) return 1;
188    if (b) return -1;
189  }
190  return 0;
191}
192
193
194BITSET  test=(BITSET)0;
195int     HCord;
196int     Kstd1_deg;
197int     mu=32000;
198
199/*2
200*deletes higher monomial of p, re-compute ecart and length
201*works only for orderings with ecart =pFDeg(end)-pFDeg(start)
202*/
203void deleteHC(LObject *L, kStrategy strat, BOOLEAN fromNext)
204{
205  if (strat->kHEdgeFound)
206  {
207    kTest_L(L);
208    poly p1;
209    poly p = L->GetLmTailRing();
210    int l = 1;
211    kBucket_pt bucket = NULL;
212    if (L->bucket != NULL)
213    {
214      kBucketClear(L->bucket, &pNext(p), &L->pLength);
215      L->pLength++;
216      bucket = L->bucket;
217      L->bucket = NULL;
218      L->last = NULL;
219    }
220
221    if (!fromNext && p_Cmp(p,strat->kNoetherTail(), L->tailRing) == -1)
222    {
223      L->Delete();
224      L->Clear();
225      L->ecart = -1;
226      if (bucket != NULL) kBucketDestroy(&bucket);
227      return;
228    }
229    p1 = p;
230    while (pNext(p1)!=NULL)
231    {
232      if (p_LmCmp(pNext(p1), strat->kNoetherTail(), L->tailRing) == -1)
233      {
234        L->last = p1;
235        p_Delete(&pNext(p1), L->tailRing);
236        if (p1 == p)
237        {
238          if (L->t_p != NULL)
239          {
240            assume(L->p != NULL && p == L->t_p);
241            pNext(L->p) = NULL;
242          }
243          L->max  = NULL;
244        }
245        else if (fromNext)
246          L->max  = p_GetMaxExpP(pNext(L->p), L->tailRing ); // p1;
247        //if (L->pLength != 0)
248        L->pLength = l;
249        // Hmmm when called from updateT, then only
250        // reset ecart when cut
251        if (fromNext)
252          L->ecart = L->pLDeg() - L->GetpFDeg();
253        break;
254      }
255      l++;
256      pIter(p1);
257    }
258    if (! fromNext)
259    {
260      L->SetpFDeg();
261      L->ecart = L->pLDeg(strat->LDegLast) - L->GetpFDeg();
262    }
263    if (bucket != NULL)
264    {
265      if (L->pLength > 1)
266      {
267        kBucketInit(bucket, pNext(p), L->pLength - 1);
268        pNext(p) = NULL;
269        if (L->t_p != NULL) pNext(L->t_p) = NULL;
270        L->pLength = 0;
271        L->bucket = bucket;
272        L->last = NULL;
273      }
274      else
275        kBucketDestroy(&bucket);
276    }
277    kTest_L(L);
278  }
279}
280
281void deleteHC(poly* p, int* e, int* l,kStrategy strat)
282{
283  LObject L(*p, currRing, strat->tailRing);
284
285  deleteHC(&L, strat);
286  *p = L.p;
287  *e = L.ecart;
288  *l = L.length;
289  if (L.t_p != NULL) p_LmFree(L.t_p, strat->tailRing);
290}
291
292/*2
293*tests if p.p=monomial*unit and cancels the unit
294*/
295void cancelunit (LObject* L,BOOLEAN inNF)
296{
297  int  i;
298  poly h;
299
300  if(currRing->OrdSgn != -1) return;
301  if(TEST_OPT_CANCELUNIT) return;
302
303  ring r = L->tailRing;
304  poly p = L->GetLmTailRing();
305
306  if(p_GetComp(p, r) != 0 && !p_OneComp(p, r)) return;
307
308  if (L->ecart != 0)
309  {
310//    for(i=r->N;i>0;i--)
311//    {
312//      if ((p_GetExp(p,i,r)>0) && (rIsPolyVar(i, r)==TRUE)) return;
313//    }
314    h = pNext(p);
315    loop
316    {
317      if (h==NULL)
318      {
319        p_Delete(&pNext(p), r);
320        if (!inNF)
321        {
322          number eins=nInit(1);
323          if (L->p != NULL)  pSetCoeff(L->p,eins);
324          else if (L->t_p != NULL) nDelete(&pGetCoeff(L->t_p));
325          if (L->t_p != NULL) pSetCoeff0(L->t_p,eins);
326        }
327        L->ecart = 0;
328        L->length = 1;
329        //if (L->pLength > 0)
330        L->pLength = 1;
331        if (L->last != NULL) L->last = p;
332
333        if (L->t_p != NULL && pNext(L->t_p) != NULL)
334          pNext(L->t_p) = NULL;
335        if (L->p != NULL && pNext(L->p) != NULL)
336          pNext(L->p) = NULL;
337        return;
338      }
339      i = 0;
340      loop
341      {
342        i++;
343        if (p_GetExp(p,i,r) > p_GetExp(h,i,r)) return ; // does not divide
344        if (i == r->N) break; // does divide, try next monom
345      }
346      pIter(h);
347    }
348  }
349}
350
351/*2
352*pp is the new element in s
353*returns TRUE (in strat->kHEdgeFound) if
354*-HEcke is allowed
355*-we are in the last componente of the vector
356*-on all axis are monomials (all elements in NotUsedAxis are FALSE)
357*returns FALSE for pLexOrderings,
358*assumes in module case an ordering of type c* !!
359* HEckeTest is only called with strat->kHEdgeFound==FALSE !
360*/
361void HEckeTest (poly pp,kStrategy strat)
362{
363  int   j,k,p;
364
365  strat->kHEdgeFound=FALSE;
366  if (pLexOrder || currRing->MixedOrder)
367  {
368    return;
369  }
370  if (strat->ak > 1)           /*we are in the module case*/
371  {
372    return; // until ....
373    //if (!pVectorOut)     /*pVectorOut <=> order = c,* */
374    //  return FALSE;
375    //if (pGetComp(pp) < strat->ak) /* ak is the number of the last component */
376    //  return FALSE;
377  }
378  k = 0;
379  p=pIsPurePower(pp);
380  if (p!=0) strat->NotUsedAxis[p] = FALSE;
381  /*- the leading term of pp is a power of the p-th variable -*/
382  for (j=pVariables;j>0; j--)
383  {
384    if (strat->NotUsedAxis[j])
385    {
386      return;
387    }
388  }
389  strat->kHEdgeFound=TRUE;
390}
391
392/*2
393*utilities for TSet, LSet
394*/
395inline static intset initec (const int maxnr)
396{
397  return (intset)omAlloc(maxnr*sizeof(int));
398}
399
400inline static unsigned long* initsevS (const int maxnr)
401{
402  return (unsigned long*)omAlloc0(maxnr*sizeof(unsigned long));
403}
404inline static int* initS_2_R (const int maxnr)
405{
406  return (int*)omAlloc0(maxnr*sizeof(int));
407}
408
409static inline void enlargeT (TSet &T, TObject** &R, unsigned long* &sevT,
410                             int &length, const int incr)
411{
412  assume(T!=NULL);
413  assume(sevT!=NULL);
414  assume(R!=NULL);
415  assume((length+incr) > 0);
416
417  int i;
418  T = (TSet)omRealloc0Size(T, length*sizeof(TObject),
419                           (length+incr)*sizeof(TObject));
420
421  sevT = (unsigned long*) omReallocSize(sevT, length*sizeof(long*),
422                           (length+incr)*sizeof(long*));
423
424  R = (TObject**)omRealloc0Size(R,length*sizeof(TObject*),
425                                (length+incr)*sizeof(TObject*));
426  for (i=length-1;i>=0;i--) R[T[i].i_r] = &(T[i]);
427  length += incr;
428}
429
430void cleanT (kStrategy strat)
431{
432  int i,j;
433  poly  p;
434  assume(currRing == strat->tailRing || strat->tailRing != NULL);
435
436  pShallowCopyDeleteProc p_shallow_copy_delete =
437    (strat->tailRing != currRing ?
438     pGetShallowCopyDeleteProc(strat->tailRing, currRing) :
439     NULL);
440
441  for (j=0; j<=strat->tl; j++)
442  {
443    p = strat->T[j].p;
444    strat->T[j].p=NULL;
445    if (strat->T[j].max != NULL)
446      p_LmFree(strat->T[j].max, strat->tailRing);
447    i = -1;
448    loop
449    {
450      i++;
451      if (i>strat->sl)
452      {
453        if (strat->T[j].t_p != NULL)
454        {
455          p_Delete(&(strat->T[j].t_p), strat->tailRing);
456          p_LmFree(p, currRing);
457        }
458        else
459          pDelete(&p);
460        break;
461      }
462      if (p == strat->S[i])
463      {
464        if (strat->T[j].t_p != NULL)
465        {
466          assume(p_shallow_copy_delete != NULL);
467          pNext(p) = p_shallow_copy_delete(pNext(p),strat->tailRing,currRing,
468                                           currRing->PolyBin);
469          p_LmFree(strat->T[j].t_p, strat->tailRing);
470        }
471        break;
472      }
473    }
474  }
475  strat->tl=-1;
476}
477
478//LSet initL ()
479//{
480//  int i;
481//  LSet l = (LSet)omAlloc(setmaxL*sizeof(LObject));
482//  return l;
483//}
484
485static inline void enlargeL (LSet* L,int* length,const int incr)
486{
487  assume((*L)!=NULL);
488  assume((length+incr)>0);
489
490  *L = (LSet)omReallocSize((*L),(*length)*sizeof(LObject),
491                                   ((*length)+incr)*sizeof(LObject));
492  (*length) += incr;
493}
494
495void initPairtest(kStrategy strat)
496{
497  strat->pairtest = (BOOLEAN *)omAlloc0((strat->sl+2)*sizeof(BOOLEAN));
498}
499
500/*2
501*test whether (p1,p2) or (p2,p1) is in L up position length
502*it returns TRUE if yes and the position k
503*/
504BOOLEAN isInPairsetL(int length,poly p1,poly p2,int*  k,kStrategy strat)
505{
506  LObject *p=&(strat->L[length]);
507
508  *k = length;
509  loop
510  {
511    if ((*k) < 0) return FALSE;
512    if (((p1 == (*p).p1) && (p2 == (*p).p2))
513    ||  ((p1 == (*p).p2) && (p2 == (*p).p1)))
514      return TRUE;
515    (*k)--;
516    p--;
517  }
518}
519
520/*2
521*in B all pairs have the same element p on the right
522*it tests whether (q,p) is in B and returns TRUE if yes
523*and the position k
524*/
525BOOLEAN isInPairsetB(poly q,int*  k,kStrategy strat)
526{
527  LObject *p=&(strat->B[strat->Bl]);
528
529  *k = strat->Bl;
530  loop
531  {
532    if ((*k) < 0) return FALSE;
533    if (q == (*p).p1)
534      return TRUE;
535    (*k)--;
536    p--;
537  }
538}
539
540int kFindInT(poly p, TSet T, int tlength)
541{
542  int i;
543
544  for (i=0; i<=tlength; i++)
545  {
546    if (T[i].p == p) return i;
547  }
548  return -1;
549}
550
551int kFindInT(poly p, kStrategy strat)
552{
553  int i;
554  do
555  {
556    i = kFindInT(p, strat->T, strat->tl);
557    if (i >= 0) return i;
558    strat = strat->next;
559  }
560  while (strat != NULL);
561  return -1;
562}
563
564#ifdef KDEBUG
565
566void sTObject::wrp()
567{
568  if (t_p != NULL) p_wrp(t_p, tailRing);
569  else if (p != NULL) p_wrp(p, currRing, tailRing);
570  else ::wrp(NULL);
571}
572
573#define kFalseReturn(x) do { if (!x) return FALSE;} while (0)
574
575// check that Lm's of a poly from T are "equal"
576static const char* kTest_LmEqual(poly p, poly t_p, ring tailRing)
577{
578  int i;
579  for (i=1; i<=tailRing->N; i++)
580  {
581    if (p_GetExp(p, i, currRing) != p_GetExp(t_p, i, tailRing))
582      return "Lm[i] different";
583  }
584  if (p_GetComp(p, currRing) != p_GetComp(t_p, tailRing))
585    return "Lm[0] different";
586  if (pNext(p) != pNext(t_p))
587    return "Lm.next different";
588  if (pGetCoeff(p) != pGetCoeff(t_p))
589    return "Lm.coeff different";
590  return NULL;
591}
592
593static BOOLEAN sloppy_max = FALSE;
594BOOLEAN kTest_T(TObject * T, ring strat_tailRing, int i, char TN)
595{
596  ring tailRing = T->tailRing;
597  if (strat_tailRing == NULL) strat_tailRing = tailRing;
598  r_assume(strat_tailRing == tailRing);
599
600  poly p = T->p;
601  ring r = currRing;
602
603  if (T->p == NULL && T->t_p == NULL && i >= 0)
604    return dReportError("%c[%d].poly is NULL", TN, i);
605
606  if (T->tailRing != currRing)
607  {
608    if (T->t_p == NULL && i > 0)
609      return dReportError("%c[%d].t_p is NULL", TN, i);
610    pFalseReturn(p_Test(T->t_p, T->tailRing));
611    if (T->p != NULL) pFalseReturn(p_LmTest(T->p, currRing));
612    if (T->p != NULL && T->t_p != NULL)
613    {
614      const char* msg = kTest_LmEqual(T->p, T->t_p, T->tailRing);
615      if (msg != NULL)
616        return dReportError("%c[%d] %s", TN, i, msg);
617      r = T->tailRing;
618      p = T->t_p;
619    }
620    if (T->p == NULL)
621    {
622      p = T->t_p;
623      r = T->tailRing;
624    }
625    if (T->t_p != NULL && i >= 0 && TN == 'T')
626    {
627      if (pNext(T->t_p) == NULL)
628      {
629        if (T->max != NULL)
630          return dReportError("%c[%d].max is not NULL as it should be", TN, i);
631      }
632      else
633      {
634        if (T->max == NULL)
635          return dReportError("%c[%d].max is NULL", TN, i);
636        if (pNext(T->max) != NULL)
637          return dReportError("pNext(%c[%d].max) != NULL", TN, i);
638
639        pFalseReturn(p_CheckPolyRing(T->max, tailRing));
640        omCheckBinAddrSize(T->max, (tailRing->PolyBin->sizeW)*SIZEOF_LONG);
641#if KDEBUG > 0
642        if (! sloppy_max)
643        {
644          poly test_max = p_GetMaxExpP(pNext(T->t_p), tailRing);
645          p_Setm(T->max, tailRing);
646          p_Setm(test_max, tailRing);
647          BOOLEAN equal = p_ExpVectorEqual(T->max, test_max, tailRing);
648          if (! equal)
649            return dReportError("%c[%d].max out of sync", TN, i);
650          p_LmFree(test_max, tailRing);
651        }
652#endif
653      }
654    }
655  }
656  else
657  {
658    if (T->max != NULL)
659      return dReportError("%c[%d].max != NULL but tailRing == currRing",TN,i);
660    if (T->t_p != NULL)
661      return dReportError("%c[%d].t_p != NULL but tailRing == currRing",TN,i);
662    if (T->p == NULL && i > 0)
663      return dReportError("%c[%d].p is NULL", TN, i);
664    pFalseReturn(p_Test(T->p, currRing));
665  }
666
667  if (i >= 0 && T->pLength != 0 && T->pLength != pLength(p))
668  {
669    return dReportError("%c[%d] pLength error: has %d, specified to have %d",
670                        TN, i , pLength(p), T->pLength);
671  }
672
673  // check FDeg,  for elements in L and T
674  if (i >= 0 && (TN == 'T' || TN == 'L'))
675  {
676    // FDeg has ir element from T of L set
677    if (T->FDeg  != T->pFDeg())
678      return dReportError("%c[%d] FDeg error: has %d, specified to have %d",
679                          TN, i , T->pFDeg(), T->FDeg);
680  }
681
682  // check is_normalized for elements in T
683  if (i >= 0 && TN == 'T')
684  {
685    if (T->is_normalized && ! nIsOne(pGetCoeff(p)))
686      return dReportError("T[%d] is_normalized error", i);
687
688  }
689  return TRUE;
690}
691
692BOOLEAN kTest_L(LObject *L, ring strat_tailRing,
693                BOOLEAN testp, int lpos, TSet T, int tlength)
694{
695  if (testp)
696  {
697    poly pn = NULL;
698    if (L->bucket != NULL)
699    {
700      kFalseReturn(kbTest(L->bucket));
701      r_assume(L->bucket->bucket_ring == L->tailRing);
702      if (L->p != NULL && pNext(L->p) != NULL)
703      {
704        pn = pNext(L->p);
705        pNext(L->p) = NULL;
706      }
707    }
708    kFalseReturn(kTest_T(L, strat_tailRing, lpos, 'L'));
709    if (pn != NULL)
710      pNext(L->p) = pn;
711
712    ring r;
713    poly p;
714    L->GetLm(p, r);
715    if (L->sev != 0 && p_GetShortExpVector(p, r) != L->sev)
716    {
717      return dReportError("L[%d] wrong sev: has %o, specified to have %o",
718                          lpos, p_GetShortExpVector(p, r), L->sev);
719    }
720    if (lpos > 0 && L->last != NULL && pLast(p) != L->last)
721    {
722      return dReportError("L[%d] last wrong: has %p specified to have %p",
723                          lpos, pLast(p), L->last);
724    }
725  }
726  if (L->p1 == NULL)
727  {
728    // L->p2 either NULL or "normal" poly
729    pFalseReturn(pp_Test(L->p2, currRing, L->tailRing));
730  }
731  else if (tlength > 0 && T != NULL && (lpos >=0))
732  {
733    // now p1 and p2 must be != NULL and must be contained in T
734    int i;
735    i = kFindInT(L->p1, T, tlength);
736    if (i < 0)
737      return dReportError("L[%d].p1 not in T",lpos);
738    i = kFindInT(L->p2, T, tlength);
739    if (i < 0)
740      return dReportError("L[%d].p2 not in T",lpos);
741  }
742  return TRUE;
743}
744
745BOOLEAN kTest (kStrategy strat)
746{
747  int i;
748
749  // test P
750  kFalseReturn(kTest_L(&(strat->P), strat->tailRing,
751                       (strat->P.p != NULL && pNext(strat->P.p)!=strat->tail),
752                       -1, strat->T, strat->tl));
753
754  // test T
755  if (strat->T != NULL)
756  {
757    for (i=0; i<=strat->tl; i++)
758    {
759      kFalseReturn(kTest_T(&(strat->T[i]), strat->tailRing, i, 'T'));
760      if (strat->sevT[i] != pGetShortExpVector(strat->T[i].p))
761        return dReportError("strat->sevT[%d] out of sync", i);
762    }
763  }
764
765  // test L
766  if (strat->L != NULL)
767  {
768    for (i=0; i<=strat->Ll; i++)
769    {
770      kFalseReturn(kTest_L(&(strat->L[i]), strat->tailRing,
771                           strat->L[i].Next() != strat->tail, i,
772                           strat->T, strat->tl));
773      if (strat->use_buckets && strat->L[i].Next() != strat->tail &&
774          strat->L[i].Next() != NULL && strat->L[i].p1 != NULL)
775      {
776        assume(strat->L[i].bucket != NULL);
777      }
778    }
779  }
780
781  // test S
782  if (strat->S != NULL)
783    kFalseReturn(kTest_S(strat));
784
785  return TRUE;
786}
787
788BOOLEAN kTest_S(kStrategy strat)
789{
790  int i;
791  BOOLEAN ret = TRUE;
792  for (i=0; i<=strat->sl; i++)
793  {
794    if (strat->S[i] != NULL &&
795        strat->sevS[i] != pGetShortExpVector(strat->S[i]))
796    {
797      return dReportError("S[%d] wrong sev: has %o, specified to have %o",
798                          i , pGetShortExpVector(strat->S[i]), strat->sevS[i]);
799    }
800  }
801  return ret;
802}
803
804
805
806BOOLEAN kTest_TS(kStrategy strat)
807{
808  int i, j;
809  BOOLEAN ret = TRUE;
810  kFalseReturn(kTest(strat));
811
812  // test strat->R, strat->T[i].i_r
813  for (i=0; i<=strat->tl; i++)
814  {
815    if (strat->T[i].i_r < 0 || strat->T[i].i_r > strat->tl)
816      return dReportError("strat->T[%d].i_r == %d out of bounds", i,
817                          strat->T[i].i_r);
818    if (strat->R[strat->T[i].i_r] != &(strat->T[i]))
819      return dReportError("T[%d].i_r with R out of sync", i);
820  }
821  // test containment of S inT
822  if (strat->S != NULL)
823  {
824    for (i=0; i<=strat->sl; i++)
825    {
826      j = kFindInT(strat->S[i], strat->T, strat->tl);
827      if (j < 0)
828        return dReportError("S[%d] not in T", i);
829      if (strat->S_2_R[i] != strat->T[j].i_r)
830        return dReportError("S_2_R[%d]=%d != T[%d].i_r=%d\n",
831                            i, strat->S_2_R[i], j, strat->T[j].i_r);
832    }
833  }
834  // test strat->L[i].i_r1
835  for (i=0; i<=strat->Ll; i++)
836  {
837    if (strat->L[i].p1 != NULL && strat->L[i].p2)
838    {
839      if (strat->L[i].i_r1 < 0 ||
840          strat->L[i].i_r1 > strat->tl ||
841          strat->L[i].T_1(strat)->p != strat->L[i].p1)
842        return dReportError("L[%d].i_r1 out of sync", i);
843      if (strat->L[i].i_r2 < 0 ||
844          strat->L[i].i_r2 > strat->tl ||
845          strat->L[i].T_2(strat)->p != strat->L[i].p2);
846    }
847    else
848    {
849      if (strat->L[i].i_r1 != -1)
850        return dReportError("L[%d].i_r1 out of sync", i);
851      if (strat->L[i].i_r2 != -1)
852        return dReportError("L[%d].i_r2 out of sync", i);
853    }
854    if (strat->L[i].i_r != -1)
855      return dReportError("L[%d].i_r out of sync", i);
856  }
857  return TRUE;
858}
859
860#endif // KDEBUG
861
862/*2
863*cancels the i-th polynomial in the standardbase s
864*/
865void deleteInS (int i,kStrategy strat)
866{
867#ifdef ENTER_USE_MEMMOVE
868  memmove(&(strat->S[i]), &(strat->S[i+1]), (strat->sl - i)*sizeof(poly));
869  memmove(&(strat->ecartS[i]),&(strat->ecartS[i+1]),(strat->sl - i)*sizeof(int));
870  memmove(&(strat->sevS[i]),&(strat->sevS[i+1]),(strat->sl - i)*sizeof(long));
871  memmove(&(strat->S_2_R[i]),&(strat->S_2_R[i+1]),(strat->sl - i)*sizeof(int));
872#else
873  int j;
874  for (j=i; j<strat->sl; j++)
875  {
876    strat->S[j] = strat->S[j+1];
877    strat->ecartS[j] = strat->ecartS[j+1];
878    strat->sevS[j] = strat->sevS[j+1];
879    strat->S_2_R[j] = strat->S_2_R[j+1];
880  }
881#endif
882  if (strat->lenS!=NULL)
883  {
884#ifdef ENTER_USE_MEMMOVE
885    memmove(&(strat->lenS[i]),&(strat->lenS[i+1]),(strat->sl - i)*sizeof(int));
886#else
887    for (j=i; j<strat->sl; j++) strat->lenS[j] = strat->lenS[j+1];
888#endif
889  }
890  if (strat->lenSw!=NULL)
891  {
892#ifdef ENTER_USE_MEMMOVE
893    memmove(&(strat->lenSw[i]),&(strat->lenSw[i+1]),(strat->sl - i)*sizeof(wlen_type));
894#else
895    for (j=i; j<strat->sl; j++) strat->lenSw[j] = strat->lenSw[j+1];
896#endif
897  }
898  if (strat->fromQ!=NULL)
899  {
900#ifdef ENTER_USE_MEMMOVE
901    memmove(&(strat->fromQ[i]),&(strat->fromQ[i+1]),(strat->sl - i)*sizeof(int));
902#else
903    for (j=i; j<strat->sl; j++)
904    {
905      strat->fromQ[j] = strat->fromQ[j+1];
906    }
907#endif
908  }
909  strat->S[strat->sl] = NULL;
910  strat->sl--;
911}
912
913/*2
914*cancels the j-th polynomial in the set
915*/
916void deleteInL (LSet set, int *length, int j,kStrategy strat)
917{
918  if (set[j].lcm!=NULL)
919#ifdef HAVE_RINGS
920    if (pGetCoeff(set[j].lcm) != NULL)
921      pLmDelete(set[j].lcm);
922    else
923#endif
924      pLmFree(set[j].lcm);
925  if (set[j].p!=NULL)
926  {
927    if (pNext(set[j].p) == strat->tail)
928    {
929#ifdef HAVE_RINGS
930      if (pGetCoeff(set[j].p) != NULL)
931        pLmDelete(set[j].p);
932      else
933#endif
934        pLmFree(set[j].p);
935      /*- tail belongs to several int spolys -*/
936    }
937    else
938    {
939      // search p in T, if it is there, do not delete it
940      if (pOrdSgn != -1 || kFindInT(set[j].p, strat) < 0)
941      {
942        // assure that for global orderings kFindInT fails
943        assume(pOrdSgn == -1 || kFindInT(set[j].p, strat) < 0);
944        set[j].Delete();
945      }
946    }
947  }
948  if (*length > 0 && j < *length)
949  {
950#ifdef ENTER_USE_MEMMOVE
951    memmove(&(set[j]), &(set[j+1]), (*length - j)*sizeof(LObject));
952#else
953    int i;
954    for (i=j; i < (*length); i++)
955      set[i] = set[i+1];
956#endif
957  }
958#ifdef KDEBUG
959  memset(&(set[*length]),0,sizeof(LObject));
960#endif
961  (*length)--;
962}
963
964/*2
965*enters p at position at in L
966*/
967void enterL (LSet *set,int *length, int *LSetmax, LObject p,int at)
968{
969#ifdef PDEBUG
970  /*  zaehler++; */
971#endif /*PDEBUG*/
972  int i;
973  // this should be corrected
974  assume(p.FDeg == p.pFDeg());
975
976  if ((*length)>=0)
977  {
978    if ((*length) == (*LSetmax)-1) enlargeL(set,LSetmax,setmaxLinc);
979    if (at <= (*length))
980#ifdef ENTER_USE_MEMMOVE
981      memmove(&((*set)[at+1]), &((*set)[at]), ((*length)-at+1)*sizeof(LObject));
982#else
983    for (i=(*length)+1; i>=at+1; i--) (*set)[i] = (*set)[i-1];
984#endif
985  }
986  else at = 0;
987  (*set)[at] = p;
988  (*length)++;
989}
990
991/*2
992* computes the normal ecart;
993* used in mora case and if pLexOrder & sugar in bba case
994*/
995void initEcartNormal (LObject* h)
996{
997  h->FDeg = h->pFDeg();
998  h->ecart = h->pLDeg() - h->FDeg;
999  // h->length is set by h->pLDeg
1000  h->length=h->pLength=pLength(h->p);
1001}
1002
1003void initEcartBBA (LObject* h)
1004{
1005  h->FDeg = h->pFDeg();
1006  (*h).ecart = 0;
1007  h->length=h->pLength=pLength(h->p);
1008}
1009
1010void initEcartPairBba (LObject* Lp,poly f,poly g,int ecartF,int ecartG)
1011{
1012  Lp->FDeg = Lp->pFDeg();
1013  (*Lp).ecart = 0;
1014  (*Lp).length = 0;
1015}
1016
1017void initEcartPairMora (LObject* Lp,poly f,poly g,int ecartF,int ecartG)
1018{
1019  Lp->FDeg = Lp->pFDeg();
1020  (*Lp).ecart = si_max(ecartF,ecartG);
1021  (*Lp).ecart = (*Lp).ecart- (Lp->FDeg -pFDeg((*Lp).lcm,currRing));
1022  (*Lp).length = 0;
1023}
1024
1025/*2
1026*if ecart1<=ecart2 it returns TRUE
1027*/
1028static inline BOOLEAN sugarDivisibleBy(int ecart1, int ecart2)
1029{
1030  return (ecart1 <= ecart2);
1031}
1032
1033#ifdef HAVE_RINGS
1034/*2
1035* put the pair (s[i],p)  into the set B, ecart=ecart(p) (ring case)
1036*/
1037void enterOnePairRing (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
1038{
1039  assume(i<=strat->sl);
1040  int      l,j,compare,compareCoeff;
1041  LObject  Lp;
1042
1043  if (strat->interred_flag) return;
1044#ifdef KDEBUG
1045  Lp.ecart=0; Lp.length=0;
1046#endif
1047  /*- computes the lcm(s[i],p) -*/
1048  Lp.lcm = pInit();
1049  pSetCoeff0(Lp.lcm, nLcm(pGetCoeff(p), pGetCoeff(strat->S[i]), currRing));
1050  // Lp.lcm == 0
1051  if (nIsZero(pGetCoeff(Lp.lcm)))
1052  {
1053#ifdef KDEBUG
1054      if (TEST_OPT_DEBUG)
1055      {
1056        PrintS("--- Lp.lcm == 0\n");
1057        PrintS("p:");
1058        wrp(p);
1059        Print("  strat->S[%d]:", i);
1060        wrp(strat->S[i]);
1061        PrintLn();
1062      }
1063#endif
1064      strat->cp++;
1065      pLmDelete(Lp.lcm);
1066      return;
1067  }
1068  // basic product criterion
1069  pLcm(p,strat->S[i],Lp.lcm);
1070  pSetm(Lp.lcm);
1071  assume(!strat->sugarCrit);
1072  if (pHasNotCF(p,strat->S[i]) && nIsUnit(pGetCoeff(p)) && nIsUnit(pGetCoeff(strat->S[i])))
1073  {
1074#ifdef KDEBUG
1075      if (TEST_OPT_DEBUG)
1076      {
1077        PrintS("--- product criterion func enterOnePairRing type 1\n");
1078        PrintS("p:");
1079        wrp(p);
1080        Print("  strat->S[%d]:", i);
1081        wrp(strat->S[i]);
1082        PrintLn();
1083      }
1084#endif
1085      strat->cp++;
1086      pLmDelete(Lp.lcm);
1087      return;
1088  }
1089  assume(!strat->fromT);
1090  /*
1091  *the set B collects the pairs of type (S[j],p)
1092  *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
1093  *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1094  *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1095  */
1096  for(j = strat->Bl;j>=0;j--)
1097  {
1098    compare=pDivCompRing(strat->B[j].lcm,Lp.lcm);
1099    compareCoeff = nComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(Lp.lcm));
1100    if (compareCoeff == 0 || compare == compareCoeff)
1101    {
1102      if (compare == 1)
1103      {
1104        strat->c3++;
1105#ifdef KDEBUG
1106        if (TEST_OPT_DEBUG)
1107        {
1108          PrintS("--- chain criterion type 1\n");
1109          PrintS("strat->B[j]:");
1110          wrp(strat->B[j].lcm);
1111          PrintS("  Lp.lcm:");
1112          wrp(Lp.lcm);
1113          PrintLn();
1114        }
1115#endif
1116        if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1117        {
1118          pLmDelete(Lp.lcm);
1119          return;
1120        }
1121        break;
1122      }
1123      else
1124      if (compare == -1)
1125      {
1126#ifdef KDEBUG
1127        if (TEST_OPT_DEBUG)
1128        {
1129          PrintS("--- chain criterion type 2\n");
1130          Print("strat->B[%d].lcm:",j);
1131          wrp(strat->B[j].lcm);
1132          PrintS("  Lp.lcm:");
1133          wrp(Lp.lcm);
1134          PrintLn();
1135        }
1136#endif
1137        deleteInL(strat->B,&strat->Bl,j,strat);
1138        strat->c3++;
1139      }
1140    }
1141    if ((compare == pDivComp_EQUAL) && (compareCoeff != 2))
1142    {
1143      if (compareCoeff == pDivComp_LESS)
1144      {
1145#ifdef KDEBUG
1146        if (TEST_OPT_DEBUG)
1147        {
1148          PrintS("--- chain criterion type 3\n");
1149          Print("strat->B[%d].lcm:", j);
1150          wrp(strat->B[j].lcm);
1151          PrintS("  Lp.lcm:");
1152          wrp(Lp.lcm);
1153          PrintLn();
1154        }
1155#endif
1156        strat->c3++;
1157        if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1158        {
1159          pLmDelete(Lp.lcm);
1160          return;
1161        }
1162        break;
1163      }
1164      else
1165      // Add hint for same LM and LC (later) (TODO Oliver)
1166      // if (compareCoeff == pDivComp_GREATER)
1167      {
1168#ifdef KDEBUG
1169        if (TEST_OPT_DEBUG)
1170        {
1171          PrintS("--- chain criterion type 4\n");
1172          Print("strat->B[%d].lcm:", j);
1173          wrp(strat->B[j].lcm);
1174          PrintS("  Lp.lcm:");
1175          wrp(Lp.lcm);
1176          PrintLn();
1177        }
1178#endif
1179        deleteInL(strat->B,&strat->Bl,j,strat);
1180        strat->c3++;
1181      }
1182    }
1183  }
1184  /*
1185  *the pair (S[i],p) enters B if the spoly != 0
1186  */
1187  /*-  compute the short s-polynomial -*/
1188  if ((strat->S[i]==NULL) || (p==NULL)) {
1189#ifdef KDEBUG
1190    if (TEST_OPT_DEBUG)
1191    {
1192      PrintS("--- spoly = NULL\n");
1193    }
1194#endif
1195    pLmDelete(Lp.lcm);
1196    return;
1197  }
1198  pNorm(p);
1199  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
1200  {
1201    // Is from a previous computed GB, therefore we know that spoly will
1202    // reduce to zero. Oliver.
1203    WarnS("Could we come here? 8738947389");
1204    Lp.p=NULL;
1205  }
1206  else
1207  {
1208    Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
1209  }
1210  if (Lp.p == NULL)
1211  {
1212#ifdef KDEBUG
1213    if (TEST_OPT_DEBUG)
1214    {
1215      PrintS("--- spoly = NULL\n");
1216    }
1217#endif
1218    /*- the case that the s-poly is 0 -*/
1219    if (strat->pairtest==NULL) initPairtest(strat);
1220    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
1221    strat->pairtest[strat->sl+1] = TRUE;
1222    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
1223    /*
1224    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
1225    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
1226    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
1227    *term of p devides the lcm(s,r)
1228    *(this canceling should be done here because
1229    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
1230    *the first case is handeled in chainCrit
1231    */
1232    pLmDelete(Lp.lcm);
1233  }
1234  else
1235  {
1236    /*- the pair (S[i],p) enters B -*/
1237    Lp.p1 = strat->S[i];
1238    Lp.p2 = p;
1239
1240    pNext(Lp.p) = strat->tail;
1241
1242    if (atR >= 0)
1243    {
1244      Lp.i_r2 = atR;
1245      Lp.i_r1 = strat->S_2_R[i];
1246    }
1247    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1248    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
1249    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
1250  }
1251}
1252
1253
1254/*2
1255* put the  lcm(s[i],p)  into the set B
1256*/
1257
1258BOOLEAN enterOneStrongPoly (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
1259{
1260  number d, s, t;
1261  assume(i<=strat->sl);
1262  LObject  Lp;
1263  poly m1, m2, erg, gcd;
1264
1265  d = nExtGcd(pGetCoeff(p), pGetCoeff(strat->S[i]), &s, &t);
1266
1267  if (nIsZero(s) || nIsZero(t))  // evtl. durch divBy tests ersetzen
1268  {
1269    nDelete(&d);
1270    nDelete(&s);
1271    nDelete(&t);
1272    return FALSE;
1273  }
1274
1275  k_GetStrongLeadTerms(p, strat->S[i], currRing, m1, m2, gcd, strat->tailRing);
1276
1277  pSetCoeff0(m1, s);
1278  pSetCoeff0(m2, t);
1279  pSetCoeff0(gcd, d);
1280
1281
1282#ifdef KDEBUG
1283  if (TEST_OPT_DEBUG)
1284  {
1285    Print("t = %d; s = %d; d = %d\n", nInt(t), nInt(s), nInt(d));
1286    PrintS("m1 = ");
1287    p_wrp(m1, strat->tailRing);
1288    PrintS(" ; m2 = ");
1289    p_wrp(m2, strat->tailRing);
1290    PrintS(" ; gcd = ");
1291    wrp(gcd);
1292    PrintS("\n--- create strong gcd poly: ");
1293    Print("\n p: ", i);
1294    wrp(p);
1295    Print("\n strat->S[%d]: ", i);
1296    wrp(strat->S[i]);
1297    PrintS(" ---> ");
1298  }
1299#endif
1300
1301  erg = p_Add_q(pp_Mult_mm(pNext(p), m1, strat->tailRing), pp_Mult_mm(pNext(strat->S[i]), m2, strat->tailRing), strat->tailRing);
1302  pNext(gcd) = erg;
1303  pLmDelete(m1);
1304  pLmDelete(m2);
1305
1306#ifdef KDEBUG
1307    if (TEST_OPT_DEBUG)
1308    {
1309      wrp(gcd);
1310      PrintLn();
1311    }
1312#endif
1313
1314  LObject h;
1315  h.p = gcd;
1316  h.tailRing = strat->tailRing;
1317  int posx;
1318  if (h.p!=NULL)
1319  {
1320    if (TEST_OPT_INTSTRATEGY)
1321    {
1322      h.pCleardenom(); // also does a pContent
1323    }
1324    else
1325    {
1326      h.pNorm();
1327    }
1328    strat->initEcart(&h);
1329    if (strat->Ll==-1)
1330      posx =0;
1331    else
1332      posx = strat->posInL(strat->L,strat->Ll,&h,strat);
1333    h.sev = pGetShortExpVector(h.p);
1334    h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
1335    if (pNext(p) != NULL)
1336    {
1337      // What does this? (Oliver)
1338      // pShallowCopyDeleteProc p_shallow_copy_delete
1339      //      = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
1340      // pNext(p) = p_shallow_copy_delete(pNext(p),
1341      //              currRing, strat->tailRing, strat->tailRing->PolyBin);
1342    }
1343    enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
1344  }
1345  return TRUE;
1346}
1347#endif
1348
1349/*2
1350* put the pair (s[i],p)  into the set B, ecart=ecart(p)
1351*/
1352
1353void enterOnePair (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
1354{
1355  assume(i<=strat->sl);
1356  if (strat->interred_flag) return;
1357
1358  int      l,j,compare;
1359  LObject  Lp;
1360  Lp.i_r = -1;
1361
1362#ifdef KDEBUG
1363  Lp.ecart=0; Lp.length=0;
1364#endif
1365  /*- computes the lcm(s[i],p) -*/
1366  Lp.lcm = pInit();
1367
1368  pLcm(p,strat->S[i],Lp.lcm);
1369  pSetm(Lp.lcm);
1370
1371#ifdef HAVE_PLURAL
1372  const BOOLEAN bIsPluralRing = rIsPluralRing(currRing);
1373  const BOOLEAN bIsSCA        = rIsSCA(currRing) && strat->homog; // for prod-crit
1374  const BOOLEAN bNCProdCrit   = ( !bIsPluralRing || bIsSCA ); // commutative or homogeneous SCA
1375#else
1376  const BOOLEAN bIsPluralRing = FALSE;
1377  const BOOLEAN bIsSCA        = FALSE;
1378  const BOOLEAN bNCProdCrit   = TRUE;
1379#endif
1380
1381  if (strat->sugarCrit && bNCProdCrit)
1382  {
1383    if((!((strat->ecartS[i]>0)&&(ecart>0)))
1384    && pHasNotCF(p,strat->S[i]))
1385    {
1386    /*
1387    *the product criterion has applied for (s,p),
1388    *i.e. lcm(s,p)=product of the leading terms of s and p.
1389    *Suppose (s,r) is in L and the leading term
1390    *of p divides lcm(s,r)
1391    *(==> the leading term of p divides the leading term of r)
1392    *but the leading term of s does not divide the leading term of r
1393    *(notice that tis condition is automatically satisfied if r is still
1394    *in S), then (s,r) can be cancelled.
1395    *This should be done here because the
1396    *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
1397    *
1398    *Moreover, skipping (s,r) holds also for the noncommutative case.
1399    */
1400      strat->cp++;
1401      pLmFree(Lp.lcm);
1402      Lp.lcm=NULL;
1403      return;
1404    }
1405    else
1406      Lp.ecart = si_max(ecart,strat->ecartS[i]);
1407    if (strat->fromT && (strat->ecartS[i]>ecart))
1408    {
1409      pLmFree(Lp.lcm);
1410      Lp.lcm=NULL;
1411      return;
1412      /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
1413    }
1414    /*
1415    *the set B collects the pairs of type (S[j],p)
1416    *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
1417    *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1418    *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1419    */
1420    {
1421      j = strat->Bl;
1422      loop
1423      {
1424        if (j < 0)  break;
1425        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
1426        if ((compare==1)
1427        &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
1428        {
1429          strat->c3++;
1430          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1431          {
1432            pLmFree(Lp.lcm);
1433            return;
1434          }
1435          break;
1436        }
1437        else
1438        if ((compare ==-1)
1439        && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
1440        {
1441          deleteInL(strat->B,&strat->Bl,j,strat);
1442          strat->c3++;
1443        }
1444        j--;
1445      }
1446    }
1447  }
1448  else /*sugarcrit*/
1449  {
1450    if (bNCProdCrit)
1451    {
1452      // if currRing->nc_type!=quasi (or skew)
1453      // TODO: enable productCrit for super commutative algebras...
1454      if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
1455      pHasNotCF(p,strat->S[i]))
1456      {
1457      /*
1458      *the product criterion has applied for (s,p),
1459      *i.e. lcm(s,p)=product of the leading terms of s and p.
1460      *Suppose (s,r) is in L and the leading term
1461      *of p devides lcm(s,r)
1462      *(==> the leading term of p devides the leading term of r)
1463      *but the leading term of s does not devide the leading term of r
1464      *(notice that tis condition is automatically satisfied if r is still
1465      *in S), then (s,r) can be canceled.
1466      *This should be done here because the
1467      *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
1468      */
1469          strat->cp++;
1470          pLmFree(Lp.lcm);
1471          Lp.lcm=NULL;
1472          return;
1473      }
1474      if (strat->fromT && (strat->ecartS[i]>ecart))
1475      {
1476        pLmFree(Lp.lcm);
1477        Lp.lcm=NULL;
1478        return;
1479        /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
1480      }
1481      /*
1482      *the set B collects the pairs of type (S[j],p)
1483      *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
1484      *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1485      *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1486      */
1487      for(j = strat->Bl;j>=0;j--)
1488      {
1489        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
1490        if (compare==1)
1491        {
1492          strat->c3++;
1493          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1494          {
1495            pLmFree(Lp.lcm);
1496            return;
1497          }
1498          break;
1499        }
1500        else
1501        if (compare ==-1)
1502        {
1503          deleteInL(strat->B,&strat->Bl,j,strat);
1504          strat->c3++;
1505        }
1506      }
1507    }
1508  }
1509  /*
1510  *the pair (S[i],p) enters B if the spoly != 0
1511  */
1512  /*-  compute the short s-polynomial -*/
1513  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
1514    pNorm(p);
1515  if ((strat->S[i]==NULL) || (p==NULL))
1516    return;
1517  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
1518    Lp.p=NULL;
1519  else
1520  {
1521    #ifdef HAVE_PLURAL
1522    if ( bIsPluralRing )
1523    {
1524      if(pHasNotCF(p, strat->S[i]))
1525      {
1526        if(ncRingType(currRing) == nc_lie)
1527        {
1528            // generalized prod-crit for lie-type
1529            strat->cp++;
1530            Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i]);
1531        }
1532        else
1533        if( bIsSCA )
1534        {
1535            // product criterion for homogeneous case in SCA
1536            strat->cp++;
1537            Lp.p = NULL;
1538        }
1539        else
1540          Lp.p = nc_CreateSpoly(strat->S[i],p,currRing); // ?
1541      }
1542      else  Lp.p = nc_CreateSpoly(strat->S[i],p,currRing);
1543    }
1544    else
1545    #endif
1546    {
1547      Lp.p = ksCreateShortSpoly(strat->S[i],p, strat->tailRing);
1548    }
1549  }
1550  if (Lp.p == NULL)
1551  {
1552    /*- the case that the s-poly is 0 -*/
1553    if (strat->pairtest==NULL) initPairtest(strat);
1554    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
1555    strat->pairtest[strat->sl+1] = TRUE;
1556    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
1557    /*
1558    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
1559    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
1560    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
1561    *term of p devides the lcm(s,r)
1562    *(this canceling should be done here because
1563    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
1564    *the first case is handeled in chainCrit
1565    */
1566    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
1567  }
1568  else
1569  {
1570    /*- the pair (S[i],p) enters B -*/
1571    Lp.p1 = strat->S[i];
1572    Lp.p2 = p;
1573
1574    if ( !bIsPluralRing )
1575      pNext(Lp.p) = strat->tail;
1576
1577    if (atR >= 0)
1578    {
1579      Lp.i_r1 = strat->S_2_R[i];
1580      Lp.i_r2 = atR;
1581    }
1582    else
1583    {
1584      Lp.i_r1 = -1;
1585      Lp.i_r2 = -1;
1586    }
1587    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1588
1589    if (TEST_OPT_INTSTRATEGY)
1590    {
1591      if (!bIsPluralRing)
1592        nDelete(&(Lp.p->coef));
1593    }
1594
1595    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
1596    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
1597  }
1598}
1599
1600/*2
1601* put the pair (s[i],p) into the set L, ecart=ecart(p)
1602* in the case that s forms a SB of (s)
1603*/
1604void enterOnePairSpecial (int i,poly p,int ecart,kStrategy strat, int atR = -1)
1605{
1606  //PrintS("try ");wrp(strat->S[i]);PrintS(" and ");wrp(p);PrintLn();
1607  if(pHasNotCF(p,strat->S[i]))
1608  {
1609    //PrintS("prod-crit\n");
1610    #ifdef HAVE_PLURAL
1611    if(!rIsPluralRing(currRing) || (rIsSCA(currRing) && strat->homog))
1612    #endif
1613    {
1614      //PrintS("prod-crit\n");
1615      strat->cp++;
1616      return;
1617    }
1618  }
1619
1620  int      l,j,compare;
1621  LObject  Lp;
1622  Lp.i_r = -1;
1623
1624  Lp.lcm = pInit();
1625  pLcm(p,strat->S[i],Lp.lcm);
1626  pSetm(Lp.lcm);
1627  for(j = strat->Ll;j>=0;j--)
1628  {
1629    compare=pDivComp(strat->L[j].lcm,Lp.lcm);
1630    if ((compare==1) || (pLmEqual(strat->L[j].lcm,Lp.lcm)))
1631    {
1632      //PrintS("c3-crit\n");
1633      strat->c3++;
1634      pLmFree(Lp.lcm);
1635      return;
1636    }
1637    else if (compare ==-1)
1638    {
1639      //Print("c3-crit with L[%d]\n",j);
1640      deleteInL(strat->L,&strat->Ll,j,strat);
1641      strat->c3++;
1642    }
1643  }
1644  /*-  compute the short s-polynomial -*/
1645
1646  #ifdef HAVE_PLURAL
1647  if (rIsPluralRing(currRing))
1648  {
1649    Lp.p = nc_CreateShortSpoly(strat->S[i],p); // ???
1650  }
1651  else
1652  #endif
1653    Lp.p = ksCreateShortSpoly(strat->S[i],p,strat->tailRing);
1654
1655  if (Lp.p == NULL)
1656  {
1657     //PrintS("short spoly==NULL\n");
1658     pLmFree(Lp.lcm);
1659  }
1660  else
1661  {
1662    /*- the pair (S[i],p) enters L -*/
1663    Lp.p1 = strat->S[i];
1664    Lp.p2 = p;
1665    if (atR >= 0)
1666    {
1667      Lp.i_r1 = strat->S_2_R[i];
1668      Lp.i_r2 = atR;
1669    }
1670    else
1671    {
1672      Lp.i_r1 = -1;
1673      Lp.i_r2 = -1;
1674    }
1675    pNext(Lp.p) = strat->tail;
1676    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1677    if (TEST_OPT_INTSTRATEGY)
1678    {
1679      nDelete(&(Lp.p->coef));
1680    }
1681    l = strat->posInL(strat->L,strat->Ll,&Lp,strat);
1682    //Print("-> L[%d]\n",l);
1683    enterL(&strat->L,&strat->Ll,&strat->Lmax,Lp,l);
1684  }
1685}
1686
1687/*2
1688*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
1689*using the chain-criterion in B and L and enters B to L
1690*/
1691void chainCrit (poly p,int ecart,kStrategy strat)
1692{
1693  int i,j,l;
1694
1695  /*
1696  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
1697  *In this case all elements in B such
1698  *that their lcm is divisible by the leading term of S[i] can be canceled
1699  */
1700  if (strat->pairtest!=NULL)
1701  {
1702    {
1703      /*- i.e. there is an i with pairtest[i]==TRUE -*/
1704      for (j=0; j<=strat->sl; j++)
1705      {
1706        if (strat->pairtest[j])
1707        {
1708          for (i=strat->Bl; i>=0; i--)
1709          {
1710            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
1711            {
1712              deleteInL(strat->B,&strat->Bl,i,strat);
1713              strat->c3++;
1714            }
1715          }
1716        }
1717      }
1718    }
1719    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
1720    strat->pairtest=NULL;
1721  }
1722  if (strat->Gebauer || strat->fromT)
1723  {
1724    if (strat->sugarCrit)
1725    {
1726    /*
1727    *suppose L[j] == (s,r) and p/lcm(s,r)
1728    *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
1729    *and in case the sugar is o.k. then L[j] can be canceled
1730    */
1731      for (j=strat->Ll; j>=0; j--)
1732      {
1733        if (sugarDivisibleBy(ecart,strat->L[j].ecart)
1734        && ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
1735        && pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1736        {
1737          if (strat->L[j].p == strat->tail)
1738          {
1739              deleteInL(strat->L,&strat->Ll,j,strat);
1740              strat->c3++;
1741          }
1742        }
1743      }
1744      /*
1745      *this is GEBAUER-MOELLER:
1746      *in B all elements with the same lcm except the "best"
1747      *(i.e. the last one in B with this property) will be canceled
1748      */
1749      j = strat->Bl;
1750      loop /*cannot be changed into a for !!! */
1751      {
1752        if (j <= 0) break;
1753        i = j-1;
1754        loop
1755        {
1756          if (i <  0) break;
1757          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
1758          {
1759            strat->c3++;
1760            if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
1761            {
1762              deleteInL(strat->B,&strat->Bl,i,strat);
1763              j--;
1764            }
1765            else
1766            {
1767              deleteInL(strat->B,&strat->Bl,j,strat);
1768              break;
1769            }
1770          }
1771          i--;
1772        }
1773        j--;
1774      }
1775    }
1776    else /*sugarCrit*/
1777    {
1778      /*
1779      *suppose L[j] == (s,r) and p/lcm(s,r)
1780      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
1781      *and in case the sugar is o.k. then L[j] can be canceled
1782      */
1783      for (j=strat->Ll; j>=0; j--)
1784      {
1785        if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1786        {
1787          if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
1788          {
1789            deleteInL(strat->L,&strat->Ll,j,strat);
1790            strat->c3++;
1791          }
1792        }
1793      }
1794      /*
1795      *this is GEBAUER-MOELLER:
1796      *in B all elements with the same lcm except the "best"
1797      *(i.e. the last one in B with this property) will be canceled
1798      */
1799      j = strat->Bl;
1800      loop   /*cannot be changed into a for !!! */
1801      {
1802        if (j <= 0) break;
1803        for(i=j-1; i>=0; i--)
1804        {
1805          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
1806          {
1807            strat->c3++;
1808            deleteInL(strat->B,&strat->Bl,i,strat);
1809            j--;
1810          }
1811        }
1812        j--;
1813      }
1814    }
1815    /*
1816    *the elements of B enter L/their order with respect to B is kept
1817    *j = posInL(L,j,B[i]) would permutate the order
1818    *if once B is ordered different from L
1819    *then one should use j = posInL(L,Ll,B[i])
1820    */
1821    j = strat->Ll+1;
1822    for (i=strat->Bl; i>=0; i--)
1823    {
1824      j = strat->posInL(strat->L,j-1,&(strat->B[i]),strat);
1825      enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
1826    }
1827    strat->Bl = -1;
1828  }
1829  else
1830  {
1831    for (j=strat->Ll; j>=0; j--)
1832    {
1833      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1834      {
1835        if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
1836        {
1837          deleteInL(strat->L,&strat->Ll,j,strat);
1838          strat->c3++;
1839        }
1840      }
1841    }
1842    /*
1843    *this is our MODIFICATION of GEBAUER-MOELLER:
1844    *First the elements of B enter L,
1845    *then we fix a lcm and the "best" element in L
1846    *(i.e the last in L with this lcm and of type (s,p))
1847    *and cancel all the other elements of type (r,p) with this lcm
1848    *except the case the element (s,r) has also the same lcm
1849    *and is on the worst position with respect to (s,p) and (r,p)
1850    */
1851    /*
1852    *B enters to L/their order with respect to B is permutated for elements
1853    *B[i].p with the same leading term
1854    */
1855    j = strat->Ll;
1856    for (i=strat->Bl; i>=0; i--)
1857    {
1858      j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
1859      enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
1860    }
1861    strat->Bl = -1;
1862    j = strat->Ll;
1863    loop  /*cannot be changed into a for !!! */
1864    {
1865      if (j <= 0)
1866      {
1867        /*now L[0] cannot be canceled any more and the tail can be removed*/
1868        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
1869        break;
1870      }
1871      if (strat->L[j].p2 == p)
1872      {
1873        i = j-1;
1874        loop
1875        {
1876          if (i < 0)  break;
1877          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
1878          {
1879            /*L[i] could be canceled but we search for a better one to cancel*/
1880            strat->c3++;
1881            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
1882            && (pNext(strat->L[l].p) == strat->tail)
1883            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
1884            && pDivisibleBy(p,strat->L[l].lcm))
1885            {
1886              /*
1887              *"NOT equal(...)" because in case of "equal" the element L[l]
1888              *is "older" and has to be from theoretical point of view behind
1889              *L[i], but we do not want to reorder L
1890              */
1891              strat->L[i].p2 = strat->tail;
1892              /*
1893              *L[l] will be canceled, we cannot cancel L[i] later on,
1894              *so we mark it with "tail"
1895              */
1896              deleteInL(strat->L,&strat->Ll,l,strat);
1897              i--;
1898            }
1899            else
1900            {
1901              deleteInL(strat->L,&strat->Ll,i,strat);
1902            }
1903            j--;
1904          }
1905          i--;
1906        }
1907      }
1908      else if (strat->L[j].p2 == strat->tail)
1909      {
1910        /*now L[j] cannot be canceled any more and the tail can be removed*/
1911        strat->L[j].p2 = p;
1912      }
1913      j--;
1914    }
1915  }
1916}
1917
1918/*2
1919*(s[0],h),...,(s[k],h) will be put to the pairset L
1920*/
1921void initenterpairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
1922{
1923
1924  if ((strat->syzComp==0)
1925  || (pGetComp(h)<=strat->syzComp))
1926  {
1927    int j;
1928    BOOLEAN new_pair=FALSE;
1929
1930    if (pGetComp(h)==0)
1931    {
1932      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
1933      if ((isFromQ)&&(strat->fromQ!=NULL))
1934      {
1935        for (j=0; j<=k; j++)
1936        {
1937          if (!strat->fromQ[j])
1938          {
1939            new_pair=TRUE;
1940            enterOnePair(j,h,ecart,isFromQ,strat, atR);
1941          //Print("j:%d, Ll:%d\n",j,strat->Ll);
1942          }
1943        }
1944      }
1945      else
1946      {
1947        new_pair=TRUE;
1948        for (j=0; j<=k; j++)
1949        {
1950          enterOnePair(j,h,ecart,isFromQ,strat, atR);
1951          //Print("j:%d, Ll:%d\n",j,strat->Ll);
1952        }
1953      }
1954    }
1955    else
1956    {
1957      for (j=0; j<=k; j++)
1958      {
1959        if ((pGetComp(h)==pGetComp(strat->S[j]))
1960        || (pGetComp(strat->S[j])==0))
1961        {
1962          new_pair=TRUE;
1963          enterOnePair(j,h,ecart,isFromQ,strat, atR);
1964        //Print("j:%d, Ll:%d\n",j,strat->Ll);
1965        }
1966      }
1967    }
1968
1969    if (new_pair) chainCrit(h,ecart,strat);
1970
1971  }
1972}
1973
1974#ifdef HAVE_RINGS
1975/*2
1976*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
1977*using the chain-criterion in B and L and enters B to L
1978*/
1979void chainCritRing (poly p,int ecart,kStrategy strat)
1980{
1981  int i,j,l;
1982  /*
1983  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
1984  *In this case all elements in B such
1985  *that their lcm is divisible by the leading term of S[i] can be canceled
1986  */
1987  if (strat->pairtest!=NULL)
1988  {
1989    {
1990      /*- i.e. there is an i with pairtest[i]==TRUE -*/
1991      for (j=0; j<=strat->sl; j++)
1992      {
1993        if (strat->pairtest[j])
1994        {
1995          for (i=strat->Bl; i>=0; i--)
1996          {
1997            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
1998            {
1999#ifdef KDEBUG
2000              if (TEST_OPT_DEBUG)
2001              {
2002                PrintS("--- chain criterion func chainCritRing type 1\n");
2003                PrintS("strat->S[j]:");
2004                wrp(strat->S[j]);
2005                PrintS("  strat->B[i].lcm:");
2006                wrp(strat->B[i].lcm);
2007                PrintLn();
2008              }
2009#endif
2010              deleteInL(strat->B,&strat->Bl,i,strat);
2011              strat->c3++;
2012            }
2013          }
2014        }
2015      }
2016    }
2017    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
2018    strat->pairtest=NULL;
2019  }
2020  assume(!(strat->Gebauer || strat->fromT));
2021  for (j=strat->Ll; j>=0; j--)
2022  {
2023    if (strat->L[j].lcm != NULL && nDivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(p)))
2024    {
2025      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2026      {
2027        if ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
2028        {
2029          deleteInL(strat->L,&strat->Ll,j,strat);
2030          strat->c3++;
2031#ifdef KDEBUG
2032              if (TEST_OPT_DEBUG)
2033              {
2034                PrintS("--- chain criterion func chainCritRing type 2\n");
2035                PrintS("strat->L[j].p:");
2036                wrp(strat->L[j].p);
2037                PrintS("  p:");
2038                wrp(p);
2039                PrintLn();
2040              }
2041#endif
2042        }
2043      }
2044    }
2045  }
2046  /*
2047  *this is our MODIFICATION of GEBAUER-MOELLER:
2048  *First the elements of B enter L,
2049  *then we fix a lcm and the "best" element in L
2050  *(i.e the last in L with this lcm and of type (s,p))
2051  *and cancel all the other elements of type (r,p) with this lcm
2052  *except the case the element (s,r) has also the same lcm
2053  *and is on the worst position with respect to (s,p) and (r,p)
2054  */
2055  /*
2056  *B enters to L/their order with respect to B is permutated for elements
2057  *B[i].p with the same leading term
2058  */
2059  j = strat->Ll;
2060  for (i=strat->Bl; i>=0; i--)
2061  {
2062    j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
2063    enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
2064  }
2065  strat->Bl = -1;
2066  j = strat->Ll;
2067  loop  /*cannot be changed into a for !!! */
2068  {
2069    if (j <= 0)
2070    {
2071      /*now L[0] cannot be canceled any more and the tail can be removed*/
2072      if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2073      break;
2074    }
2075    if (strat->L[j].p2 == p) // Was the element added from B?
2076    {
2077      i = j-1;
2078      loop
2079      {
2080        if (i < 0)  break;
2081        // Element is from B and has the same lcm as L[j]
2082        if ((strat->L[i].p2 == p) && nDivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(strat->L[i].lcm))
2083             && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2084        {
2085          /*L[i] could be canceled but we search for a better one to cancel*/
2086          strat->c3++;
2087#ifdef KDEBUG
2088          if (TEST_OPT_DEBUG)
2089          {
2090            PrintS("--- chain criterion func chainCritRing type 3\n");
2091            PrintS("strat->L[j].lcm:");
2092            wrp(strat->L[j].lcm);
2093            PrintS("  strat->L[i].lcm:");
2094            wrp(strat->L[i].lcm);
2095            PrintLn();
2096          }
2097#endif
2098          if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2099          && (pNext(strat->L[l].p) == strat->tail)
2100          && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2101          && pDivisibleBy(p,strat->L[l].lcm))
2102          {
2103            /*
2104            *"NOT equal(...)" because in case of "equal" the element L[l]
2105            *is "older" and has to be from theoretical point of view behind
2106            *L[i], but we do not want to reorder L
2107            */
2108            strat->L[i].p2 = strat->tail;
2109            /*
2110            *L[l] will be canceled, we cannot cancel L[i] later on,
2111            *so we mark it with "tail"
2112            */
2113            deleteInL(strat->L,&strat->Ll,l,strat);
2114            i--;
2115          }
2116          else
2117          {
2118            deleteInL(strat->L,&strat->Ll,i,strat);
2119          }
2120          j--;
2121        }
2122        i--;
2123      }
2124    }
2125    else if (strat->L[j].p2 == strat->tail)
2126    {
2127      /*now L[j] cannot be canceled any more and the tail can be removed*/
2128      strat->L[j].p2 = p;
2129    }
2130    j--;
2131  }
2132}
2133#endif
2134
2135#ifdef HAVE_RING2TOM
2136long twoPow(long arg)
2137{
2138  return 1L << arg;
2139}
2140
2141long ind2(long arg)
2142{
2143  long ind = 0;
2144  if (arg <= 0) return 0;
2145  while (arg%2 == 0)
2146  {
2147    arg = arg / 2;
2148    ind++;
2149  }
2150  return ind;
2151}
2152
2153long ind_fact_2(long arg)
2154{
2155  long ind = 0;
2156  if (arg <= 0) return 0;
2157  if (arg%2 == 1) { arg--; }
2158  while (arg > 0)
2159  {
2160    ind += ind2(arg);
2161    arg = arg - 2;
2162  }
2163  return ind;
2164}
2165
2166/*2
2167* put the pair (p, f) in B and f in T
2168*/
2169void enterOneZeroPairRing (poly f, poly t_p, poly p, int ecart, kStrategy strat, int atR = -1)
2170{
2171  int      l,j,compare,compareCoeff;
2172  LObject  Lp;
2173
2174  if (strat->interred_flag) return;
2175#ifdef KDEBUG
2176  Lp.ecart=0; Lp.length=0;
2177#endif
2178  /*- computes the lcm(s[i],p) -*/
2179  Lp.lcm = pInit();
2180
2181  pLcm(p,f,Lp.lcm);
2182  pSetm(Lp.lcm);
2183  pSetCoeff(Lp.lcm, nLcm(pGetCoeff(p), pGetCoeff(f), currRing));
2184  assume(!strat->sugarCrit);
2185  assume(!strat->fromT);
2186  /*
2187  *the set B collects the pairs of type (S[j],p)
2188  *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
2189  *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
2190  *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
2191  */
2192  for(j = strat->Bl;j>=0;j--)
2193  {
2194    compare=pDivCompRing(strat->B[j].lcm,Lp.lcm);
2195    compareCoeff = nComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(Lp.lcm));
2196    if (compareCoeff == 0 || compare == compareCoeff)
2197    {
2198      if (compare == 1)
2199      {
2200        strat->c3++;
2201        pLmDelete(Lp.lcm);
2202        return;
2203      }
2204      else
2205      if (compare == -1)
2206      {
2207        deleteInL(strat->B,&strat->Bl,j,strat);
2208        strat->c3++;
2209      }
2210    }
2211    if (compare == pDivComp_EQUAL)
2212    {
2213      // Add hint for same LM and direction of LC (later) (TODO Oliver)
2214      if (compareCoeff == 1)
2215      {
2216        strat->c3++;
2217        pLmDelete(Lp.lcm);
2218        return;
2219      }
2220      else
2221      if (compareCoeff == -1)
2222      {
2223        deleteInL(strat->B,&strat->Bl,j,strat);
2224        strat->c3++;
2225      }
2226    }
2227  }
2228  /*
2229  *the pair (S[i],p) enters B if the spoly != 0
2230  */
2231  /*-  compute the short s-polynomial -*/
2232  if ((f==NULL) || (p==NULL)) return;
2233  pNorm(p);
2234  {
2235    Lp.p = ksCreateShortSpoly(f, p, strat->tailRing);
2236  }
2237  if (Lp.p == NULL) //deactivated, as we are adding pairs with zeropoly and not from S
2238  {
2239    /*- the case that the s-poly is 0 -*/
2240//    if (strat->pairtest==NULL) initPairtest(strat);
2241//    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
2242//    strat->pairtest[strat->sl+1] = TRUE;
2243    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
2244    /*
2245    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
2246    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
2247    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
2248    *term of p devides the lcm(s,r)
2249    *(this canceling should be done here because
2250    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
2251    *the first case is handeled in chainCrit
2252    */
2253    if (Lp.lcm!=NULL) pLmDelete(Lp.lcm);
2254  }
2255  else
2256  {
2257    /*- the pair (S[i],p) enters B -*/
2258    Lp.p1 = f;
2259    Lp.p2 = p;
2260
2261    pNext(Lp.p) = strat->tail;
2262
2263    LObject tmp_h(f, currRing, strat->tailRing);
2264    tmp_h.SetShortExpVector();
2265    strat->initEcart(&tmp_h);
2266    tmp_h.sev = pGetShortExpVector(tmp_h.p);
2267    tmp_h.t_p = t_p;
2268
2269    enterT(tmp_h, strat, strat->tl + 1);
2270
2271    if (atR >= 0)
2272    {
2273      Lp.i_r2 = atR;
2274      Lp.i_r1 = strat->tl;
2275    }
2276
2277    strat->initEcartPair(&Lp,f,p,0/*strat->ecartS[i]*/,ecart);     // Attention: TODO: break ecart
2278    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
2279    enterL(&strat->B, &strat->Bl, &strat->Bmax, Lp, l);
2280  }
2281}
2282
2283/* Helper for kCreateZeroPoly
2284 * enumerating the exponents
2285ring r = 2^2, (a, b, c), lp; ideal G0 = system("createG0"); ideal G = interred(G0); ncols(G0); ncols(G);
2286 */
2287
2288int nextZeroSimplexExponent (long exp[], long ind[], long cexp[], long cind[], long* cabsind, long step[], long bound, long N)
2289/* gives the next exponent from the set H_1 */
2290{
2291  long add = ind2(cexp[1] + 2);
2292  if ((*cabsind < bound) && (*cabsind - step[1] + add < bound))
2293  {
2294    cexp[1] += 2;
2295    cind[1] += add;
2296    *cabsind += add;
2297  }
2298  else
2299  {
2300    // cabsind >= habsind
2301    if (N == 1) return 0;
2302    int i = 1;
2303    while (exp[i] == cexp[i] && i <= N) i++;
2304    cexp[i] = exp[i];
2305    *cabsind -= cind[i];
2306    cind[i] = ind[i];
2307    step[i] = 500000;
2308    *cabsind += cind[i];
2309    // Print("in: %d\n", *cabsind);
2310    i += 1;
2311    if (i > N) return 0;
2312    do
2313    {
2314      step[1] = 500000;
2315      for (int j = i + 1; j <= N; j++)
2316      {
2317        if (step[1] > step[j]) step[1] = step[j];
2318      }
2319      add = ind2(cexp[i] + 2);
2320      if (*cabsind - step[1] + add >= bound)
2321      {
2322        cexp[i] = exp[i];
2323        *cabsind -= cind[i];
2324        cind[i] = ind[i];
2325        *cabsind += cind[i];
2326        step[i] = 500000;
2327        i += 1;
2328        if (i > N) return 0;
2329      }
2330      else step[1] = -1;
2331    } while (step[1] != -1);
2332    step[1] = 500000;
2333    cexp[i] += 2;
2334    cind[i] += add;
2335    *cabsind += add;
2336    if (add < step[i]) step[i] = add;
2337    for (i = 2; i <= N; i++)
2338    {
2339      if (step[1] > step[i]) step[1] = step[i];
2340    }
2341  }
2342  return 1;
2343}
2344
2345/*
2346 * Creates the zero Polynomial on position exp
2347 * long exp[] : exponent of leading term
2348 * cabsind    : total 2-ind of exp (if -1 will be computed)
2349 * poly* t_p  : will hold the LT in tailRing
2350 * leadRing   : ring for the LT
2351 * tailRing   : ring for the tail
2352 */
2353
2354poly kCreateZeroPoly(long exp[], long cabsind, poly* t_p, ring leadRing, ring tailRing)
2355{
2356
2357  poly zeroPoly = NULL;
2358
2359  number tmp1;
2360  poly tmp2, tmp3;
2361
2362  if (cabsind == -1)
2363  {
2364    cabsind = 0;
2365    for (int i = 1; i <= leadRing->N; i++)
2366    {
2367      cabsind += ind_fact_2(exp[i]);
2368    }
2369//    Print("cabsind: %d\n", cabsind);
2370  }
2371  if (cabsind < leadRing->ch)
2372  {
2373    zeroPoly = p_ISet(twoPow(leadRing->ch - cabsind), tailRing);
2374  }
2375  else
2376  {
2377    zeroPoly = p_ISet(1, tailRing);
2378  }
2379  for (int i = 1; i <= leadRing->N; i++)
2380  {
2381    for (long j = 1; j <= exp[i]; j++)
2382    {
2383      tmp1 = nInit(j);
2384      tmp2 = p_ISet(1, tailRing);
2385      p_SetExp(tmp2, i, 1, tailRing);
2386      p_Setm(tmp2, tailRing);
2387      if (nIsZero(tmp1))
2388      { // should nowbe obsolet, test ! TODO OLIVER
2389        zeroPoly = p_Mult_q(zeroPoly, tmp2, tailRing);
2390      }
2391      else
2392      {
2393        tmp3 = p_NSet(nCopy(tmp1), tailRing);
2394        zeroPoly = p_Mult_q(zeroPoly, p_Add_q(tmp3, tmp2, tailRing), tailRing);
2395      }
2396    }
2397  }
2398  tmp2 = p_NSet(nCopy(pGetCoeff(zeroPoly)), leadRing);
2399  for (int i = 1; i <= leadRing->N; i++)
2400  {
2401    pSetExp(tmp2, i, p_GetExp(zeroPoly, i, tailRing));
2402  }
2403  p_Setm(tmp2, leadRing);
2404  *t_p = zeroPoly;
2405  zeroPoly = pNext(zeroPoly);
2406  pNext(*t_p) = NULL;
2407  pNext(tmp2) = zeroPoly;
2408  return tmp2;
2409}
2410
2411// #define OLI_DEBUG
2412
2413/*
2414 * Generate the s-polynomial for the virtual set of zero-polynomials
2415 */
2416
2417void initenterzeropairsRing (poly p, int ecart, kStrategy strat, int atR)
2418{
2419  // Initialize
2420  long exp[50];            // The exponent of \hat{X} (basepoint)
2421  long cexp[50];           // The current exponent for iterating over all
2422  long ind[50];            // The power of 2 in the i-th component of exp
2423  long cind[50];           // analog for cexp
2424  long mult[50];           // How to multiply the elements of G
2425  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
2426  long habsind = 0;        // The abs. index of the coefficient of h
2427  long step[50];           // The last increases
2428  for (int i = 1; i <= currRing->N; i++)
2429  {
2430    exp[i] = p_GetExp(p, i, currRing);
2431    if (exp[i] & 1 != 0)
2432    {
2433      exp[i] = exp[i] - 1;
2434      mult[i] = 1;
2435    }
2436    cexp[i] = exp[i];
2437    ind[i] = ind_fact_2(exp[i]);
2438    cabsind += ind[i];
2439    cind[i] = ind[i];
2440    step[i] = 500000;
2441  }
2442  step[1] = 500000;
2443  habsind = ind2((long) p_GetCoeff(p, currRing));
2444  long bound = currRing->ch - habsind;
2445#ifdef OLI_DEBUG
2446  PrintS("-------------\npoly  :");
2447  wrp(p);
2448  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
2449  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
2450  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
2451  Print("bound : %d\n", bound);
2452  Print("cind  : %d\n", cabsind);
2453#endif
2454  if (cabsind == 0)
2455  {
2456    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
2457    {
2458      return;
2459    }
2460  }
2461  // Now the whole simplex
2462  do
2463  {
2464    // Build s-polynomial
2465    // 2**ind-def * mult * g - exp-def * h
2466    poly t_p;
2467    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, strat->tailRing);
2468#ifdef OLI_DEBUG
2469    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
2470    Print("zPoly : ");
2471    wrp(zeroPoly);
2472    Print("\n");
2473#endif
2474    enterOneZeroPairRing(zeroPoly, t_p, p, ecart, strat, atR);
2475  }
2476  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
2477}
2478
2479/*
2480 * Create the Groebner basis of the vanishing polynomials.
2481 */
2482
2483ideal createG0()
2484{
2485  // Initialize
2486  long exp[50];            // The exponent of \hat{X} (basepoint)
2487  long cexp[50];           // The current exponent for iterating over all
2488  long ind[50];            // The power of 2 in the i-th component of exp
2489  long cind[50];           // analog for cexp
2490  long mult[50];           // How to multiply the elements of G
2491  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
2492  long habsind = 0;        // The abs. index of the coefficient of h
2493  long step[50];           // The last increases
2494  for (int i = 1; i <= currRing->N; i++)
2495  {
2496    exp[i] = 0;
2497    cexp[i] = exp[i];
2498    ind[i] = 0;
2499    step[i] = 500000;
2500    cind[i] = ind[i];
2501  }
2502  long bound = currRing->ch;
2503  step[1] = 500000;
2504#ifdef OLI_DEBUG
2505  PrintS("-------------\npoly  :");
2506//  wrp(p);
2507  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
2508  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
2509  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
2510  Print("bound : %d\n", bound);
2511  Print("cind  : %d\n", cabsind);
2512#endif
2513  if (cabsind == 0)
2514  {
2515    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
2516    {
2517      return idInit(1, 1);
2518    }
2519  }
2520  ideal G0 = idInit(1, 1);
2521  // Now the whole simplex
2522  do
2523  {
2524    // Build s-polynomial
2525    // 2**ind-def * mult * g - exp-def * h
2526    poly t_p;
2527    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, currRing);
2528#ifdef OLI_DEBUG
2529    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
2530    Print("zPoly : ");
2531    wrp(zeroPoly);
2532    Print("\n");
2533#endif
2534    // Add to ideal
2535    pEnlargeSet(&(G0->m), IDELEMS(G0), 1);
2536    IDELEMS(G0) += 1;
2537    G0->m[IDELEMS(G0) - 1] = zeroPoly;
2538  }
2539  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
2540  idSkipZeroes(G0);
2541  return G0;
2542}
2543#endif
2544
2545#ifdef HAVE_RINGS
2546/*2
2547*(s[0],h),...,(s[k],h) will be put to the pairset L
2548*/
2549void initenterpairsRing (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2550{
2551
2552  if ((strat->syzComp==0) || (pGetComp(h)<=strat->syzComp))
2553  {
2554    int j;
2555    BOOLEAN new_pair=FALSE;
2556
2557    if (pGetComp(h)==0)
2558    {
2559      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
2560      if ((isFromQ)&&(strat->fromQ!=NULL))
2561      {
2562        for (j=0; j<=k; j++)
2563        {
2564          if (!strat->fromQ[j])
2565          {
2566            new_pair=TRUE;
2567            Print("TODO Oliver --- j:%d, Ll:%d\n",j,strat->Ll);
2568            enterOnePairRing(j,h,ecart,isFromQ,strat, atR);
2569          }
2570        }
2571      }
2572      else
2573      {
2574        new_pair=TRUE;
2575        for (j=0; j<=k; j++)
2576        {
2577          // Print("j:%d, Ll:%d\n",j,strat->Ll);
2578          enterOnePairRing(j,h,ecart,isFromQ,strat, atR);
2579        }
2580      }
2581    }
2582    else
2583    {
2584      for (j=0; j<=k; j++)
2585      {
2586        if ((pGetComp(h)==pGetComp(strat->S[j])) || (pGetComp(strat->S[j])==0))
2587        {
2588          new_pair=TRUE;
2589          Print("TODO Oliver --- j:%d, Ll:%d\n",j,strat->Ll);
2590          enterOnePairRing(j,h,ecart,isFromQ,strat, atR);
2591        }
2592      }
2593    }
2594
2595#ifdef HAVE_VANGB
2596    // initenterzeropairsRing(h, ecart, strat, atR);
2597#endif
2598
2599    if (new_pair) chainCritRing(h,ecart,strat);
2600
2601  }
2602/*
2603ring r=256,(x,y,z),dp;
2604ideal I=12xz-133y, 2xy-z;
2605*/
2606
2607}
2608
2609/*2
2610*(s[0],h),...,(s[k],h) will be put to the pairset L
2611*/
2612void initenterstrongPairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2613{
2614
2615  if (!nIsOne(pGetCoeff(h)))
2616  {
2617    int j;
2618    BOOLEAN new_pair=FALSE;
2619
2620    for (j=0; j<=k; j++)
2621    {
2622      // Print("j:%d, Ll:%d\n",j,strat->Ll);
2623//      if (((unsigned long) pGetCoeff(h) % (unsigned long) pGetCoeff(strat->S[j]) != 0) &&
2624//         ((unsigned long) pGetCoeff(strat->S[j]) % (unsigned long) pGetCoeff(h) != 0))
2625      {
2626        if (enterOneStrongPoly(j,h,ecart,isFromQ,strat, atR))
2627          new_pair=TRUE;
2628      }
2629    }
2630  }
2631/*
2632ring r=256,(x,y,z),dp;
2633ideal I=12xz-133y, 2xy-z;
2634*/
2635
2636}
2637
2638/*2
2639* Generates spoly(0, h) if applicable. Assumes ring in Z/2^n.
2640*/
2641void enterExtendedSpoly(poly h,kStrategy strat)
2642{
2643  number gcd = nGcd((number) 0, pGetCoeff(h), strat->tailRing);
2644  if (!nIsOne(gcd))
2645  {
2646    poly p = h->next;
2647    number tmp = gcd;
2648    gcd = nIntDiv(0, gcd);
2649    nDelete(&tmp);
2650    p = pp_Mult_nn(p, gcd, strat->tailRing);
2651    nDelete(&gcd);
2652
2653    if (p != NULL)
2654    {
2655      if (TEST_OPT_PROT)
2656      {
2657        PrintS("Z");
2658      }
2659#ifdef KDEBUG
2660      if (TEST_OPT_DEBUG)
2661      {
2662        PrintS("--- create zero spoly: ");
2663        wrp(h);
2664        PrintS(" ---> ");
2665      }
2666#endif
2667      poly tmp = pInit();
2668      pSetCoeff0(tmp, pGetCoeff(p));
2669      for (int i = 1; i <= currRing->N; i++)
2670      {
2671        pSetExp(tmp, i, p_GetExp(p, i, strat->tailRing));
2672      }
2673      p_Setm(tmp, currRing);
2674      p = p_LmFreeAndNext(p, strat->tailRing);
2675      pNext(tmp) = p;
2676      LObject h;
2677      h.p = tmp;
2678      h.tailRing = strat->tailRing;
2679      int posx;
2680      if (h.p!=NULL)
2681      {
2682        if (TEST_OPT_INTSTRATEGY)
2683        {
2684          //pContent(h.p);
2685          h.pCleardenom(); // also does a pContent
2686        }
2687        else
2688        {
2689          h.pNorm();
2690        }
2691        strat->initEcart(&h);
2692        if (strat->Ll==-1)
2693          posx =0;
2694        else
2695          posx = strat->posInL(strat->L,strat->Ll,&h,strat);
2696        h.sev = pGetShortExpVector(h.p);
2697        h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
2698        if (pNext(p) != NULL)
2699        {
2700          // What does this? (Oliver)
2701          // pShallowCopyDeleteProc p_shallow_copy_delete
2702          //      = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
2703          // pNext(p) = p_shallow_copy_delete(pNext(p),
2704          //              currRing, strat->tailRing, strat->tailRing->PolyBin);
2705        }
2706#ifdef KDEBUG
2707        if (TEST_OPT_DEBUG)
2708        {
2709          wrp(tmp);
2710          PrintLn();
2711        }
2712#endif
2713        enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
2714      }
2715    }
2716  }
2717  nDelete(&gcd);
2718}
2719
2720void clearSbatch (poly h,int k,int pos,kStrategy strat)
2721{
2722  int j = pos;
2723  if ( (!strat->fromT)
2724  && (1//(strat->syzComp==0)
2725    //||(pGetComp(h)<=strat->syzComp)))
2726  ))
2727  {
2728    // Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
2729    unsigned long h_sev = pGetShortExpVector(h);
2730    loop
2731    {
2732      if (j > k) break;
2733      clearS(h,h_sev, &j,&k,strat);
2734      j++;
2735    }
2736    // Print("end clearS sl=%d\n",strat->sl);
2737  }
2738}
2739
2740/*2
2741* Generates a sufficient set of spolys (maybe just a finite generating
2742* set of the syzygys)
2743*/
2744void superenterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
2745{
2746    assume (rField_is_Ring(currRing));
2747    // enter also zero divisor * poly, if this is non zero and of smaller degree
2748    if (!(rField_is_Domain(currRing))) enterExtendedSpoly(h, strat);
2749    initenterpairsRing(h, k, ecart, 0, strat, atR);
2750    initenterstrongPairs(h, k, ecart, 0, strat, atR);
2751    clearSbatch(h, k, pos, strat);
2752}
2753#endif
2754
2755/*2
2756*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
2757*superfluous elements in S will be deleted
2758*/
2759void enterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
2760{
2761  int j=pos;
2762
2763#ifdef HAVE_RINGS
2764  assume (!rField_is_Ring(currRing));
2765#endif
2766  initenterpairs(h,k,ecart,0,strat, atR);
2767  if ( (!strat->fromT)
2768  && ((strat->syzComp==0)
2769    ||(pGetComp(h)<=strat->syzComp)))
2770  {
2771    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
2772    unsigned long h_sev = pGetShortExpVector(h);
2773    loop
2774    {
2775      if (j > k) break;
2776      clearS(h,h_sev, &j,&k,strat);
2777      j++;
2778    }
2779    //Print("end clearS sl=%d\n",strat->sl);
2780  }
2781 // PrintS("end enterpairs\n");
2782}
2783
2784/*2
2785*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
2786*superfluous elements in S will be deleted
2787*/
2788void enterpairsSpecial (poly h,int k,int ecart,int pos,kStrategy strat, int atR = -1)
2789{
2790  int j;
2791
2792  for (j=0; j<=k; j++)
2793  {
2794    if ((pGetComp(h)==pGetComp(strat->S[j]))
2795    || (0==pGetComp(strat->S[j])))
2796    {
2797      enterOnePairSpecial(j,h,ecart,strat, atR);
2798    }
2799  }
2800//   #ifdef HAVE_PLURAL
2801  if (!rIsPluralRing(currRing))
2802//   #endif
2803  {
2804    j=pos;
2805    loop
2806    {
2807      unsigned long h_sev = pGetShortExpVector(h);
2808      if (j > k) break;
2809      clearS(h,h_sev,&j,&k,strat);
2810      j++;
2811    }
2812  }
2813}
2814
2815/*2
2816*reorders  s with respect to posInS,
2817*suc is the first changed index or zero
2818*/
2819
2820void reorderS (int* suc,kStrategy strat)
2821{
2822  int i,j,at,ecart, s2r;
2823  int fq=0;
2824  unsigned long sev;
2825  poly  p;
2826  int new_suc=strat->sl+1;
2827  i= *suc;
2828  if (i<0) i=0;
2829
2830  for (; i<=strat->sl; i++)
2831  {
2832    at = posInS(strat,i-1,strat->S[i],strat->ecartS[i]);
2833    if (at != i)
2834    {
2835      if (new_suc > at) new_suc = at;
2836      p = strat->S[i];
2837      ecart = strat->ecartS[i];
2838      sev = strat->sevS[i];
2839      s2r = strat->S_2_R[i];
2840      if (strat->fromQ!=NULL) fq=strat->fromQ[i];
2841      for (j=i; j>=at+1; j--)
2842      {
2843        strat->S[j] = strat->S[j-1];
2844        strat->ecartS[j] = strat->ecartS[j-1];
2845        strat->sevS[j] = strat->sevS[j-1];
2846        strat->S_2_R[j] = strat->S_2_R[j-1];
2847      }
2848      strat->S[at] = p;
2849      strat->ecartS[at] = ecart;
2850      strat->sevS[at] = sev;
2851      strat->S_2_R[at] = s2r;
2852      if (strat->fromQ!=NULL)
2853      {
2854        for (j=i; j>=at+1; j--)
2855        {
2856          strat->fromQ[j] = strat->fromQ[j-1];
2857        }
2858        strat->fromQ[at]=fq;
2859      }
2860    }
2861  }
2862  if (new_suc <= strat->sl) *suc=new_suc;
2863  else                      *suc=-1;
2864}
2865
2866
2867/*2
2868*looks up the position of p in set
2869*set[0] is the smallest with respect to the ordering-procedure deg/pComp
2870* Assumption: posInS only depends on the leading term
2871*             otherwise, bba has to be changed
2872*/
2873int posInS (const kStrategy strat, const int length,const poly p,
2874            const int ecart_p)
2875{
2876  if(length==-1) return 0;
2877  polyset set=strat->S;
2878  int i;
2879  int an = 0;
2880  int en = length;
2881  int cmp_int = pOrdSgn;
2882  int pc=pGetComp(p);
2883  if ((currRing->MixedOrder)
2884#if 0
2885  || ((strat->ak>0) && ((currRing->order[0]==ringorder_c)||((currRing->order[0]==ringorder_C))))
2886#endif
2887  )
2888  {
2889    int o=pWTotaldegree(p);
2890    int oo=pWTotaldegree(set[length]);
2891
2892    if ((oo<o)
2893    || ((o==oo) && (pLmCmp(set[length],p)!= cmp_int)))
2894      return length+1;
2895
2896    loop
2897    {
2898      if (an >= en-1)
2899      {
2900        if ((pWTotaldegree(set[an])>=o) && (pLmCmp(set[an],p) == cmp_int))
2901        {
2902          return an;
2903        }
2904        return en;
2905      }
2906      i=(an+en) / 2;
2907      if ((pWTotaldegree(set[i])>=o) && (pLmCmp(set[i],p) == cmp_int)) en=i;
2908      else                              an=i;
2909    }
2910  }
2911  else
2912  {
2913#ifdef HAVE_RINGS
2914    if (rField_is_Ring(currRing))
2915    {
2916      if (pLmCmp(set[length],p)== -cmp_int)
2917        return length+1;
2918      int cmp;
2919      loop
2920      {
2921        if (an >= en-1)
2922        {
2923          cmp = pLmCmp(set[an],p);
2924          if (cmp == cmp_int)  return an;
2925          if (cmp == -cmp_int) return en;
2926          if (nDivBy(pGetCoeff(p), pGetCoeff(set[an]))) return en;
2927          return an;
2928        }
2929        i = (an+en) / 2;
2930        cmp = pLmCmp(set[i],p);
2931        if (cmp == cmp_int)         en = i;
2932        else if (cmp == -cmp_int)   an = i;
2933        else
2934        {
2935          if (nDivBy(pGetCoeff(p), pGetCoeff(set[i]))) an = i;
2936          else en = i;
2937        }
2938      }
2939    }
2940    else
2941#endif
2942    if (pLmCmp(set[length],p)== -cmp_int)
2943      return length+1;
2944
2945    loop
2946    {
2947      if (an >= en-1)
2948      {
2949        if (pLmCmp(set[an],p) == cmp_int) return an;
2950        if (pLmCmp(set[an],p) == -cmp_int) return en;
2951        if ((cmp_int!=1)
2952        && ((strat->ecartS[an])>ecart_p))
2953          return an;
2954        return en;
2955      }
2956      i=(an+en) / 2;
2957      if (pLmCmp(set[i],p) == cmp_int) en=i;
2958      else if (pLmCmp(set[i],p) == -cmp_int) an=i;
2959      else
2960      {
2961        if ((cmp_int!=1)
2962        &&((strat->ecartS[i])<ecart_p))
2963          en=i;
2964        else
2965          an=i;
2966      }
2967    }
2968  }
2969}
2970
2971
2972/*2
2973* looks up the position of p in set
2974* the position is the last one
2975*/
2976int posInT0 (const TSet set,const int length,LObject &p)
2977{
2978  return (length+1);
2979}
2980
2981
2982/*2
2983* looks up the position of p in T
2984* set[0] is the smallest with respect to the ordering-procedure
2985* pComp
2986*/
2987int posInT1 (const TSet set,const int length,LObject &p)
2988{
2989  if (length==-1) return 0;
2990
2991  if (pLmCmp(set[length].p,p.p)!= pOrdSgn) return length+1;
2992
2993  int i;
2994  int an = 0;
2995  int en= length;
2996
2997  loop
2998  {
2999    if (an >= en-1)
3000    {
3001      if (pLmCmp(set[an].p,p.p) == pOrdSgn) return an;
3002      return en;
3003    }
3004    i=(an+en) / 2;
3005    if (pLmCmp(set[i].p,p.p) == pOrdSgn) en=i;
3006    else                                 an=i;
3007  }
3008}
3009
3010/*2
3011* looks up the position of p in T
3012* set[0] is the smallest with respect to the ordering-procedure
3013* length
3014*/
3015int posInT2 (const TSet set,const int length,LObject &p)
3016{
3017  if (length==-1)
3018    return 0;
3019  if (set[length].length<p.length)
3020    return length+1;
3021
3022  int i;
3023  int an = 0;
3024  int en= length;
3025
3026  loop
3027  {
3028    if (an >= en-1)
3029    {
3030      if (set[an].length>p.length) return an;
3031      return en;
3032    }
3033    i=(an+en) / 2;
3034    if (set[i].length>p.length) en=i;
3035    else                        an=i;
3036  }
3037}
3038
3039/*2
3040* looks up the position of p in T
3041* set[0] is the smallest with respect to the ordering-procedure
3042* totaldegree,pComp
3043*/
3044int posInT11 (const TSet set,const int length,LObject &p)
3045/*{
3046 * int j=0;
3047 * int o;
3048 *
3049 * o = p.GetpFDeg();
3050 * loop
3051 * {
3052 *   if ((pFDeg(set[j].p) > o)
3053 *   || ((pFDeg(set[j].p) == o) && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
3054 *   {
3055 *     return j;
3056 *   }
3057 *   j++;
3058 *   if (j > length) return j;
3059 * }
3060 *}
3061 */
3062{
3063  if (length==-1) return 0;
3064
3065  int o = p.GetpFDeg();
3066  int op = set[length].GetpFDeg();
3067
3068  if ((op < o)
3069  || ((op == o) && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3070    return length+1;
3071
3072  int i;
3073  int an = 0;
3074  int en= length;
3075
3076  loop
3077  {
3078    if (an >= en-1)
3079    {
3080      op= set[an].GetpFDeg();
3081      if ((op > o)
3082      || (( op == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3083        return an;
3084      return en;
3085    }
3086    i=(an+en) / 2;
3087    op = set[i].GetpFDeg();
3088    if (( op > o)
3089    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3090      en=i;
3091    else
3092      an=i;
3093  }
3094}
3095
3096/*2 Pos for rings T: Here I am
3097* looks up the position of p in T
3098* set[0] is the smallest with respect to the ordering-procedure
3099* totaldegree,pComp
3100*/
3101int posInTrg0 (const TSet set,const int length,LObject &p)
3102{
3103  if (length==-1) return 0;
3104  int o = p.GetpFDeg();
3105  int op = set[length].GetpFDeg();
3106  int i;
3107  int an = 0;
3108  int en = length;
3109  int cmp_int = pOrdSgn;
3110  if ((op < o) || (pLmCmp(set[length].p,p.p)== -cmp_int))
3111    return length+1;
3112  int cmp;
3113  loop
3114  {
3115    if (an >= en-1)
3116    {
3117      op = set[an].GetpFDeg();
3118      if (op > o) return an;
3119      if (op < 0) return en;
3120      cmp = pLmCmp(set[an].p,p.p);
3121      if (cmp == cmp_int)  return an;
3122      if (cmp == -cmp_int) return en;
3123      if (nGreater(pGetCoeff(p.p), pGetCoeff(set[an].p))) return en;
3124      return an;
3125    }
3126    i = (an + en) / 2;
3127    op = set[i].GetpFDeg();
3128    if (op > o)       en = i;
3129    else if (op < o)  an = i;
3130    else
3131    {
3132      cmp = pLmCmp(set[i].p,p.p);
3133      if (cmp == cmp_int)                                     en = i;
3134      else if (cmp == -cmp_int)                               an = i;
3135      else if (nGreater(pGetCoeff(p.p), pGetCoeff(set[i].p))) an = i;
3136      else                                                    en = i;
3137    }
3138  }
3139}
3140/*
3141  int o = p.GetpFDeg();
3142  int op = set[length].GetpFDeg();
3143
3144  if ((op < o)
3145  || ((op == o) && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3146    return length+1;
3147
3148  int i;
3149  int an = 0;
3150  int en= length;
3151
3152  loop
3153  {
3154    if (an >= en-1)
3155    {
3156      op= set[an].GetpFDeg();
3157      if ((op > o)
3158      || (( op == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3159        return an;
3160      return en;
3161    }
3162    i=(an+en) / 2;
3163    op = set[i].GetpFDeg();
3164    if (( op > o)
3165    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3166      en=i;
3167    else
3168      an=i;
3169  }
3170}
3171  */
3172/*2
3173* looks up the position of p in T
3174* set[0] is the smallest with respect to the ordering-procedure
3175* totaldegree,pComp
3176*/
3177int posInT110 (const TSet set,const int length,LObject &p)
3178{
3179  if (length==-1) return 0;
3180
3181  int o = p.GetpFDeg();
3182  int op = set[length].GetpFDeg();
3183
3184  if (( op < o)
3185  || (( op == o) && (set[length].length<p.length))
3186  || (( op == o) && (set[length].length == p.length)
3187     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3188    return length+1;
3189
3190  int i;
3191  int an = 0;
3192  int en= length;
3193  loop
3194  {
3195    if (an >= en-1)
3196    {
3197      op = set[an].GetpFDeg();
3198      if (( op > o)
3199      || (( op == o) && (set[an].length > p.length))
3200      || (( op == o) && (set[an].length == p.length)
3201         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3202        return an;
3203      return en;
3204    }
3205    i=(an+en) / 2;
3206    op = set[i].GetpFDeg();
3207    if (( op > o)
3208    || (( op == o) && (set[i].length > p.length))
3209    || (( op == o) && (set[i].length == p.length)
3210       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3211      en=i;
3212    else
3213      an=i;
3214  }
3215}
3216
3217/*2
3218* looks up the position of p in set
3219* set[0] is the smallest with respect to the ordering-procedure
3220* pFDeg
3221*/
3222int posInT13 (const TSet set,const int length,LObject &p)
3223{
3224  if (length==-1) return 0;
3225
3226  int o = p.GetpFDeg();
3227
3228  if (set[length].GetpFDeg() <= o)
3229    return length+1;
3230
3231  int i;
3232  int an = 0;
3233  int en= length;
3234  loop
3235  {
3236    if (an >= en-1)
3237    {
3238      if (set[an].GetpFDeg() > o)
3239        return an;
3240      return en;
3241    }
3242    i=(an+en) / 2;
3243    if (set[i].GetpFDeg() > o)
3244      en=i;
3245    else
3246      an=i;
3247  }
3248}
3249
3250// determines the position based on: 1.) Ecart 2.) pLength
3251int posInT_EcartpLength(const TSet set,const int length,LObject &p)
3252{
3253  if (length==-1) return 0;
3254
3255  int op=p.ecart;
3256  int ol = p.GetpLength();
3257
3258  int oo=set[length].ecart;
3259  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
3260    return length+1;
3261
3262  int i;
3263  int an = 0;
3264  int en= length;
3265  loop
3266    {
3267      if (an >= en-1)
3268      {
3269        int oo=set[an].ecart;
3270        if((oo > op)
3271           || ((oo==op) && (set[an].pLength > ol)))
3272          return an;
3273        return en;
3274      }
3275      i=(an+en) / 2;
3276      int oo=set[i].ecart;
3277      if ((oo > op)
3278          || ((oo == op) && (set[i].pLength > ol)))
3279        en=i;
3280      else
3281        an=i;
3282    }
3283}
3284
3285/*2
3286* looks up the position of p in set
3287* set[0] is the smallest with respect to the ordering-procedure
3288* maximaldegree, pComp
3289*/
3290int posInT15 (const TSet set,const int length,LObject &p)
3291/*{
3292 *int j=0;
3293 * int o;
3294 *
3295 * o = p.GetpFDeg()+p.ecart;
3296 * loop
3297 * {
3298 *   if ((set[j].GetpFDeg()+set[j].ecart > o)
3299 *   || ((set[j].GetpFDeg()+set[j].ecart == o)
3300 *     && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
3301 *   {
3302 *     return j;
3303 *   }
3304 *   j++;
3305 *   if (j > length) return j;
3306 * }
3307 *}
3308 */
3309{
3310  if (length==-1) return 0;
3311
3312  int o = p.GetpFDeg() + p.ecart;
3313  int op = set[length].GetpFDeg()+set[length].ecart;
3314
3315  if ((op < o)
3316  || ((op == o)
3317     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3318    return length+1;
3319
3320  int i;
3321  int an = 0;
3322  int en= length;
3323  loop
3324  {
3325    if (an >= en-1)
3326    {
3327      op = set[an].GetpFDeg()+set[an].ecart;
3328      if (( op > o)
3329      || (( op  == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3330        return an;
3331      return en;
3332    }
3333    i=(an+en) / 2;
3334    op = set[i].GetpFDeg()+set[i].ecart;
3335    if (( op > o)
3336    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3337      en=i;
3338    else
3339      an=i;
3340  }
3341}
3342
3343/*2
3344* looks up the position of p in set
3345* set[0] is the smallest with respect to the ordering-procedure
3346* pFDeg+ecart, ecart, pComp
3347*/
3348int posInT17 (const TSet set,const int length,LObject &p)
3349/*
3350*{
3351* int j=0;
3352* int  o;
3353*
3354*  o = p.GetpFDeg()+p.ecart;
3355*  loop
3356*  {
3357*    if ((pFDeg(set[j].p)+set[j].ecart > o)
3358*    || (((pFDeg(set[j].p)+set[j].ecart == o)
3359*      && (set[j].ecart < p.ecart)))
3360*    || ((pFDeg(set[j].p)+set[j].ecart == o)
3361*      && (set[j].ecart==p.ecart)
3362*      && (pLmCmp(set[j].p,p.p)==pOrdSgn)))
3363*      return j;
3364*    j++;
3365*    if (j > length) return j;
3366*  }
3367* }
3368*/
3369{
3370  if (length==-1) return 0;
3371
3372  int o = p.GetpFDeg() + p.ecart;
3373  int op = set[length].GetpFDeg()+set[length].ecart;
3374
3375  if ((op < o)
3376  || (( op == o) && (set[length].ecart > p.ecart))
3377  || (( op == o) && (set[length].ecart==p.ecart)
3378     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3379    return length+1;
3380
3381  int i;
3382  int an = 0;
3383  int en= length;
3384  loop
3385  {
3386    if (an >= en-1)
3387    {
3388      op = set[an].GetpFDeg()+set[an].ecart;
3389      if (( op > o)
3390      || (( op == o) && (set[an].ecart < p.ecart))
3391      || (( op  == o) && (set[an].ecart==p.ecart)
3392         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3393        return an;
3394      return en;
3395    }
3396    i=(an+en) / 2;
3397    op = set[i].GetpFDeg()+set[i].ecart;
3398    if ((op > o)
3399    || (( op == o) && (set[i].ecart < p.ecart))
3400    || (( op == o) && (set[i].ecart == p.ecart)
3401       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3402      en=i;
3403    else
3404      an=i;
3405  }
3406}
3407/*2
3408* looks up the position of p in set
3409* set[0] is the smallest with respect to the ordering-procedure
3410* pGetComp, pFDeg+ecart, ecart, pComp
3411*/
3412int posInT17_c (const TSet set,const int length,LObject &p)
3413{
3414  if (length==-1) return 0;
3415
3416  int cc = (-1+2*currRing->order[0]==ringorder_c);
3417  /* cc==1 for (c,..), cc==-1 for (C,..) */
3418  int o = p.GetpFDeg() + p.ecart;
3419  int c = pGetComp(p.p)*cc;
3420
3421  if (pGetComp(set[length].p)*cc < c)
3422    return length+1;
3423  if (pGetComp(set[length].p)*cc == c)
3424  {
3425    int op = set[length].GetpFDeg()+set[length].ecart;
3426    if ((op < o)
3427    || ((op == o) && (set[length].ecart > p.ecart))
3428    || ((op == o) && (set[length].ecart==p.ecart)
3429       && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3430      return length+1;
3431  }
3432
3433  int i;
3434  int an = 0;
3435  int en= length;
3436  loop
3437  {
3438    if (an >= en-1)
3439    {
3440      if (pGetComp(set[an].p)*cc < c)
3441        return en;
3442      if (pGetComp(set[an].p)*cc == c)
3443      {
3444        int op = set[an].GetpFDeg()+set[an].ecart;
3445        if ((op > o)
3446        || ((op == o) && (set[an].ecart < p.ecart))
3447        || ((op == o) && (set[an].ecart==p.ecart)
3448           && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3449          return an;
3450      }
3451      return en;
3452    }
3453    i=(an+en) / 2;
3454    if (pGetComp(set[i].p)*cc > c)
3455      en=i;
3456    else if (pGetComp(set[i].p)*cc == c)
3457    {
3458      int op = set[i].GetpFDeg()+set[i].ecart;
3459      if ((op > o)
3460      || ((op == o) && (set[i].ecart < p.ecart))
3461      || ((op == o) && (set[i].ecart == p.ecart)
3462         && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3463        en=i;
3464      else
3465        an=i;
3466    }
3467    else
3468      an=i;
3469  }
3470}
3471
3472/*2
3473* looks up the position of p in set
3474* set[0] is the smallest with respect to
3475* ecart, pFDeg, length
3476*/
3477int posInT19 (const TSet set,const int length,LObject &p)
3478{
3479  if (length==-1) return 0;
3480
3481  int o = p.ecart;
3482  int op=p.GetpFDeg();
3483
3484  if (set[length].ecart < o)
3485    return length+1;
3486  if (set[length].ecart == o)
3487  {
3488     int oo=set[length].GetpFDeg();
3489     if ((oo < op) || ((oo==op) && (set[length].length < p.length)))
3490       return length+1;
3491  }
3492
3493  int i;
3494  int an = 0;
3495  int en= length;
3496  loop
3497  {
3498    if (an >= en-1)
3499    {
3500      if (set[an].ecart > o)
3501        return an;
3502      if (set[an].ecart == o)
3503      {
3504         int oo=set[an].GetpFDeg();
3505         if((oo > op)
3506         || ((oo==op) && (set[an].length > p.length)))
3507           return an;
3508      }
3509      return en;
3510    }
3511    i=(an+en) / 2;
3512    if (set[i].ecart > o)
3513      en=i;
3514    else if (set[i].ecart == o)
3515    {
3516       int oo=set[i].GetpFDeg();
3517       if ((oo > op)
3518       || ((oo == op) && (set[i].length > p.length)))
3519         en=i;
3520       else
3521        an=i;
3522    }
3523    else
3524      an=i;
3525  }
3526}
3527
3528/*2
3529*looks up the position of polynomial p in set
3530*set[length] is the smallest element in set with respect
3531*to the ordering-procedure pComp
3532*/
3533int posInLSpecial (const LSet set, const int length,
3534                   LObject *p,const kStrategy strat)
3535{
3536  if (length<0) return 0;
3537
3538  int d=p->GetpFDeg();
3539  int op=set[length].GetpFDeg();
3540
3541  if ((op > d)
3542  || ((op == d) && (p->p1!=NULL)&&(set[length].p1==NULL))
3543  || (pLmCmp(set[length].p,p->p)== pOrdSgn))
3544     return length+1;
3545
3546  int i;
3547  int an = 0;
3548  int en= length;
3549  loop
3550  {
3551    if (an >= en-1)
3552    {
3553      op=set[an].GetpFDeg();
3554      if ((op > d)
3555      || ((op == d) && (p->p1!=NULL) && (set[an].p1==NULL))
3556      || (pLmCmp(set[an].p,p->p)== pOrdSgn))
3557         return en;
3558      return an;
3559    }
3560    i=(an+en) / 2;
3561    op=set[i].GetpFDeg();
3562    if ((op>d)
3563    || ((op==d) && (p->p1!=NULL) && (set[i].p1==NULL))
3564    || (pLmCmp(set[i].p,p->p) == pOrdSgn))
3565      an=i;
3566    else
3567      en=i;
3568  }
3569}
3570
3571/*2
3572*looks up the position of polynomial p in set
3573*set[length] is the smallest element in set with respect
3574*to the ordering-procedure pComp
3575*/
3576int posInL0 (const LSet set, const int length,
3577             LObject* p,const kStrategy strat)
3578{
3579  if (length<0) return 0;
3580
3581  if (pLmCmp(set[length].p,p->p)== pOrdSgn)
3582    return length+1;
3583
3584  int i;
3585  int an = 0;
3586  int en= length;
3587  loop
3588  {
3589    if (an >= en-1)
3590    {
3591      if (pLmCmp(set[an].p,p->p) == pOrdSgn) return en;
3592      return an;
3593    }
3594    i=(an+en) / 2;
3595    if (pLmCmp(set[i].p,p->p) == pOrdSgn) an=i;
3596    else                                 en=i;
3597    /*aend. fuer lazy == in !=- machen */
3598  }
3599}
3600
3601/*2
3602* looks up the position of polynomial p in set
3603* e is the ecart of p
3604* set[length] is the smallest element in set with respect
3605* to the ordering-procedure totaldegree,pComp
3606*/
3607int posInL11 (const LSet set, const int length,
3608              LObject* p,const kStrategy strat)
3609/*{
3610 * int j=0;
3611 * int o;
3612 *
3613 * o = p->GetpFDeg();
3614 * loop
3615 * {
3616 *   if (j > length)            return j;
3617 *   if ((set[j].GetpFDeg() < o)) return j;
3618 *   if ((set[j].GetpFDeg() == o) && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
3619 *   {
3620 *     return j;
3621 *   }
3622 *   j++;
3623 * }
3624 *}
3625 */
3626{
3627  if (length<0) return 0;
3628
3629  int o = p->GetpFDeg();
3630  int op = set[length].GetpFDeg();
3631
3632  if ((op > o)
3633  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
3634    return length+1;
3635  int i;
3636  int an = 0;
3637  int en= length;
3638  loop
3639  {
3640    if (an >= en-1)
3641    {
3642      op = set[an].GetpFDeg();
3643      if ((op > o)
3644      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
3645        return en;
3646      return an;
3647    }
3648    i=(an+en) / 2;
3649    op = set[i].GetpFDeg();
3650    if ((op > o)
3651    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
3652      an=i;
3653    else
3654      en=i;
3655  }
3656}
3657
3658/*2 Position for rings L: Here I am
3659* looks up the position of polynomial p in set
3660* e is the ecart of p
3661* set[length] is the smallest element in set with respect
3662* to the ordering-procedure totaldegree,pComp
3663*/
3664inline int getIndexRng(long coeff)
3665{
3666  if (coeff == 0) return -1;
3667  long tmp = coeff;
3668  int ind = 0;
3669  while (tmp % 2 == 0)
3670  {
3671    tmp = tmp / 2;
3672    ind++;
3673  }
3674  return ind;
3675}
3676
3677int posInLrg0 (const LSet set, const int length,
3678              LObject* p,const kStrategy strat)
3679/*          if (nGreater(pGetCoeff(p), pGetCoeff(set[an]))) return en;
3680        if (pLmCmp(set[i],p) == cmp_int)         en = i;
3681        else if (pLmCmp(set[i],p) == -cmp_int)   an = i;
3682        else
3683        {
3684          if (nGreater(pGetCoeff(p), pGetCoeff(set[i]))) an = i;
3685          else en = i;
3686        }*/
3687{
3688  if (length < 0) return 0;
3689
3690  int o = p->GetpFDeg();
3691  int op = set[length].GetpFDeg();
3692
3693  if ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
3694    return length + 1;
3695  int i;
3696  int an = 0;
3697  int en = length;
3698  loop
3699  {
3700    if (an >= en - 1)
3701    {
3702      op = set[an].GetpFDeg();
3703      if ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
3704        return en;
3705      return an;
3706    }
3707    i = (an+en) / 2;
3708    op = set[i].GetpFDeg();
3709    if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
3710      an = i;
3711    else
3712      en = i;
3713  }
3714}
3715
3716/*{
3717  if (length < 0) return 0;
3718
3719  int o = p->GetpFDeg();
3720  int op = set[length].GetpFDeg();
3721
3722  int inde = getIndexRng((unsigned long) pGetCoeff(set[length].p));
3723  int indp = getIndexRng((unsigned long) pGetCoeff(p->p));
3724  int inda;
3725  int indi;
3726
3727  if ((inda > indp) || ((inda == inde) && ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))))
3728    return length + 1;
3729  int i;
3730  int an = 0;
3731  inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
3732  int en = length;
3733  loop
3734  {
3735    if (an >= en-1)
3736    {
3737      op = set[an].GetpFDeg();
3738      if ((indp > inda) || ((indp == inda) && ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))))
3739        return en;
3740      return an;
3741    }
3742    i = (an + en) / 2;
3743    indi = getIndexRng((unsigned long) pGetCoeff(set[i].p));
3744    op = set[i].GetpFDeg();
3745    if ((indi > indp) || ((indi == indp) && ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))))
3746    // if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
3747    {
3748      an = i;
3749      inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
3750    }
3751    else
3752      en = i;
3753  }
3754} */
3755
3756/*2
3757* looks up the position of polynomial p in set
3758* set[length] is the smallest element in set with respect
3759* to the ordering-procedure totaldegree,pLength0
3760*/
3761int posInL110 (const LSet set, const int length,
3762               LObject* p,const kStrategy strat)
3763{
3764  if (length<0) return 0;
3765
3766  int o = p->GetpFDeg();
3767  int op = set[length].GetpFDeg();
3768
3769  if ((op > o)
3770  || ((op == o) && (set[length].length >p->length))
3771  || ((op == o) && (set[length].length <= p->length)
3772     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
3773    return length+1;
3774  int i;
3775  int an = 0;
3776  int en= length;
3777  loop
3778  {
3779    if (an >= en-1)
3780    {
3781      op = set[an].GetpFDeg();
3782      if ((op > o)
3783      || ((op == o) && (set[an].length >p->length))
3784      || ((op == o) && (set[an].length <=p->length)
3785         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
3786        return en;
3787      return an;
3788    }
3789    i=(an+en) / 2;
3790    op = set[i].GetpFDeg();
3791    if ((op > o)
3792    || ((op == o) && (set[i].length > p->length))
3793    || ((op == o) && (set[i].length <= p->length)
3794       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
3795      an=i;
3796    else
3797      en=i;
3798  }
3799}
3800
3801/*2
3802* looks up the position of polynomial p in set
3803* e is the ecart of p
3804* set[length] is the smallest element in set with respect
3805* to the ordering-procedure totaldegree
3806*/
3807int posInL13 (const LSet set, const int length,
3808              LObject* p,const kStrategy strat)
3809{
3810  if (length<0) return 0;
3811
3812  int o = p->GetpFDeg();
3813
3814  if (set[length].GetpFDeg() > o)
3815    return length+1;
3816
3817  int i;
3818  int an = 0;
3819  int en= length;
3820  loop
3821  {
3822    if (an >= en-1)
3823    {
3824      if (set[an].GetpFDeg() >= o)
3825        return en;
3826      return an;
3827    }
3828    i=(an+en) / 2;
3829    if (set[i].GetpFDeg() >= o)
3830      an=i;
3831    else
3832      en=i;
3833  }
3834}
3835
3836/*2
3837* looks up the position of polynomial p in set
3838* e is the ecart of p
3839* set[length] is the smallest element in set with respect
3840* to the ordering-procedure maximaldegree,pComp
3841*/
3842int posInL15 (const LSet set, const int length,
3843              LObject* p,const kStrategy strat)
3844/*{
3845 * int j=0;
3846 * int o;
3847 *
3848 * o = p->ecart+p->GetpFDeg();
3849 * loop
3850 * {
3851 *   if (j > length)                       return j;
3852 *   if (set[j].GetpFDeg()+set[j].ecart < o) return j;
3853 *   if ((set[j].GetpFDeg()+set[j].ecart == o)
3854 *   && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
3855 *   {
3856 *     return j;
3857 *   }
3858 *   j++;
3859 * }
3860 *}
3861 */
3862{
3863  if (length<0) return 0;
3864
3865  int o = p->GetpFDeg() + p->ecart;
3866  int op = set[length].GetpFDeg() + set[length].ecart;
3867
3868  if ((op > o)
3869  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
3870    return length+1;
3871  int i;
3872  int an = 0;
3873  int en= length;
3874  loop
3875  {
3876    if (an >= en-1)
3877    {
3878      op = set[an].GetpFDeg() + set[an].ecart;
3879      if ((op > o)
3880      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
3881        return en;
3882      return an;
3883    }
3884    i=(an+en) / 2;
3885    op = set[i].GetpFDeg() + set[i].ecart;
3886    if ((op > o)
3887    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
3888      an=i;
3889    else
3890      en=i;
3891  }
3892}
3893
3894/*2
3895* looks up the position of polynomial p in set
3896* e is the ecart of p
3897* set[length] is the smallest element in set with respect
3898* to the ordering-procedure totaldegree
3899*/
3900int posInL17 (const LSet set, const int length,
3901              LObject* p,const kStrategy strat)
3902{
3903  if (length<0) return 0;
3904
3905  int o = p->GetpFDeg() + p->ecart;
3906
3907  if ((set[length].GetpFDeg() + set[length].ecart > o)
3908  || ((set[length].GetpFDeg() + set[length].ecart == o)
3909     && (set[length].ecart > p->ecart))
3910  || ((set[length].GetpFDeg() + set[length].ecart == o)
3911     && (set[length].ecart == p->ecart)
3912     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
3913    return length+1;
3914  int i;
3915  int an = 0;
3916  int en= length;
3917  loop
3918  {
3919    if (an >= en-1)
3920    {
3921      if ((set[an].GetpFDeg() + set[an].ecart > o)
3922      || ((set[an].GetpFDeg() + set[an].ecart == o)
3923         && (set[an].ecart > p->ecart))
3924      || ((set[an].GetpFDeg() + set[an].ecart == o)
3925         && (set[an].ecart == p->ecart)
3926         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
3927        return en;
3928      return an;
3929    }
3930    i=(an+en) / 2;
3931    if ((set[i].GetpFDeg() + set[i].ecart > o)
3932    || ((set[i].GetpFDeg() + set[i].ecart == o)
3933       && (set[i].ecart > p->ecart))
3934    || ((set[i].GetpFDeg() +set[i].ecart == o)
3935       && (set[i].ecart == p->ecart)
3936       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
3937      an=i;
3938    else
3939      en=i;
3940  }
3941}
3942/*2
3943* looks up the position of polynomial p in set
3944* e is the ecart of p
3945* set[length] is the smallest element in set with respect
3946* to the ordering-procedure pComp
3947*/
3948int posInL17_c (const LSet set, const int length,
3949                LObject* p,const kStrategy strat)
3950{
3951  if (length<0) return 0;
3952
3953  int cc = (-1+2*currRing->order[0]==ringorder_c);
3954  /* cc==1 for (c,..), cc==-1 for (C,..) */
3955  int c = pGetComp(p->p)*cc;
3956  int o = p->GetpFDeg() + p->ecart;
3957
3958  if (pGetComp(set[length].p)*cc > c)
3959    return length+1;
3960  if (pGetComp(set[length].p)*cc == c)
3961  {
3962    if ((set[length].GetpFDeg() + set[length].ecart > o)
3963    || ((set[length].GetpFDeg() + set[length].ecart == o)
3964       && (set[length].ecart > p->ecart))
3965    || ((set[length].GetpFDeg() + set[length].ecart == o)
3966       && (set[length].ecart == p->ecart)
3967       && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
3968      return length+1;
3969  }
3970  int i;
3971  int an = 0;
3972  int en= length;
3973  loop
3974  {
3975    if (an >= en-1)
3976    {
3977      if (pGetComp(set[an].p)*cc > c)
3978        return en;
3979      if (pGetComp(set[an].p)*cc == c)
3980      {
3981        if ((set[an].GetpFDeg() + set[an].ecart > o)
3982        || ((set[an].GetpFDeg() + set[an].ecart == o)
3983           && (set[an].ecart > p->ecart))
3984        || ((set[an].GetpFDeg() + set[an].ecart == o)
3985           && (set[an].ecart == p->ecart)
3986           && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
3987          return en;
3988      }
3989      return an;
3990    }
3991    i=(an+en) / 2;
3992    if (pGetComp(set[i].p)*cc > c)
3993      an=i;
3994    else if (pGetComp(set[i].p)*cc == c)
3995    {
3996      if ((set[i].GetpFDeg() + set[i].ecart > o)
3997      || ((set[i].GetpFDeg() + set[i].ecart == o)
3998         && (set[i].ecart > p->ecart))
3999      || ((set[i].GetpFDeg() +set[i].ecart == o)
4000         && (set[i].ecart == p->ecart)
4001         && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4002        an=i;
4003      else
4004        en=i;
4005    }
4006    else
4007      en=i;
4008  }
4009}
4010
4011/***************************************************************
4012 *
4013 * Tail reductions
4014 *
4015 ***************************************************************/
4016TObject*
4017kFindDivisibleByInS(kStrategy strat, int pos, LObject* L, TObject *T,
4018                    long ecart)
4019{
4020  int j = 0;
4021  const unsigned long not_sev = ~L->sev;
4022  const unsigned long* sev = strat->sevS;
4023  poly p;
4024  ring r;
4025  L->GetLm(p, r);
4026
4027  assume(~not_sev == p_GetShortExpVector(p, r));
4028
4029  if (r == currRing)
4030  {
4031    loop
4032    {
4033      if (j > pos) return NULL;
4034#if defined(PDEBUG) || defined(PDIV_DEBUG)
4035      if (p_LmShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
4036          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4037        break;
4038#else
4039      if (!(sev[j] & not_sev) &&
4040          (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
4041          p_LmDivisibleBy(strat->S[j], p, r))
4042        break;
4043
4044#endif
4045      j++;
4046    }
4047    // if called from NF, T objects do not exist:
4048    if (strat->tl < 0 || strat->S_2_R[j] == -1)
4049    {
4050      T->Set(strat->S[j], r, strat->tailRing);
4051      return T;
4052    }
4053    else
4054    {
4055      assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL &&
4056              strat->S_2_T(j)->p == strat->S[j]);
4057      return strat->S_2_T(j);
4058    }
4059  }
4060  else
4061  {
4062    TObject* t;
4063    loop
4064    {
4065      if (j > pos) return NULL;
4066      assume(strat->S_2_R[j] != -1);
4067#if defined(PDEBUG) || defined(PDIV_DEBUG)
4068      t = strat->S_2_T(j);
4069      assume(t != NULL && t->t_p != NULL && t->tailRing == r);
4070      if (p_LmShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
4071          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4072        return t;
4073#else
4074      if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4075      {
4076        t = strat->S_2_T(j);
4077        assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
4078        if (p_LmDivisibleBy(t->t_p, p, r)) return t;
4079      }
4080#endif
4081      j++;
4082    }
4083  }
4084}
4085
4086poly redtail (LObject* L, int pos, kStrategy strat)
4087{
4088  poly h, hn;
4089  int j;
4090  unsigned long not_sev;
4091  strat->redTailChange=FALSE;
4092
4093  poly p = L->p;
4094  if (strat->noTailReduction || pNext(p) == NULL)
4095    return p;
4096
4097  LObject Ln(strat->tailRing);
4098  TObject* With;
4099  // placeholder in case strat->tl < 0
4100  TObject  With_s(strat->tailRing);
4101  h = p;
4102  hn = pNext(h);
4103  long op = strat->tailRing->pFDeg(hn, strat->tailRing);
4104  long e;
4105  int l;
4106  BOOLEAN save_HE=strat->kHEdgeFound;
4107  strat->kHEdgeFound |=
4108    ((Kstd1_deg>0) && (op<=Kstd1_deg)) || TEST_OPT_INFREDTAIL;
4109
4110  while(hn != NULL)
4111  {
4112    op = strat->tailRing->pFDeg(hn, strat->tailRing);
4113    if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
4114    e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
4115    loop
4116    {
4117      Ln.Set(hn, strat->tailRing);
4118      Ln.sev = p_GetShortExpVector(hn, strat->tailRing);
4119      if (strat->kHEdgeFound)
4120        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
4121      else
4122        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s, e);
4123      if (With == NULL) break;
4124      With->length=0;
4125      With->pLength=0;
4126      strat->redTailChange=TRUE;
4127      if (ksReducePolyTail(L, With, h, strat->kNoetherTail()))
4128      {
4129        // reducing the tail would violate the exp bound
4130        if (kStratChangeTailRing(strat, L))
4131        {
4132          strat->kHEdgeFound = save_HE;
4133          return redtail(L, pos, strat);
4134        }
4135        else
4136          return NULL;
4137      }
4138      hn = pNext(h);
4139      if (hn == NULL) goto all_done;
4140      op = strat->tailRing->pFDeg(hn, strat->tailRing);
4141      if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
4142      e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
4143    }
4144    h = hn;
4145    hn = pNext(h);
4146  }
4147
4148  all_done:
4149  if (strat->redTailChange)
4150  {
4151    L->last = 0;
4152    L->pLength = 0;
4153  }
4154  strat->kHEdgeFound = save_HE;
4155  return p;
4156}
4157
4158poly redtail (poly p, int pos, kStrategy strat)
4159{
4160  LObject L(p, currRing);
4161  return redtail(&L, pos, strat);
4162}
4163
4164poly redtailBba (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
4165{
4166  strat->redTailChange=FALSE;
4167  if (strat->noTailReduction) return L->GetLmCurrRing();
4168  poly h, p;
4169  p = h = L->GetLmTailRing();
4170  if ((h==NULL) || (pNext(h)==NULL))
4171    return L->GetLmCurrRing();
4172
4173  TObject* With;
4174  // placeholder in case strat->tl < 0
4175  TObject  With_s(strat->tailRing);
4176
4177  LObject Ln(pNext(h), strat->tailRing);
4178  Ln.pLength = L->GetpLength() - 1;
4179
4180  pNext(h) = NULL;
4181  if (L->p != NULL) pNext(L->p) = NULL;
4182  L->pLength = 1;
4183
4184  Ln.PrepareRed(strat->use_buckets);
4185
4186  while(!Ln.IsNull())
4187  {
4188    loop
4189    {
4190      Ln.SetShortExpVector();
4191      if (withT)
4192      {
4193        int j;
4194        j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
4195        if (j < 0) break;
4196        With = &(strat->T[j]);
4197      }
4198      else
4199      {
4200        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
4201        if (With == NULL) break;
4202      }
4203      if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
4204      {
4205        With->pNorm();
4206        //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
4207      }
4208      strat->redTailChange=TRUE;
4209      if (ksReducePolyTail(L, With, &Ln))
4210      {
4211        // reducing the tail would violate the exp bound
4212        //  set a flag and hope for a retry (in bba)
4213        strat->completeReduce_retry=TRUE;
4214        do
4215        {
4216          pNext(h) = Ln.LmExtractAndIter();
4217          pIter(h);
4218          L->pLength++;
4219        } while (!Ln.IsNull());
4220        goto all_done;
4221      }
4222      if (Ln.IsNull()) goto all_done;
4223      if (! withT) With_s.Init(currRing);
4224    }
4225    pNext(h) = Ln.LmExtractAndIter();
4226    pIter(h);
4227    L->pLength++;
4228  }
4229
4230  all_done:
4231  Ln.Delete();
4232  if (L->p != NULL) pNext(L->p) = pNext(p);
4233
4234  if (strat->redTailChange)
4235  {
4236    L->last = NULL;
4237    L->length = 0;
4238  }
4239  L->Normalize(); // HANNES: should have a test
4240  kTest_L(L);
4241  return L->GetLmCurrRing();
4242}
4243
4244/*2
4245*checks the change degree and write progress report
4246*/
4247void message (int i,int* reduc,int* olddeg,kStrategy strat, int red_result)
4248{
4249  if (i != *olddeg)
4250  {
4251    Print("%d",i);
4252    *olddeg = i;
4253  }
4254  if (K_TEST_OPT_OLDSTD)
4255  {
4256    if (strat->Ll != *reduc)
4257    {
4258      if (strat->Ll != *reduc-1)
4259        Print("(%d)",strat->Ll+1);
4260      else
4261        PrintS("-");
4262      *reduc = strat->Ll;
4263    }
4264    else
4265      PrintS(".");
4266    mflush();
4267  }
4268  else
4269  {
4270    if (red_result == 0)
4271      PrintS("-");
4272    else if (red_result < 0)
4273      PrintS(".");
4274    if ((red_result > 0) || ((strat->Ll % 100)==99))
4275    {
4276      if (strat->Ll != *reduc && strat->Ll > 0)
4277      {
4278        Print("(%d)",strat->Ll+1);
4279        *reduc = strat->Ll;
4280      }
4281    }
4282  }
4283}
4284
4285/*2
4286*statistics
4287*/
4288void messageStat (int srmax,int lrmax,int hilbcount,kStrategy strat)
4289{
4290  //PrintS("\nUsage/Allocation of temporary storage:\n");
4291  //Print("%d/%d polynomials in standard base\n",srmax,IDELEMS(Shdl));
4292  //Print("%d/%d polynomials in set L (for lazy alg.)",lrmax+1,strat->Lmax);
4293  Print("product criterion:%d chain criterion:%d\n",strat->cp,strat->c3);
4294  if (hilbcount!=0) Print("hilbert series criterion:%d\n",hilbcount);
4295  /*mflush();*/
4296}
4297
4298#ifdef KDEBUG
4299/*2
4300*debugging output: all internal sets, if changed
4301*for testing purpuse only/has to be changed for later use
4302*/
4303void messageSets (kStrategy strat)
4304{
4305  int i;
4306  if (strat->news)
4307  {
4308    PrintS("set S");
4309    for (i=0; i<=strat->sl; i++)
4310    {
4311      Print("\n  %d:",i);
4312      p_wrp(strat->S[i], currRing, strat->tailRing);
4313    }
4314    strat->news = FALSE;
4315  }
4316  if (strat->newt)
4317  {
4318    PrintS("\nset T");
4319    for (i=0; i<=strat->tl; i++)
4320    {
4321      Print("\n  %d:",i);
4322      strat->T[i].wrp();
4323      Print(" o:%d e:%d l:%d",
4324        strat->T[i].pFDeg(),strat->T[i].ecart,strat->T[i].length);
4325    }
4326    strat->newt = FALSE;
4327  }
4328  PrintS("\nset L");
4329  for (i=strat->Ll; i>=0; i--)
4330  {
4331    Print("\n%d:",i);
4332    p_wrp(strat->L[i].p1, currRing, strat->tailRing);
4333    PrintS("  ");
4334    p_wrp(strat->L[i].p2, currRing, strat->tailRing);
4335    PrintS(" lcm: ");p_wrp(strat->L[i].lcm, currRing);
4336    PrintS("\n  p : ");
4337    strat->L[i].wrp();
4338    Print("  o:%d e:%d l:%d",
4339          strat->L[i].pFDeg(),strat->L[i].ecart,strat->L[i].length);
4340  }
4341  PrintLn();
4342}
4343
4344#endif
4345
4346
4347/*2
4348*construct the set s from F
4349*/
4350void initS (ideal F, ideal Q,kStrategy strat)
4351{
4352  int   i,pos;
4353
4354  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4355  else i=setmaxT;
4356  strat->ecartS=initec(i);
4357  strat->sevS=initsevS(i);
4358  strat->S_2_R=initS_2_R(i);
4359  strat->fromQ=NULL;
4360  strat->Shdl=idInit(i,F->rank);
4361  strat->S=strat->Shdl->m;
4362  /*- put polys into S -*/
4363  if (Q!=NULL)
4364  {
4365    strat->fromQ=initec(i);
4366    memset(strat->fromQ,0,i*sizeof(int));
4367    for (i=0; i<IDELEMS(Q); i++)
4368    {
4369      if (Q->m[i]!=NULL)
4370      {
4371        LObject h;
4372        h.p = pCopy(Q->m[i]);
4373        if (TEST_OPT_INTSTRATEGY)
4374        {
4375          //pContent(h.p);
4376          h.pCleardenom(); // also does a pContent
4377        }
4378        else
4379        {
4380          h.pNorm();
4381        }
4382        if (pOrdSgn==-1)
4383        {
4384          deleteHC(&h, strat);
4385        }
4386        if (h.p!=NULL)
4387        {
4388          strat->initEcart(&h);
4389          if (strat->sl==-1)
4390            pos =0;
4391          else
4392          {
4393            pos = posInS(strat,strat->sl,h.p,h.ecart);
4394          }
4395          h.sev = pGetShortExpVector(h.p);
4396          strat->enterS(h,pos,strat,-1);
4397          strat->fromQ[pos]=1;
4398        }
4399      }
4400    }
4401  }
4402  for (i=0; i<IDELEMS(F); i++)
4403  {
4404    if (F->m[i]!=NULL)
4405    {
4406      LObject h;
4407      h.p = pCopy(F->m[i]);
4408      if (pOrdSgn==-1)
4409      {
4410        cancelunit(&h);  /*- tries to cancel a unit -*/
4411        deleteHC(&h, strat);
4412      }
4413      if (TEST_OPT_INTSTRATEGY)
4414      {
4415        //pContent(h.p);
4416        h.pCleardenom(); // also does a pContent
4417      }
4418      else
4419      {
4420        h.pNorm();
4421      }
4422      if (h.p!=NULL)
4423      {
4424        strat->initEcart(&h);
4425        if (strat->sl==-1)
4426          pos =0;
4427        else
4428          pos = posInS(strat,strat->sl,h.p,h.ecart);
4429        h.sev = pGetShortExpVector(h.p);
4430        strat->enterS(h,pos,strat,-1);
4431      }
4432    }
4433  }
4434  /*- test, if a unit is in F -*/
4435  if ((strat->sl>=0)
4436#ifdef HAVE_RINGS
4437       && nIsUnit(pGetCoeff(strat->S[0]))
4438#endif
4439       && pIsConstant(strat->S[0]))
4440  {
4441    while (strat->sl>0) deleteInS(strat->sl,strat);
4442  }
4443}
4444
4445void initSL (ideal F, ideal Q,kStrategy strat)
4446{
4447  int   i,pos;
4448
4449  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4450  else i=setmaxT;
4451  strat->ecartS=initec(i);
4452  strat->sevS=initsevS(i);
4453  strat->S_2_R=initS_2_R(i);
4454  strat->fromQ=NULL;
4455  strat->Shdl=idInit(i,F->rank);
4456  strat->S=strat->Shdl->m;
4457  /*- put polys into S -*/
4458  if (Q!=NULL)
4459  {
4460    strat->fromQ=initec(i);
4461    memset(strat->fromQ,0,i*sizeof(int));
4462    for (i=0; i<IDELEMS(Q); i++)
4463    {
4464      if (Q->m[i]!=NULL)
4465      {
4466        LObject h;
4467        h.p = pCopy(Q->m[i]);
4468        if (pOrdSgn==-1)
4469        {
4470          deleteHC(&h,strat);
4471        }
4472        if (TEST_OPT_INTSTRATEGY)
4473        {
4474          //pContent(h.p);
4475          h.pCleardenom(); // also does a pContent
4476        }
4477        else
4478        {
4479          h.pNorm();
4480        }
4481        if (h.p!=NULL)
4482        {
4483          strat->initEcart(&h);
4484          if (strat->sl==-1)
4485            pos =0;
4486          else
4487          {
4488            pos = posInS(strat,strat->sl,h.p,h.ecart);
4489          }
4490          h.sev = pGetShortExpVector(h.p);
4491          strat->enterS(h,pos,strat,-1);
4492          strat->fromQ[pos]=1;
4493        }
4494      }
4495    }
4496  }
4497  for (i=0; i<IDELEMS(F); i++)
4498  {
4499    if (F->m[i]!=NULL)
4500    {
4501      LObject h;
4502      h.p = pCopy(F->m[i]);
4503      if (h.p!=NULL)
4504      {
4505        if (pOrdSgn==-1)
4506        {
4507          cancelunit(&h);  /*- tries to cancel a unit -*/
4508          deleteHC(&h, strat);
4509        }
4510        if (h.p!=NULL)
4511        {
4512          if (TEST_OPT_INTSTRATEGY)
4513          {
4514            //pContent(h.p);
4515            h.pCleardenom(); // also does a pContent
4516          }
4517          else
4518          {
4519            h.pNorm();
4520          }
4521          strat->initEcart(&h);
4522          if (strat->Ll==-1)
4523            pos =0;
4524          else
4525            pos = strat->posInL(strat->L,strat->Ll,&h,strat);
4526          h.sev = pGetShortExpVector(h.p);
4527          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
4528        }
4529      }
4530    }
4531  }
4532  /*- test, if a unit is in F -*/
4533
4534  if ((strat->Ll>=0) 
4535#ifdef HAVE_RINGS
4536       && nIsUnit(pGetCoeff(strat->L[strat->Ll].p))
4537#endif
4538       && pIsConstant(strat->L[strat->Ll].p))
4539  {
4540    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
4541  }
4542}
4543
4544
4545/*2
4546*construct the set s from F and {P}
4547*/
4548void initSSpecial (ideal F, ideal Q, ideal P,kStrategy strat)
4549{
4550  int   i,pos;
4551
4552  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4553  else i=setmaxT;
4554  i=((i+IDELEMS(F)+IDELEMS(P)+15)/16)*16;
4555  strat->ecartS=initec(i);
4556  strat->sevS=initsevS(i);
4557  strat->S_2_R=initS_2_R(i);
4558  strat->fromQ=NULL;
4559  strat->Shdl=idInit(i,F->rank);
4560  strat->S=strat->Shdl->m;
4561
4562  /*- put polys into S -*/
4563  if (Q!=NULL)
4564  {
4565    strat->fromQ=initec(i);
4566    memset(strat->fromQ,0,i*sizeof(int));
4567    for (i=0; i<IDELEMS(Q); i++)
4568    {
4569      if (Q->m[i]!=NULL)
4570      {
4571        LObject h;
4572        h.p = pCopy(Q->m[i]);
4573        //if (TEST_OPT_INTSTRATEGY)
4574        //{
4575        //  //pContent(h.p);
4576        //  h.pCleardenom(); // also does a pContent
4577        //}
4578        //else
4579        //{
4580        //  h.pNorm();
4581        //}
4582        if (pOrdSgn==-1)
4583        {
4584          deleteHC(&h,strat);
4585        }
4586        if (h.p!=NULL)
4587        {
4588          strat->initEcart(&h);
4589          if (strat->sl==-1)
4590            pos =0;
4591          else
4592          {
4593            pos = posInS(strat,strat->sl,h.p,h.ecart);
4594          }
4595          h.sev = pGetShortExpVector(h.p);
4596          strat->enterS(h,pos,strat, strat->tl+1);
4597          enterT(h, strat);
4598          strat->fromQ[pos]=1;
4599        }
4600      }
4601    }
4602  }
4603  /*- put polys into S -*/
4604  for (i=0; i<IDELEMS(F); i++)
4605  {
4606    if (F->m[i]!=NULL)
4607    {
4608      LObject h;
4609      h.p = pCopy(F->m[i]);
4610      if (pOrdSgn==-1)
4611      {
4612        deleteHC(&h,strat);
4613      }
4614      else
4615      {
4616        h.p=redtailBba(h.p,strat->sl,strat);
4617      }
4618      if (h.p!=NULL)
4619      {
4620        strat->initEcart(&h);
4621        if (strat->sl==-1)
4622          pos =0;
4623        else
4624          pos = posInS(strat,strat->sl,h.p,h.ecart);
4625        h.sev = pGetShortExpVector(h.p);
4626        strat->enterS(h,pos,strat, strat->tl+1);
4627        enterT(h,strat);
4628      }
4629    }
4630  }
4631  for (i=0; i<IDELEMS(P); i++)
4632  {
4633    if (P->m[i]!=NULL)
4634    {
4635      LObject h;
4636      h.p=pCopy(P->m[i]);
4637      if (TEST_OPT_INTSTRATEGY)
4638      {
4639        h.pCleardenom();
4640      }
4641      else
4642      {
4643        h.pNorm();
4644      }
4645      if(strat->sl>=0)
4646      {
4647        if (pOrdSgn==1)
4648        {
4649          h.p=redBba(h.p,strat->sl,strat);
4650          if (h.p!=NULL)
4651          {
4652            h.p=redtailBba(h.p,strat->sl,strat);
4653          }
4654        }
4655        else
4656        {
4657          h.p=redMora(h.p,strat->sl,strat);
4658        }
4659        if(h.p!=NULL)
4660        {
4661          strat->initEcart(&h);
4662          if (TEST_OPT_INTSTRATEGY)
4663          {
4664            h.pCleardenom();
4665          }
4666          else
4667          {
4668            h.is_normalized = 0;
4669            h.pNorm();
4670          }
4671          h.sev = pGetShortExpVector(h.p);
4672          h.SetpFDeg();
4673          pos = posInS(strat,strat->sl,h.p,h.ecart);
4674          enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
4675          strat->enterS(h,pos,strat, strat->tl+1);
4676          enterT(h,strat);
4677        }
4678      }
4679      else
4680      {
4681        h.sev = pGetShortExpVector(h.p);
4682        strat->initEcart(&h);
4683        strat->enterS(h,0,strat, strat->tl+1);
4684        enterT(h,strat);
4685      }
4686    }
4687  }
4688}
4689/*2
4690* reduces h using the set S
4691* procedure used in cancelunit1
4692*/
4693static poly redBba1 (poly h,int maxIndex,kStrategy strat)
4694{
4695  int j = 0;
4696  unsigned long not_sev = ~ pGetShortExpVector(h);
4697
4698  while (j <= maxIndex)
4699  {
4700    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j],h, not_sev))
4701       return ksOldSpolyRedNew(strat->S[j],h,strat->kNoetherTail());
4702    else j++;
4703  }
4704  return h;
4705}
4706
4707/*2
4708*tests if p.p=monomial*unit and cancels the unit
4709*/
4710void cancelunit1 (LObject* p,int *suc, int index,kStrategy strat )
4711{
4712  int k;
4713  poly r,h,h1,q;
4714
4715  if (!pIsVector((*p).p) && ((*p).ecart != 0))
4716  {
4717    k = 0;
4718    h1 = r = pCopy((*p).p);
4719    h =pNext(r);
4720    loop
4721    {
4722      if (h==NULL)
4723      {
4724        pDelete(&r);
4725        pDelete(&(pNext((*p).p)));
4726        (*p).ecart = 0;
4727        (*p).length = 1;
4728        (*suc)=0;
4729        return;
4730      }
4731      if (!pDivisibleBy(r,h))
4732      {
4733        q=redBba1(h,index ,strat);
4734        if (q != h)
4735        {
4736          k++;
4737          pDelete(&h);
4738          pNext(h1) = h = q;
4739        }
4740        else
4741        {
4742          pDelete(&r);
4743          return;
4744        }
4745      }
4746      else
4747      {
4748        h1 = h;
4749        pIter(h);
4750      }
4751      if (k > 10)
4752      {
4753        pDelete(&r);
4754        return;
4755      }
4756    }
4757  }
4758}
4759
4760#if 0
4761/*2
4762* reduces h using the elements from Q in the set S
4763* procedure used in updateS
4764* must not be used for elements of Q or elements of an ideal !
4765*/
4766static poly redQ (poly h, int j, kStrategy strat)
4767{
4768  int start;
4769  unsigned long not_sev = ~ pGetShortExpVector(h);
4770  while ((j <= strat->sl) && (pGetComp(strat->S[j])!=0)) j++;
4771  start=j;
4772  while (j<=strat->sl)
4773  {
4774    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
4775    {
4776      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
4777      if (h==NULL) return NULL;
4778      j = start;
4779      not_sev = ~ pGetShortExpVector(h);
4780    }
4781    else j++;
4782  }
4783  return h;
4784}
4785#endif
4786
4787/*2
4788* reduces h using the set S
4789* procedure used in updateS
4790*/
4791static poly redBba (poly h,int maxIndex,kStrategy strat)
4792{
4793  int j = 0;
4794  unsigned long not_sev = ~ pGetShortExpVector(h);
4795
4796  while (j <= maxIndex)
4797  {
4798    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
4799    {
4800      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
4801      if (h==NULL) return NULL;
4802      j = 0;
4803      not_sev = ~ pGetShortExpVector(h);    }
4804    else j++;
4805  }
4806  return h;
4807}
4808
4809/*2
4810* reduces h using the set S
4811*e is the ecart of h
4812*procedure used in updateS
4813*/
4814static poly redMora (poly h,int maxIndex,kStrategy strat)
4815{
4816  int  j=0;
4817  int  e,l;
4818  unsigned long not_sev = ~ pGetShortExpVector(h);
4819
4820  if (maxIndex >= 0)
4821  {
4822    e = pLDeg(h,&l,currRing)-pFDeg(h,currRing);
4823    do
4824    {
4825      if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev)
4826      && ((e >= strat->ecartS[j]) || strat->kHEdgeFound))
4827      {
4828#ifdef KDEBUG
4829        if (TEST_OPT_DEBUG)
4830          {PrintS("reduce ");wrp(h);Print(" with S[%d] (",j);wrp(strat->S[j]);}
4831#endif
4832        h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
4833#ifdef KDEBUG
4834        if(TEST_OPT_DEBUG)
4835          {PrintS(")\nto "); wrp(h); PrintLn();}
4836#endif
4837        // pDelete(&h);
4838        if (h == NULL) return NULL;
4839        e = pLDeg(h,&l,currRing)-pFDeg(h,currRing);
4840        j = 0;
4841        not_sev = ~ pGetShortExpVector(h);
4842      }
4843      else j++;
4844    }
4845    while (j <= maxIndex);
4846  }
4847  return h;
4848}
4849
4850/*2
4851*updates S:
4852*the result is a set of polynomials which are in
4853*normalform with respect to S
4854*/
4855void updateS(BOOLEAN toT,kStrategy strat)
4856{
4857  LObject h;
4858  int i, suc=0;
4859  poly redSi=NULL;
4860  BOOLEAN change,any_change;
4861//  Print("nach initS: updateS start mit sl=%d\n",(strat->sl));
4862//  for (i=0; i<=(strat->sl); i++)
4863//  {
4864//    Print("s%d:",i);
4865//    if (strat->fromQ!=NULL) Print("(Q:%d) ",strat->fromQ[i]);
4866//    pWrite(strat->S[i]);
4867//  }
4868//  Print("pOrdSgn=%d\n", pOrdSgn);
4869  any_change=FALSE;
4870  if (pOrdSgn==1)
4871  {
4872    while (suc != -1)
4873    {
4874      i=suc+1;
4875      while (i<=strat->sl)
4876      {
4877        change=FALSE;
4878        if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
4879        {
4880          redSi = pHead(strat->S[i]);
4881          strat->S[i] = redBba(strat->S[i],i-1,strat);
4882          //if ((strat->ak!=0)&&(strat->S[i]!=NULL))
4883          //  strat->S[i]=redQ(strat->S[i],i+1,strat); /*reduce S[i] mod Q*/
4884          if (pCmp(redSi,strat->S[i])!=0)
4885          {
4886            change=TRUE;
4887            any_change=TRUE;
4888            #ifdef KDEBUG
4889            if (TEST_OPT_DEBUG)
4890            {
4891              PrintS("reduce:");
4892              wrp(redSi);PrintS(" to ");p_wrp(strat->S[i], currRing, strat->tailRing);PrintLn();
4893            }
4894            #endif
4895            if (TEST_OPT_PROT)
4896            {
4897              if (strat->S[i]==NULL)
4898                PrintS("V");
4899              else
4900                PrintS("v");
4901              mflush();
4902            }
4903          }
4904          pDeleteLm(&redSi);
4905          if (strat->S[i]==NULL)
4906          {
4907            deleteInS(i,strat);
4908            i--;
4909          }
4910          else if (change)
4911          {
4912            if (TEST_OPT_INTSTRATEGY)
4913            {
4914              //pContent(strat->S[i]);
4915              pCleardenom(strat->S[i]);// also does a pContent
4916            }
4917            else
4918            {
4919              pNorm(strat->S[i]);
4920            }
4921            strat->sevS[i] = pGetShortExpVector(strat->S[i]);
4922          }
4923        }
4924        i++;
4925      }
4926      if (any_change) reorderS(&suc,strat);
4927      else break;
4928    }
4929    if (toT)
4930    {
4931      for (i=0; i<=strat->sl; i++)
4932      {
4933        if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
4934        {
4935          h.p = redtailBba(strat->S[i],i-1,strat);
4936          if (TEST_OPT_INTSTRATEGY)
4937          {
4938            pCleardenom(h.p);// also does a pContent
4939          }
4940        }
4941        else
4942        {
4943          h.p = strat->S[i];
4944        }
4945        strat->initEcart(&h);
4946        if (strat->honey)
4947        {
4948          strat->ecartS[i] = h.ecart;
4949        }
4950        if (strat->sevS[i] == 0) {strat->sevS[i] = pGetShortExpVector(h.p);}
4951        else assume(strat->sevS[i] == pGetShortExpVector(h.p));
4952        h.sev = strat->sevS[i];
4953        /*puts the elements of S also to T*/
4954        enterT(h,strat);
4955        strat->S_2_R[i] = strat->tl;
4956      }
4957    }
4958  }
4959  else
4960  {
4961    while (suc != -1)
4962    {
4963      i=suc;
4964      while (i<=strat->sl)
4965      {
4966        change=FALSE;
4967        if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
4968        {
4969          redSi=pHead((strat->S)[i]);
4970          (strat->S)[i] = redMora((strat->S)[i],i-1,strat);
4971          if ((strat->S)[i]==NULL)
4972          {
4973            deleteInS(i,strat);
4974            i--;
4975          }
4976          else if (pCmp((strat->S)[i],redSi)!=0)
4977          {
4978            any_change=TRUE;
4979            h.p = strat->S[i];
4980            strat->initEcart(&h);
4981            strat->ecartS[i] = h.ecart;
4982            if (TEST_OPT_INTSTRATEGY)
4983            {
4984              pCleardenom(strat->S[i]);// also does a pContent
4985            }
4986            else
4987            {
4988              pNorm(strat->S[i]); // == h.p
4989            }
4990            h.sev =  pGetShortExpVector(h.p);
4991            strat->sevS[i] = h.sev;
4992          }
4993          pDeleteLm(&redSi);
4994          kTest(strat);
4995        }
4996        i++;
4997      }
4998#ifdef KDEBUG
4999      kTest(strat);
5000#endif
5001      if (any_change) reorderS(&suc,strat);
5002      else { suc=-1; break; }
5003      if (h.p!=NULL)
5004      {
5005        if (!strat->kHEdgeFound)
5006        {
5007          /*strat->kHEdgeFound =*/ HEckeTest(h.p,strat);
5008        }
5009        if (strat->kHEdgeFound)
5010          newHEdge(strat->S,strat);
5011      }
5012    }
5013    for (i=0; i<=strat->sl; i++)
5014    {
5015      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
5016      {
5017        strat->S[i] = h.p = redtail(strat->S[i],strat->sl,strat);
5018        strat->initEcart(&h);
5019        strat->ecartS[i] = h.ecart;
5020        h.sev = pGetShortExpVector(h.p);
5021        strat->sevS[i] = h.sev;
5022      }
5023      else
5024      {
5025        h.p = strat->S[i];
5026        h.ecart=strat->ecartS[i];
5027        h.sev = strat->sevS[i];
5028        h.length = h.pLength = pLength(h.p);
5029      }
5030      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
5031        cancelunit1(&h,&suc,strat->sl,strat);
5032      h.SetpFDeg();
5033      /*puts the elements of S also to T*/
5034      enterT(h,strat);
5035      strat->S_2_R[i] = strat->tl;
5036    }
5037    if (suc!= -1) updateS(toT,strat);
5038  }
5039#ifdef KDEBUG
5040  kTest(strat);
5041#endif
5042}
5043
5044
5045/*2
5046* -puts p to the standardbasis s at position at
5047* -saves the result in S
5048*/
5049void enterSBba (LObject p,int atS,kStrategy strat, int atR)
5050{
5051  int i;
5052  strat->news = TRUE;
5053  /*- puts p to the standardbasis s at position at -*/
5054  if (strat->sl == IDELEMS(strat->Shdl)-1)
5055  {
5056    strat->sevS = (unsigned long*) omRealloc0Size(strat->sevS,
5057                                    IDELEMS(strat->Shdl)*sizeof(unsigned long),
5058                                    (IDELEMS(strat->Shdl)+setmaxTinc)
5059                                                  *sizeof(unsigned long));
5060    strat->ecartS = (intset)omReallocSize(strat->ecartS,
5061                                          IDELEMS(strat->Shdl)*sizeof(int),
5062                                          (IDELEMS(strat->Shdl)+setmaxTinc)
5063                                                  *sizeof(int));
5064    strat->S_2_R = (int*) omRealloc0Size(strat->S_2_R,
5065                                         IDELEMS(strat->Shdl)*sizeof(int),
5066                                         (IDELEMS(strat->Shdl)+setmaxTinc)
5067                                                  *sizeof(int));
5068    if (strat->lenS!=NULL)
5069      strat->lenS=(int*)omRealloc0Size(strat->lenS,
5070                                       IDELEMS(strat->Shdl)*sizeof(int),
5071                                       (IDELEMS(strat->Shdl)+setmaxTinc)
5072                                                 *sizeof(int));
5073    if (strat->lenSw!=NULL)
5074      strat->lenSw=(wlen_type*)omRealloc0Size(strat->lenSw,
5075                                       IDELEMS(strat->Shdl)*sizeof(wlen_type),
5076                                       (IDELEMS(strat->Shdl)+setmaxTinc)
5077                                                 *sizeof(wlen_type));
5078    if (strat->fromQ!=NULL)
5079    {
5080      strat->fromQ = (intset)omReallocSize(strat->fromQ,
5081                                    IDELEMS(strat->Shdl)*sizeof(int),
5082                                    (IDELEMS(strat->Shdl)+setmaxTinc)*sizeof(int));
5083    }
5084    pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmaxTinc);
5085    IDELEMS(strat->Shdl)+=setmaxTinc;
5086    strat->Shdl->m=strat->S;
5087  }
5088  if (atS <= strat->sl)
5089  {
5090#ifdef ENTER_USE_MEMMOVE
5091// #if 0
5092    memmove(&(strat->S[atS+1]), &(strat->S[atS]),
5093            (strat->sl - atS + 1)*sizeof(poly));
5094    memmove(&(strat->ecartS[atS+1]), &(strat->ecartS[atS]),
5095            (strat->sl - atS + 1)*sizeof(int));
5096    memmove(&(strat->sevS[atS+1]), &(strat->sevS[atS]),
5097            (strat->sl - atS + 1)*sizeof(unsigned long));
5098    memmove(&(strat->S_2_R[atS+1]), &(strat->S_2_R[atS]),
5099            (strat->sl - atS + 1)*sizeof(int));
5100    if (strat->lenS!=NULL)
5101    memmove(&(strat->lenS[atS+1]), &(strat->lenS[atS]),
5102            (strat->sl - atS + 1)*sizeof(int));
5103    if (strat->lenSw!=NULL)
5104    memmove(&(strat->lenSw[atS+1]), &(strat->lenSw[atS]),
5105            (strat->sl - atS + 1)*sizeof(wlen_type));
5106#else
5107    for (i=strat->sl+1; i>=atS+1; i--)
5108    {
5109      strat->S[i] = strat->S[i-1];
5110      strat->ecartS[i] = strat->ecartS[i-1];
5111      strat->sevS[i] = strat->sevS[i-1];
5112      strat->S_2_R[i] = strat->S_2_R[i-1];
5113    }
5114    if (strat->lenS!=NULL)
5115    for (i=strat->sl+1; i>=atS+1; i--)
5116      strat->lenS[i] = strat->lenS[i-1];
5117    if (strat->lenSw!=NULL)
5118    for (i=strat->sl+1; i>=atS+1; i--)
5119      strat->lenSw[i] = strat->lenSw[i-1];
5120#endif
5121  }
5122  if (strat->fromQ!=NULL)
5123  {
5124#ifdef ENTER_USE_MEMMOVE
5125    memmove(&(strat->fromQ[atS+1]), &(strat->fromQ[atS]),
5126                  (strat->sl - atS + 1)*sizeof(int));
5127#else
5128    for (i=strat->sl+1; i>=atS+1; i--)
5129    {
5130      strat->fromQ[i] = strat->fromQ[i-1];
5131    }
5132#endif
5133    strat->fromQ[atS]=0;
5134  }
5135
5136  /*- save result -*/
5137  strat->S[atS] = p.p;
5138  if (strat->honey) strat->ecartS[atS] = p.ecart;
5139  if (p.sev == 0)
5140    p.sev = pGetShortExpVector(p.p);
5141  else
5142    assume(p.sev == pGetShortExpVector(p.p));
5143  strat->sevS[atS] = p.sev;
5144  strat->ecartS[atS] = p.ecart;
5145  strat->S_2_R[atS] = atR;
5146  strat->sl++;
5147}
5148
5149/*2
5150* puts p to the set T at position atT
5151*/
5152void enterT(LObject p, kStrategy strat, int atT)
5153{
5154  int i;
5155
5156  pp_Test(p.p, currRing, p.tailRing);
5157  assume(strat->tailRing == p.tailRing);
5158  // redMoraNF complains about this -- but, we don't really
5159  // neeed this so far
5160  assume(p.pLength == 0 || pLength(p.p) == p.pLength);
5161  assume(p.FDeg == p.pFDeg());
5162  assume(!p.is_normalized || nIsOne(pGetCoeff(p.p)));
5163
5164  strat->newt = TRUE;
5165  if (atT < 0)
5166    atT = strat->posInT(strat->T, strat->tl, p);
5167  if (strat->tl == strat->tmax-1)
5168    enlargeT(strat->T,strat->R,strat->sevT,strat->tmax,setmaxTinc);
5169  if (atT <= strat->tl)
5170  {
5171#ifdef ENTER_USE_MEMMOVE
5172    memmove(&(strat->T[atT+1]), &(strat->T[atT]),
5173            (strat->tl-atT+1)*sizeof(TObject));
5174    memmove(&(strat->sevT[atT+1]), &(strat->sevT[atT]),
5175            (strat->tl-atT+1)*sizeof(unsigned long));
5176#endif
5177    for (i=strat->tl+1; i>=atT+1; i--)
5178    {
5179#ifndef ENTER_USE_MEMMOVE
5180      strat->T[i] = strat->T[i-1];
5181      strat->sevT[i] = strat->sevT[i-1];
5182#endif
5183      strat->R[strat->T[i].i_r] = &(strat->T[i]);
5184    }
5185  }
5186
5187  if (strat->tailBin != NULL && (pNext(p.p) != NULL))
5188  {
5189    pNext(p.p)=p_ShallowCopyDelete(pNext(p.p),
5190                                   (strat->tailRing != NULL ?
5191                                    strat->tailRing : currRing),
5192                                   strat->tailBin);
5193    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
5194  }
5195  strat->T[atT] = (TObject) p;
5196
5197  if (strat->tailRing != currRing && pNext(p.p) != NULL)
5198    strat->T[atT].max = p_GetMaxExpP(pNext(p.p), strat->tailRing);
5199  else
5200    strat->T[atT].max = NULL;
5201
5202  strat->tl++;
5203  strat->R[strat->tl] = &(strat->T[atT]);
5204  strat->T[atT].i_r = strat->tl;
5205  assume(p.sev == 0 || pGetShortExpVector(p.p) == p.sev);
5206  strat->sevT[atT] = (p.sev == 0 ? pGetShortExpVector(p.p) : p.sev);
5207  kTest_T(&(strat->T[atT]));
5208}
5209
5210void initHilbCrit(ideal F, ideal Q, intvec **hilb,kStrategy strat)
5211{
5212  if (strat->homog!=isHomog)
5213  {
5214    *hilb=NULL;
5215  }
5216}
5217
5218void initBuchMoraCrit(kStrategy strat)
5219{
5220  strat->sugarCrit =        TEST_OPT_SUGARCRIT;
5221  // obachman: Hmm.. I need BTEST1(2) for notBuckets ..
5222  //  strat->Gebauer =          BTEST1(2) || strat->homog || strat->sugarCrit;
5223  strat->Gebauer =          strat->homog || strat->sugarCrit;
5224  strat->honey =            !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
5225  if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
5226  strat->pairtest = NULL;
5227  /* alway use tailreduction, except:
5228  * - in local rings, - in lex order case, -in ring over extensions */
5229  strat->noTailReduction = !TEST_OPT_REDTAIL;
5230
5231#ifdef HAVE_PLURAL
5232  // and r is plural_ring
5233  if( rIsPluralRing(currRing) || (rIsSCA(currRing) && !strat->homog) )
5234  {    //or it has non-quasi-comm type... later
5235    strat->sugarCrit = FALSE;
5236    strat->Gebauer = FALSE;
5237    strat->honey = FALSE;
5238  }
5239#endif
5240
5241#ifdef HAVE_RINGS
5242  // Coefficient ring?
5243  if (rField_is_Ring(currRing))
5244  {
5245    strat->sugarCrit = FALSE;
5246    strat->Gebauer = FALSE ;
5247    strat->honey = FALSE;
5248  }
5249#endif
5250  #ifdef KDEBUG
5251  if (TEST_OPT_DEBUG)
5252  {
5253    if (strat->homog) PrintS("ideal/module is homogeneous\n");
5254    else              PrintS("ideal/module is not homogeneous\n");
5255  }
5256  #endif
5257}
5258
5259BOOLEAN kPosInLDependsOnLength(int (*pos_in_l)
5260                               (const LSet set, const int length,
5261                                LObject* L,const kStrategy strat))
5262{
5263  if (pos_in_l == posInL110 ||
5264      pos_in_l == posInL10)
5265    return TRUE;
5266
5267  return FALSE;
5268}
5269
5270void initBuchMoraPos (kStrategy strat)
5271{
5272  if (pOrdSgn==1)
5273  {
5274    if (strat->honey)
5275    {
5276      strat->posInL = posInL15;
5277      // ok -- here is the deal: from my experiments for Singular-2-0
5278      // I conclude that that posInT_EcartpLength is the best of
5279      // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
5280      // see the table at the end of this file
5281      if (K_TEST_OPT_OLDSTD)
5282        strat->posInT = posInT15;
5283      else
5284        strat->posInT = posInT_EcartpLength;
5285    }
5286    else if (pLexOrder && !TEST_OPT_INTSTRATEGY)
5287    {
5288      strat->posInL = posInL11;
5289      strat->posInT = posInT11;
5290    }
5291    else if (TEST_OPT_INTSTRATEGY)
5292    {
5293      strat->posInL = posInL11;
5294      strat->posInT = posInT11;
5295    }
5296    else
5297    {
5298      strat->posInL = posInL0;
5299      strat->posInT = posInT0;
5300    }
5301    //if (strat->minim>0) strat->posInL =posInLSpecial;
5302    if (strat->homog)
5303    {
5304       strat->posInL = posInL110;
5305       strat->posInT = posInT110;
5306    }
5307  }
5308  else
5309  {
5310    if (strat->homog)
5311    {
5312      strat->posInL = posInL11;
5313      strat->posInT = posInT11;
5314    }
5315    else
5316    {
5317      if ((currRing->order[0]==ringorder_c)
5318      ||(currRing->order[0]==ringorder_C))
5319      {
5320        strat->posInL = posInL17_c;
5321        strat->posInT = posInT17_c;
5322      }
5323      else
5324      {
5325        strat->posInL = posInL17;
5326        strat->posInT = posInT17;
5327      }
5328    }
5329  }
5330  if (strat->minim>0) strat->posInL =posInLSpecial;
5331  // for further tests only
5332  if ((BTEST1(11)) || (BTEST1(12)))
5333    strat->posInL = posInL11;
5334  else if ((BTEST1(13)) || (BTEST1(14)))
5335    strat->posInL = posInL13;
5336  else if ((BTEST1(15)) || (BTEST1(16)))
5337    strat->posInL = posInL15;
5338  else if ((BTEST1(17)) || (BTEST1(18)))
5339    strat->posInL = posInL17;
5340  if (BTEST1(11))
5341    strat->posInT = posInT11;
5342  else if (BTEST1(13))
5343    strat->posInT = posInT13;
5344  else if (BTEST1(15))
5345    strat->posInT = posInT15;
5346  else if ((BTEST1(17)))
5347    strat->posInT = posInT17;
5348  else if ((BTEST1(19)))
5349    strat->posInT = posInT19;
5350  else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
5351    strat->posInT = posInT1;
5352#ifdef HAVE_RINGS
5353  if (rField_is_Ring(currRing))
5354  {
5355    strat->posInL = posInL11;
5356    strat->posInT = posInT11;
5357  }
5358#endif
5359  strat->posInLDependsOnLength = kPosInLDependsOnLength(strat->posInL);
5360}
5361
5362void initBuchMora (ideal F,ideal Q,kStrategy strat)
5363{
5364  strat->interpt = BTEST1(OPT_INTERRUPT);
5365  strat->kHEdge=NULL;
5366  if (pOrdSgn==1) strat->kHEdgeFound=FALSE;
5367  /*- creating temp data structures------------------- -*/
5368  strat->cp = 0;
5369  strat->c3 = 0;
5370  strat->tail = pInit();
5371  /*- set s -*/
5372  strat->sl = -1;
5373  /*- set L -*/
5374  strat->Lmax = setmaxL;
5375  strat->Ll = -1;
5376  strat->L = initL();
5377  /*- set B -*/
5378  strat->Bmax = setmaxL;
5379  strat->Bl = -1;
5380  strat->B = initL();
5381  /*- set T -*/
5382  strat->tl = -1;
5383  strat->tmax = setmaxT;
5384  strat->T = initT();
5385  strat->R = initR();
5386  strat->sevT = initsevT();
5387  /*- init local data struct.---------------------------------------- -*/
5388  strat->P.ecart=0;
5389  strat->P.length=0;
5390  if (pOrdSgn==-1)
5391  {
5392    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
5393    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
5394  }
5395  if(TEST_OPT_SB_1)
5396  {
5397    int i;
5398    ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
5399    for (i=strat->newIdeal;i<IDELEMS(F);i++)
5400    {
5401      P->m[i-strat->newIdeal] = F->m[i];
5402      F->m[i] = NULL;
5403    }
5404    initSSpecial(F,Q,P,strat);
5405    for (i=strat->newIdeal;i<IDELEMS(F);i++)
5406    {
5407      F->m[i] = P->m[i-strat->newIdeal];
5408      P->m[i-strat->newIdeal] = NULL;
5409    }
5410    idDelete(&P);
5411  }
5412  else
5413  {
5414    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
5415    // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
5416  }
5417  strat->kIdeal = NULL;
5418  strat->fromT = FALSE;
5419  strat->noTailReduction = !TEST_OPT_REDTAIL;
5420  if (!TEST_OPT_SB_1)
5421  {
5422    updateS(TRUE,strat);
5423  }
5424  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
5425  strat->fromQ=NULL;
5426}
5427
5428void exitBuchMora (kStrategy strat)
5429{
5430  /*- release temp data -*/
5431  cleanT(strat);
5432  omFreeSize(strat->T,(strat->tmax)*sizeof(TObject));
5433  omFreeSize(strat->R,(strat->tmax)*sizeof(TObject*));
5434  omFreeSize(strat->sevT, (strat->tmax)*sizeof(unsigned long));
5435  omFreeSize(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
5436  omFreeSize(strat->sevS,IDELEMS(strat->Shdl)*sizeof(int));
5437  omFreeSize(strat->S_2_R,IDELEMS(strat->Shdl)*sizeof(int));
5438  /*- set L: should be empty -*/
5439  omFreeSize(strat->L,(strat->Lmax)*sizeof(LObject));
5440  /*- set B: should be empty -*/
5441  omFreeSize(strat->B,(strat->Bmax)*sizeof(LObject));
5442  pDeleteLm(&strat->tail);
5443  strat->syzComp=0;
5444  if (strat->kIdeal!=NULL)
5445  {
5446    omFreeBin(strat->kIdeal, sleftv_bin);
5447    strat->kIdeal=NULL;
5448  }
5449}
5450
5451/*2
5452* in the case of a standardbase of a module over a qring:
5453* replace polynomials in i by ak vectors,
5454* (the polynomial * unit vectors gen(1)..gen(ak)
5455* in every case (also for ideals:)
5456* deletes divisible vectors/polynomials
5457*/
5458void updateResult(ideal r,ideal Q, kStrategy strat)
5459{
5460  int l;
5461  if (strat->ak>0)
5462  {
5463    for (l=IDELEMS(r)-1;l>=0;l--)
5464    {
5465      if ((r->m[l]!=NULL) && (pGetComp(r->m[l])==0))
5466      {
5467        pDelete(&r->m[l]); // and set it to NULL
5468      }
5469    }
5470    int q;
5471    poly p;
5472    for (l=IDELEMS(r)-1;l>=0;l--)
5473    {
5474      if ((r->m[l]!=NULL)
5475      && (strat->syzComp>0)
5476      && (pGetComp(r->m[l])<=strat->syzComp))
5477      {
5478        for(q=IDELEMS(Q)-1; q>=0;q--)
5479        {
5480          if ((Q->m[q]!=NULL)
5481          &&(pLmDivisibleBy(Q->m[q],r->m[l])))
5482          {
5483            if (TEST_OPT_REDSB)
5484            {
5485              p=r->m[l];
5486              r->m[l]=kNF(Q,NULL,p);
5487              pDelete(&p);
5488            }
5489            else
5490            {
5491              pDelete(&r->m[l]); // and set it to NULL
5492            }
5493            break;
5494          }
5495        }
5496      }
5497    }
5498  }
5499  else
5500  {
5501    int q;
5502    poly p;
5503    for (l=IDELEMS(r)-1;l>=0;l--)
5504    {
5505      if (r->m[l]!=NULL)
5506      {
5507        for(q=IDELEMS(Q)-1; q>=0;q--)
5508        {
5509          if ((Q->m[q]!=NULL)
5510          &&(pLmEqual(r->m[l],Q->m[q])))
5511          {
5512            if (TEST_OPT_REDSB)
5513            {
5514              p=r->m[l];
5515              r->m[l]=kNF(Q,NULL,p);
5516              pDelete(&p);
5517            }
5518            else
5519            {
5520              pDelete(&r->m[l]); // and set it to NULL
5521            }
5522            break;
5523          }
5524        }
5525      }
5526    }
5527  }
5528  idSkipZeroes(r);
5529}
5530
5531void completeReduce (kStrategy strat)
5532{
5533  int i;
5534  int low = (pOrdSgn == 1 ? 1 : 0);
5535  LObject L;
5536
5537#ifdef KDEBUG
5538  // need to set this: during tailreductions of T[i], T[i].max is out of
5539  // sync
5540  sloppy_max = TRUE;
5541#endif
5542
5543  strat->noTailReduction = FALSE;
5544  if (TEST_OPT_PROT)
5545  {
5546    PrintLn();
5547    if (timerv) writeTime("standard base computed:");
5548  }
5549  if (TEST_OPT_PROT)
5550  {
5551    Print("(S:%d)",strat->sl);mflush();
5552  }
5553  for (i=strat->sl; i>=low; i--)
5554  {
5555    TObject* T_j = strat->s_2_t(i);
5556    if (T_j != NULL)
5557    {
5558      L = *T_j;
5559      poly p;
5560      if (pOrdSgn == 1)
5561        strat->S[i] = redtailBba(&L, i-1, strat, FALSE);
5562      else
5563        strat->S[i] = redtail(&L, strat->sl, strat);
5564
5565      if (strat->redTailChange && strat->tailRing != currRing)
5566      {
5567        if (T_j->max != NULL) p_LmFree(T_j->max, strat->tailRing);
5568        if (pNext(T_j->p) != NULL)
5569          T_j->max = p_GetMaxExpP(pNext(T_j->p), strat->tailRing);
5570        else
5571          T_j->max = NULL;
5572      }
5573      if (TEST_OPT_INTSTRATEGY)
5574        T_j->pCleardenom();
5575    }
5576    else
5577    {
5578      assume(currRing == strat->tailRing);
5579      if (pOrdSgn == 1)
5580        strat->S[i] = redtailBba(strat->S[i], i-1, strat);
5581      else
5582        strat->S[i] = redtail(strat->S[i], strat->sl, strat);
5583      if (TEST_OPT_INTSTRATEGY)
5584        pCleardenom(strat->S[i]);
5585    }
5586    if (TEST_OPT_PROT)
5587      PrintS("-");
5588  }
5589  if (TEST_OPT_PROT) PrintLn();
5590#ifdef KDEBUG
5591  sloppy_max = FALSE;
5592#endif
5593}
5594
5595
5596/*2
5597* computes the new strat->kHEdge and the new pNoether,
5598* returns TRUE, if pNoether has changed
5599*/
5600BOOLEAN newHEdge(polyset S, kStrategy strat)
5601{
5602  int i,j;
5603  poly newNoether;
5604
5605#if 0
5606  if (currRing->weight_all_1)
5607    scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
5608  else
5609    scComputeHCw(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
5610#else   
5611  scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
5612#endif 
5613  if (strat->t_kHEdge != NULL) p_LmFree(strat->t_kHEdge, strat->tailRing);
5614  if (strat->tailRing != currRing)
5615    strat->t_kHEdge = k_LmInit_currRing_2_tailRing(strat->kHEdge, strat->tailRing);
5616  /* compare old and new noether*/
5617  newNoether = pLmInit(strat->kHEdge);
5618  j = pFDeg(newNoether,currRing);
5619  for (i=1; i<=pVariables; i++)
5620  {
5621    if (pGetExp(newNoether, i) > 0) pDecrExp(newNoether,i);
5622  }
5623  pSetm(newNoether);
5624  if (j < strat->HCord) /*- statistics -*/
5625  {
5626    if (TEST_OPT_PROT)
5627    {
5628      Print("H(%d)",j);
5629      mflush();
5630    }
5631    strat->HCord=j;
5632    #ifdef KDEBUG
5633    if (TEST_OPT_DEBUG)
5634    {
5635      Print("H(%d):",j);
5636      wrp(strat->kHEdge);
5637      PrintLn();
5638    }
5639    #endif
5640  }
5641  if (pCmp(strat->kNoether,newNoether)!=1)
5642  {
5643    pDelete(&strat->kNoether);
5644    strat->kNoether=newNoether;
5645    if (strat->t_kNoether != NULL) p_LmFree(strat->t_kNoether, strat->tailRing);
5646    if (strat->tailRing != currRing)
5647      strat->t_kNoether = k_LmInit_currRing_2_tailRing(strat->kNoether, strat->tailRing);
5648
5649    return TRUE;
5650  }
5651  pLmFree(newNoether);
5652  return FALSE;
5653}
5654
5655/***************************************************************
5656 *
5657 * Routines related for ring changes during std computations
5658 *
5659 ***************************************************************/
5660BOOLEAN kCheckSpolyCreation(LObject *L, kStrategy strat, poly &m1, poly &m2)
5661{
5662  assume(L->p1 != NULL && L->p2 != NULL);
5663  assume(L->i_r1 >= 0 && L->i_r1 <= strat->tl);
5664  assume(L->i_r2 >= 0 && L->i_r2 <= strat->tl);
5665  assume(strat->tailRing != currRing);
5666
5667  if (! k_GetLeadTerms(L->p1, L->p2, currRing, m1, m2, strat->tailRing))
5668    return FALSE;
5669  poly p1_max = (strat->R[L->i_r1])->max;
5670  poly p2_max = (strat->R[L->i_r2])->max;
5671
5672  if ((p1_max != NULL && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
5673      (p2_max != NULL && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
5674  {
5675    p_LmFree(m1, strat->tailRing);
5676    p_LmFree(m2, strat->tailRing);
5677    m1 = NULL;
5678    m2 = NULL;
5679    return FALSE;
5680  }
5681  return TRUE;
5682}
5683
5684BOOLEAN kStratChangeTailRing(kStrategy strat, LObject *L, TObject* T, unsigned long expbound)
5685{
5686  if (expbound == 0) expbound = strat->tailRing->bitmask << 1;
5687  if (expbound >= currRing->bitmask) return FALSE;
5688  ring new_tailRing = rModifyRing(currRing,
5689                                  // Hmmm .. the condition pFDeg == pDeg
5690                                  // might be too strong
5691#ifdef HAVE_RINGS
5692                                  (strat->homog && pFDeg == pDeg && !(rField_is_Ring(currRing))), // TODO Oliver
5693#else
5694                                  (strat->homog && pFDeg == pDeg),
5695#endif
5696                                  !strat->ak,
5697                                  expbound);
5698  if (new_tailRing == currRing) return TRUE;
5699
5700  strat->pOrigFDeg_TailRing = new_tailRing->pFDeg;
5701  strat->pOrigLDeg_TailRing = new_tailRing->pLDeg;
5702
5703  if (currRing->pFDeg != currRing->pFDegOrig)
5704  {
5705    new_tailRing->pFDeg = currRing->pFDeg;
5706    new_tailRing->pLDeg = currRing->pLDeg;
5707  }
5708
5709  if (TEST_OPT_PROT)
5710    Print("[%lu:%d", (unsigned long) new_tailRing->bitmask, new_tailRing->ExpL_Size);
5711  kTest_TS(strat);
5712  assume(new_tailRing != strat->tailRing);
5713  pShallowCopyDeleteProc p_shallow_copy_delete
5714    = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
5715
5716  omBin new_tailBin = omGetStickyBinOfBin(new_tailRing->PolyBin);
5717
5718  int i;
5719  for (i=0; i<=strat->tl; i++)
5720  {
5721    strat->T[i].ShallowCopyDelete(new_tailRing, new_tailBin,
5722                                  p_shallow_copy_delete);
5723  }
5724  for (i=0; i<=strat->Ll; i++)
5725  {
5726    assume(strat->L[i].p != NULL);
5727    if (pNext(strat->L[i].p) != strat->tail)
5728      strat->L[i].ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
5729  }
5730  if (strat->P.t_p != NULL ||
5731      (strat->P.p != NULL && pNext(strat->P.p) != strat->tail))
5732    strat->P.ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
5733
5734  if (L != NULL && L->tailRing != new_tailRing)
5735  {
5736    if (L->i_r < 0)
5737      L->ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
5738    else
5739    {
5740      assume(L->i_r <= strat->tl);
5741      TObject* t_l = strat->R[L->i_r];
5742      assume(t_l != NULL);
5743      L->tailRing = new_tailRing;
5744      L->p = t_l->p;
5745      L->t_p = t_l->t_p;
5746      L->max = t_l->max;
5747    }
5748  }
5749
5750  if (T != NULL && T->tailRing != new_tailRing && T->i_r < 0)
5751    T->ShallowCopyDelete(new_tailRing, new_tailBin, p_shallow_copy_delete);
5752
5753  omMergeStickyBinIntoBin(strat->tailBin, strat->tailRing->PolyBin);
5754  if (strat->tailRing != currRing)
5755    rKillModifiedRing(strat->tailRing);
5756
5757  strat->tailRing = new_tailRing;
5758  strat->tailBin = new_tailBin;
5759  strat->p_shallow_copy_delete
5760    = pGetShallowCopyDeleteProc(currRing, new_tailRing);
5761
5762  if (strat->kHEdge != NULL)
5763  {
5764    if (strat->t_kHEdge != NULL)
5765      p_LmFree(strat->t_kHEdge, strat->tailRing);
5766    strat->t_kHEdge=k_LmInit_currRing_2_tailRing(strat->kHEdge, new_tailRing);
5767  }
5768
5769  if (strat->kNoether != NULL)
5770  {
5771    if (strat->t_kNoether != NULL)
5772      p_LmFree(strat->t_kNoether, strat->tailRing);
5773    strat->t_kNoether=k_LmInit_currRing_2_tailRing(strat->kNoether,
5774                                                   new_tailRing);
5775  }
5776  kTest_TS(strat);
5777  if (TEST_OPT_PROT)
5778    PrintS("]");
5779  return TRUE;
5780}
5781
5782void kStratInitChangeTailRing(kStrategy strat)
5783{
5784  unsigned long l = 0;
5785  int i;
5786  Exponent_t e;
5787  ring new_tailRing;
5788
5789  assume(strat->tailRing == currRing);
5790
5791  for (i=0; i<= strat->Ll; i++)
5792  {
5793    l = p_GetMaxExpL(strat->L[i].p, currRing, l);
5794  }
5795  for (i=0; i<=strat->tl; i++)
5796  {
5797    // Hmm ... this we could do in one Step
5798    l = p_GetMaxExpL(strat->T[i].p, currRing, l);
5799  }
5800  e = p_GetMaxExp(l, currRing);
5801  if (e <= 1) e = 2;
5802
5803  kStratChangeTailRing(strat, NULL, NULL, e);
5804}
5805
5806skStrategy::skStrategy()
5807{
5808  memset(this, 0, sizeof(skStrategy));
5809#ifndef NDEBUG
5810  strat_nr++;
5811  nr=strat_nr;
5812  if (strat_fac_debug) Print("s(%d) created\n",nr);
5813#endif
5814  tailRing = currRing;
5815  P.tailRing = currRing;
5816  tl = -1;
5817  sl = -1;
5818#ifdef HAVE_LM_BIN
5819  lmBin = omGetStickyBinOfBin(currRing->PolyBin);
5820#endif
5821#ifdef HAVE_TAIL_BIN
5822  tailBin = omGetStickyBinOfBin(currRing->PolyBin);
5823#endif
5824  pOrigFDeg = pFDeg;
5825  pOrigLDeg = pLDeg;
5826}
5827
5828
5829skStrategy::~skStrategy()
5830{
5831  if (lmBin != NULL)
5832    omMergeStickyBinIntoBin(lmBin, currRing->PolyBin);
5833  if (tailBin != NULL)
5834    omMergeStickyBinIntoBin(tailBin,
5835                            (tailRing != NULL ? tailRing->PolyBin:
5836                             currRing->PolyBin));
5837  if (t_kHEdge != NULL)
5838    p_LmFree(t_kHEdge, tailRing);
5839  if (t_kNoether != NULL)
5840    p_LmFree(t_kNoether, tailRing);
5841
5842  if (currRing != tailRing)
5843    rKillModifiedRing(tailRing);
5844  pRestoreDegProcs(pOrigFDeg, pOrigLDeg);
5845}
5846
5847#if 0
5848Timings for the different possibilities of posInT:
5849            T15           EDL         DL          EL            L         1-2-3
5850Gonnet      43.26       42.30       38.34       41.98       38.40      100.04
5851Hairer_2_1   1.11        1.15        1.04        1.22        1.08        4.7
5852Twomat3      1.62        1.69        1.70        1.65        1.54       11.32
5853ahml         4.48        4.03        4.03        4.38        4.96       26.50
5854c7          15.02       13.98       15.16       13.24       17.31       47.89
5855c8         505.09      407.46      852.76      413.21      499.19        n/a
5856f855        12.65        9.27       14.97        8.78       14.23       33.12
5857gametwo6    11.47       11.35       14.57       11.20       12.02       35.07
5858gerhard_3    2.73        2.83        2.93        2.64        3.12        6.24
5859ilias13     22.89       22.46       24.62       20.60       23.34       53.86
5860noon8       40.68       37.02       37.99       36.82       35.59      877.16
5861rcyclic_19  48.22       42.29       43.99       45.35       51.51      204.29
5862rkat9       82.37       79.46       77.20       77.63       82.54      267.92
5863schwarz_11  16.46       16.81       16.76       16.81       16.72       35.56
5864test016     16.39       14.17       14.40       13.50       14.26       34.07
5865test017     34.70       36.01       33.16       35.48       32.75       71.45
5866test042     10.76       10.99       10.27       11.57       10.45       23.04
5867test058      6.78        6.75        6.51        6.95        6.22        9.47
5868test066     10.71       10.94       10.76       10.61       10.56       19.06
5869test073     10.75       11.11       10.17       10.79        8.63       58.10
5870test086     12.23       11.81       12.88       12.24       13.37       66.68
5871test103      5.05        4.80        5.47        4.64        4.89       11.90
5872test154     12.96       11.64       13.51       12.46       14.61       36.35
5873test162     65.27       64.01       67.35       59.79       67.54      196.46
5874test164      7.50        6.50        7.68        6.70        7.96       17.13
5875virasoro     3.39        3.50        3.35        3.47        3.70        7.66
5876#endif
5877
5878
5879#ifdef HAVE_MORE_POS_IN_T
5880// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
5881int posInT_EcartFDegpLength(const TSet set,const int length,LObject &p)
5882{
5883
5884  if (length==-1) return 0;
5885
5886  int o = p.ecart;
5887  int op=p.GetpFDeg();
5888  int ol = p.GetpLength();
5889
5890  if (set[length].ecart < o)
5891    return length+1;
5892  if (set[length].ecart == o)
5893  {
5894     int oo=set[length].GetpFDeg();
5895     if ((oo < op) || ((oo==op) && (set[length].length < ol)))
5896       return length+1;
5897  }
5898
5899  int i;
5900  int an = 0;
5901  int en= length;
5902  loop
5903  {
5904    if (an >= en-1)
5905    {
5906      if (set[an].ecart > o)
5907        return an;
5908      if (set[an].ecart == o)
5909      {
5910         int oo=set[an].GetpFDeg();
5911         if((oo > op)
5912         || ((oo==op) && (set[an].pLength > ol)))
5913           return an;
5914      }
5915      return en;
5916    }
5917    i=(an+en) / 2;
5918    if (set[i].ecart > o)
5919      en=i;
5920    else if (set[i].ecart == o)
5921    {
5922       int oo=set[i].GetpFDeg();
5923       if ((oo > op)
5924       || ((oo == op) && (set[i].pLength > ol)))
5925         en=i;
5926       else
5927        an=i;
5928    }
5929    else
5930      an=i;
5931  }
5932}
5933
5934// determines the position based on: 1.) FDeg 2.) pLength
5935int posInT_FDegpLength(const TSet set,const int length,LObject &p)
5936{
5937
5938  if (length==-1) return 0;
5939
5940  int op=p.GetpFDeg();
5941  int ol = p.GetpLength();
5942
5943  int oo=set[length].GetpFDeg();
5944  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
5945    return length+1;
5946
5947  int i;
5948  int an = 0;
5949  int en= length;
5950  loop
5951    {
5952      if (an >= en-1)
5953      {
5954        int oo=set[an].GetpFDeg();
5955        if((oo > op)
5956           || ((oo==op) && (set[an].pLength > ol)))
5957          return an;
5958        return en;
5959      }
5960      i=(an+en) / 2;
5961      int oo=set[i].GetpFDeg();
5962      if ((oo > op)
5963          || ((oo == op) && (set[i].pLength > ol)))
5964        en=i;
5965      else
5966        an=i;
5967    }
5968}
5969
5970
5971// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
5972int posInT_pLength(const TSet set,const int length,LObject &p)
5973{
5974  if (length==-1)
5975    return 0;
5976  if (set[length].length<p.length)
5977    return length+1;
5978
5979  int i;
5980  int an = 0;
5981  int en= length;
5982  int ol = p.GetpLength();
5983
5984  loop
5985  {
5986    if (an >= en-1)
5987    {
5988      if (set[an].pLength>ol) return an;
5989      return en;
5990    }
5991    i=(an+en) / 2;
5992    if (set[i].pLength>ol) en=i;
5993    else                        an=i;
5994  }
5995}
5996#endif
5997
5998#ifdef HAVE_PLURAL
5999/* including the self pairs? */
6000
6001/*1
6002* put the pairs (s[i],sh \dot p)  into the set B, ecart=ecart(p)
6003*/
6004void enterOnePairManyShifts (int i, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int uptodeg, int lV)
6005{
6006  atR = -1;
6007  int j;
6008  int lb = pLastVblock(p,lV);
6009  poly q;
6010  for (j=0; j<= uptodeg - lb; j++)
6011  {
6012    q = pLPshift(p,j,uptodeg,lV);
6013    enterOnePairShift(i, q, ecart, isFromQ, strat, -1, uptodeg, lV);
6014  }
6015}
6016#endif
6017
6018#ifdef HAVE_PLURAL
6019/*2
6020* put the pair (s[i],p)  into the set B, ecart=ecart(p)
6021*/
6022void enterOnePairShift (int i, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int uptodeg, int lV)
6023{
6024
6025  /* need additionally: int up_to_degree, poly V0 with the variables in (0)  or just the number lV = the length of the first block */
6026  /* should cycle through all shifts of s[i] until up_to_degree - lastVblock(s[i]) */
6027  /* that is create the pairs (f, s \dot g) for deg(s\dot g)= */
6028  atR = -1;
6029  assume(i<=strat->sl);
6030  if (strat->interred_flag) return;
6031
6032  int      l,j,compare;
6033  LObject  Lp;
6034  Lp.i_r = -1;
6035
6036#ifdef KDEBUG
6037  Lp.ecart=0; Lp.length=0;
6038#endif
6039  /*- computes the lcm(s[i],p) -*/
6040  Lp.lcm = pInit();
6041
6042  pLcm(p,strat->S[i],Lp.lcm);
6043  pSetm(Lp.lcm);
6044
6045  /* apply the V criterion */
6046  if (!isInV(Lp.lcm, lV))
6047  {
6048    pLmFree(Lp.lcm);
6049    Lp.lcm=NULL;
6050    return;
6051    /* + add the counter for applying the V criterion */
6052  }
6053
6054
6055  const BOOLEAN bIsPluralRing = rIsPluralRing(currRing);
6056  const BOOLEAN bIsSCA        = rIsSCA(currRing) && strat->homog; // for prod-crit
6057  const BOOLEAN bNCProdCrit   = ( !bIsPluralRing || bIsSCA ); // commutative or homogeneous SCA
6058
6059  if (strat->sugarCrit && bNCProdCrit)
6060  {
6061    if((!((strat->ecartS[i]>0)&&(ecart>0)))
6062    && pHasNotCF(p,strat->S[i]))
6063    {
6064    /*
6065    *the product criterion has applied for (s,p),
6066    *i.e. lcm(s,p)=product of the leading terms of s and p.
6067    *Suppose (s,r) is in L and the leading term
6068    *of p divides lcm(s,r)
6069    *(==> the leading term of p divides the leading term of r)
6070    *but the leading term of s does not divide the leading term of r
6071    *(notice that this condition is automatically satisfied if r is still
6072    *in S), then (s,r) can be cancelled.
6073    *This should be done here because the
6074    *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
6075    *
6076    *Moreover, skipping (s,r) holds also for the noncommutative case.
6077    */
6078      strat->cp++;
6079      pLmFree(Lp.lcm);
6080      Lp.lcm=NULL;
6081      return;
6082    }
6083    else
6084      Lp.ecart = si_max(ecart,strat->ecartS[i]);
6085    if (strat->fromT && (strat->ecartS[i]>ecart))
6086    {
6087      pLmFree(Lp.lcm);
6088      Lp.lcm=NULL;
6089      return;
6090      /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
6091    }
6092    /*
6093    *the set B collects the pairs of type (S[j],p)
6094    *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
6095    *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
6096    *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
6097    */
6098    {
6099      j = strat->Bl;
6100      loop
6101      {
6102        if (j < 0)  break;
6103        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
6104        if ((compare==1)
6105        &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
6106        {
6107          strat->c3++;
6108          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
6109          {
6110            pLmFree(Lp.lcm);
6111            return;
6112          }
6113          break;
6114        }
6115        else
6116        if ((compare ==-1)
6117        && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
6118        {
6119          deleteInL(strat->B,&strat->Bl,j,strat);
6120          strat->c3++;
6121        }
6122        j--;
6123      }
6124    }
6125  }
6126  else /*sugarcrit*/
6127  {
6128    if (bNCProdCrit)
6129    {
6130      // if currRing->nc_type!=quasi (or skew)
6131      // TODO: enable productCrit for super commutative algebras...
6132      if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
6133      pHasNotCF(p,strat->S[i]))
6134      {
6135      /*
6136      *the product criterion has applied for (s,p),
6137      *i.e. lcm(s,p)=product of the leading terms of s and p.
6138      *Suppose (s,r) is in L and the leading term
6139      *of p devides lcm(s,r)
6140      *(==> the leading term of p devides the leading term of r)
6141      *but the leading term of s does not devide the leading term of r
6142      *(notice that tis condition is automatically satisfied if r is still
6143      *in S), then (s,r) can be canceled.
6144      *This should be done here because the
6145      *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
6146      */
6147          strat->cp++;
6148          pLmFree(Lp.lcm);
6149          Lp.lcm=NULL;
6150          return;
6151      }
6152      if (strat->fromT && (strat->ecartS[i]>ecart))
6153      {
6154        pLmFree(Lp.lcm);
6155        Lp.lcm=NULL;
6156        return;
6157        /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
6158      }
6159      /*
6160      *the set B collects the pairs of type (S[j],p)
6161      *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
6162      *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
6163      *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
6164      */
6165      for(j = strat->Bl;j>=0;j--)
6166      {
6167        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
6168        if (compare==1)
6169        {
6170          strat->c3++;
6171          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
6172          {
6173            pLmFree(Lp.lcm);
6174            return;
6175          }
6176          break;
6177        }
6178        else
6179        if (compare ==-1)
6180        {
6181          deleteInL(strat->B,&strat->Bl,j,strat);
6182          strat->c3++;
6183        }
6184      }
6185    }
6186  }
6187  /*
6188  *the pair (S[i],p) enters B if the spoly != 0
6189  */
6190  /*-  compute the short s-polynomial -*/
6191  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
6192    pNorm(p);
6193  if ((strat->S[i]==NULL) || (p==NULL))
6194    return;
6195  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
6196    Lp.p=NULL;
6197  else
6198  {
6199    if ( bIsPluralRing )
6200    {
6201      if(pHasNotCF(p, strat->S[i]))
6202      {
6203        if(ncRingType(currRing) == nc_lie)
6204        {
6205            // generalized prod-crit for lie-type
6206            strat->cp++;
6207            Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i]);
6208        }
6209        else
6210        if( bIsSCA )
6211        {
6212            // product criterion for homogeneous case in SCA
6213            strat->cp++;
6214            Lp.p = NULL;
6215        }
6216        else
6217          Lp.p = nc_CreateSpoly(strat->S[i],p,currRing); // ?
6218      }
6219      else  Lp.p = nc_CreateSpoly(strat->S[i],p,currRing);
6220    }
6221    else
6222    {
6223      Lp.p = ksCreateShortSpoly(strat->S[i],p, strat->tailRing);
6224    }
6225  }
6226  if (Lp.p == NULL)
6227  {
6228    /*- the case that the s-poly is 0 -*/
6229    if (strat->pairtest==NULL) initPairtest(strat);
6230    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
6231    strat->pairtest[strat->sl+1] = TRUE;
6232    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
6233    /*
6234    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
6235    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
6236    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
6237    *term of p devides the lcm(s,r)
6238    *(this canceling should be done here because
6239    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
6240    *the first case is handeled in chainCrit
6241    */
6242    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
6243  }
6244  else
6245  {
6246    /*- the pair (S[i],p) enters B -*/
6247    Lp.p1 = strat->S[i];
6248    Lp.p2 = p;
6249
6250    if ( !bIsPluralRing )
6251      pNext(Lp.p) = strat->tail;
6252
6253    if (atR >= 0)
6254    {
6255      Lp.i_r1 = strat->S_2_R[i];
6256      Lp.i_r2 = atR;
6257    }
6258    else
6259    {
6260      Lp.i_r1 = -1;
6261      Lp.i_r2 = -1;
6262    }
6263    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
6264
6265    if (TEST_OPT_INTSTRATEGY)
6266    {
6267      if (!bIsPluralRing)
6268        nDelete(&(Lp.p->coef));
6269    }
6270
6271    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
6272    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
6273  }
6274}
6275#endif
6276
6277#ifdef HAVE_PLURAL
6278/*3
6279*(s[0],h),...,(s[k],h) will be put to the pairset L
6280* additionally we put the pairs (h, s \sdot h) for s>=1 to L
6281*/
6282void initenterpairsShift (poly h,int k,int ecart,int isFromQ, kStrategy strat, int atR)
6283{
6284  atR = -1;
6285  if ((strat->syzComp==0)
6286  || (pGetComp(h)<=strat->syzComp))
6287  {
6288    int j;
6289    BOOLEAN new_pair=FALSE;
6290
6291    if (pGetComp(h)==0)
6292    {
6293      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
6294      if ((isFromQ)&&(strat->fromQ!=NULL))
6295      {
6296        for (j=0; j<=k; j++)
6297        {
6298          if (!strat->fromQ[j])
6299          {
6300            new_pair=TRUE;
6301            enterOnePair(j,h,ecart,isFromQ,strat, atR);
6302          //Print("j:%d, Ll:%d\n",j,strat->Ll);
6303          }
6304        }
6305      }
6306      else
6307      {
6308        new_pair=TRUE;
6309        for (j=0; j<=k; j++)
6310        {
6311          enterOnePair(j,h,ecart,isFromQ,strat, atR);
6312        }
6313        /* HERE we put (h, s*h) pairs */
6314      }
6315    }
6316    else
6317    {
6318      for (j=0; j<=k; j++)
6319      {
6320        if ((pGetComp(h)==pGetComp(strat->S[j]))
6321        || (pGetComp(strat->S[j])==0))
6322        {
6323          new_pair=TRUE;
6324          enterOnePair(j,h,ecart,isFromQ,strat, atR);
6325        //Print("j:%d, Ll:%d\n",j,strat->Ll);
6326        }
6327      }
6328      /* HERE we put (h, s*h) pairs TOO */
6329    }
6330
6331    if (new_pair) chainCrit(h,ecart,strat);
6332
6333  }
6334}
6335#endif
6336
6337#ifdef HAVE_PLURAL
6338/*2
6339*reduces h with elements from T choosing  the first possible
6340* element in t with respect to the given pDivisibleBy
6341*/
6342int redFirstShift (LObject* h,kStrategy strat)
6343{
6344  int at,reddeg,d,i;
6345  int pass = 0;
6346  int j = 0;
6347
6348  d = pFDeg((*h).p,currRing)+(*h).ecart;
6349  reddeg = strat->LazyDegree+d;
6350  loop
6351  {
6352    if (j > strat->sl)
6353    {
6354      #ifdef KDEBUG
6355      if (TEST_OPT_DEBUG) PrintLn();
6356      #endif
6357      return 0;
6358    }
6359    #ifdef KDEBUG
6360    if (TEST_OPT_DEBUG) Print("%d",j);
6361    #endif
6362    if (pDivisibleBy(strat->S[j],(*h).p))
6363    {
6364      #ifdef KDEBUG
6365      if (TEST_OPT_DEBUG) PrintS("+\n");
6366      #endif
6367      /*
6368      * the polynomial to reduce with is;
6369      * T[j].p
6370      */
6371      if (!TEST_OPT_INTSTRATEGY)
6372        pNorm(strat->S[j]);
6373      #ifdef KDEBUG
6374      if (TEST_OPT_DEBUG)
6375      {
6376        wrp(h->p);
6377        PrintS(" with ");
6378        wrp(strat->S[j]);
6379      }
6380      #endif
6381      (*h).p = nc_ReduceSpoly(strat->S[j],(*h).p, currRing);
6382      //spSpolyRed(strat->T[j].p,(*h).p,strat->kNoether);
6383
6384      #ifdef KDEBUG
6385      if (TEST_OPT_DEBUG)
6386      {
6387        PrintS(" to ");
6388        wrp(h->p);
6389      }
6390      #endif
6391      if ((*h).p == NULL)
6392      {
6393        if (h->lcm!=NULL) p_LmFree((*h).lcm, currRing);
6394        return 0;
6395      }
6396      if (TEST_OPT_INTSTRATEGY)
6397      {
6398        if (rField_is_Zp_a()) pContent(h->p);
6399        else pCleardenom(h->p);// also does a pContent
6400      }
6401      /*computes the ecart*/
6402      d = pLDeg((*h).p,&((*h).length),currRing);
6403      (*h).FDeg=pFDeg((*h).p,currRing);
6404      (*h).ecart = d-(*h).FDeg; /*pFDeg((*h).p);*/
6405      if ((strat->syzComp!=0) && !strat->honey)
6406      {
6407        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
6408        {
6409          #ifdef KDEBUG
6410          if (TEST_OPT_DEBUG) PrintS(" > sysComp\n");
6411          #endif
6412          return 0;
6413        }
6414      }
6415      /*- try to reduce the s-polynomial -*/
6416      pass++;
6417      /*
6418      *test whether the polynomial should go to the lazyset L
6419      *-if the degree jumps
6420      *-if the number of pre-defined reductions jumps
6421      */
6422      if ((strat->Ll >= 0)
6423      && ((d >= reddeg) || (pass > strat->LazyPass))
6424      && !strat->homog)
6425      {
6426        at = strat->posInL(strat->L,strat->Ll,h,strat);
6427        if (at <= strat->Ll)
6428        {
6429          i=strat->sl+1;
6430          do
6431          {
6432            i--;
6433            if (i<0) return 0;
6434          } while (!pDivisibleBy(strat->S[i],(*h).p));
6435          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
6436          #ifdef KDEBUG
6437          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
6438          #endif
6439          (*h).p = NULL;
6440          return 0;
6441        }
6442      }
6443      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
6444      {
6445        reddeg = d+1;
6446        Print(".%d",d);mflush();
6447      }
6448      j = 0;
6449      #ifdef KDEBUG
6450      if (TEST_OPT_DEBUG) PrintLn();
6451      #endif
6452    }
6453    else
6454    {
6455      #ifdef KDEBUG
6456      if (TEST_OPT_DEBUG) PrintS("-");
6457      #endif
6458      j++;
6459    }
6460  }
6461}
6462
6463
6464/*2
6465*  reduction procedure for the homogeneous case
6466*  and the case of a degree-ordering
6467*/
6468int redHomogShift (LObject* h,kStrategy strat)
6469{
6470  if (strat->tl<0) return 1;
6471  //if (h->GetLmTailRing()==NULL) return 0; // HS: SHOULD NOT BE NEEDED!
6472  assume(h->FDeg == h->pFDeg());
6473
6474  poly h_p;
6475  int i,j,at,pass, ii;
6476  unsigned long not_sev;
6477  long reddeg,d;
6478
6479  pass = j = 0;
6480  d = reddeg = h->GetpFDeg();
6481  h->SetShortExpVector();
6482  int li;
6483  h_p = h->GetLmTailRing();
6484  not_sev = ~ h->sev;
6485  loop
6486  {
6487    j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, h);
6488    if (j < 0) return 1;
6489
6490    li = strat->T[j].pLength;
6491    ii = j;
6492    /*
6493     * the polynomial to reduce with (up to the moment) is;
6494     * pi with length li
6495     */
6496    i = j;
6497#if 1
6498    if (TEST_OPT_LENGTH)
6499    loop
6500    {
6501      /*- search the shortest possible with respect to length -*/
6502      i++;
6503      if (i > strat->tl)
6504        break;
6505      if (li<=1)
6506        break;
6507      if ((strat->T[i].pLength < li)
6508         &&
6509          p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i],
6510                               h_p, not_sev, strat->tailRing))
6511      {
6512        /*
6513         * the polynomial to reduce with is now;
6514         */
6515        li = strat->T[i].pLength;
6516        ii = i;
6517      }
6518    }
6519#endif
6520
6521    /*
6522     * end of search: have to reduce with pi
6523     */
6524#ifdef KDEBUG
6525    if (TEST_OPT_DEBUG)
6526    {
6527      PrintS("red:");
6528      h->wrp();
6529      PrintS(" with ");
6530      strat->T[ii].wrp();
6531    }
6532#endif
6533    assume(strat->fromT == FALSE);
6534
6535    ksReducePoly(h, &(strat->T[ii]), NULL, NULL, strat);
6536
6537#ifdef KDEBUG
6538    if (TEST_OPT_DEBUG)
6539    {
6540      PrintS("\nto ");
6541      h->wrp();
6542      PrintLn();
6543    }
6544#endif
6545
6546    h_p = h->GetLmTailRing();
6547    if (h_p == NULL)
6548    {
6549      if (h->lcm!=NULL) pLmFree(h->lcm);
6550#ifdef KDEBUG
6551      h->lcm=NULL;
6552#endif
6553      return 0;
6554    }
6555    h->SetShortExpVector();
6556    not_sev = ~ h->sev;
6557    /*
6558     * try to reduce the s-polynomial h
6559     *test first whether h should go to the lazyset L
6560     *-if the degree jumps
6561     *-if the number of pre-defined reductions jumps
6562     */
6563    pass++;
6564    if (!K_TEST_OPT_REDTHROUGH && (strat->Ll >= 0) && (pass > strat->LazyPass))
6565    {
6566      h->SetLmCurrRing();
6567      at = strat->posInL(strat->L,strat->Ll,h,strat);
6568      if (at <= strat->Ll)
6569      {
6570        int dummy=strat->sl;
6571        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
6572          return 1;
6573        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
6574#ifdef KDEBUG
6575        if (TEST_OPT_DEBUG)
6576          Print(" lazy: -> L%d\n",at);
6577#endif
6578        h->Clear();
6579        return -1;
6580      }
6581    }
6582  }
6583}
6584#endif // HAVE_PLURAL
6585
6586#endif // KUTIL_CC
Note: See TracBrowser for help on using the repository browser.