source: git/kernel/kutil.cc @ 47fff5

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