source: git/kernel/kutil.cc @ 802b08

jengelh-datetimespielwiese
Last change on this file since 802b08 was 802b08, checked in by Hans Schoenemann <hannes@…>, 11 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)