source: git/kernel/kutil.cc @ 95c826

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