source: git/kernel/GBEngine/kutil.cc @ a94825

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