source: git/kernel/kutil.cc @ 1eba39

spielwiese
Last change on this file since 1eba39 was 1eba39, checked in by Christian Eder, 10 years ago
partly fixes memory generation for degree-index-lt order
  • Property mode set to 100644
File size: 250.6 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT: kernel: utils for kStd
6*/
7
8// #define PDEBUG 2
9// #define PDIV_DEBUG
10#define KUTIL_CC
11#include <stdlib.h>
12#include <string.h>
13#ifdef HAVE_CONFIG_H
14#include "singularconfig.h"
15#endif /* HAVE_CONFIG_H */
16#include "mod2.h"
17
18#ifndef NDEBUG
19# define MYTEST 0
20#else /* ifndef NDEBUG */
21# define MYTEST 0
22#endif /* ifndef NDEBUG */
23
24
25#include <misc/mylimits.h>
26#include <misc/options.h>
27#include <polys/nc/nc.h>
28#include <polys/nc/sca.h>
29#include <polys/weight.h> /* for kDebugPrint: maxdegreeWecart*/
30#ifdef KDEBUG
31#undef KDEBUG
32#define KDEBUG 2
33#endif
34
35#ifdef DEBUGF5
36#undef DEBUGF5
37//#define DEBUGF5 1
38#endif
39
40#ifdef HAVE_RINGS
41#include <kernel/ideals.h>
42#endif
43
44// define if enterL, enterT should use memmove instead of doing it manually
45// on topgun, this is slightly faster (see monodromy_l.tst, homog_gonnet.sing)
46#ifndef SunOS_4
47#define ENTER_USE_MEMMOVE
48#endif
49
50// define, if the my_memmove inlines should be used instead of
51// system memmove -- it does not seem to pay off, though
52// #define ENTER_USE_MYMEMMOVE
53
54#include <kernel/kutil.h>
55#include <polys/kbuckets.h>
56#include <kernel/febase.h>
57#include <omalloc/omalloc.h>
58#include <coeffs/numbers.h>
59#include <kernel/polys.h>
60#include <polys/monomials/ring.h>
61#include <kernel/ideals.h>
62#include <kernel/timer.h>
63//#include "cntrlc.h"
64#include <kernel/stairc.h>
65#include <kernel/kstd1.h>
66#include <polys/operations/pShallowCopyDelete.h>
67
68/* shiftgb stuff */
69#include <kernel/shiftgb.h>
70#include <polys/prCopy.h>
71
72#ifdef HAVE_RATGRING
73#include <kernel/ratgring.h>
74#endif
75
76#ifdef KDEBUG
77#undef KDEBUG
78#define KDEBUG 2
79#endif
80
81#ifdef DEBUGF5
82#undef DEBUGF5
83#define DEBUGF5 2
84#endif
85
86#define ADIDEBUG 0
87
88denominator_list DENOMINATOR_LIST=NULL;
89
90
91#ifdef ENTER_USE_MYMEMMOVE
92inline void _my_memmove_d_gt_s(unsigned long* d, unsigned long* s, long l)
93{
94  register unsigned long* _dl = (unsigned long*) d;
95  register unsigned long* _sl = (unsigned long*) s;
96  register long _i = l - 1;
97
98  do
99  {
100    _dl[_i] = _sl[_i];
101    _i--;
102  }
103  while (_i >= 0);
104}
105
106inline void _my_memmove_d_lt_s(unsigned long* d, unsigned long* s, long l)
107{
108  register long _ll = l;
109  register unsigned long* _dl = (unsigned long*) d;
110  register unsigned long* _sl = (unsigned long*) s;
111  register long _i = 0;
112
113  do
114  {
115    _dl[_i] = _sl[_i];
116    _i++;
117  }
118  while (_i < _ll);
119}
120
121inline void _my_memmove(void* d, void* s, long l)
122{
123  unsigned long _d = (unsigned long) d;
124  unsigned long _s = (unsigned long) s;
125  unsigned long _l = ((l) + SIZEOF_LONG - 1) >> LOG_SIZEOF_LONG;
126
127  if (_d > _s) _my_memmove_d_gt_s(_d, _s, _l);
128  else _my_memmove_d_lt_s(_d, _s, _l);
129}
130
131#undef memmove
132#define memmove(d,s,l) _my_memmove(d, s, l)
133#endif
134
135static poly redMora (poly h,int maxIndex,kStrategy strat);
136static poly redBba (poly h,int maxIndex,kStrategy strat);
137
138#ifdef HAVE_RINGS
139#define pDivComp_EQUAL 2
140#define pDivComp_LESS 1
141#define pDivComp_GREATER -1
142#define pDivComp_INCOMP 0
143/* Checks the relation of LM(p) and LM(q)
144     LM(p) = LM(q) => return pDivComp_EQUAL
145     LM(p) | LM(q) => return pDivComp_LESS
146     LM(q) | LM(p) => return pDivComp_GREATER
147     else return pDivComp_INCOMP */
148static inline int pDivCompRing(poly p, poly q)
149{
150  if (pGetComp(p) == pGetComp(q))
151  {
152    BOOLEAN a=FALSE, b=FALSE;
153    int i;
154    unsigned long la, lb;
155    unsigned long divmask = currRing->divmask;
156    for (i=0; i<currRing->VarL_Size; i++)
157    {
158      la = p->exp[currRing->VarL_Offset[i]];
159      lb = q->exp[currRing->VarL_Offset[i]];
160      if (la != lb)
161      {
162        if (la < lb)
163        {
164          if (b) return pDivComp_INCOMP;
165          if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
166            return pDivComp_INCOMP;
167          a = TRUE;
168        }
169        else
170        {
171          if (a) return pDivComp_INCOMP;
172          if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
173            return pDivComp_INCOMP;
174          b = TRUE;
175        }
176      }
177    }
178    if (a) return pDivComp_LESS;
179    if (b) return pDivComp_GREATER;
180    if (!a & !b) return pDivComp_EQUAL;
181  }
182  return pDivComp_INCOMP;
183}
184#endif
185
186static inline int pDivComp(poly p, poly q)
187{
188  if (pGetComp(p) == pGetComp(q))
189  {
190#ifdef HAVE_RATGRING
191    if (rIsRatGRing(currRing))
192    {
193      if (_p_LmDivisibleByPart(p,currRing,
194                           q,currRing,
195                           currRing->real_var_start, currRing->real_var_end))
196        return 0;
197      return pLmCmp(q,p); // ONLY FOR GLOBAL ORDER!
198    }
199#endif
200    BOOLEAN a=FALSE, b=FALSE;
201    int i;
202    unsigned long la, lb;
203    unsigned long divmask = currRing->divmask;
204    for (i=0; i<currRing->VarL_Size; i++)
205    {
206      la = p->exp[currRing->VarL_Offset[i]];
207      lb = q->exp[currRing->VarL_Offset[i]];
208      if (la != lb)
209      {
210        if (la < lb)
211        {
212          if (b) return 0;
213          if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
214            return 0;
215          a = TRUE;
216        }
217        else
218        {
219          if (a) return 0;
220          if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
221            return 0;
222          b = TRUE;
223        }
224      }
225    }
226    if (a) { /*assume(pLmCmp(q,p)==1);*/ return 1; }
227    if (b) { /*assume(pLmCmp(q,p)==-1);*/return -1; }
228    /*assume(pLmCmp(q,p)==0);*/
229  }
230  return 0;
231}
232
233
234int     HCord;
235int     Kstd1_deg;
236int     Kstd1_mu=32000;
237
238/*2
239*deletes higher monomial of p, re-compute ecart and length
240*works only for orderings with ecart =pFDeg(end)-pFDeg(start)
241*/
242void deleteHC(LObject *L, kStrategy strat, BOOLEAN fromNext)
243{
244  if (strat->kHEdgeFound)
245  {
246    assume(kTest_L(L));
247    poly p1;
248    poly p = L->GetLmTailRing();
249    int l = 1;
250    kBucket_pt bucket = NULL;
251    if (L->bucket != NULL)
252    {
253      kBucketClear(L->bucket, &pNext(p), &L->pLength);
254      L->pLength++;
255      bucket = L->bucket;
256      L->bucket = NULL;
257    }
258
259    if (!fromNext && p_Cmp(p,strat->kNoetherTail(), L->tailRing) == -1)
260    {
261      L->Delete();
262      L->Clear();
263      L->ecart = -1;
264      if (bucket != NULL) kBucketDestroy(&bucket);
265      return;
266    }
267    p1 = p;
268    while (pNext(p1)!=NULL)
269    {
270    if (p_LmCmp(pNext(p1), strat->kNoetherTail(), L->tailRing) == -1)
271      {
272        p_Delete(&pNext(p1), L->tailRing);
273        if (p1 == p)
274        {
275          if (L->t_p != NULL)
276          {
277            assume(L->p != NULL && p == L->t_p);
278            pNext(L->p) = NULL;
279          }
280          L->max  = NULL;
281        }
282        else if (fromNext)
283          L->max  = p_GetMaxExpP(pNext(L->p), L->tailRing ); // p1;
284        //if (L->pLength != 0)
285        L->pLength = l;
286        // Hmmm when called from updateT, then only
287        // reset ecart when cut
288        if (fromNext)
289          L->ecart = L->pLDeg() - L->GetpFDeg();
290        break;
291      }
292      l++;
293      pIter(p1);
294    }
295    if (! fromNext)
296    {
297      L->SetpFDeg();
298      L->ecart = L->pLDeg(strat->LDegLast) - L->GetpFDeg();
299    }
300    if (bucket != NULL)
301    {
302      if (L->pLength > 1)
303      {
304        kBucketInit(bucket, pNext(p), L->pLength - 1);
305        pNext(p) = NULL;
306        if (L->t_p != NULL) pNext(L->t_p) = NULL;
307        L->pLength = 0;
308        L->bucket = bucket;
309      }
310      else
311        kBucketDestroy(&bucket);
312    }
313    assume(kTest_L(L));
314  }
315}
316
317void deleteHC(poly* p, int* e, int* l,kStrategy strat)
318{
319  LObject L(*p, currRing, strat->tailRing);
320
321  deleteHC(&L, strat);
322  *p = L.p;
323  *e = L.ecart;
324  *l = L.length;
325  if (L.t_p != NULL) p_LmFree(L.t_p, strat->tailRing);
326}
327
328/*2
329*tests if p.p=monomial*unit and cancels the unit
330*/
331void cancelunit (LObject* L,BOOLEAN inNF)
332{
333  int  i;
334  poly h;
335  number lc;
336
337  if(rHasGlobalOrdering (currRing)) return;
338  if(TEST_OPT_CANCELUNIT) return;
339
340  ring r = L->tailRing;
341  poly p = L->GetLmTailRing();
342
343#ifdef HAVE_RINGS
344    if (rField_is_Ring(currRing) && (currRing->OrdSgn == -1))
345                  lc = p_GetCoeff(p,r);
346#endif
347
348#ifdef HAVE_RINGS_LOC
349  // Leading coef have to be a unit
350  if ( !(nIsUnit(p_GetCoeff(p, r))) ) return;
351#endif
352
353  if(p_GetComp(p, r) != 0 && !p_OneComp(p, r)) return;
354
355//    for(i=r->N;i>0;i--)
356//    {
357//      if ((p_GetExp(p,i,r)>0) && (rIsPolyVar(i, r)==TRUE)) return;
358//    }
359  h = pNext(p);
360
361  loop
362  {
363    if (h==NULL)
364    {
365      p_Delete(&pNext(p), r);
366      if (!inNF)
367      {
368             number eins;
369              #ifdef HAVE_RINGS
370              if (rField_is_Ring(currRing) && (currRing->OrdSgn == -1))
371                              eins = nCopy(lc);
372                    else
373                     #endif
374              eins=nInit(1);
375              if (L->p != NULL)  pSetCoeff(L->p,eins);
376        else if (L->t_p != NULL) nDelete(&pGetCoeff(L->t_p));
377        if (L->t_p != NULL) pSetCoeff0(L->t_p,eins);
378      }
379      L->ecart = 0;
380      L->length = 1;
381      //if (L->pLength > 0)
382      L->pLength = 1;
383      L->max = NULL;
384
385      if (L->t_p != NULL && pNext(L->t_p) != NULL)
386        pNext(L->t_p) = NULL;
387      if (L->p != NULL && pNext(L->p) != NULL)
388        pNext(L->p) = NULL;
389
390      return;
391    }
392    i = 0;
393    loop
394    {
395      i++;
396      if (p_GetExp(p,i,r) > p_GetExp(h,i,r)) return ; // does not divide
397      #ifdef HAVE_RINGS
398      ///should check also if the lc is a zero divisor, if it divides all the others
399      if (rField_is_Ring(currRing) && currRing->OrdSgn == -1)
400              if(n_DivBy(p_GetCoeff(h,r->cf),lc,r->cf) == 0)
401                      return;
402      #endif
403      if (i == r->N) break; // does divide, try next monom
404    }
405    pIter(h);
406  }
407}
408
409/*2
410*pp is the new element in s
411*returns TRUE (in strat->kHEdgeFound) if
412*-HEcke is allowed
413*-we are in the last componente of the vector
414*-on all axis are monomials (all elements in NotUsedAxis are FALSE)
415*returns FALSE for pLexOrderings,
416*assumes in module case an ordering of type c* !!
417* HEckeTest is only called with strat->kHEdgeFound==FALSE !
418*/
419void HEckeTest (poly pp,kStrategy strat)
420{
421  int   j,/*k,*/p;
422
423  strat->kHEdgeFound=FALSE;
424  if (currRing->pLexOrder || currRing->MixedOrder)
425  {
426    return;
427  }
428  if (strat->ak > 1)           /*we are in the module case*/
429  {
430    return; // until ....
431    //if (!pVectorOut)     /*pVectorOut <=> order = c,* */
432    //  return FALSE;
433    //if (pGetComp(pp) < strat->ak) /* ak is the number of the last component */
434    //  return FALSE;
435  }
436  // k = 0;
437  p=pIsPurePower(pp);
438  if (p!=0) strat->NotUsedAxis[p] = FALSE;
439  /*- the leading term of pp is a power of the p-th variable -*/
440  for (j=(currRing->N);j>0; j--)
441  {
442    if (strat->NotUsedAxis[j])
443    {
444      return;
445    }
446  }
447  strat->kHEdgeFound=TRUE;
448}
449
450/*2
451*utilities for TSet, LSet
452*/
453inline static intset initec (const int maxnr)
454{
455  return (intset)omAlloc(maxnr*sizeof(int));
456}
457
458inline static unsigned long* initsevS (const int maxnr)
459{
460  return (unsigned long*)omAlloc0(maxnr*sizeof(unsigned long));
461}
462inline static int* initS_2_R (const int maxnr)
463{
464  return (int*)omAlloc0(maxnr*sizeof(int));
465}
466
467static inline void enlargeT (TSet &T, TObject** &R, unsigned long* &sevT,
468                             int &length, const int incr)
469{
470  assume(T!=NULL);
471  assume(sevT!=NULL);
472  assume(R!=NULL);
473  assume((length+incr) > 0);
474
475  int i;
476  T = (TSet)omRealloc0Size(T, length*sizeof(TObject),
477                           (length+incr)*sizeof(TObject));
478
479  sevT = (unsigned long*) omReallocSize(sevT, length*sizeof(long*),
480                           (length+incr)*sizeof(long*));
481
482  R = (TObject**)omRealloc0Size(R,length*sizeof(TObject*),
483                                (length+incr)*sizeof(TObject*));
484  for (i=length-1;i>=0;i--) R[T[i].i_r] = &(T[i]);
485  length += incr;
486}
487
488void cleanT (kStrategy strat)
489{
490  int i,j;
491  poly  p;
492  assume(currRing == strat->tailRing || strat->tailRing != NULL);
493
494  pShallowCopyDeleteProc p_shallow_copy_delete =
495    (strat->tailRing != currRing ?
496     pGetShallowCopyDeleteProc(strat->tailRing, currRing) :
497     NULL);
498
499  for (j=0; j<=strat->tl; j++)
500  {
501    p = strat->T[j].p;
502    strat->T[j].p=NULL;
503    if (strat->T[j].max != NULL)
504    {
505      p_LmFree(strat->T[j].max, strat->tailRing);
506    }
507    i = -1;
508    loop
509    {
510      i++;
511      if (i>strat->sl)
512      {
513        if (strat->T[j].t_p != NULL)
514        {
515          p_Delete(&(strat->T[j].t_p), strat->tailRing);
516          p_LmFree(p, currRing);
517        }
518        else
519          pDelete(&p);
520        break;
521      }
522      if (p == strat->S[i])
523      {
524        if (strat->T[j].t_p != NULL)
525        {
526          assume(p_shallow_copy_delete != NULL);
527          pNext(p) = p_shallow_copy_delete(pNext(p),strat->tailRing,currRing,
528                                           currRing->PolyBin);
529          p_LmFree(strat->T[j].t_p, strat->tailRing);
530        }
531        break;
532      }
533    }
534  }
535  strat->tl=-1;
536}
537
538//LSet initL ()
539//{
540//  int i;
541//  LSet l = (LSet)omAlloc(setmaxL*sizeof(LObject));
542//  return l;
543//}
544
545static inline void enlargeL (LSet* L,int* length,const int incr)
546{
547  assume((*L)!=NULL);
548  assume((length+incr)>0);
549
550  *L = (LSet)omReallocSize((*L),(*length)*sizeof(LObject),
551                                   ((*length)+incr)*sizeof(LObject));
552  (*length) += incr;
553}
554
555void initPairtest(kStrategy strat)
556{
557  strat->pairtest = (BOOLEAN *)omAlloc0((strat->sl+2)*sizeof(BOOLEAN));
558}
559
560/*2
561*test whether (p1,p2) or (p2,p1) is in L up position length
562*it returns TRUE if yes and the position k
563*/
564BOOLEAN isInPairsetL(int length,poly p1,poly p2,int*  k,kStrategy strat)
565{
566  LObject *p=&(strat->L[length]);
567
568  *k = length;
569  loop
570  {
571    if ((*k) < 0) return FALSE;
572    if (((p1 == (*p).p1) && (p2 == (*p).p2))
573    ||  ((p1 == (*p).p2) && (p2 == (*p).p1)))
574      return TRUE;
575    (*k)--;
576    p--;
577  }
578}
579
580/*2
581*in B all pairs have the same element p on the right
582*it tests whether (q,p) is in B and returns TRUE if yes
583*and the position k
584*/
585BOOLEAN isInPairsetB(poly q,int*  k,kStrategy strat)
586{
587  LObject *p=&(strat->B[strat->Bl]);
588
589  *k = strat->Bl;
590  loop
591  {
592    if ((*k) < 0) return FALSE;
593    if (q == (*p).p1)
594      return TRUE;
595    (*k)--;
596    p--;
597  }
598}
599
600int kFindInT(poly p, TSet T, int tlength)
601{
602  int i;
603
604  for (i=0; i<=tlength; i++)
605  {
606    if (T[i].p == p) return i;
607  }
608  return -1;
609}
610
611int kFindInT(poly p, kStrategy strat)
612{
613  int i;
614  do
615  {
616    i = kFindInT(p, strat->T, strat->tl);
617    if (i >= 0) return i;
618    strat = strat->next;
619  }
620  while (strat != NULL);
621  return -1;
622}
623
624#ifdef KDEBUG
625
626void sTObject::wrp()
627{
628  if (t_p != NULL) p_wrp(t_p, tailRing);
629  else if (p != NULL) p_wrp(p, currRing, tailRing);
630  else ::wrp(NULL);
631}
632
633#define kFalseReturn(x) do { if (!x) return FALSE;} while (0)
634
635// check that Lm's of a poly from T are "equal"
636static const char* kTest_LmEqual(poly p, poly t_p, ring tailRing)
637{
638  int i;
639  for (i=1; i<=tailRing->N; i++)
640  {
641    if (p_GetExp(p, i, currRing) != p_GetExp(t_p, i, tailRing))
642      return "Lm[i] different";
643  }
644  if (p_GetComp(p, currRing) != p_GetComp(t_p, tailRing))
645    return "Lm[0] different";
646  if (pNext(p) != pNext(t_p))
647    return "Lm.next different";
648  if (pGetCoeff(p) != pGetCoeff(t_p))
649    return "Lm.coeff different";
650  return NULL;
651}
652
653static BOOLEAN sloppy_max = FALSE;
654BOOLEAN kTest_T(TObject * T, ring strat_tailRing, int i, char TN)
655{
656  ring tailRing = T->tailRing;
657  if (strat_tailRing == NULL) strat_tailRing = tailRing;
658  r_assume(strat_tailRing == tailRing);
659
660  poly p = T->p;
661  // ring r = currRing;
662
663  if (T->p == NULL && T->t_p == NULL && i >= 0)
664    return dReportError("%c[%d].poly is NULL", TN, i);
665
666  if (T->tailRing != currRing)
667  {
668    if (T->t_p == NULL && i > 0)
669      return dReportError("%c[%d].t_p is NULL", TN, i);
670    pFalseReturn(p_Test(T->t_p, T->tailRing));
671    if (T->p != NULL) pFalseReturn(p_LmTest(T->p, currRing));
672    if (T->p != NULL && T->t_p != NULL)
673    {
674      const char* msg = kTest_LmEqual(T->p, T->t_p, T->tailRing);
675      if (msg != NULL)
676        return dReportError("%c[%d] %s", TN, i, msg);
677      // r = T->tailRing;
678      p = T->t_p;
679    }
680    if (T->p == NULL)
681    {
682      p = T->t_p;
683      // r = T->tailRing;
684    }
685    if (T->t_p != NULL && i >= 0 && TN == 'T')
686    {
687      if (pNext(T->t_p) == NULL)
688      {
689        if (T->max != NULL)
690          return dReportError("%c[%d].max is not NULL as it should be", TN, i);
691      }
692      else
693      {
694        if (T->max == NULL)
695          return dReportError("%c[%d].max is NULL", TN, i);
696        if (pNext(T->max) != NULL)
697          return dReportError("pNext(%c[%d].max) != NULL", TN, i);
698
699        pFalseReturn(p_CheckPolyRing(T->max, tailRing));
700        omCheckBinAddrSize(T->max, (omSizeWOfBin(tailRing->PolyBin))*SIZEOF_LONG);
701#if KDEBUG > 0
702        if (! sloppy_max)
703        {
704          poly test_max = p_GetMaxExpP(pNext(T->t_p), tailRing);
705          p_Setm(T->max, tailRing);
706          p_Setm(test_max, tailRing);
707          BOOLEAN equal = p_ExpVectorEqual(T->max, test_max, tailRing);
708          if (! equal)
709            return dReportError("%c[%d].max out of sync", TN, i);
710          p_LmFree(test_max, tailRing);
711        }
712#endif
713      }
714    }
715  }
716  else
717  {
718    if (T->max != NULL)
719      return dReportError("%c[%d].max != NULL but tailRing == currRing",TN,i);
720    if (T->t_p != NULL)
721      return dReportError("%c[%d].t_p != NULL but tailRing == currRing",TN,i);
722    if (T->p == NULL && i > 0)
723      return dReportError("%c[%d].p is NULL", TN, i);
724    pFalseReturn(p_Test(T->p, currRing));
725  }
726
727  if (i >= 0 && T->pLength != 0
728  && ! rIsSyzIndexRing(currRing) && T->pLength != pLength(p))
729  {
730    int l=T->pLength;
731    T->pLength=pLength(p);
732    return dReportError("%c[%d] pLength error: has %d, specified to have %d",
733                        TN, i , pLength(p), l);
734  }
735
736  // check FDeg,  for elements in L and T
737  if (i >= 0 && (TN == 'T' || TN == 'L'))
738  {
739    // FDeg has ir element from T of L set
740    if (T->FDeg  != T->pFDeg())
741    {
742      int d=T->FDeg;
743      T->FDeg=T->pFDeg();
744      return dReportError("%c[%d] FDeg error: has %d, specified to have %d",
745                          TN, i , T->pFDeg(), d);
746    }
747  }
748
749  // check is_normalized for elements in T
750  if (i >= 0 && TN == 'T')
751  {
752    if (T->is_normalized && ! nIsOne(pGetCoeff(p)))
753      return dReportError("T[%d] is_normalized error", i);
754
755  }
756  return TRUE;
757}
758
759BOOLEAN kTest_L(LObject *L, ring strat_tailRing,
760                BOOLEAN testp, int lpos, TSet T, int tlength)
761{
762  if (testp)
763  {
764    poly pn = NULL;
765    if (L->bucket != NULL)
766    {
767      kFalseReturn(kbTest(L->bucket));
768      r_assume(L->bucket->bucket_ring == L->tailRing);
769      if (L->p != NULL && pNext(L->p) != NULL)
770      {
771        pn = pNext(L->p);
772        pNext(L->p) = NULL;
773      }
774    }
775    kFalseReturn(kTest_T(L, strat_tailRing, lpos, 'L'));
776    if (pn != NULL)
777      pNext(L->p) = pn;
778
779    ring r;
780    poly p;
781    L->GetLm(p, r);
782    if (L->sev != 0 && p_GetShortExpVector(p, r) != L->sev)
783    {
784      return dReportError("L[%d] wrong sev: has %o, specified to have %o",
785                          lpos, p_GetShortExpVector(p, r), L->sev);
786    }
787  }
788  if (L->p1 == NULL)
789  {
790    // L->p2 either NULL or "normal" poly
791    pFalseReturn(pp_Test(L->p2, currRing, L->tailRing));
792  }
793  else if (tlength > 0 && T != NULL && (lpos >=0))
794  {
795    // now p1 and p2 must be != NULL and must be contained in T
796    int i;
797    i = kFindInT(L->p1, T, tlength);
798    if (i < 0)
799      return dReportError("L[%d].p1 not in T",lpos);
800    i = kFindInT(L->p2, T, tlength);
801    if (i < 0)
802      return dReportError("L[%d].p2 not in T",lpos);
803  }
804  return TRUE;
805}
806
807BOOLEAN kTest (kStrategy strat)
808{
809  int i;
810
811  // test P
812  kFalseReturn(kTest_L(&(strat->P), strat->tailRing,
813                       (strat->P.p != NULL && pNext(strat->P.p)!=strat->tail),
814                       -1, strat->T, strat->tl));
815
816  // test T
817  if (strat->T != NULL)
818  {
819    for (i=0; i<=strat->tl; i++)
820    {
821      kFalseReturn(kTest_T(&(strat->T[i]), strat->tailRing, i, 'T'));
822      if (strat->sevT[i] != pGetShortExpVector(strat->T[i].p))
823        return dReportError("strat->sevT[%d] out of sync", i);
824    }
825  }
826
827  // test L
828  if (strat->L != NULL)
829  {
830    for (i=0; i<=strat->Ll; i++)
831    {
832      kFalseReturn(kTest_L(&(strat->L[i]), strat->tailRing,
833                           strat->L[i].Next() != strat->tail, i,
834                           strat->T, strat->tl));
835      // may be unused
836      //if (strat->use_buckets && strat->L[i].Next() != strat->tail &&
837      //    strat->L[i].Next() != NULL && strat->L[i].p1 != NULL)
838      //{
839      //  assume(strat->L[i].bucket != NULL);
840      //}
841    }
842  }
843
844  // test S
845  if (strat->S != NULL)
846    kFalseReturn(kTest_S(strat));
847
848  return TRUE;
849}
850
851BOOLEAN kTest_S(kStrategy strat)
852{
853  int i;
854  BOOLEAN ret = TRUE;
855  for (i=0; i<=strat->sl; i++)
856  {
857    if (strat->S[i] != NULL &&
858        strat->sevS[i] != pGetShortExpVector(strat->S[i]))
859    {
860      return dReportError("S[%d] wrong sev: has %o, specified to have %o",
861                          i , pGetShortExpVector(strat->S[i]), strat->sevS[i]);
862    }
863  }
864  return ret;
865}
866
867
868
869BOOLEAN kTest_TS(kStrategy strat)
870{
871  int i, j;
872  // BOOLEAN ret = TRUE;
873  kFalseReturn(kTest(strat));
874
875  // test strat->R, strat->T[i].i_r
876  for (i=0; i<=strat->tl; i++)
877  {
878    if (strat->T[i].i_r < 0 || strat->T[i].i_r > strat->tl)
879      return dReportError("strat->T[%d].i_r == %d out of bounds", i,
880                          strat->T[i].i_r);
881    if (strat->R[strat->T[i].i_r] != &(strat->T[i]))
882      return dReportError("T[%d].i_r with R out of sync", i);
883  }
884  // test containment of S inT
885  if (strat->S != NULL)
886  {
887    for (i=0; i<=strat->sl; i++)
888    {
889      j = kFindInT(strat->S[i], strat->T, strat->tl);
890      if (j < 0)
891        return dReportError("S[%d] not in T", i);
892      if (strat->S_2_R[i] != strat->T[j].i_r)
893        return dReportError("S_2_R[%d]=%d != T[%d].i_r=%d\n",
894                            i, strat->S_2_R[i], j, strat->T[j].i_r);
895    }
896  }
897  // test strat->L[i].i_r1
898  for (i=0; i<=strat->Ll; i++)
899  {
900    if (strat->L[i].p1 != NULL && strat->L[i].p2)
901    {
902      if (strat->L[i].i_r1 < 0 ||
903          strat->L[i].i_r1 > strat->tl ||
904          strat->L[i].T_1(strat)->p != strat->L[i].p1)
905        return dReportError("L[%d].i_r1 out of sync", i);
906      if (strat->L[i].i_r2 < 0 ||
907          strat->L[i].i_r2 > strat->tl ||
908          strat->L[i].T_2(strat)->p != strat->L[i].p2);
909    }
910    else
911    {
912      if (strat->L[i].i_r1 != -1)
913        return dReportError("L[%d].i_r1 out of sync", i);
914      if (strat->L[i].i_r2 != -1)
915        return dReportError("L[%d].i_r2 out of sync", i);
916    }
917    if (strat->L[i].i_r != -1)
918      return dReportError("L[%d].i_r out of sync", i);
919  }
920  return TRUE;
921}
922
923#endif // KDEBUG
924
925/*2
926*cancels the i-th polynomial in the standardbase s
927*/
928void deleteInS (int i,kStrategy strat)
929{
930#ifdef ENTER_USE_MEMMOVE
931  memmove(&(strat->S[i]), &(strat->S[i+1]), (strat->sl - i)*sizeof(poly));
932  memmove(&(strat->ecartS[i]),&(strat->ecartS[i+1]),(strat->sl - i)*sizeof(int));
933  memmove(&(strat->sevS[i]),&(strat->sevS[i+1]),(strat->sl - i)*sizeof(unsigned long));
934  memmove(&(strat->S_2_R[i]),&(strat->S_2_R[i+1]),(strat->sl - i)*sizeof(int));
935#else
936  int j;
937  for (j=i; j<strat->sl; j++)
938  {
939    strat->S[j] = strat->S[j+1];
940    strat->ecartS[j] = strat->ecartS[j+1];
941    strat->sevS[j] = strat->sevS[j+1];
942    strat->S_2_R[j] = strat->S_2_R[j+1];
943  }
944#endif
945  if (strat->lenS!=NULL)
946  {
947#ifdef ENTER_USE_MEMMOVE
948    memmove(&(strat->lenS[i]),&(strat->lenS[i+1]),(strat->sl - i)*sizeof(int));
949#else
950    for (j=i; j<strat->sl; j++) strat->lenS[j] = strat->lenS[j+1];
951#endif
952  }
953  if (strat->lenSw!=NULL)
954  {
955#ifdef ENTER_USE_MEMMOVE
956    memmove(&(strat->lenSw[i]),&(strat->lenSw[i+1]),(strat->sl - i)*sizeof(wlen_type));
957#else
958    for (j=i; j<strat->sl; j++) strat->lenSw[j] = strat->lenSw[j+1];
959#endif
960  }
961  if (strat->fromQ!=NULL)
962  {
963#ifdef ENTER_USE_MEMMOVE
964    memmove(&(strat->fromQ[i]),&(strat->fromQ[i+1]),(strat->sl - i)*sizeof(int));
965#else
966    for (j=i; j<strat->sl; j++)
967    {
968      strat->fromQ[j] = strat->fromQ[j+1];
969    }
970#endif
971  }
972  strat->S[strat->sl] = NULL;
973  strat->sl--;
974}
975
976
977/*2
978*cancels the i-th polynomial in the standardbase s
979*/
980void deleteInSSba (int i,kStrategy strat)
981{
982#ifdef ENTER_USE_MEMMOVE
983  memmove(&(strat->S[i]), &(strat->S[i+1]), (strat->sl - i)*sizeof(poly));
984  memmove(&(strat->sig[i]), &(strat->sig[i+1]), (strat->sl - i)*sizeof(poly));
985  memmove(&(strat->ecartS[i]),&(strat->ecartS[i+1]),(strat->sl - i)*sizeof(int));
986  memmove(&(strat->sevS[i]),&(strat->sevS[i+1]),(strat->sl - i)*sizeof(unsigned long));
987  memmove(&(strat->sevSig[i]),&(strat->sevSig[i+1]),(strat->sl - i)*sizeof(unsigned long));
988  memmove(&(strat->S_2_R[i]),&(strat->S_2_R[i+1]),(strat->sl - i)*sizeof(int));
989#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  strat->newt = TRUE;
7184  if (atT < 0)
7185    atT = strat->posInT(strat->T, strat->tl, p);
7186  if (strat->tl == strat->tmax-1)
7187    enlargeT(strat->T,strat->R,strat->sevT,strat->tmax,setmaxTinc);
7188  if (atT <= strat->tl)
7189  {
7190#ifdef ENTER_USE_MEMMOVE
7191    memmove(&(strat->T[atT+1]), &(strat->T[atT]),
7192            (strat->tl-atT+1)*sizeof(TObject));
7193    memmove(&(strat->sevT[atT+1]), &(strat->sevT[atT]),
7194            (strat->tl-atT+1)*sizeof(unsigned long));
7195#endif
7196    for (i=strat->tl+1; i>=atT+1; i--)
7197    {
7198#ifndef ENTER_USE_MEMMOVE
7199      strat->T[i] = strat->T[i-1];
7200      strat->sevT[i] = strat->sevT[i-1];
7201#endif
7202      strat->R[strat->T[i].i_r] = &(strat->T[i]);
7203    }
7204  }
7205
7206  if ((strat->tailBin != NULL) && (pNext(p.p) != NULL))
7207  {
7208    pNext(p.p)=p_ShallowCopyDelete(pNext(p.p),
7209                                   (strat->tailRing != NULL ?
7210                                    strat->tailRing : currRing),
7211                                   strat->tailBin);
7212    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
7213  }
7214  strat->T[atT] = (TObject) p;
7215
7216  if (strat->tailRing != currRing && pNext(p.p) != NULL)
7217    strat->T[atT].max = p_GetMaxExpP(pNext(p.p), strat->tailRing);
7218  else
7219    strat->T[atT].max = NULL;
7220
7221  strat->tl++;
7222  strat->R[strat->tl] = &(strat->T[atT]);
7223  strat->T[atT].i_r = strat->tl;
7224  assume(p.sev == 0 || pGetShortExpVector(p.p) == p.sev);
7225  strat->sevT[atT] = (p.sev == 0 ? pGetShortExpVector(p.p) : p.sev);
7226  assume(kTest_T(&(strat->T[atT])));
7227}
7228
7229
7230/*2
7231* puts signature p.sig to the set syz
7232*/
7233void enterSyz(LObject p, kStrategy strat, int atT)
7234{
7235  int i;
7236  strat->newt = TRUE;
7237  if (strat->syzl == strat->syzmax-1)
7238  {
7239    pEnlargeSet(&strat->syz,strat->syzmax,setmaxTinc);
7240    strat->sevSyz = (unsigned long*) omRealloc0Size(strat->sevSyz,
7241                                    (strat->syzmax)*sizeof(unsigned long),
7242                                    ((strat->syzmax)+setmaxTinc)
7243                                                  *sizeof(unsigned long));
7244    strat->syzmax += setmaxTinc;
7245  }
7246  if (atT < strat->syzl)
7247  {
7248#ifdef ENTER_USE_MEMMOVE
7249    memmove(&(strat->syz[atT+1]), &(strat->syz[atT]),
7250            (strat->syzl-atT+1)*sizeof(poly));
7251    memmove(&(strat->sevSyz[atT+1]), &(strat->sevSyz[atT]),
7252            (strat->syzl-atT+1)*sizeof(unsigned long));
7253#endif
7254    for (i=strat->syzl; i>=atT+1; i--)
7255    {
7256#ifndef ENTER_USE_MEMMOVE
7257      strat->syz[i] = strat->syz[i-1];
7258      strat->sevSyz[i] = strat->sevSyz[i-1];
7259#endif
7260    }
7261  }
7262  //i = strat->syzl;
7263  i = atT;
7264  strat->syz[atT] = p.sig;
7265  strat->sevSyz[atT] = p.sevSig;
7266  strat->syzl++;
7267#if F5DEBUG
7268  Print("element in strat->syz: %d--%d  ",atT+1,strat->syzmax);
7269  pWrite(strat->syz[atT]);
7270#endif
7271  // recheck pairs in strat->L with new rule and delete correspondingly
7272  int cc = strat->Ll;
7273  while (cc>-1)
7274  {
7275    if (p_LmShortDivisibleBy( strat->syz[atT], strat->sevSyz[atT],
7276                              strat->L[cc].sig, ~strat->L[cc].sevSig, currRing))
7277    {
7278      deleteInL(strat->L,&strat->Ll,cc,strat);
7279    }
7280    cc--;
7281  }
7282//#if 1
7283#ifdef DEBUGF5
7284    Print("--- Syzygies ---\n");
7285    printf("syzl   %d\n",strat->syzl);
7286    printf("syzmax %d\n",strat->syzmax);
7287    Print("--------------------------------\n");
7288    for(i=0;i<=strat->syzl-1;i++)
7289    {
7290      printf("%d - ",i);
7291      pWrite(strat->syz[i]);
7292    }
7293    Print("--------------------------------\n");
7294#endif
7295}
7296
7297
7298void initHilbCrit(ideal/*F*/, ideal /*Q*/, intvec **hilb,kStrategy strat)
7299{
7300
7301  //if the ordering is local, then hilb criterion
7302  //can be used also if tzhe ideal is not homogenous
7303  if((currRing->OrdSgn == -1) && (currRing->MixedOrder == 0 ))
7304  #ifdef HAVE_RINGS
7305  {
7306  if(rField_is_Ring(currRing))
7307          *hilb=NULL;
7308  else
7309           return;
7310  }
7311#endif
7312  if (strat->homog!=isHomog)
7313  {
7314    *hilb=NULL;
7315  }
7316}
7317
7318void initBuchMoraCrit(kStrategy strat)
7319{
7320  strat->enterOnePair=enterOnePairNormal;
7321  strat->chainCrit=chainCritNormal;
7322#ifdef HAVE_RINGS
7323  if (rField_is_Ring(currRing))
7324  {
7325    strat->enterOnePair=enterOnePairRing;
7326    strat->chainCrit=chainCritRing;
7327  }
7328#endif
7329#ifdef HAVE_RATGRING
7330  if (rIsRatGRing(currRing))
7331  {
7332     strat->chainCrit=chainCritPart;
7333     /* enterOnePairNormal get rational part in it */
7334  }
7335#endif
7336
7337  strat->sugarCrit =        TEST_OPT_SUGARCRIT;
7338  strat->Gebauer =          strat->homog || strat->sugarCrit;
7339  strat->honey =            !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
7340  if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
7341  strat->pairtest = NULL;
7342  /* alway use tailreduction, except:
7343  * - in local rings, - in lex order case, -in ring over extensions */
7344  strat->noTailReduction = !TEST_OPT_REDTAIL;
7345
7346#ifdef HAVE_PLURAL
7347  // and r is plural_ring
7348  //  hence this holds for r a rational_plural_ring
7349  if( rIsPluralRing(currRing) || (rIsSCA(currRing) && !strat->z2homog) )
7350  {    //or it has non-quasi-comm type... later
7351    strat->sugarCrit = FALSE;
7352    strat->Gebauer = FALSE;
7353    strat->honey = FALSE;
7354  }
7355#endif
7356
7357#ifdef HAVE_RINGS
7358  // Coefficient ring?
7359  if (rField_is_Ring(currRing))
7360  {
7361    strat->sugarCrit = FALSE;
7362    strat->Gebauer = FALSE ;
7363    strat->honey = FALSE;
7364  }
7365#endif
7366  #ifdef KDEBUG
7367  if (TEST_OPT_DEBUG)
7368  {
7369    if (strat->homog) PrintS("ideal/module is homogeneous\n");
7370    else              PrintS("ideal/module is not homogeneous\n");
7371  }
7372  #endif
7373}
7374
7375void initSbaCrit(kStrategy strat)
7376{
7377  //strat->enterOnePair=enterOnePairNormal;
7378  strat->enterOnePair = enterOnePairNormal;
7379  //strat->chainCrit=chainCritNormal;
7380  strat->chainCrit    = chainCritSig;
7381  /******************************************
7382   * rewCrit1 and rewCrit2 are already set in
7383   * kSba() in kstd1.cc
7384   *****************************************/
7385  //strat->rewCrit1     = faugereRewCriterion;
7386  if (strat->sbaOrder == 1)
7387  {
7388    strat->syzCrit  = syzCriterionInc;
7389  }
7390  else
7391  {
7392    strat->syzCrit  = syzCriterion;
7393  }
7394#ifdef HAVE_RINGS
7395  if (rField_is_Ring(currRing))
7396  {
7397    strat->enterOnePair=enterOnePairRing;
7398    strat->chainCrit=chainCritRing;
7399  }
7400#endif
7401#ifdef HAVE_RATGRING
7402  if (rIsRatGRing(currRing))
7403  {
7404     strat->chainCrit=chainCritPart;
7405     /* enterOnePairNormal get rational part in it */
7406  }
7407#endif
7408
7409  strat->sugarCrit =        TEST_OPT_SUGARCRIT;
7410  strat->Gebauer =          strat->homog || strat->sugarCrit;
7411  strat->honey =            !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
7412  if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
7413  strat->pairtest = NULL;
7414  /* alway use tailreduction, except:
7415  * - in local rings, - in lex order case, -in ring over extensions */
7416  strat->noTailReduction = !TEST_OPT_REDTAIL;
7417  //strat->noTailReduction = NULL;
7418
7419#ifdef HAVE_PLURAL
7420  // and r is plural_ring
7421  //  hence this holds for r a rational_plural_ring
7422  if( rIsPluralRing(currRing) || (rIsSCA(currRing) && !strat->z2homog) )
7423  {    //or it has non-quasi-comm type... later
7424    strat->sugarCrit = FALSE;
7425    strat->Gebauer = FALSE;
7426    strat->honey = FALSE;
7427  }
7428#endif
7429
7430#ifdef HAVE_RINGS
7431  // Coefficient ring?
7432  if (rField_is_Ring(currRing))
7433  {
7434    strat->sugarCrit = FALSE;
7435    strat->Gebauer = FALSE ;
7436    strat->honey = FALSE;
7437  }
7438#endif
7439  #ifdef KDEBUG
7440  if (TEST_OPT_DEBUG)
7441  {
7442    if (strat->homog) PrintS("ideal/module is homogeneous\n");
7443    else              PrintS("ideal/module is not homogeneous\n");
7444  }
7445  #endif
7446}
7447
7448BOOLEAN kPosInLDependsOnLength(int (*pos_in_l)
7449                               (const LSet set, const int length,
7450                                LObject* L,const kStrategy strat))
7451{
7452  if (pos_in_l == posInL110 ||
7453      pos_in_l == posInL10)
7454    return TRUE;
7455
7456  return FALSE;
7457}
7458
7459void initBuchMoraPos (kStrategy strat)
7460{
7461  if (currRing->OrdSgn==1)
7462  {
7463    if (strat->honey)
7464    {
7465      strat->posInL = posInL15;
7466      // ok -- here is the deal: from my experiments for Singular-2-0
7467      // I conclude that that posInT_EcartpLength is the best of
7468      // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
7469      // see the table at the end of this file
7470      if (TEST_OPT_OLDSTD)
7471        strat->posInT = posInT15;
7472      else
7473        strat->posInT = posInT_EcartpLength;
7474    }
7475    else if (currRing->pLexOrder && !TEST_OPT_INTSTRATEGY)
7476    {
7477      strat->posInL = posInL11;
7478      strat->posInT = posInT11;
7479    }
7480    else if (TEST_OPT_INTSTRATEGY)
7481    {
7482      strat->posInL = posInL11;
7483      strat->posInT = posInT11;
7484    }
7485    else
7486    {
7487      strat->posInL = posInL0;
7488      strat->posInT = posInT0;
7489    }
7490    //if (strat->minim>0) strat->posInL =posInLSpecial;
7491    if (strat->homog)
7492    {
7493       strat->posInL = posInL110;
7494       strat->posInT = posInT110;
7495    }
7496  }
7497  else
7498  {
7499    if (strat->homog)
7500    {
7501      strat->posInL = posInL11;
7502      strat->posInT = posInT11;
7503    }
7504    else
7505    {
7506      if ((currRing->order[0]==ringorder_c)
7507      ||(currRing->order[0]==ringorder_C))
7508      {
7509        strat->posInL = posInL17_c;
7510        strat->posInT = posInT17_c;
7511      }
7512      else
7513      {
7514        strat->posInL = posInL17;
7515        strat->posInT = posInT17;
7516      }
7517    }
7518  }
7519  if (strat->minim>0) strat->posInL =posInLSpecial;
7520  // for further tests only
7521  if ((BTEST1(11)) || (BTEST1(12)))
7522    strat->posInL = posInL11;
7523  else if ((BTEST1(13)) || (BTEST1(14)))
7524    strat->posInL = posInL13;
7525  else if ((BTEST1(15)) || (BTEST1(16)))
7526    strat->posInL = posInL15;
7527  else if ((BTEST1(17)) || (BTEST1(18)))
7528    strat->posInL = posInL17;
7529  if (BTEST1(11))
7530    strat->posInT = posInT11;
7531  else if (BTEST1(13))
7532    strat->posInT = posInT13;
7533  else if (BTEST1(15))
7534    strat->posInT = posInT15;
7535  else if ((BTEST1(17)))
7536    strat->posInT = posInT17;
7537  else if ((BTEST1(19)))
7538    strat->posInT = posInT19;
7539  else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
7540    strat->posInT = posInT1;
7541#ifdef HAVE_RINGS
7542  if (rField_is_Ring(currRing))
7543  {
7544    strat->posInL = posInL11;
7545    strat->posInT = posInT11;
7546  }
7547#endif
7548  strat->posInLDependsOnLength = kPosInLDependsOnLength(strat->posInL);
7549}
7550
7551void initBuchMora (ideal F,ideal Q,kStrategy strat)
7552{
7553  strat->interpt = BTEST1(OPT_INTERRUPT);
7554  strat->kHEdge=NULL;
7555  if (currRing->OrdSgn==1) strat->kHEdgeFound=FALSE;
7556  /*- creating temp data structures------------------- -*/
7557  strat->cp = 0;
7558  strat->c3 = 0;
7559  strat->tail = pInit();
7560  /*- set s -*/
7561  strat->sl = -1;
7562  /*- set L -*/
7563  strat->Lmax = ((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
7564  strat->Ll = -1;
7565  strat->L = initL(((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc);
7566  /*- set B -*/
7567  strat->Bmax = setmaxL;
7568  strat->Bl = -1;
7569  strat->B = initL();
7570  /*- set T -*/
7571  strat->tl = -1;
7572  strat->tmax = setmaxT;
7573  strat->T = initT();
7574  strat->R = initR();
7575  strat->sevT = initsevT();
7576  /*- init local data struct.---------------------------------------- -*/
7577  strat->P.ecart=0;
7578  strat->P.length=0;
7579  if (currRing->OrdSgn==-1)
7580  {
7581    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
7582    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
7583  }
7584  if(TEST_OPT_SB_1)
7585  {
7586    int i;
7587    ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
7588    for (i=strat->newIdeal;i<IDELEMS(F);i++)
7589    {
7590      P->m[i-strat->newIdeal] = F->m[i];
7591      F->m[i] = NULL;
7592    }
7593    initSSpecial(F,Q,P,strat);
7594    for (i=strat->newIdeal;i<IDELEMS(F);i++)
7595    {
7596      F->m[i] = P->m[i-strat->newIdeal];
7597      P->m[i-strat->newIdeal] = NULL;
7598    }
7599    idDelete(&P);
7600  }
7601  else
7602  {
7603    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
7604    // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
7605  }
7606  strat->fromT = FALSE;
7607  strat->noTailReduction = !TEST_OPT_REDTAIL;
7608  if (!TEST_OPT_SB_1)
7609  {
7610    updateS(TRUE,strat);
7611  }
7612  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
7613  strat->fromQ=NULL;
7614}
7615
7616void exitBuchMora (kStrategy strat)
7617{
7618  /*- release temp data -*/
7619  cleanT(strat);
7620  omFreeSize(strat->T,(strat->tmax)*sizeof(TObject));
7621  omFreeSize(strat->R,(strat->tmax)*sizeof(TObject*));
7622  omFreeSize(strat->sevT, (strat->tmax)*sizeof(unsigned long));
7623  omFreeSize(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
7624  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
7625  omFreeSize(strat->S_2_R,IDELEMS(strat->Shdl)*sizeof(int));
7626  /*- set L: should be empty -*/
7627  omFreeSize(strat->L,(strat->Lmax)*sizeof(LObject));
7628  /*- set B: should be empty -*/
7629  omFreeSize(strat->B,(strat->Bmax)*sizeof(LObject));
7630  pLmDelete(&strat->tail);
7631  strat->syzComp=0;
7632}
7633
7634void initSbaPos (kStrategy strat)
7635{
7636  if (currRing->OrdSgn==1)
7637  {
7638    if (strat->honey)
7639    {
7640      strat->posInL = posInL15;
7641      // ok -- here is the deal: from my experiments for Singular-2-0
7642      // I conclude that that posInT_EcartpLength is the best of
7643      // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
7644      // see the table at the end of this file
7645      if (TEST_OPT_OLDSTD)
7646        strat->posInT = posInT15;
7647      else
7648        strat->posInT = posInT_EcartpLength;
7649    }
7650    else if (currRing->pLexOrder && !TEST_OPT_INTSTRATEGY)
7651    {
7652      strat->posInL = posInL11;
7653      strat->posInT = posInT11;
7654    }
7655    else if (TEST_OPT_INTSTRATEGY)
7656    {
7657      strat->posInL = posInL11;
7658      strat->posInT = posInT11;
7659    }
7660    else
7661    {
7662      strat->posInL = posInL0;
7663      strat->posInT = posInT0;
7664    }
7665    //if (strat->minim>0) strat->posInL =posInLSpecial;
7666    if (strat->homog)
7667    {
7668       strat->posInL = posInL110;
7669       strat->posInT = posInT110;
7670    }
7671  }
7672  else
7673  {
7674    if (strat->homog)
7675    {
7676      strat->posInL = posInL11;
7677      strat->posInT = posInT11;
7678    }
7679    else
7680    {
7681      if ((currRing->order[0]==ringorder_c)
7682      ||(currRing->order[0]==ringorder_C))
7683      {
7684        strat->posInL = posInL17_c;
7685        strat->posInT = posInT17_c;
7686      }
7687      else
7688      {
7689        strat->posInL = posInL17;
7690        strat->posInT = posInT17;
7691      }
7692    }
7693  }
7694  if (strat->minim>0) strat->posInL =posInLSpecial;
7695  // for further tests only
7696  if ((BTEST1(11)) || (BTEST1(12)))
7697    strat->posInL = posInL11;
7698  else if ((BTEST1(13)) || (BTEST1(14)))
7699    strat->posInL = posInL13;
7700  else if ((BTEST1(15)) || (BTEST1(16)))
7701    strat->posInL = posInL15;
7702  else if ((BTEST1(17)) || (BTEST1(18)))
7703    strat->posInL = posInL17;
7704  if (BTEST1(11))
7705    strat->posInT = posInT11;
7706  else if (BTEST1(13))
7707    strat->posInT = posInT13;
7708  else if (BTEST1(15))
7709    strat->posInT = posInT15;
7710  else if ((BTEST1(17)))
7711    strat->posInT = posInT17;
7712  else if ((BTEST1(19)))
7713    strat->posInT = posInT19;
7714  else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
7715    strat->posInT = posInT1;
7716#ifdef HAVE_RINGS
7717  if (rField_is_Ring(currRing))
7718  {
7719    strat->posInL = posInL11;
7720    strat->posInT = posInT11;
7721  }
7722#endif
7723  strat->posInLDependsOnLength = FALSE;
7724  strat->posInLSba  = posInLSig;
7725  //strat->posInL     = posInLSig;
7726  strat->posInL     = posInLF5C;
7727  //strat->posInT     = posInTSig;
7728}
7729
7730void initSbaBuchMora (ideal F,ideal Q,kStrategy strat)
7731{
7732  strat->interpt = BTEST1(OPT_INTERRUPT);
7733  strat->kHEdge=NULL;
7734  if (currRing->OrdSgn==1) strat->kHEdgeFound=FALSE;
7735  /*- creating temp data structures------------------- -*/
7736  strat->cp = 0;
7737  strat->c3 = 0;
7738  strat->tail = pInit();
7739  /*- set s -*/
7740  strat->sl = -1;
7741  /*- set ps -*/
7742  strat->syzl = -1;
7743  /*- set L -*/
7744  strat->Lmax = ((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
7745  strat->Ll = -1;
7746  strat->L = initL(((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc);
7747  /*- set B -*/
7748  strat->Bmax = setmaxL;
7749  strat->Bl = -1;
7750  strat->B = initL();
7751  /*- set T -*/
7752  strat->tl = -1;
7753  strat->tmax = setmaxT;
7754  strat->T = initT();
7755  strat->R = initR();
7756  strat->sevT = initsevT();
7757  /*- init local data struct.---------------------------------------- -*/
7758  strat->P.ecart=0;
7759  strat->P.length=0;
7760  if (currRing->OrdSgn==-1)
7761  {
7762    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
7763    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
7764  }
7765  if(TEST_OPT_SB_1)
7766  {
7767    int i;
7768    ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
7769    for (i=strat->newIdeal;i<IDELEMS(F);i++)
7770    {
7771      P->m[i-strat->newIdeal] = F->m[i];
7772      F->m[i] = NULL;
7773    }
7774    initSSpecialSba(F,Q,P,strat);
7775    for (i=strat->newIdeal;i<IDELEMS(F);i++)
7776    {
7777      F->m[i] = P->m[i-strat->newIdeal];
7778      P->m[i-strat->newIdeal] = NULL;
7779    }
7780    idDelete(&P);
7781  }
7782  else
7783  {
7784    /*Shdl=*/initSLSba(F, Q,strat); /*sets also S, ecartS, fromQ */
7785    // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
7786  }
7787  strat->fromT = FALSE;
7788  strat->noTailReduction = !TEST_OPT_REDTAIL;
7789  if (!TEST_OPT_SB_1)
7790  {
7791    updateS(TRUE,strat);
7792  }
7793  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
7794  strat->fromQ=NULL;
7795}
7796
7797void exitSba (kStrategy strat)
7798{
7799  /*- release temp data -*/
7800  cleanT(strat);
7801  omFreeSize(strat->T,(strat->tmax)*sizeof(TObject));
7802  omFreeSize(strat->R,(strat->tmax)*sizeof(TObject*));
7803  omFreeSize(strat->sevT, (strat->tmax)*sizeof(unsigned long));
7804  omFreeSize(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
7805  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
7806  omFreeSize((ADDRESS)strat->sevSig,IDELEMS(strat->Shdl)*sizeof(unsigned long));
7807  omFreeSize((ADDRESS)strat->syz,(strat->syzmax)*sizeof(poly));
7808  omFreeSize((ADDRESS)strat->sevSyz,(strat->syzmax)*sizeof(unsigned long));
7809  if (strat->sbaOrder == 1)
7810  {
7811    omFreeSize(strat->syzIdx,(strat->syzidxmax)*sizeof(int));
7812  }
7813  omFreeSize(strat->S_2_R,IDELEMS(strat->Shdl)*sizeof(int));
7814  /*- set L: should be empty -*/
7815  omFreeSize(strat->L,(strat->Lmax)*sizeof(LObject));
7816  /*- set B: should be empty -*/
7817  omFreeSize(strat->B,(strat->Bmax)*sizeof(LObject));
7818  /*- set sig: no need for the signatures anymore -*/
7819  omFreeSize(strat->sig,IDELEMS(strat->Shdl)*sizeof(poly));
7820  pLmDelete(&strat->tail);
7821  strat->syzComp=0;
7822}
7823
7824/*2
7825* in the case of a standardbase of a module over a qring:
7826* replace polynomials in i by ak vectors,
7827* (the polynomial * unit vectors gen(1)..gen(ak)
7828* in every case (also for ideals:)
7829* deletes divisible vectors/polynomials
7830*/
7831void updateResult(ideal r,ideal Q, kStrategy strat)
7832{
7833  int l;
7834  if (strat->ak>0)
7835  {
7836    for (l=IDELEMS(r)-1;l>=0;l--)
7837    {
7838      if ((r->m[l]!=NULL) && (pGetComp(r->m[l])==0))
7839      {
7840        pDelete(&r->m[l]); // and set it to NULL
7841      }
7842    }
7843    int q;
7844    poly p;
7845    for (l=IDELEMS(r)-1;l>=0;l--)
7846    {
7847      if ((r->m[l]!=NULL)
7848      //&& (strat->syzComp>0)
7849      //&& (pGetComp(r->m[l])<=strat->syzComp)
7850      )
7851      {
7852        for(q=IDELEMS(Q)-1; q>=0;q--)
7853        {
7854          if ((Q->m[q]!=NULL)
7855          &&(pLmDivisibleBy(Q->m[q],r->m[l])))
7856          {
7857            if (TEST_OPT_REDSB)
7858            {
7859              p=r->m[l];
7860              r->m[l]=kNF(Q,NULL,p);
7861              pDelete(&p);
7862            }
7863            else
7864            {
7865              pDelete(&r->m[l]); // and set it to NULL
7866            }
7867            break;
7868          }
7869        }
7870      }
7871    }
7872  }
7873  else
7874  {
7875    int q;
7876    poly p;
7877    BOOLEAN reduction_found=FALSE;
7878    for (l=IDELEMS(r)-1;l>=0;l--)
7879    {
7880      if (r->m[l]!=NULL)
7881      {
7882        for(q=IDELEMS(Q)-1; q>=0;q--)
7883        {
7884          if ((Q->m[q]!=NULL)
7885          &&(pLmEqual(r->m[l],Q->m[q])))
7886          {
7887            if (TEST_OPT_REDSB)
7888            {
7889              p=r->m[l];
7890              r->m[l]=kNF(Q,NULL,p);
7891              pDelete(&p);
7892              reduction_found=TRUE;
7893            }
7894            else
7895            {
7896              pDelete(&r->m[l]); // and set it to NULL
7897            }
7898            break;
7899          }
7900        }
7901      }
7902    }
7903    if (/*TEST_OPT_REDSB &&*/ reduction_found)
7904    {
7905      for (l=IDELEMS(r)-1;l>=0;l--)
7906      {
7907        if (r->m[l]!=NULL)
7908        {
7909          for(q=IDELEMS(r)-1;q>=0;q--)
7910          {
7911            if ((l!=q)
7912            && (r->m[q]!=NULL)
7913            &&(pLmDivisibleBy(r->m[l],r->m[q])))
7914            {
7915              pDelete(&r->m[q]);
7916            }
7917          }
7918        }
7919      }
7920    }
7921  }
7922  idSkipZeroes(r);
7923}
7924
7925void completeReduce (kStrategy strat, BOOLEAN withT)
7926{
7927  int i;
7928  int low = (((currRing->OrdSgn==1) && (strat->ak==0)) ? 1 : 0);
7929  LObject L;
7930
7931#ifdef KDEBUG
7932  // need to set this: during tailreductions of T[i], T[i].max is out of
7933  // sync
7934  sloppy_max = TRUE;
7935#endif
7936
7937  strat->noTailReduction = FALSE;
7938  if (TEST_OPT_PROT)
7939  {
7940    PrintLn();
7941    if (timerv) writeTime("standard base computed:");
7942  }
7943  if (TEST_OPT_PROT)
7944  {
7945    Print("(S:%d)",strat->sl);mflush();
7946  }
7947  for (i=strat->sl; i>=low; i--)
7948  {
7949    int end_pos=strat->sl;
7950    if ((strat->fromQ!=NULL) && (strat->fromQ[i])) continue; // do not reduce Q_i
7951    if (strat->ak==0) end_pos=i-1;
7952    TObject* T_j = strat->s_2_t(i);
7953    if ((T_j != NULL)&&(T_j->p==strat->S[i]))
7954    {
7955      L = *T_j;
7956      #ifdef KDEBUG
7957      if (TEST_OPT_DEBUG)
7958      {
7959        Print("test S[%d]:",i);
7960        p_wrp(L.p,currRing,strat->tailRing);
7961        PrintLn();
7962      }
7963      #endif
7964      if (currRing->OrdSgn == 1)
7965        strat->S[i] = redtailBba(&L, end_pos, strat, withT);
7966      else
7967        strat->S[i] = redtail(&L, strat->sl, strat);
7968      #ifdef KDEBUG
7969      if (TEST_OPT_DEBUG)
7970      {
7971        Print("to (tailR) S[%d]:",i);
7972        p_wrp(strat->S[i],currRing,strat->tailRing);
7973        PrintLn();
7974      }
7975      #endif
7976
7977      if (strat->redTailChange && strat->tailRing != currRing)
7978      {
7979        if (T_j->max != NULL) p_LmFree(T_j->max, strat->tailRing);
7980        if (pNext(T_j->p) != NULL)
7981          T_j->max = p_GetMaxExpP(pNext(T_j->p), strat->tailRing);
7982        else
7983          T_j->max = NULL;
7984      }
7985      if (TEST_OPT_INTSTRATEGY)
7986        T_j->pCleardenom();
7987    }
7988    else
7989    {
7990      assume(currRing == strat->tailRing);
7991      #ifdef KDEBUG
7992      if (TEST_OPT_DEBUG)
7993      {
7994        Print("test S[%d]:",i);
7995        p_wrp(strat->S[i],currRing,strat->tailRing);
7996        PrintLn();
7997      }
7998      #endif
7999      if (currRing->OrdSgn == 1)
8000        strat->S[i] = redtailBba(strat->S[i], end_pos, strat, withT);
8001      else
8002        strat->S[i] = redtail(strat->S[i], strat->sl, strat);
8003      if (TEST_OPT_INTSTRATEGY)
8004      {
8005        if (TEST_OPT_CONTENTSB)
8006        {
8007          number n;
8008          p_Cleardenom_n(strat->S[i], currRing, n);// also does a pContent
8009          if (!nIsOne(n))
8010          {
8011            denominator_list denom=(denominator_list)omAlloc(sizeof(denominator_list_s));
8012            denom->n=nInvers(n);
8013            denom->next=DENOMINATOR_LIST;
8014            DENOMINATOR_LIST=denom;
8015          }
8016          nDelete(&n);
8017        }
8018        else
8019        {
8020          //pContent(strat->S[i]);
8021          strat->S[i]=p_Cleardenom(strat->S[i], currRing);// also does a pContent
8022        }
8023      }
8024      #ifdef KDEBUG
8025      if (TEST_OPT_DEBUG)
8026      {
8027        Print("to (-tailR) S[%d]:",i);
8028        p_wrp(strat->S[i],currRing,strat->tailRing);
8029        PrintLn();
8030      }
8031      #endif
8032    }
8033    if (TEST_OPT_PROT)
8034      PrintS("-");
8035  }
8036  if (TEST_OPT_PROT) PrintLn();
8037#ifdef KDEBUG
8038  sloppy_max = FALSE;
8039#endif
8040}
8041
8042
8043/*2
8044* computes the new strat->kHEdge and the new pNoether,
8045* returns TRUE, if pNoether has changed
8046*/
8047BOOLEAN newHEdge(kStrategy strat)
8048{
8049  int i,j;
8050  poly newNoether;
8051
8052#if 0
8053  if (currRing->weight_all_1)
8054    scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
8055  else
8056    scComputeHCw(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
8057#else
8058  scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
8059#endif
8060  if (strat->t_kHEdge != NULL) p_LmFree(strat->t_kHEdge, strat->tailRing);
8061  if (strat->tailRing != currRing)
8062    strat->t_kHEdge = k_LmInit_currRing_2_tailRing(strat->kHEdge, strat->tailRing);
8063  /* compare old and new noether*/
8064  newNoether = pLmInit(strat->kHEdge);
8065  j = p_FDeg(newNoether,currRing);
8066/*  #ifdef HAVE_RINGS
8067  if (!rField_is_Ring(currRing))
8068  #endif */
8069  for (i=1; i<=(currRing->N); i++)
8070  {
8071    if (pGetExp(newNoether, i) > 0) pDecrExp(newNoether,i);
8072  }
8073  pSetm(newNoether);
8074  if (j < strat->HCord) /*- statistics -*/
8075  {
8076    if (TEST_OPT_PROT)
8077    {
8078      Print("H(%d)",j);
8079      mflush();
8080    }
8081    strat->HCord=j;
8082    #ifdef KDEBUG
8083    if (TEST_OPT_DEBUG)
8084    {
8085      Print("H(%d):",j);
8086      wrp(strat->kHEdge);
8087      PrintLn();
8088    }
8089    #endif
8090  }
8091  if (pCmp(strat->kNoether,newNoether)!=1)
8092  {
8093    pDelete(&strat->kNoether);
8094    strat->kNoether=newNoether;
8095    if (strat->t_kNoether != NULL) p_LmFree(strat->t_kNoether, strat->tailRing);
8096    if (strat->tailRing != currRing)
8097      strat->t_kNoether = k_LmInit_currRing_2_tailRing(strat->kNoether, strat->tailRing);
8098
8099    return TRUE;
8100  }
8101  pLmFree(newNoether);
8102  return FALSE;
8103}
8104
8105/***************************************************************
8106 *
8107 * Routines related for ring changes during std computations
8108 *
8109 ***************************************************************/
8110BOOLEAN kCheckSpolyCreation(LObject *L, kStrategy strat, poly &m1, poly &m2)
8111{
8112  if (strat->overflow) return FALSE;
8113  assume(L->p1 != NULL && L->p2 != NULL);
8114  // shift changes: from 0 to -1
8115  assume(L->i_r1 >= -1 && L->i_r1 <= strat->tl);
8116  assume(L->i_r2 >= -1 && L->i_r2 <= strat->tl);
8117  assume(strat->tailRing != currRing);
8118
8119  if (! k_GetLeadTerms(L->p1, L->p2, currRing, m1, m2, strat->tailRing))
8120    return FALSE;
8121  // shift changes: extra case inserted
8122  if ((L->i_r1 == -1) || (L->i_r2 == -1) )
8123  {
8124    return TRUE;
8125  }
8126  poly p1_max = (strat->R[L->i_r1])->max;
8127  poly p2_max = (strat->R[L->i_r2])->max;
8128
8129  if (((p1_max != NULL) && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
8130      ((p2_max != NULL) && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
8131  {
8132    p_LmFree(m1, strat->tailRing);
8133    p_LmFree(m2, strat->tailRing);
8134    m1 = NULL;
8135    m2 = NULL;
8136    return FALSE;
8137  }
8138  return TRUE;
8139}
8140
8141#ifdef HAVE_RINGS
8142/***************************************************************
8143 *
8144 * Checks, if we can compute the gcd poly / strong pair
8145 * gcd-poly = m1 * R[atR] + m2 * S[atS]
8146 *
8147 ***************************************************************/
8148BOOLEAN kCheckStrongCreation(int atR, poly m1, int atS, poly m2, kStrategy strat)
8149{
8150  assume(strat->S_2_R[atS] >= -1 && strat->S_2_R[atS] <= strat->tl);
8151  //assume(strat->tailRing != currRing);
8152
8153  poly p1_max = (strat->R[atR])->max;
8154  poly p2_max = (strat->R[strat->S_2_R[atS]])->max;
8155
8156  if (((p1_max != NULL) && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
8157      ((p2_max != NULL) && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
8158  {
8159    return FALSE;
8160  }
8161  return TRUE;
8162}
8163#endif
8164
8165BOOLEAN kStratChangeTailRing(kStrategy strat, LObject *L, TObject* T, unsigned long expbound)
8166{
8167  assume((strat->tailRing == currRing) || (strat->tailRing->bitmask < currRing->bitmask));
8168  /* initial setup or extending */
8169
8170  if (expbound == 0) expbound = strat->tailRing->bitmask << 1;
8171  if (expbound >= currRing->bitmask) return FALSE;
8172  strat->overflow=FALSE;
8173  ring new_tailRing = rModifyRing(currRing,
8174  // Hmmm .. the condition pFDeg == p_Deg
8175  // might be too strong
8176#ifdef HAVE_RINGS
8177  (strat->homog && currRing->pFDeg == p_Deg && !(rField_is_Ring(currRing))), // TODO Oliver
8178#else
8179  (strat->homog && currRing->pFDeg == p_Deg), // omit_degree
8180#endif
8181  (strat->ak==0), // omit_comp if the input is an ideal
8182  expbound); // exp_limit
8183
8184  if (new_tailRing == currRing) return TRUE;
8185
8186  strat->pOrigFDeg_TailRing = new_tailRing->pFDeg;
8187  strat->pOrigLDeg_TailRing = new_tailRing->pLDeg;
8188
8189  if (currRing->pFDeg != currRing->pFDegOrig)
8190  {
8191    new_tailRing->pFDeg = currRing->pFDeg;
8192    new_tailRing->pLDeg = currRing->pLDeg;
8193  }
8194
8195  if (TEST_OPT_PROT)
8196    Print("[%lu:%d", (unsigned long) new_tailRing->bitmask, new_tailRing->ExpL_Size);
8197  assume(kTest_TS(strat));
8198  assume(new_tailRing != strat->tailRing);
8199  pShallowCopyDeleteProc p_shallow_copy_delete
8200    = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
8201
8202  omBin new_tailBin = omGetStickyBinOfBin(new_tailRing->PolyBin);
8203
8204  int i;
8205  for (i=0; i<=strat->tl; i++)
8206  {
8207    strat->T[i].ShallowCopyDelete(new_tailRing, new_tailBin,
8208                                  p_shallow_copy_delete);
8209  }
8210  for (i=0; i<=strat->Ll; i++)
8211  {
8212    assume(strat->L[i].p != NULL);
8213    if (pNext(strat->L[i].p) != strat->tail)
8214      strat->L[i].ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
8215  }
8216  if ((strat->P.t_p != NULL) ||
8217      ((strat->P.p != NULL) && pNext(strat->P.p) != strat->tail))
8218    strat->P.ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
8219
8220  if ((L != NULL) && (L->tailRing != new_tailRing))
8221  {
8222    if (L->i_r < 0)
8223      L->ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
8224    else
8225    {
8226      assume(L->i_r <= strat->tl);
8227      TObject* t_l = strat->R[L->i_r];
8228      assume(t_l != NULL);
8229      L->tailRing = new_tailRing;
8230      L->p = t_l->p;
8231      L->t_p = t_l->t_p;
8232      L->max = t_l->max;
8233    }
8234  }
8235
8236  if ((T != NULL) && (T->tailRing != new_tailRing && T->i_r < 0))
8237    T->ShallowCopyDelete(new_tailRing, new_tailBin, p_shallow_copy_delete);
8238
8239  omMergeStickyBinIntoBin(strat->tailBin, strat->tailRing->PolyBin);
8240  if (strat->tailRing != currRing)
8241    rKillModifiedRing(strat->tailRing);
8242
8243  strat->tailRing = new_tailRing;
8244  strat->tailBin = new_tailBin;
8245  strat->p_shallow_copy_delete
8246    = pGetShallowCopyDeleteProc(currRing, new_tailRing);
8247
8248  if (strat->kHEdge != NULL)
8249  {
8250    if (strat->t_kHEdge != NULL)
8251      p_LmFree(strat->t_kHEdge, strat->tailRing);
8252    strat->t_kHEdge=k_LmInit_currRing_2_tailRing(strat->kHEdge, new_tailRing);
8253  }
8254
8255  if (strat->kNoether != NULL)
8256  {
8257    if (strat->t_kNoether != NULL)
8258      p_LmFree(strat->t_kNoether, strat->tailRing);
8259    strat->t_kNoether=k_LmInit_currRing_2_tailRing(strat->kNoether,
8260                                                   new_tailRing);
8261  }
8262  assume(kTest_TS(strat));
8263  if (TEST_OPT_PROT)
8264    PrintS("]");
8265  return TRUE;
8266}
8267
8268void kStratInitChangeTailRing(kStrategy strat)
8269{
8270  unsigned long l = 0;
8271  int i;
8272  long e;
8273
8274  assume(strat->tailRing == currRing);
8275
8276  for (i=0; i<= strat->Ll; i++)
8277  {
8278    l = p_GetMaxExpL(strat->L[i].p, currRing, l);
8279  }
8280  for (i=0; i<=strat->tl; i++)
8281  {
8282    // Hmm ... this we could do in one Step
8283    l = p_GetMaxExpL(strat->T[i].p, currRing, l);
8284  }
8285  if (rField_is_Ring(currRing))
8286  {
8287    l *= 2;
8288  }
8289  e = p_GetMaxExp(l, currRing);
8290  if (e <= 1) e = 2;
8291
8292  kStratChangeTailRing(strat, NULL, NULL, e);
8293}
8294
8295ring sbaRing (kStrategy strat, const ring r, BOOLEAN /*complete*/, int /*sgn*/)
8296{
8297  int n = rBlocks(r); // Including trailing zero!
8298  // if sbaOrder == 1 => use (C,monomial order from r)
8299  if (strat->sbaOrder == 1)
8300  {
8301    if (r->order[0] == ringorder_C || r->order[0] == ringorder_c)
8302    {
8303      return r;
8304    }
8305    ring res = rCopy0(r, FALSE, TRUE);
8306    for (int i=1; i<n-1; i++)
8307    {
8308      res->order[i] = res->order[i-1];
8309      res->block0[i] = res->block0[i-1];
8310      res->block1[i] = res->block1[i-1];
8311      res->wvhdl[i] = res->wvhdl[i-1];
8312    }
8313
8314    // new 1st block
8315    res->order[0]   = ringorder_C; // Prefix
8316    res->block0[0]  = 1;
8317    res->block1[0]  = res->N;
8318    //res->wvhdl[j]   = NULL;
8319    // res->order [j] = 0; // The End!
8320    rComplete(res, 1);
8321#ifdef HAVE_PLURAL
8322    if (rIsPluralRing(r))
8323    {
8324      if ( nc_rComplete(r, res, false) ) // no qideal!
8325      {
8326#ifndef NDEBUG
8327        WarnS("error in nc_rComplete");
8328#endif
8329        // cleanup?
8330
8331        //      rDelete(res);
8332        //      return r;
8333
8334        // just go on..
8335      }
8336    }
8337#endif
8338    strat->tailRing = res;
8339    return (res);
8340  }
8341
8342  // not sbaOrder == 1 => use Schreyer order
8343  // this is done by a trick when initializing the signatures
8344  // in initSLSba():
8345  // Instead of using the signature 1e_i for F->m[i], we start
8346  // with the signature LM(F->m[i])e_i for F->m[i]. Doing this we get a
8347  // Schreyer order w.r.t. the underlying monomial order.
8348  // => we do not need to change the underlying polynomial ring at all!
8349
8350  // UPDATE/NOTE/TODO: use induced Schreyer ordering 'IS'!!!!????
8351
8352  /*
8353  else
8354  {
8355    ring res = rCopy0(r, FALSE, FALSE);
8356    // Create 2 more blocks for prefix/suffix:
8357    res->order=(int *)omAlloc0((n+2)*sizeof(int)); // 0  ..  n+1
8358    res->block0=(int *)omAlloc0((n+2)*sizeof(int));
8359    res->block1=(int *)omAlloc0((n+2)*sizeof(int));
8360    int ** wvhdl =(int **)omAlloc0((n+2)*sizeof(int**));
8361
8362    // Encapsulate all existing blocks between induced Schreyer ordering markers: prefix and suffix!
8363    // Note that prefix and suffix have the same ringorder marker and only differ in block[] parameters!
8364
8365    // new 1st block
8366    int j = 0;
8367    res->order[j] = ringorder_IS; // Prefix
8368    res->block0[j] = res->block1[j] = 0;
8369    // wvhdl[j] = NULL;
8370    j++;
8371
8372    for(int i = 0; (i < n) && (r->order[i] != 0); i++, j++) // i = [0 .. n-1] <- non-zero old blocks
8373    {
8374      res->order [j] = r->order [i];
8375      res->block0[j] = r->block0[i];
8376      res->block1[j] = r->block1[i];
8377
8378      if (r->wvhdl[i] != NULL)
8379      {
8380        wvhdl[j] = (int*) omMemDup(r->wvhdl[i]);
8381      } // else wvhdl[j] = NULL;
8382    }
8383
8384    // new last block
8385    res->order [j] = ringorder_IS; // Suffix
8386    res->block0[j] = res->block1[j] = sgn; // Sign of v[o]: 1 for C, -1 for c
8387    // wvhdl[j] = NULL;
8388    j++;
8389
8390    // res->order [j] = 0; // The End!
8391    res->wvhdl = wvhdl;
8392
8393    // j == the last zero block now!
8394    assume(j == (n+1));
8395    assume(res->order[0]==ringorder_IS);
8396    assume(res->order[j-1]==ringorder_IS);
8397    assume(res->order[j]==0);
8398
8399    if (complete)
8400    {
8401      rComplete(res, 1);
8402
8403#ifdef HAVE_PLURAL
8404      if (rIsPluralRing(r))
8405      {
8406        if ( nc_rComplete(r, res, false) ) // no qideal!
8407        {
8408        }
8409      }
8410      assume(rIsPluralRing(r) == rIsPluralRing(res));
8411#endif
8412
8413
8414#ifdef HAVE_PLURAL
8415      ring old_ring = r;
8416
8417#endif
8418
8419      if (r->qideal!=NULL)
8420      {
8421        res->qideal= idrCopyR_NoSort(r->qideal, r, res);
8422
8423        assume(idRankFreeModule(res->qideal, res) == 0);
8424
8425#ifdef HAVE_PLURAL
8426        if( rIsPluralRing(res) )
8427          if( nc_SetupQuotient(res, r, true) )
8428          {
8429            //          WarnS("error in nc_SetupQuotient"); // cleanup?      rDelete(res);       return r;  // just go on...?
8430          }
8431
8432#endif
8433        assume(idRankFreeModule(res->qideal, res) == 0);
8434      }
8435
8436#ifdef HAVE_PLURAL
8437      assume((res->qideal==NULL) == (old_ring->qideal==NULL));
8438      assume(rIsPluralRing(res) == rIsPluralRing(old_ring));
8439      assume(rIsSCA(res) == rIsSCA(old_ring));
8440      assume(ncRingType(res) == ncRingType(old_ring));
8441#endif
8442    }
8443    strat->tailRing = res;
8444    return res;
8445  }
8446  */
8447
8448  assume(FALSE);
8449  return(NULL);
8450}
8451
8452skStrategy::skStrategy()
8453{
8454  memset(this, 0, sizeof(skStrategy));
8455#ifndef NDEBUG
8456  strat_nr++;
8457  nr=strat_nr;
8458  if (strat_fac_debug) Print("s(%d) created\n",nr);
8459#endif
8460  tailRing = currRing;
8461  P.tailRing = currRing;
8462  tl = -1;
8463  sl = -1;
8464#ifdef HAVE_LM_BIN
8465  lmBin = omGetStickyBinOfBin(currRing->PolyBin);
8466#endif
8467#ifdef HAVE_TAIL_BIN
8468  tailBin = omGetStickyBinOfBin(currRing->PolyBin);
8469#endif
8470  pOrigFDeg = currRing->pFDeg;
8471  pOrigLDeg = currRing->pLDeg;
8472}
8473
8474
8475skStrategy::~skStrategy()
8476{
8477  if (lmBin != NULL)
8478    omMergeStickyBinIntoBin(lmBin, currRing->PolyBin);
8479  if (tailBin != NULL)
8480    omMergeStickyBinIntoBin(tailBin,
8481                            (tailRing != NULL ? tailRing->PolyBin:
8482                             currRing->PolyBin));
8483  if (t_kHEdge != NULL)
8484    p_LmFree(t_kHEdge, tailRing);
8485  if (t_kNoether != NULL)
8486    p_LmFree(t_kNoether, tailRing);
8487
8488  if (currRing != tailRing)
8489    rKillModifiedRing(tailRing);
8490  pRestoreDegProcs(currRing,pOrigFDeg, pOrigLDeg);
8491}
8492
8493#if 0
8494Timings for the different possibilities of posInT:
8495            T15           EDL         DL          EL            L         1-2-3
8496Gonnet      43.26       42.30       38.34       41.98       38.40      100.04
8497Hairer_2_1   1.11        1.15        1.04        1.22        1.08        4.7
8498Twomat3      1.62        1.69        1.70        1.65        1.54       11.32
8499ahml         4.48        4.03        4.03        4.38        4.96       26.50
8500c7          15.02       13.98       15.16       13.24       17.31       47.89
8501c8         505.09      407.46      852.76      413.21      499.19        n/a
8502f855        12.65        9.27       14.97        8.78       14.23       33.12
8503gametwo6    11.47       11.35       14.57       11.20       12.02       35.07
8504gerhard_3    2.73        2.83        2.93        2.64        3.12        6.24
8505ilias13     22.89       22.46       24.62       20.60       23.34       53.86
8506noon8       40.68       37.02       37.99       36.82       35.59      877.16
8507rcyclic_19  48.22       42.29       43.99       45.35       51.51      204.29
8508rkat9       82.37       79.46       77.20       77.63       82.54      267.92
8509schwarz_11  16.46       16.81       16.76       16.81       16.72       35.56
8510test016     16.39       14.17       14.40       13.50       14.26       34.07
8511test017     34.70       36.01       33.16       35.48       32.75       71.45
8512test042     10.76       10.99       10.27       11.57       10.45       23.04
8513test058      6.78        6.75        6.51        6.95        6.22        9.47
8514test066     10.71       10.94       10.76       10.61       10.56       19.06
8515test073     10.75       11.11       10.17       10.79        8.63       58.10
8516test086     12.23       11.81       12.88       12.24       13.37       66.68
8517test103      5.05        4.80        5.47        4.64        4.89       11.90
8518test154     12.96       11.64       13.51       12.46       14.61       36.35
8519test162     65.27       64.01       67.35       59.79       67.54      196.46
8520test164      7.50        6.50        7.68        6.70        7.96       17.13
8521virasoro     3.39        3.50        3.35        3.47        3.70        7.66
8522#endif
8523
8524
8525//#ifdef HAVE_MORE_POS_IN_T
8526#if 1
8527// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
8528int posInT_EcartFDegpLength(const TSet set,const int length,LObject &p)
8529{
8530
8531  if (length==-1) return 0;
8532
8533  int o = p.ecart;
8534  int op=p.GetpFDeg();
8535  int ol = p.GetpLength();
8536
8537  if (set[length].ecart < o)
8538    return length+1;
8539  if (set[length].ecart == o)
8540  {
8541     int oo=set[length].GetpFDeg();
8542     if ((oo < op) || ((oo==op) && (set[length].length < ol)))
8543       return length+1;
8544  }
8545
8546  int i;
8547  int an = 0;
8548  int en= length;
8549  loop
8550  {
8551    if (an >= en-1)
8552    {
8553      if (set[an].ecart > o)
8554        return an;
8555      if (set[an].ecart == o)
8556      {
8557         int oo=set[an].GetpFDeg();
8558         if((oo > op)
8559         || ((oo==op) && (set[an].pLength > ol)))
8560           return an;
8561      }
8562      return en;
8563    }
8564    i=(an+en) / 2;
8565    if (set[i].ecart > o)
8566      en=i;
8567    else if (set[i].ecart == o)
8568    {
8569       int oo=set[i].GetpFDeg();
8570       if ((oo > op)
8571       || ((oo == op) && (set[i].pLength > ol)))
8572         en=i;
8573       else
8574        an=i;
8575    }
8576    else
8577      an=i;
8578  }
8579}
8580
8581// determines the position based on: 1.) FDeg 2.) pLength
8582int posInT_FDegpLength(const TSet set,const int length,LObject &p)
8583{
8584
8585  if (length==-1) return 0;
8586
8587  int op=p.GetpFDeg();
8588  int ol = p.GetpLength();
8589
8590  int oo=set[length].GetpFDeg();
8591  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
8592    return length+1;
8593
8594  int i;
8595  int an = 0;
8596  int en= length;
8597  loop
8598    {
8599      if (an >= en-1)
8600      {
8601        int oo=set[an].GetpFDeg();
8602        if((oo > op)
8603           || ((oo==op) && (set[an].pLength > ol)))
8604          return an;
8605        return en;
8606      }
8607      i=(an+en) / 2;
8608      int oo=set[i].GetpFDeg();
8609      if ((oo > op)
8610          || ((oo == op) && (set[i].pLength > ol)))
8611        en=i;
8612      else
8613        an=i;
8614    }
8615}
8616
8617
8618// determines the position based on: 1.) pLength
8619int posInT_pLength(const TSet set,const int length,LObject &p)
8620{
8621  int ol = p.GetpLength();
8622  if (length==-1)
8623    return 0;
8624  if (set[length].length<p.length)
8625    return length+1;
8626
8627  int i;
8628  int an = 0;
8629  int en= length;
8630
8631  loop
8632  {
8633    if (an >= en-1)
8634    {
8635      if (set[an].pLength>ol) return an;
8636      return en;
8637    }
8638    i=(an+en) / 2;
8639    if (set[i].pLength>ol) en=i;
8640    else                        an=i;
8641  }
8642}
8643#endif
8644
8645// kstd1.cc:
8646int redFirst (LObject* h,kStrategy strat);
8647int redEcart (LObject* h,kStrategy strat);
8648void enterSMora (LObject p,int atS,kStrategy strat, int atR=-1);
8649void enterSMoraNF (LObject p,int atS,kStrategy strat, int atR=-1);
8650// ../Singular/misc.cc:
8651extern char *  showOption();
8652
8653void kDebugPrint(kStrategy strat)
8654{
8655  PrintS("red: ");
8656    if (strat->red==redFirst) PrintS("redFirst\n");
8657    else if (strat->red==redHoney) PrintS("redHoney\n");
8658    else if (strat->red==redEcart) PrintS("redEcart\n");
8659    else if (strat->red==redHomog) PrintS("redHomog\n");
8660    else  Print("%p\n",(void*)strat->red);
8661  PrintS("posInT: ");
8662    if (strat->posInT==posInT0) PrintS("posInT0\n");
8663    else if (strat->posInT==posInT0) PrintS("posInT0\n");
8664    else if (strat->posInT==posInT1) PrintS("posInT1\n");
8665    else if (strat->posInT==posInT11) PrintS("posInT11\n");
8666    else if (strat->posInT==posInT110) PrintS("posInT110\n");
8667    else if (strat->posInT==posInT13) PrintS("posInT13\n");
8668    else if (strat->posInT==posInT15) PrintS("posInT15\n");
8669    else if (strat->posInT==posInT17) PrintS("posInT17\n");
8670    else if (strat->posInT==posInT17_c) PrintS("posInT17_c\n");
8671    else if (strat->posInT==posInT19) PrintS("posInT19\n");
8672    else if (strat->posInT==posInT2) PrintS("posInT2\n");
8673#ifdef HAVE_MORE_POS_IN_T
8674    else if (strat->posInT==posInT_EcartFDegpLength) PrintS("posInT_EcartFDegpLength\n");
8675    else if (strat->posInT==posInT_FDegpLength) PrintS("posInT_FDegpLength\n");
8676    else if (strat->posInT==posInT_pLength) PrintS("posInT_pLength\n");
8677#endif
8678    else if (strat->posInT==posInT_EcartpLength) PrintS("posInT_EcartpLength\n");
8679    else if (strat->posInT==posInTrg0) PrintS("posInTrg0\n");
8680    else  Print("%p\n",(void*)strat->posInT);
8681  PrintS("posInL: ");
8682    if (strat->posInL==posInL0) PrintS("posInL0\n");
8683    else if (strat->posInL==posInL10) PrintS("posInL10\n");
8684    else if (strat->posInL==posInL11) PrintS("posInL11\n");
8685    else if (strat->posInL==posInL110) PrintS("posInL110\n");
8686    else if (strat->posInL==posInL13) PrintS("posInL13\n");
8687    else if (strat->posInL==posInL15) PrintS("posInL15\n");
8688    else if (strat->posInL==posInL17) PrintS("posInL17\n");
8689    else if (strat->posInL==posInL17_c) PrintS("posInL17_c\n");
8690    else if (strat->posInL==posInLSpecial) PrintS("posInLSpecial\n");
8691    else if (strat->posInL==posInLrg0) PrintS("posInLrg0\n");
8692    else  Print("%p\n",(void*)strat->posInL);
8693  PrintS("enterS: ");
8694    if (strat->enterS==enterSBba) PrintS("enterSBba\n");
8695    else if (strat->enterS==enterSMora) PrintS("enterSMora\n");
8696    else if (strat->enterS==enterSMoraNF) PrintS("enterSMoraNF\n");
8697    else  Print("%p\n",(void*)strat->enterS);
8698  PrintS("initEcart: ");
8699    if (strat->initEcart==initEcartBBA) PrintS("initEcartBBA\n");
8700    else if (strat->initEcart==initEcartNormal) PrintS("initEcartNormal\n");
8701    else  Print("%p\n",(void*)strat->initEcart);
8702  PrintS("initEcartPair: ");
8703    if (strat->initEcartPair==initEcartPairBba) PrintS("initEcartPairBba\n");
8704    else if (strat->initEcartPair==initEcartPairMora) PrintS("initEcartPairMora\n");
8705    else  Print("%p\n",(void*)strat->initEcartPair);
8706  Print("homog=%d, LazyDegree=%d, LazyPass=%d, ak=%d,\n",
8707         strat->homog, strat->LazyDegree,strat->LazyPass, strat->ak);
8708  Print("honey=%d, sugarCrit=%d, Gebauer=%d, noTailReduction=%d, use_buckets=%d\n",
8709         strat->honey,strat->sugarCrit,strat->Gebauer,strat->noTailReduction,strat->use_buckets);
8710  Print("posInLDependsOnLength=%d\n",
8711         strat->posInLDependsOnLength);
8712  PrintS(showOption());PrintLn();
8713  PrintS("LDeg: ");
8714    if (currRing->pLDeg==pLDeg0) PrintS("pLDeg0");
8715    else if (currRing->pLDeg==pLDeg0c) PrintS("pLDeg0c");
8716    else if (currRing->pLDeg==pLDegb) PrintS("pLDegb");
8717    else if (currRing->pLDeg==pLDeg1) PrintS("pLDeg1");
8718    else if (currRing->pLDeg==pLDeg1c) PrintS("pLDeg1c");
8719    else if (currRing->pLDeg==pLDeg1_Deg) PrintS("pLDeg1_Deg");
8720    else if (currRing->pLDeg==pLDeg1c_Deg) PrintS("pLDeg1c_Deg");
8721    else if (currRing->pLDeg==pLDeg1_Totaldegree) PrintS("pLDeg1_Totaldegree");
8722    else if (currRing->pLDeg==pLDeg1c_Totaldegree) PrintS("pLDeg1c_Totaldegree");
8723    else if (currRing->pLDeg==pLDeg1_WFirstTotalDegree) PrintS("pLDeg1_WFirstTotalDegree");
8724    else if (currRing->pLDeg==pLDeg1c_WFirstTotalDegree) PrintS("pLDeg1c_WFirstTotalDegree");
8725    else if (currRing->pLDeg==maxdegreeWecart) PrintS("maxdegreeWecart");
8726    else Print("? (%lx)", (long)currRing->pLDeg);
8727    PrintS(" / ");
8728    if (strat->tailRing->pLDeg==pLDeg0) PrintS("pLDeg0");
8729    else if (strat->tailRing->pLDeg==pLDeg0c) PrintS("pLDeg0c");
8730    else if (strat->tailRing->pLDeg==pLDegb) PrintS("pLDegb");
8731    else if (strat->tailRing->pLDeg==pLDeg1) PrintS("pLDeg1");
8732    else if (strat->tailRing->pLDeg==pLDeg1c) PrintS("pLDeg1c");
8733    else if (strat->tailRing->pLDeg==pLDeg1_Deg) PrintS("pLDeg1_Deg");
8734    else if (strat->tailRing->pLDeg==pLDeg1c_Deg) PrintS("pLDeg1c_Deg");
8735    else if (strat->tailRing->pLDeg==pLDeg1_Totaldegree) PrintS("pLDeg1_Totaldegree");
8736    else if (strat->tailRing->pLDeg==pLDeg1c_Totaldegree) PrintS("pLDeg1c_Totaldegree");
8737    else if (strat->tailRing->pLDeg==pLDeg1_WFirstTotalDegree) PrintS("pLDeg1_WFirstTotalDegree");
8738    else if (strat->tailRing->pLDeg==pLDeg1c_WFirstTotalDegree) PrintS("pLDeg1c_WFirstTotalDegree");
8739    else if (strat->tailRing->pLDeg==maxdegreeWecart) PrintS("maxdegreeWecart");
8740    else Print("? (%lx)", (long)strat->tailRing->pLDeg);
8741    PrintLn();
8742  PrintS("currRing->pFDeg: ");
8743    if (currRing->pFDeg==p_Totaldegree) PrintS("p_Totaldegree");
8744    else if (currRing->pFDeg==p_WFirstTotalDegree) PrintS("pWFirstTotalDegree");
8745    else if (currRing->pFDeg==p_Deg) PrintS("p_Deg");
8746    else if (currRing->pFDeg==kHomModDeg) PrintS("kHomModDeg");
8747    else if (currRing->pFDeg==totaldegreeWecart) PrintS("totaldegreeWecart");
8748    else if (currRing->pFDeg==p_WTotaldegree) PrintS("p_WTotaldegree");
8749    else Print("? (%lx)", (long)currRing->pFDeg);
8750    PrintLn();
8751    Print(" syzring:%d, syzComp(strat):%d limit:%d\n",rIsSyzIndexRing(currRing),strat->syzComp,rGetCurrSyzLimit(currRing));
8752    if(TEST_OPT_DEGBOUND)
8753      Print(" degBound: %d\n", Kstd1_deg);
8754
8755    if( ecartWeights != NULL )
8756    {
8757       PrintS("ecartWeights: ");
8758       for (int i = rVar(currRing); i > 0; i--)
8759         Print("%hd ", ecartWeights[i]);
8760       PrintLn();
8761       assume( TEST_OPT_WEIGHTM );
8762    }
8763
8764#ifndef NDEBUG
8765    rDebugPrint(currRing);
8766#endif
8767}
8768
8769
8770#ifdef HAVE_SHIFTBBA
8771poly pMove2CurrTail(poly p, kStrategy strat)
8772{
8773  /* assume: p is completely in currRing */
8774  /* produces an object with LM in curring
8775     and TAIL in tailring */
8776  if (pNext(p)!=NULL)
8777  {
8778    pNext(p) = prMoveR(pNext(p), /* src */ currRing, /* dest */ strat->tailRing);
8779  }
8780  return(p);
8781}
8782#endif
8783
8784#ifdef HAVE_SHIFTBBA
8785poly pMoveCurrTail2poly(poly p, kStrategy strat)
8786{
8787  /* assume: p has  LM in curring and TAIL in tailring */
8788  /* convert it to complete currRing */
8789
8790  /* check that LM is in currRing */
8791  assume(p_LmCheckIsFromRing(p, currRing));
8792
8793  if (pNext(p)!=NULL)
8794  {
8795    pNext(p) = prMoveR(pNext(p), /* src */ strat->tailRing, /* dest */currRing);
8796  }
8797  return(p);
8798}
8799#endif
8800
8801#ifdef HAVE_SHIFTBBA
8802poly pCopyL2p(LObject H, kStrategy strat)
8803{
8804    /* restores a poly in currRing from LObject */
8805    LObject h = H;
8806    h.Copy();
8807    poly p;
8808    if (h.p == NULL)
8809    {
8810      if (h.t_p != NULL)
8811      {
8812         p = prMoveR(h.t_p, /* source ring: */ strat->tailRing, /* dest. ring: */ currRing);
8813        return(p);
8814      }
8815      else
8816      {
8817        /* h.tp == NULL -> the object is NULL */
8818        return(NULL);
8819      }
8820    }
8821    /* we're here if h.p != NULL */
8822    if (h.t_p == NULL)
8823    {
8824       /* then h.p is the whole poly in currRing */
8825       p = h.p;
8826      return(p);
8827    }
8828    /* we're here if h.p != NULL and h.t_p != NULL */
8829    // clean h.p, get poly from t_p
8830     pNext(h.p)=NULL;
8831     pDelete(&h.p);
8832     p = prMoveR(h.t_p, /* source ring: */ strat->tailRing,
8833                         /* dest. ring: */ currRing);
8834     // no need to clean h: we re-used the polys
8835    return(p);
8836}
8837#endif
8838
8839//LObject pCopyp2L(poly p, kStrategy strat)
8840//{
8841    /* creates LObject from the poly in currRing */
8842  /* actually put p into L.p and make L.t_p=NULL : does not work */
8843
8844//}
8845
8846// poly pCopyL2p(LObject H, kStrategy strat)
8847// {
8848//   /* restores a poly in currRing from LObject */
8849//   LObject h = H;
8850//   h.Copy();
8851//   poly p;
8852//   if (h.p == NULL)
8853//   {
8854//     if (h.t_p != NULL)
8855//     {
8856//       p = p_ShallowCopyDelete(h.t_p, (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
8857//       return(p);
8858//     }
8859//     else
8860//     {
8861//       /* h.tp == NULL -> the object is NULL */
8862//       return(NULL);
8863//     }
8864//   }
8865//   /* we're here if h.p != NULL */
8866
8867//   if (h.t_p == NULL)
8868//   {
8869//     /* then h.p is the whole poly in tailRing */
8870//     if (strat->tailBin != NULL && (pNext(h.p) != NULL))
8871//     {
8872//       p = p_ShallowCopyDelete(h.p, (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
8873//     }
8874//     return(p);
8875//   }
8876//   /* we're here if h.p != NULL and h.t_p != NULL */
8877//   p = pCopy(pHead(h.p)); // in currRing
8878//   if (strat->tailBin != NULL && (pNext(h.p) != NULL))
8879//   {
8880//     //    pNext(p) = p_ShallowCopyDelete(pNext(h.t_p), (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
8881//     poly pp = p_Copy(pNext(h.p), strat->tailRing);
8882//     //    poly p3 = p_Copy(pNext(h.p), currRing); // error
8883//       // p_ShallowCopyDelete(pNext(h.p), currRing, strat->tailBin); // the same as pp
8884//     poly p5 = p_ShallowCopyDelete(pNext(h.p), strat->tailRing, strat->tailBin);
8885//     pNext(p) = p_ShallowCopyDelete(h.t_p, strat->tailRing, strat->tailBin);
8886//     poly p4 = p_Copy(h.t_p, strat->tailRing);
8887//     //    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
8888//   }
8889//   //  pTest(p);
8890//   return(p);
8891// }
8892
8893#ifdef HAVE_SHIFTBBA
8894/* including the self pairs */
8895void updateSShift(kStrategy strat,int uptodeg,int lV)
8896{
8897  /* to use after updateS(toT=FALSE,strat) */
8898  /* fills T with shifted elt's of S */
8899  int i;
8900  LObject h;
8901  int atT = -1; // or figure out smth better
8902  strat->tl = -1; // init
8903  for (i=0; i<=strat->sl; i++)
8904  {
8905    memset(&h,0,sizeof(h));
8906    h.p =  strat->S[i]; // lm in currRing, tail in TR
8907    strat->initEcart(&h);
8908    h.sev = strat->sevS[i];
8909    h.t_p = NULL;
8910    h.GetTP(); // creates correct t_p
8911    /*puts the elements of S with their shifts to T*/
8912    //    int atT, int uptodeg, int lV)
8913    strat->S_2_R[i] = strat->tl + 1; // the el't with shift 0 will be inserted first
8914    // need a small check for above; we insert >=1 elements
8915    // insert this check into kTest_TS ?
8916    enterTShift(h,strat,atT,uptodeg,lV);
8917  }
8918  /* what about setting strat->tl? */
8919}
8920#endif
8921
8922#ifdef HAVE_SHIFTBBA
8923void initBuchMoraShift (ideal F,ideal Q,kStrategy strat)
8924{
8925  strat->interpt = BTEST1(OPT_INTERRUPT);
8926  strat->kHEdge=NULL;
8927  if (currRing->OrdSgn==1) strat->kHEdgeFound=FALSE;
8928  /*- creating temp data structures------------------- -*/
8929  strat->cp = 0;
8930  strat->c3 = 0;
8931  strat->cv = 0;
8932  strat->tail = pInit();
8933  /*- set s -*/
8934  strat->sl = -1;
8935  /*- set L -*/
8936  strat->Lmax = setmaxL;
8937  strat->Ll = -1;
8938  strat->L = initL();
8939  /*- set B -*/
8940  strat->Bmax = setmaxL;
8941  strat->Bl = -1;
8942  strat->B = initL();
8943  /*- set T -*/
8944  strat->tl = -1;
8945  strat->tmax = setmaxT;
8946  strat->T = initT();
8947  strat->R = initR();
8948  strat->sevT = initsevT();
8949  /*- init local data struct.---------------------------------------- -*/
8950  strat->P.ecart=0;
8951  strat->P.length=0;
8952  if (currRing->OrdSgn==-1)
8953  {
8954    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
8955    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
8956  }
8957  if(TEST_OPT_SB_1)
8958  {
8959    int i;
8960    ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
8961    for (i=strat->newIdeal;i<IDELEMS(F);i++)
8962    {
8963      P->m[i-strat->newIdeal] = F->m[i];
8964      F->m[i] = NULL;
8965    }
8966    initSSpecial(F,Q,P,strat);
8967    for (i=strat->newIdeal;i<IDELEMS(F);i++)
8968    {
8969      F->m[i] = P->m[i-strat->newIdeal];
8970      P->m[i-strat->newIdeal] = NULL;
8971    }
8972    idDelete(&P);
8973  }
8974  else
8975  {
8976    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
8977    // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
8978  }
8979  strat->fromT = FALSE;
8980  strat->noTailReduction = !TEST_OPT_REDTAIL;
8981  if (!TEST_OPT_SB_1)
8982  {
8983    /* the only change: we do not fill the set T*/
8984    updateS(FALSE,strat);
8985  }
8986  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
8987  strat->fromQ=NULL;
8988  /* more changes: fill the set T with all the shifts of elts of S*/
8989  /* is done by other procedure */
8990}
8991#endif
8992
8993#ifdef HAVE_SHIFTBBA
8994/*1
8995* put the pairs (sh \dot s[i],p)  into the set B, ecart=ecart(p)
8996*/
8997void enterOnePairManyShifts (int i, poly p, int ecart, int isFromQ, kStrategy strat, int /*atR*/, int uptodeg, int lV)
8998{
8999  /* p comes from strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
9000
9001  assume(p_LmCheckIsFromRing(p,currRing));
9002  assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
9003
9004  /* cycles through all shifts of s[i] until uptodeg - lastVblock(s[i]) */
9005  /* that is create the pairs (f, s \dot g)  */
9006
9007  poly qq = strat->S[i]; //  lm in currRing, tail in tailRing
9008
9009  //  poly q = pCopy(pHead(strat->S[i])); // lm in currRing
9010  //  pNext(q) = prCopyR(pNext(strat->S[i]),strat->tailRing,currRing); // zero shift
9011
9012 /* determine how many elements we have to insert for a given s[i] */
9013  /* x(0)y(1)z(2) : lastVblock-1=2, to add until lastVblock=uptodeg-1 */
9014  /* hence, a total number of elt's to add is: */
9015  /*  int toInsert = 1 + (uptodeg-1) - (pLastVblock(p.p, lV) -1);  */
9016  int toInsert =  itoInsert(qq, uptodeg,  lV, strat->tailRing);
9017
9018#ifdef KDEBUG
9019    if (TEST_OPT_DEBUG)
9020    {
9021      //      Print("entered ManyShifts: with toInsert=%d",toInsert); PrintLn();
9022    }
9023#endif
9024
9025  assume(i<=strat->sl); // from OnePair
9026  if (strat->interred_flag) return; // ?
9027
9028  /* these vars hold for all shifts of s[i] */
9029  int ecartq = 0; //Hans says it's ok; we're in the homog case, no ecart
9030
9031  int qfromQ;
9032  if (strat->fromQ != NULL)
9033  {
9034    qfromQ = strat->fromQ[i];
9035  }
9036  else
9037  {
9038    qfromQ = -1;
9039  }
9040
9041  int j;
9042
9043  poly q/*, s*/;
9044
9045  // for the 0th shift: insert the orig. pair
9046  enterOnePairShift(qq, p, ecart, isFromQ, strat, -1, ecartq, qfromQ, 0, i, uptodeg, lV);
9047
9048  for (j=1; j<= toInsert; j++)
9049  {
9050    //    q = pLPshift(strat->S[i],j,uptodeg,lV);
9051    q = p_LPshiftT(qq, j, uptodeg, lV, strat, currRing);
9052    //    q = p_mLPshift(qq,j,uptodeg,lV,currRing); // lm in currRing, shift this monomial
9053    //    s = p_LPshift(pNext(qq), j, uptodeg, lV, strat->tailRing); // from tailRing
9054    //    pNext(q) = s; // in tailRing
9055    /* here we need to call enterOnePair with two polys ... */
9056
9057#ifdef KDEBUG
9058    if (TEST_OPT_DEBUG)
9059    {
9060      //      PrintS("ManyShifts: calling enterOnePairShift(q,p)");      PrintLn();
9061    }
9062#endif
9063    enterOnePairShift(q, p, ecart, isFromQ, strat, -1, ecartq, qfromQ, j, i, uptodeg, lV);
9064  }
9065}
9066#endif
9067
9068#ifdef HAVE_SHIFTBBA
9069/*1
9070* put the pairs (sh \dot qq,p)  into the set B, ecart=ecart(p)
9071* despite the name, not only self shifts
9072*/
9073void enterOnePairSelfShifts (poly qq, poly p, int ecart, int isFromQ, kStrategy strat, int /*atR*/, int uptodeg, int lV)
9074{
9075
9076  /* format: p,qq are in LObject form: lm in CR, tail in TR */
9077  /* for true self pairs qq ==p  */
9078  /* we test both qq and p */
9079  assume(p_LmCheckIsFromRing(qq,currRing));
9080  assume(p_CheckIsFromRing(pNext(qq),strat->tailRing));
9081  assume(p_LmCheckIsFromRing(p,currRing));
9082  assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
9083
9084  /* since this proc is applied twice for (h, s*g) and (g,s*h), init j with 1 only */
9085
9086  //  int j = 0;
9087  int j = 1;
9088
9089  /* for such self pairs start with 1, not with 0 */
9090  if (qq == p) j=1;
9091
9092  /* should cycle through all shifts of q until uptodeg - lastVblock(q) */
9093  /* that is create the pairs (f, s \dot g)  */
9094
9095  int toInsert =  itoInsert(qq, uptodeg,  lV, strat->tailRing);
9096
9097#ifdef KDEBUG
9098    if (TEST_OPT_DEBUG)
9099    {
9100      //      Print("entered SelfShifts: with toInsert=%d",toInsert); PrintLn();
9101    }
9102#endif
9103
9104  poly q;
9105
9106  if (strat->interred_flag) return; // ?
9107
9108  /* these vars hold for all shifts of s[i] */
9109  int ecartq = 0; //Hans says it's ok; we're in the homog case, no ecart
9110  int qfromQ = 0; // strat->fromQ[i];
9111
9112  for (; j<= toInsert; j++)
9113  {
9114    //    q = pLPshift(strat->S[i],j,uptodeg,lV);
9115    /* we increase shifts by one; must delete q there*/
9116    //    q = qq; q = pMoveCurrTail2poly(q,strat);
9117    //    q = pLPshift(q,j,uptodeg,lV); //,currRing);
9118    q = p_LPshiftT(qq, j, uptodeg, lV, strat, currRing);
9119    //    q = p_mLPshift(qq,j,uptodeg,lV,currRing); // lm in currRing, shift this monomial
9120    //    s = p_LPshift(pNext(qq), j, uptodeg, lV, strat->tailRing); // from tailRing
9121    //    pNext(q) = s; // in tailRing
9122    /* here we need to call enterOnePair with two polys ... */
9123#ifdef KDEBUG
9124    if (TEST_OPT_DEBUG)
9125    {
9126      //      PrintS("SelfShifts: calling enterOnePairShift(q,p)");      PrintLn();
9127    }
9128#endif
9129    enterOnePairShift(q, p, ecart, isFromQ, strat, -1, ecartq, qfromQ, j, -1, uptodeg, lV);
9130  }
9131}
9132#endif
9133
9134#ifdef HAVE_SHIFTBBA
9135/*2
9136* put the pair (q,p)  into the set B, ecart=ecart(p), q is the shift of some s[i]
9137*/
9138void 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)
9139{
9140
9141  /* Format: q and p are like strat->P.p, so lm in CR, tail in TR */
9142
9143  /* check this Formats: */
9144  assume(p_LmCheckIsFromRing(q,currRing));
9145  assume(p_CheckIsFromRing(pNext(q),strat->tailRing));
9146  assume(p_LmCheckIsFromRing(p,currRing));
9147  assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
9148
9149#ifdef KDEBUG
9150    if (TEST_OPT_DEBUG)
9151    {
9152//       PrintS("enterOnePairShift(q,p) invoked with q = ");
9153//       wrp(q); //      wrp(pHead(q));
9154//       PrintS(", p = ");
9155//       wrp(p); //wrp(pHead(p));
9156//       PrintLn();
9157    }
9158#endif
9159
9160  /* poly q stays for s[i], ecartq = ecart(q), qisFromQ = applies to q */
9161
9162  int qfromQ = qisFromQ;
9163
9164  /* need additionally: int up_to_degree, poly V0 with the variables in (0)  or just the number lV = the length of the first block */
9165
9166  if (strat->interred_flag) return;
9167
9168  int      l,j,compare;
9169  LObject  Lp;
9170  Lp.i_r = -1;
9171
9172#ifdef KDEBUG
9173  Lp.ecart=0; Lp.length=0;
9174#endif
9175  /*- computes the lcm(s[i],p) -*/
9176  Lp.lcm = pInit();
9177
9178  pLcm(p,q, Lp.lcm); // q is what was strat->S[i], so a poly in LM/TR presentation
9179  pSetm(Lp.lcm);
9180
9181  /* apply the V criterion */
9182  if (!isInV(Lp.lcm, lV))
9183  {
9184#ifdef KDEBUG
9185    if (TEST_OPT_DEBUG)
9186    {
9187      PrintS("V crit applied to q = ");
9188      wrp(q); //      wrp(pHead(q));
9189      PrintS(", p = ");
9190      wrp(p); //wrp(pHead(p));
9191      PrintLn();
9192    }
9193#endif
9194    pLmFree(Lp.lcm);
9195    Lp.lcm=NULL;
9196    /* + counter for applying the V criterion */
9197    strat->cv++;
9198    return;
9199  }
9200
9201  if (strat->sugarCrit && ALLOW_PROD_CRIT(strat))
9202  {
9203    if((!((ecartq>0)&&(ecart>0)))
9204    && pHasNotCF(p,q))
9205    {
9206    /*
9207    *the product criterion has applied for (s,p),
9208    *i.e. lcm(s,p)=product of the leading terms of s and p.
9209    *Suppose (s,r) is in L and the leading term
9210    *of p divides lcm(s,r)
9211    *(==> the leading term of p divides the leading term of r)
9212    *but the leading term of s does not divide the leading term of r
9213    *(notice that this condition is automatically satisfied if r is still
9214    *in S), then (s,r) can be cancelled.
9215    *This should be done here because the
9216    *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
9217    *
9218    *Moreover, skipping (s,r) holds also for the noncommutative case.
9219    */
9220      strat->cp++;
9221      pLmFree(Lp.lcm);
9222      Lp.lcm=NULL;
9223      return;
9224    }
9225    else
9226      Lp.ecart = si_max(ecart,ecartq);
9227    if (strat->fromT && (ecartq>ecart))
9228    {
9229      pLmFree(Lp.lcm);
9230      Lp.lcm=NULL;
9231      return;
9232      /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
9233    }
9234    /*
9235    *the set B collects the pairs of type (S[j],p)
9236    *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
9237    *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
9238    *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
9239    */
9240    {
9241      j = strat->Bl;
9242      loop
9243      {
9244        if (j < 0)  break;
9245        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
9246        if ((compare==1)
9247        &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
9248        {
9249          strat->c3++;
9250          if ((strat->fromQ==NULL) || (isFromQ==0) || (qfromQ==0))
9251          {
9252            pLmFree(Lp.lcm);
9253            return;
9254          }
9255          break;
9256        }
9257        else
9258        if ((compare ==-1)
9259        && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
9260        {
9261          deleteInL(strat->B,&strat->Bl,j,strat);
9262          strat->c3++;
9263        }
9264        j--;
9265      }
9266    }
9267  }
9268  else /*sugarcrit*/
9269  {
9270    if (ALLOW_PROD_CRIT(strat))
9271    {
9272      // if currRing->nc_type!=quasi (or skew)
9273      // TODO: enable productCrit for super commutative algebras...
9274      if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
9275      pHasNotCF(p,q))
9276      {
9277      /*
9278      *the product criterion has applied for (s,p),
9279      *i.e. lcm(s,p)=product of the leading terms of s and p.
9280      *Suppose (s,r) is in L and the leading term
9281      *of p devides lcm(s,r)
9282      *(==> the leading term of p devides the leading term of r)
9283      *but the leading term of s does not devide the leading term of r
9284      *(notice that tis condition is automatically satisfied if r is still
9285      *in S), then (s,r) can be canceled.
9286      *This should be done here because the
9287      *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
9288      */
9289          strat->cp++;
9290          pLmFree(Lp.lcm);
9291          Lp.lcm=NULL;
9292          return;
9293      }
9294      if (strat->fromT && (ecartq>ecart))
9295      {
9296        pLmFree(Lp.lcm);
9297        Lp.lcm=NULL;
9298        return;
9299        /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
9300      }
9301      /*
9302      *the set B collects the pairs of type (S[j],p)
9303      *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
9304      *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
9305      *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
9306      */
9307      for(j = strat->Bl;j>=0;j--)
9308      {
9309        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
9310        if (compare==1)
9311        {
9312          strat->c3++;
9313          if ((strat->fromQ==NULL) || (isFromQ==0) || (qfromQ==0))
9314          {
9315            pLmFree(Lp.lcm);
9316            return;
9317          }
9318          break;
9319        }
9320        else
9321        if (compare ==-1)
9322        {
9323          deleteInL(strat->B,&strat->Bl,j,strat);
9324          strat->c3++;
9325        }
9326      }
9327    }
9328  }
9329  /*
9330  *the pair (S[i],p) enters B if the spoly != 0
9331  */
9332  /*-  compute the short s-polynomial -*/
9333  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
9334    pNorm(p);
9335  if ((q==NULL) || (p==NULL))
9336    return;
9337  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (qfromQ!=0))
9338    Lp.p=NULL;
9339  else
9340  {
9341//     if ( rIsPluralRing(currRing) )
9342//     {
9343//       if(pHasNotCF(p, q))
9344//       {
9345//         if(ncRingType(currRing) == nc_lie)
9346//         {
9347//             // generalized prod-crit for lie-type
9348//             strat->cp++;
9349//             Lp.p = nc_p_Bracket_qq(pCopy(p),q, currRing);
9350//         }
9351//         else
9352//         if( ALLOW_PROD_CRIT(strat) )
9353//         {
9354//             // product criterion for homogeneous case in SCA
9355//             strat->cp++;
9356//             Lp.p = NULL;
9357//         }
9358//         else
9359//           Lp.p = nc_CreateSpoly(q,p,currRing); // ?
9360//       }
9361//       else  Lp.p = nc_CreateSpoly(q,p,currRing);
9362//     }
9363//     else
9364//     {
9365
9366    /* ksCreateShortSpoly needs two Lobject-kind presentations */
9367    /* p is already in this form, so convert q */
9368    //    q = pMove2CurrTail(q, strat);
9369    Lp.p = ksCreateShortSpoly(q, p, strat->tailRing);
9370      //  }
9371  }
9372  if (Lp.p == NULL)
9373  {
9374    /*- the case that the s-poly is 0 -*/
9375    /* TEMPORARILY DISABLED FOR SHIFTS because there is no i*/
9376//      if (strat->pairtest==NULL) initPairtest(strat);
9377//      strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
9378//      strat->pairtest[strat->sl+1] = TRUE;
9379    /* END _ TEMPORARILY DISABLED FOR SHIFTS */
9380    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
9381    /*
9382    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
9383    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
9384    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
9385    *term of p devides the lcm(s,r)
9386    *(this canceling should be done here because
9387    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
9388    *the first case is handeled in chainCrit
9389    */
9390    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
9391  }
9392  else
9393  {
9394    /*- the pair (S[i],p) enters B -*/
9395    /* both of them should have their LM in currRing and TAIL in tailring */
9396    Lp.p1 = q;  // already in the needed form
9397    Lp.p2 = p; // already in the needed form
9398
9399    if ( !rIsPluralRing(currRing) )
9400      pNext(Lp.p) = strat->tail;
9401
9402    /* TEMPORARILY DISABLED FOR SHIFTS because there's no i*/
9403    /* at the beginning we DO NOT set atR = -1 ANYMORE*/
9404    if ( (atR >= 0) && (shiftcount==0) && (ifromS >=0) )
9405    {
9406      Lp.i_r1 = kFindInT(Lp.p1,strat); //strat->S_2_R[ifromS];
9407      Lp.i_r2 = atR;
9408    }
9409    else
9410    {
9411      /* END _ TEMPORARILY DISABLED FOR SHIFTS */
9412      Lp.i_r1 = -1;
9413      Lp.i_r2 = -1;
9414     }
9415    strat->initEcartPair(&Lp,q,p,ecartq,ecart);
9416
9417    if (TEST_OPT_INTSTRATEGY)
9418    {
9419      if (!rIsPluralRing(currRing))
9420        nDelete(&(Lp.p->coef));
9421    }
9422
9423    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
9424    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
9425  }
9426}
9427#endif
9428
9429#ifdef HAVE_SHIFTBBA
9430/*2
9431*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
9432*superfluous elements in S will be deleted
9433*/
9434void enterpairsShift (poly h,int k,int ecart,int pos,kStrategy strat, int atR,int uptodeg, int lV)
9435{
9436  /* h is strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
9437  /* Q: what is exactly the strat->fromT ? A: a local case trick; don't need it yet*/
9438  int j=pos;
9439
9440#ifdef HAVE_RINGS
9441  assume (!rField_is_Ring(currRing));
9442#endif
9443  initenterpairsShift(h,k,ecart,0,strat, atR,uptodeg,lV);
9444  if ( (!strat->fromT)
9445  && ((strat->syzComp==0)
9446    ||(pGetComp(h)<=strat->syzComp)))
9447  {
9448    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
9449    unsigned long h_sev = pGetShortExpVector(h);
9450    loop
9451    {
9452      if (j > k) break;
9453      clearS(h,h_sev, &j,&k,strat);
9454      j++;
9455    }
9456    //Print("end clearS sl=%d\n",strat->sl);
9457  }
9458 // PrintS("end enterpairs\n");
9459}
9460#endif
9461
9462#ifdef HAVE_SHIFTBBA
9463/*3
9464*(s[0], s \dot h),...,(s[k],s \dot h) will be put to the pairset L
9465* also the pairs (h, s\dot s[0]), ..., (h, s\dot s[k]) enter L
9466* additionally we put the pairs (h, s \sdot h) for s>=1 to L
9467*/
9468void initenterpairsShift (poly h,int k,int ecart,int isFromQ, kStrategy strat, int atR, int uptodeg, int lV)
9469{
9470  /* h comes from strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
9471  //  atR = -1;
9472  if ((strat->syzComp==0)
9473  || (pGetComp(h)<=strat->syzComp))
9474  {
9475    int j;
9476    BOOLEAN new_pair=FALSE;
9477
9478    if (pGetComp(h)==0)
9479    {
9480      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
9481      if ((isFromQ)&&(strat->fromQ!=NULL))
9482      {
9483        for (j=0; j<=k; j++)
9484        {
9485          if (!strat->fromQ[j])
9486          {
9487            new_pair=TRUE;
9488            enterOnePairManyShifts(j,h,ecart,isFromQ,strat, atR,uptodeg,lV);
9489            // other side pairs:
9490            enterOnePairSelfShifts(h,strat->S[j],ecart,isFromQ,strat, atR,uptodeg,lV);
9491          //Print("j:%d, Ll:%d\n",j,strat->Ll);
9492          }
9493        }
9494      }
9495      else
9496      {
9497        new_pair=TRUE;
9498        for (j=0; j<=k; j++)
9499        {
9500          enterOnePairManyShifts(j,h,ecart,isFromQ,strat, atR,uptodeg,lV);
9501          // other side pairs
9502          enterOnePairSelfShifts(h,strat->S[j],ecart,isFromQ,strat, atR,uptodeg,lV);
9503        }
9504        /* HERE we put (h, s*h) pairs */
9505       /* enterOnePairSelfShifts (poly qq, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int uptodeg, int lV); */
9506       enterOnePairSelfShifts (h, h, ecart, isFromQ, strat, atR, uptodeg, lV);
9507      }
9508    }
9509    else
9510    {
9511      for (j=0; j<=k; j++)
9512      {
9513        if ((pGetComp(h)==pGetComp(strat->S[j]))
9514        || (pGetComp(strat->S[j])==0))
9515        {
9516          new_pair=TRUE;
9517          enterOnePairManyShifts(j,h,ecart,isFromQ,strat, atR, uptodeg, lV);
9518          // other side pairs
9519          enterOnePairSelfShifts(h,strat->S[j],ecart,isFromQ,strat, atR,uptodeg,lV);
9520        //Print("j:%d, Ll:%d\n",j,strat->Ll);
9521        }
9522      }
9523      /* HERE we put (h, s*h) pairs */
9524      enterOnePairSelfShifts (h, h, ecart, isFromQ, strat, atR, uptodeg, lV);
9525    }
9526
9527    if (new_pair)
9528    {
9529      strat->chainCrit(h,ecart,strat);
9530    }
9531
9532  }
9533}
9534#endif
9535
9536#ifdef HAVE_SHIFTBBA
9537/*2
9538* puts p to the set T, starting with the at position atT
9539* and inserts all admissible shifts of p
9540*/
9541void enterTShift(LObject p, kStrategy strat, int atT, int uptodeg, int lV)
9542{
9543  /* determine how many elements we have to insert */
9544  /* x(0)y(1)z(2) : lastVblock-1=2, to add until lastVblock=uptodeg-1 */
9545  /* hence, a total number of elt's to add is: */
9546  /*  int toInsert = 1 + (uptodeg-1) - (pLastVblock(p.p, lV) -1);  */
9547
9548  int toInsert =  itoInsert(p.p, uptodeg,  lV, strat->tailRing);
9549
9550#ifdef PDEBUG
9551  //  Print("enterTShift uses toInsert: %d", toInsert);  PrintLn();
9552#endif
9553  int i;
9554
9555  if (atT < 0)
9556    atT = strat->posInT(strat->T, strat->tl, p);
9557
9558  /* can call enterT in a sequence, e.g. */
9559
9560  /* shift0 = it's our model for further shifts */
9561  enterT(p,strat,atT);
9562  LObject qq;
9563  for (i=1; i<=toInsert; i++) // toIns - 1?
9564  {
9565    qq      = p; //qq.Copy();
9566    qq.p    = NULL;
9567    qq.max  = NULL;
9568    qq.t_p = p_LPshift(p_Copy(p.t_p,strat->tailRing), i, uptodeg, lV, strat->tailRing); // direct shift
9569    qq.GetP();
9570    // update q.sev
9571    qq.sev = pGetShortExpVector(qq.p);
9572    /* enter it into T, first el't is with the shift 0 */
9573    // compute the position for qq
9574    atT = strat->posInT(strat->T, strat->tl, qq);
9575    enterT(qq,strat,atT);
9576  }
9577/* Q: what to do with this one in the orig enterT ? */
9578/*  strat->R[strat->tl] = &(strat->T[atT]); */
9579/* Solution: it is done by enterT each time separately */
9580}
9581#endif
9582
9583#ifdef HAVE_SHIFTBBA
9584poly redtailBbaShift (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
9585{
9586  /* for the shift case need to run it with withT = TRUE */
9587  strat->redTailChange=FALSE;
9588  if (strat->noTailReduction) return L->GetLmCurrRing();
9589  poly h, p;
9590  p = h = L->GetLmTailRing();
9591  if ((h==NULL) || (pNext(h)==NULL))
9592    return L->GetLmCurrRing();
9593
9594  TObject* With;
9595  // placeholder in case strat->tl < 0
9596  TObject  With_s(strat->tailRing);
9597
9598  LObject Ln(pNext(h), strat->tailRing);
9599  Ln.pLength = L->GetpLength() - 1;
9600
9601  pNext(h) = NULL;
9602  if (L->p != NULL) pNext(L->p) = NULL;
9603  L->pLength = 1;
9604
9605  Ln.PrepareRed(strat->use_buckets);
9606
9607  while(!Ln.IsNull())
9608  {
9609    loop
9610    {
9611      Ln.SetShortExpVector();
9612      if (withT)
9613      {
9614        int j;
9615        j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
9616        if (j < 0) break;
9617        With = &(strat->T[j]);
9618      }
9619      else
9620      {
9621        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
9622        if (With == NULL) break;
9623      }
9624      if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
9625      {
9626        With->pNorm();
9627        //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
9628      }
9629      strat->redTailChange=TRUE;
9630      if (ksReducePolyTail(L, With, &Ln))
9631      {
9632        // reducing the tail would violate the exp bound
9633        //  set a flag and hope for a retry (in bba)
9634        strat->completeReduce_retry=TRUE;
9635        if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
9636        do
9637        {
9638          pNext(h) = Ln.LmExtractAndIter();
9639          pIter(h);
9640          L->pLength++;
9641        } while (!Ln.IsNull());
9642        goto all_done;
9643      }
9644      if (Ln.IsNull()) goto all_done;
9645      if (! withT) With_s.Init(currRing);
9646    }
9647    pNext(h) = Ln.LmExtractAndIter();
9648    pIter(h);
9649    L->pLength++;
9650  }
9651
9652  all_done:
9653  Ln.Delete();
9654  if (L->p != NULL) pNext(L->p) = pNext(p);
9655
9656  if (strat->redTailChange)
9657  {
9658    L->length = 0;
9659  }
9660  L->Normalize(); // HANNES: should have a test
9661  assume(kTest_L(L));
9662  return L->GetLmCurrRing();
9663}
9664#endif
Note: See TracBrowser for help on using the repository browser.