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

spielwiese
Last change on this file since eb55f8a was eb55f8a, checked in by Oleksandr Motsak <motsak@…>, 10 years ago
There should be no *Test in assume call (and no assume in *Test definition)
  • Property mode set to 100644
File size: 254.1 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT: kernel: utils for kStd
6*/
7
8// #define PDEBUG 2
9// #define PDIV_DEBUG
10#define KUTIL_CC
11
12#define MYTEST 0
13
14#include <kernel/mod2.h>
15
16#include <misc/mylimits.h>
17#include <misc/options.h>
18#include <polys/nc/nc.h>
19#include <polys/nc/sca.h>
20#include <polys/weight.h> /* for kDebugPrint: maxdegreeWecart*/
21
22#include <stdlib.h>
23#include <string.h>
24
25#ifdef KDEBUG
26#undef KDEBUG
27#define KDEBUG 2
28#endif
29
30#ifdef DEBUGF5
31#undef DEBUGF5
32//#define DEBUGF5 1
33#endif
34
35#ifdef HAVE_RINGS
36#include <kernel/ideals.h>
37#endif
38
39// define if enterL, enterT should use memmove instead of doing it manually
40// on topgun, this is slightly faster (see monodromy_l.tst, homog_gonnet.sing)
41#ifndef SunOS_4
42#define ENTER_USE_MEMMOVE
43#endif
44
45// define, if the my_memmove inlines should be used instead of
46// system memmove -- it does not seem to pay off, though
47// #define ENTER_USE_MYMEMMOVE
48
49#include <kernel/GBEngine/kutil.h>
50#include <polys/kbuckets.h>
51#include <omalloc/omalloc.h>
52#include <coeffs/numbers.h>
53#include <kernel/polys.h>
54#include <polys/monomials/ring.h>
55#include <kernel/ideals.h>
56//#include "cntrlc.h"
57#include <kernel/combinatorics/stairc.h>
58#include <kernel/GBEngine/kstd1.h>
59#include <polys/operations/pShallowCopyDelete.h>
60
61/* shiftgb stuff */
62#include <kernel/GBEngine/shiftgb.h>
63#include <polys/prCopy.h>
64
65#ifdef HAVE_RATGRING
66#include <kernel/GBEngine/ratgring.h>
67#endif
68
69#ifdef KDEBUG
70#undef KDEBUG
71#define KDEBUG 2
72#endif
73
74#ifdef DEBUGF5
75#undef DEBUGF5
76#define DEBUGF5 2
77#endif
78
79#define ADIDEBUG 0
80
81denominator_list DENOMINATOR_LIST=NULL;
82
83
84#ifdef ENTER_USE_MYMEMMOVE
85inline void _my_memmove_d_gt_s(unsigned long* d, unsigned long* s, long l)
86{
87  register unsigned long* _dl = (unsigned long*) d;
88  register unsigned long* _sl = (unsigned long*) s;
89  register long _i = l - 1;
90
91  do
92  {
93    _dl[_i] = _sl[_i];
94    _i--;
95  }
96  while (_i >= 0);
97}
98
99inline void _my_memmove_d_lt_s(unsigned long* d, unsigned long* s, long l)
100{
101  register long _ll = l;
102  register unsigned long* _dl = (unsigned long*) d;
103  register unsigned long* _sl = (unsigned long*) s;
104  register long _i = 0;
105
106  do
107  {
108    _dl[_i] = _sl[_i];
109    _i++;
110  }
111  while (_i < _ll);
112}
113
114inline void _my_memmove(void* d, void* s, long l)
115{
116  unsigned long _d = (unsigned long) d;
117  unsigned long _s = (unsigned long) s;
118  unsigned long _l = ((l) + SIZEOF_LONG - 1) >> LOG_SIZEOF_LONG;
119
120  if (_d > _s) _my_memmove_d_gt_s(_d, _s, _l);
121  else _my_memmove_d_lt_s(_d, _s, _l);
122}
123
124#undef memmove
125#define memmove(d,s,l) _my_memmove(d, s, l)
126#endif
127
128static poly redMora (poly h,int maxIndex,kStrategy strat);
129static poly redBba (poly h,int maxIndex,kStrategy strat);
130
131#ifdef HAVE_RINGS
132#define pDivComp_EQUAL 2
133#define pDivComp_LESS 1
134#define pDivComp_GREATER -1
135#define pDivComp_INCOMP 0
136/* Checks the relation of LM(p) and LM(q)
137     LM(p) = LM(q) => return pDivComp_EQUAL
138     LM(p) | LM(q) => return pDivComp_LESS
139     LM(q) | LM(p) => return pDivComp_GREATER
140     else return pDivComp_INCOMP */
141static inline int pDivCompRing(poly p, poly q)
142{
143  if (pGetComp(p) == pGetComp(q))
144  {
145    BOOLEAN a=FALSE, b=FALSE;
146    int i;
147    unsigned long la, lb;
148    unsigned long divmask = currRing->divmask;
149    for (i=0; i<currRing->VarL_Size; i++)
150    {
151      la = p->exp[currRing->VarL_Offset[i]];
152      lb = q->exp[currRing->VarL_Offset[i]];
153      if (la != lb)
154      {
155        if (la < lb)
156        {
157          if (b) return pDivComp_INCOMP;
158          if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
159            return pDivComp_INCOMP;
160          a = TRUE;
161        }
162        else
163        {
164          if (a) return pDivComp_INCOMP;
165          if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
166            return pDivComp_INCOMP;
167          b = TRUE;
168        }
169      }
170    }
171    if (a) return pDivComp_LESS;
172    if (b) return pDivComp_GREATER;
173    if (!a & !b) return pDivComp_EQUAL;
174  }
175  return pDivComp_INCOMP;
176}
177#endif
178
179static inline int pDivComp(poly p, poly q)
180{
181  if (pGetComp(p) == pGetComp(q))
182  {
183#ifdef HAVE_RATGRING
184    if (rIsRatGRing(currRing))
185    {
186      if (_p_LmDivisibleByPart(p,currRing,
187                           q,currRing,
188                           currRing->real_var_start, currRing->real_var_end))
189        return 0;
190      return pLmCmp(q,p); // ONLY FOR GLOBAL ORDER!
191    }
192#endif
193    BOOLEAN a=FALSE, b=FALSE;
194    int i;
195    unsigned long la, lb;
196    unsigned long divmask = currRing->divmask;
197    for (i=0; i<currRing->VarL_Size; i++)
198    {
199      la = p->exp[currRing->VarL_Offset[i]];
200      lb = q->exp[currRing->VarL_Offset[i]];
201      if (la != lb)
202      {
203        if (la < lb)
204        {
205          if (b) return 0;
206          if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
207            return 0;
208          a = TRUE;
209        }
210        else
211        {
212          if (a) return 0;
213          if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
214            return 0;
215          b = TRUE;
216        }
217      }
218    }
219    if (a) { /*assume(pLmCmp(q,p)==1);*/ return 1; }
220    if (b) { /*assume(pLmCmp(q,p)==-1);*/return -1; }
221    /*assume(pLmCmp(q,p)==0);*/
222  }
223  return 0;
224}
225
226
227int     HCord;
228int     Kstd1_deg;
229int     Kstd1_mu=32000;
230
231/*2
232*deletes higher monomial of p, re-compute ecart and length
233*works only for orderings with ecart =pFDeg(end)-pFDeg(start)
234*/
235void deleteHC(LObject *L, kStrategy strat, BOOLEAN fromNext)
236{
237  if (strat->kHEdgeFound)
238  {
239    kTest_L(L);
240    poly p1;
241    poly p = L->GetLmTailRing();
242    int l = 1;
243    kBucket_pt bucket = NULL;
244    if (L->bucket != NULL)
245    {
246      kBucketClear(L->bucket, &pNext(p), &L->pLength);
247      L->pLength++;
248      bucket = L->bucket;
249      L->bucket = NULL;
250    }
251
252    if (!fromNext && p_Cmp(p,strat->kNoetherTail(), L->tailRing) == -1)
253    {
254      L->Delete();
255      L->Clear();
256      L->ecart = -1;
257      if (bucket != NULL) kBucketDestroy(&bucket);
258      return;
259    }
260    p1 = p;
261    while (pNext(p1)!=NULL)
262    {
263    if (p_LmCmp(pNext(p1), strat->kNoetherTail(), L->tailRing) == -1)
264      {
265        p_Delete(&pNext(p1), L->tailRing);
266        if (p1 == p)
267        {
268          if (L->t_p != NULL)
269          {
270            assume(L->p != NULL && p == L->t_p);
271            pNext(L->p) = NULL;
272          }
273          L->max  = NULL;
274        }
275        else if (fromNext)
276          L->max  = p_GetMaxExpP(pNext(L->p), L->tailRing ); // p1;
277        //if (L->pLength != 0)
278        L->pLength = l;
279        // Hmmm when called from updateT, then only
280        // reset ecart when cut
281        if (fromNext)
282          L->ecart = L->pLDeg() - L->GetpFDeg();
283        break;
284      }
285      l++;
286      pIter(p1);
287    }
288    if (! fromNext)
289    {
290      L->SetpFDeg();
291      L->ecart = L->pLDeg(strat->LDegLast) - L->GetpFDeg();
292    }
293    if (bucket != NULL)
294    {
295      if (L->pLength > 1)
296      {
297        kBucketInit(bucket, pNext(p), L->pLength - 1);
298        pNext(p) = NULL;
299        if (L->t_p != NULL) pNext(L->t_p) = NULL;
300        L->pLength = 0;
301        L->bucket = bucket;
302      }
303      else
304        kBucketDestroy(&bucket);
305    }
306    kTest_L(L);
307  }
308}
309
310void deleteHC(poly* p, int* e, int* l,kStrategy strat)
311{
312  LObject L(*p, currRing, strat->tailRing);
313
314  deleteHC(&L, strat);
315  *p = L.p;
316  *e = L.ecart;
317  *l = L.length;
318  if (L.t_p != NULL) p_LmFree(L.t_p, strat->tailRing);
319}
320
321/*2
322*tests if p.p=monomial*unit and cancels the unit
323*/
324void cancelunit (LObject* L,BOOLEAN inNF)
325{
326  int  i;
327  poly h;
328  number lc;
329
330  if(rHasGlobalOrdering (currRing)) return;
331  if(TEST_OPT_CANCELUNIT) return;
332
333  ring r = L->tailRing;
334  poly p = L->GetLmTailRing();
335
336#ifdef HAVE_RINGS
337    if (rField_is_Ring(currRing) && (currRing->OrdSgn == -1))
338                  lc = p_GetCoeff(p,r);
339#endif
340
341#ifdef HAVE_RINGS_LOC
342  // Leading coef have to be a unit
343  if ( !(nIsUnit(p_GetCoeff(p, r))) ) return;
344#endif
345
346  if(p_GetComp(p, r) != 0 && !p_OneComp(p, r)) return;
347
348//    for(i=r->N;i>0;i--)
349//    {
350//      if ((p_GetExp(p,i,r)>0) && (rIsPolyVar(i, r)==TRUE)) return;
351//    }
352  h = pNext(p);
353
354  loop
355  {
356    if (h==NULL)
357    {
358      p_Delete(&pNext(p), r);
359      if (!inNF)
360      {
361             number eins;
362              #ifdef HAVE_RINGS
363              if (rField_is_Ring(currRing) && (currRing->OrdSgn == -1))
364                              eins = nCopy(lc);
365                    else
366                     #endif
367              eins=nInit(1);
368              if (L->p != NULL)  pSetCoeff(L->p,eins);
369        else if (L->t_p != NULL) nDelete(&pGetCoeff(L->t_p));
370        if (L->t_p != NULL) pSetCoeff0(L->t_p,eins);
371      }
372      L->ecart = 0;
373      L->length = 1;
374      //if (L->pLength > 0)
375      L->pLength = 1;
376      L->max = NULL;
377
378      if (L->t_p != NULL && pNext(L->t_p) != NULL)
379        pNext(L->t_p) = NULL;
380      if (L->p != NULL && pNext(L->p) != NULL)
381        pNext(L->p) = NULL;
382
383      return;
384    }
385    i = 0;
386    loop
387    {
388      i++;
389      if (p_GetExp(p,i,r) > p_GetExp(h,i,r)) return ; // does not divide
390      #ifdef HAVE_RINGS
391      // Note: As long as qring j forbidden if j contains integer (i.e. ground rings are
392      //       domains), no zerodivisor test needed  CAUTION
393      if (rField_is_Ring(currRing) && currRing->OrdSgn == -1)
394              if(n_DivBy(p_GetCoeff(h,r->cf),lc,r->cf) == 0)
395                      return;
396      #endif
397      if (i == r->N) break; // does divide, try next monom
398    }
399    pIter(h);
400  }
401}
402
403/*2
404*pp is the new element in s
405*returns TRUE (in strat->kHEdgeFound) if
406*-HEcke is allowed
407*-we are in the last componente of the vector
408*-on all axis are monomials (all elements in NotUsedAxis are FALSE)
409*returns FALSE for pLexOrderings,
410*assumes in module case an ordering of type c* !!
411* HEckeTest is only called with strat->kHEdgeFound==FALSE !
412*/
413void HEckeTest (poly pp,kStrategy strat)
414{
415  int   j,/*k,*/p;
416
417  strat->kHEdgeFound=FALSE;
418  if (currRing->pLexOrder || currRing->MixedOrder)
419  {
420    return;
421  }
422  if (strat->ak > 1)           /*we are in the module case*/
423  {
424    return; // until ....
425    //if (!pVectorOut)     /*pVectorOut <=> order = c,* */
426    //  return FALSE;
427    //if (pGetComp(pp) < strat->ak) /* ak is the number of the last component */
428    //  return FALSE;
429  }
430  // k = 0;
431  p=pIsPurePower(pp);
432  if (p!=0) strat->NotUsedAxis[p] = FALSE;
433  /*- the leading term of pp is a power of the p-th variable -*/
434  for (j=(currRing->N);j>0; j--)
435  {
436    if (strat->NotUsedAxis[j])
437    {
438      return;
439    }
440  }
441  strat->kHEdgeFound=TRUE;
442}
443
444/*2
445*utilities for TSet, LSet
446*/
447inline static intset initec (const int maxnr)
448{
449  return (intset)omAlloc(maxnr*sizeof(int));
450}
451
452inline static unsigned long* initsevS (const int maxnr)
453{
454  return (unsigned long*)omAlloc0(maxnr*sizeof(unsigned long));
455}
456inline static int* initS_2_R (const int maxnr)
457{
458  return (int*)omAlloc0(maxnr*sizeof(int));
459}
460
461static inline void enlargeT (TSet &T, TObject** &R, unsigned long* &sevT,
462                             int &length, const int incr)
463{
464  assume(T!=NULL);
465  assume(sevT!=NULL);
466  assume(R!=NULL);
467  assume((length+incr) > 0);
468
469  int i;
470  T = (TSet)omRealloc0Size(T, length*sizeof(TObject),
471                           (length+incr)*sizeof(TObject));
472
473  sevT = (unsigned long*) omReallocSize(sevT, length*sizeof(long*),
474                           (length+incr)*sizeof(long*));
475
476  R = (TObject**)omRealloc0Size(R,length*sizeof(TObject*),
477                                (length+incr)*sizeof(TObject*));
478  for (i=length-1;i>=0;i--) R[T[i].i_r] = &(T[i]);
479  length += incr;
480}
481
482void cleanT (kStrategy strat)
483{
484  int i,j;
485  poly  p;
486  assume(currRing == strat->tailRing || strat->tailRing != NULL);
487
488  pShallowCopyDeleteProc p_shallow_copy_delete =
489    (strat->tailRing != currRing ?
490     pGetShallowCopyDeleteProc(strat->tailRing, currRing) :
491     NULL);
492
493  for (j=0; j<=strat->tl; j++)
494  {
495    p = strat->T[j].p;
496    strat->T[j].p=NULL;
497    if (strat->T[j].max != NULL)
498    {
499      p_LmFree(strat->T[j].max, strat->tailRing);
500    }
501    i = -1;
502    loop
503    {
504      i++;
505      if (i>strat->sl)
506      {
507        if (strat->T[j].t_p != NULL)
508        {
509          p_Delete(&(strat->T[j].t_p), strat->tailRing);
510          p_LmFree(p, currRing);
511        }
512        else
513          pDelete(&p);
514        break;
515      }
516      if (p == strat->S[i])
517      {
518        if (strat->T[j].t_p != NULL)
519        {
520          assume(p_shallow_copy_delete != NULL);
521          pNext(p) = p_shallow_copy_delete(pNext(p),strat->tailRing,currRing,
522                                           currRing->PolyBin);
523          p_LmFree(strat->T[j].t_p, strat->tailRing);
524        }
525        break;
526      }
527    }
528  }
529  strat->tl=-1;
530}
531
532//LSet initL ()
533//{
534//  int i;
535//  LSet l = (LSet)omAlloc(setmaxL*sizeof(LObject));
536//  return l;
537//}
538
539static inline void enlargeL (LSet* L,int* length,const int incr)
540{
541  assume((*L)!=NULL);
542  assume((length+incr)>0);
543
544  *L = (LSet)omReallocSize((*L),(*length)*sizeof(LObject),
545                                   ((*length)+incr)*sizeof(LObject));
546  (*length) += incr;
547}
548
549void initPairtest(kStrategy strat)
550{
551  strat->pairtest = (BOOLEAN *)omAlloc0((strat->sl+2)*sizeof(BOOLEAN));
552}
553
554/*2
555*test whether (p1,p2) or (p2,p1) is in L up position length
556*it returns TRUE if yes and the position k
557*/
558BOOLEAN isInPairsetL(int length,poly p1,poly p2,int*  k,kStrategy strat)
559{
560  LObject *p=&(strat->L[length]);
561
562  *k = length;
563  loop
564  {
565    if ((*k) < 0) return FALSE;
566    if (((p1 == (*p).p1) && (p2 == (*p).p2))
567    ||  ((p1 == (*p).p2) && (p2 == (*p).p1)))
568      return TRUE;
569    (*k)--;
570    p--;
571  }
572}
573
574/*2
575*in B all pairs have the same element p on the right
576*it tests whether (q,p) is in B and returns TRUE if yes
577*and the position k
578*/
579BOOLEAN isInPairsetB(poly q,int*  k,kStrategy strat)
580{
581  LObject *p=&(strat->B[strat->Bl]);
582
583  *k = strat->Bl;
584  loop
585  {
586    if ((*k) < 0) return FALSE;
587    if (q == (*p).p1)
588      return TRUE;
589    (*k)--;
590    p--;
591  }
592}
593
594int kFindInT(poly p, TSet T, int tlength)
595{
596  int i;
597
598  for (i=0; i<=tlength; i++)
599  {
600    if (T[i].p == p) return i;
601  }
602  return -1;
603}
604
605int kFindInT(poly p, kStrategy strat)
606{
607  int i;
608  do
609  {
610    i = kFindInT(p, strat->T, strat->tl);
611    if (i >= 0) return i;
612    strat = strat->next;
613  }
614  while (strat != NULL);
615  return -1;
616}
617
618#ifdef KDEBUG
619
620void sTObject::wrp()
621{
622  if (t_p != NULL) p_wrp(t_p, tailRing);
623  else if (p != NULL) p_wrp(p, currRing, tailRing);
624  else ::wrp(NULL);
625}
626
627#define kFalseReturn(x) do { if (!x) return FALSE;} while (0)
628
629// check that Lm's of a poly from T are "equal"
630static const char* kTest_LmEqual(poly p, poly t_p, ring tailRing)
631{
632  int i;
633  for (i=1; i<=tailRing->N; i++)
634  {
635    if (p_GetExp(p, i, currRing) != p_GetExp(t_p, i, tailRing))
636      return "Lm[i] different";
637  }
638  if (p_GetComp(p, currRing) != p_GetComp(t_p, tailRing))
639    return "Lm[0] different";
640  if (pNext(p) != pNext(t_p))
641    return "Lm.next different";
642  if (pGetCoeff(p) != pGetCoeff(t_p))
643    return "Lm.coeff different";
644  return NULL;
645}
646
647static BOOLEAN sloppy_max = FALSE;
648BOOLEAN kTest_T(TObject * T, ring strat_tailRing, int i, char TN)
649{
650  ring tailRing = T->tailRing;
651  if (strat_tailRing == NULL) strat_tailRing = tailRing;
652  r_assume(strat_tailRing == tailRing);
653
654  poly p = T->p;
655  // ring r = currRing;
656
657  if (T->p == NULL && T->t_p == NULL && i >= 0)
658    return dReportError("%c[%d].poly is NULL", TN, i);
659
660  if (T->tailRing != currRing)
661  {
662    if (T->t_p == NULL && i > 0)
663      return dReportError("%c[%d].t_p is NULL", TN, i);
664    pFalseReturn(p_Test(T->t_p, T->tailRing));
665    if (T->p != NULL) pFalseReturn(p_LmTest(T->p, currRing));
666    if (T->p != NULL && T->t_p != NULL)
667    {
668      const char* msg = kTest_LmEqual(T->p, T->t_p, T->tailRing);
669      if (msg != NULL)
670        return dReportError("%c[%d] %s", TN, i, msg);
671      // r = T->tailRing;
672      p = T->t_p;
673    }
674    if (T->p == NULL)
675    {
676      p = T->t_p;
677      // r = T->tailRing;
678    }
679    if (T->t_p != NULL && i >= 0 && TN == 'T')
680    {
681      if (pNext(T->t_p) == NULL)
682      {
683        if (T->max != NULL)
684          return dReportError("%c[%d].max is not NULL as it should be", TN, i);
685      }
686      else
687      {
688        if (T->max == NULL)
689          return dReportError("%c[%d].max is NULL", TN, i);
690        if (pNext(T->max) != NULL)
691          return dReportError("pNext(%c[%d].max) != NULL", TN, i);
692
693        pFalseReturn(p_CheckPolyRing(T->max, tailRing));
694        omCheckBinAddrSize(T->max, (omSizeWOfBin(tailRing->PolyBin))*SIZEOF_LONG);
695#if KDEBUG > 0
696        if (! sloppy_max)
697        {
698          poly test_max = p_GetMaxExpP(pNext(T->t_p), tailRing);
699          p_Setm(T->max, tailRing);
700          p_Setm(test_max, tailRing);
701          BOOLEAN equal = p_ExpVectorEqual(T->max, test_max, tailRing);
702          if (! equal)
703            return dReportError("%c[%d].max out of sync", TN, i);
704          p_LmFree(test_max, tailRing);
705        }
706#endif
707      }
708    }
709  }
710  else
711  {
712    if (T->max != NULL)
713      return dReportError("%c[%d].max != NULL but tailRing == currRing",TN,i);
714    if (T->t_p != NULL)
715      return dReportError("%c[%d].t_p != NULL but tailRing == currRing",TN,i);
716    if (T->p == NULL && i > 0)
717      return dReportError("%c[%d].p is NULL", TN, i);
718    pFalseReturn(p_Test(T->p, currRing));
719  }
720
721  if ((i >= 0) && (T->pLength != 0)
722  && (! rIsSyzIndexRing(currRing)) && (T->pLength != pLength(p)))
723  {
724    int l=T->pLength;
725    T->pLength=pLength(p);
726    return dReportError("%c[%d] pLength error: has %d, specified to have %d",
727                        TN, i , pLength(p), l);
728  }
729
730  // check FDeg,  for elements in L and T
731  if (i >= 0 && (TN == 'T' || TN == 'L'))
732  {
733    // FDeg has ir element from T of L set
734    if (T->FDeg  != T->pFDeg())
735    {
736      int d=T->FDeg;
737      T->FDeg=T->pFDeg();
738      return dReportError("%c[%d] FDeg error: has %d, specified to have %d",
739                          TN, i , T->pFDeg(), d);
740    }
741  }
742
743  // check is_normalized for elements in T
744  if (i >= 0 && TN == 'T')
745  {
746    if (T->is_normalized && ! nIsOne(pGetCoeff(p)))
747      return dReportError("T[%d] is_normalized error", i);
748
749  }
750  return TRUE;
751}
752
753BOOLEAN kTest_L(LObject *L, ring strat_tailRing,
754                BOOLEAN testp, int lpos, TSet T, int tlength)
755{
756  if (testp)
757  {
758    poly pn = NULL;
759    if (L->bucket != NULL)
760    {
761      kFalseReturn(kbTest(L->bucket));
762      r_assume(L->bucket->bucket_ring == L->tailRing);
763      if (L->p != NULL && pNext(L->p) != NULL)
764      {
765        pn = pNext(L->p);
766        pNext(L->p) = NULL;
767      }
768    }
769    kFalseReturn(kTest_T(L, strat_tailRing, lpos, 'L'));
770    if (pn != NULL)
771      pNext(L->p) = pn;
772
773    ring r;
774    poly p;
775    L->GetLm(p, r);
776    if (L->sev != 0 && p_GetShortExpVector(p, r) != L->sev)
777    {
778      return dReportError("L[%d] wrong sev: has %o, specified to have %o",
779                          lpos, p_GetShortExpVector(p, r), L->sev);
780    }
781  }
782  if (L->p1 == NULL)
783  {
784    // L->p2 either NULL or "normal" poly
785    pFalseReturn(pp_Test(L->p2, currRing, L->tailRing));
786  }
787  else if (tlength > 0 && T != NULL && (lpos >=0))
788  {
789    // now p1 and p2 must be != NULL and must be contained in T
790    int i;
791    i = kFindInT(L->p1, T, tlength);
792    if (i < 0)
793      return dReportError("L[%d].p1 not in T",lpos);
794    i = kFindInT(L->p2, T, tlength);
795    if (i < 0)
796      return dReportError("L[%d].p2 not in T",lpos);
797  }
798  return TRUE;
799}
800
801BOOLEAN kTest (kStrategy strat)
802{
803  int i;
804
805  // test P
806  kFalseReturn(kTest_L(&(strat->P), strat->tailRing,
807                       (strat->P.p != NULL && pNext(strat->P.p)!=strat->tail),
808                       -1, strat->T, strat->tl));
809
810  // test T
811  if (strat->T != NULL)
812  {
813    for (i=0; i<=strat->tl; i++)
814    {
815      kFalseReturn(kTest_T(&(strat->T[i]), strat->tailRing, i, 'T'));
816      if (strat->sevT[i] != pGetShortExpVector(strat->T[i].p))
817        return dReportError("strat->sevT[%d] out of sync", i);
818    }
819  }
820
821  // test L
822  if (strat->L != NULL)
823  {
824    for (i=0; i<=strat->Ll; i++)
825    {
826      kFalseReturn(kTest_L(&(strat->L[i]), strat->tailRing,
827                           strat->L[i].Next() != strat->tail, i,
828                           strat->T, strat->tl));
829      // may be unused
830      //if (strat->use_buckets && strat->L[i].Next() != strat->tail &&
831      //    strat->L[i].Next() != NULL && strat->L[i].p1 != NULL)
832      //{
833      //  assume(strat->L[i].bucket != NULL);
834      //}
835    }
836  }
837
838  // test S
839  if (strat->S != NULL)
840    kFalseReturn(kTest_S(strat));
841
842  return TRUE;
843}
844
845BOOLEAN kTest_S(kStrategy strat)
846{
847  int i;
848  BOOLEAN ret = TRUE;
849  for (i=0; i<=strat->sl; i++)
850  {
851    if (strat->S[i] != NULL &&
852        strat->sevS[i] != pGetShortExpVector(strat->S[i]))
853    {
854      return dReportError("S[%d] wrong sev: has %o, specified to have %o",
855                          i , pGetShortExpVector(strat->S[i]), strat->sevS[i]);
856    }
857  }
858  return ret;
859}
860
861
862
863BOOLEAN kTest_TS(kStrategy strat)
864{
865  int i, j;
866  // BOOLEAN ret = TRUE;
867  kFalseReturn(kTest(strat));
868
869  // test strat->R, strat->T[i].i_r
870  for (i=0; i<=strat->tl; i++)
871  {
872    if (strat->T[i].i_r < 0 || strat->T[i].i_r > strat->tl)
873      return dReportError("strat->T[%d].i_r == %d out of bounds", i,
874                          strat->T[i].i_r);
875    if (strat->R[strat->T[i].i_r] != &(strat->T[i]))
876      return dReportError("T[%d].i_r with R out of sync", i);
877  }
878  // test containment of S inT
879  if (strat->S != NULL)
880  {
881    for (i=0; i<=strat->sl; i++)
882    {
883      j = kFindInT(strat->S[i], strat->T, strat->tl);
884      if (j < 0)
885        return dReportError("S[%d] not in T", i);
886      if (strat->S_2_R[i] != strat->T[j].i_r)
887        return dReportError("S_2_R[%d]=%d != T[%d].i_r=%d\n",
888                            i, strat->S_2_R[i], j, strat->T[j].i_r);
889    }
890  }
891  // test strat->L[i].i_r1
892  for (i=0; i<=strat->Ll; i++)
893  {
894    if (strat->L[i].p1 != NULL && strat->L[i].p2)
895    {
896      if (strat->L[i].i_r1 < 0 ||
897          strat->L[i].i_r1 > strat->tl ||
898          strat->L[i].T_1(strat)->p != strat->L[i].p1)
899        return dReportError("L[%d].i_r1 out of sync", i);
900      if (strat->L[i].i_r2 < 0 ||
901          strat->L[i].i_r2 > strat->tl ||
902          strat->L[i].T_2(strat)->p != strat->L[i].p2);
903    }
904    else
905    {
906      if (strat->L[i].i_r1 != -1)
907        return dReportError("L[%d].i_r1 out of sync", i);
908      if (strat->L[i].i_r2 != -1)
909        return dReportError("L[%d].i_r2 out of sync", i);
910    }
911    if (strat->L[i].i_r != -1)
912      return dReportError("L[%d].i_r out of sync", i);
913  }
914  return TRUE;
915}
916
917#endif // KDEBUG
918
919/*2
920*cancels the i-th polynomial in the standardbase s
921*/
922void deleteInS (int i,kStrategy strat)
923{
924#ifdef ENTER_USE_MEMMOVE
925  memmove(&(strat->S[i]), &(strat->S[i+1]), (strat->sl - i)*sizeof(poly));
926  memmove(&(strat->ecartS[i]),&(strat->ecartS[i+1]),(strat->sl - i)*sizeof(int));
927  memmove(&(strat->sevS[i]),&(strat->sevS[i+1]),(strat->sl - i)*sizeof(unsigned long));
928  memmove(&(strat->S_2_R[i]),&(strat->S_2_R[i+1]),(strat->sl - i)*sizeof(int));
929#else
930  int j;
931  for (j=i; j<strat->sl; j++)
932  {
933    strat->S[j] = strat->S[j+1];
934    strat->ecartS[j] = strat->ecartS[j+1];
935    strat->sevS[j] = strat->sevS[j+1];
936    strat->S_2_R[j] = strat->S_2_R[j+1];
937  }
938#endif
939  if (strat->lenS!=NULL)
940  {
941#ifdef ENTER_USE_MEMMOVE
942    memmove(&(strat->lenS[i]),&(strat->lenS[i+1]),(strat->sl - i)*sizeof(int));
943#else
944    for (j=i; j<strat->sl; j++) strat->lenS[j] = strat->lenS[j+1];
945#endif
946  }
947  if (strat->lenSw!=NULL)
948  {
949#ifdef ENTER_USE_MEMMOVE
950    memmove(&(strat->lenSw[i]),&(strat->lenSw[i+1]),(strat->sl - i)*sizeof(wlen_type));
951#else
952    for (j=i; j<strat->sl; j++) strat->lenSw[j] = strat->lenSw[j+1];
953#endif
954  }
955  if (strat->fromQ!=NULL)
956  {
957#ifdef ENTER_USE_MEMMOVE
958    memmove(&(strat->fromQ[i]),&(strat->fromQ[i+1]),(strat->sl - i)*sizeof(int));
959#else
960    for (j=i; j<strat->sl; j++)
961    {
962      strat->fromQ[j] = strat->fromQ[j+1];
963    }
964#endif
965  }
966  strat->S[strat->sl] = NULL;
967  strat->sl--;
968}
969
970
971/*2
972*cancels the i-th polynomial in the standardbase s
973*/
974void deleteInSSba (int i,kStrategy strat)
975{
976#ifdef ENTER_USE_MEMMOVE
977  memmove(&(strat->S[i]), &(strat->S[i+1]), (strat->sl - i)*sizeof(poly));
978  memmove(&(strat->sig[i]), &(strat->sig[i+1]), (strat->sl - i)*sizeof(poly));
979  memmove(&(strat->ecartS[i]),&(strat->ecartS[i+1]),(strat->sl - i)*sizeof(int));
980  memmove(&(strat->sevS[i]),&(strat->sevS[i+1]),(strat->sl - i)*sizeof(unsigned long));
981  memmove(&(strat->sevSig[i]),&(strat->sevSig[i+1]),(strat->sl - i)*sizeof(unsigned long));
982  memmove(&(strat->S_2_R[i]),&(strat->S_2_R[i+1]),(strat->sl - i)*sizeof(int));
983#else
984  int j;
985  for (j=i; j<strat->sl; j++)
986  {
987    strat->S[j] = strat->S[j+1];
988    strat->sig[j] = strat->sig[j+1];
989    strat->ecartS[j] = strat->ecartS[j+1];
990    strat->sevS[j] = strat->sevS[j+1];
991    strat->sevSig[j] = strat->sevSig[j+1];
992    strat->S_2_R[j] = strat->S_2_R[j+1];
993  }
994#endif
995  if (strat->lenS!=NULL)
996  {
997#ifdef ENTER_USE_MEMMOVE
998    memmove(&(strat->lenS[i]),&(strat->lenS[i+1]),(strat->sl - i)*sizeof(int));
999#else
1000    for (j=i; j<strat->sl; j++) strat->lenS[j] = strat->lenS[j+1];
1001#endif
1002  }
1003  if (strat->lenSw!=NULL)
1004  {
1005#ifdef ENTER_USE_MEMMOVE
1006    memmove(&(strat->lenSw[i]),&(strat->lenSw[i+1]),(strat->sl - i)*sizeof(wlen_type));
1007#else
1008    for (j=i; j<strat->sl; j++) strat->lenSw[j] = strat->lenSw[j+1];
1009#endif
1010  }
1011  if (strat->fromQ!=NULL)
1012  {
1013#ifdef ENTER_USE_MEMMOVE
1014    memmove(&(strat->fromQ[i]),&(strat->fromQ[i+1]),(strat->sl - i)*sizeof(int));
1015#else
1016    for (j=i; j<strat->sl; j++)
1017    {
1018      strat->fromQ[j] = strat->fromQ[j+1];
1019    }
1020#endif
1021  }
1022  strat->S[strat->sl] = NULL;
1023  strat->sl--;
1024}
1025
1026/*2
1027*cancels the j-th polynomial in the set
1028*/
1029void deleteInL (LSet set, int *length, int j,kStrategy strat)
1030{
1031  if (set[j].lcm!=NULL)
1032  {
1033#ifdef HAVE_RINGS
1034    if (pGetCoeff(set[j].lcm) != NULL)
1035      pLmDelete(set[j].lcm);
1036    else
1037#endif
1038      pLmFree(set[j].lcm);
1039  }
1040  if (set[j].sig!=NULL)
1041  {
1042#ifdef HAVE_RINGS
1043    if (pGetCoeff(set[j].sig) != NULL)
1044      pLmDelete(set[j].sig);
1045    else
1046#endif
1047      pLmFree(set[j].sig);
1048  }
1049  if (set[j].p!=NULL)
1050  {
1051    if (pNext(set[j].p) == strat->tail)
1052    {
1053#ifdef HAVE_RINGS
1054      if (pGetCoeff(set[j].p) != NULL)
1055        pLmDelete(set[j].p);
1056      else
1057#endif
1058        pLmFree(set[j].p);
1059      /*- tail belongs to several int spolys -*/
1060    }
1061    else
1062    {
1063      // search p in T, if it is there, do not delete it
1064      if (currRing->OrdSgn != -1 || kFindInT(set[j].p, strat) < 0)
1065      {
1066        // assure that for global orderings kFindInT fails
1067        assume(currRing->OrdSgn == -1 || kFindInT(set[j].p, strat) < 0);
1068        set[j].Delete();
1069      }
1070    }
1071  }
1072  if (*length > 0 && j < *length)
1073  {
1074#ifdef ENTER_USE_MEMMOVE
1075    memmove(&(set[j]), &(set[j+1]), (*length - j)*sizeof(LObject));
1076#else
1077    int i;
1078    for (i=j; i < (*length); i++)
1079      set[i] = set[i+1];
1080#endif
1081  }
1082#ifdef KDEBUG
1083  memset(&(set[*length]),0,sizeof(LObject));
1084#endif
1085  (*length)--;
1086}
1087
1088/*2
1089*enters p at position at in L
1090*/
1091void enterL (LSet *set,int *length, int *LSetmax, LObject p,int at)
1092{
1093  // this should be corrected
1094  assume(p.FDeg == p.pFDeg());
1095
1096  if ((*length)>=0)
1097  {
1098    if ((*length) == (*LSetmax)-1) enlargeL(set,LSetmax,setmaxLinc);
1099    if (at <= (*length))
1100#ifdef ENTER_USE_MEMMOVE
1101      memmove(&((*set)[at+1]), &((*set)[at]), ((*length)-at+1)*sizeof(LObject));
1102#else
1103    for (i=(*length)+1; i>=at+1; i--) (*set)[i] = (*set)[i-1];
1104#endif
1105  }
1106  else at = 0;
1107  (*set)[at] = p;
1108  (*length)++;
1109}
1110
1111/*2
1112* computes the normal ecart;
1113* used in mora case and if pLexOrder & sugar in bba case
1114*/
1115void initEcartNormal (LObject* h)
1116{
1117  h->FDeg = h->pFDeg();
1118  h->ecart = h->pLDeg() - h->FDeg;
1119  // h->length is set by h->pLDeg
1120  h->length=h->pLength=pLength(h->p);
1121}
1122
1123void initEcartBBA (LObject* h)
1124{
1125  h->FDeg = h->pFDeg();
1126  (*h).ecart = 0;
1127  h->length=h->pLength=pLength(h->p);
1128}
1129
1130void initEcartPairBba (LObject* Lp,poly /*f*/,poly /*g*/,int /*ecartF*/,int /*ecartG*/)
1131{
1132  Lp->FDeg = Lp->pFDeg();
1133  (*Lp).ecart = 0;
1134  (*Lp).length = 0;
1135}
1136
1137void initEcartPairMora (LObject* Lp,poly /*f*/,poly /*g*/,int ecartF,int ecartG)
1138{
1139  Lp->FDeg = Lp->pFDeg();
1140  (*Lp).ecart = si_max(ecartF,ecartG);
1141  (*Lp).ecart = (*Lp).ecart- (Lp->FDeg -p_FDeg((*Lp).lcm,currRing));
1142  (*Lp).length = 0;
1143}
1144
1145/*2
1146*if ecart1<=ecart2 it returns TRUE
1147*/
1148static inline BOOLEAN sugarDivisibleBy(int ecart1, int ecart2)
1149{
1150  return (ecart1 <= ecart2);
1151}
1152
1153#ifdef HAVE_RINGS
1154/*2
1155* put the pair (s[i],p)  into the set B, ecart=ecart(p) (ring case)
1156*/
1157void enterOnePairRing (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
1158{
1159  assume(i<=strat->sl);
1160  int      l,j,compare,compareCoeff;
1161  LObject  Lp;
1162
1163  if (strat->interred_flag) return;
1164#ifdef KDEBUG
1165  Lp.ecart=0; Lp.length=0;
1166#endif
1167  /*- computes the lcm(s[i],p) -*/
1168  Lp.lcm = pInit();
1169  pSetCoeff0(Lp.lcm, n_Lcm(pGetCoeff(p), pGetCoeff(strat->S[i]), currRing->cf));
1170
1171  #if ADIDEBUG
1172  PrintS("\nLp.lcm (lc) = ");pWrite(Lp.lcm);
1173  #endif
1174
1175  // Lp.lcm == 0
1176  if (nIsZero(pGetCoeff(Lp.lcm)))
1177  {
1178#ifdef KDEBUG
1179      if (TEST_OPT_DEBUG)
1180      {
1181        PrintS("--- Lp.lcm == 0\n");
1182        PrintS("p:");
1183        wrp(p);
1184        Print("  strat->S[%d]:", i);
1185        wrp(strat->S[i]);
1186        PrintLn();
1187      }
1188#endif
1189      strat->cp++;
1190      pLmDelete(Lp.lcm);
1191      return;
1192  }
1193  // basic product criterion
1194  pLcm(p,strat->S[i],Lp.lcm);
1195
1196  #if ADIDEBUG
1197  PrintS("\nLp.lcm (lcm) = ");pWrite(Lp.lcm);
1198  #endif
1199
1200  pSetm(Lp.lcm);
1201  assume(!strat->sugarCrit);
1202  if (pHasNotCF(p,strat->S[i]) && n_IsUnit(pGetCoeff(p),currRing->cf)
1203      && n_IsUnit(pGetCoeff(strat->S[i]),currRing->cf))
1204  {
1205#ifdef KDEBUG
1206      if (TEST_OPT_DEBUG)
1207      {
1208        PrintS("--- product criterion func enterOnePairRing type 1\n");
1209        PrintS("p:");
1210        wrp(p);
1211        Print("  strat->S[%d]:", i);
1212        wrp(strat->S[i]);
1213        PrintLn();
1214      }
1215#endif
1216      strat->cp++;
1217      pLmDelete(Lp.lcm);
1218      return;
1219  }
1220  assume(!strat->fromT);
1221  /*
1222  *the set B collects the pairs of type (S[j],p)
1223  *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
1224  *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1225  *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1226  */
1227  for(j = strat->Bl;j>=0;j--)
1228  {
1229    compare=pDivCompRing(strat->B[j].lcm,Lp.lcm);
1230    compareCoeff = n_DivComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(Lp.lcm), currRing->cf);
1231    if ((compareCoeff == pDivComp_EQUAL) || (compare == compareCoeff))
1232    {
1233      if (compare == 1)
1234      {
1235        strat->c3++;
1236#ifdef KDEBUG
1237        if (TEST_OPT_DEBUG)
1238        {
1239          PrintS("--- chain criterion type 1\n");
1240          PrintS("strat->B[j]:");
1241          wrp(strat->B[j].lcm);
1242          PrintS("  Lp.lcm:");
1243          wrp(Lp.lcm);
1244          PrintLn();
1245        }
1246#endif
1247        if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1248        {
1249          pLmDelete(Lp.lcm);
1250          return;
1251        }
1252        break;
1253      }
1254      else
1255      if (compare == -1)
1256      {
1257#ifdef KDEBUG
1258        if (TEST_OPT_DEBUG)
1259        {
1260          PrintS("--- chain criterion type 2\n");
1261          Print("strat->B[%d].lcm:",j);
1262          wrp(strat->B[j].lcm);
1263          PrintS("  Lp.lcm:");
1264          wrp(Lp.lcm);
1265          PrintLn();
1266        }
1267#endif
1268        deleteInL(strat->B,&strat->Bl,j,strat);
1269        strat->c3++;
1270      }
1271    }
1272    if ((compare == pDivComp_EQUAL) && (compareCoeff != 2))
1273    {
1274      if (compareCoeff == pDivComp_LESS)
1275      {
1276#ifdef KDEBUG
1277        if (TEST_OPT_DEBUG)
1278        {
1279          PrintS("--- chain criterion type 3\n");
1280          Print("strat->B[%d].lcm:", j);
1281          wrp(strat->B[j].lcm);
1282          PrintS("  Lp.lcm:");
1283          wrp(Lp.lcm);
1284          PrintLn();
1285        }
1286#endif
1287        strat->c3++;
1288        if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1289        {
1290          pLmDelete(Lp.lcm);
1291          return;
1292        }
1293        break;
1294      }
1295      else
1296      // Add hint for same LM and LC (later) (TODO Oliver)
1297      // if (compareCoeff == pDivComp_GREATER)
1298      {
1299#ifdef KDEBUG
1300        if (TEST_OPT_DEBUG)
1301        {
1302          PrintS("--- chain criterion type 4\n");
1303          Print("strat->B[%d].lcm:", j);
1304          wrp(strat->B[j].lcm);
1305          PrintS("  Lp.lcm:");
1306          wrp(Lp.lcm);
1307          PrintLn();
1308        }
1309#endif
1310        deleteInL(strat->B,&strat->Bl,j,strat);
1311        strat->c3++;
1312      }
1313    }
1314  }
1315  /*
1316  *the pair (S[i],p) enters B if the spoly != 0
1317  */
1318  /*-  compute the short s-polynomial -*/
1319  if ((strat->S[i]==NULL) || (p==NULL))
1320  {
1321#ifdef KDEBUG
1322    if (TEST_OPT_DEBUG)
1323    {
1324      PrintS("--- spoly = NULL\n");
1325    }
1326#endif
1327    pLmDelete(Lp.lcm);
1328    return;
1329  }
1330  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
1331  {
1332    // Is from a previous computed GB, therefore we know that spoly will
1333    // reduce to zero. Oliver.
1334    WarnS("Could we come here? 8738947389");
1335    Lp.p=NULL;
1336  }
1337  else
1338  {
1339    Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
1340  }
1341  if (Lp.p == NULL)
1342  {
1343#ifdef KDEBUG
1344    if (TEST_OPT_DEBUG)
1345    {
1346      PrintS("--- spoly = NULL\n");
1347    }
1348#endif
1349    /*- the case that the s-poly is 0 -*/
1350    if (strat->pairtest==NULL) initPairtest(strat);
1351    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
1352    strat->pairtest[strat->sl+1] = TRUE;
1353    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
1354    /*
1355    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
1356    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
1357    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
1358    *term of p devides the lcm(s,r)
1359    *(this canceling should be done here because
1360    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
1361    *the first case is handeled in chainCrit
1362    */
1363    pLmDelete(Lp.lcm);
1364  }
1365  else
1366  {
1367    /*- the pair (S[i],p) enters B -*/
1368    Lp.p1 = strat->S[i];
1369    Lp.p2 = p;
1370
1371    pNext(Lp.p) = strat->tail;
1372
1373    if (atR >= 0)
1374    {
1375      Lp.i_r2 = atR;
1376      Lp.i_r1 = strat->S_2_R[i];
1377    }
1378    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1379    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
1380    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
1381  }
1382}
1383
1384
1385/*2
1386* put the  lcm(s[i],p)  into the set B
1387*/
1388
1389BOOLEAN enterOneStrongPoly (int i,poly p,int /*ecart*/, int /*isFromQ*/,kStrategy strat, int atR = -1)
1390{
1391  number d, s, t;
1392  assume(i<=strat->sl);
1393  assume(atR >= 0);
1394  poly m1, m2, gcd;
1395
1396  d = n_ExtGcd(pGetCoeff(p), pGetCoeff(strat->S[i]), &s, &t, currRing->cf);
1397
1398  if (nIsZero(s) || nIsZero(t))  // evtl. durch divBy tests ersetzen
1399  {
1400    nDelete(&d);
1401    nDelete(&s);
1402    nDelete(&t);
1403    return FALSE;
1404  }
1405
1406  k_GetStrongLeadTerms(p, strat->S[i], currRing, m1, m2, gcd, strat->tailRing);
1407  //p_Test(m1,strat->tailRing);
1408  //p_Test(m2,strat->tailRing);
1409  while (! kCheckStrongCreation(atR, m1, i, m2, strat) )
1410  {
1411    memset(&(strat->P), 0, sizeof(strat->P));
1412    kStratChangeTailRing(strat);
1413    strat->P = *(strat->R[atR]);
1414    p_LmFree(m1, strat->tailRing);
1415    p_LmFree(m2, strat->tailRing);
1416    p_LmFree(gcd, currRing);
1417    k_GetStrongLeadTerms(p, strat->S[i], currRing, m1, m2, gcd, strat->tailRing);
1418  }
1419  pSetCoeff0(m1, s);
1420  pSetCoeff0(m2, t);
1421  pSetCoeff0(gcd, d);
1422  p_Test(m1,strat->tailRing);
1423  p_Test(m2,strat->tailRing);
1424
1425#ifdef KDEBUG
1426  if (TEST_OPT_DEBUG)
1427  {
1428    // Print("t = %d; s = %d; d = %d\n", nInt(t), nInt(s), nInt(d));
1429    PrintS("m1 = ");
1430    p_wrp(m1, strat->tailRing);
1431    PrintS(" ; m2 = ");
1432    p_wrp(m2, strat->tailRing);
1433    PrintS(" ; gcd = ");
1434    wrp(gcd);
1435    PrintS("\n--- create strong gcd poly: ");
1436    Print("\n p: ", i);
1437    wrp(p);
1438    Print("\n strat->S[%d]: ", i);
1439    wrp(strat->S[i]);
1440    PrintS(" ---> ");
1441  }
1442#endif
1443
1444  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);
1445  p_LmDelete(m1, strat->tailRing);
1446  p_LmDelete(m2, strat->tailRing);
1447
1448#ifdef KDEBUG
1449  if (TEST_OPT_DEBUG)
1450  {
1451    wrp(gcd);
1452    PrintLn();
1453  }
1454#endif
1455
1456  LObject h;
1457  h.p = gcd;
1458  h.tailRing = strat->tailRing;
1459  int posx;
1460  h.pCleardenom();
1461  strat->initEcart(&h);
1462  if (strat->Ll==-1)
1463    posx =0;
1464  else
1465    posx = strat->posInL(strat->L,strat->Ll,&h,strat);
1466  h.sev = pGetShortExpVector(h.p);
1467  if (currRing!=strat->tailRing)
1468    h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
1469  enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
1470  return TRUE;
1471}
1472#endif
1473
1474/*2
1475* put the pair (s[i],p)  into the set B, ecart=ecart(p)
1476*/
1477
1478void enterOnePairNormal (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
1479{
1480  assume(i<=strat->sl);
1481  if (strat->interred_flag) return;
1482
1483  int      l,j,compare;
1484  LObject  Lp;
1485  Lp.i_r = -1;
1486
1487#ifdef KDEBUG
1488  Lp.ecart=0; Lp.length=0;
1489#endif
1490  /*- computes the lcm(s[i],p) -*/
1491  Lp.lcm = pInit();
1492
1493#ifndef HAVE_RATGRING
1494  pLcm(p,strat->S[i],Lp.lcm);
1495#elif defined(HAVE_RATGRING)
1496  //  if (rIsRatGRing(currRing))
1497  pLcmRat(p,strat->S[i],Lp.lcm, currRing->real_var_start); // int rat_shift
1498#endif
1499  pSetm(Lp.lcm);
1500
1501
1502  if (strat->sugarCrit && ALLOW_PROD_CRIT(strat))
1503  {
1504    if((!((strat->ecartS[i]>0)&&(ecart>0)))
1505    && pHasNotCF(p,strat->S[i]))
1506    {
1507    /*
1508    *the product criterion has applied for (s,p),
1509    *i.e. lcm(s,p)=product of the leading terms of s and p.
1510    *Suppose (s,r) is in L and the leading term
1511    *of p divides lcm(s,r)
1512    *(==> the leading term of p divides the leading term of r)
1513    *but the leading term of s does not divide the leading term of r
1514    *(notice that tis condition is automatically satisfied if r is still
1515    *in S), then (s,r) can be cancelled.
1516    *This should be done here because the
1517    *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
1518    *
1519    *Moreover, skipping (s,r) holds also for the noncommutative case.
1520    */
1521      strat->cp++;
1522      pLmFree(Lp.lcm);
1523      Lp.lcm=NULL;
1524      return;
1525    }
1526    else
1527      Lp.ecart = si_max(ecart,strat->ecartS[i]);
1528    if (strat->fromT && (strat->ecartS[i]>ecart))
1529    {
1530      pLmFree(Lp.lcm);
1531      Lp.lcm=NULL;
1532      return;
1533      /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
1534    }
1535    /*
1536    *the set B collects the pairs of type (S[j],p)
1537    *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
1538    *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1539    *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1540    */
1541    {
1542      j = strat->Bl;
1543      loop
1544      {
1545        if (j < 0)  break;
1546        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
1547        if ((compare==1)
1548        &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
1549        {
1550          strat->c3++;
1551          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1552          {
1553            pLmFree(Lp.lcm);
1554            return;
1555          }
1556          break;
1557        }
1558        else
1559        if ((compare ==-1)
1560        && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
1561        {
1562          deleteInL(strat->B,&strat->Bl,j,strat);
1563          strat->c3++;
1564        }
1565        j--;
1566      }
1567    }
1568  }
1569  else /*sugarcrit*/
1570  {
1571    if (ALLOW_PROD_CRIT(strat))
1572    {
1573      // if currRing->nc_type!=quasi (or skew)
1574      // TODO: enable productCrit for super commutative algebras...
1575      if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
1576      pHasNotCF(p,strat->S[i]))
1577      {
1578      /*
1579      *the product criterion has applied for (s,p),
1580      *i.e. lcm(s,p)=product of the leading terms of s and p.
1581      *Suppose (s,r) is in L and the leading term
1582      *of p devides lcm(s,r)
1583      *(==> the leading term of p devides the leading term of r)
1584      *but the leading term of s does not devide the leading term of r
1585      *(notice that tis condition is automatically satisfied if r is still
1586      *in S), then (s,r) can be canceled.
1587      *This should be done here because the
1588      *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
1589      */
1590          strat->cp++;
1591          pLmFree(Lp.lcm);
1592          Lp.lcm=NULL;
1593          return;
1594      }
1595      if (strat->fromT && (strat->ecartS[i]>ecart))
1596      {
1597        pLmFree(Lp.lcm);
1598        Lp.lcm=NULL;
1599        return;
1600        /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
1601      }
1602      /*
1603      *the set B collects the pairs of type (S[j],p)
1604      *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
1605      *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1606      *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1607      */
1608      for(j = strat->Bl;j>=0;j--)
1609      {
1610        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
1611        if (compare==1)
1612        {
1613          strat->c3++;
1614          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1615          {
1616            pLmFree(Lp.lcm);
1617            return;
1618          }
1619          break;
1620        }
1621        else
1622        if (compare ==-1)
1623        {
1624          deleteInL(strat->B,&strat->Bl,j,strat);
1625          strat->c3++;
1626        }
1627      }
1628    }
1629  }
1630  /*
1631  *the pair (S[i],p) enters B if the spoly != 0
1632  */
1633  /*-  compute the short s-polynomial -*/
1634  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
1635    pNorm(p);
1636
1637  if ((strat->S[i]==NULL) || (p==NULL))
1638    return;
1639
1640  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
1641    Lp.p=NULL;
1642  else
1643  {
1644    #ifdef HAVE_PLURAL
1645    if ( rIsPluralRing(currRing) )
1646    {
1647      if(pHasNotCF(p, strat->S[i]))
1648      {
1649         if(ncRingType(currRing) == nc_lie)
1650         {
1651             // generalized prod-crit for lie-type
1652             strat->cp++;
1653             Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i], currRing);
1654         }
1655         else
1656        if( ALLOW_PROD_CRIT(strat) )
1657        {
1658            // product criterion for homogeneous case in SCA
1659            strat->cp++;
1660            Lp.p = NULL;
1661        }
1662        else
1663        {
1664          Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
1665                nc_CreateShortSpoly(strat->S[i], p, currRing);
1666
1667          assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
1668          pNext(Lp.p) = strat->tail; // !!!
1669        }
1670      }
1671      else
1672      {
1673        Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
1674              nc_CreateShortSpoly(strat->S[i], p, currRing);
1675
1676        assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
1677        pNext(Lp.p) = strat->tail; // !!!
1678
1679      }
1680
1681
1682#if MYTEST
1683      if (TEST_OPT_DEBUG)
1684      {
1685        PrintS("enterOnePairNormal::\n strat->S[i]: "); pWrite(strat->S[i]);
1686        PrintS("p: "); pWrite(p);
1687        PrintS("SPoly: "); pWrite(Lp.p);
1688      }
1689#endif
1690
1691    }
1692    else
1693    #endif
1694    {
1695      assume(!rIsPluralRing(currRing));
1696      Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
1697#if MYTEST
1698      if (TEST_OPT_DEBUG)
1699      {
1700        PrintS("enterOnePairNormal::\n strat->S[i]: "); pWrite(strat->S[i]);
1701        PrintS("p: "); pWrite(p);
1702        PrintS("commutative SPoly: "); pWrite(Lp.p);
1703      }
1704#endif
1705
1706      }
1707  }
1708  if (Lp.p == NULL)
1709  {
1710    /*- the case that the s-poly is 0 -*/
1711    if (strat->pairtest==NULL) initPairtest(strat);
1712    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
1713    strat->pairtest[strat->sl+1] = TRUE;
1714    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
1715    /*
1716    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
1717    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
1718    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
1719    *term of p devides the lcm(s,r)
1720    *(this canceling should be done here because
1721    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
1722    *the first case is handeled in chainCrit
1723    */
1724    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
1725  }
1726  else
1727  {
1728    /*- the pair (S[i],p) enters B -*/
1729    Lp.p1 = strat->S[i];
1730    Lp.p2 = p;
1731
1732    if (
1733        (!rIsPluralRing(currRing))
1734//      ||  (rIsPluralRing(currRing) && (ncRingType(currRing) != nc_lie))
1735       )
1736    {
1737      assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
1738      pNext(Lp.p) = strat->tail; // !!!
1739    }
1740
1741    if (atR >= 0)
1742    {
1743      Lp.i_r1 = strat->S_2_R[i];
1744      Lp.i_r2 = atR;
1745    }
1746    else
1747    {
1748      Lp.i_r1 = -1;
1749      Lp.i_r2 = -1;
1750    }
1751    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1752
1753    if (TEST_OPT_INTSTRATEGY)
1754    {
1755      if (!rIsPluralRing(currRing))
1756        nDelete(&(Lp.p->coef));
1757    }
1758
1759    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
1760    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
1761  }
1762}
1763
1764/*2
1765* put the pair (s[i],p)  into the set B, ecart=ecart(p)
1766* NOTE: here we need to add the signature-based criteria
1767*/
1768
1769#ifdef DEBUGF5
1770void enterOnePairSig (int i, poly p, poly pSig, int from, int ecart, int isFromQ, kStrategy strat, int atR = -1)
1771#else
1772void enterOnePairSig (int i, poly p, poly pSig, int, int ecart, int isFromQ, kStrategy strat, int atR = -1)
1773#endif
1774{
1775  assume(i<=strat->sl);
1776  if (strat->interred_flag) return;
1777
1778  int      l;
1779  poly m1 = NULL,m2 = NULL; // we need the multipliers for the s-polynomial to compute
1780              // the corresponding signatures for criteria checks
1781  LObject  Lp;
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("P2  ");
1809  pWrite(pHead(strat->S[i]));
1810  Print("M1  ");
1811  pWrite(m1);
1812  Print("M2  ");
1813  pWrite(m2);
1814#endif
1815  // get multiplied signatures for testing
1816  pSigMult = currRing->p_Procs->pp_Mult_mm(pSigMult,m1,currRing);
1817  pSigMultNegSev = ~p_GetShortExpVector(pSigMult,currRing);
1818  sSigMult = currRing->p_Procs->pp_Mult_mm(sSigMult,m2,currRing);
1819  sSigMultNegSev = ~p_GetShortExpVector(sSigMult,currRing);
1820
1821//#if 1
1822#ifdef DEBUGF5
1823  Print("----------------\n");
1824  pWrite(pSigMult);
1825  pWrite(sSigMult);
1826  Print("----------------\n");
1827  Lp.checked  = 0;
1828#endif
1829  int sigCmp = p_LmCmp(pSigMult,sSigMult,currRing);
1830//#if 1
1831#if DEBUGF5
1832  printf("IN PAIR GENERATION - COMPARING SIGS: %d\n",sigCmp);
1833  pWrite(pSigMult);
1834  pWrite(sSigMult);
1835#endif
1836  if(sigCmp==0)
1837  {
1838    // printf("!!!!   EQUAL SIGS   !!!!\n");
1839    // pSig = sSig, delete element due to Rewritten Criterion
1840    pDelete(&pSigMult);
1841    pDelete(&sSigMult);
1842    pLmFree(Lp.lcm);
1843    Lp.lcm=NULL;
1844    pDelete (&m1);
1845    pDelete (&m2);
1846    return;
1847  }
1848  // testing by syzCrit = F5 Criterion
1849  // testing by rewCrit1 = Rewritten Criterion
1850  // NOTE: Arri's Rewritten Criterion is tested below, we need Lp.p for it!
1851  if  ( strat->syzCrit(pSigMult,pSigMultNegSev,strat) ||
1852        strat->syzCrit(sSigMult,sSigMultNegSev,strat)
1853        || strat->rewCrit1(sSigMult,sSigMultNegSev,Lp.lcm,strat,i+1)
1854      )
1855  {
1856    pDelete(&pSigMult);
1857    pDelete(&sSigMult);
1858    pLmFree(Lp.lcm);
1859    Lp.lcm=NULL;
1860    pDelete (&m1);
1861    pDelete (&m2);
1862    return;
1863  }
1864  /*
1865  *the pair (S[i],p) enters B if the spoly != 0
1866  */
1867  /*-  compute the short s-polynomial -*/
1868  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
1869    pNorm(p);
1870
1871  if ((strat->S[i]==NULL) || (p==NULL))
1872    return;
1873
1874  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
1875    Lp.p=NULL;
1876  else
1877  {
1878    #ifdef HAVE_PLURAL
1879    if ( rIsPluralRing(currRing) )
1880    {
1881      if(pHasNotCF(p, strat->S[i]))
1882      {
1883         if(ncRingType(currRing) == nc_lie)
1884         {
1885             // generalized prod-crit for lie-type
1886             strat->cp++;
1887             Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i], currRing);
1888         }
1889         else
1890        if( ALLOW_PROD_CRIT(strat) )
1891        {
1892            // product criterion for homogeneous case in SCA
1893            strat->cp++;
1894            Lp.p = NULL;
1895        }
1896        else
1897        {
1898          Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
1899                nc_CreateShortSpoly(strat->S[i], p, currRing);
1900
1901          assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
1902          pNext(Lp.p) = strat->tail; // !!!
1903        }
1904      }
1905      else
1906      {
1907        Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
1908              nc_CreateShortSpoly(strat->S[i], p, currRing);
1909
1910        assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
1911        pNext(Lp.p) = strat->tail; // !!!
1912
1913      }
1914
1915
1916#if MYTEST
1917      if (TEST_OPT_DEBUG)
1918      {
1919        PrintS("enterOnePairNormal::\n strat->S[i]: "); pWrite(strat->S[i]);
1920        PrintS("p: "); pWrite(p);
1921        PrintS("SPoly: "); pWrite(Lp.p);
1922      }
1923#endif
1924
1925    }
1926    else
1927    #endif
1928    {
1929      assume(!rIsPluralRing(currRing));
1930      Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
1931#if MYTEST
1932      if (TEST_OPT_DEBUG)
1933      {
1934        PrintS("enterOnePairNormal::\n strat->S[i]: "); pWrite(strat->S[i]);
1935        PrintS("p: "); pWrite(p);
1936        PrintS("commutative SPoly: "); pWrite(Lp.p);
1937      }
1938#endif
1939
1940      }
1941  }
1942  // store from which element this pair comes from for further tests
1943  //Lp.from = strat->sl+1;
1944  if(sigCmp==currRing->OrdSgn)
1945  {
1946    // pSig > sSig
1947    pDelete (&sSigMult);
1948    Lp.sig    = pSigMult;
1949    Lp.sevSig = ~pSigMultNegSev;
1950  }
1951  else
1952  {
1953    // pSig < sSig
1954    pDelete (&pSigMult);
1955    Lp.sig    = sSigMult;
1956    Lp.sevSig = ~sSigMultNegSev;
1957  }
1958  if (Lp.p == NULL)
1959  {
1960    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
1961    int pos = posInSyz(strat, Lp.sig);
1962    enterSyz(Lp, strat, pos);
1963  }
1964  else
1965  {
1966    // testing by rewCrit3 = Arris Rewritten Criterion (for F5 nothing happens!)
1967    if (strat->rewCrit3(Lp.sig,~Lp.sevSig,Lp.p,strat,strat->sl+1)) {
1968      pLmFree(Lp.lcm);
1969      pDelete(&Lp.sig);
1970      Lp.lcm=NULL;
1971      pDelete (&m1);
1972      pDelete (&m2);
1973      return;
1974    }
1975    // in any case Lp is checked up to the next strat->P which is added
1976    // to S right after this critical pair creation.
1977    // NOTE: this even holds if the 2nd generator gives the bigger signature
1978    //       moreover, this improves rewCriterion,
1979    //       i.e. strat->checked > strat->from if and only if the 2nd generator
1980    //       gives the bigger signature.
1981    Lp.checked = strat->sl+1;
1982    // at this point it is clear that the pair will be added to L, since it has
1983    // passed all tests up to now
1984
1985  // adds buchberger's first criterion
1986    if (pLmCmp(m2,pHead(p)) == 0) {
1987      Lp.prod_crit = TRUE; // Product Criterion
1988#if 0
1989      int pos = posInSyz(strat, Lp.sig);
1990      enterSyz(Lp, strat, pos);
1991      Lp.lcm=NULL;
1992      pDelete (&m1);
1993      pDelete (&m2);
1994      return;
1995#endif
1996    }
1997    pDelete (&m1);
1998    pDelete (&m2);
1999#if DEBUGF5
2000    printf("SIGNATURE OF PAIR:  ");
2001    pWrite(Lp.sig);
2002#endif
2003    /*- the pair (S[i],p) enters B -*/
2004    Lp.p1 = strat->S[i];
2005    Lp.p2 = p;
2006
2007    if (
2008        (!rIsPluralRing(currRing))
2009//      ||  (rIsPluralRing(currRing) && (ncRingType(currRing) != nc_lie))
2010       )
2011    {
2012      assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
2013      pNext(Lp.p) = strat->tail; // !!!
2014    }
2015
2016    if (atR >= 0)
2017    {
2018      Lp.i_r1 = strat->S_2_R[i];
2019      Lp.i_r2 = atR;
2020    }
2021    else
2022    {
2023      Lp.i_r1 = -1;
2024      Lp.i_r2 = -1;
2025    }
2026    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
2027
2028    if (TEST_OPT_INTSTRATEGY)
2029    {
2030      if (!rIsPluralRing(currRing))
2031        nDelete(&(Lp.p->coef));
2032    }
2033
2034    l = strat->posInLSba(strat->B,strat->Bl,&Lp,strat);
2035    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
2036  }
2037}
2038
2039/*2
2040* put the pair (s[i],p) into the set L, ecart=ecart(p)
2041* in the case that s forms a SB of (s)
2042*/
2043void enterOnePairSpecial (int i,poly p,int ecart,kStrategy strat, int atR = -1)
2044{
2045  //PrintS("try ");wrp(strat->S[i]);PrintS(" and ");wrp(p);PrintLn();
2046  if(pHasNotCF(p,strat->S[i]))
2047  {
2048    //PrintS("prod-crit\n");
2049    if(ALLOW_PROD_CRIT(strat))
2050    {
2051      //PrintS("prod-crit\n");
2052      strat->cp++;
2053      return;
2054    }
2055  }
2056
2057  int      l,j,compare;
2058  LObject  Lp;
2059  Lp.i_r = -1;
2060
2061  Lp.lcm = pInit();
2062  pLcm(p,strat->S[i],Lp.lcm);
2063  pSetm(Lp.lcm);
2064  for(j = strat->Ll;j>=0;j--)
2065  {
2066    compare=pDivComp(strat->L[j].lcm,Lp.lcm);
2067    if ((compare==1) || (pLmEqual(strat->L[j].lcm,Lp.lcm)))
2068    {
2069      //PrintS("c3-crit\n");
2070      strat->c3++;
2071      pLmFree(Lp.lcm);
2072      return;
2073    }
2074    else if (compare ==-1)
2075    {
2076      //Print("c3-crit with L[%d]\n",j);
2077      deleteInL(strat->L,&strat->Ll,j,strat);
2078      strat->c3++;
2079    }
2080  }
2081  /*-  compute the short s-polynomial -*/
2082
2083  #ifdef HAVE_PLURAL
2084  if (rIsPluralRing(currRing))
2085  {
2086    Lp.p = nc_CreateShortSpoly(strat->S[i],p, currRing); // ??? strat->tailRing?
2087  }
2088  else
2089  #endif
2090    Lp.p = ksCreateShortSpoly(strat->S[i],p,strat->tailRing);
2091
2092  if (Lp.p == NULL)
2093  {
2094     //PrintS("short spoly==NULL\n");
2095     pLmFree(Lp.lcm);
2096  }
2097  else
2098  {
2099    /*- the pair (S[i],p) enters L -*/
2100    Lp.p1 = strat->S[i];
2101    Lp.p2 = p;
2102    if (atR >= 0)
2103    {
2104      Lp.i_r1 = strat->S_2_R[i];
2105      Lp.i_r2 = atR;
2106    }
2107    else
2108    {
2109      Lp.i_r1 = -1;
2110      Lp.i_r2 = -1;
2111    }
2112    assume(pNext(Lp.p) == NULL);
2113    pNext(Lp.p) = strat->tail;
2114    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
2115    if (TEST_OPT_INTSTRATEGY)
2116    {
2117      nDelete(&(Lp.p->coef));
2118    }
2119    l = strat->posInL(strat->L,strat->Ll,&Lp,strat);
2120    //Print("-> L[%d]\n",l);
2121    enterL(&strat->L,&strat->Ll,&strat->Lmax,Lp,l);
2122  }
2123}
2124
2125/*2
2126* merge set B into L
2127*/
2128void kMergeBintoL(kStrategy strat)
2129{
2130  int j=strat->Ll+strat->Bl+1;
2131  if (j>strat->Lmax)
2132  {
2133    j=((j+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
2134    strat->L = (LSet)omReallocSize(strat->L,strat->Lmax*sizeof(LObject),
2135                                 j*sizeof(LObject));
2136    strat->Lmax=j;
2137  }
2138  j = strat->Ll;
2139  int i;
2140  for (i=strat->Bl; i>=0; i--)
2141  {
2142    j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
2143    enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
2144  }
2145  strat->Bl = -1;
2146}
2147
2148/*2
2149* merge set B into L
2150*/
2151void kMergeBintoLSba(kStrategy strat)
2152{
2153  int j=strat->Ll+strat->Bl+1;
2154  if (j>strat->Lmax)
2155  {
2156    j=((j+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
2157    strat->L = (LSet)omReallocSize(strat->L,strat->Lmax*sizeof(LObject),
2158                                 j*sizeof(LObject));
2159    strat->Lmax=j;
2160  }
2161  j = strat->Ll;
2162  int i;
2163  for (i=strat->Bl; i>=0; i--)
2164  {
2165    j = strat->posInLSba(strat->L,j,&(strat->B[i]),strat);
2166    enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
2167  }
2168  strat->Bl = -1;
2169}
2170/*2
2171*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
2172*using the chain-criterion in B and L and enters B to L
2173*/
2174void chainCritNormal (poly p,int ecart,kStrategy strat)
2175{
2176  int i,j,l;
2177
2178  /*
2179  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
2180  *In this case all elements in B such
2181  *that their lcm is divisible by the leading term of S[i] can be canceled
2182  */
2183  if (strat->pairtest!=NULL)
2184  {
2185    {
2186      /*- i.e. there is an i with pairtest[i]==TRUE -*/
2187      for (j=0; j<=strat->sl; j++)
2188      {
2189        if (strat->pairtest[j])
2190        {
2191          for (i=strat->Bl; i>=0; i--)
2192          {
2193            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
2194            {
2195              deleteInL(strat->B,&strat->Bl,i,strat);
2196              strat->c3++;
2197            }
2198          }
2199        }
2200      }
2201    }
2202    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
2203    strat->pairtest=NULL;
2204  }
2205  if (strat->Gebauer || strat->fromT)
2206  {
2207    if (strat->sugarCrit)
2208    {
2209    /*
2210    *suppose L[j] == (s,r) and p/lcm(s,r)
2211    *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
2212    *and in case the sugar is o.k. then L[j] can be canceled
2213    */
2214      for (j=strat->Ll; j>=0; j--)
2215      {
2216        if (sugarDivisibleBy(ecart,strat->L[j].ecart)
2217        && ((pNext(strat->L[j].p) == strat->tail) || (currRing->OrdSgn==1))
2218        && pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2219        {
2220          if (strat->L[j].p == strat->tail)
2221          {
2222              deleteInL(strat->L,&strat->Ll,j,strat);
2223              strat->c3++;
2224          }
2225        }
2226      }
2227      /*
2228      *this is GEBAUER-MOELLER:
2229      *in B all elements with the same lcm except the "best"
2230      *(i.e. the last one in B with this property) will be canceled
2231      */
2232      j = strat->Bl;
2233      loop /*cannot be changed into a for !!! */
2234      {
2235        if (j <= 0) break;
2236        i = j-1;
2237        loop
2238        {
2239          if (i <  0) break;
2240          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
2241          {
2242            strat->c3++;
2243            if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
2244            {
2245              deleteInL(strat->B,&strat->Bl,i,strat);
2246              j--;
2247            }
2248            else
2249            {
2250              deleteInL(strat->B,&strat->Bl,j,strat);
2251              break;
2252            }
2253          }
2254          i--;
2255        }
2256        j--;
2257      }
2258    }
2259    else /*sugarCrit*/
2260    {
2261      /*
2262      *suppose L[j] == (s,r) and p/lcm(s,r)
2263      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
2264      *and in case the sugar is o.k. then L[j] can be canceled
2265      */
2266      for (j=strat->Ll; j>=0; j--)
2267      {
2268        if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2269        {
2270          if ((pNext(strat->L[j].p) == strat->tail)||(currRing->OrdSgn==1))
2271          {
2272            deleteInL(strat->L,&strat->Ll,j,strat);
2273            strat->c3++;
2274          }
2275        }
2276      }
2277      /*
2278      *this is GEBAUER-MOELLER:
2279      *in B all elements with the same lcm except the "best"
2280      *(i.e. the last one in B with this property) will be canceled
2281      */
2282      j = strat->Bl;
2283      loop   /*cannot be changed into a for !!! */
2284      {
2285        if (j <= 0) break;
2286        for(i=j-1; i>=0; i--)
2287        {
2288          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
2289          {
2290            strat->c3++;
2291            deleteInL(strat->B,&strat->Bl,i,strat);
2292            j--;
2293          }
2294        }
2295        j--;
2296      }
2297    }
2298    /*
2299    *the elements of B enter L
2300    */
2301    kMergeBintoL(strat);
2302  }
2303  else
2304  {
2305    for (j=strat->Ll; j>=0; j--)
2306    {
2307      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2308      {
2309        if ((pNext(strat->L[j].p) == strat->tail)||(currRing->OrdSgn==1))
2310        {
2311          deleteInL(strat->L,&strat->Ll,j,strat);
2312          strat->c3++;
2313        }
2314      }
2315    }
2316    /*
2317    *this is our MODIFICATION of GEBAUER-MOELLER:
2318    *First the elements of B enter L,
2319    *then we fix a lcm and the "best" element in L
2320    *(i.e the last in L with this lcm and of type (s,p))
2321    *and cancel all the other elements of type (r,p) with this lcm
2322    *except the case the element (s,r) has also the same lcm
2323    *and is on the worst position with respect to (s,p) and (r,p)
2324    */
2325    /*
2326    *B enters to L/their order with respect to B is permutated for elements
2327    *B[i].p with the same leading term
2328    */
2329    kMergeBintoL(strat);
2330    j = strat->Ll;
2331    loop  /*cannot be changed into a for !!! */
2332    {
2333      if (j <= 0)
2334      {
2335        /*now L[0] cannot be canceled any more and the tail can be removed*/
2336        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2337        break;
2338      }
2339      if (strat->L[j].p2 == p)
2340      {
2341        i = j-1;
2342        loop
2343        {
2344          if (i < 0)  break;
2345          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2346          {
2347            /*L[i] could be canceled but we search for a better one to cancel*/
2348            strat->c3++;
2349            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2350            && (pNext(strat->L[l].p) == strat->tail)
2351            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2352            && pDivisibleBy(p,strat->L[l].lcm))
2353            {
2354              /*
2355              *"NOT equal(...)" because in case of "equal" the element L[l]
2356              *is "older" and has to be from theoretical point of view behind
2357              *L[i], but we do not want to reorder L
2358              */
2359              strat->L[i].p2 = strat->tail;
2360              /*
2361              *L[l] will be canceled, we cannot cancel L[i] later on,
2362              *so we mark it with "tail"
2363              */
2364              deleteInL(strat->L,&strat->Ll,l,strat);
2365              i--;
2366            }
2367            else
2368            {
2369              deleteInL(strat->L,&strat->Ll,i,strat);
2370            }
2371            j--;
2372          }
2373          i--;
2374        }
2375      }
2376      else if (strat->L[j].p2 == strat->tail)
2377      {
2378        /*now L[j] cannot be canceled any more and the tail can be removed*/
2379        strat->L[j].p2 = p;
2380      }
2381      j--;
2382    }
2383  }
2384}
2385/*2
2386*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
2387*using the chain-criterion in B and L and enters B to L
2388*/
2389void chainCritSig (poly p,int /*ecart*/,kStrategy strat)
2390{
2391  int i,j,l;
2392  kMergeBintoLSba(strat);
2393  j = strat->Ll;
2394  loop  /*cannot be changed into a for !!! */
2395  {
2396    if (j <= 0)
2397    {
2398      /*now L[0] cannot be canceled any more and the tail can be removed*/
2399      if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2400      break;
2401    }
2402    if (strat->L[j].p2 == p)
2403    {
2404      i = j-1;
2405      loop
2406      {
2407        if (i < 0)  break;
2408        if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2409        {
2410          /*L[i] could be canceled but we search for a better one to cancel*/
2411          strat->c3++;
2412          if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2413              && (pNext(strat->L[l].p) == strat->tail)
2414              && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2415              && pDivisibleBy(p,strat->L[l].lcm))
2416          {
2417            /*
2418             *"NOT equal(...)" because in case of "equal" the element L[l]
2419             *is "older" and has to be from theoretical point of view behind
2420             *L[i], but we do not want to reorder L
2421             */
2422            strat->L[i].p2 = strat->tail;
2423            /*
2424             *L[l] will be canceled, we cannot cancel L[i] later on,
2425             *so we mark it with "tail"
2426             */
2427            deleteInL(strat->L,&strat->Ll,l,strat);
2428            i--;
2429          }
2430          else
2431          {
2432            deleteInL(strat->L,&strat->Ll,i,strat);
2433          }
2434          j--;
2435        }
2436        i--;
2437      }
2438    }
2439    else if (strat->L[j].p2 == strat->tail)
2440    {
2441      /*now L[j] cannot be canceled any more and the tail can be removed*/
2442      strat->L[j].p2 = p;
2443    }
2444    j--;
2445  }
2446}
2447#ifdef HAVE_RATGRING
2448void chainCritPart (poly p,int ecart,kStrategy strat)
2449{
2450  int i,j,l;
2451
2452  /*
2453  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
2454  *In this case all elements in B such
2455  *that their lcm is divisible by the leading term of S[i] can be canceled
2456  */
2457  if (strat->pairtest!=NULL)
2458  {
2459    {
2460      /*- i.e. there is an i with pairtest[i]==TRUE -*/
2461      for (j=0; j<=strat->sl; j++)
2462      {
2463        if (strat->pairtest[j])
2464        {
2465          for (i=strat->Bl; i>=0; i--)
2466          {
2467            if (_p_LmDivisibleByPart(strat->S[j],currRing,
2468               strat->B[i].lcm,currRing,
2469               currRing->real_var_start,currRing->real_var_end))
2470            {
2471              if(TEST_OPT_DEBUG)
2472              {
2473                 Print("chain-crit-part: S[%d]=",j);
2474                 p_wrp(strat->S[j],currRing);
2475                 Print(" divide B[%d].lcm=",i);
2476                 p_wrp(strat->B[i].lcm,currRing);
2477                 PrintLn();
2478              }
2479              deleteInL(strat->B,&strat->Bl,i,strat);
2480              strat->c3++;
2481            }
2482          }
2483        }
2484      }
2485    }
2486    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
2487    strat->pairtest=NULL;
2488  }
2489  if (strat->Gebauer || strat->fromT)
2490  {
2491    if (strat->sugarCrit)
2492    {
2493    /*
2494    *suppose L[j] == (s,r) and p/lcm(s,r)
2495    *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
2496    *and in case the sugar is o.k. then L[j] can be canceled
2497    */
2498      for (j=strat->Ll; j>=0; j--)
2499      {
2500        if (sugarDivisibleBy(ecart,strat->L[j].ecart)
2501        && ((pNext(strat->L[j].p) == strat->tail) || (currRing->OrdSgn==1))
2502        && pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2503        {
2504          if (strat->L[j].p == strat->tail)
2505          {
2506              if(TEST_OPT_DEBUG)
2507              {
2508                 PrintS("chain-crit-part: pCompareChainPart p=");
2509                 p_wrp(p,currRing);
2510                 Print(" delete L[%d]",j);
2511                 p_wrp(strat->L[j].lcm,currRing);
2512                 PrintLn();
2513              }
2514              deleteInL(strat->L,&strat->Ll,j,strat);
2515              strat->c3++;
2516          }
2517        }
2518      }
2519      /*
2520      *this is GEBAUER-MOELLER:
2521      *in B all elements with the same lcm except the "best"
2522      *(i.e. the last one in B with this property) will be canceled
2523      */
2524      j = strat->Bl;
2525      loop /*cannot be changed into a for !!! */
2526      {
2527        if (j <= 0) break;
2528        i = j-1;
2529        loop
2530        {
2531          if (i <  0) break;
2532          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
2533          {
2534            strat->c3++;
2535            if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
2536            {
2537              if(TEST_OPT_DEBUG)
2538              {
2539                 Print("chain-crit-part: sugar B[%d].lcm=",j);
2540                 p_wrp(strat->B[j].lcm,currRing);
2541                 Print(" delete B[%d]",i);
2542                 p_wrp(strat->B[i].lcm,currRing);
2543                 PrintLn();
2544              }
2545              deleteInL(strat->B,&strat->Bl,i,strat);
2546              j--;
2547            }
2548            else
2549            {
2550              if(TEST_OPT_DEBUG)
2551              {
2552                 Print("chain-crit-part: sugar B[%d].lcm=",i);
2553                 p_wrp(strat->B[i].lcm,currRing);
2554                 Print(" delete B[%d]",j);
2555                 p_wrp(strat->B[j].lcm,currRing);
2556                 PrintLn();
2557              }
2558              deleteInL(strat->B,&strat->Bl,j,strat);
2559              break;
2560            }
2561          }
2562          i--;
2563        }
2564        j--;
2565      }
2566    }
2567    else /*sugarCrit*/
2568    {
2569      /*
2570      *suppose L[j] == (s,r) and p/lcm(s,r)
2571      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
2572      *and in case the sugar is o.k. then L[j] can be canceled
2573      */
2574      for (j=strat->Ll; j>=0; j--)
2575      {
2576        if (pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2577        {
2578          if ((pNext(strat->L[j].p) == strat->tail)||(currRing->OrdSgn==1))
2579          {
2580              if(TEST_OPT_DEBUG)
2581              {
2582                 PrintS("chain-crit-part: sugar:pCompareChainPart p=");
2583                 p_wrp(p,currRing);
2584                 Print(" delete L[%d]",j);
2585                 p_wrp(strat->L[j].lcm,currRing);
2586                 PrintLn();
2587              }
2588            deleteInL(strat->L,&strat->Ll,j,strat);
2589            strat->c3++;
2590          }
2591        }
2592      }
2593      /*
2594      *this is GEBAUER-MOELLER:
2595      *in B all elements with the same lcm except the "best"
2596      *(i.e. the last one in B with this property) will be canceled
2597      */
2598      j = strat->Bl;
2599      loop   /*cannot be changed into a for !!! */
2600      {
2601        if (j <= 0) break;
2602        for(i=j-1; i>=0; i--)
2603        {
2604          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
2605          {
2606              if(TEST_OPT_DEBUG)
2607              {
2608                 Print("chain-crit-part: equal lcm B[%d].lcm=",j);
2609                 p_wrp(strat->B[j].lcm,currRing);
2610                 Print(" delete B[%d]\n",i);
2611              }
2612            strat->c3++;
2613            deleteInL(strat->B,&strat->Bl,i,strat);
2614            j--;
2615          }
2616        }
2617        j--;
2618      }
2619    }
2620    /*
2621    *the elements of B enter L
2622    */
2623    kMergeBintoL(strat);
2624  }
2625  else
2626  {
2627    for (j=strat->Ll; j>=0; j--)
2628    {
2629      if (pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2630      {
2631        if ((pNext(strat->L[j].p) == strat->tail)||(currRing->OrdSgn==1))
2632        {
2633              if(TEST_OPT_DEBUG)
2634              {
2635                 PrintS("chain-crit-part: pCompareChainPart p=");
2636                 p_wrp(p,currRing);
2637                 Print(" delete L[%d]",j);
2638                 p_wrp(strat->L[j].lcm,currRing);
2639                 PrintLn();
2640              }
2641          deleteInL(strat->L,&strat->Ll,j,strat);
2642          strat->c3++;
2643        }
2644      }
2645    }
2646    /*
2647    *this is our MODIFICATION of GEBAUER-MOELLER:
2648    *First the elements of B enter L,
2649    *then we fix a lcm and the "best" element in L
2650    *(i.e the last in L with this lcm and of type (s,p))
2651    *and cancel all the other elements of type (r,p) with this lcm
2652    *except the case the element (s,r) has also the same lcm
2653    *and is on the worst position with respect to (s,p) and (r,p)
2654    */
2655    /*
2656    *B enters to L/their order with respect to B is permutated for elements
2657    *B[i].p with the same leading term
2658    */
2659    kMergeBintoL(strat);
2660    j = strat->Ll;
2661    loop  /*cannot be changed into a for !!! */
2662    {
2663      if (j <= 0)
2664      {
2665        /*now L[0] cannot be canceled any more and the tail can be removed*/
2666        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2667        break;
2668      }
2669      if (strat->L[j].p2 == p)
2670      {
2671        i = j-1;
2672        loop
2673        {
2674          if (i < 0)  break;
2675          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2676          {
2677            /*L[i] could be canceled but we search for a better one to cancel*/
2678            strat->c3++;
2679            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2680            && (pNext(strat->L[l].p) == strat->tail)
2681            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2682            && _p_LmDivisibleByPart(p,currRing,
2683                           strat->L[l].lcm,currRing,
2684                           currRing->real_var_start, currRing->real_var_end))
2685
2686            {
2687              /*
2688              *"NOT equal(...)" because in case of "equal" the element L[l]
2689              *is "older" and has to be from theoretical point of view behind
2690              *L[i], but we do not want to reorder L
2691              */
2692              strat->L[i].p2 = strat->tail;
2693              /*
2694              *L[l] will be canceled, we cannot cancel L[i] later on,
2695              *so we mark it with "tail"
2696              */
2697              if(TEST_OPT_DEBUG)
2698              {
2699                 PrintS("chain-crit-part: divisible_by p=");
2700                 p_wrp(p,currRing);
2701                 Print(" delete L[%d]",l);
2702                 p_wrp(strat->L[l].lcm,currRing);
2703                 PrintLn();
2704              }
2705              deleteInL(strat->L,&strat->Ll,l,strat);
2706              i--;
2707            }
2708            else
2709            {
2710              if(TEST_OPT_DEBUG)
2711              {
2712                 PrintS("chain-crit-part: divisible_by(2) p=");
2713                 p_wrp(p,currRing);
2714                 Print(" delete L[%d]",i);
2715                 p_wrp(strat->L[i].lcm,currRing);
2716                 PrintLn();
2717              }
2718              deleteInL(strat->L,&strat->Ll,i,strat);
2719            }
2720            j--;
2721          }
2722          i--;
2723        }
2724      }
2725      else if (strat->L[j].p2 == strat->tail)
2726      {
2727        /*now L[j] cannot be canceled any more and the tail can be removed*/
2728        strat->L[j].p2 = p;
2729      }
2730      j--;
2731    }
2732  }
2733}
2734#endif
2735
2736/*2
2737*(s[0],h),...,(s[k],h) will be put to the pairset L
2738*/
2739void initenterpairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2740{
2741
2742  if ((strat->syzComp==0)
2743  || (pGetComp(h)<=strat->syzComp))
2744  {
2745    int j;
2746    BOOLEAN new_pair=FALSE;
2747
2748    if (pGetComp(h)==0)
2749    {
2750      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
2751      if ((isFromQ)&&(strat->fromQ!=NULL))
2752      {
2753        for (j=0; j<=k; j++)
2754        {
2755          if (!strat->fromQ[j])
2756          {
2757            new_pair=TRUE;
2758            strat->enterOnePair(j,h,ecart,isFromQ,strat, atR);
2759          //Print("j:%d, Ll:%d\n",j,strat->Ll);
2760          }
2761        }
2762      }
2763      else
2764      {
2765        new_pair=TRUE;
2766        for (j=0; j<=k; j++)
2767        {
2768        #if ADIDEBUG
2769        PrintS("\n initenterpairs: \n");
2770        PrintS("                ");p_Write(h, strat->tailRing);
2771        PrintS("                ");p_Write(strat->S[j],strat->tailRing);
2772        #endif
2773          strat->enterOnePair(j,h,ecart,isFromQ,strat, atR);
2774          //Print("j:%d, Ll:%d\n",j,strat->Ll);
2775        }
2776      }
2777    }
2778    else
2779    {
2780      for (j=0; j<=k; j++)
2781      {
2782        if ((pGetComp(h)==pGetComp(strat->S[j]))
2783        || (pGetComp(strat->S[j])==0))
2784        {
2785          new_pair=TRUE;
2786          strat->enterOnePair(j,h,ecart,isFromQ,strat, atR);
2787        //Print("j:%d, Ll:%d\n",j,strat->Ll);
2788        }
2789      }
2790    }
2791
2792    if (new_pair)
2793    {
2794#ifdef HAVE_RATGRING
2795      if (currRing->real_var_start>0)
2796        chainCritPart(h,ecart,strat);
2797      else
2798#endif
2799      strat->chainCrit(h,ecart,strat);
2800    }
2801  }
2802}
2803
2804/*2
2805*(s[0],h),...,(s[k],h) will be put to the pairset L
2806*using signatures <= only for signature-based standard basis algorithms
2807*/
2808void initenterpairsSig (poly h,poly hSig,int hFrom,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2809{
2810
2811  if ((strat->syzComp==0)
2812  || (pGetComp(h)<=strat->syzComp))
2813  {
2814    int j;
2815    BOOLEAN new_pair=FALSE;
2816
2817    if (pGetComp(h)==0)
2818    {
2819      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
2820      if ((isFromQ)&&(strat->fromQ!=NULL))
2821      {
2822        for (j=0; j<=k; j++)
2823        {
2824          if (!strat->fromQ[j])
2825          {
2826            new_pair=TRUE;
2827            enterOnePairSig(j,h,hSig,hFrom,ecart,isFromQ,strat, atR);
2828          //Print("j:%d, Ll:%d\n",j,strat->Ll);
2829          }
2830        }
2831      }
2832      else
2833      {
2834        new_pair=TRUE;
2835        for (j=0; j<=k; j++)
2836        {
2837          enterOnePairSig(j,h,hSig,hFrom,ecart,isFromQ,strat, atR);
2838          //Print("j:%d, Ll:%d\n",j,strat->Ll);
2839        }
2840      }
2841    }
2842    else
2843    {
2844      for (j=0; j<=k; j++)
2845      {
2846        if ((pGetComp(h)==pGetComp(strat->S[j]))
2847        || (pGetComp(strat->S[j])==0))
2848        {
2849          new_pair=TRUE;
2850          enterOnePairSig(j,h,hSig,hFrom,ecart,isFromQ,strat, atR);
2851        //Print("j:%d, Ll:%d\n",j,strat->Ll);
2852        }
2853      }
2854    }
2855
2856    if (new_pair)
2857    {
2858#ifdef HAVE_RATGRING
2859      if (currRing->real_var_start>0)
2860        chainCritPart(h,ecart,strat);
2861      else
2862#endif
2863      strat->chainCrit(h,ecart,strat);
2864    }
2865  }
2866}
2867
2868#ifdef HAVE_RINGS
2869/*2
2870*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
2871*using the chain-criterion in B and L and enters B to L
2872*/
2873void chainCritRing (poly p,int, kStrategy strat)
2874{
2875  int i,j,l;
2876  /*
2877  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
2878  *In this case all elements in B such
2879  *that their lcm is divisible by the leading term of S[i] can be canceled
2880  */
2881  if (strat->pairtest!=NULL)
2882  {
2883    {
2884      /*- i.e. there is an i with pairtest[i]==TRUE -*/
2885      for (j=0; j<=strat->sl; j++)
2886      {
2887        if (strat->pairtest[j])
2888        {
2889          for (i=strat->Bl; i>=0; i--)
2890          {
2891            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
2892            {
2893#ifdef KDEBUG
2894              if (TEST_OPT_DEBUG)
2895              {
2896                PrintS("--- chain criterion func chainCritRing type 1\n");
2897                PrintS("strat->S[j]:");
2898                wrp(strat->S[j]);
2899                PrintS("  strat->B[i].lcm:");
2900                wrp(strat->B[i].lcm);
2901                PrintLn();
2902              }
2903#endif
2904              deleteInL(strat->B,&strat->Bl,i,strat);
2905              strat->c3++;
2906            }
2907          }
2908        }
2909      }
2910    }
2911    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
2912    strat->pairtest=NULL;
2913  }
2914  assume(!(strat->Gebauer || strat->fromT));
2915  for (j=strat->Ll; j>=0; j--)
2916  {
2917    if ((strat->L[j].lcm != NULL) && n_DivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(p), currRing->cf))
2918    {
2919      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2920      {
2921        if ((pNext(strat->L[j].p) == strat->tail) || (currRing->OrdSgn==1))
2922        {
2923          deleteInL(strat->L,&strat->Ll,j,strat);
2924          strat->c3++;
2925#ifdef KDEBUG
2926              if (TEST_OPT_DEBUG)
2927              {
2928                PrintS("--- chain criterion func chainCritRing type 2\n");
2929                PrintS("strat->L[j].p:");
2930                wrp(strat->L[j].p);
2931                PrintS("  p:");
2932                wrp(p);
2933                PrintLn();
2934              }
2935#endif
2936        }
2937      }
2938    }
2939  }
2940  /*
2941  *this is our MODIFICATION of GEBAUER-MOELLER:
2942  *First the elements of B enter L,
2943  *then we fix a lcm and the "best" element in L
2944  *(i.e the last in L with this lcm and of type (s,p))
2945  *and cancel all the other elements of type (r,p) with this lcm
2946  *except the case the element (s,r) has also the same lcm
2947  *and is on the worst position with respect to (s,p) and (r,p)
2948  */
2949  /*
2950  *B enters to L/their order with respect to B is permutated for elements
2951  *B[i].p with the same leading term
2952  */
2953  kMergeBintoL(strat);
2954  j = strat->Ll;
2955  loop  /*cannot be changed into a for !!! */
2956  {
2957    if (j <= 0)
2958    {
2959      /*now L[0] cannot be canceled any more and the tail can be removed*/
2960      if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2961      break;
2962    }
2963    if (strat->L[j].p2 == p) // Was the element added from B?
2964    {
2965      i = j-1;
2966      loop
2967      {
2968        if (i < 0)  break;
2969        // Element is from B and has the same lcm as L[j]
2970        if ((strat->L[i].p2 == p) && n_DivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(strat->L[i].lcm), currRing->cf)
2971             && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2972        {
2973          /*L[i] could be canceled but we search for a better one to cancel*/
2974          strat->c3++;
2975#ifdef KDEBUG
2976          if (TEST_OPT_DEBUG)
2977          {
2978            PrintS("--- chain criterion func chainCritRing type 3\n");
2979            PrintS("strat->L[j].lcm:");
2980            wrp(strat->L[j].lcm);
2981            PrintS("  strat->L[i].lcm:");
2982            wrp(strat->L[i].lcm);
2983            PrintLn();
2984          }
2985#endif
2986          if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2987          && (pNext(strat->L[l].p) == strat->tail)
2988          && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2989          && pDivisibleBy(p,strat->L[l].lcm))
2990          {
2991            /*
2992            *"NOT equal(...)" because in case of "equal" the element L[l]
2993            *is "older" and has to be from theoretical point of view behind
2994            *L[i], but we do not want to reorder L
2995            */
2996            strat->L[i].p2 = strat->tail;
2997            /*
2998            *L[l] will be canceled, we cannot cancel L[i] later on,
2999            *so we mark it with "tail"
3000            */
3001            deleteInL(strat->L,&strat->Ll,l,strat);
3002            i--;
3003          }
3004          else
3005          {
3006            deleteInL(strat->L,&strat->Ll,i,strat);
3007          }
3008          j--;
3009        }
3010        i--;
3011      }
3012    }
3013    else if (strat->L[j].p2 == strat->tail)
3014    {
3015      /*now L[j] cannot be canceled any more and the tail can be removed*/
3016      strat->L[j].p2 = p;
3017    }
3018    j--;
3019  }
3020}
3021#endif
3022
3023#ifdef HAVE_RINGS
3024long ind2(long arg)
3025{
3026  long ind = 0;
3027  if (arg <= 0) return 0;
3028  while (arg%2 == 0)
3029  {
3030    arg = arg / 2;
3031    ind++;
3032  }
3033  return ind;
3034}
3035
3036long ind_fact_2(long arg)
3037{
3038  long ind = 0;
3039  if (arg <= 0) return 0;
3040  if (arg%2 == 1) { arg--; }
3041  while (arg > 0)
3042  {
3043    ind += ind2(arg);
3044    arg = arg - 2;
3045  }
3046  return ind;
3047}
3048#endif
3049
3050#ifdef HAVE_VANIDEAL
3051long twoPow(long arg)
3052{
3053  return 1L << arg;
3054}
3055
3056/*2
3057* put the pair (p, f) in B and f in T
3058*/
3059void enterOneZeroPairRing (poly f, poly t_p, poly p, int ecart, kStrategy strat, int atR = -1)
3060{
3061  int      l,j,compare,compareCoeff;
3062  LObject  Lp;
3063
3064  if (strat->interred_flag) return;
3065#ifdef KDEBUG
3066  Lp.ecart=0; Lp.length=0;
3067#endif
3068  /*- computes the lcm(s[i],p) -*/
3069  Lp.lcm = pInit();
3070
3071  pLcm(p,f,Lp.lcm);
3072  pSetm(Lp.lcm);
3073  pSetCoeff(Lp.lcm, nLcm(pGetCoeff(p), pGetCoeff(f), currRing));
3074  assume(!strat->sugarCrit);
3075  assume(!strat->fromT);
3076  /*
3077  *the set B collects the pairs of type (S[j],p)
3078  *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
3079  *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
3080  *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
3081  */
3082  for(j = strat->Bl;j>=0;j--)
3083  {
3084    compare=pDivCompRing(strat->B[j].lcm,Lp.lcm);
3085    compareCoeff = nDivComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(Lp.lcm));
3086    if (compareCoeff == 0 || compare == compareCoeff)
3087    {
3088      if (compare == 1)
3089      {
3090        strat->c3++;
3091        pLmDelete(Lp.lcm);
3092        return;
3093      }
3094      else
3095      if (compare == -1)
3096      {
3097        deleteInL(strat->B,&strat->Bl,j,strat);
3098        strat->c3++;
3099      }
3100    }
3101    if (compare == pDivComp_EQUAL)
3102    {
3103      // Add hint for same LM and direction of LC (later) (TODO Oliver)
3104      if (compareCoeff == 1)
3105      {
3106        strat->c3++;
3107        pLmDelete(Lp.lcm);
3108        return;
3109      }
3110      else
3111      if (compareCoeff == -1)
3112      {
3113        deleteInL(strat->B,&strat->Bl,j,strat);
3114        strat->c3++;
3115      }
3116    }
3117  }
3118  /*
3119  *the pair (S[i],p) enters B if the spoly != 0
3120  */
3121  /*-  compute the short s-polynomial -*/
3122  if ((f==NULL) || (p==NULL)) return;
3123  pNorm(p);
3124  {
3125    Lp.p = ksCreateShortSpoly(f, p, strat->tailRing);
3126  }
3127  if (Lp.p == NULL) //deactivated, as we are adding pairs with zeropoly and not from S
3128  {
3129    /*- the case that the s-poly is 0 -*/
3130//    if (strat->pairtest==NULL) initPairtest(strat);
3131//    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
3132//    strat->pairtest[strat->sl+1] = TRUE;
3133    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
3134    /*
3135    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
3136    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
3137    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
3138    *term of p devides the lcm(s,r)
3139    *(this canceling should be done here because
3140    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
3141    *the first case is handeled in chainCrit
3142    */
3143    if (Lp.lcm!=NULL) pLmDelete(Lp.lcm);
3144  }
3145  else
3146  {
3147    /*- the pair (S[i],p) enters B -*/
3148    Lp.p1 = f;
3149    Lp.p2 = p;
3150
3151    pNext(Lp.p) = strat->tail;
3152
3153    LObject tmp_h(f, currRing, strat->tailRing);
3154    tmp_h.SetShortExpVector();
3155    strat->initEcart(&tmp_h);
3156    tmp_h.sev = pGetShortExpVector(tmp_h.p);
3157    tmp_h.t_p = t_p;
3158
3159    enterT(tmp_h, strat, strat->tl + 1);
3160
3161    if (atR >= 0)
3162    {
3163      Lp.i_r2 = atR;
3164      Lp.i_r1 = strat->tl;
3165    }
3166
3167    strat->initEcartPair(&Lp,f,p,0/*strat->ecartS[i]*/,ecart);     // Attention: TODO: break ecart
3168    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
3169    enterL(&strat->B, &strat->Bl, &strat->Bmax, Lp, l);
3170  }
3171}
3172
3173/* Helper for kCreateZeroPoly
3174 * enumerating the exponents
3175ring r = 2^2, (a, b, c), lp; ideal G0 = system("createG0"); ideal G = interred(G0); ncols(G0); ncols(G);
3176 */
3177
3178int nextZeroSimplexExponent (long exp[], long ind[], long cexp[], long cind[], long* cabsind, long step[], long bound, long N)
3179/* gives the next exponent from the set H_1 */
3180{
3181  long add = ind2(cexp[1] + 2);
3182  if ((*cabsind < bound) && (*cabsind - step[1] + add < bound))
3183  {
3184    cexp[1] += 2;
3185    cind[1] += add;
3186    *cabsind += add;
3187  }
3188  else
3189  {
3190    // cabsind >= habsind
3191    if (N == 1) return 0;
3192    int i = 1;
3193    while (exp[i] == cexp[i] && i <= N) i++;
3194    cexp[i] = exp[i];
3195    *cabsind -= cind[i];
3196    cind[i] = ind[i];
3197    step[i] = 500000;
3198    *cabsind += cind[i];
3199    // Print("in: %d\n", *cabsind);
3200    i += 1;
3201    if (i > N) return 0;
3202    do
3203    {
3204      step[1] = 500000;
3205      for (int j = i + 1; j <= N; j++)
3206      {
3207        if (step[1] > step[j]) step[1] = step[j];
3208      }
3209      add = ind2(cexp[i] + 2);
3210      if (*cabsind - step[1] + add >= bound)
3211      {
3212        cexp[i] = exp[i];
3213        *cabsind -= cind[i];
3214        cind[i] = ind[i];
3215        *cabsind += cind[i];
3216        step[i] = 500000;
3217        i += 1;
3218        if (i > N) return 0;
3219      }
3220      else step[1] = -1;
3221    } while (step[1] != -1);
3222    step[1] = 500000;
3223    cexp[i] += 2;
3224    cind[i] += add;
3225    *cabsind += add;
3226    if (add < step[i]) step[i] = add;
3227    for (i = 2; i <= N; i++)
3228    {
3229      if (step[1] > step[i]) step[1] = step[i];
3230    }
3231  }
3232  return 1;
3233}
3234
3235/*
3236 * Creates the zero Polynomial on position exp
3237 * long exp[] : exponent of leading term
3238 * cabsind    : total 2-ind of exp (if -1 will be computed)
3239 * poly* t_p  : will hold the LT in tailRing
3240 * leadRing   : ring for the LT
3241 * tailRing   : ring for the tail
3242 */
3243
3244poly kCreateZeroPoly(long exp[], long cabsind, poly* t_p, ring leadRing, ring tailRing)
3245{
3246
3247  poly zeroPoly = NULL;
3248
3249  number tmp1;
3250  poly tmp2, tmp3;
3251
3252  if (cabsind == -1)
3253  {
3254    cabsind = 0;
3255    for (int i = 1; i <= leadRing->N; i++)
3256    {
3257      cabsind += ind_fact_2(exp[i]);
3258    }
3259//    Print("cabsind: %d\n", cabsind);
3260  }
3261  if (cabsind < leadRing->ch)
3262  {
3263    zeroPoly = p_ISet(twoPow(leadRing->ch - cabsind), tailRing);
3264  }
3265  else
3266  {
3267    zeroPoly = p_ISet(1, tailRing);
3268  }
3269  for (int i = 1; i <= leadRing->N; i++)
3270  {
3271    for (long j = 1; j <= exp[i]; j++)
3272    {
3273      tmp1 = nInit(j);
3274      tmp2 = p_ISet(1, tailRing);
3275      p_SetExp(tmp2, i, 1, tailRing);
3276      p_Setm(tmp2, tailRing);
3277      if (nIsZero(tmp1))
3278      { // should nowbe obsolet, test ! TODO OLIVER
3279        zeroPoly = p_Mult_q(zeroPoly, tmp2, tailRing);
3280      }
3281      else
3282      {
3283        tmp3 = p_NSet(nCopy(tmp1), tailRing);
3284        zeroPoly = p_Mult_q(zeroPoly, p_Add_q(tmp3, tmp2, tailRing), tailRing);
3285      }
3286    }
3287  }
3288  tmp2 = p_NSet(nCopy(pGetCoeff(zeroPoly)), leadRing);
3289  for (int i = 1; i <= leadRing->N; i++)
3290  {
3291    pSetExp(tmp2, i, p_GetExp(zeroPoly, i, tailRing));
3292  }
3293  p_Setm(tmp2, leadRing);
3294  *t_p = zeroPoly;
3295  zeroPoly = pNext(zeroPoly);
3296  pNext(*t_p) = NULL;
3297  pNext(tmp2) = zeroPoly;
3298  return tmp2;
3299}
3300
3301// #define OLI_DEBUG
3302
3303/*
3304 * Generate the s-polynomial for the virtual set of zero-polynomials
3305 */
3306
3307void initenterzeropairsRing (poly p, int ecart, kStrategy strat, int atR)
3308{
3309  // Initialize
3310  long exp[50];            // The exponent of \hat{X} (basepoint)
3311  long cexp[50];           // The current exponent for iterating over all
3312  long ind[50];            // The power of 2 in the i-th component of exp
3313  long cind[50];           // analog for cexp
3314  long mult[50];           // How to multiply the elements of G
3315  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
3316  long habsind = 0;        // The abs. index of the coefficient of h
3317  long step[50];           // The last increases
3318  for (int i = 1; i <= currRing->N; i++)
3319  {
3320    exp[i] = p_GetExp(p, i, currRing);
3321    if (exp[i] & 1 != 0)
3322    {
3323      exp[i] = exp[i] - 1;
3324      mult[i] = 1;
3325    }
3326    cexp[i] = exp[i];
3327    ind[i] = ind_fact_2(exp[i]);
3328    cabsind += ind[i];
3329    cind[i] = ind[i];
3330    step[i] = 500000;
3331  }
3332  step[1] = 500000;
3333  habsind = ind2((long) p_GetCoeff(p, currRing));
3334  long bound = currRing->ch - habsind;
3335#ifdef OLI_DEBUG
3336  PrintS("-------------\npoly  :");
3337  wrp(p);
3338  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
3339  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
3340  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
3341  Print("bound : %d\n", bound);
3342  Print("cind  : %d\n", cabsind);
3343#endif
3344  if (cabsind == 0)
3345  {
3346    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
3347    {
3348      return;
3349    }
3350  }
3351  // Now the whole simplex
3352  do
3353  {
3354    // Build s-polynomial
3355    // 2**ind-def * mult * g - exp-def * h
3356    poly t_p;
3357    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, strat->tailRing);
3358#ifdef OLI_DEBUG
3359    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
3360    Print("zPoly : ");
3361    wrp(zeroPoly);
3362    Print("\n");
3363#endif
3364    enterOneZeroPairRing(zeroPoly, t_p, p, ecart, strat, atR);
3365  }
3366  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
3367}
3368
3369/*
3370 * Create the Groebner basis of the vanishing polynomials.
3371 */
3372
3373ideal createG0()
3374{
3375  // Initialize
3376  long exp[50];            // The exponent of \hat{X} (basepoint)
3377  long cexp[50];           // The current exponent for iterating over all
3378  long ind[50];            // The power of 2 in the i-th component of exp
3379  long cind[50];           // analog for cexp
3380  long mult[50];           // How to multiply the elements of G
3381  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
3382  long habsind = 0;        // The abs. index of the coefficient of h
3383  long step[50];           // The last increases
3384  for (int i = 1; i <= currRing->N; i++)
3385  {
3386    exp[i] = 0;
3387    cexp[i] = exp[i];
3388    ind[i] = 0;
3389    step[i] = 500000;
3390    cind[i] = ind[i];
3391  }
3392  long bound = currRing->ch;
3393  step[1] = 500000;
3394#ifdef OLI_DEBUG
3395  PrintS("-------------\npoly  :");
3396//  wrp(p);
3397  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
3398  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
3399  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
3400  Print("bound : %d\n", bound);
3401  Print("cind  : %d\n", cabsind);
3402#endif
3403  if (cabsind == 0)
3404  {
3405    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
3406    {
3407      return idInit(1, 1);
3408    }
3409  }
3410  ideal G0 = idInit(1, 1);
3411  // Now the whole simplex
3412  do
3413  {
3414    // Build s-polynomial
3415    // 2**ind-def * mult * g - exp-def * h
3416    poly t_p;
3417    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, currRing);
3418#ifdef OLI_DEBUG
3419    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
3420    Print("zPoly : ");
3421    wrp(zeroPoly);
3422    Print("\n");
3423#endif
3424    // Add to ideal
3425    pEnlargeSet(&(G0->m), IDELEMS(G0), 1);
3426    IDELEMS(G0) += 1;
3427    G0->m[IDELEMS(G0) - 1] = zeroPoly;
3428  }
3429  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
3430  idSkipZeroes(G0);
3431  return G0;
3432}
3433#endif
3434
3435#ifdef HAVE_RINGS
3436/*2
3437*(s[0],h),...,(s[k],h) will be put to the pairset L
3438*/
3439void initenterstrongPairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
3440{
3441  const unsigned long iCompH = pGetComp(h);
3442  if (!nIsOne(pGetCoeff(h)))
3443  {
3444    int j;
3445
3446    for (j=0; j<=k; j++)
3447    {
3448      // Print("j:%d, Ll:%d\n",j,strat->Ll);
3449//      if (((unsigned long) pGetCoeff(h) % (unsigned long) pGetCoeff(strat->S[j]) != 0) &&
3450//         ((unsigned long) pGetCoeff(strat->S[j]) % (unsigned long) pGetCoeff(h) != 0))
3451      if (((iCompH == pGetComp(strat->S[j]))
3452      || (0 == pGetComp(strat->S[j])))
3453      && ((iCompH<=strat->syzComp)||(strat->syzComp==0)))
3454      {
3455        enterOneStrongPoly(j,h,ecart,isFromQ,strat, atR);
3456      }
3457    }
3458  }
3459/*
3460ring r=256,(x,y,z),dp;
3461ideal I=12xz-133y, 2xy-z;
3462*/
3463
3464}
3465
3466/*2
3467* Generates spoly(0, h) if applicable. Assumes ring in Z/2^n.
3468*/
3469void enterExtendedSpoly(poly h,kStrategy strat)
3470{
3471  if (nIsOne(pGetCoeff(h))) return;
3472  number gcd;
3473  bool go = false;
3474  if (n_DivBy((number) 0, pGetCoeff(h), currRing->cf))
3475  {
3476    gcd = n_Ann(pGetCoeff(h),currRing->cf);
3477    go = true;
3478  }
3479  else
3480    gcd = n_Gcd((number) 0, pGetCoeff(h), strat->tailRing->cf);
3481  if (go || !nIsOne(gcd))
3482  {
3483    poly p = h->next;
3484    if (!go)
3485    {
3486      number tmp = gcd;
3487      gcd = n_Ann(gcd,currRing->cf);
3488      nDelete(&tmp);
3489    }
3490    p_Test(p,strat->tailRing);
3491    p = pp_Mult_nn(p, gcd, strat->tailRing);
3492    nDelete(&gcd);
3493
3494    if (p != NULL)
3495    {
3496      if (TEST_OPT_PROT)
3497      {
3498        PrintS("Z");
3499      }
3500#ifdef KDEBUG
3501      if (TEST_OPT_DEBUG)
3502      {
3503        PrintS("--- create zero spoly: ");
3504        p_wrp(h,currRing,strat->tailRing);
3505        PrintS(" ---> ");
3506      }
3507#endif
3508      poly tmp = pInit();
3509      pSetCoeff0(tmp, pGetCoeff(p));
3510      for (int i = 1; i <= rVar(currRing); i++)
3511      {
3512        pSetExp(tmp, i, p_GetExp(p, i, strat->tailRing));
3513      }
3514      if (rRing_has_Comp(currRing) && rRing_has_Comp(strat->tailRing))
3515      {
3516        p_SetComp(tmp, p_GetComp(p, strat->tailRing), currRing);
3517      }
3518      p_Setm(tmp, currRing);
3519      p = p_LmFreeAndNext(p, strat->tailRing);
3520      pNext(tmp) = p;
3521      LObject h;
3522      h.Init();
3523      h.p = tmp;
3524      h.tailRing = strat->tailRing;
3525      int posx;
3526      if (h.p!=NULL)
3527      {
3528        if (TEST_OPT_INTSTRATEGY)
3529        {
3530          //pContent(h.p);
3531          h.pCleardenom(); // also does a pContent
3532        }
3533        else
3534        {
3535          h.pNorm();
3536        }
3537        strat->initEcart(&h);
3538        if (strat->Ll==-1)
3539          posx =0;
3540        else
3541          posx = strat->posInL(strat->L,strat->Ll,&h,strat);
3542        h.sev = pGetShortExpVector(h.p);
3543        if (strat->tailRing != currRing)
3544        {
3545          h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
3546        }
3547#ifdef KDEBUG
3548        if (TEST_OPT_DEBUG)
3549        {
3550          p_wrp(tmp,currRing,strat->tailRing);
3551          PrintLn();
3552        }
3553#endif
3554        enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
3555      }
3556    }
3557  }
3558  nDelete(&gcd);
3559}
3560
3561void clearSbatch (poly h,int k,int pos,kStrategy strat)
3562{
3563  int j = pos;
3564  if ( (!strat->fromT)
3565  && ((strat->syzComp==0)
3566    ||(pGetComp(h)<=strat->syzComp)
3567  ))
3568  {
3569    // Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
3570    unsigned long h_sev = pGetShortExpVector(h);
3571    loop
3572    {
3573      if (j > k) break;
3574      clearS(h,h_sev, &j,&k,strat);
3575      j++;
3576    }
3577    // Print("end clearS sl=%d\n",strat->sl);
3578  }
3579}
3580
3581/*2
3582* Generates a sufficient set of spolys (maybe just a finite generating
3583* set of the syzygys)
3584*/
3585void superenterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
3586{
3587  #if ADIDEBUG
3588  PrintLn();
3589  PrintS("Enter superenterpairs");
3590  PrintLn();
3591  int iii = strat->Ll;
3592  #endif
3593  assume (rField_is_Ring(currRing));
3594  // enter also zero divisor * poly, if this is non zero and of smaller degree
3595  if (!(rField_is_Domain(currRing))) enterExtendedSpoly(h, strat);
3596   #if ADIDEBUG
3597  if(iii==strat->Ll)
3598  {
3599    PrintLn();
3600    PrintS("                enterExtendedSpoly has not changed the list L.");
3601    PrintLn();
3602  }
3603  else
3604  {
3605    PrintLn();
3606    PrintS("                enterExtendedSpoly changed the list L: ");
3607    PrintLn();
3608    for(iii=0;iii<=strat->Ll;iii++)
3609    {
3610      PrintLn();
3611      PrintS("                L[");printf("%d",iii);PrintS("]:");PrintLn();
3612      PrintS("                     ");p_Write(strat->L[iii].p1,strat->tailRing);
3613      PrintS("                     ");p_Write(strat->L[iii].p2,strat->tailRing);
3614      PrintS("                     ");p_Write(strat->L[iii].p,strat->tailRing);
3615    }
3616  }
3617  iii = strat->Ll;
3618  #endif
3619  initenterpairs(h, k, ecart, 0, strat, atR);
3620  #if ADIDEBUG
3621  if(iii==strat->Ll)
3622  {
3623    PrintLn();
3624    PrintS("                initenterpairs has not changed the list L.");
3625    PrintLn();
3626  }
3627  else
3628  {
3629    PrintLn();
3630    PrintS("                initenterpairs changed the list L: ");
3631    PrintLn();
3632    for(iii=0;iii<=strat->Ll;iii++)
3633    {
3634      PrintLn();
3635      PrintS("                L[");printf("%d",iii);PrintS("]:");PrintLn();
3636      PrintS("                     ");p_Write(strat->L[iii].p1,strat->tailRing);
3637      PrintS("                     ");p_Write(strat->L[iii].p2,strat->tailRing);
3638      PrintS("                     ");p_Write(strat->L[iii].p,strat->tailRing);
3639    }
3640  }
3641  iii = strat->Ll;
3642  #endif
3643  initenterstrongPairs(h, k, ecart, 0, strat, atR);
3644  #if ADIDEBUG
3645  if(iii==strat->Ll)
3646  {
3647    PrintLn();
3648    PrintS("                initenterstrongPairs has not changed the list L.");
3649    PrintLn();
3650  }
3651  else
3652  {
3653    PrintLn();
3654    PrintS("                initenterstrongPairs changed the list L: ");
3655    PrintLn();
3656    for(iii=0;iii<=strat->Ll;iii++)
3657    {
3658      PrintLn();
3659      PrintS("                L[");printf("%d",iii);PrintS("]:");PrintLn();
3660      PrintS("                     ");p_Write(strat->L[iii].p1,strat->tailRing);
3661      PrintS("                     ");p_Write(strat->L[iii].p2,strat->tailRing);
3662      PrintS("                     ");p_Write(strat->L[iii].p,strat->tailRing);
3663    }
3664  }
3665  PrintLn();
3666  PrintS("End of superenterpairs");
3667  PrintLn();
3668  #endif
3669  clearSbatch(h, k, pos, strat);
3670}
3671#endif
3672
3673/*2
3674*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
3675*superfluous elements in S will be deleted
3676*/
3677void enterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
3678{
3679  int j=pos;
3680
3681#ifdef HAVE_RINGS
3682  assume (!rField_is_Ring(currRing));
3683#endif
3684
3685  initenterpairs(h,k,ecart,0,strat, atR);
3686  if ( (!strat->fromT)
3687  && ((strat->syzComp==0)
3688    ||(pGetComp(h)<=strat->syzComp)))
3689  {
3690    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
3691    unsigned long h_sev = pGetShortExpVector(h);
3692    loop
3693    {
3694      if (j > k) break;
3695      clearS(h,h_sev, &j,&k,strat);
3696      j++;
3697    }
3698    //Print("end clearS sl=%d\n",strat->sl);
3699  }
3700 // PrintS("end enterpairs\n");
3701}
3702
3703/*2
3704*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
3705*superfluous elements in S will be deleted
3706*this is a special variant of signature-based algorithms including the
3707*signatures for criteria checks
3708*/
3709void enterpairsSig (poly h,poly hSig,int hFrom,int k,int ecart,int pos,kStrategy strat, int atR)
3710{
3711int j=pos;
3712
3713#ifdef HAVE_RINGS
3714assume (!rField_is_Ring(currRing));
3715#endif
3716
3717initenterpairsSig(h,hSig,hFrom,k,ecart,0,strat, atR);
3718if ( (!strat->fromT)
3719&& ((strat->syzComp==0)
3720  ||(pGetComp(h)<=strat->syzComp)))
3721{
3722  //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
3723  unsigned long h_sev = pGetShortExpVector(h);
3724  loop
3725  {
3726    if (j > k) break;
3727    clearS(h,h_sev, &j,&k,strat);
3728    j++;
3729  }
3730  //Print("end clearS sl=%d\n",strat->sl);
3731}
3732// PrintS("end enterpairs\n");
3733}
3734
3735/*2
3736*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
3737*superfluous elements in S will be deleted
3738*/
3739void enterpairsSpecial (poly h,int k,int ecart,int pos,kStrategy strat, int atR = -1)
3740{
3741  int j;
3742  const int iCompH = pGetComp(h);
3743
3744#ifdef HAVE_RINGS
3745  if (rField_is_Ring(currRing))
3746  {
3747    for (j=0; j<=k; j++)
3748    {
3749      const int iCompSj = pGetComp(strat->S[j]);
3750      if ((iCompH==iCompSj)
3751          //|| (0==iCompH) // can only happen,if iCompSj==0
3752          || (0==iCompSj))
3753      {
3754        enterOnePairRing(j,h,ecart,FALSE,strat, atR);
3755      }
3756    }
3757    kMergeBintoL(strat);
3758  }
3759  else
3760#endif
3761  for (j=0; j<=k; j++)
3762  {
3763    const int iCompSj = pGetComp(strat->S[j]);
3764    if ((iCompH==iCompSj)
3765        //|| (0==iCompH) // can only happen,if iCompSj==0
3766        || (0==iCompSj))
3767    {
3768      enterOnePairSpecial(j,h,ecart,strat, atR);
3769    }
3770  }
3771
3772  if (strat->noClearS) return;
3773
3774//   #ifdef HAVE_PLURAL
3775/*
3776  if (rIsPluralRing(currRing))
3777  {
3778    j=pos;
3779    loop
3780    {
3781      if (j > k) break;
3782
3783      if (pLmDivisibleBy(h, strat->S[j]))
3784      {
3785        deleteInS(j, strat);
3786        j--;
3787        k--;
3788      }
3789
3790      j++;
3791    }
3792  }
3793  else
3794*/
3795//   #endif // ??? Why was the following cancelation disabled for non-commutative rings?
3796  {
3797    j=pos;
3798    loop
3799    {
3800      unsigned long h_sev = pGetShortExpVector(h);
3801      if (j > k) break;
3802      clearS(h,h_sev,&j,&k,strat);
3803      j++;
3804    }
3805  }
3806}
3807
3808/*2
3809*reorders  s with respect to posInS,
3810*suc is the first changed index or zero
3811*/
3812
3813void reorderS (int* suc,kStrategy strat)
3814{
3815  int i,j,at,ecart, s2r;
3816  int fq=0;
3817  unsigned long sev;
3818  poly  p;
3819  int new_suc=strat->sl+1;
3820  i= *suc;
3821  if (i<0) i=0;
3822
3823  for (; i<=strat->sl; i++)
3824  {
3825    at = posInS(strat,i-1,strat->S[i],strat->ecartS[i]);
3826    if (at != i)
3827    {
3828      if (new_suc > at) new_suc = at;
3829      p = strat->S[i];
3830      ecart = strat->ecartS[i];
3831      sev = strat->sevS[i];
3832      s2r = strat->S_2_R[i];
3833      if (strat->fromQ!=NULL) fq=strat->fromQ[i];
3834      for (j=i; j>=at+1; j--)
3835      {
3836        strat->S[j] = strat->S[j-1];
3837        strat->ecartS[j] = strat->ecartS[j-1];
3838        strat->sevS[j] = strat->sevS[j-1];
3839        strat->S_2_R[j] = strat->S_2_R[j-1];
3840      }
3841      strat->S[at] = p;
3842      strat->ecartS[at] = ecart;
3843      strat->sevS[at] = sev;
3844      strat->S_2_R[at] = s2r;
3845      if (strat->fromQ!=NULL)
3846      {
3847        for (j=i; j>=at+1; j--)
3848        {
3849          strat->fromQ[j] = strat->fromQ[j-1];
3850        }
3851        strat->fromQ[at]=fq;
3852      }
3853    }
3854  }
3855  if (new_suc <= strat->sl) *suc=new_suc;
3856  else                      *suc=-1;
3857}
3858
3859
3860/*2
3861*looks up the position of p in set
3862*set[0] is the smallest with respect to the ordering-procedure deg/pComp
3863* Assumption: posInS only depends on the leading term
3864*             otherwise, bba has to be changed
3865*/
3866int posInS (const kStrategy strat, const int length,const poly p,
3867            const int ecart_p)
3868{
3869  if(length==-1) return 0;
3870  polyset set=strat->S;
3871  int i;
3872  int an = 0;
3873  int en = length;
3874  int cmp_int = currRing->OrdSgn;
3875  if ((currRing->MixedOrder)
3876#ifdef HAVE_PLURAL
3877  && (currRing->real_var_start==0)
3878#endif
3879#if 0
3880  || ((strat->ak>0) && ((currRing->order[0]==ringorder_c)||((currRing->order[0]==ringorder_C))))
3881#endif
3882  )
3883  {
3884    int o=p_Deg(p,currRing);
3885    int oo=p_Deg(set[length],currRing);
3886
3887    if ((oo<o)
3888    || ((o==oo) && (pLmCmp(set[length],p)!= cmp_int)))
3889      return length+1;
3890
3891    loop
3892    {
3893      if (an >= en-1)
3894      {
3895        if ((p_Deg(set[an],currRing)>=o) && (pLmCmp(set[an],p) == cmp_int))
3896        {
3897          return an;
3898        }
3899        return en;
3900      }
3901      i=(an+en) / 2;
3902      if ((p_Deg(set[i],currRing)>=o) && (pLmCmp(set[i],p) == cmp_int)) en=i;
3903      else                              an=i;
3904    }
3905  }
3906  else
3907  {
3908#ifdef HAVE_RINGS
3909    if (rField_is_Ring(currRing))
3910    {
3911      if (pLmCmp(set[length],p)== -cmp_int)
3912        return length+1;
3913      int cmp;
3914      loop
3915      {
3916        if (an >= en-1)
3917        {
3918          cmp = pLmCmp(set[an],p);
3919          if (cmp == cmp_int)  return an;
3920          if (cmp == -cmp_int) return en;
3921          if (n_DivBy(pGetCoeff(p), pGetCoeff(set[an]), currRing->cf)) return en;
3922          return an;
3923        }
3924        i = (an+en) / 2;
3925        cmp = pLmCmp(set[i],p);
3926        if (cmp == cmp_int)         en = i;
3927        else if (cmp == -cmp_int)   an = i;
3928        else
3929        {
3930          if (n_DivBy(pGetCoeff(p), pGetCoeff(set[i]), currRing->cf)) an = i;
3931          else en = i;
3932        }
3933      }
3934    }
3935    else
3936#endif
3937    if (pLmCmp(set[length],p)== -cmp_int)
3938      return length+1;
3939
3940    loop
3941    {
3942      if (an >= en-1)
3943      {
3944        if (pLmCmp(set[an],p) == cmp_int) return an;
3945        if (pLmCmp(set[an],p) == -cmp_int) return en;
3946        if ((cmp_int!=1)
3947        && ((strat->ecartS[an])>ecart_p))
3948          return an;
3949        return en;
3950      }
3951      i=(an+en) / 2;
3952      if (pLmCmp(set[i],p) == cmp_int) en=i;
3953      else if (pLmCmp(set[i],p) == -cmp_int) an=i;
3954      else
3955      {
3956        if ((cmp_int!=1)
3957        &&((strat->ecartS[i])<ecart_p))
3958          en=i;
3959        else
3960          an=i;
3961      }
3962    }
3963  }
3964}
3965
3966
3967/*2
3968* looks up the position of p in set
3969* the position is the last one
3970*/
3971int posInT0 (const TSet,const int length,LObject &)
3972{
3973  return (length+1);
3974}
3975
3976
3977/*2
3978* looks up the position of p in T
3979* set[0] is the smallest with respect to the ordering-procedure
3980* pComp
3981*/
3982int posInT1 (const TSet set,const int length,LObject &p)
3983{
3984  if (length==-1) return 0;
3985
3986  if (pLmCmp(set[length].p,p.p)!= currRing->OrdSgn) return length+1;
3987
3988  int i;
3989  int an = 0;
3990  int en= length;
3991
3992  loop
3993  {
3994    if (an >= en-1)
3995    {
3996      if (pLmCmp(set[an].p,p.p) == currRing->OrdSgn) return an;
3997      return en;
3998    }
3999    i=(an+en) / 2;
4000    if (pLmCmp(set[i].p,p.p) == currRing->OrdSgn) en=i;
4001    else                                 an=i;
4002  }
4003}
4004
4005/*2
4006* looks up the position of p in T
4007* set[0] is the smallest with respect to the ordering-procedure
4008* length
4009*/
4010int posInT2 (const TSet set,const int length,LObject &p)
4011{
4012  p.GetpLength();
4013  if (length==-1)
4014    return 0;
4015  if (set[length].length<p.length)
4016    return length+1;
4017
4018  int i;
4019  int an = 0;
4020  int en= length;
4021
4022  loop
4023  {
4024    if (an >= en-1)
4025    {
4026      if (set[an].length>p.length) return an;
4027      return en;
4028    }
4029    i=(an+en) / 2;
4030    if (set[i].length>p.length) en=i;
4031    else                        an=i;
4032  }
4033}
4034
4035/*2
4036* looks up the position of p in T
4037* set[0] is the smallest with respect to the ordering-procedure
4038* totaldegree,pComp
4039*/
4040int posInT11 (const TSet set,const int length,LObject &p)
4041/*{
4042 * int j=0;
4043 * int o;
4044 *
4045 * o = p.GetpFDeg();
4046 * loop
4047 * {
4048 *   if ((pFDeg(set[j].p) > o)
4049 *   || ((pFDeg(set[j].p) == o) && (pLmCmp(set[j].p,p.p) == currRing->OrdSgn)))
4050 *   {
4051 *     return j;
4052 *   }
4053 *   j++;
4054 *   if (j > length) return j;
4055 * }
4056 *}
4057 */
4058{
4059  if (length==-1) return 0;
4060
4061  int o = p.GetpFDeg();
4062  int op = set[length].GetpFDeg();
4063
4064  if ((op < o)
4065  || ((op == o) && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4066    return length+1;
4067
4068  int i;
4069  int an = 0;
4070  int en= length;
4071
4072  loop
4073  {
4074    if (an >= en-1)
4075    {
4076      op= set[an].GetpFDeg();
4077      if ((op > o)
4078      || (( op == o) && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4079        return an;
4080      return en;
4081    }
4082    i=(an+en) / 2;
4083    op = set[i].GetpFDeg();
4084    if (( op > o)
4085    || (( op == o) && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4086      en=i;
4087    else
4088      an=i;
4089  }
4090}
4091
4092/*2 Pos for rings T: Here I am
4093* looks up the position of p in T
4094* set[0] is the smallest with respect to the ordering-procedure
4095* totaldegree,pComp
4096*/
4097int posInTrg0 (const TSet set,const int length,LObject &p)
4098{
4099  if (length==-1) return 0;
4100  int o = p.GetpFDeg();
4101  int op = set[length].GetpFDeg();
4102  int i;
4103  int an = 0;
4104  int en = length;
4105  int cmp_int = currRing->OrdSgn;
4106  if ((op < o) || (pLmCmp(set[length].p,p.p)== -cmp_int))
4107    return length+1;
4108  int cmp;
4109  loop
4110  {
4111    if (an >= en-1)
4112    {
4113      op = set[an].GetpFDeg();
4114      if (op > o) return an;
4115      if (op < 0) return en;
4116      cmp = pLmCmp(set[an].p,p.p);
4117      if (cmp == cmp_int)  return an;
4118      if (cmp == -cmp_int) return en;
4119      if (nGreater(pGetCoeff(p.p), pGetCoeff(set[an].p))) return en;
4120      return an;
4121    }
4122    i = (an + en) / 2;
4123    op = set[i].GetpFDeg();
4124    if (op > o)       en = i;
4125    else if (op < o)  an = i;
4126    else
4127    {
4128      cmp = pLmCmp(set[i].p,p.p);
4129      if (cmp == cmp_int)                                     en = i;
4130      else if (cmp == -cmp_int)                               an = i;
4131      else if (nGreater(pGetCoeff(p.p), pGetCoeff(set[i].p))) an = i;
4132      else                                                    en = i;
4133    }
4134  }
4135}
4136/*
4137  int o = p.GetpFDeg();
4138  int op = set[length].GetpFDeg();
4139
4140  if ((op < o)
4141  || ((op == o) && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4142    return length+1;
4143
4144  int i;
4145  int an = 0;
4146  int en= length;
4147
4148  loop
4149  {
4150    if (an >= en-1)
4151    {
4152      op= set[an].GetpFDeg();
4153      if ((op > o)
4154      || (( op == o) && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4155        return an;
4156      return en;
4157    }
4158    i=(an+en) / 2;
4159    op = set[i].GetpFDeg();
4160    if (( op > o)
4161    || (( op == o) && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4162      en=i;
4163    else
4164      an=i;
4165  }
4166}
4167  */
4168/*2
4169* looks up the position of p in T
4170* set[0] is the smallest with respect to the ordering-procedure
4171* totaldegree,pComp
4172*/
4173int posInT110 (const TSet set,const int length,LObject &p)
4174{
4175  p.GetpLength();
4176  if (length==-1) return 0;
4177
4178  int o = p.GetpFDeg();
4179  int op = set[length].GetpFDeg();
4180
4181  if (( op < o)
4182  || (( op == o) && (set[length].length<p.length))
4183  || (( op == o) && (set[length].length == p.length)
4184     && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4185    return length+1;
4186
4187  int i;
4188  int an = 0;
4189  int en= length;
4190  loop
4191  {
4192    if (an >= en-1)
4193    {
4194      op = set[an].GetpFDeg();
4195      if (( op > o)
4196      || (( op == o) && (set[an].length > p.length))
4197      || (( op == o) && (set[an].length == p.length)
4198         && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4199        return an;
4200      return en;
4201    }
4202    i=(an+en) / 2;
4203    op = set[i].GetpFDeg();
4204    if (( op > o)
4205    || (( op == o) && (set[i].length > p.length))
4206    || (( op == o) && (set[i].length == p.length)
4207       && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4208      en=i;
4209    else
4210      an=i;
4211  }
4212}
4213
4214/*2
4215* looks up the position of p in set
4216* set[0] is the smallest with respect to the ordering-procedure
4217* pFDeg
4218*/
4219int posInT13 (const TSet set,const int length,LObject &p)
4220{
4221  if (length==-1) return 0;
4222
4223  int o = p.GetpFDeg();
4224
4225  if (set[length].GetpFDeg() <= o)
4226    return length+1;
4227
4228  int i;
4229  int an = 0;
4230  int en= length;
4231  loop
4232  {
4233    if (an >= en-1)
4234    {
4235      if (set[an].GetpFDeg() > o)
4236        return an;
4237      return en;
4238    }
4239    i=(an+en) / 2;
4240    if (set[i].GetpFDeg() > o)
4241      en=i;
4242    else
4243      an=i;
4244  }
4245}
4246
4247// determines the position based on: 1.) Ecart 2.) pLength
4248int posInT_EcartpLength(const TSet set,const int length,LObject &p)
4249{
4250  int ol = p.GetpLength();
4251  if (length==-1) return 0;
4252
4253  int op=p.ecart;
4254
4255  int oo=set[length].ecart;
4256  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
4257    return length+1;
4258
4259  int i;
4260  int an = 0;
4261  int en= length;
4262  loop
4263    {
4264      if (an >= en-1)
4265      {
4266        int oo=set[an].ecart;
4267        if((oo > op)
4268           || ((oo==op) && (set[an].pLength > ol)))
4269          return an;
4270        return en;
4271      }
4272      i=(an+en) / 2;
4273      int oo=set[i].ecart;
4274      if ((oo > op)
4275          || ((oo == op) && (set[i].pLength > ol)))
4276        en=i;
4277      else
4278        an=i;
4279    }
4280}
4281
4282/*2
4283* looks up the position of p in set
4284* set[0] is the smallest with respect to the ordering-procedure
4285* maximaldegree, pComp
4286*/
4287int posInT15 (const TSet set,const int length,LObject &p)
4288/*{
4289 *int j=0;
4290 * int o;
4291 *
4292 * o = p.GetpFDeg()+p.ecart;
4293 * loop
4294 * {
4295 *   if ((set[j].GetpFDeg()+set[j].ecart > o)
4296 *   || ((set[j].GetpFDeg()+set[j].ecart == o)
4297 *     && (pLmCmp(set[j].p,p.p) == currRing->OrdSgn)))
4298 *   {
4299 *     return j;
4300 *   }
4301 *   j++;
4302 *   if (j > length) return j;
4303 * }
4304 *}
4305 */
4306{
4307  if (length==-1) return 0;
4308
4309  int o = p.GetpFDeg() + p.ecart;
4310  int op = set[length].GetpFDeg()+set[length].ecart;
4311
4312  if ((op < o)
4313  || ((op == o)
4314     && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4315    return length+1;
4316
4317  int i;
4318  int an = 0;
4319  int en= length;
4320  loop
4321  {
4322    if (an >= en-1)
4323    {
4324      op = set[an].GetpFDeg()+set[an].ecart;
4325      if (( op > o)
4326      || (( op  == o) && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4327        return an;
4328      return en;
4329    }
4330    i=(an+en) / 2;
4331    op = set[i].GetpFDeg()+set[i].ecart;
4332    if (( op > o)
4333    || (( op == o) && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4334      en=i;
4335    else
4336      an=i;
4337  }
4338}
4339
4340/*2
4341* looks up the position of p in set
4342* set[0] is the smallest with respect to the ordering-procedure
4343* pFDeg+ecart, ecart, pComp
4344*/
4345int posInT17 (const TSet set,const int length,LObject &p)
4346/*
4347*{
4348* int j=0;
4349* int  o;
4350*
4351*  o = p.GetpFDeg()+p.ecart;
4352*  loop
4353*  {
4354*    if ((pFDeg(set[j].p)+set[j].ecart > o)
4355*    || (((pFDeg(set[j].p)+set[j].ecart == o)
4356*      && (set[j].ecart < p.ecart)))
4357*    || ((pFDeg(set[j].p)+set[j].ecart == o)
4358*      && (set[j].ecart==p.ecart)
4359*      && (pLmCmp(set[j].p,p.p)==currRing->OrdSgn)))
4360*      return j;
4361*    j++;
4362*    if (j > length) return j;
4363*  }
4364* }
4365*/
4366{
4367  if (length==-1) return 0;
4368
4369  int o = p.GetpFDeg() + p.ecart;
4370  int op = set[length].GetpFDeg()+set[length].ecart;
4371
4372  if ((op < o)
4373  || (( op == o) && (set[length].ecart > p.ecart))
4374  || (( op == o) && (set[length].ecart==p.ecart)
4375     && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4376    return length+1;
4377
4378  int i;
4379  int an = 0;
4380  int en= length;
4381  loop
4382  {
4383    if (an >= en-1)
4384    {
4385      op = set[an].GetpFDeg()+set[an].ecart;
4386      if (( op > o)
4387      || (( op == o) && (set[an].ecart < p.ecart))
4388      || (( op  == o) && (set[an].ecart==p.ecart)
4389         && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4390        return an;
4391      return en;
4392    }
4393    i=(an+en) / 2;
4394    op = set[i].GetpFDeg()+set[i].ecart;
4395    if ((op > o)
4396    || (( op == o) && (set[i].ecart < p.ecart))
4397    || (( op == o) && (set[i].ecart == p.ecart)
4398       && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4399      en=i;
4400    else
4401      an=i;
4402  }
4403}
4404/*2
4405* looks up the position of p in set
4406* set[0] is the smallest with respect to the ordering-procedure
4407* pGetComp, pFDeg+ecart, ecart, pComp
4408*/
4409int posInT17_c (const TSet set,const int length,LObject &p)
4410{
4411  if (length==-1) return 0;
4412
4413  int cc = (-1+2*currRing->order[0]==ringorder_c);
4414  /* cc==1 for (c,..), cc==-1 for (C,..) */
4415  int o = p.GetpFDeg() + p.ecart;
4416  unsigned long c = pGetComp(p.p)*cc;
4417
4418  if (pGetComp(set[length].p)*cc < c)
4419    return length+1;
4420  if (pGetComp(set[length].p)*cc == c)
4421  {
4422    int op = set[length].GetpFDeg()+set[length].ecart;
4423    if ((op < o)
4424    || ((op == o) && (set[length].ecart > p.ecart))
4425    || ((op == o) && (set[length].ecart==p.ecart)
4426       && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4427      return length+1;
4428  }
4429
4430  int i;
4431  int an = 0;
4432  int en= length;
4433  loop
4434  {
4435    if (an >= en-1)
4436    {
4437      if (pGetComp(set[an].p)*cc < c)
4438        return en;
4439      if (pGetComp(set[an].p)*cc == c)
4440      {
4441        int op = set[an].GetpFDeg()+set[an].ecart;
4442        if ((op > o)
4443        || ((op == o) && (set[an].ecart < p.ecart))
4444        || ((op == o) && (set[an].ecart==p.ecart)
4445           && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4446          return an;
4447      }
4448      return en;
4449    }
4450    i=(an+en) / 2;
4451    if (pGetComp(set[i].p)*cc > c)
4452      en=i;
4453    else if (pGetComp(set[i].p)*cc == c)
4454    {
4455      int op = set[i].GetpFDeg()+set[i].ecart;
4456      if ((op > o)
4457      || ((op == o) && (set[i].ecart < p.ecart))
4458      || ((op == o) && (set[i].ecart == p.ecart)
4459         && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4460        en=i;
4461      else
4462        an=i;
4463    }
4464    else
4465      an=i;
4466  }
4467}
4468
4469/*2
4470* looks up the position of p in set
4471* set[0] is the smallest with respect to
4472* ecart, pFDeg, length
4473*/
4474int posInT19 (const TSet set,const int length,LObject &p)
4475{
4476  p.GetpLength();
4477  if (length==-1) return 0;
4478
4479  int o = p.ecart;
4480  int op=p.GetpFDeg();
4481
4482  if (set[length].ecart < o)
4483    return length+1;
4484  if (set[length].ecart == o)
4485  {
4486     int oo=set[length].GetpFDeg();
4487     if ((oo < op) || ((oo==op) && (set[length].length < p.length)))
4488       return length+1;
4489  }
4490
4491  int i;
4492  int an = 0;
4493  int en= length;
4494  loop
4495  {
4496    if (an >= en-1)
4497    {
4498      if (set[an].ecart > o)
4499        return an;
4500      if (set[an].ecart == o)
4501      {
4502         int oo=set[an].GetpFDeg();
4503         if((oo > op)
4504         || ((oo==op) && (set[an].length > p.length)))
4505           return an;
4506      }
4507      return en;
4508    }
4509    i=(an+en) / 2;
4510    if (set[i].ecart > o)
4511      en=i;
4512    else if (set[i].ecart == o)
4513    {
4514       int oo=set[i].GetpFDeg();
4515       if ((oo > op)
4516       || ((oo == op) && (set[i].length > p.length)))
4517         en=i;
4518       else
4519        an=i;
4520    }
4521    else
4522      an=i;
4523  }
4524}
4525
4526/*2
4527*looks up the position of polynomial p in set
4528*set[length] is the smallest element in set with respect
4529*to the ordering-procedure pComp
4530*/
4531int posInLSpecial (const LSet set, const int length,
4532                   LObject *p,const kStrategy)
4533{
4534  if (length<0) return 0;
4535
4536  int d=p->GetpFDeg();
4537  int op=set[length].GetpFDeg();
4538
4539  if ((op > d)
4540  || ((op == d) && (p->p1!=NULL)&&(set[length].p1==NULL))
4541  || (pLmCmp(set[length].p,p->p)== currRing->OrdSgn))
4542     return length+1;
4543
4544  int i;
4545  int an = 0;
4546  int en= length;
4547  loop
4548  {
4549    if (an >= en-1)
4550    {
4551      op=set[an].GetpFDeg();
4552      if ((op > d)
4553      || ((op == d) && (p->p1!=NULL) && (set[an].p1==NULL))
4554      || (pLmCmp(set[an].p,p->p)== currRing->OrdSgn))
4555         return en;
4556      return an;
4557    }
4558    i=(an+en) / 2;
4559    op=set[i].GetpFDeg();
4560    if ((op>d)
4561    || ((op==d) && (p->p1!=NULL) && (set[i].p1==NULL))
4562    || (pLmCmp(set[i].p,p->p) == currRing->OrdSgn))
4563      an=i;
4564    else
4565      en=i;
4566  }
4567}
4568
4569/*2
4570*looks up the position of polynomial p in set
4571*set[length] is the smallest element in set with respect
4572*to the ordering-procedure pComp
4573*/
4574int posInL0 (const LSet set, const int length,
4575             LObject* p,const kStrategy)
4576{
4577  if (length<0) return 0;
4578
4579  if (pLmCmp(set[length].p,p->p)== currRing->OrdSgn)
4580    return length+1;
4581
4582  int i;
4583  int an = 0;
4584  int en= length;
4585  loop
4586  {
4587    if (an >= en-1)
4588    {
4589      if (pLmCmp(set[an].p,p->p) == currRing->OrdSgn) return en;
4590      return an;
4591    }
4592    i=(an+en) / 2;
4593    if (pLmCmp(set[i].p,p->p) == currRing->OrdSgn) an=i;
4594    else                                 en=i;
4595    /*aend. fuer lazy == in !=- machen */
4596  }
4597}
4598
4599/*2
4600* looks up the position of polynomial p in set
4601* e is the ecart of p
4602* set[length] is the smallest element in set with respect
4603* to the signature order
4604*/
4605int posInLSig (const LSet set, const int length,
4606               LObject* p,const kStrategy /*strat*/)
4607{
4608if (length<0) return 0;
4609if (pLmCmp(set[length].sig,p->sig)== currRing->OrdSgn)
4610  return length+1;
4611
4612int i;
4613int an = 0;
4614int en= length;
4615loop
4616{
4617  if (an >= en-1)
4618  {
4619    if (pLmCmp(set[an].sig,p->sig) == currRing->OrdSgn) return en;
4620    return an;
4621  }
4622  i=(an+en) / 2;
4623  if (pLmCmp(set[i].sig,p->sig) == currRing->OrdSgn) an=i;
4624  else                                      en=i;
4625  /*aend. fuer lazy == in !=- machen */
4626}
4627}
4628
4629// for sba, sorting syzygies
4630int posInSyz (const kStrategy strat, poly sig)
4631{
4632if (strat->syzl==0) return 0;
4633if (pLmCmp(strat->syz[strat->syzl-1],sig) != currRing->OrdSgn)
4634  return strat->syzl;
4635int i;
4636int an = 0;
4637int en= strat->syzl-1;
4638loop
4639{
4640  if (an >= en-1)
4641  {
4642    if (pLmCmp(strat->syz[an],sig) != currRing->OrdSgn) return en;
4643    return an;
4644  }
4645  i=(an+en) / 2;
4646  if (pLmCmp(strat->syz[i],sig) != currRing->OrdSgn) an=i;
4647  else                                      en=i;
4648  /*aend. fuer lazy == in !=- machen */
4649}
4650}
4651
4652/*2
4653*
4654* is only used in F5C, must ensure that the interreduction process does add new
4655* critical pairs to strat->L only behind all other critical pairs which are
4656* still in strat->L!
4657*/
4658int posInLF5C (const LSet /*set*/, const int /*length*/,
4659               LObject* /*p*/,const kStrategy strat)
4660{
4661  return strat->Ll+1;
4662}
4663
4664/*2
4665* looks up the position of polynomial p in set
4666* e is the ecart of p
4667* set[length] is the smallest element in set with respect
4668* to the ordering-procedure totaldegree,pComp
4669*/
4670int posInL11 (const LSet set, const int length,
4671              LObject* p,const kStrategy)
4672/*{
4673 * int j=0;
4674 * int o;
4675 *
4676 * o = p->GetpFDeg();
4677 * loop
4678 * {
4679 *   if (j > length)            return j;
4680 *   if ((set[j].GetpFDeg() < o)) return j;
4681 *   if ((set[j].GetpFDeg() == o) && (pLmCmp(set[j].p,p->p) == -currRing->OrdSgn))
4682 *   {
4683 *     return j;
4684 *   }
4685 *   j++;
4686 * }
4687 *}
4688 */
4689{
4690  if (length<0) return 0;
4691
4692  int o = p->GetpFDeg();
4693  int op = set[length].GetpFDeg();
4694
4695  if ((op > o)
4696  || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4697    return length+1;
4698  int i;
4699  int an = 0;
4700  int en= length;
4701  loop
4702  {
4703    if (an >= en-1)
4704    {
4705      op = set[an].GetpFDeg();
4706      if ((op > o)
4707      || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4708        return en;
4709      return an;
4710    }
4711    i=(an+en) / 2;
4712    op = set[i].GetpFDeg();
4713    if ((op > o)
4714    || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4715      an=i;
4716    else
4717      en=i;
4718  }
4719}
4720
4721/*2 Position for rings L: Here I am
4722* looks up the position of polynomial p in set
4723* e is the ecart of p
4724* set[length] is the smallest element in set with respect
4725* to the ordering-procedure totaldegree,pComp
4726*/
4727inline int getIndexRng(long coeff)
4728{
4729  if (coeff == 0) return -1;
4730  long tmp = coeff;
4731  int ind = 0;
4732  while (tmp % 2 == 0)
4733  {
4734    tmp = tmp / 2;
4735    ind++;
4736  }
4737  return ind;
4738}
4739
4740int posInLrg0 (const LSet set, const int length,
4741              LObject* p,const kStrategy)
4742/*          if (nGreater(pGetCoeff(p), pGetCoeff(set[an]))) return en;
4743        if (pLmCmp(set[i],p) == cmp_int)         en = i;
4744        else if (pLmCmp(set[i],p) == -cmp_int)   an = i;
4745        else
4746        {
4747          if (nGreater(pGetCoeff(p), pGetCoeff(set[i]))) an = i;
4748          else en = i;
4749        }*/
4750{
4751  if (length < 0) return 0;
4752
4753  int o = p->GetpFDeg();
4754  int op = set[length].GetpFDeg();
4755
4756  if ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4757    return length + 1;
4758  int i;
4759  int an = 0;
4760  int en = length;
4761  loop
4762  {
4763    if (an >= en - 1)
4764    {
4765      op = set[an].GetpFDeg();
4766      if ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4767        return en;
4768      return an;
4769    }
4770    i = (an+en) / 2;
4771    op = set[i].GetpFDeg();
4772    if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4773      an = i;
4774    else
4775      en = i;
4776  }
4777}
4778
4779/*{
4780  if (length < 0) return 0;
4781
4782  int o = p->GetpFDeg();
4783  int op = set[length].GetpFDeg();
4784
4785  int inde = getIndexRng((unsigned long) pGetCoeff(set[length].p));
4786  int indp = getIndexRng((unsigned long) pGetCoeff(p->p));
4787  int inda;
4788  int indi;
4789
4790  if ((inda > indp) || ((inda == inde) && ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))))
4791    return length + 1;
4792  int i;
4793  int an = 0;
4794  inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
4795  int en = length;
4796  loop
4797  {
4798    if (an >= en-1)
4799    {
4800      op = set[an].GetpFDeg();
4801      if ((indp > inda) || ((indp == inda) && ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))))
4802        return en;
4803      return an;
4804    }
4805    i = (an + en) / 2;
4806    indi = getIndexRng((unsigned long) pGetCoeff(set[i].p));
4807    op = set[i].GetpFDeg();
4808    if ((indi > indp) || ((indi == indp) && ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))))
4809    // if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4810    {
4811      an = i;
4812      inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
4813    }
4814    else
4815      en = i;
4816  }
4817} */
4818
4819/*2
4820* looks up the position of polynomial p in set
4821* set[length] is the smallest element in set with respect
4822* to the ordering-procedure totaldegree,pLength0
4823*/
4824int posInL110 (const LSet set, const int length,
4825               LObject* p,const kStrategy)
4826{
4827  if (length<0) return 0;
4828
4829  int o = p->GetpFDeg();
4830  int op = set[length].GetpFDeg();
4831
4832  if ((op > o)
4833  || ((op == o) && (set[length].length >p->length))
4834  || ((op == o) && (set[length].length <= p->length)
4835     && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4836    return length+1;
4837  int i;
4838  int an = 0;
4839  int en= length;
4840  loop
4841  {
4842    if (an >= en-1)
4843    {
4844      op = set[an].GetpFDeg();
4845      if ((op > o)
4846      || ((op == o) && (set[an].length >p->length))
4847      || ((op == o) && (set[an].length <=p->length)
4848         && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4849        return en;
4850      return an;
4851    }
4852    i=(an+en) / 2;
4853    op = set[i].GetpFDeg();
4854    if ((op > o)
4855    || ((op == o) && (set[i].length > p->length))
4856    || ((op == o) && (set[i].length <= p->length)
4857       && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4858      an=i;
4859    else
4860      en=i;
4861  }
4862}
4863
4864/*2
4865* looks up the position of polynomial p in set
4866* e is the ecart of p
4867* set[length] is the smallest element in set with respect
4868* to the ordering-procedure totaldegree
4869*/
4870int posInL13 (const LSet set, const int length,
4871              LObject* p,const kStrategy)
4872{
4873  if (length<0) return 0;
4874
4875  int o = p->GetpFDeg();
4876
4877  if (set[length].GetpFDeg() > o)
4878    return length+1;
4879
4880  int i;
4881  int an = 0;
4882  int en= length;
4883  loop
4884  {
4885    if (an >= en-1)
4886    {
4887      if (set[an].GetpFDeg() >= o)
4888        return en;
4889      return an;
4890    }
4891    i=(an+en) / 2;
4892    if (set[i].GetpFDeg() >= o)
4893      an=i;
4894    else
4895      en=i;
4896  }
4897}
4898
4899/*2
4900* looks up the position of polynomial p in set
4901* e is the ecart of p
4902* set[length] is the smallest element in set with respect
4903* to the ordering-procedure maximaldegree,pComp
4904*/
4905int posInL15 (const LSet set, const int length,
4906              LObject* p,const kStrategy)
4907/*{
4908 * int j=0;
4909 * int o;
4910 *
4911 * o = p->ecart+p->GetpFDeg();
4912 * loop
4913 * {
4914 *   if (j > length)                       return j;
4915 *   if (set[j].GetpFDeg()+set[j].ecart < o) return j;
4916 *   if ((set[j].GetpFDeg()+set[j].ecart == o)
4917 *   && (pLmCmp(set[j].p,p->p) == -currRing->OrdSgn))
4918 *   {
4919 *     return j;
4920 *   }
4921 *   j++;
4922 * }
4923 *}
4924 */
4925{
4926  if (length<0) return 0;
4927
4928  int o = p->GetpFDeg() + p->ecart;
4929  int op = set[length].GetpFDeg() + set[length].ecart;
4930
4931  if ((op > o)
4932  || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4933    return length+1;
4934  int i;
4935  int an = 0;
4936  int en= length;
4937  loop
4938  {
4939    if (an >= en-1)
4940    {
4941      op = set[an].GetpFDeg() + set[an].ecart;
4942      if ((op > o)
4943      || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4944        return en;
4945      return an;
4946    }
4947    i=(an+en) / 2;
4948    op = set[i].GetpFDeg() + set[i].ecart;
4949    if ((op > o)
4950    || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4951      an=i;
4952    else
4953      en=i;
4954  }
4955}
4956
4957/*2
4958* looks up the position of polynomial p in set
4959* e is the ecart of p
4960* set[length] is the smallest element in set with respect
4961* to the ordering-procedure totaldegree
4962*/
4963int posInL17 (const LSet set, const int length,
4964              LObject* p,const kStrategy)
4965{
4966  if (length<0) return 0;
4967
4968  int o = p->GetpFDeg() + p->ecart;
4969
4970  if ((set[length].GetpFDeg() + set[length].ecart > o)
4971  || ((set[length].GetpFDeg() + set[length].ecart == o)
4972     && (set[length].ecart > p->ecart))
4973  || ((set[length].GetpFDeg() + set[length].ecart == o)
4974     && (set[length].ecart == p->ecart)
4975     && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4976    return length+1;
4977  int i;
4978  int an = 0;
4979  int en= length;
4980  loop
4981  {
4982    if (an >= en-1)
4983    {
4984      if ((set[an].GetpFDeg() + set[an].ecart > o)
4985      || ((set[an].GetpFDeg() + set[an].ecart == o)
4986         && (set[an].ecart > p->ecart))
4987      || ((set[an].GetpFDeg() + set[an].ecart == o)
4988         && (set[an].ecart == p->ecart)
4989         && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4990        return en;
4991      return an;
4992    }
4993    i=(an+en) / 2;
4994    if ((set[i].GetpFDeg() + set[i].ecart > o)
4995    || ((set[i].GetpFDeg() + set[i].ecart == o)
4996       && (set[i].ecart > p->ecart))
4997    || ((set[i].GetpFDeg() +set[i].ecart == o)
4998       && (set[i].ecart == p->ecart)
4999       && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
5000      an=i;
5001    else
5002      en=i;
5003  }
5004}
5005/*2
5006* looks up the position of polynomial p in set
5007* e is the ecart of p
5008* set[length] is the smallest element in set with respect
5009* to the ordering-procedure pComp
5010*/
5011int posInL17_c (const LSet set, const int length,
5012                LObject* p,const kStrategy)
5013{
5014  if (length<0) return 0;
5015
5016  int cc = (-1+2*currRing->order[0]==ringorder_c);
5017  /* cc==1 for (c,..), cc==-1 for (C,..) */
5018  unsigned long c = pGetComp(p->p)*cc;
5019  int o = p->GetpFDeg() + p->ecart;
5020
5021  if (pGetComp(set[length].p)*cc > c)
5022    return length+1;
5023  if (pGetComp(set[length].p)*cc == c)
5024  {
5025    if ((set[length].GetpFDeg() + set[length].ecart > o)
5026    || ((set[length].GetpFDeg() + set[length].ecart == o)
5027       && (set[length].ecart > p->ecart))
5028    || ((set[length].GetpFDeg() + set[length].ecart == o)
5029       && (set[length].ecart == p->ecart)
5030       && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
5031      return length+1;
5032  }
5033  int i;
5034  int an = 0;
5035  int en= length;
5036  loop
5037  {
5038    if (an >= en-1)
5039    {
5040      if (pGetComp(set[an].p)*cc > c)
5041        return en;
5042      if (pGetComp(set[an].p)*cc == c)
5043      {
5044        if ((set[an].GetpFDeg() + set[an].ecart > o)
5045        || ((set[an].GetpFDeg() + set[an].ecart == o)
5046           && (set[an].ecart > p->ecart))
5047        || ((set[an].GetpFDeg() + set[an].ecart == o)
5048           && (set[an].ecart == p->ecart)
5049           && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
5050          return en;
5051      }
5052      return an;
5053    }
5054    i=(an+en) / 2;
5055    if (pGetComp(set[i].p)*cc > c)
5056      an=i;
5057    else if (pGetComp(set[i].p)*cc == c)
5058    {
5059      if ((set[i].GetpFDeg() + set[i].ecart > o)
5060      || ((set[i].GetpFDeg() + set[i].ecart == o)
5061         && (set[i].ecart > p->ecart))
5062      || ((set[i].GetpFDeg() +set[i].ecart == o)
5063         && (set[i].ecart == p->ecart)
5064         && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
5065        an=i;
5066      else
5067        en=i;
5068    }
5069    else
5070      en=i;
5071  }
5072}
5073
5074/*
5075 * SYZYGY CRITERION for signature-based standard basis algorithms
5076 */
5077BOOLEAN syzCriterion(poly sig, unsigned long not_sevSig, kStrategy strat)
5078{
5079//#if 1
5080#ifdef DEBUGF5
5081  Print("syzygy criterion checks:  ");
5082  pWrite(sig);
5083#endif
5084  for (int k=0; k<strat->syzl; k++)
5085  {
5086    //printf("-%d",k);
5087//#if 1
5088#ifdef DEBUGF5
5089    Print("checking with: %d / %d --  \n",k,strat->syzl);
5090    pWrite(pHead(strat->syz[k]));
5091#endif
5092    if (p_LmShortDivisibleBy(strat->syz[k], strat->sevSyz[k], sig, not_sevSig, currRing))
5093    {
5094//#if 1
5095#ifdef DEBUGF5
5096      printf("DELETE!\n");
5097#endif
5098      //printf("- T -\n\n");
5099      return TRUE;
5100    }
5101  }
5102  //printf("- F -\n\n");
5103  return FALSE;
5104}
5105
5106/*
5107 * SYZYGY CRITERION for signature-based standard basis algorithms
5108 */
5109BOOLEAN syzCriterionInc(poly sig, unsigned long not_sevSig, kStrategy strat)
5110{
5111//#if 1
5112#ifdef DEBUGF5
5113  Print("--- syzygy criterion checks:  ");
5114  pWrite(sig);
5115#endif
5116  int comp = p_GetComp(sig, currRing);
5117  int min, max;
5118  if (comp<=1)
5119    return FALSE;
5120  else
5121  {
5122    min = strat->syzIdx[comp-2];
5123    //printf("SYZIDX %d/%d\n",strat->syzIdx[comp-2],comp-2);
5124    //printf("SYZIDX %d/%d\n",strat->syzIdx[comp-1],comp-1);
5125    //printf("SYZIDX %d/%d\n",strat->syzIdx[comp],comp);
5126    if (comp == strat->currIdx)
5127    {
5128      max = strat->syzl;
5129    }
5130    else
5131    {
5132      max = strat->syzIdx[comp-1];
5133    }
5134    for (int k=min; k<max; k++)
5135    {
5136#ifdef F5DEBUG
5137      printf("COMP %d/%d - MIN %d - MAX %d - SYZL %ld\n",comp,strat->currIdx,min,max,strat->syzl);
5138      Print("checking with: %d --  ",k);
5139      pWrite(pHead(strat->syz[k]));
5140#endif
5141      if (p_LmShortDivisibleBy(strat->syz[k], strat->sevSyz[k], sig, not_sevSig, currRing))
5142        return TRUE;
5143    }
5144    return FALSE;
5145  }
5146}
5147
5148/*
5149 * REWRITTEN CRITERION for signature-based standard basis algorithms
5150 */
5151BOOLEAN faugereRewCriterion(poly sig, unsigned long not_sevSig, poly /*lm*/, kStrategy strat, int start=0)
5152{
5153  //printf("Faugere Rewritten Criterion\n");
5154//#if 1
5155#ifdef DEBUGF5
5156  printf("rewritten criterion checks:  ");
5157  pWrite(sig);
5158#endif
5159  for(int k = strat->sl; k>=start; k--)
5160  {
5161//#if 1
5162#ifdef DEBUGF5
5163    Print("checking with:  ");
5164    pWrite(strat->sig[k]);
5165    pWrite(pHead(strat->S[k]));
5166#endif
5167    if (p_LmShortDivisibleBy(strat->sig[k], strat->sevSig[k], sig, not_sevSig, currRing))
5168    {
5169//#if 1
5170#ifdef DEBUGF5
5171      printf("DELETE!\n");
5172#endif
5173      return TRUE;
5174    }
5175    //k--;
5176  }
5177#ifdef DEBUGF5
5178  Print("ALL ELEMENTS OF S\n----------------------------------------\n");
5179  for(int kk = 0; kk<strat->sl+1; kk++)
5180  {
5181    pWrite(pHead(strat->S[kk]));
5182  }
5183  Print("------------------------------\n");
5184#endif
5185  return FALSE;
5186}
5187
5188/*
5189 * REWRITTEN CRITERION for signature-based standard basis algorithms
5190 ***************************************************************************
5191 * TODO:This should become the version of Arri/Perry resp. Bjarke/Stillman *
5192 ***************************************************************************
5193 */
5194
5195// real implementation of arri's rewritten criterion, only called once in
5196// kstd2.cc, right before starting reduction
5197// IDEA:  Arri says that it is enough to consider 1 polynomial for each unique
5198//        signature appearing during the computations. Thus we first of all go
5199//        through strat->L and delete all other pairs of the same signature,
5200//        keeping only the one with least possible leading monomial. After this
5201//        we check if we really need to compute this critical pair at all: There
5202//        can be elements already in strat->S whose signatures divide the
5203//        signature of the critical pair in question and whose multiplied
5204//        leading monomials are smaller than the leading monomial of the
5205//        critical pair. In this situation we can discard the critical pair
5206//        completely.
5207BOOLEAN arriRewCriterion(poly /*sig*/, unsigned long /*not_sevSig*/, poly /*lm*/, kStrategy strat, int start=0)
5208{
5209  poly p1 = pOne();
5210  poly p2 = pOne();
5211  for (int ii=strat->sl; ii>start; ii--)
5212  {
5213    if (p_LmShortDivisibleBy(strat->sig[ii], strat->sevSig[ii], strat->P.sig, ~strat->P.sevSig, currRing))
5214    {
5215      p_ExpVectorSum(p1,strat->P.sig,strat->S[ii],currRing);
5216      p_ExpVectorSum(p2,strat->sig[ii],strat->P.p,currRing);
5217      if (!(pLmCmp(p1,p2) == 1))
5218      {
5219        pDelete(&p1);
5220        pDelete(&p2);
5221        return TRUE;
5222      }
5223    }
5224  }
5225  pDelete(&p1);
5226  pDelete(&p2);
5227  return FALSE;
5228}
5229
5230BOOLEAN arriRewCriterionPre(poly sig, unsigned long not_sevSig, poly lm, kStrategy strat, int /*start=0*/)
5231{
5232  int found = -1;
5233  for (int i=strat->Bl; i>-1; i--) {
5234    if (pLmEqual(strat->B[i].sig,sig)) {
5235      found = i;
5236      break;
5237    }
5238  }
5239  if (found != -1) {
5240    if (pLmCmp(lm,strat->B[found].GetLmCurrRing()) == -1) {
5241      deleteInL(strat->B,&strat->Bl,found,strat);
5242    } else {
5243      return TRUE;
5244    }
5245  }
5246  poly p1 = pOne();
5247  poly p2 = pOne();
5248  for (int ii=strat->sl; ii>-1; ii--)
5249  {
5250    if (p_LmShortDivisibleBy(strat->sig[ii], strat->sevSig[ii], sig, not_sevSig, currRing))
5251    {
5252      p_ExpVectorSum(p1,sig,strat->S[ii],currRing);
5253      p_ExpVectorSum(p2,strat->sig[ii],lm,currRing);
5254      if (!(pLmCmp(p1,p2) == 1))
5255      {
5256        pDelete(&p1);
5257        pDelete(&p2);
5258        return TRUE;
5259      }
5260    }
5261  }
5262  pDelete(&p1);
5263  pDelete(&p2);
5264  return FALSE;
5265}
5266
5267/***************************************************************
5268 *
5269 * Tail reductions
5270 *
5271 ***************************************************************/
5272TObject*
5273kFindDivisibleByInS(kStrategy strat, int pos, LObject* L, TObject *T,
5274                    long ecart)
5275{
5276  int j = 0;
5277  const unsigned long not_sev = ~L->sev;
5278  const unsigned long* sev = strat->sevS;
5279  poly p;
5280  ring r;
5281  L->GetLm(p, r);
5282
5283  assume(~not_sev == p_GetShortExpVector(p, r));
5284
5285  if (r == currRing)
5286  {
5287    loop
5288    {
5289      if (j > pos) return NULL;
5290#if defined(PDEBUG) || defined(PDIV_DEBUG)
5291      if (p_LmShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
5292          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
5293        break;
5294#else
5295      if (!(sev[j] & not_sev) &&
5296          (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
5297          p_LmDivisibleBy(strat->S[j], p, r))
5298        break;
5299
5300#endif
5301      j++;
5302    }
5303    // if called from NF, T objects do not exist:
5304    if (strat->tl < 0 || strat->S_2_R[j] == -1)
5305    {
5306      T->Set(strat->S[j], r, strat->tailRing);
5307      return T;
5308    }
5309    else
5310    {
5311/////      assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL
5312/////      && strat->S_2_T(j)->p == strat->S[j]); // wrong?
5313//      assume (j >= 0 && j <= strat->sl && strat->S_2_T(j) != NULL && strat->S_2_T(j)->p == strat->S[j]);
5314      return strat->S_2_T(j);
5315    }
5316  }
5317  else
5318  {
5319    TObject* t;
5320    loop
5321    {
5322      if (j > pos) return NULL;
5323      assume(strat->S_2_R[j] != -1);
5324#if defined(PDEBUG) || defined(PDIV_DEBUG)
5325      t = strat->S_2_T(j);
5326      assume(t != NULL && t->t_p != NULL && t->tailRing == r);
5327      if (p_LmShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
5328          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
5329        return t;
5330#else
5331      if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
5332      {
5333        t = strat->S_2_T(j);
5334        assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
5335        if (p_LmDivisibleBy(t->t_p, p, r)) return t;
5336      }
5337#endif
5338      j++;
5339    }
5340  }
5341}
5342
5343poly redtail (LObject* L, int pos, kStrategy strat)
5344{
5345  poly h, hn;
5346  strat->redTailChange=FALSE;
5347
5348  poly p = L->p;
5349  if (strat->noTailReduction || pNext(p) == NULL)
5350    return p;
5351
5352  LObject Ln(strat->tailRing);
5353  TObject* With;
5354  // placeholder in case strat->tl < 0
5355  TObject  With_s(strat->tailRing);
5356  h = p;
5357  hn = pNext(h);
5358  long op = strat->tailRing->pFDeg(hn, strat->tailRing);
5359  long e;
5360  int l;
5361  BOOLEAN save_HE=strat->kHEdgeFound;
5362  strat->kHEdgeFound |=
5363    ((Kstd1_deg>0) && (op<=Kstd1_deg)) || TEST_OPT_INFREDTAIL;
5364
5365  while(hn != NULL)
5366  {
5367    op = strat->tailRing->pFDeg(hn, strat->tailRing);
5368    if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
5369    e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
5370    loop
5371    {
5372      Ln.Set(hn, strat->tailRing);
5373      Ln.sev = p_GetShortExpVector(hn, strat->tailRing);
5374      if (strat->kHEdgeFound)
5375        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
5376      else
5377        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s, e);
5378      if (With == NULL) break;
5379      With->length=0;
5380      With->pLength=0;
5381      strat->redTailChange=TRUE;
5382      if (ksReducePolyTail(L, With, h, strat->kNoetherTail()))
5383      {
5384        // reducing the tail would violate the exp bound
5385        if (kStratChangeTailRing(strat, L))
5386        {
5387          strat->kHEdgeFound = save_HE;
5388          return redtail(L, pos, strat);
5389        }
5390        else
5391          return NULL;
5392      }
5393      hn = pNext(h);
5394      if (hn == NULL) goto all_done;
5395      op = strat->tailRing->pFDeg(hn, strat->tailRing);
5396      if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
5397      e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
5398    }
5399    h = hn;
5400    hn = pNext(h);
5401  }
5402
5403  all_done:
5404  if (strat->redTailChange)
5405  {
5406    L->pLength = 0;
5407  }
5408  strat->kHEdgeFound = save_HE;
5409  return p;
5410}
5411
5412poly redtail (poly p, int pos, kStrategy strat)
5413{
5414  LObject L(p, currRing);
5415  return redtail(&L, pos, strat);
5416}
5417
5418poly redtailBba (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
5419{
5420#define REDTAIL_CANONICALIZE 100
5421  strat->redTailChange=FALSE;
5422  if (strat->noTailReduction) return L->GetLmCurrRing();
5423  poly h, p;
5424  p = h = L->GetLmTailRing();
5425  if ((h==NULL) || (pNext(h)==NULL))
5426    return L->GetLmCurrRing();
5427
5428  TObject* With;
5429  // placeholder in case strat->tl < 0
5430  TObject  With_s(strat->tailRing);
5431
5432  LObject Ln(pNext(h), strat->tailRing);
5433  Ln.pLength = L->GetpLength() - 1;
5434
5435  pNext(h) = NULL;
5436  if (L->p != NULL) pNext(L->p) = NULL;
5437  L->pLength = 1;
5438
5439  Ln.PrepareRed(strat->use_buckets);
5440
5441  int cnt=REDTAIL_CANONICALIZE;
5442  while(!Ln.IsNull())
5443  {
5444    loop
5445    {
5446      Ln.SetShortExpVector();
5447      if (withT)
5448      {
5449        int j;
5450        j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
5451        if (j < 0) break;
5452        With = &(strat->T[j]);
5453      }
5454      else
5455      {
5456        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
5457        if (With == NULL) break;
5458      }
5459      cnt--;
5460      if (cnt==0)
5461      {
5462        cnt=REDTAIL_CANONICALIZE;
5463        /*poly tmp=*/Ln.CanonicalizeP();
5464        if (normalize)
5465        {
5466          Ln.Normalize();
5467          //pNormalize(tmp);
5468          //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
5469        }
5470      }
5471      if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
5472      {
5473        With->pNorm();
5474      }
5475      strat->redTailChange=TRUE;
5476      if (ksReducePolyTail(L, With, &Ln))
5477      {
5478        // reducing the tail would violate the exp bound
5479        //  set a flag and hope for a retry (in bba)
5480        strat->completeReduce_retry=TRUE;
5481        if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
5482        do
5483        {
5484          pNext(h) = Ln.LmExtractAndIter();
5485          pIter(h);
5486          L->pLength++;
5487        } while (!Ln.IsNull());
5488        goto all_done;
5489      }
5490      if (Ln.IsNull()) goto all_done;
5491      if (! withT) With_s.Init(currRing);
5492    }
5493    pNext(h) = Ln.LmExtractAndIter();
5494    pIter(h);
5495    pNormalize(h);
5496    L->pLength++;
5497  }
5498
5499  all_done:
5500  Ln.Delete();
5501  if (L->p != NULL) pNext(L->p) = pNext(p);
5502
5503  if (strat->redTailChange)
5504  {
5505    L->length = 0;
5506    L->pLength = 0;
5507  }
5508
5509  //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
5510  //L->Normalize(); // HANNES: should have a test
5511  kTest_L(L);
5512  return L->GetLmCurrRing();
5513}
5514
5515#ifdef HAVE_RINGS
5516poly redtailBba_Z (LObject* L, int pos, kStrategy strat )
5517// normalize=FALSE, withT=FALSE, coeff=Z
5518{
5519  strat->redTailChange=FALSE;
5520  if (strat->noTailReduction) return L->GetLmCurrRing();
5521  poly h, p;
5522  p = h = L->GetLmTailRing();
5523  if ((h==NULL) || (pNext(h)==NULL))
5524    return L->GetLmCurrRing();
5525
5526  TObject* With;
5527  // placeholder in case strat->tl < 0
5528  TObject  With_s(strat->tailRing);
5529
5530  LObject Ln(pNext(h), strat->tailRing);
5531  Ln.pLength = L->GetpLength() - 1;
5532
5533  pNext(h) = NULL;
5534  if (L->p != NULL) pNext(L->p) = NULL;
5535  L->pLength = 1;
5536
5537  Ln.PrepareRed(strat->use_buckets);
5538
5539  int cnt=REDTAIL_CANONICALIZE;
5540  while(!Ln.IsNull())
5541  {
5542    loop
5543    {
5544      Ln.SetShortExpVector();
5545      With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
5546      if (With == NULL) break;
5547      cnt--;
5548      if (cnt==0)
5549      {
5550        cnt=REDTAIL_CANONICALIZE;
5551        /*poly tmp=*/Ln.CanonicalizeP();
5552      }
5553      // we are in Z, do not call pNorm
5554      strat->redTailChange=TRUE;
5555      // test divisibility of coefs:
5556      poly p_Ln=Ln.GetLmCurrRing();
5557      poly p_With=With->GetLmCurrRing();
5558      number z=n_IntMod(pGetCoeff(p_Ln),pGetCoeff(p_With), currRing->cf);
5559      if (!nIsZero(z))
5560      {
5561        // subtract z*Ln, add z.Ln to L
5562        poly m=pHead(p_Ln);
5563        pSetCoeff(m,z);
5564        poly mm=pHead(m);
5565        pNext(h) = m;
5566        pIter(h);
5567        L->pLength++;
5568        mm=pNeg(mm);
5569        if (Ln.bucket!=NULL)
5570        {
5571          int dummy=1;
5572          kBucket_Add_q(Ln.bucket,mm,&dummy);
5573        }
5574        else
5575        {
5576          if (Ln.p!=NULL) Ln.p=pAdd(Ln.p,mm);
5577          else if (Ln.t_p!=NULL)  Ln.t_p=p_Add_q(Ln.t_p,mm,strat->tailRing);
5578        }
5579      }
5580      else
5581        nDelete(&z);
5582
5583      if (ksReducePolyTail(L, With, &Ln))
5584      {
5585        // reducing the tail would violate the exp bound
5586        //  set a flag and hope for a retry (in bba)
5587        strat->completeReduce_retry=TRUE;
5588        if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
5589        do
5590        {
5591          pNext(h) = Ln.LmExtractAndIter();
5592          pIter(h);
5593          L->pLength++;
5594        } while (!Ln.IsNull());
5595        goto all_done;
5596      }
5597      if (Ln.IsNull()) goto all_done;
5598      With_s.Init(currRing);
5599    }
5600    pNext(h) = Ln.LmExtractAndIter();
5601    pIter(h);
5602    pNormalize(h);
5603    L->pLength++;
5604  }
5605
5606  all_done:
5607  Ln.Delete();
5608  if (L->p != NULL) pNext(L->p) = pNext(p);
5609
5610  if (strat->redTailChange)
5611  {
5612    L->length = 0;
5613  }
5614
5615  //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
5616  //L->Normalize(); // HANNES: should have a test
5617  kTest_L(L);
5618  return L->GetLmCurrRing();
5619}
5620#endif
5621
5622/*2
5623*checks the change degree and write progress report
5624*/
5625void message (int i,int* reduc,int* olddeg,kStrategy strat, int red_result)
5626{
5627  if (i != *olddeg)
5628  {
5629    Print("%d",i);
5630    *olddeg = i;
5631  }
5632  if (TEST_OPT_OLDSTD)
5633  {
5634    if (strat->Ll != *reduc)
5635    {
5636      if (strat->Ll != *reduc-1)
5637        Print("(%d)",strat->Ll+1);
5638      else
5639        PrintS("-");
5640      *reduc = strat->Ll;
5641    }
5642    else
5643      PrintS(".");
5644    mflush();
5645  }
5646  else
5647  {
5648    if (red_result == 0)
5649      PrintS("-");
5650    else if (red_result < 0)
5651      PrintS(".");
5652    if ((red_result > 0) || ((strat->Ll % 100)==99))
5653    {
5654      if (strat->Ll != *reduc && strat->Ll > 0)
5655      {
5656        Print("(%d)",strat->Ll+1);
5657        *reduc = strat->Ll;
5658      }
5659    }
5660  }
5661}
5662
5663/*2
5664*statistics
5665*/
5666void messageStat (int hilbcount,kStrategy strat)
5667{
5668  //PrintS("\nUsage/Allocation of temporary storage:\n");
5669  //Print("%d/%d polynomials in standard base\n",srmax,IDELEMS(Shdl));
5670  //Print("%d/%d polynomials in set L (for lazy alg.)",lrmax+1,strat->Lmax);
5671  Print("product criterion:%d chain criterion:%d\n",strat->cp,strat->c3);
5672  if (hilbcount!=0) Print("hilbert series criterion:%d\n",hilbcount);
5673  /* in usual case strat->cv is 0, it gets changed only in shift routines */
5674  if (strat->cv!=0) Print("shift V criterion:%d\n",strat->cv);
5675  /*mflush();*/
5676}
5677
5678#ifdef KDEBUG
5679/*2
5680*debugging output: all internal sets, if changed
5681*for testing purpuse only/has to be changed for later use
5682*/
5683void messageSets (kStrategy strat)
5684{
5685  int i;
5686  if (strat->news)
5687  {
5688    PrintS("set S");
5689    for (i=0; i<=strat->sl; i++)
5690    {
5691      Print("\n  %d:",i);
5692      p_wrp(strat->S[i], currRing, strat->tailRing);
5693    }
5694    strat->news = FALSE;
5695  }
5696  if (strat->newt)
5697  {
5698    PrintS("\nset T");
5699    for (i=0; i<=strat->tl; i++)
5700    {
5701      Print("\n  %d:",i);
5702      strat->T[i].wrp();
5703      Print(" o:%ld e:%d l:%d",
5704        strat->T[i].pFDeg(),strat->T[i].ecart,strat->T[i].length);
5705    }
5706    strat->newt = FALSE;
5707  }
5708  PrintS("\nset L");
5709  for (i=strat->Ll; i>=0; i--)
5710  {
5711    Print("\n%d:",i);
5712    p_wrp(strat->L[i].p1, currRing, strat->tailRing);
5713    PrintS("  ");
5714    p_wrp(strat->L[i].p2, currRing, strat->tailRing);
5715    PrintS(" lcm: ");p_wrp(strat->L[i].lcm, currRing);
5716    PrintS("\n  p : ");
5717    strat->L[i].wrp();
5718    Print("  o:%ld e:%d l:%d",
5719          strat->L[i].pFDeg(),strat->L[i].ecart,strat->L[i].length);
5720  }
5721  PrintLn();
5722}
5723
5724#endif
5725
5726
5727/*2
5728*construct the set s from F
5729*/
5730void initS (ideal F, ideal Q, kStrategy strat)
5731{
5732  int   i,pos;
5733
5734  if (Q!=NULL) i=((IDELEMS(F)+IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5735  else         i=((IDELEMS(F)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5736  strat->ecartS=initec(i);
5737  strat->sevS=initsevS(i);
5738  strat->S_2_R=initS_2_R(i);
5739  strat->fromQ=NULL;
5740  strat->Shdl=idInit(i,F->rank);
5741  strat->S=strat->Shdl->m;
5742  /*- put polys into S -*/
5743  if (Q!=NULL)
5744  {
5745    strat->fromQ=initec(i);
5746    memset(strat->fromQ,0,i*sizeof(int));
5747    for (i=0; i<IDELEMS(Q); i++)
5748    {
5749      if (Q->m[i]!=NULL)
5750      {
5751        LObject h;
5752        h.p = pCopy(Q->m[i]);
5753        if (TEST_OPT_INTSTRATEGY)
5754        {
5755          //pContent(h.p);
5756          h.pCleardenom(); // also does a pContent
5757        }
5758        else
5759        {
5760          h.pNorm();
5761        }
5762        if (currRing->OrdSgn==-1)
5763        {
5764          deleteHC(&h, strat);
5765        }
5766        if (h.p!=NULL)
5767        {
5768          strat->initEcart(&h);
5769          if (strat->sl==-1)
5770            pos =0;
5771          else
5772          {
5773            pos = posInS(strat,strat->sl,h.p,h.ecart);
5774          }
5775          h.sev = pGetShortExpVector(h.p);
5776          strat->enterS(h,pos,strat,-1);
5777          strat->fromQ[pos]=1;
5778        }
5779      }
5780    }
5781  }
5782  for (i=0; i<IDELEMS(F); i++)
5783  {
5784    if (F->m[i]!=NULL)
5785    {
5786      LObject h;
5787      h.p = pCopy(F->m[i]);
5788      if (currRing->OrdSgn==-1)
5789      {
5790                    /*#ifdef HAVE_RINGS
5791                          if (rField_is_Ring(currRing))
5792                            {
5793                            h.pCleardenom();
5794                            }
5795                          else
5796                                #endif*/
5797        cancelunit(&h);  /*- tries to cancel a unit -*/
5798        deleteHC(&h, strat);
5799      }
5800      if (h.p!=NULL)
5801      // do not rely on the input being a SB!
5802      {
5803        if (TEST_OPT_INTSTRATEGY)
5804        {
5805          //pContent(h.p);
5806          h.pCleardenom(); // also does a pContent
5807        }
5808        else
5809        {
5810          h.pNorm();
5811        }
5812        strat->initEcart(&h);
5813        if (strat->sl==-1)
5814          pos =0;
5815        else
5816          pos = posInS(strat,strat->sl,h.p,h.ecart);
5817        h.sev = pGetShortExpVector(h.p);
5818        strat->enterS(h,pos,strat,-1);
5819      }
5820    }
5821  }
5822  /*- test, if a unit is in F -*/
5823  if ((strat->sl>=0)
5824#ifdef HAVE_RINGS
5825       && n_IsUnit(pGetCoeff(strat->S[0]),currRing->cf)
5826#endif
5827       && pIsConstant(strat->S[0]))
5828  {
5829    while (strat->sl>0) deleteInS(strat->sl,strat);
5830  }
5831}
5832
5833void initSL (ideal F, ideal Q,kStrategy strat)
5834{
5835  int   i,pos;
5836
5837  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5838  else i=setmaxT;
5839  strat->ecartS=initec(i);
5840  strat->sevS=initsevS(i);
5841  strat->S_2_R=initS_2_R(i);
5842  strat->fromQ=NULL;
5843  strat->Shdl=idInit(i,F->rank);
5844  strat->S=strat->Shdl->m;
5845  /*- put polys into S -*/
5846  if (Q!=NULL)
5847  {
5848    strat->fromQ=initec(i);
5849    memset(strat->fromQ,0,i*sizeof(int));
5850    for (i=0; i<IDELEMS(Q); i++)
5851    {
5852      if (Q->m[i]!=NULL)
5853      {
5854        LObject h;
5855        h.p = pCopy(Q->m[i]);
5856        if (currRing->OrdSgn==-1)
5857        {
5858          deleteHC(&h,strat);
5859        }
5860        if (TEST_OPT_INTSTRATEGY)
5861        {
5862          //pContent(h.p);
5863          h.pCleardenom(); // also does a pContent
5864        }
5865        else
5866        {
5867          h.pNorm();
5868        }
5869        if (h.p!=NULL)
5870        {
5871          strat->initEcart(&h);
5872          if (strat->sl==-1)
5873            pos =0;
5874          else
5875          {
5876            pos = posInS(strat,strat->sl,h.p,h.ecart);
5877          }
5878          h.sev = pGetShortExpVector(h.p);
5879          strat->enterS(h,pos,strat,-1);
5880          strat->fromQ[pos]=1;
5881        }
5882      }
5883    }
5884  }
5885  for (i=0; i<IDELEMS(F); i++)
5886  {
5887    if (F->m[i]!=NULL)
5888    {
5889      LObject h;
5890      h.p = pCopy(F->m[i]);
5891      if (h.p!=NULL)
5892      {
5893        if (currRing->OrdSgn==-1)
5894        {
5895          cancelunit(&h);  /*- tries to cancel a unit -*/
5896          deleteHC(&h, strat);
5897        }
5898        if (h.p!=NULL)
5899        {
5900          if (TEST_OPT_INTSTRATEGY)
5901          {
5902            //pContent(h.p);
5903            h.pCleardenom(); // also does a pContent
5904          }
5905          else
5906          {
5907            h.pNorm();
5908          }
5909          strat->initEcart(&h);
5910          if (strat->Ll==-1)
5911            pos =0;
5912          else
5913            pos = strat->posInL(strat->L,strat->Ll,&h,strat);
5914          h.sev = pGetShortExpVector(h.p);
5915          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
5916        }
5917      }
5918    }
5919  }
5920  /*- test, if a unit is in F -*/
5921
5922  if ((strat->Ll>=0)
5923#ifdef HAVE_RINGS
5924       && n_IsUnit(pGetCoeff(strat->L[strat->Ll].p), currRing->cf)
5925#endif
5926       && pIsConstant(strat->L[strat->Ll].p))
5927  {
5928    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
5929  }
5930}
5931
5932void initSLSba (ideal F, ideal Q,kStrategy strat)
5933{
5934  int   i,pos;
5935  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5936  else i=setmaxT;
5937  strat->ecartS =   initec(i);
5938  strat->sevS   =   initsevS(i);
5939  strat->sevSig =   initsevS(i);
5940  strat->S_2_R  =   initS_2_R(i);
5941  strat->fromQ  =   NULL;
5942  strat->Shdl   =   idInit(i,F->rank);
5943  strat->S      =   strat->Shdl->m;
5944  strat->sig    =   (poly *)omAlloc0(i*sizeof(poly));
5945  if (strat->sbaOrder != 1)
5946  {
5947    strat->syz    = (poly *)omAlloc0(i*sizeof(poly));
5948    strat->sevSyz = initsevS(i);
5949    strat->syzmax = i;
5950    strat->syzl   = 0;
5951  }
5952  /*- put polys into S -*/
5953  if (Q!=NULL)
5954  {
5955    strat->fromQ=initec(i);
5956    memset(strat->fromQ,0,i*sizeof(int));
5957    for (i=0; i<IDELEMS(Q); i++)
5958    {
5959      if (Q->m[i]!=NULL)
5960      {
5961        LObject h;
5962        h.p = pCopy(Q->m[i]);
5963        if (currRing->OrdSgn==-1)
5964        {
5965          deleteHC(&h,strat);
5966        }
5967        if (TEST_OPT_INTSTRATEGY)
5968        {
5969          //pContent(h.p);
5970          h.pCleardenom(); // also does a pContent
5971        }
5972        else
5973        {
5974          h.pNorm();
5975        }
5976        if (h.p!=NULL)
5977        {
5978          strat->initEcart(&h);
5979          if (strat->sl==-1)
5980            pos =0;
5981          else
5982          {
5983            pos = posInS(strat,strat->sl,h.p,h.ecart);
5984          }
5985          h.sev = pGetShortExpVector(h.p);
5986          strat->enterS(h,pos,strat,-1);
5987          strat->fromQ[pos]=1;
5988        }
5989      }
5990    }
5991  }
5992  for (i=0; i<IDELEMS(F); i++)
5993  {
5994    if (F->m[i]!=NULL)
5995    {
5996      LObject h;
5997      h.p = pCopy(F->m[i]);
5998      h.sig = pOne();
5999      //h.sig = pInit();
6000      //p_SetCoeff(h.sig,nInit(1),currRing);
6001      p_SetComp(h.sig,i+1,currRing);
6002      // if we are working with the Schreyer order we generate it
6003      // by multiplying the initial signatures with the leading monomial
6004      // of the corresponding initial polynomials generating the ideal
6005      // => we can keep the underlying monomial order and get a Schreyer
6006      //    order without any bigger overhead
6007      if (strat->sbaOrder == 0 || strat->sbaOrder == 3)
6008      {
6009        p_ExpVectorAdd (h.sig,F->m[i],currRing);
6010      }
6011      h.sevSig = pGetShortExpVector(h.sig);
6012#ifdef DEBUGF5
6013      pWrite(h.p);
6014      pWrite(h.sig);
6015#endif
6016      if (h.p!=NULL)
6017      {
6018        if (currRing->OrdSgn==-1)
6019        {
6020          cancelunit(&h);  /*- tries to cancel a unit -*/
6021          deleteHC(&h, strat);
6022        }
6023        if (h.p!=NULL)
6024        {
6025          if (TEST_OPT_INTSTRATEGY)
6026          {
6027            //pContent(h.p);
6028            h.pCleardenom(); // also does a pContent
6029          }
6030          else
6031          {
6032            h.pNorm();
6033          }
6034          strat->initEcart(&h);
6035          if (strat->Ll==-1)
6036            pos =0;
6037          else
6038            pos = strat->posInLSba(strat->L,strat->Ll,&h,strat);
6039          h.sev = pGetShortExpVector(h.p);
6040          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
6041        }
6042      }
6043      /*
6044      if (strat->sbaOrder != 1)
6045      {
6046        for(j=0;j<i;j++)
6047        {
6048          strat->syz[ctr] = pCopy(F->m[j]);
6049          p_SetCompP(strat->syz[ctr],i+1,currRing);
6050          // add LM(F->m[i]) to the signature to get a Schreyer order
6051          // without changing the underlying polynomial ring at all
6052          p_ExpVectorAdd (strat->syz[ctr],F->m[i],currRing);
6053          // since p_Add_q() destroys all input
6054          // data we need to recreate help
6055          // each time
6056          poly help = pCopy(F->m[i]);
6057          p_SetCompP(help,j+1,currRing);
6058          pWrite(strat->syz[ctr]);
6059          pWrite(help);
6060          printf("%d\n",pLmCmp(strat->syz[ctr],help));
6061          strat->syz[ctr] = p_Add_q(strat->syz[ctr],help,currRing);
6062          printf("%d. SYZ  ",ctr);
6063          pWrite(strat->syz[ctr]);
6064          strat->sevSyz[ctr] = p_GetShortExpVector(strat->syz[ctr],currRing);
6065          ctr++;
6066        }
6067        strat->syzl = ps;
6068      }
6069      */
6070    }
6071  }
6072  /*- test, if a unit is in F -*/
6073
6074  if ((strat->Ll>=0)
6075#ifdef HAVE_RINGS
6076       && n_IsUnit(pGetCoeff(strat->L[strat->Ll].p), currRing->cf)
6077#endif
6078       && pIsConstant(strat->L[strat->Ll].p))
6079  {
6080    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
6081  }
6082}
6083
6084void initSyzRules (kStrategy strat)
6085{
6086  if( strat->S[0] )
6087  {
6088    if( strat->S[1] )
6089    {
6090      omFreeSize(strat->syzIdx,(strat->syzidxmax)*sizeof(int));
6091      omFreeSize(strat->sevSyz,(strat->syzmax)*sizeof(unsigned long));
6092      omFreeSize(strat->syz,(strat->syzmax)*sizeof(poly));
6093    }
6094    int i, j, k, diff, comp, comp_old, ps=0, ctr=0;
6095    /************************************************************
6096     * computing the length of the syzygy array needed
6097     ***********************************************************/
6098    for(i=1; i<=strat->sl; i++)
6099    {
6100      if (pGetComp(strat->sig[i-1]) != pGetComp(strat->sig[i]))
6101      {
6102        ps += i;
6103      }
6104    }
6105    ps += strat->sl+1;
6106    //comp              = pGetComp (strat->P.sig);
6107    comp              = strat->currIdx;
6108    strat->syzIdx     = initec(comp);
6109    strat->sevSyz     = initsevS(ps);
6110    strat->syz        = (poly *)omAlloc(ps*sizeof(poly));
6111    strat->syzmax     = ps;
6112    strat->syzl       = 0;
6113    strat->syzidxmax  = comp;
6114#if defined(DEBUGF5) || defined(DEBUGF51)
6115    printf("------------- GENERATING SYZ RULES NEW ---------------\n");
6116#endif
6117    i = 1;
6118    j = 0;
6119    /************************************************************
6120     * generating the leading terms of the principal syzygies
6121     ***********************************************************/
6122    while (i <= strat->sl)
6123    {
6124      /**********************************************************
6125       * principal syzygies start with component index 2
6126       * the array syzIdx starts with index 0
6127       * => the rules for a signature with component comp start
6128       *    at strat->syz[strat->syzIdx[comp-2]] !
6129       *********************************************************/
6130      if (pGetComp(strat->sig[i-1]) != pGetComp(strat->sig[i]))
6131      {
6132        comp      = pGetComp(strat->sig[i]);
6133        comp_old  = pGetComp(strat->sig[i-1]);
6134        diff      = comp - comp_old - 1;
6135        // diff should be zero, but sometimes also the initial generating
6136        // elements of the input ideal reduce to zero. then there is an
6137        // index-gap between the signatures. for these inbetween signatures we
6138        // can safely set syzIdx[j] = 0 as no such element will be ever computed
6139        // in the following.
6140        // doing this, we keep the relation "j = comp - 2" alive, which makes
6141        // jumps way easier when checking criteria
6142        while (diff>0)
6143        {
6144          strat->syzIdx[j]  = 0;
6145          diff--;
6146          j++;
6147        }
6148        strat->syzIdx[j]  = ctr;
6149        j++;
6150        LObject Q;
6151        int pos;
6152        for (k = 0; k<i; k++)
6153        {
6154          Q.sig          = pOne();
6155          p_ExpVectorCopy(Q.sig,strat->S[k],currRing);
6156          p_SetCompP (Q.sig, comp, currRing);
6157          poly q          = p_One(currRing);
6158          p_ExpVectorCopy(q,strat->S[i],currRing);
6159          q               = p_Neg (q, currRing);
6160          p_SetCompP (q, p_GetComp(strat->sig[k], currRing), currRing);
6161          Q.sig = p_Add_q (Q.sig, q, currRing);
6162          Q.sevSig  = p_GetShortExpVector(Q.sig,currRing);
6163          pos = posInSyz(strat, Q.sig);
6164          enterSyz(Q, strat, pos);
6165          ctr++;
6166        }
6167      }
6168      i++;
6169    }
6170    /**************************************************************
6171    * add syzygies for upcoming first element of new iteration step
6172    **************************************************************/
6173    comp      = strat->currIdx;
6174    comp_old  = pGetComp(strat->sig[i-1]);
6175    diff      = comp - comp_old - 1;
6176    // diff should be zero, but sometimes also the initial generating
6177    // elements of the input ideal reduce to zero. then there is an
6178    // index-gap between the signatures. for these inbetween signatures we
6179    // can safely set syzIdx[j] = 0 as no such element will be ever computed
6180    // in the following.
6181    // doing this, we keep the relation "j = comp - 2" alive, which makes
6182    // jumps way easier when checking criteria
6183    while (diff>0)
6184    {
6185      strat->syzIdx[j]  = 0;
6186      diff--;
6187      j++;
6188    }
6189    strat->syzIdx[j]  = ctr;
6190    LObject Q;
6191    int pos;
6192    for (k = 0; k<strat->sl+1; k++)
6193    {
6194      Q.sig          = pOne();
6195      p_ExpVectorCopy(Q.sig,strat->S[k],currRing);
6196      p_SetCompP (Q.sig, comp, currRing);
6197      poly q          = p_One(currRing);
6198      p_ExpVectorCopy(q,strat->L[strat->Ll].p,currRing);
6199      q               = p_Neg (q, currRing);
6200      p_SetCompP (q, p_GetComp(strat->sig[k], currRing), currRing);
6201      Q.sig = p_Add_q (Q.sig, q, currRing);
6202      Q.sevSig = p_GetShortExpVector(Q.sig,currRing);
6203      pos = posInSyz(strat, Q.sig);
6204      enterSyz(Q, strat, pos);
6205      ctr++;
6206    }
6207//#if 1
6208#ifdef DEBUGF5
6209    Print("Principal syzygies:\n");
6210    printf("syzl   %d\n",strat->syzl);
6211    printf("syzmax %d\n",strat->syzmax);
6212    printf("ps     %d\n",ps);
6213    Print("--------------------------------\n");
6214    for(i=0;i<=strat->syzl-1;i++)
6215    {
6216      printf("%d - ",i);
6217      pWrite(strat->syz[i]);
6218    }
6219    for(i=0;i<strat->currIdx;i++)
6220    {
6221      printf("%d - %d\n",i,strat->syzIdx[i]);
6222    }
6223    Print("--------------------------------\n");
6224#endif
6225
6226  }
6227}
6228
6229
6230
6231/*2
6232*construct the set s from F and {P}
6233*/
6234void initSSpecial (ideal F, ideal Q, ideal P,kStrategy strat)
6235{
6236  int   i,pos;
6237
6238  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
6239  else i=setmaxT;
6240  i=((i+IDELEMS(F)+IDELEMS(P)+15)/16)*16;
6241  strat->ecartS=initec(i);
6242  strat->sevS=initsevS(i);
6243  strat->S_2_R=initS_2_R(i);
6244  strat->fromQ=NULL;
6245  strat->Shdl=idInit(i,F->rank);
6246  strat->S=strat->Shdl->m;
6247
6248  /*- put polys into S -*/
6249  if (Q!=NULL)
6250  {
6251    strat->fromQ=initec(i);
6252    memset(strat->fromQ,0,i*sizeof(int));
6253    for (i=0; i<IDELEMS(Q); i++)
6254    {
6255      if (Q->m[i]!=NULL)
6256      {
6257        LObject h;
6258        h.p = pCopy(Q->m[i]);
6259        //if (TEST_OPT_INTSTRATEGY)
6260        //{
6261        //  //pContent(h.p);
6262        //  h.pCleardenom(); // also does a pContent
6263        //}
6264        //else
6265        //{
6266        //  h.pNorm();
6267        //}
6268        if (currRing->OrdSgn==-1)
6269        {
6270          deleteHC(&h,strat);
6271        }
6272        if (h.p!=NULL)
6273        {
6274          strat->initEcart(&h);
6275          if (strat->sl==-1)
6276            pos =0;
6277          else
6278          {
6279            pos = posInS(strat,strat->sl,h.p,h.ecart);
6280          }
6281          h.sev = pGetShortExpVector(h.p);
6282          strat->enterS(h,pos,strat, strat->tl+1);
6283          enterT(h, strat);
6284          strat->fromQ[pos]=1;
6285        }
6286      }
6287    }
6288  }
6289  /*- put polys into S -*/
6290  for (i=0; i<IDELEMS(F); i++)
6291  {
6292    if (F->m[i]!=NULL)
6293    {
6294      LObject h;
6295      h.p = pCopy(F->m[i]);
6296      if (currRing->OrdSgn==-1)
6297      {
6298        deleteHC(&h,strat);
6299      }
6300      else
6301      {
6302        h.p=redtailBba(h.p,strat->sl,strat);
6303      }
6304      if (h.p!=NULL)
6305      {
6306        strat->initEcart(&h);
6307        if (strat->sl==-1)
6308          pos =0;
6309        else
6310          pos = posInS(strat,strat->sl,h.p,h.ecart);
6311        h.sev = pGetShortExpVector(h.p);
6312        strat->enterS(h,pos,strat, strat->tl+1);
6313        enterT(h,strat);
6314      }
6315    }
6316  }
6317  for (i=0; i<IDELEMS(P); i++)
6318  {
6319    if (P->m[i]!=NULL)
6320    {
6321      LObject h;
6322      h.p=pCopy(P->m[i]);
6323      if (TEST_OPT_INTSTRATEGY)
6324      {
6325        h.pCleardenom();
6326      }
6327      else
6328      {
6329        h.pNorm();
6330      }
6331      if(strat->sl>=0)
6332      {
6333        if (currRing->OrdSgn==1)
6334        {
6335          h.p=redBba(h.p,strat->sl,strat);
6336          if (h.p!=NULL)
6337          {
6338            h.p=redtailBba(h.p,strat->sl,strat);
6339          }
6340        }
6341        else
6342        {
6343          h.p=redMora(h.p,strat->sl,strat);
6344        }
6345        if(h.p!=NULL)
6346        {
6347          strat->initEcart(&h);
6348          if (TEST_OPT_INTSTRATEGY)
6349          {
6350            h.pCleardenom();
6351          }
6352          else
6353          {
6354            h.is_normalized = 0;
6355            h.pNorm();
6356          }
6357          h.sev = pGetShortExpVector(h.p);
6358          h.SetpFDeg();
6359          pos = posInS(strat,strat->sl,h.p,h.ecart);
6360          enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
6361          strat->enterS(h,pos,strat, strat->tl+1);
6362          enterT(h,strat);
6363        }
6364      }
6365      else
6366      {
6367        h.sev = pGetShortExpVector(h.p);
6368        strat->initEcart(&h);
6369        strat->enterS(h,0,strat, strat->tl+1);
6370        enterT(h,strat);
6371      }
6372    }
6373  }
6374}
6375/*2
6376*construct the set s from F and {P}
6377*/
6378
6379void initSSpecialSba (ideal F, ideal Q, ideal P,kStrategy strat)
6380{
6381  int   i,pos;
6382
6383  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
6384  else i=setmaxT;
6385  i=((i+IDELEMS(F)+IDELEMS(P)+15)/16)*16;
6386  strat->sevS=initsevS(i);
6387  strat->sevSig=initsevS(i);
6388  strat->S_2_R=initS_2_R(i);
6389  strat->fromQ=NULL;
6390  strat->Shdl=idInit(i,F->rank);
6391  strat->S=strat->Shdl->m;
6392  strat->sig=(poly *)omAlloc0(i*sizeof(poly));
6393  /*- put polys into S -*/
6394  if (Q!=NULL)
6395  {
6396    strat->fromQ=initec(i);
6397    memset(strat->fromQ,0,i*sizeof(int));
6398    for (i=0; i<IDELEMS(Q); i++)
6399    {
6400      if (Q->m[i]!=NULL)
6401      {
6402        LObject h;
6403        h.p = pCopy(Q->m[i]);
6404        //if (TEST_OPT_INTSTRATEGY)
6405        //{
6406        //  //pContent(h.p);
6407        //  h.pCleardenom(); // also does a pContent
6408        //}
6409        //else
6410        //{
6411        //  h.pNorm();
6412        //}
6413        if (currRing->OrdSgn==-1)
6414        {
6415          deleteHC(&h,strat);
6416        }
6417        if (h.p!=NULL)
6418        {
6419          strat->initEcart(&h);
6420          if (strat->sl==-1)
6421            pos =0;
6422          else
6423          {
6424            pos = posInS(strat,strat->sl,h.p,h.ecart);
6425          }
6426          h.sev = pGetShortExpVector(h.p);
6427          strat->enterS(h,pos,strat, strat->tl+1);
6428          enterT(h, strat);
6429          strat->fromQ[pos]=1;
6430        }
6431      }
6432    }
6433  }
6434  /*- put polys into S -*/
6435  for (i=0; i<IDELEMS(F); i++)
6436  {
6437    if (F->m[i]!=NULL)
6438    {
6439      LObject h;
6440      h.p = pCopy(F->m[i]);
6441      if (currRing->OrdSgn==-1)
6442      {
6443        deleteHC(&h,strat);
6444      }
6445      else
6446      {
6447        h.p=redtailBba(h.p,strat->sl,strat);
6448      }
6449      if (h.p!=NULL)
6450      {
6451        strat->initEcart(&h);
6452        if (strat->sl==-1)
6453          pos =0;
6454        else
6455          pos = posInS(strat,strat->sl,h.p,h.ecart);
6456        h.sev = pGetShortExpVector(h.p);
6457        strat->enterS(h,pos,strat, strat->tl+1);
6458        enterT(h,strat);
6459      }
6460    }
6461  }
6462  for (i=0; i<IDELEMS(P); i++)
6463  {
6464    if (P->m[i]!=NULL)
6465    {
6466      LObject h;
6467      h.p=pCopy(P->m[i]);
6468      if (TEST_OPT_INTSTRATEGY)
6469      {
6470        h.pCleardenom();
6471      }
6472      else
6473      {
6474        h.pNorm();
6475      }
6476      if(strat->sl>=0)
6477      {
6478        if (currRing->OrdSgn==1)
6479        {
6480          h.p=redBba(h.p,strat->sl,strat);
6481          if (h.p!=NULL)
6482          {
6483            h.p=redtailBba(h.p,strat->sl,strat);
6484          }
6485        }
6486        else
6487        {
6488          h.p=redMora(h.p,strat->sl,strat);
6489        }
6490        if(h.p!=NULL)
6491        {
6492          strat->initEcart(&h);
6493          if (TEST_OPT_INTSTRATEGY)
6494          {
6495            h.pCleardenom();
6496          }
6497          else
6498          {
6499            h.is_normalized = 0;
6500            h.pNorm();
6501          }
6502          h.sev = pGetShortExpVector(h.p);
6503          h.SetpFDeg();
6504          pos = posInS(strat,strat->sl,h.p,h.ecart);
6505          enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
6506          strat->enterS(h,pos,strat, strat->tl+1);
6507          enterT(h,strat);
6508        }
6509      }
6510      else
6511      {
6512        h.sev = pGetShortExpVector(h.p);
6513        strat->initEcart(&h);
6514        strat->enterS(h,0,strat, strat->tl+1);
6515        enterT(h,strat);
6516      }
6517    }
6518  }
6519}
6520/*2
6521* reduces h using the set S
6522* procedure used in cancelunit1
6523*/
6524static poly redBba1 (poly h,int maxIndex,kStrategy strat)
6525{
6526  int j = 0;
6527  unsigned long not_sev = ~ pGetShortExpVector(h);
6528
6529  while (j <= maxIndex)
6530  {
6531    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j],h, not_sev))
6532       return ksOldSpolyRedNew(strat->S[j],h,strat->kNoetherTail());
6533    else j++;
6534  }
6535  return h;
6536}
6537
6538/*2
6539*tests if p.p=monomial*unit and cancels the unit
6540*/
6541void cancelunit1 (LObject* p,int *suc, int index,kStrategy strat )
6542{
6543  int k;
6544  poly r,h,h1,q;
6545
6546  if (!pIsVector((*p).p) && ((*p).ecart != 0))
6547  {
6548#ifdef HAVE_RINGS_LOC
6549    // Leading coef have to be a unit
6550    if ( !(nIsUnit(p_GetCoeff((*p).p, r))) ) return;
6551#endif
6552    k = 0;
6553    h1 = r = pCopy((*p).p);
6554    h =pNext(r);
6555    loop
6556    {
6557      if (h==NULL)
6558      {
6559        pDelete(&r);
6560        pDelete(&(pNext((*p).p)));
6561        (*p).ecart = 0;
6562        (*p).length = 1;
6563#ifdef HAVE_RINGS_LOC
6564        (*p).pLength = 1;  // Why wasn't this set already?
6565#endif
6566        (*suc)=0;
6567        return;
6568      }
6569      if (!pDivisibleBy(r,h))
6570      {
6571        q=redBba1(h,index ,strat);
6572        if (q != h)
6573        {
6574          k++;
6575          pDelete(&h);
6576          pNext(h1) = h = q;
6577        }
6578        else
6579        {
6580          pDelete(&r);
6581          return;
6582        }
6583      }
6584      else
6585      {
6586        h1 = h;
6587        pIter(h);
6588      }
6589      if (k > 10)
6590      {
6591        pDelete(&r);
6592        return;
6593      }
6594    }
6595  }
6596}
6597
6598#if 0
6599/*2
6600* reduces h using the elements from Q in the set S
6601* procedure used in updateS
6602* must not be used for elements of Q or elements of an ideal !
6603*/
6604static poly redQ (poly h, int j, kStrategy strat)
6605{
6606  int start;
6607  unsigned long not_sev = ~ pGetShortExpVector(h);
6608  while ((j <= strat->sl) && (pGetComp(strat->S[j])!=0)) j++;
6609  start=j;
6610  while (j<=strat->sl)
6611  {
6612    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
6613    {
6614      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
6615      if (h==NULL) return NULL;
6616      j = start;
6617      not_sev = ~ pGetShortExpVector(h);
6618    }
6619    else j++;
6620  }
6621  return h;
6622}
6623#endif
6624
6625/*2
6626* reduces h using the set S
6627* procedure used in updateS
6628*/
6629static poly redBba (poly h,int maxIndex,kStrategy strat)
6630{
6631  int j = 0;
6632  unsigned long not_sev = ~ pGetShortExpVector(h);
6633
6634  while (j <= maxIndex)
6635  {
6636    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
6637    {
6638      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
6639      if (h==NULL) return NULL;
6640      j = 0;
6641      not_sev = ~ pGetShortExpVector(h);    }
6642    else j++;
6643  }
6644  return h;
6645}
6646
6647/*2
6648* reduces h using the set S
6649*e is the ecart of h
6650*procedure used in updateS
6651*/
6652static poly redMora (poly h,int maxIndex,kStrategy strat)
6653{
6654  int  j=0;
6655  int  e,l;
6656  unsigned long not_sev = ~ pGetShortExpVector(h);
6657
6658  if (maxIndex >= 0)
6659  {
6660    e = currRing->pLDeg(h,&l,currRing)-p_FDeg(h,currRing);
6661    do
6662    {
6663      if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev)
6664      && ((e >= strat->ecartS[j]) || strat->kHEdgeFound))
6665      {
6666#ifdef KDEBUG
6667        if (TEST_OPT_DEBUG)
6668          {PrintS("reduce ");wrp(h);Print(" with S[%d] (",j);wrp(strat->S[j]);}
6669#endif
6670        h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
6671#ifdef KDEBUG
6672        if(TEST_OPT_DEBUG)
6673          {PrintS(")\nto "); wrp(h); PrintLn();}
6674#endif
6675        // pDelete(&h);
6676        if (h == NULL) return NULL;
6677        e = currRing->pLDeg(h,&l,currRing)-p_FDeg(h,currRing);
6678        j = 0;
6679        not_sev = ~ pGetShortExpVector(h);
6680      }
6681      else j++;
6682    }
6683    while (j <= maxIndex);
6684  }
6685  return h;
6686}
6687
6688/*2
6689*updates S:
6690*the result is a set of polynomials which are in
6691*normalform with respect to S
6692*/
6693void updateS(BOOLEAN toT,kStrategy strat)
6694{
6695  LObject h;
6696  int i, suc=0;
6697  poly redSi=NULL;
6698  BOOLEAN change,any_change;
6699//  Print("nach initS: updateS start mit sl=%d\n",(strat->sl));
6700//  for (i=0; i<=(strat->sl); i++)
6701//  {
6702//    Print("s%d:",i);
6703//    if (strat->fromQ!=NULL) Print("(Q:%d) ",strat->fromQ[i]);
6704//    pWrite(strat->S[i]);
6705//  }
6706//  Print("currRing->OrdSgn=%d\n", currRing->OrdSgn);
6707  any_change=FALSE;
6708  if (currRing->OrdSgn==1)
6709  {
6710    while (suc != -1)
6711    {
6712      i=suc+1;
6713      while (i<=strat->sl)
6714      {
6715        change=FALSE;
6716        #ifdef HAVE_RINGS
6717        if(rField_is_Ring(currRing))
6718            any_change = FALSE;
6719        #endif
6720        if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
6721        {
6722          redSi = pHead(strat->S[i]);
6723          strat->S[i] = redBba(strat->S[i],i-1,strat);
6724          //if ((strat->ak!=0)&&(strat->S[i]!=NULL))
6725          //  strat->S[i]=redQ(strat->S[i],i+1,strat); /*reduce S[i] mod Q*/
6726          if (pCmp(redSi,strat->S[i])!=0)
6727          {
6728            change=TRUE;
6729            any_change=TRUE;
6730            #ifdef KDEBUG
6731            if (TEST_OPT_DEBUG)
6732            {
6733              PrintS("reduce:");
6734              wrp(redSi);PrintS(" to ");p_wrp(strat->S[i], currRing, strat->tailRing);PrintLn();
6735            }
6736            #endif
6737            if (TEST_OPT_PROT)
6738            {
6739              if (strat->S[i]==NULL)
6740                PrintS("V");
6741              else
6742                PrintS("v");
6743              mflush();
6744            }
6745          }
6746          pLmDelete(&redSi);
6747          if (strat->S[i]==NULL)
6748          {
6749            deleteInS(i,strat);
6750            i--;
6751          }
6752          else if (change)
6753          {
6754            if (TEST_OPT_INTSTRATEGY)
6755            {
6756              if (TEST_OPT_CONTENTSB)
6757                {
6758                  number n;
6759                  p_Cleardenom_n(strat->S[i], currRing, n);// also does a pContent
6760                  if (!nIsOne(n))
6761                    {
6762                      denominator_list denom=(denominator_list)omAlloc(sizeof(denominator_list_s));
6763                      denom->n=nInvers(n);
6764                      denom->next=DENOMINATOR_LIST;
6765                      DENOMINATOR_LIST=denom;
6766                    }
6767                  nDelete(&n);
6768                }
6769              else
6770                {
6771                  //pContent(strat->S[i]);
6772                  strat->S[i]=p_Cleardenom(strat->S[i], currRing);// also does a pContent
6773                }
6774            }
6775            else
6776            {
6777              pNorm(strat->S[i]);
6778            }
6779            strat->sevS[i] = pGetShortExpVector(strat->S[i]);
6780          }
6781        }
6782        i++;
6783      }
6784      if (any_change) reorderS(&suc,strat);
6785      else break;
6786    }
6787    if (toT)
6788    {
6789      for (i=0; i<=strat->sl; i++)
6790      {
6791        if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
6792        {
6793          h.p = redtailBba(strat->S[i],i-1,strat);
6794          if (TEST_OPT_INTSTRATEGY)
6795          {
6796            h.pCleardenom();// also does a pContent
6797          }
6798        }
6799        else
6800        {
6801          h.p = strat->S[i];
6802        }
6803        strat->initEcart(&h);
6804        if (strat->honey)
6805        {
6806          strat->ecartS[i] = h.ecart;
6807        }
6808        if (strat->sevS[i] == 0) {strat->sevS[i] = pGetShortExpVector(h.p);}
6809        else assume(strat->sevS[i] == pGetShortExpVector(h.p));
6810        h.sev = strat->sevS[i];
6811        /*puts the elements of S also to T*/
6812        strat->initEcart(&h);
6813        enterT(h,strat);
6814        strat->S_2_R[i] = strat->tl;
6815      }
6816    }
6817  }
6818  else
6819  {
6820    while (suc != -1)
6821    {
6822      i=suc;
6823      while (i<=strat->sl)
6824      {
6825        change=FALSE;
6826        if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
6827        {
6828          redSi=pHead((strat->S)[i]);
6829          (strat->S)[i] = redMora((strat->S)[i],i-1,strat);
6830          if ((strat->S)[i]==NULL)
6831          {
6832            deleteInS(i,strat);
6833            i--;
6834          }
6835          else if (pCmp((strat->S)[i],redSi)!=0)
6836          {
6837            any_change=TRUE;
6838            h.p = strat->S[i];
6839            strat->initEcart(&h);
6840            strat->ecartS[i] = h.ecart;
6841            if (TEST_OPT_INTSTRATEGY)
6842            {
6843              if (TEST_OPT_CONTENTSB)
6844                {
6845                  number n;
6846                  p_Cleardenom_n(strat->S[i], currRing, n);// also does a pContent
6847                  if (!nIsOne(n))
6848                    {
6849                      denominator_list denom=(denominator_list)omAlloc(sizeof(denominator_list_s));
6850                      denom->n=nInvers(n);
6851                      denom->next=DENOMINATOR_LIST;
6852                      DENOMINATOR_LIST=denom;
6853                    }
6854                  nDelete(&n);
6855                }
6856              else
6857                {
6858                  //pContent(strat->S[i]);
6859                  strat->S[i]=p_Cleardenom(strat->S[i], currRing);// also does a pContent
6860                }
6861            }
6862            else
6863            {
6864              pNorm(strat->S[i]); // == h.p
6865            }
6866            h.sev =  pGetShortExpVector(h.p);
6867            strat->sevS[i] = h.sev;
6868          }
6869          pLmDelete(&redSi);
6870          kTest(strat);
6871        }
6872        i++;
6873      }
6874#ifdef KDEBUG
6875      kTest(strat);
6876#endif
6877      if (any_change) reorderS(&suc,strat);
6878      else { suc=-1; break; }
6879      if (h.p!=NULL)
6880      {
6881        if (!strat->kHEdgeFound)
6882        {
6883          /*strat->kHEdgeFound =*/ HEckeTest(h.p,strat);
6884        }
6885        if (strat->kHEdgeFound)
6886          newHEdge(strat);
6887      }
6888    }
6889    for (i=0; i<=strat->sl; i++)
6890    {
6891      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
6892      {
6893        strat->S[i] = h.p = redtail(strat->S[i],strat->sl,strat);
6894        strat->initEcart(&h);
6895        strat->ecartS[i] = h.ecart;
6896        h.sev = pGetShortExpVector(h.p);
6897        strat->sevS[i] = h.sev;
6898      }
6899      else
6900      {
6901        h.p = strat->S[i];
6902        h.ecart=strat->ecartS[i];
6903        h.sev = strat->sevS[i];
6904        h.length = h.pLength = pLength(h.p);
6905      }
6906      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
6907        cancelunit1(&h,&suc,strat->sl,strat);
6908      h.SetpFDeg();
6909      /*puts the elements of S also to T*/
6910      enterT(h,strat);
6911      strat->S_2_R[i] = strat->tl;
6912    }
6913    if (suc!= -1) updateS(toT,strat);
6914  }
6915#ifdef KDEBUG
6916  kTest(strat);
6917#endif
6918}
6919
6920
6921/*2
6922* -puts p to the standardbasis s at position at
6923* -saves the result in S
6924*/
6925void enterSBba (LObject p,int atS,kStrategy strat, int atR)
6926{
6927  strat->news = TRUE;
6928  /*- puts p to the standardbasis s at position at -*/
6929  if (strat->sl == IDELEMS(strat->Shdl)-1)
6930  {
6931    strat->sevS = (unsigned long*) omRealloc0Size(strat->sevS,
6932                                    IDELEMS(strat->Shdl)*sizeof(unsigned long),
6933                                    (IDELEMS(strat->Shdl)+setmaxTinc)
6934                                                  *sizeof(unsigned long));
6935    strat->ecartS = (intset)omReallocSize(strat->ecartS,
6936                                          IDELEMS(strat->Shdl)*sizeof(int),
6937                                          (IDELEMS(strat->Shdl)+setmaxTinc)
6938                                                  *sizeof(int));
6939    strat->S_2_R = (int*) omRealloc0Size(strat->S_2_R,
6940                                         IDELEMS(strat->Shdl)*sizeof(int),
6941                                         (IDELEMS(strat->Shdl)+setmaxTinc)
6942                                                  *sizeof(int));
6943    if (strat->lenS!=NULL)
6944      strat->lenS=(int*)omRealloc0Size(strat->lenS,
6945                                       IDELEMS(strat->Shdl)*sizeof(int),
6946                                       (IDELEMS(strat->Shdl)+setmaxTinc)
6947                                                 *sizeof(int));
6948    if (strat->lenSw!=NULL)
6949      strat->lenSw=(wlen_type*)omRealloc0Size(strat->lenSw,
6950                                       IDELEMS(strat->Shdl)*sizeof(wlen_type),
6951                                       (IDELEMS(strat->Shdl)+setmaxTinc)
6952                                                 *sizeof(wlen_type));
6953    if (strat->fromQ!=NULL)
6954    {
6955      strat->fromQ = (intset)omReallocSize(strat->fromQ,
6956                                    IDELEMS(strat->Shdl)*sizeof(int),
6957                                    (IDELEMS(strat->Shdl)+setmaxTinc)*sizeof(int));
6958    }
6959    pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmaxTinc);
6960    IDELEMS(strat->Shdl)+=setmaxTinc;
6961    strat->Shdl->m=strat->S;
6962  }
6963  if (atS <= strat->sl)
6964  {
6965#ifdef ENTER_USE_MEMMOVE
6966// #if 0
6967    memmove(&(strat->S[atS+1]), &(strat->S[atS]),
6968            (strat->sl - atS + 1)*sizeof(poly));
6969    memmove(&(strat->ecartS[atS+1]), &(strat->ecartS[atS]),
6970            (strat->sl - atS + 1)*sizeof(int));
6971    memmove(&(strat->sevS[atS+1]), &(strat->sevS[atS]),
6972            (strat->sl - atS + 1)*sizeof(unsigned long));
6973    memmove(&(strat->S_2_R[atS+1]), &(strat->S_2_R[atS]),
6974            (strat->sl - atS + 1)*sizeof(int));
6975    if (strat->lenS!=NULL)
6976    memmove(&(strat->lenS[atS+1]), &(strat->lenS[atS]),
6977            (strat->sl - atS + 1)*sizeof(int));
6978    if (strat->lenSw!=NULL)
6979    memmove(&(strat->lenSw[atS+1]), &(strat->lenSw[atS]),
6980            (strat->sl - atS + 1)*sizeof(wlen_type));
6981#else
6982    for (i=strat->sl+1; i>=atS+1; i--)
6983    {
6984      strat->S[i] = strat->S[i-1];
6985      strat->ecartS[i] = strat->ecartS[i-1];
6986      strat->sevS[i] = strat->sevS[i-1];
6987      strat->S_2_R[i] = strat->S_2_R[i-1];
6988    }
6989    if (strat->lenS!=NULL)
6990    for (i=strat->sl+1; i>=atS+1; i--)
6991      strat->lenS[i] = strat->lenS[i-1];
6992    if (strat->lenSw!=NULL)
6993    for (i=strat->sl+1; i>=atS+1; i--)
6994      strat->lenSw[i] = strat->lenSw[i-1];
6995#endif
6996  }
6997  if (strat->fromQ!=NULL)
6998  {
6999#ifdef ENTER_USE_MEMMOVE
7000    memmove(&(strat->fromQ[atS+1]), &(strat->fromQ[atS]),
7001                  (strat->sl - atS + 1)*sizeof(int));
7002#else
7003    for (i=strat->sl+1; i>=atS+1; i--)
7004    {
7005      strat->fromQ[i] = strat->fromQ[i-1];
7006    }
7007#endif
7008    strat->fromQ[atS]=0;
7009  }
7010
7011  /*- save result -*/
7012  strat->S[atS] = p.p;
7013  if (strat->honey) strat->ecartS[atS] = p.ecart;
7014  if (p.sev == 0)
7015    p.sev = pGetShortExpVector(p.p);
7016  else
7017    assume(p.sev == pGetShortExpVector(p.p));
7018  strat->sevS[atS] = p.sev;
7019  strat->ecartS[atS] = p.ecart;
7020  strat->S_2_R[atS] = atR;
7021  strat->sl++;
7022}
7023
7024/*2
7025* -puts p to the standardbasis s at position at
7026* -saves the result in S
7027*/
7028void enterSSba (LObject p,int atS,kStrategy strat, int atR)
7029{
7030  strat->news = TRUE;
7031  /*- puts p to the standardbasis s at position at -*/
7032  if (strat->sl == IDELEMS(strat->Shdl)-1)
7033  {
7034    strat->sevS = (unsigned long*) omRealloc0Size(strat->sevS,
7035                                    IDELEMS(strat->Shdl)*sizeof(unsigned long),
7036                                    (IDELEMS(strat->Shdl)+setmaxTinc)
7037                                                  *sizeof(unsigned long));
7038    strat->sevSig = (unsigned long*) omRealloc0Size(strat->sevSig,
7039                                    IDELEMS(strat->Shdl)*sizeof(unsigned long),
7040                                    (IDELEMS(strat->Shdl)+setmaxTinc)
7041                                                  *sizeof(unsigned long));
7042    strat->ecartS = (intset)omReallocSize(strat->ecartS,
7043                                          IDELEMS(strat->Shdl)*sizeof(int),
7044                                          (IDELEMS(strat->Shdl)+setmaxTinc)
7045                                                  *sizeof(int));
7046    strat->S_2_R = (int*) omRealloc0Size(strat->S_2_R,
7047                                         IDELEMS(strat->Shdl)*sizeof(int),
7048                                         (IDELEMS(strat->Shdl)+setmaxTinc)
7049                                                  *sizeof(int));
7050    if (strat->lenS!=NULL)
7051      strat->lenS=(int*)omRealloc0Size(strat->lenS,
7052                                       IDELEMS(strat->Shdl)*sizeof(int),
7053                                       (IDELEMS(strat->Shdl)+setmaxTinc)
7054                                                 *sizeof(int));
7055    if (strat->lenSw!=NULL)
7056      strat->lenSw=(wlen_type*)omRealloc0Size(strat->lenSw,
7057                                       IDELEMS(strat->Shdl)*sizeof(wlen_type),
7058                                       (IDELEMS(strat->Shdl)+setmaxTinc)
7059                                                 *sizeof(wlen_type));
7060    if (strat->fromQ!=NULL)
7061    {
7062      strat->fromQ = (intset)omReallocSize(strat->fromQ,
7063                                    IDELEMS(strat->Shdl)*sizeof(int),
7064                                    (IDELEMS(strat->Shdl)+setmaxTinc)*sizeof(int));
7065    }
7066    pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmaxTinc);
7067    pEnlargeSet(&strat->sig,IDELEMS(strat->Shdl),setmaxTinc);
7068    IDELEMS(strat->Shdl)+=setmaxTinc;
7069    strat->Shdl->m=strat->S;
7070  }
7071  // in a signature-based algorithm the following situation will never
7072  // appear due to the fact that the critical pairs are already sorted
7073  // by increasing signature.
7074  if (atS <= strat->sl)
7075  {
7076#ifdef ENTER_USE_MEMMOVE
7077// #if 0
7078    memmove(&(strat->S[atS+1]), &(strat->S[atS]),
7079            (strat->sl - atS + 1)*sizeof(poly));
7080    memmove(&(strat->ecartS[atS+1]), &(strat->ecartS[atS]),
7081            (strat->sl - atS + 1)*sizeof(int));
7082    memmove(&(strat->sevS[atS+1]), &(strat->sevS[atS]),
7083            (strat->sl - atS + 1)*sizeof(unsigned long));
7084    memmove(&(strat->S_2_R[atS+1]), &(strat->S_2_R[atS]),
7085            (strat->sl - atS + 1)*sizeof(int));
7086    if (strat->lenS!=NULL)
7087    memmove(&(strat->lenS[atS+1]), &(strat->lenS[atS]),
7088            (strat->sl - atS + 1)*sizeof(int));
7089    if (strat->lenSw!=NULL)
7090    memmove(&(strat->lenSw[atS+1]), &(strat->lenSw[atS]),
7091            (strat->sl - atS + 1)*sizeof(wlen_type));
7092#else
7093    for (i=strat->sl+1; i>=atS+1; i--)
7094    {
7095      strat->S[i] = strat->S[i-1];
7096      strat->ecartS[i] = strat->ecartS[i-1];
7097      strat->sevS[i] = strat->sevS[i-1];
7098      strat->S_2_R[i] = strat->S_2_R[i-1];
7099    }
7100    if (strat->lenS!=NULL)
7101    for (i=strat->sl+1; i>=atS+1; i--)
7102      strat->lenS[i] = strat->lenS[i-1];
7103    if (strat->lenSw!=NULL)
7104    for (i=strat->sl+1; i>=atS+1; i--)
7105      strat->lenSw[i] = strat->lenSw[i-1];
7106#endif
7107  }
7108  if (strat->fromQ!=NULL)
7109  {
7110#ifdef ENTER_USE_MEMMOVE
7111    memmove(&(strat->fromQ[atS+1]), &(strat->fromQ[atS]),
7112                  (strat->sl - atS + 1)*sizeof(int));
7113#else
7114    for (i=strat->sl+1; i>=atS+1; i--)
7115    {
7116      strat->fromQ[i] = strat->fromQ[i-1];
7117    }
7118#endif
7119    strat->fromQ[atS]=0;
7120  }
7121
7122  /*- save result -*/
7123  strat->S[atS] = p.p;
7124  strat->sig[atS] = p.sig; // TODO: get ths correct signature in here!
7125  if (strat->honey) strat->ecartS[atS] = p.ecart;
7126  if (p.sev == 0)
7127    p.sev = pGetShortExpVector(p.p);
7128  else
7129    assume(p.sev == pGetShortExpVector(p.p));
7130  strat->sevS[atS] = p.sev;
7131  // during the interreduction process of a signature-based algorithm we do not
7132  // compute the signature at this point, but when the whole interreduction
7133  // process finishes, i.e. f5c terminates!
7134  if (p.sig != NULL)
7135  {
7136    if (p.sevSig == 0)
7137      p.sevSig = pGetShortExpVector(p.sig);
7138    else
7139      assume(p.sevSig == pGetShortExpVector(p.sig));
7140    strat->sevSig[atS] = p.sevSig; // TODO: get the correct signature in here!
7141  }
7142  strat->ecartS[atS] = p.ecart;
7143  strat->S_2_R[atS] = atR;
7144  strat->sl++;
7145#ifdef DEBUGF5
7146  int k;
7147  Print("--- LIST S: %d ---\n",strat->sl);
7148  for(k=0;k<=strat->sl;k++)
7149  {
7150    pWrite(strat->sig[k]);
7151  }
7152  Print("--- LIST S END ---\n");
7153#endif
7154}
7155
7156/*2
7157* puts p to the set T at position atT
7158*/
7159void enterT(LObject p, kStrategy strat, int atT)
7160{
7161  int i;
7162
7163  pp_Test(p.p, currRing, p.tailRing);
7164  assume(strat->tailRing == p.tailRing);
7165  // redMoraNF complains about this -- but, we don't really
7166  // neeed this so far
7167  assume(p.pLength == 0 || pLength(p.p) == p.pLength || rIsSyzIndexRing(currRing)); // modulo syzring
7168  assume(p.FDeg == p.pFDeg());
7169  assume(!p.is_normalized || nIsOne(pGetCoeff(p.p)));
7170
7171#ifdef KDEBUG
7172  // do not put an LObject twice into T:
7173  for(i=strat->tl;i>=0;i--)
7174  {
7175    if (p.p==strat->T[i].p)
7176    {
7177      printf("already in T at pos %d of %d, atT=%d\n",i,strat->tl,atT);
7178      return;
7179    }
7180  }
7181#endif
7182#ifdef HAVE_TAIL_RING
7183  if (currRing!=strat->tailRing)
7184  {
7185    p.t_p=p.GetLmTailRing();
7186  }
7187#endif
7188  strat->newt = TRUE;
7189  if (atT < 0)
7190    atT = strat->posInT(strat->T, strat->tl, p);
7191  if (strat->tl == strat->tmax-1)
7192    enlargeT(strat->T,strat->R,strat->sevT,strat->tmax,setmaxTinc);
7193  if (atT <= strat->tl)
7194  {
7195#ifdef ENTER_USE_MEMMOVE
7196    memmove(&(strat->T[atT+1]), &(strat->T[atT]),
7197            (strat->tl-atT+1)*sizeof(TObject));
7198    memmove(&(strat->sevT[atT+1]), &(strat->sevT[atT]),
7199            (strat->tl-atT+1)*sizeof(unsigned long));
7200#endif
7201    for (i=strat->tl+1; i>=atT+1; i--)
7202    {
7203#ifndef ENTER_USE_MEMMOVE
7204      strat->T[i] = strat->T[i-1];
7205      strat->sevT[i] = strat->sevT[i-1];
7206#endif
7207      strat->R[strat->T[i].i_r] = &(strat->T[i]);
7208    }
7209  }
7210
7211  if ((strat->tailBin != NULL) && (pNext(p.p) != NULL))
7212  {
7213    pNext(p.p)=p_ShallowCopyDelete(pNext(p.p),
7214                                   (strat->tailRing != NULL ?
7215                                    strat->tailRing : currRing),
7216                                   strat->tailBin);
7217    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
7218  }
7219  strat->T[atT] = (TObject) p;
7220
7221  if (strat->tailRing != currRing && pNext(p.p) != NULL)
7222    strat->T[atT].max = p_GetMaxExpP(pNext(p.p), strat->tailRing);
7223  else
7224    strat->T[atT].max = NULL;
7225
7226  strat->tl++;
7227  strat->R[strat->tl] = &(strat->T[atT]);
7228  strat->T[atT].i_r = strat->tl;
7229  assume(p.sev == 0 || pGetShortExpVector(p.p) == p.sev);
7230  strat->sevT[atT] = (p.sev == 0 ? pGetShortExpVector(p.p) : p.sev);
7231  kTest_T(&(strat->T[atT]));
7232}
7233
7234
7235/*2
7236* puts signature p.sig to the set syz
7237*/
7238void enterSyz(LObject p, kStrategy strat, int atT)
7239{
7240  int i;
7241  strat->newt = TRUE;
7242  if (strat->syzl == strat->syzmax-1)
7243  {
7244    pEnlargeSet(&strat->syz,strat->syzmax,setmaxTinc);
7245    strat->sevSyz = (unsigned long*) omRealloc0Size(strat->sevSyz,
7246                                    (strat->syzmax)*sizeof(unsigned long),
7247                                    ((strat->syzmax)+setmaxTinc)
7248                                                  *sizeof(unsigned long));
7249    strat->syzmax += setmaxTinc;
7250  }
7251  if (atT < strat->syzl)
7252  {
7253#ifdef ENTER_USE_MEMMOVE
7254    memmove(&(strat->syz[atT+1]), &(strat->syz[atT]),
7255            (strat->syzl-atT+1)*sizeof(poly));
7256    memmove(&(strat->sevSyz[atT+1]), &(strat->sevSyz[atT]),
7257            (strat->syzl-atT+1)*sizeof(unsigned long));
7258#endif
7259    for (i=strat->syzl; i>=atT+1; i--)
7260    {
7261#ifndef ENTER_USE_MEMMOVE
7262      strat->syz[i] = strat->syz[i-1];
7263      strat->sevSyz[i] = strat->sevSyz[i-1];
7264#endif
7265    }
7266  }
7267  //i = strat->syzl;
7268  i = atT;
7269  strat->syz[atT] = p.sig;
7270  strat->sevSyz[atT] = p.sevSig;
7271  strat->syzl++;
7272#if F5DEBUG
7273  Print("element in strat->syz: %d--%d  ",atT+1,strat->syzmax);
7274  pWrite(strat->syz[atT]);
7275#endif
7276  // recheck pairs in strat->L with new rule and delete correspondingly
7277  int cc = strat->Ll;
7278  while (cc>-1)
7279  {
7280    if (p_LmShortDivisibleBy( strat->syz[atT], strat->sevSyz[atT],
7281                              strat->L[cc].sig, ~strat->L[cc].sevSig, currRing))
7282    {
7283      deleteInL(strat->L,&strat->Ll,cc,strat);
7284    }
7285    cc--;
7286  }
7287//#if 1
7288#ifdef DEBUGF5
7289    Print("--- Syzygies ---\n");
7290    printf("syzl   %d\n",strat->syzl);
7291    printf("syzmax %d\n",strat->syzmax);
7292    Print("--------------------------------\n");
7293    for(i=0;i<=strat->syzl-1;i++)
7294    {
7295      printf("%d - ",i);
7296      pWrite(strat->syz[i]);
7297    }
7298    Print("--------------------------------\n");
7299#endif
7300}
7301
7302
7303void initHilbCrit(ideal/*F*/, ideal /*Q*/, intvec **hilb,kStrategy strat)
7304{
7305
7306  //if the ordering is local, then hilb criterion
7307  //can be used also if tzhe ideal is not homogenous
7308  if((currRing->OrdSgn == -1) && (currRing->MixedOrder == 0 ))
7309  #ifdef HAVE_RINGS
7310  {
7311  if(rField_is_Ring(currRing))
7312          *hilb=NULL;
7313  else
7314           return;
7315  }
7316#endif
7317  if (strat->homog!=isHomog)
7318  {
7319    *hilb=NULL;
7320  }
7321}
7322
7323void initBuchMoraCrit(kStrategy strat)
7324{
7325  strat->enterOnePair=enterOnePairNormal;
7326  strat->chainCrit=chainCritNormal;
7327#ifdef HAVE_RINGS
7328  if (rField_is_Ring(currRing))
7329  {
7330    strat->enterOnePair=enterOnePairRing;
7331    strat->chainCrit=chainCritRing;
7332  }
7333#endif
7334#ifdef HAVE_RATGRING
7335  if (rIsRatGRing(currRing))
7336  {
7337     strat->chainCrit=chainCritPart;
7338     /* enterOnePairNormal get rational part in it */
7339  }
7340#endif
7341
7342  strat->sugarCrit =        TEST_OPT_SUGARCRIT;
7343  strat->Gebauer =          strat->homog || strat->sugarCrit;
7344  strat->honey =            !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
7345  if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
7346  strat->pairtest = NULL;
7347  /* alway use tailreduction, except:
7348  * - in local rings, - in lex order case, -in ring over extensions */
7349  strat->noTailReduction = !TEST_OPT_REDTAIL;
7350
7351#ifdef HAVE_PLURAL
7352  // and r is plural_ring
7353  //  hence this holds for r a rational_plural_ring
7354  if( rIsPluralRing(currRing) || (rIsSCA(currRing) && !strat->z2homog) )
7355  {    //or it has non-quasi-comm type... later
7356    strat->sugarCrit = FALSE;
7357    strat->Gebauer = FALSE;
7358    strat->honey = FALSE;
7359  }
7360#endif
7361
7362#ifdef HAVE_RINGS
7363  // Coefficient ring?
7364  if (rField_is_Ring(currRing))
7365  {
7366    strat->sugarCrit = FALSE;
7367    strat->Gebauer = FALSE ;
7368    strat->honey = FALSE;
7369  }
7370#endif
7371  #ifdef KDEBUG
7372  if (TEST_OPT_DEBUG)
7373  {
7374    if (strat->homog) PrintS("ideal/module is homogeneous\n");
7375    else              PrintS("ideal/module is not homogeneous\n");
7376  }
7377  #endif
7378}
7379
7380void initSbaCrit(kStrategy strat)
7381{
7382  //strat->enterOnePair=enterOnePairNormal;
7383  strat->enterOnePair = enterOnePairNormal;
7384  //strat->chainCrit=chainCritNormal;
7385  strat->chainCrit    = chainCritSig;
7386  /******************************************
7387   * rewCrit1 and rewCrit2 are already set in
7388   * kSba() in kstd1.cc
7389   *****************************************/
7390  //strat->rewCrit1     = faugereRewCriterion;
7391  if (strat->sbaOrder == 1)
7392  {
7393    strat->syzCrit  = syzCriterionInc;
7394  }
7395  else
7396  {
7397    strat->syzCrit  = syzCriterion;
7398  }
7399#ifdef HAVE_RINGS
7400  if (rField_is_Ring(currRing))
7401  {
7402    strat->enterOnePair=enterOnePairRing;
7403    strat->chainCrit=chainCritRing;
7404  }
7405#endif
7406#ifdef HAVE_RATGRING
7407  if (rIsRatGRing(currRing))
7408  {
7409     strat->chainCrit=chainCritPart;
7410     /* enterOnePairNormal get rational part in it */
7411  }
7412#endif
7413
7414  strat->sugarCrit =        TEST_OPT_SUGARCRIT;
7415  strat->Gebauer =          strat->homog || strat->sugarCrit;
7416  strat->honey =            !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
7417  if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
7418  strat->pairtest = NULL;
7419  /* alway use tailreduction, except:
7420  * - in local rings, - in lex order case, -in ring over extensions */
7421  strat->noTailReduction = !TEST_OPT_REDTAIL;
7422  //strat->noTailReduction = NULL;
7423
7424#ifdef HAVE_PLURAL
7425  // and r is plural_ring
7426  //  hence this holds for r a rational_plural_ring
7427  if( rIsPluralRing(currRing) || (rIsSCA(currRing) && !strat->z2homog) )
7428  {    //or it has non-quasi-comm type... later
7429    strat->sugarCrit = FALSE;
7430    strat->Gebauer = FALSE;
7431    strat->honey = FALSE;
7432  }
7433#endif
7434
7435#ifdef HAVE_RINGS
7436  // Coefficient ring?
7437  if (rField_is_Ring(currRing))
7438  {
7439    strat->sugarCrit = FALSE;
7440    strat->Gebauer = FALSE ;
7441    strat->honey = FALSE;
7442  }
7443#endif
7444  #ifdef KDEBUG
7445  if (TEST_OPT_DEBUG)
7446  {
7447    if (strat->homog) PrintS("ideal/module is homogeneous\n");
7448    else              PrintS("ideal/module is not homogeneous\n");
7449  }
7450  #endif
7451}
7452
7453BOOLEAN kPosInLDependsOnLength(int (*pos_in_l)
7454                               (const LSet set, const int length,
7455                                LObject* L,const kStrategy strat))
7456{
7457  if (pos_in_l == posInL110 ||
7458      pos_in_l == posInL10)
7459    return TRUE;
7460
7461  return FALSE;
7462}
7463
7464void initBuchMoraPos (kStrategy strat)
7465{
7466  if (currRing->OrdSgn==1)
7467  {
7468    if (strat->honey)
7469    {
7470      strat->posInL = posInL15;
7471      // ok -- here is the deal: from my experiments for Singular-2-0
7472      // I conclude that that posInT_EcartpLength is the best of
7473      // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
7474      // see the table at the end of this file
7475      if (TEST_OPT_OLDSTD)
7476        strat->posInT = posInT15;
7477      else
7478        strat->posInT = posInT_EcartpLength;
7479    }
7480    else if (currRing->pLexOrder && !TEST_OPT_INTSTRATEGY)
7481    {
7482      strat->posInL = posInL11;
7483      strat->posInT = posInT11;
7484    }
7485    else if (TEST_OPT_INTSTRATEGY)
7486    {
7487      strat->posInL = posInL11;
7488      strat->posInT = posInT11;
7489    }
7490    else
7491    {
7492      strat->posInL = posInL0;
7493      strat->posInT = posInT0;
7494    }
7495    //if (strat->minim>0) strat->posInL =posInLSpecial;
7496    if (strat->homog)
7497    {
7498       strat->posInL = posInL110;
7499       strat->posInT = posInT110;
7500    }
7501  }
7502  else
7503  {
7504    if (strat->homog)
7505    {
7506      strat->posInL = posInL11;
7507      strat->posInT = posInT11;
7508    }
7509    else
7510    {
7511      if ((currRing->order[0]==ringorder_c)
7512      ||(currRing->order[0]==ringorder_C))
7513      {
7514        strat->posInL = posInL17_c;
7515        strat->posInT = posInT17_c;
7516      }
7517      else
7518      {
7519        strat->posInL = posInL17;
7520        strat->posInT = posInT17;
7521      }
7522    }
7523  }
7524  if (strat->minim>0) strat->posInL =posInLSpecial;
7525  // for further tests only
7526  if ((BTEST1(11)) || (BTEST1(12)))
7527    strat->posInL = posInL11;
7528  else if ((BTEST1(13)) || (BTEST1(14)))
7529    strat->posInL = posInL13;
7530  else if ((BTEST1(15)) || (BTEST1(16)))
7531    strat->posInL = posInL15;
7532  else if ((BTEST1(17)) || (BTEST1(18)))
7533    strat->posInL = posInL17;
7534  if (BTEST1(11))
7535    strat->posInT = posInT11;
7536  else if (BTEST1(13))
7537    strat->posInT = posInT13;
7538  else if (BTEST1(15))
7539    strat->posInT = posInT15;
7540  else if ((BTEST1(17)))
7541    strat->posInT = posInT17;
7542  else if ((BTEST1(19)))
7543    strat->posInT = posInT19;
7544  else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
7545    strat->posInT = posInT1;
7546#ifdef HAVE_RINGS
7547  if (rField_is_Ring(currRing))
7548  {
7549    strat->posInL = posInL11;
7550    strat->posInT = posInT11;
7551  }
7552#endif
7553  strat->posInLDependsOnLength = kPosInLDependsOnLength(strat->posInL);
7554}
7555
7556void initBuchMora (ideal F,ideal Q,kStrategy strat)
7557{
7558  strat->interpt = BTEST1(OPT_INTERRUPT);
7559  strat->kHEdge=NULL;
7560  if (currRing->OrdSgn==1) strat->kHEdgeFound=FALSE;
7561  /*- creating temp data structures------------------- -*/
7562  strat->cp = 0;
7563  strat->c3 = 0;
7564  strat->tail = pInit();
7565  /*- set s -*/
7566  strat->sl = -1;
7567  /*- set L -*/
7568  strat->Lmax = ((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
7569  strat->Ll = -1;
7570  strat->L = initL(((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc);
7571  /*- set B -*/
7572  strat->Bmax = setmaxL;
7573  strat->Bl = -1;
7574  strat->B = initL();
7575  /*- set T -*/
7576  strat->tl = -1;
7577  strat->tmax = setmaxT;
7578  strat->T = initT();
7579  strat->R = initR();
7580  strat->sevT = initsevT();
7581  /*- init local data struct.---------------------------------------- -*/
7582  strat->P.ecart=0;
7583  strat->P.length=0;
7584  if (currRing->OrdSgn==-1)
7585  {
7586    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
7587    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
7588  }
7589  #ifdef HAVE_RINGS
7590  if(rField_is_Ring(currRing))
7591  {
7592    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
7593  }
7594  else
7595  #endif
7596  {
7597    if(TEST_OPT_SB_1)
7598    {
7599        int i;
7600        ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
7601        for (i=strat->newIdeal;i<IDELEMS(F);i++)
7602        {
7603          P->m[i-strat->newIdeal] = F->m[i];
7604          F->m[i] = NULL;
7605        }
7606        initSSpecial(F,Q,P,strat);
7607        for (i=strat->newIdeal;i<IDELEMS(F);i++)
7608        {
7609          F->m[i] = P->m[i-strat->newIdeal];
7610          P->m[i-strat->newIdeal] = NULL;
7611        }
7612        idDelete(&P);
7613    }
7614
7615    else
7616    {
7617      /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
7618      // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
7619    }
7620  }
7621  strat->fromT = FALSE;
7622  strat->noTailReduction = !TEST_OPT_REDTAIL;
7623  if ((!TEST_OPT_SB_1)
7624  #ifdef HAVE_RINGS
7625  || (rField_is_Ring(currRing))
7626  #endif
7627  )
7628  {
7629    updateS(TRUE,strat);
7630  }
7631  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
7632  strat->fromQ=NULL;
7633}
7634
7635void exitBuchMora (kStrategy strat)
7636{
7637  /*- release temp data -*/
7638  cleanT(strat);
7639  omFreeSize(strat->T,(strat->tmax)*sizeof(TObject));
7640  omFreeSize(strat->R,(strat->tmax)*sizeof(TObject*));
7641  omFreeSize(strat->sevT, (strat->tmax)*sizeof(unsigned long));
7642  omFreeSize(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
7643  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
7644  omFreeSize(strat->S_2_R,IDELEMS(strat->Shdl)*sizeof(int));
7645  /*- set L: should be empty -*/
7646  omFreeSize(strat->L,(strat->Lmax)*sizeof(LObject));
7647  /*- set B: should be empty -*/
7648  omFreeSize(strat->B,(strat->Bmax)*sizeof(LObject));
7649  pLmDelete(&strat->tail);
7650  strat->syzComp=0;
7651}
7652
7653void initSbaPos (kStrategy strat)
7654{
7655  if (currRing->OrdSgn==1)
7656  {
7657    if (strat->honey)
7658    {
7659      strat->posInL = posInL15;
7660      // ok -- here is the deal: from my experiments for Singular-2-0
7661      // I conclude that that posInT_EcartpLength is the best of
7662      // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
7663      // see the table at the end of this file
7664      if (TEST_OPT_OLDSTD)
7665        strat->posInT = posInT15;
7666      else
7667        strat->posInT = posInT_EcartpLength;
7668    }
7669    else if (currRing->pLexOrder && !TEST_OPT_INTSTRATEGY)
7670    {
7671      strat->posInL = posInL11;
7672      strat->posInT = posInT11;
7673    }
7674    else if (TEST_OPT_INTSTRATEGY)
7675    {
7676      strat->posInL = posInL11;
7677      strat->posInT = posInT11;
7678    }
7679    else
7680    {
7681      strat->posInL = posInL0;
7682      strat->posInT = posInT0;
7683    }
7684    //if (strat->minim>0) strat->posInL =posInLSpecial;
7685    if (strat->homog)
7686    {
7687       strat->posInL = posInL110;
7688       strat->posInT = posInT110;
7689    }
7690  }
7691  else
7692  {
7693    if (strat->homog)
7694    {
7695      strat->posInL = posInL11;
7696      strat->posInT = posInT11;
7697    }
7698    else
7699    {
7700      if ((currRing->order[0]==ringorder_c)
7701      ||(currRing->order[0]==ringorder_C))
7702      {
7703        strat->posInL = posInL17_c;
7704        strat->posInT = posInT17_c;
7705      }
7706      else
7707      {
7708        strat->posInL = posInL17;
7709        strat->posInT = posInT17;
7710      }
7711    }
7712  }
7713  if (strat->minim>0) strat->posInL =posInLSpecial;
7714  // for further tests only
7715  if ((BTEST1(11)) || (BTEST1(12)))
7716    strat->posInL = posInL11;
7717  else if ((BTEST1(13)) || (BTEST1(14)))
7718    strat->posInL = posInL13;
7719  else if ((BTEST1(15)) || (BTEST1(16)))
7720    strat->posInL = posInL15;
7721  else if ((BTEST1(17)) || (BTEST1(18)))
7722    strat->posInL = posInL17;
7723  if (BTEST1(11))
7724    strat->posInT = posInT11;
7725  else if (BTEST1(13))
7726    strat->posInT = posInT13;
7727  else if (BTEST1(15))
7728    strat->posInT = posInT15;
7729  else if ((BTEST1(17)))
7730    strat->posInT = posInT17;
7731  else if ((BTEST1(19)))
7732    strat->posInT = posInT19;
7733  else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
7734    strat->posInT = posInT1;
7735#ifdef HAVE_RINGS
7736  if (rField_is_Ring(currRing))
7737  {
7738    strat->posInL = posInL11;
7739    strat->posInT = posInT11;
7740  }
7741#endif
7742  strat->posInLDependsOnLength = FALSE;
7743  strat->posInLSba  = posInLSig;
7744  //strat->posInL     = posInLSig;
7745  strat->posInL     = posInLF5C;
7746  //strat->posInT     = posInTSig;
7747}
7748
7749void initSbaBuchMora (ideal F,ideal Q,kStrategy strat)
7750{
7751  strat->interpt = BTEST1(OPT_INTERRUPT);
7752  strat->kHEdge=NULL;
7753  if (currRing->OrdSgn==1) strat->kHEdgeFound=FALSE;
7754  /*- creating temp data structures------------------- -*/
7755  strat->cp = 0;
7756  strat->c3 = 0;
7757  strat->tail = pInit();
7758  /*- set s -*/
7759  strat->sl = -1;
7760  /*- set ps -*/
7761  strat->syzl = -1;
7762  /*- set L -*/
7763  strat->Lmax = ((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
7764  strat->Ll = -1;
7765  strat->L = initL(((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc);
7766  /*- set B -*/
7767  strat->Bmax = setmaxL;
7768  strat->Bl = -1;
7769  strat->B = initL();
7770  /*- set T -*/
7771  strat->tl = -1;
7772  strat->tmax = setmaxT;
7773  strat->T = initT();
7774  strat->R = initR();
7775  strat->sevT = initsevT();
7776  /*- init local data struct.---------------------------------------- -*/
7777  strat->P.ecart=0;
7778  strat->P.length=0;
7779  if (currRing->OrdSgn==-1)
7780  {
7781    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
7782    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
7783  }
7784  #ifdef HAVE_RINGS
7785  if(rField_is_Ring(currRing))
7786  {
7787    /*Shdl=*/initSLSba(F, Q,strat); /*sets also S, ecartS, fromQ */
7788  }
7789  else
7790  #endif
7791  {
7792    if(TEST_OPT_SB_1)
7793    {
7794        int i;
7795        ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
7796        for (i=strat->newIdeal;i<IDELEMS(F);i++)
7797        {
7798          P->m[i-strat->newIdeal] = F->m[i];
7799          F->m[i] = NULL;
7800        }
7801        initSSpecialSba(F,Q,P,strat);
7802        for (i=strat->newIdeal;i<IDELEMS(F);i++)
7803        {
7804          F->m[i] = P->m[i-strat->newIdeal];
7805          P->m[i-strat->newIdeal] = NULL;
7806        }
7807        idDelete(&P);
7808    }
7809    else
7810    {
7811      /*Shdl=*/initSLSba(F, Q,strat); /*sets also S, ecartS, fromQ */
7812      // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
7813    }
7814  }
7815  strat->fromT = FALSE;
7816  strat->noTailReduction = !TEST_OPT_REDTAIL;
7817  if (!TEST_OPT_SB_1)
7818  {
7819    #ifdef HAVE_RINGS
7820    if(!rField_is_Ring(currRing))
7821    #endif
7822    updateS(TRUE,strat);
7823  }
7824  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
7825  strat->fromQ=NULL;
7826}
7827
7828void exitSba (kStrategy strat)
7829{
7830  /*- release temp data -*/
7831  cleanT(strat);
7832  omFreeSize(strat->T,(strat->tmax)*sizeof(TObject));
7833  omFreeSize(strat->R,(strat->tmax)*sizeof(TObject*));
7834  omFreeSize(strat->sevT, (strat->tmax)*sizeof(unsigned long));
7835  omFreeSize(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
7836  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
7837  omFreeSize((ADDRESS)strat->sevSig,IDELEMS(strat->Shdl)*sizeof(unsigned long));
7838  omFreeSize((ADDRESS)strat->syz,(strat->syzmax)*sizeof(poly));
7839  omFreeSize((ADDRESS)strat->sevSyz,(strat->syzmax)*sizeof(unsigned long));
7840  if (strat->sbaOrder == 1)
7841  {
7842    omFreeSize(strat->syzIdx,(strat->syzidxmax)*sizeof(int));
7843  }
7844  omFreeSize(strat->S_2_R,IDELEMS(strat->Shdl)*sizeof(int));
7845  /*- set L: should be empty -*/
7846  omFreeSize(strat->L,(strat->Lmax)*sizeof(LObject));
7847  /*- set B: should be empty -*/
7848  omFreeSize(strat->B,(strat->Bmax)*sizeof(LObject));
7849  /*- set sig: no need for the signatures anymore -*/
7850  omFreeSize(strat->sig,IDELEMS(strat->Shdl)*sizeof(poly));
7851  pLmDelete(&strat->tail);
7852  strat->syzComp=0;
7853}
7854
7855/*2
7856* in the case of a standardbase of a module over a qring:
7857* replace polynomials in i by ak vectors,
7858* (the polynomial * unit vectors gen(1)..gen(ak)
7859* in every case (also for ideals:)
7860* deletes divisible vectors/polynomials
7861*/
7862void updateResult(ideal r,ideal Q, kStrategy strat)
7863{
7864  int l;
7865  if (strat->ak>0)
7866  {
7867    for (l=IDELEMS(r)-1;l>=0;l--)
7868    {
7869      if ((r->m[l]!=NULL) && (pGetComp(r->m[l])==0))
7870      {
7871        pDelete(&r->m[l]); // and set it to NULL
7872      }
7873    }
7874    int q;
7875    poly p;
7876    for (l=IDELEMS(r)-1;l>=0;l--)
7877    {
7878      if ((r->m[l]!=NULL)
7879      //&& (strat->syzComp>0)
7880      //&& (pGetComp(r->m[l])<=strat->syzComp)
7881      )
7882      {
7883        for(q=IDELEMS(Q)-1; q>=0;q--)
7884        {
7885          if ((Q->m[q]!=NULL)
7886          &&(pLmDivisibleBy(Q->m[q],r->m[l])))
7887          {
7888            if (TEST_OPT_REDSB)
7889            {
7890              p=r->m[l];
7891              r->m[l]=kNF(Q,NULL,p);
7892              pDelete(&p);
7893            }
7894            else
7895            {
7896              pDelete(&r->m[l]); // and set it to NULL
7897            }
7898            break;
7899          }
7900        }
7901      }
7902    }
7903  }
7904  else
7905  {
7906    int q;
7907    poly p;
7908    BOOLEAN reduction_found=FALSE;
7909    if (!rField_is_Ring(currRing))
7910    {
7911      for (l=IDELEMS(r)-1;l>=0;l--)
7912      {
7913        if (r->m[l]!=NULL)
7914        {
7915          for(q=IDELEMS(Q)-1; q>=0;q--)
7916          {
7917            if ((Q->m[q]!=NULL)&&(pLmEqual(Q->m[q],r->m[l])))
7918            {
7919              if (TEST_OPT_REDSB)
7920              {
7921                p=r->m[l];
7922                r->m[l]=kNF(Q,NULL,p);
7923                pDelete(&p);
7924                reduction_found=TRUE;
7925              }
7926              else
7927              {
7928                pDelete(&r->m[l]); // and set it to NULL
7929              }
7930              break;
7931            }
7932          }
7933        }
7934      }
7935    }
7936    #ifdef HAVE_RINGS
7937    //Also need divisibility of the leading coefficients
7938    else
7939    {
7940      for (l=IDELEMS(r)-1;l>=0;l--)
7941      {
7942        if (r->m[l]!=NULL)
7943        {
7944          for(q=IDELEMS(Q)-1; q>=0;q--)
7945          {
7946            if ((Q->m[q]!=NULL)&&(pLmEqual(Q->m[q],r->m[l]))
7947            && pDivisibleBy(Q->m[q],r->m[l]))
7948            {
7949              if (TEST_OPT_REDSB)
7950              {
7951                p=r->m[l];
7952                r->m[l]=kNF(Q,NULL,p);
7953                pDelete(&p);
7954                reduction_found=TRUE;
7955              }
7956              else
7957              {
7958                pDelete(&r->m[l]); // and set it to NULL
7959              }
7960              break;
7961            }
7962          }
7963        }
7964      }
7965    }
7966    #endif
7967    if (/*TEST_OPT_REDSB &&*/ reduction_found)
7968    {
7969      for (l=IDELEMS(r)-1;l>=0;l--)
7970      {
7971        if (r->m[l]!=NULL)
7972        {
7973          for(q=IDELEMS(r)-1;q>=0;q--)
7974          {
7975            if ((l!=q)
7976            && (r->m[q]!=NULL)
7977            &&(pLmDivisibleBy(r->m[l],r->m[q])))
7978            {
7979              pDelete(&r->m[q]);
7980            }
7981          }
7982        }
7983      }
7984    }
7985  }
7986  idSkipZeroes(r);
7987}
7988
7989void completeReduce (kStrategy strat, BOOLEAN withT)
7990{
7991  int i;
7992  int low = (((currRing->OrdSgn==1) && (strat->ak==0)) ? 1 : 0);
7993  LObject L;
7994
7995#ifdef KDEBUG
7996  // need to set this: during tailreductions of T[i], T[i].max is out of
7997  // sync
7998  sloppy_max = TRUE;
7999#endif
8000
8001  strat->noTailReduction = FALSE;
8002  if (TEST_OPT_PROT)
8003  {
8004    PrintLn();
8005//    if (timerv) writeTime("standard base computed:");
8006  }
8007  if (TEST_OPT_PROT)
8008  {
8009    Print("(S:%d)",strat->sl);mflush();
8010  }
8011  for (i=strat->sl; i>=low; i--)
8012  {
8013    int end_pos=strat->sl;
8014    if ((strat->fromQ!=NULL) && (strat->fromQ[i])) continue; // do not reduce Q_i
8015    if (strat->ak==0) end_pos=i-1;
8016    TObject* T_j = strat->s_2_t(i);
8017    if ((T_j != NULL)&&(T_j->p==strat->S[i]))
8018    {
8019      L = *T_j;
8020      #ifdef KDEBUG
8021      if (TEST_OPT_DEBUG)
8022      {
8023        Print("test S[%d]:",i);
8024        p_wrp(L.p,currRing,strat->tailRing);
8025        PrintLn();
8026      }
8027      #endif
8028      if (currRing->OrdSgn == 1)
8029        strat->S[i] = redtailBba(&L, end_pos, strat, withT);
8030      else
8031        strat->S[i] = redtail(&L, strat->sl, strat);
8032      #ifdef KDEBUG
8033      if (TEST_OPT_DEBUG)
8034      {
8035        Print("to (tailR) S[%d]:",i);
8036        p_wrp(strat->S[i],currRing,strat->tailRing);
8037        PrintLn();
8038      }
8039      #endif
8040
8041      if (strat->redTailChange && strat->tailRing != currRing)
8042      {
8043        if (T_j->max != NULL) p_LmFree(T_j->max, strat->tailRing);
8044        if (pNext(T_j->p) != NULL)
8045          T_j->max = p_GetMaxExpP(pNext(T_j->p), strat->tailRing);
8046        else
8047          T_j->max = NULL;
8048      }
8049      if (TEST_OPT_INTSTRATEGY)
8050        T_j->pCleardenom();
8051    }
8052    else
8053    {
8054      assume(currRing == strat->tailRing);
8055      #ifdef KDEBUG
8056      if (TEST_OPT_DEBUG)
8057      {
8058        Print("test S[%d]:",i);
8059        p_wrp(strat->S[i],currRing,strat->tailRing);
8060        PrintLn();
8061      }
8062      #endif
8063      if (currRing->OrdSgn == 1)
8064        strat->S[i] = redtailBba(strat->S[i], end_pos, strat, withT);
8065      else
8066        strat->S[i] = redtail(strat->S[i], strat->sl, strat);
8067      if (TEST_OPT_INTSTRATEGY)
8068      {
8069        if (TEST_OPT_CONTENTSB)
8070        {
8071          number n;
8072          p_Cleardenom_n(strat->S[i], currRing, n);// also does a pContent
8073          if (!nIsOne(n))
8074          {
8075            denominator_list denom=(denominator_list)omAlloc(sizeof(denominator_list_s));
8076            denom->n=nInvers(n);
8077            denom->next=DENOMINATOR_LIST;
8078            DENOMINATOR_LIST=denom;
8079          }
8080          nDelete(&n);
8081        }
8082        else
8083        {
8084          //pContent(strat->S[i]);
8085          strat->S[i]=p_Cleardenom(strat->S[i], currRing);// also does a pContent
8086        }
8087      }
8088      #ifdef KDEBUG
8089      if (TEST_OPT_DEBUG)
8090      {
8091        Print("to (-tailR) S[%d]:",i);
8092        p_wrp(strat->S[i],currRing,strat->tailRing);
8093        PrintLn();
8094      }
8095      #endif
8096    }
8097    if (TEST_OPT_PROT)
8098      PrintS("-");
8099  }
8100  if (TEST_OPT_PROT) PrintLn();
8101#ifdef KDEBUG
8102  sloppy_max = FALSE;
8103#endif
8104}
8105
8106
8107/*2
8108* computes the new strat->kHEdge and the new pNoether,
8109* returns TRUE, if pNoether has changed
8110*/
8111BOOLEAN newHEdge(kStrategy strat)
8112{
8113  int i,j;
8114  poly newNoether;
8115
8116#if 0
8117  if (currRing->weight_all_1)
8118    scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
8119  else
8120    scComputeHCw(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
8121#else
8122  scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
8123#endif
8124  if (strat->t_kHEdge != NULL) p_LmFree(strat->t_kHEdge, strat->tailRing);
8125  if (strat->tailRing != currRing)
8126    strat->t_kHEdge = k_LmInit_currRing_2_tailRing(strat->kHEdge, strat->tailRing);
8127  /* compare old and new noether*/
8128  newNoether = pLmInit(strat->kHEdge);
8129  j = p_FDeg(newNoether,currRing);
8130/*  #ifdef HAVE_RINGS
8131  if (!rField_is_Ring(currRing))
8132  #endif */
8133  for (i=1; i<=(currRing->N); i++)
8134  {
8135    if (pGetExp(newNoether, i) > 0) pDecrExp(newNoether,i);
8136  }
8137  pSetm(newNoether);
8138  if (j < strat->HCord) /*- statistics -*/
8139  {
8140    if (TEST_OPT_PROT)
8141    {
8142      Print("H(%d)",j);
8143      mflush();
8144    }
8145    strat->HCord=j;
8146    #ifdef KDEBUG
8147    if (TEST_OPT_DEBUG)
8148    {
8149      Print("H(%d):",j);
8150      wrp(strat->kHEdge);
8151      PrintLn();
8152    }
8153    #endif
8154  }
8155  if (pCmp(strat->kNoether,newNoether)!=1)
8156  {
8157    pDelete(&strat->kNoether);
8158    strat->kNoether=newNoether;
8159    if (strat->t_kNoether != NULL) p_LmFree(strat->t_kNoether, strat->tailRing);
8160    if (strat->tailRing != currRing)
8161      strat->t_kNoether = k_LmInit_currRing_2_tailRing(strat->kNoether, strat->tailRing);
8162
8163    return TRUE;
8164  }
8165  pLmFree(newNoether);
8166  return FALSE;
8167}
8168
8169/***************************************************************
8170 *
8171 * Routines related for ring changes during std computations
8172 *
8173 ***************************************************************/
8174BOOLEAN kCheckSpolyCreation(LObject *L, kStrategy strat, poly &m1, poly &m2)
8175{
8176  if (strat->overflow) return FALSE;
8177  assume(L->p1 != NULL && L->p2 != NULL);
8178  // shift changes: from 0 to -1
8179  assume(L->i_r1 >= -1 && L->i_r1 <= strat->tl);
8180  assume(L->i_r2 >= -1 && L->i_r2 <= strat->tl);
8181  assume(strat->tailRing != currRing);
8182
8183  if (! k_GetLeadTerms(L->p1, L->p2, currRing, m1, m2, strat->tailRing))
8184    return FALSE;
8185  // shift changes: extra case inserted
8186  if ((L->i_r1 == -1) || (L->i_r2 == -1) )
8187  {
8188    return TRUE;
8189  }
8190  poly p1_max = (strat->R[L->i_r1])->max;
8191  poly p2_max = (strat->R[L->i_r2])->max;
8192
8193  if (((p1_max != NULL) && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
8194      ((p2_max != NULL) && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
8195  {
8196    p_LmFree(m1, strat->tailRing);
8197    p_LmFree(m2, strat->tailRing);
8198    m1 = NULL;
8199    m2 = NULL;
8200    return FALSE;
8201  }
8202  return TRUE;
8203}
8204
8205#ifdef HAVE_RINGS
8206/***************************************************************
8207 *
8208 * Checks, if we can compute the gcd poly / strong pair
8209 * gcd-poly = m1 * R[atR] + m2 * S[atS]
8210 *
8211 ***************************************************************/
8212BOOLEAN kCheckStrongCreation(int atR, poly m1, int atS, poly m2, kStrategy strat)
8213{
8214  assume(strat->S_2_R[atS] >= -1 && strat->S_2_R[atS] <= strat->tl);
8215  //assume(strat->tailRing != currRing);
8216
8217  poly p1_max = (strat->R[atR])->max;
8218  poly p2_max = (strat->R[strat->S_2_R[atS]])->max;
8219
8220  if (((p1_max != NULL) && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
8221      ((p2_max != NULL) && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
8222  {
8223    return FALSE;
8224  }
8225  return TRUE;
8226}
8227#endif
8228
8229BOOLEAN kStratChangeTailRing(kStrategy strat, LObject *L, TObject* T, unsigned long expbound)
8230{
8231  assume((strat->tailRing == currRing) || (strat->tailRing->bitmask < currRing->bitmask));
8232  /* initial setup or extending */
8233
8234  if (expbound == 0) expbound = strat->tailRing->bitmask << 1;
8235  if (expbound >= currRing->bitmask) return FALSE;
8236  strat->overflow=FALSE;
8237  ring new_tailRing = rModifyRing(currRing,
8238  // Hmmm .. the condition pFDeg == p_Deg
8239  // might be too strong
8240#ifdef HAVE_RINGS
8241  (strat->homog && currRing->pFDeg == p_Deg && !(rField_is_Ring(currRing))), // TODO Oliver
8242#else
8243  (strat->homog && currRing->pFDeg == p_Deg), // omit_degree
8244#endif
8245  (strat->ak==0), // omit_comp if the input is an ideal
8246  expbound); // exp_limit
8247
8248  if (new_tailRing == currRing) return TRUE;
8249
8250  strat->pOrigFDeg_TailRing = new_tailRing->pFDeg;
8251  strat->pOrigLDeg_TailRing = new_tailRing->pLDeg;
8252
8253  if (currRing->pFDeg != currRing->pFDegOrig)
8254  {
8255    new_tailRing->pFDeg = currRing->pFDeg;
8256    new_tailRing->pLDeg = currRing->pLDeg;
8257  }
8258
8259  if (TEST_OPT_PROT)
8260    Print("[%lu:%d", (unsigned long) new_tailRing->bitmask, new_tailRing->ExpL_Size);
8261  kTest_TS(strat);
8262  assume(new_tailRing != strat->tailRing);
8263  pShallowCopyDeleteProc p_shallow_copy_delete
8264    = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
8265
8266  omBin new_tailBin = omGetStickyBinOfBin(new_tailRing->PolyBin);
8267
8268  int i;
8269  for (i=0; i<=strat->tl; i++)
8270  {
8271    strat->T[i].ShallowCopyDelete(new_tailRing, new_tailBin,
8272                                  p_shallow_copy_delete);
8273  }
8274  for (i=0; i<=strat->Ll; i++)
8275  {
8276    assume(strat->L[i].p != NULL);
8277    if (pNext(strat->L[i].p) != strat->tail)
8278      strat->L[i].ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
8279  }
8280  if ((strat->P.t_p != NULL) ||
8281      ((strat->P.p != NULL) && pNext(strat->P.p) != strat->tail))
8282    strat->P.ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
8283
8284  if ((L != NULL) && (L->tailRing != new_tailRing))
8285  {
8286    if (L->i_r < 0)
8287      L->ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
8288    else
8289    {
8290      assume(L->i_r <= strat->tl);
8291      TObject* t_l = strat->R[L->i_r];
8292      assume(t_l != NULL);
8293      L->tailRing = new_tailRing;
8294      L->p = t_l->p;
8295      L->t_p = t_l->t_p;
8296      L->max = t_l->max;
8297    }
8298  }
8299
8300  if ((T != NULL) && (T->tailRing != new_tailRing && T->i_r < 0))
8301    T->ShallowCopyDelete(new_tailRing, new_tailBin, p_shallow_copy_delete);
8302
8303  omMergeStickyBinIntoBin(strat->tailBin, strat->tailRing->PolyBin);
8304  if (strat->tailRing != currRing)
8305    rKillModifiedRing(strat->tailRing);
8306
8307  strat->tailRing = new_tailRing;
8308  strat->tailBin = new_tailBin;
8309  strat->p_shallow_copy_delete
8310    = pGetShallowCopyDeleteProc(currRing, new_tailRing);
8311
8312  if (strat->kHEdge != NULL)
8313  {
8314    if (strat->t_kHEdge != NULL)
8315      p_LmFree(strat->t_kHEdge, strat->tailRing);
8316    strat->t_kHEdge=k_LmInit_currRing_2_tailRing(strat->kHEdge, new_tailRing);
8317  }
8318
8319  if (strat->kNoether != NULL)
8320  {
8321    if (strat->t_kNoether != NULL)
8322      p_LmFree(strat->t_kNoether, strat->tailRing);
8323    strat->t_kNoether=k_LmInit_currRing_2_tailRing(strat->kNoether,
8324                                                   new_tailRing);
8325  }
8326  kTest_TS(strat);
8327  if (TEST_OPT_PROT)
8328    PrintS("]");
8329  return TRUE;
8330}
8331
8332void kStratInitChangeTailRing(kStrategy strat)
8333{
8334  unsigned long l = 0;
8335  int i;
8336  long e;
8337
8338  assume(strat->tailRing == currRing);
8339
8340  for (i=0; i<= strat->Ll; i++)
8341  {
8342    l = p_GetMaxExpL(strat->L[i].p, currRing, l);
8343  }
8344  for (i=0; i<=strat->tl; i++)
8345  {
8346    // Hmm ... this we could do in one Step
8347    l = p_GetMaxExpL(strat->T[i].p, currRing, l);
8348  }
8349  if (rField_is_Ring(currRing))
8350  {
8351    l *= 2;
8352  }
8353  e = p_GetMaxExp(l, currRing);
8354  if (e <= 1) e = 2;
8355
8356  kStratChangeTailRing(strat, NULL, NULL, e);
8357}
8358
8359ring sbaRing (kStrategy strat, const ring r, BOOLEAN /*complete*/, int /*sgn*/)
8360{
8361  int n = rBlocks(r); // Including trailing zero!
8362  // if sbaOrder == 1 => use (C,monomial order from r)
8363  if (strat->sbaOrder == 1)
8364  {
8365    if (r->order[0] == ringorder_C || r->order[0] == ringorder_c)
8366    {
8367      return r;
8368    }
8369    ring res = rCopy0(r, TRUE, FALSE);
8370    res->order  = (int *)omAlloc0((n+1)*sizeof(int));
8371    res->block0 = (int *)omAlloc0((n+1)*sizeof(int));
8372    res->block1 = (int *)omAlloc0((n+1)*sizeof(int));
8373    int **wvhdl = (int **)omAlloc0((n+1)*sizeof(int*));
8374    res->wvhdl  = wvhdl;
8375    for (int i=1; i<n; i++)
8376    {
8377      res->order[i]   = r->order[i-1];
8378      res->block0[i]  = r->block0[i-1];
8379      res->block1[i]  = r->block1[i-1];
8380      res->wvhdl[i]   = r->wvhdl[i-1];
8381    }
8382
8383    // new 1st block
8384    res->order[0]   = ringorder_C; // Prefix
8385    // removes useless secondary component order if defined in old ring
8386    for (int i=rBlocks(res); i>0; --i) {
8387      if (res->order[i] == ringorder_C || res->order[i] == ringorder_c) {
8388        res->order[i] = 0;
8389      }
8390    }
8391    rComplete(res, 1);
8392#ifdef HAVE_PLURAL
8393    if (rIsPluralRing(r))
8394    {
8395      if ( nc_rComplete(r, res, false) ) // no qideal!
8396      {
8397#ifndef SING_NDEBUG
8398        WarnS("error in nc_rComplete");
8399#endif
8400        // cleanup?
8401
8402        //      rDelete(res);
8403        //      return r;
8404
8405        // just go on..
8406      }
8407    }
8408#endif
8409    strat->tailRing = res;
8410    return (res);
8411  }
8412  // if sbaOrder == 3 => degree - position - ring order
8413  if (strat->sbaOrder == 3)
8414  {
8415    ring res = rCopy0(r, TRUE, FALSE);
8416    res->order  = (int *)omAlloc0((n+2)*sizeof(int));
8417    res->block0 = (int *)omAlloc0((n+2)*sizeof(int));
8418    res->block1 = (int *)omAlloc0((n+2)*sizeof(int));
8419    int **wvhdl = (int **)omAlloc0((n+2)*sizeof(int*));
8420    res->wvhdl  = wvhdl;
8421    for (int i=2; i<n+2; i++)
8422    {
8423      res->order[i]   = r->order[i-2];
8424      res->block0[i]  = r->block0[i-2];
8425      res->block1[i]  = r->block1[i-2];
8426      res->wvhdl[i]   = r->wvhdl[i-2];
8427    }
8428
8429    // new 1st block
8430    res->order[0]   = ringorder_a; // Prefix
8431    res->block0[0]  = 1;
8432    res->wvhdl[0]   = (int *)omAlloc(res->N*sizeof(int));
8433    for (int i=0; i<res->N; ++i)
8434      res->wvhdl[0][i]  = 1;
8435    res->block1[0]  = si_min(res->N, rVar(res));
8436    // new 2nd block
8437    res->order[1]   = ringorder_C; // Prefix
8438    res->wvhdl[1]   = NULL;
8439    // removes useless secondary component order if defined in old ring
8440    for (int i=rBlocks(res); i>1; --i) {
8441      if (res->order[i] == ringorder_C || res->order[i] == ringorder_c) {
8442        res->order[i] = 0;
8443      }
8444    }
8445    rComplete(res, 1);
8446#ifdef HAVE_PLURAL
8447    if (rIsPluralRing(r))
8448    {
8449      if ( nc_rComplete(r, res, false) ) // no qideal!
8450      {
8451#ifndef SING_NDEBUG
8452        WarnS("error in nc_rComplete");
8453#endif
8454        // cleanup?
8455
8456        //      rDelete(res);
8457        //      return r;
8458
8459        // just go on..
8460      }
8461    }
8462#endif
8463    strat->tailRing = res;
8464    return (res);
8465  }
8466
8467  // not sbaOrder == 1 => use Schreyer order
8468  // this is done by a trick when initializing the signatures
8469  // in initSLSba():
8470  // Instead of using the signature 1e_i for F->m[i], we start
8471  // with the signature LM(F->m[i])e_i for F->m[i]. Doing this we get a
8472  // Schreyer order w.r.t. the underlying monomial order.
8473  // => we do not need to change the underlying polynomial ring at all!
8474
8475  // UPDATE/NOTE/TODO: use induced Schreyer ordering 'IS'!!!!????
8476
8477  /*
8478  else
8479  {
8480    ring res = rCopy0(r, FALSE, FALSE);
8481    // Create 2 more blocks for prefix/suffix:
8482    res->order=(int *)omAlloc0((n+2)*sizeof(int)); // 0  ..  n+1
8483    res->block0=(int *)omAlloc0((n+2)*sizeof(int));
8484    res->block1=(int *)omAlloc0((n+2)*sizeof(int));
8485    int ** wvhdl =(int **)omAlloc0((n+2)*sizeof(int**));
8486
8487    // Encapsulate all existing blocks between induced Schreyer ordering markers: prefix and suffix!
8488    // Note that prefix and suffix have the same ringorder marker and only differ in block[] parameters!
8489
8490    // new 1st block
8491    int j = 0;
8492    res->order[j] = ringorder_IS; // Prefix
8493    res->block0[j] = res->block1[j] = 0;
8494    // wvhdl[j] = NULL;
8495    j++;
8496
8497    for(int i = 0; (i < n) && (r->order[i] != 0); i++, j++) // i = [0 .. n-1] <- non-zero old blocks
8498    {
8499      res->order [j] = r->order [i];
8500      res->block0[j] = r->block0[i];
8501      res->block1[j] = r->block1[i];
8502
8503      if (r->wvhdl[i] != NULL)
8504      {
8505        wvhdl[j] = (int*) omMemDup(r->wvhdl[i]);
8506      } // else wvhdl[j] = NULL;
8507    }
8508
8509    // new last block
8510    res->order [j] = ringorder_IS; // Suffix
8511    res->block0[j] = res->block1[j] = sgn; // Sign of v[o]: 1 for C, -1 for c
8512    // wvhdl[j] = NULL;
8513    j++;
8514
8515    // res->order [j] = 0; // The End!
8516    res->wvhdl = wvhdl;
8517
8518    // j == the last zero block now!
8519    assume(j == (n+1));
8520    assume(res->order[0]==ringorder_IS);
8521    assume(res->order[j-1]==ringorder_IS);
8522    assume(res->order[j]==0);
8523
8524    if (complete)
8525    {
8526      rComplete(res, 1);
8527
8528#ifdef HAVE_PLURAL
8529      if (rIsPluralRing(r))
8530      {
8531        if ( nc_rComplete(r, res, false) ) // no qideal!
8532        {
8533        }
8534      }
8535      assume(rIsPluralRing(r) == rIsPluralRing(res));
8536#endif
8537
8538
8539#ifdef HAVE_PLURAL
8540      ring old_ring = r;
8541
8542#endif
8543
8544      if (r->qideal!=NULL)
8545      {
8546        res->qideal= idrCopyR_NoSort(r->qideal, r, res);
8547
8548        assume(idRankFreeModule(res->qideal, res) == 0);
8549
8550#ifdef HAVE_PLURAL
8551        if( rIsPluralRing(res) )
8552          if( nc_SetupQuotient(res, r, true) )
8553          {
8554            //          WarnS("error in nc_SetupQuotient"); // cleanup?      rDelete(res);       return r;  // just go on...?
8555          }
8556
8557#endif
8558        assume(idRankFreeModule(res->qideal, res) == 0);
8559      }
8560
8561#ifdef HAVE_PLURAL
8562      assume((res->qideal==NULL) == (old_ring->qideal==NULL));
8563      assume(rIsPluralRing(res) == rIsPluralRing(old_ring));
8564      assume(rIsSCA(res) == rIsSCA(old_ring));
8565      assume(ncRingType(res) == ncRingType(old_ring));
8566#endif
8567    }
8568    strat->tailRing = res;
8569    return res;
8570  }
8571  */
8572
8573  assume(FALSE);
8574  return(NULL);
8575}
8576
8577skStrategy::skStrategy()
8578{
8579  memset(this, 0, sizeof(skStrategy));
8580#ifndef SING_NDEBUG
8581  strat_nr++;
8582  nr=strat_nr;
8583  if (strat_fac_debug) Print("s(%d) created\n",nr);
8584#endif
8585  tailRing = currRing;
8586  P.tailRing = currRing;
8587  tl = -1;
8588  sl = -1;
8589#ifdef HAVE_LM_BIN
8590  lmBin = omGetStickyBinOfBin(currRing->PolyBin);
8591#endif
8592#ifdef HAVE_TAIL_BIN
8593  tailBin = omGetStickyBinOfBin(currRing->PolyBin);
8594#endif
8595  pOrigFDeg = currRing->pFDeg;
8596  pOrigLDeg = currRing->pLDeg;
8597}
8598
8599
8600skStrategy::~skStrategy()
8601{
8602  if (lmBin != NULL)
8603    omMergeStickyBinIntoBin(lmBin, currRing->PolyBin);
8604  if (tailBin != NULL)
8605    omMergeStickyBinIntoBin(tailBin,
8606                            (tailRing != NULL ? tailRing->PolyBin:
8607                             currRing->PolyBin));
8608  if (t_kHEdge != NULL)
8609    p_LmFree(t_kHEdge, tailRing);
8610  if (t_kNoether != NULL)
8611    p_LmFree(t_kNoether, tailRing);
8612
8613  if (currRing != tailRing)
8614    rKillModifiedRing(tailRing);
8615  pRestoreDegProcs(currRing,pOrigFDeg, pOrigLDeg);
8616}
8617
8618#if 0
8619Timings for the different possibilities of posInT:
8620            T15           EDL         DL          EL            L         1-2-3
8621Gonnet      43.26       42.30       38.34       41.98       38.40      100.04
8622Hairer_2_1   1.11        1.15        1.04        1.22        1.08        4.7
8623Twomat3      1.62        1.69        1.70        1.65        1.54       11.32
8624ahml         4.48        4.03        4.03        4.38        4.96       26.50
8625c7          15.02       13.98       15.16       13.24       17.31       47.89
8626c8         505.09      407.46      852.76      413.21      499.19        n/a
8627f855        12.65        9.27       14.97        8.78       14.23       33.12
8628gametwo6    11.47       11.35       14.57       11.20       12.02       35.07
8629gerhard_3    2.73        2.83        2.93        2.64        3.12        6.24
8630ilias13     22.89       22.46       24.62       20.60       23.34       53.86
8631noon8       40.68       37.02       37.99       36.82       35.59      877.16
8632rcyclic_19  48.22       42.29       43.99       45.35       51.51      204.29
8633rkat9       82.37       79.46       77.20       77.63       82.54      267.92
8634schwarz_11  16.46       16.81       16.76       16.81       16.72       35.56
8635test016     16.39       14.17       14.40       13.50       14.26       34.07
8636test017     34.70       36.01       33.16       35.48       32.75       71.45
8637test042     10.76       10.99       10.27       11.57       10.45       23.04
8638test058      6.78        6.75        6.51        6.95        6.22        9.47
8639test066     10.71       10.94       10.76       10.61       10.56       19.06
8640test073     10.75       11.11       10.17       10.79        8.63       58.10
8641test086     12.23       11.81       12.88       12.24       13.37       66.68
8642test103      5.05        4.80        5.47        4.64        4.89       11.90
8643test154     12.96       11.64       13.51       12.46       14.61       36.35
8644test162     65.27       64.01       67.35       59.79       67.54      196.46
8645test164      7.50        6.50        7.68        6.70        7.96       17.13
8646virasoro     3.39        3.50        3.35        3.47        3.70        7.66
8647#endif
8648
8649
8650//#ifdef HAVE_MORE_POS_IN_T
8651#if 1
8652// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
8653int posInT_EcartFDegpLength(const TSet set,const int length,LObject &p)
8654{
8655
8656  if (length==-1) return 0;
8657
8658  int o = p.ecart;
8659  int op=p.GetpFDeg();
8660  int ol = p.GetpLength();
8661
8662  if (set[length].ecart < o)
8663    return length+1;
8664  if (set[length].ecart == o)
8665  {
8666     int oo=set[length].GetpFDeg();
8667     if ((oo < op) || ((oo==op) && (set[length].length < ol)))
8668       return length+1;
8669  }
8670
8671  int i;
8672  int an = 0;
8673  int en= length;
8674  loop
8675  {
8676    if (an >= en-1)
8677    {
8678      if (set[an].ecart > o)
8679        return an;
8680      if (set[an].ecart == o)
8681      {
8682         int oo=set[an].GetpFDeg();
8683         if((oo > op)
8684         || ((oo==op) && (set[an].pLength > ol)))
8685           return an;
8686      }
8687      return en;
8688    }
8689    i=(an+en) / 2;
8690    if (set[i].ecart > o)
8691      en=i;
8692    else if (set[i].ecart == o)
8693    {
8694       int oo=set[i].GetpFDeg();
8695       if ((oo > op)
8696       || ((oo == op) && (set[i].pLength > ol)))
8697         en=i;
8698       else
8699        an=i;
8700    }
8701    else
8702      an=i;
8703  }
8704}
8705
8706// determines the position based on: 1.) FDeg 2.) pLength
8707int posInT_FDegpLength(const TSet set,const int length,LObject &p)
8708{
8709
8710  if (length==-1) return 0;
8711
8712  int op=p.GetpFDeg();
8713  int ol = p.GetpLength();
8714
8715  int oo=set[length].GetpFDeg();
8716  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
8717    return length+1;
8718
8719  int i;
8720  int an = 0;
8721  int en= length;
8722  loop
8723    {
8724      if (an >= en-1)
8725      {
8726        int oo=set[an].GetpFDeg();
8727        if((oo > op)
8728           || ((oo==op) && (set[an].pLength > ol)))
8729          return an;
8730        return en;
8731      }
8732      i=(an+en) / 2;
8733      int oo=set[i].GetpFDeg();
8734      if ((oo > op)
8735          || ((oo == op) && (set[i].pLength > ol)))
8736        en=i;
8737      else
8738        an=i;
8739    }
8740}
8741
8742
8743// determines the position based on: 1.) pLength
8744int posInT_pLength(const TSet set,const int length,LObject &p)
8745{
8746  int ol = p.GetpLength();
8747  if (length==-1)
8748    return 0;
8749  if (set[length].length<p.length)
8750    return length+1;
8751
8752  int i;
8753  int an = 0;
8754  int en= length;
8755
8756  loop
8757  {
8758    if (an >= en-1)
8759    {
8760      if (set[an].pLength>ol) return an;
8761      return en;
8762    }
8763    i=(an+en) / 2;
8764    if (set[i].pLength>ol) en=i;
8765    else                        an=i;
8766  }
8767}
8768#endif
8769
8770// kstd1.cc:
8771int redFirst (LObject* h,kStrategy strat);
8772int redEcart (LObject* h,kStrategy strat);
8773void enterSMora (LObject p,int atS,kStrategy strat, int atR=-1);
8774void enterSMoraNF (LObject p,int atS,kStrategy strat, int atR=-1);
8775// ../Singular/misc.cc:
8776extern char *  showOption();
8777
8778void kDebugPrint(kStrategy strat)
8779{
8780  PrintS("red: ");
8781    if (strat->red==redFirst) PrintS("redFirst\n");
8782    else if (strat->red==redHoney) PrintS("redHoney\n");
8783    else if (strat->red==redEcart) PrintS("redEcart\n");
8784    else if (strat->red==redHomog) PrintS("redHomog\n");
8785    else  Print("%p\n",(void*)strat->red);
8786  PrintS("posInT: ");
8787    if (strat->posInT==posInT0) PrintS("posInT0\n");
8788    else if (strat->posInT==posInT1) PrintS("posInT1\n");
8789    else if (strat->posInT==posInT11) PrintS("posInT11\n");
8790    else if (strat->posInT==posInT110) PrintS("posInT110\n");
8791    else if (strat->posInT==posInT13) PrintS("posInT13\n");
8792    else if (strat->posInT==posInT15) PrintS("posInT15\n");
8793    else if (strat->posInT==posInT17) PrintS("posInT17\n");
8794    else if (strat->posInT==posInT17_c) PrintS("posInT17_c\n");
8795    else if (strat->posInT==posInT19) PrintS("posInT19\n");
8796    else if (strat->posInT==posInT2) PrintS("posInT2\n");
8797#ifdef HAVE_MORE_POS_IN_T
8798    else if (strat->posInT==posInT_EcartFDegpLength) PrintS("posInT_EcartFDegpLength\n");
8799    else if (strat->posInT==posInT_FDegpLength) PrintS("posInT_FDegpLength\n");
8800    else if (strat->posInT==posInT_pLength) PrintS("posInT_pLength\n");
8801#endif
8802    else if (strat->posInT==posInT_EcartpLength) PrintS("posInT_EcartpLength\n");
8803    else if (strat->posInT==posInTrg0) PrintS("posInTrg0\n");
8804    else  Print("%p\n",(void*)strat->posInT);
8805  PrintS("posInL: ");
8806    if (strat->posInL==posInL0) PrintS("posInL0\n");
8807    else if (strat->posInL==posInL10) PrintS("posInL10\n");
8808    else if (strat->posInL==posInL11) PrintS("posInL11\n");
8809    else if (strat->posInL==posInL110) PrintS("posInL110\n");
8810    else if (strat->posInL==posInL13) PrintS("posInL13\n");
8811    else if (strat->posInL==posInL15) PrintS("posInL15\n");
8812    else if (strat->posInL==posInL17) PrintS("posInL17\n");
8813    else if (strat->posInL==posInL17_c) PrintS("posInL17_c\n");
8814    else if (strat->posInL==posInLSpecial) PrintS("posInLSpecial\n");
8815    else if (strat->posInL==posInLrg0) PrintS("posInLrg0\n");
8816    else  Print("%p\n",(void*)strat->posInL);
8817  PrintS("enterS: ");
8818    if (strat->enterS==enterSBba) PrintS("enterSBba\n");
8819    else if (strat->enterS==enterSMora) PrintS("enterSMora\n");
8820    else if (strat->enterS==enterSMoraNF) PrintS("enterSMoraNF\n");
8821    else  Print("%p\n",(void*)strat->enterS);
8822  PrintS("initEcart: ");
8823    if (strat->initEcart==initEcartBBA) PrintS("initEcartBBA\n");
8824    else if (strat->initEcart==initEcartNormal) PrintS("initEcartNormal\n");
8825    else  Print("%p\n",(void*)strat->initEcart);
8826  PrintS("initEcartPair: ");
8827    if (strat->initEcartPair==initEcartPairBba) PrintS("initEcartPairBba\n");
8828    else if (strat->initEcartPair==initEcartPairMora) PrintS("initEcartPairMora\n");
8829    else  Print("%p\n",(void*)strat->initEcartPair);
8830  Print("homog=%d, LazyDegree=%d, LazyPass=%d, ak=%d,\n",
8831         strat->homog, strat->LazyDegree,strat->LazyPass, strat->ak);
8832  Print("honey=%d, sugarCrit=%d, Gebauer=%d, noTailReduction=%d, use_buckets=%d\n",
8833         strat->honey,strat->sugarCrit,strat->Gebauer,strat->noTailReduction,strat->use_buckets);
8834  Print("posInLDependsOnLength=%d\n",
8835         strat->posInLDependsOnLength);
8836  PrintS(showOption());PrintLn();
8837  PrintS("LDeg: ");
8838    if (currRing->pLDeg==pLDeg0) PrintS("pLDeg0");
8839    else if (currRing->pLDeg==pLDeg0c) PrintS("pLDeg0c");
8840    else if (currRing->pLDeg==pLDegb) PrintS("pLDegb");
8841    else if (currRing->pLDeg==pLDeg1) PrintS("pLDeg1");
8842    else if (currRing->pLDeg==pLDeg1c) PrintS("pLDeg1c");
8843    else if (currRing->pLDeg==pLDeg1_Deg) PrintS("pLDeg1_Deg");
8844    else if (currRing->pLDeg==pLDeg1c_Deg) PrintS("pLDeg1c_Deg");
8845    else if (currRing->pLDeg==pLDeg1_Totaldegree) PrintS("pLDeg1_Totaldegree");
8846    else if (currRing->pLDeg==pLDeg1c_Totaldegree) PrintS("pLDeg1c_Totaldegree");
8847    else if (currRing->pLDeg==pLDeg1_WFirstTotalDegree) PrintS("pLDeg1_WFirstTotalDegree");
8848    else if (currRing->pLDeg==pLDeg1c_WFirstTotalDegree) PrintS("pLDeg1c_WFirstTotalDegree");
8849    else if (currRing->pLDeg==maxdegreeWecart) PrintS("maxdegreeWecart");
8850    else Print("? (%lx)", (long)currRing->pLDeg);
8851    PrintS(" / ");
8852    if (strat->tailRing->pLDeg==pLDeg0) PrintS("pLDeg0");
8853    else if (strat->tailRing->pLDeg==pLDeg0c) PrintS("pLDeg0c");
8854    else if (strat->tailRing->pLDeg==pLDegb) PrintS("pLDegb");
8855    else if (strat->tailRing->pLDeg==pLDeg1) PrintS("pLDeg1");
8856    else if (strat->tailRing->pLDeg==pLDeg1c) PrintS("pLDeg1c");
8857    else if (strat->tailRing->pLDeg==pLDeg1_Deg) PrintS("pLDeg1_Deg");
8858    else if (strat->tailRing->pLDeg==pLDeg1c_Deg) PrintS("pLDeg1c_Deg");
8859    else if (strat->tailRing->pLDeg==pLDeg1_Totaldegree) PrintS("pLDeg1_Totaldegree");
8860    else if (strat->tailRing->pLDeg==pLDeg1c_Totaldegree) PrintS("pLDeg1c_Totaldegree");
8861    else if (strat->tailRing->pLDeg==pLDeg1_WFirstTotalDegree) PrintS("pLDeg1_WFirstTotalDegree");
8862    else if (strat->tailRing->pLDeg==pLDeg1c_WFirstTotalDegree) PrintS("pLDeg1c_WFirstTotalDegree");
8863    else if (strat->tailRing->pLDeg==maxdegreeWecart) PrintS("maxdegreeWecart");
8864    else Print("? (%lx)", (long)strat->tailRing->pLDeg);
8865    PrintLn();
8866  PrintS("currRing->pFDeg: ");
8867    if (currRing->pFDeg==p_Totaldegree) PrintS("p_Totaldegree");
8868    else if (currRing->pFDeg==p_WFirstTotalDegree) PrintS("pWFirstTotalDegree");
8869    else if (currRing->pFDeg==p_Deg) PrintS("p_Deg");
8870    else if (currRing->pFDeg==kHomModDeg) PrintS("kHomModDeg");
8871    else if (currRing->pFDeg==totaldegreeWecart) PrintS("totaldegreeWecart");
8872    else if (currRing->pFDeg==p_WTotaldegree) PrintS("p_WTotaldegree");
8873    else Print("? (%lx)", (long)currRing->pFDeg);
8874    PrintLn();
8875    Print(" syzring:%d, syzComp(strat):%d limit:%d\n",rIsSyzIndexRing(currRing),strat->syzComp,rGetCurrSyzLimit(currRing));
8876    if(TEST_OPT_DEGBOUND)
8877      Print(" degBound: %d\n", Kstd1_deg);
8878
8879    if( ecartWeights != NULL )
8880    {
8881       PrintS("ecartWeights: ");
8882       for (int i = rVar(currRing); i > 0; i--)
8883         Print("%hd ", ecartWeights[i]);
8884       PrintLn();
8885       assume( TEST_OPT_WEIGHTM );
8886    }
8887
8888#ifndef SING_NDEBUG
8889    rDebugPrint(currRing);
8890#endif
8891}
8892
8893
8894#ifdef HAVE_SHIFTBBA
8895poly pMove2CurrTail(poly p, kStrategy strat)
8896{
8897  /* assume: p is completely in currRing */
8898  /* produces an object with LM in curring
8899     and TAIL in tailring */
8900  if (pNext(p)!=NULL)
8901  {
8902    pNext(p) = prMoveR(pNext(p), /* src */ currRing, /* dest */ strat->tailRing);
8903  }
8904  return(p);
8905}
8906#endif
8907
8908#ifdef HAVE_SHIFTBBA
8909poly pMoveCurrTail2poly(poly p, kStrategy strat)
8910{
8911  /* assume: p has  LM in curring and TAIL in tailring */
8912  /* convert it to complete currRing */
8913
8914  /* check that LM is in currRing */
8915  assume(p_LmCheckIsFromRing(p, currRing));
8916
8917  if (pNext(p)!=NULL)
8918  {
8919    pNext(p) = prMoveR(pNext(p), /* src */ strat->tailRing, /* dest */currRing);
8920  }
8921  return(p);
8922}
8923#endif
8924
8925#ifdef HAVE_SHIFTBBA
8926poly pCopyL2p(LObject H, kStrategy strat)
8927{
8928    /* restores a poly in currRing from LObject */
8929    LObject h = H;
8930    h.Copy();
8931    poly p;
8932    if (h.p == NULL)
8933    {
8934      if (h.t_p != NULL)
8935      {
8936         p = prMoveR(h.t_p, /* source ring: */ strat->tailRing, /* dest. ring: */ currRing);
8937        return(p);
8938      }
8939      else
8940      {
8941        /* h.tp == NULL -> the object is NULL */
8942        return(NULL);
8943      }
8944    }
8945    /* we're here if h.p != NULL */
8946    if (h.t_p == NULL)
8947    {
8948       /* then h.p is the whole poly in currRing */
8949       p = h.p;
8950      return(p);
8951    }
8952    /* we're here if h.p != NULL and h.t_p != NULL */
8953    // clean h.p, get poly from t_p
8954     pNext(h.p)=NULL;
8955     pDelete(&h.p);
8956     p = prMoveR(h.t_p, /* source ring: */ strat->tailRing,
8957                         /* dest. ring: */ currRing);
8958     // no need to clean h: we re-used the polys
8959    return(p);
8960}
8961#endif
8962
8963//LObject pCopyp2L(poly p, kStrategy strat)
8964//{
8965    /* creates LObject from the poly in currRing */
8966  /* actually put p into L.p and make L.t_p=NULL : does not work */
8967
8968//}
8969
8970// poly pCopyL2p(LObject H, kStrategy strat)
8971// {
8972//   /* restores a poly in currRing from LObject */
8973//   LObject h = H;
8974//   h.Copy();
8975//   poly p;
8976//   if (h.p == NULL)
8977//   {
8978//     if (h.t_p != NULL)
8979//     {
8980//       p = p_ShallowCopyDelete(h.t_p, (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
8981//       return(p);
8982//     }
8983//     else
8984//     {
8985//       /* h.tp == NULL -> the object is NULL */
8986//       return(NULL);
8987//     }
8988//   }
8989//   /* we're here if h.p != NULL */
8990
8991//   if (h.t_p == NULL)
8992//   {
8993//     /* then h.p is the whole poly in tailRing */
8994//     if (strat->tailBin != NULL && (pNext(h.p) != NULL))
8995//     {
8996//       p = p_ShallowCopyDelete(h.p, (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
8997//     }
8998//     return(p);
8999//   }
9000//   /* we're here if h.p != NULL and h.t_p != NULL */
9001//   p = pCopy(pHead(h.p)); // in currRing
9002//   if (strat->tailBin != NULL && (pNext(h.p) != NULL))
9003//   {
9004//     //    pNext(p) = p_ShallowCopyDelete(pNext(h.t_p), (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
9005//     poly pp = p_Copy(pNext(h.p), strat->tailRing);
9006//     //    poly p3 = p_Copy(pNext(h.p), currRing); // error
9007//       // p_ShallowCopyDelete(pNext(h.p), currRing, strat->tailBin); // the same as pp
9008//     poly p5 = p_ShallowCopyDelete(pNext(h.p), strat->tailRing, strat->tailBin);
9009//     pNext(p) = p_ShallowCopyDelete(h.t_p, strat->tailRing, strat->tailBin);
9010//     poly p4 = p_Copy(h.t_p, strat->tailRing);
9011//     //    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
9012//   }
9013//   //  pTest(p);
9014//   return(p);
9015// }
9016
9017#ifdef HAVE_SHIFTBBA
9018/* including the self pairs */
9019void updateSShift(kStrategy strat,int uptodeg,int lV)
9020{
9021  /* to use after updateS(toT=FALSE,strat) */
9022  /* fills T with shifted elt's of S */
9023  int i;
9024  LObject h;
9025  int atT = -1; // or figure out smth better
9026  strat->tl = -1; // init
9027  for (i=0; i<=strat->sl; i++)
9028  {
9029    memset(&h,0,sizeof(h));
9030    h.p =  strat->S[i]; // lm in currRing, tail in TR
9031    strat->initEcart(&h);
9032    h.sev = strat->sevS[i];
9033    h.t_p = NULL;
9034    h.GetTP(); // creates correct t_p
9035    /*puts the elements of S with their shifts to T*/
9036    //    int atT, int uptodeg, int lV)
9037    strat->S_2_R[i] = strat->tl + 1; // the el't with shift 0 will be inserted first
9038    // need a small check for above; we insert >=1 elements
9039    // insert this check into kTest_TS ?
9040    enterTShift(h,strat,atT,uptodeg,lV);
9041  }
9042  /* what about setting strat->tl? */
9043}
9044#endif
9045
9046#ifdef HAVE_SHIFTBBA
9047void initBuchMoraShift (ideal F,ideal Q,kStrategy strat)
9048{
9049  strat->interpt = BTEST1(OPT_INTERRUPT);
9050  strat->kHEdge=NULL;
9051  if (currRing->OrdSgn==1) strat->kHEdgeFound=FALSE;
9052  /*- creating temp data structures------------------- -*/
9053  strat->cp = 0;
9054  strat->c3 = 0;
9055  strat->cv = 0;
9056  strat->tail = pInit();
9057  /*- set s -*/
9058  strat->sl = -1;
9059  /*- set L -*/
9060  strat->Lmax = setmaxL;
9061  strat->Ll = -1;
9062  strat->L = initL();
9063  /*- set B -*/
9064  strat->Bmax = setmaxL;
9065  strat->Bl = -1;
9066  strat->B = initL();
9067  /*- set T -*/
9068  strat->tl = -1;
9069  strat->tmax = setmaxT;
9070  strat->T = initT();
9071  strat->R = initR();
9072  strat->sevT = initsevT();
9073  /*- init local data struct.---------------------------------------- -*/
9074  strat->P.ecart=0;
9075  strat->P.length=0;
9076  if (currRing->OrdSgn==-1)
9077  {
9078    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
9079    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
9080  }
9081  #ifdef HAVE_RINGS
9082  if(rField_is_Ring(currRing))
9083  {
9084    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
9085  }
9086  #endif
9087  {
9088    if(TEST_OPT_SB_1)
9089    {
9090        int i;
9091        ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
9092        for (i=strat->newIdeal;i<IDELEMS(F);i++)
9093        {
9094          P->m[i-strat->newIdeal] = F->m[i];
9095          F->m[i] = NULL;
9096        }
9097        initSSpecial(F,Q,P,strat);
9098        for (i=strat->newIdeal;i<IDELEMS(F);i++)
9099        {
9100          F->m[i] = P->m[i-strat->newIdeal];
9101          P->m[i-strat->newIdeal] = NULL;
9102        }
9103        idDelete(&P);
9104    }
9105    else
9106    {
9107      /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
9108      // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
9109    }
9110  }
9111  strat->fromT = FALSE;
9112  strat->noTailReduction = !TEST_OPT_REDTAIL;
9113  if (!TEST_OPT_SB_1)
9114  {
9115    /* the only change: we do not fill the set T*/
9116    #ifdef HAVE_RINGS
9117    if(!rField_is_Ring(currRing))
9118    #endif
9119    updateS(FALSE,strat);
9120  }
9121  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
9122  strat->fromQ=NULL;
9123  /* more changes: fill the set T with all the shifts of elts of S*/
9124  /* is done by other procedure */
9125}
9126#endif
9127
9128#ifdef HAVE_SHIFTBBA
9129/*1
9130* put the pairs (sh \dot s[i],p)  into the set B, ecart=ecart(p)
9131*/
9132void enterOnePairManyShifts (int i, poly p, int ecart, int isFromQ, kStrategy strat, int /*atR*/, int uptodeg, int lV)
9133{
9134  /* p comes from strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
9135
9136  assume(p_LmCheckIsFromRing(p,currRing));
9137  assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
9138
9139  /* cycles through all shifts of s[i] until uptodeg - lastVblock(s[i]) */
9140  /* that is create the pairs (f, s \dot g)  */
9141
9142  poly qq = strat->S[i]; //  lm in currRing, tail in tailRing
9143
9144  //  poly q = pCopy(pHead(strat->S[i])); // lm in currRing
9145  //  pNext(q) = prCopyR(pNext(strat->S[i]),strat->tailRing,currRing); // zero shift
9146
9147 /* determine how many elements we have to insert for a given s[i] */
9148  /* x(0)y(1)z(2) : lastVblock-1=2, to add until lastVblock=uptodeg-1 */
9149  /* hence, a total number of elt's to add is: */
9150  /*  int toInsert = 1 + (uptodeg-1) - (pLastVblock(p.p, lV) -1);  */
9151  int toInsert =  itoInsert(qq, uptodeg,  lV, strat->tailRing);
9152
9153#ifdef KDEBUG
9154    if (TEST_OPT_DEBUG)
9155    {
9156      //      Print("entered ManyShifts: with toInsert=%d",toInsert); PrintLn();
9157    }
9158#endif
9159
9160  assume(i<=strat->sl); // from OnePair
9161  if (strat->interred_flag) return; // ?
9162
9163  /* these vars hold for all shifts of s[i] */
9164  int ecartq = 0; //Hans says it's ok; we're in the homog case, no ecart
9165
9166  int qfromQ;
9167  if (strat->fromQ != NULL)
9168  {
9169    qfromQ = strat->fromQ[i];
9170  }
9171  else
9172  {
9173    qfromQ = -1;
9174  }
9175
9176  int j;
9177
9178  poly q/*, s*/;
9179
9180  // for the 0th shift: insert the orig. pair
9181  enterOnePairShift(qq, p, ecart, isFromQ, strat, -1, ecartq, qfromQ, 0, i, uptodeg, lV);
9182
9183  for (j=1; j<= toInsert; j++)
9184  {
9185    //    q = pLPshift(strat->S[i],j,uptodeg,lV);
9186    q = p_LPshiftT(qq, j, uptodeg, lV, strat, currRing);
9187    //    q = p_mLPshift(qq,j,uptodeg,lV,currRing); // lm in currRing, shift this monomial
9188    //    s = p_LPshift(pNext(qq), j, uptodeg, lV, strat->tailRing); // from tailRing
9189    //    pNext(q) = s; // in tailRing
9190    /* here we need to call enterOnePair with two polys ... */
9191
9192#ifdef KDEBUG
9193    if (TEST_OPT_DEBUG)
9194    {
9195      //      PrintS("ManyShifts: calling enterOnePairShift(q,p)");      PrintLn();
9196    }
9197#endif
9198    enterOnePairShift(q, p, ecart, isFromQ, strat, -1, ecartq, qfromQ, j, i, uptodeg, lV);
9199  }
9200}
9201#endif
9202
9203#ifdef HAVE_SHIFTBBA
9204/*1
9205* put the pairs (sh \dot qq,p)  into the set B, ecart=ecart(p)
9206* despite the name, not only self shifts
9207*/
9208void enterOnePairSelfShifts (poly qq, poly p, int ecart, int isFromQ, kStrategy strat, int /*atR*/, int uptodeg, int lV)
9209{
9210
9211  /* format: p,qq are in LObject form: lm in CR, tail in TR */
9212  /* for true self pairs qq ==p  */
9213  /* we test both qq and p */
9214  assume(p_LmCheckIsFromRing(qq,currRing));
9215  assume(p_CheckIsFromRing(pNext(qq),strat->tailRing));
9216  assume(p_LmCheckIsFromRing(p,currRing));
9217  assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
9218
9219  /* since this proc is applied twice for (h, s*g) and (g,s*h), init j with 1 only */
9220
9221  //  int j = 0;
9222  int j = 1;
9223
9224  /* for such self pairs start with 1, not with 0 */
9225  if (qq == p) j=1;
9226
9227  /* should cycle through all shifts of q until uptodeg - lastVblock(q) */
9228  /* that is create the pairs (f, s \dot g)  */
9229
9230  int toInsert =  itoInsert(qq, uptodeg,  lV, strat->tailRing);
9231
9232#ifdef KDEBUG
9233    if (TEST_OPT_DEBUG)
9234    {
9235      //      Print("entered SelfShifts: with toInsert=%d",toInsert); PrintLn();
9236    }
9237#endif
9238
9239  poly q;
9240
9241  if (strat->interred_flag) return; // ?
9242
9243  /* these vars hold for all shifts of s[i] */
9244  int ecartq = 0; //Hans says it's ok; we're in the homog case, no ecart
9245  int qfromQ = 0; // strat->fromQ[i];
9246
9247  for (; j<= toInsert; j++)
9248  {
9249    //    q = pLPshift(strat->S[i],j,uptodeg,lV);
9250    /* we increase shifts by one; must delete q there*/
9251    //    q = qq; q = pMoveCurrTail2poly(q,strat);
9252    //    q = pLPshift(q,j,uptodeg,lV); //,currRing);
9253    q = p_LPshiftT(qq, j, uptodeg, lV, strat, currRing);
9254    //    q = p_mLPshift(qq,j,uptodeg,lV,currRing); // lm in currRing, shift this monomial
9255    //    s = p_LPshift(pNext(qq), j, uptodeg, lV, strat->tailRing); // from tailRing
9256    //    pNext(q) = s; // in tailRing
9257    /* here we need to call enterOnePair with two polys ... */
9258#ifdef KDEBUG
9259    if (TEST_OPT_DEBUG)
9260    {
9261      //      PrintS("SelfShifts: calling enterOnePairShift(q,p)");      PrintLn();
9262    }
9263#endif
9264    enterOnePairShift(q, p, ecart, isFromQ, strat, -1, ecartq, qfromQ, j, -1, uptodeg, lV);
9265  }
9266}
9267#endif
9268
9269#ifdef HAVE_SHIFTBBA
9270/*2
9271* put the pair (q,p)  into the set B, ecart=ecart(p), q is the shift of some s[i]
9272*/
9273void enterOnePairShift (poly q, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int ecartq, int qisFromQ, int shiftcount, int ifromS, int /*uptodeg*/, int lV)
9274{
9275
9276  /* Format: q and p are like strat->P.p, so lm in CR, tail in TR */
9277
9278  /* check this Formats: */
9279  assume(p_LmCheckIsFromRing(q,currRing));
9280  assume(p_CheckIsFromRing(pNext(q),strat->tailRing));
9281  assume(p_LmCheckIsFromRing(p,currRing));
9282  assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
9283
9284#ifdef KDEBUG
9285    if (TEST_OPT_DEBUG)
9286    {
9287//       PrintS("enterOnePairShift(q,p) invoked with q = ");
9288//       wrp(q); //      wrp(pHead(q));
9289//       PrintS(", p = ");
9290//       wrp(p); //wrp(pHead(p));
9291//       PrintLn();
9292    }
9293#endif
9294
9295  /* poly q stays for s[i], ecartq = ecart(q), qisFromQ = applies to q */
9296
9297  int qfromQ = qisFromQ;
9298
9299  /* need additionally: int up_to_degree, poly V0 with the variables in (0)  or just the number lV = the length of the first block */
9300
9301  if (strat->interred_flag) return;
9302
9303  int      l,j,compare;
9304  LObject  Lp;
9305  Lp.i_r = -1;
9306
9307#ifdef KDEBUG
9308  Lp.ecart=0; Lp.length=0;
9309#endif
9310  /*- computes the lcm(s[i],p) -*/
9311  Lp.lcm = pInit();
9312
9313  pLcm(p,q, Lp.lcm); // q is what was strat->S[i], so a poly in LM/TR presentation
9314  pSetm(Lp.lcm);
9315
9316  /* apply the V criterion */
9317  if (!isInV(Lp.lcm, lV))
9318  {
9319#ifdef KDEBUG
9320    if (TEST_OPT_DEBUG)
9321    {
9322      PrintS("V crit applied to q = ");
9323      wrp(q); //      wrp(pHead(q));
9324      PrintS(", p = ");
9325      wrp(p); //wrp(pHead(p));
9326      PrintLn();
9327    }
9328#endif
9329    pLmFree(Lp.lcm);
9330    Lp.lcm=NULL;
9331    /* + counter for applying the V criterion */
9332    strat->cv++;
9333    return;
9334  }
9335
9336  if (strat->sugarCrit && ALLOW_PROD_CRIT(strat))
9337  {
9338    if((!((ecartq>0)&&(ecart>0)))
9339    && pHasNotCF(p,q))
9340    {
9341    /*
9342    *the product criterion has applied for (s,p),
9343    *i.e. lcm(s,p)=product of the leading terms of s and p.
9344    *Suppose (s,r) is in L and the leading term
9345    *of p divides lcm(s,r)
9346    *(==> the leading term of p divides the leading term of r)
9347    *but the leading term of s does not divide the leading term of r
9348    *(notice that this condition is automatically satisfied if r is still
9349    *in S), then (s,r) can be cancelled.
9350    *This should be done here because the
9351    *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
9352    *
9353    *Moreover, skipping (s,r) holds also for the noncommutative case.
9354    */
9355      strat->cp++;
9356      pLmFree(Lp.lcm);
9357      Lp.lcm=NULL;
9358      return;
9359    }
9360    else
9361      Lp.ecart = si_max(ecart,ecartq);
9362    if (strat->fromT && (ecartq>ecart))
9363    {
9364      pLmFree(Lp.lcm);
9365      Lp.lcm=NULL;
9366      return;
9367      /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
9368    }
9369    /*
9370    *the set B collects the pairs of type (S[j],p)
9371    *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
9372    *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
9373    *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
9374    */
9375    {
9376      j = strat->Bl;
9377      loop
9378      {
9379        if (j < 0)  break;
9380        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
9381        if ((compare==1)
9382        &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
9383        {
9384          strat->c3++;
9385          if ((strat->fromQ==NULL) || (isFromQ==0) || (qfromQ==0))
9386          {
9387            pLmFree(Lp.lcm);
9388            return;
9389          }
9390          break;
9391        }
9392        else
9393        if ((compare ==-1)
9394        && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
9395        {
9396          deleteInL(strat->B,&strat->Bl,j,strat);
9397          strat->c3++;
9398        }
9399        j--;
9400      }
9401    }
9402  }
9403  else /*sugarcrit*/
9404  {
9405    if (ALLOW_PROD_CRIT(strat))
9406    {
9407      // if currRing->nc_type!=quasi (or skew)
9408      // TODO: enable productCrit for super commutative algebras...
9409      if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
9410      pHasNotCF(p,q))
9411      {
9412      /*
9413      *the product criterion has applied for (s,p),
9414      *i.e. lcm(s,p)=product of the leading terms of s and p.
9415      *Suppose (s,r) is in L and the leading term
9416      *of p devides lcm(s,r)
9417      *(==> the leading term of p devides the leading term of r)
9418      *but the leading term of s does not devide the leading term of r
9419      *(notice that tis condition is automatically satisfied if r is still
9420      *in S), then (s,r) can be canceled.
9421      *This should be done here because the
9422      *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
9423      */
9424          strat->cp++;
9425          pLmFree(Lp.lcm);
9426          Lp.lcm=NULL;
9427          return;
9428      }
9429      if (strat->fromT && (ecartq>ecart))
9430      {
9431        pLmFree(Lp.lcm);
9432        Lp.lcm=NULL;
9433        return;
9434        /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
9435      }
9436      /*
9437      *the set B collects the pairs of type (S[j],p)
9438      *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
9439      *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
9440      *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
9441      */
9442      for(j = strat->Bl;j>=0;j--)
9443      {
9444        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
9445        if (compare==1)
9446        {
9447          strat->c3++;
9448          if ((strat->fromQ==NULL) || (isFromQ==0) || (qfromQ==0))
9449          {
9450            pLmFree(Lp.lcm);
9451            return;
9452          }
9453          break;
9454        }
9455        else
9456        if (compare ==-1)
9457        {
9458          deleteInL(strat->B,&strat->Bl,j,strat);
9459          strat->c3++;
9460        }
9461      }
9462    }
9463  }
9464  /*
9465  *the pair (S[i],p) enters B if the spoly != 0
9466  */
9467  /*-  compute the short s-polynomial -*/
9468  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
9469    pNorm(p);
9470  if ((q==NULL) || (p==NULL))
9471    return;
9472  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (qfromQ!=0))
9473    Lp.p=NULL;
9474  else
9475  {
9476//     if ( rIsPluralRing(currRing) )
9477//     {
9478//       if(pHasNotCF(p, q))
9479//       {
9480//         if(ncRingType(currRing) == nc_lie)
9481//         {
9482//             // generalized prod-crit for lie-type
9483//             strat->cp++;
9484//             Lp.p = nc_p_Bracket_qq(pCopy(p),q, currRing);
9485//         }
9486//         else
9487//         if( ALLOW_PROD_CRIT(strat) )
9488//         {
9489//             // product criterion for homogeneous case in SCA
9490//             strat->cp++;
9491//             Lp.p = NULL;
9492//         }
9493//         else
9494//           Lp.p = nc_CreateSpoly(q,p,currRing); // ?
9495//       }
9496//       else  Lp.p = nc_CreateSpoly(q,p,currRing);
9497//     }
9498//     else
9499//     {
9500
9501    /* ksCreateShortSpoly needs two Lobject-kind presentations */
9502    /* p is already in this form, so convert q */
9503    //    q = pMove2CurrTail(q, strat);
9504    Lp.p = ksCreateShortSpoly(q, p, strat->tailRing);
9505      //  }
9506  }
9507  if (Lp.p == NULL)
9508  {
9509    /*- the case that the s-poly is 0 -*/
9510    /* TEMPORARILY DISABLED FOR SHIFTS because there is no i*/
9511//      if (strat->pairtest==NULL) initPairtest(strat);
9512//      strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
9513//      strat->pairtest[strat->sl+1] = TRUE;
9514    /* END _ TEMPORARILY DISABLED FOR SHIFTS */
9515    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
9516    /*
9517    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
9518    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
9519    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
9520    *term of p devides the lcm(s,r)
9521    *(this canceling should be done here because
9522    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
9523    *the first case is handeled in chainCrit
9524    */
9525    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
9526  }
9527  else
9528  {
9529    /*- the pair (S[i],p) enters B -*/
9530    /* both of them should have their LM in currRing and TAIL in tailring */
9531    Lp.p1 = q;  // already in the needed form
9532    Lp.p2 = p; // already in the needed form
9533
9534    if ( !rIsPluralRing(currRing) )
9535      pNext(Lp.p) = strat->tail;
9536
9537    /* TEMPORARILY DISABLED FOR SHIFTS because there's no i*/
9538    /* at the beginning we DO NOT set atR = -1 ANYMORE*/
9539    if ( (atR >= 0) && (shiftcount==0) && (ifromS >=0) )
9540    {
9541      Lp.i_r1 = kFindInT(Lp.p1,strat); //strat->S_2_R[ifromS];
9542      Lp.i_r2 = atR;
9543    }
9544    else
9545    {
9546      /* END _ TEMPORARILY DISABLED FOR SHIFTS */
9547      Lp.i_r1 = -1;
9548      Lp.i_r2 = -1;
9549     }
9550    strat->initEcartPair(&Lp,q,p,ecartq,ecart);
9551
9552    if (TEST_OPT_INTSTRATEGY)
9553    {
9554      if (!rIsPluralRing(currRing))
9555        nDelete(&(Lp.p->coef));
9556    }
9557
9558    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
9559    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
9560  }
9561}
9562#endif
9563
9564#ifdef HAVE_SHIFTBBA
9565/*2
9566*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
9567*superfluous elements in S will be deleted
9568*/
9569void enterpairsShift (poly h,int k,int ecart,int pos,kStrategy strat, int atR,int uptodeg, int lV)
9570{
9571  /* h is strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
9572  /* Q: what is exactly the strat->fromT ? A: a local case trick; don't need it yet*/
9573  int j=pos;
9574
9575#ifdef HAVE_RINGS
9576  assume (!rField_is_Ring(currRing));
9577#endif
9578  initenterpairsShift(h,k,ecart,0,strat, atR,uptodeg,lV);
9579  if ( (!strat->fromT)
9580  && ((strat->syzComp==0)
9581    ||(pGetComp(h)<=strat->syzComp)))
9582  {
9583    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
9584    unsigned long h_sev = pGetShortExpVector(h);
9585    loop
9586    {
9587      if (j > k) break;
9588      clearS(h,h_sev, &j,&k,strat);
9589      j++;
9590    }
9591    //Print("end clearS sl=%d\n",strat->sl);
9592  }
9593 // PrintS("end enterpairs\n");
9594}
9595#endif
9596
9597#ifdef HAVE_SHIFTBBA
9598/*3
9599*(s[0], s \dot h),...,(s[k],s \dot h) will be put to the pairset L
9600* also the pairs (h, s\dot s[0]), ..., (h, s\dot s[k]) enter L
9601* additionally we put the pairs (h, s \sdot h) for s>=1 to L
9602*/
9603void initenterpairsShift (poly h,int k,int ecart,int isFromQ, kStrategy strat, int atR, int uptodeg, int lV)
9604{
9605  /* h comes from strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
9606  //  atR = -1;
9607  if ((strat->syzComp==0)
9608  || (pGetComp(h)<=strat->syzComp))
9609  {
9610    int j;
9611    BOOLEAN new_pair=FALSE;
9612
9613    if (pGetComp(h)==0)
9614    {
9615      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
9616      if ((isFromQ)&&(strat->fromQ!=NULL))
9617      {
9618        for (j=0; j<=k; j++)
9619        {
9620          if (!strat->fromQ[j])
9621          {
9622            new_pair=TRUE;
9623            enterOnePairManyShifts(j,h,ecart,isFromQ,strat, atR,uptodeg,lV);
9624            // other side pairs:
9625            enterOnePairSelfShifts(h,strat->S[j],ecart,isFromQ,strat, atR,uptodeg,lV);
9626          //Print("j:%d, Ll:%d\n",j,strat->Ll);
9627          }
9628        }
9629      }
9630      else
9631      {
9632        new_pair=TRUE;
9633        for (j=0; j<=k; j++)
9634        {
9635          enterOnePairManyShifts(j,h,ecart,isFromQ,strat, atR,uptodeg,lV);
9636          // other side pairs
9637          enterOnePairSelfShifts(h,strat->S[j],ecart,isFromQ,strat, atR,uptodeg,lV);
9638        }
9639        /* HERE we put (h, s*h) pairs */
9640       /* enterOnePairSelfShifts (poly qq, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int uptodeg, int lV); */
9641       enterOnePairSelfShifts (h, h, ecart, isFromQ, strat, atR, uptodeg, lV);
9642      }
9643    }
9644    else
9645    {
9646      for (j=0; j<=k; j++)
9647      {
9648        if ((pGetComp(h)==pGetComp(strat->S[j]))
9649        || (pGetComp(strat->S[j])==0))
9650        {
9651          new_pair=TRUE;
9652          enterOnePairManyShifts(j,h,ecart,isFromQ,strat, atR, uptodeg, lV);
9653          // other side pairs
9654          enterOnePairSelfShifts(h,strat->S[j],ecart,isFromQ,strat, atR,uptodeg,lV);
9655        //Print("j:%d, Ll:%d\n",j,strat->Ll);
9656        }
9657      }
9658      /* HERE we put (h, s*h) pairs */
9659      enterOnePairSelfShifts (h, h, ecart, isFromQ, strat, atR, uptodeg, lV);
9660    }
9661
9662    if (new_pair)
9663    {
9664      strat->chainCrit(h,ecart,strat);
9665    }
9666
9667  }
9668}
9669#endif
9670
9671#ifdef HAVE_SHIFTBBA
9672/*2
9673* puts p to the set T, starting with the at position atT
9674* and inserts all admissible shifts of p
9675*/
9676void enterTShift(LObject p, kStrategy strat, int atT, int uptodeg, int lV)
9677{
9678  /* determine how many elements we have to insert */
9679  /* x(0)y(1)z(2) : lastVblock-1=2, to add until lastVblock=uptodeg-1 */
9680  /* hence, a total number of elt's to add is: */
9681  /*  int toInsert = 1 + (uptodeg-1) - (pLastVblock(p.p, lV) -1);  */
9682
9683  int toInsert =  itoInsert(p.p, uptodeg,  lV, strat->tailRing);
9684
9685#ifdef PDEBUG
9686  //  Print("enterTShift uses toInsert: %d", toInsert);  PrintLn();
9687#endif
9688  int i;
9689
9690  if (atT < 0)
9691    atT = strat->posInT(strat->T, strat->tl, p);
9692
9693  /* can call enterT in a sequence, e.g. */
9694
9695  /* shift0 = it's our model for further shifts */
9696  enterT(p,strat,atT);
9697  LObject qq;
9698  for (i=1; i<=toInsert; i++) // toIns - 1?
9699  {
9700    qq      = p; //qq.Copy();
9701    qq.p    = NULL;
9702    qq.max  = NULL;
9703    qq.t_p = p_LPshift(p_Copy(p.t_p,strat->tailRing), i, uptodeg, lV, strat->tailRing); // direct shift
9704    qq.GetP();
9705    // update q.sev
9706    qq.sev = pGetShortExpVector(qq.p);
9707    /* enter it into T, first el't is with the shift 0 */
9708    // compute the position for qq
9709    atT = strat->posInT(strat->T, strat->tl, qq);
9710    enterT(qq,strat,atT);
9711  }
9712/* Q: what to do with this one in the orig enterT ? */
9713/*  strat->R[strat->tl] = &(strat->T[atT]); */
9714/* Solution: it is done by enterT each time separately */
9715}
9716#endif
9717
9718#ifdef HAVE_SHIFTBBA
9719poly redtailBbaShift (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
9720{
9721  /* for the shift case need to run it with withT = TRUE */
9722  strat->redTailChange=FALSE;
9723  if (strat->noTailReduction) return L->GetLmCurrRing();
9724  poly h, p;
9725  p = h = L->GetLmTailRing();
9726  if ((h==NULL) || (pNext(h)==NULL))
9727    return L->GetLmCurrRing();
9728
9729  TObject* With;
9730  // placeholder in case strat->tl < 0
9731  TObject  With_s(strat->tailRing);
9732
9733  LObject Ln(pNext(h), strat->tailRing);
9734  Ln.pLength = L->GetpLength() - 1;
9735
9736  pNext(h) = NULL;
9737  if (L->p != NULL) pNext(L->p) = NULL;
9738  L->pLength = 1;
9739
9740  Ln.PrepareRed(strat->use_buckets);
9741
9742  while(!Ln.IsNull())
9743  {
9744    loop
9745    {
9746      Ln.SetShortExpVector();
9747      if (withT)
9748      {
9749        int j;
9750        j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
9751        if (j < 0) break;
9752        With = &(strat->T[j]);
9753      }
9754      else
9755      {
9756        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
9757        if (With == NULL) break;
9758      }
9759      if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
9760      {
9761        With->pNorm();
9762        //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
9763      }
9764      strat->redTailChange=TRUE;
9765      if (ksReducePolyTail(L, With, &Ln))
9766      {
9767        // reducing the tail would violate the exp bound
9768        //  set a flag and hope for a retry (in bba)
9769        strat->completeReduce_retry=TRUE;
9770        if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
9771        do
9772        {
9773          pNext(h) = Ln.LmExtractAndIter();
9774          pIter(h);
9775          L->pLength++;
9776        } while (!Ln.IsNull());
9777        goto all_done;
9778      }
9779      if (Ln.IsNull()) goto all_done;
9780      if (! withT) With_s.Init(currRing);
9781    }
9782    pNext(h) = Ln.LmExtractAndIter();
9783    pIter(h);
9784    L->pLength++;
9785  }
9786
9787  all_done:
9788  Ln.Delete();
9789  if (L->p != NULL) pNext(L->p) = pNext(p);
9790
9791  if (strat->redTailChange)
9792  {
9793    L->length = 0;
9794  }
9795  L->Normalize(); // HANNES: should have a test
9796  kTest_L(L);
9797  return L->GetLmCurrRing();
9798}
9799#endif
Note: See TracBrowser for help on using the repository browser.