source: git/kernel/kutil.cc @ ba5e9e

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