source: git/kernel/kutil.cc @ cf4277e

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