source: git/kernel/kutil.cc @ f1cef21

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