source: git/kernel/kutil.cc @ fbc7cb

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