source: git/kernel/kutil.cc @ f224d85

spielwiese
Last change on this file since f224d85 was f224d85, checked in by Hans Schoenemann <hannes@…>, 11 years ago
fix: removing last from p_*templates and k* routines
  • Property mode set to 100644
File size: 245.8 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT: kernel: utils for kStd
6*/
7
8// #define PDEBUG 2
9// #define PDIV_DEBUG
10#define KUTIL_CC
11#include <stdlib.h>
12#include <string.h>
13#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    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    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    BOOLEAN new_pair=FALSE;
3392
3393    for (j=0; j<=k; j++)
3394    {
3395      // Print("j:%d, Ll:%d\n",j,strat->Ll);
3396//      if (((unsigned long) pGetCoeff(h) % (unsigned long) pGetCoeff(strat->S[j]) != 0) &&
3397//         ((unsigned long) pGetCoeff(strat->S[j]) % (unsigned long) pGetCoeff(h) != 0))
3398      if ( iCompH == pGetComp(strat->S[j]) )
3399      {
3400        {
3401          if (enterOneStrongPoly(j,h,ecart,isFromQ,strat, atR))
3402            new_pair=TRUE;
3403        }
3404      }
3405    }
3406  }
3407/*
3408ring r=256,(x,y,z),dp;
3409ideal I=12xz-133y, 2xy-z;
3410*/
3411
3412}
3413
3414/*2
3415* Generates spoly(0, h) if applicable. Assumes ring in Z/2^n.
3416*/
3417void enterExtendedSpoly(poly h,kStrategy strat)
3418{
3419  if (nIsOne(pGetCoeff(h))) return;
3420  number gcd;
3421  bool go = false;
3422  if (n_DivBy((number) 0, pGetCoeff(h), currRing->cf))
3423  {
3424    gcd = nIntDiv((number) 0, pGetCoeff(h));
3425    go = true;
3426  }
3427  else
3428    gcd = nGcd((number) 0, pGetCoeff(h), strat->tailRing);
3429  if (go || !nIsOne(gcd))
3430  {
3431    poly p = h->next;
3432    if (!go)
3433    {
3434      number tmp = gcd;
3435      gcd = nIntDiv(0, gcd);
3436      nDelete(&tmp);
3437    }
3438    p_Test(p,strat->tailRing);
3439    p = pp_Mult_nn(p, gcd, strat->tailRing);
3440    nDelete(&gcd);
3441
3442    if (p != NULL)
3443    {
3444      if (TEST_OPT_PROT)
3445      {
3446        PrintS("Z");
3447      }
3448#ifdef KDEBUG
3449      if (TEST_OPT_DEBUG)
3450      {
3451        PrintS("--- create zero spoly: ");
3452        p_wrp(h,currRing,strat->tailRing);
3453        PrintS(" ---> ");
3454      }
3455#endif
3456      poly tmp = pInit();
3457      pSetCoeff0(tmp, pGetCoeff(p));
3458      for (int i = 1; i <= rVar(currRing); i++)
3459      {
3460        pSetExp(tmp, i, p_GetExp(p, i, strat->tailRing));
3461      }
3462      if (rRing_has_Comp(currRing) && rRing_has_Comp(strat->tailRing))
3463      {
3464        p_SetComp(tmp, p_GetComp(p, strat->tailRing), currRing);
3465      }
3466      p_Setm(tmp, currRing);
3467      p = p_LmFreeAndNext(p, strat->tailRing);
3468      pNext(tmp) = p;
3469      LObject h;
3470      h.Init();
3471      h.p = tmp;
3472      h.tailRing = strat->tailRing;
3473      int posx;
3474      if (h.p!=NULL)
3475      {
3476        if (TEST_OPT_INTSTRATEGY)
3477        {
3478          //pContent(h.p);
3479          h.pCleardenom(); // also does a pContent
3480        }
3481        else
3482        {
3483          h.pNorm();
3484        }
3485        strat->initEcart(&h);
3486        if (strat->Ll==-1)
3487          posx =0;
3488        else
3489          posx = strat->posInL(strat->L,strat->Ll,&h,strat);
3490        h.sev = pGetShortExpVector(h.p);
3491        if (strat->tailRing != currRing)
3492        {
3493          h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
3494        }
3495#ifdef KDEBUG
3496        if (TEST_OPT_DEBUG)
3497        {
3498          p_wrp(tmp,currRing,strat->tailRing);
3499          PrintLn();
3500        }
3501#endif
3502        enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
3503      }
3504    }
3505  }
3506  nDelete(&gcd);
3507}
3508
3509void clearSbatch (poly h,int k,int pos,kStrategy strat)
3510{
3511  int j = pos;
3512  if ( (!strat->fromT)
3513  && (1//(strat->syzComp==0)
3514    //||(pGetComp(h)<=strat->syzComp)))
3515  ))
3516  {
3517    // Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
3518    unsigned long h_sev = pGetShortExpVector(h);
3519    loop
3520    {
3521      if (j > k) break;
3522      clearS(h,h_sev, &j,&k,strat);
3523      j++;
3524    }
3525    // Print("end clearS sl=%d\n",strat->sl);
3526  }
3527}
3528
3529/*2
3530* Generates a sufficient set of spolys (maybe just a finite generating
3531* set of the syzygys)
3532*/
3533void superenterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
3534{
3535    assume (rField_is_Ring(currRing));
3536    // enter also zero divisor * poly, if this is non zero and of smaller degree
3537    if (!(rField_is_Domain(currRing))) enterExtendedSpoly(h, strat);
3538    initenterpairs(h, k, ecart, 0, strat, atR);
3539    initenterstrongPairs(h, k, ecart, 0, strat, atR);
3540    clearSbatch(h, k, pos, strat);
3541}
3542#endif
3543
3544/*2
3545*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
3546*superfluous elements in S will be deleted
3547*/
3548void enterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
3549{
3550  int j=pos;
3551
3552#ifdef HAVE_RINGS
3553  assume (!rField_is_Ring(currRing));
3554#endif
3555
3556  initenterpairs(h,k,ecart,0,strat, atR);
3557  if ( (!strat->fromT)
3558  && ((strat->syzComp==0)
3559    ||(pGetComp(h)<=strat->syzComp)))
3560  {
3561    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
3562    unsigned long h_sev = pGetShortExpVector(h);
3563    loop
3564    {
3565      if (j > k) break;
3566      clearS(h,h_sev, &j,&k,strat);
3567      j++;
3568    }
3569    //Print("end clearS sl=%d\n",strat->sl);
3570  }
3571 // PrintS("end enterpairs\n");
3572}
3573
3574/*2
3575*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
3576*superfluous elements in S will be deleted
3577*this is a special variant of signature-based algorithms including the
3578*signatures for criteria checks
3579*/
3580void enterpairsSig (poly h,poly hSig,int hFrom,int k,int ecart,int pos,kStrategy strat, int atR)
3581{
3582int j=pos;
3583
3584#ifdef HAVE_RINGS
3585assume (!rField_is_Ring(currRing));
3586#endif
3587
3588initenterpairsSig(h,hSig,hFrom,k,ecart,0,strat, atR);
3589if ( (!strat->fromT)
3590&& ((strat->syzComp==0)
3591  ||(pGetComp(h)<=strat->syzComp)))
3592{
3593  //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
3594  unsigned long h_sev = pGetShortExpVector(h);
3595  loop
3596  {
3597    if (j > k) break;
3598    clearS(h,h_sev, &j,&k,strat);
3599    j++;
3600  }
3601  //Print("end clearS sl=%d\n",strat->sl);
3602}
3603// PrintS("end enterpairs\n");
3604}
3605
3606/*2
3607*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
3608*superfluous elements in S will be deleted
3609*/
3610void enterpairsSpecial (poly h,int k,int ecart,int pos,kStrategy strat, int atR = -1)
3611{
3612  int j;
3613  const int iCompH = pGetComp(h);
3614
3615#ifdef HAVE_RINGS
3616  if (rField_is_Ring(currRing))
3617  {
3618    for (j=0; j<=k; j++)
3619    {
3620      const int iCompSj = pGetComp(strat->S[j]);
3621      if ((iCompH==iCompSj)
3622          //|| (0==iCompH) // can only happen,if iCompSj==0
3623          || (0==iCompSj))
3624      {
3625        enterOnePairRing(j,h,ecart,FALSE,strat, atR);
3626      }
3627    }
3628  }
3629  else
3630#endif 
3631  for (j=0; j<=k; j++)
3632  {
3633    const int iCompSj = pGetComp(strat->S[j]);
3634    if ((iCompH==iCompSj)
3635        //|| (0==iCompH) // can only happen,if iCompSj==0
3636        || (0==iCompSj))
3637    {
3638      enterOnePairSpecial(j,h,ecart,strat, atR);
3639    }
3640  }
3641
3642  if (strat->noClearS) return;
3643
3644//   #ifdef HAVE_PLURAL
3645/*
3646  if (rIsPluralRing(currRing))
3647  {
3648    j=pos;
3649    loop
3650    {
3651      if (j > k) break;
3652
3653      if (pLmDivisibleBy(h, strat->S[j]))
3654      {
3655        deleteInS(j, strat);
3656        j--;
3657        k--;
3658      }
3659
3660      j++;
3661    }
3662  }
3663  else
3664*/
3665//   #endif // ??? Why was the following cancelation disabled for non-commutative rings?
3666  {
3667    j=pos;
3668    loop
3669    {
3670      unsigned long h_sev = pGetShortExpVector(h);
3671      if (j > k) break;
3672      clearS(h,h_sev,&j,&k,strat);
3673      j++;
3674    }
3675  }
3676}
3677
3678/*2
3679*reorders  s with respect to posInS,
3680*suc is the first changed index or zero
3681*/
3682
3683void reorderS (int* suc,kStrategy strat)
3684{
3685  int i,j,at,ecart, s2r;
3686  int fq=0;
3687  unsigned long sev;
3688  poly  p;
3689  int new_suc=strat->sl+1;
3690  i= *suc;
3691  if (i<0) i=0;
3692
3693  for (; i<=strat->sl; i++)
3694  {
3695    at = posInS(strat,i-1,strat->S[i],strat->ecartS[i]);
3696    if (at != i)
3697    {
3698      if (new_suc > at) new_suc = at;
3699      p = strat->S[i];
3700      ecart = strat->ecartS[i];
3701      sev = strat->sevS[i];
3702      s2r = strat->S_2_R[i];
3703      if (strat->fromQ!=NULL) fq=strat->fromQ[i];
3704      for (j=i; j>=at+1; j--)
3705      {
3706        strat->S[j] = strat->S[j-1];
3707        strat->ecartS[j] = strat->ecartS[j-1];
3708        strat->sevS[j] = strat->sevS[j-1];
3709        strat->S_2_R[j] = strat->S_2_R[j-1];
3710      }
3711      strat->S[at] = p;
3712      strat->ecartS[at] = ecart;
3713      strat->sevS[at] = sev;
3714      strat->S_2_R[at] = s2r;
3715      if (strat->fromQ!=NULL)
3716      {
3717        for (j=i; j>=at+1; j--)
3718        {
3719          strat->fromQ[j] = strat->fromQ[j-1];
3720        }
3721        strat->fromQ[at]=fq;
3722      }
3723    }
3724  }
3725  if (new_suc <= strat->sl) *suc=new_suc;
3726  else                      *suc=-1;
3727}
3728
3729
3730/*2
3731*looks up the position of p in set
3732*set[0] is the smallest with respect to the ordering-procedure deg/pComp
3733* Assumption: posInS only depends on the leading term
3734*             otherwise, bba has to be changed
3735*/
3736int posInS (const kStrategy strat, const int length,const poly p,
3737            const int ecart_p)
3738{
3739  if(length==-1) return 0;
3740  polyset set=strat->S;
3741  int i;
3742  int an = 0;
3743  int en = length;
3744  int cmp_int = currRing->OrdSgn;
3745  if ((currRing->MixedOrder)
3746#ifdef HAVE_PLURAL
3747  && (currRing->real_var_start==0)
3748#endif
3749#if 0
3750  || ((strat->ak>0) && ((currRing->order[0]==ringorder_c)||((currRing->order[0]==ringorder_C))))
3751#endif
3752  )
3753  {
3754    int o=p_Deg(p,currRing);
3755    int oo=p_Deg(set[length],currRing);
3756
3757    if ((oo<o)
3758    || ((o==oo) && (pLmCmp(set[length],p)!= cmp_int)))
3759      return length+1;
3760
3761    loop
3762    {
3763      if (an >= en-1)
3764      {
3765        if ((p_Deg(set[an],currRing)>=o) && (pLmCmp(set[an],p) == cmp_int))
3766        {
3767          return an;
3768        }
3769        return en;
3770      }
3771      i=(an+en) / 2;
3772      if ((p_Deg(set[i],currRing)>=o) && (pLmCmp(set[i],p) == cmp_int)) en=i;
3773      else                              an=i;
3774    }
3775  }
3776  else
3777  {
3778#ifdef HAVE_RINGS
3779    if (rField_is_Ring(currRing))
3780    {
3781      if (pLmCmp(set[length],p)== -cmp_int)
3782        return length+1;
3783      int cmp;
3784      loop
3785      {
3786        if (an >= en-1)
3787        {
3788          cmp = pLmCmp(set[an],p);
3789          if (cmp == cmp_int)  return an;
3790          if (cmp == -cmp_int) return en;
3791          if (n_DivBy(pGetCoeff(p), pGetCoeff(set[an]), currRing->cf)) return en;
3792          return an;
3793        }
3794        i = (an+en) / 2;
3795        cmp = pLmCmp(set[i],p);
3796        if (cmp == cmp_int)         en = i;
3797        else if (cmp == -cmp_int)   an = i;
3798        else
3799        {
3800          if (n_DivBy(pGetCoeff(p), pGetCoeff(set[i]), currRing->cf)) an = i;
3801          else en = i;
3802        }
3803      }
3804    }
3805    else
3806#endif
3807    if (pLmCmp(set[length],p)== -cmp_int)
3808      return length+1;
3809
3810    loop
3811    {
3812      if (an >= en-1)
3813      {
3814        if (pLmCmp(set[an],p) == cmp_int) return an;
3815        if (pLmCmp(set[an],p) == -cmp_int) return en;
3816        if ((cmp_int!=1)
3817        && ((strat->ecartS[an])>ecart_p))
3818          return an;
3819        return en;
3820      }
3821      i=(an+en) / 2;
3822      if (pLmCmp(set[i],p) == cmp_int) en=i;
3823      else if (pLmCmp(set[i],p) == -cmp_int) an=i;
3824      else
3825      {
3826        if ((cmp_int!=1)
3827        &&((strat->ecartS[i])<ecart_p))
3828          en=i;
3829        else
3830          an=i;
3831      }
3832    }
3833  }
3834}
3835
3836
3837/*2
3838* looks up the position of p in set
3839* the position is the last one
3840*/
3841int posInT0 (const TSet,const int length,LObject &)
3842{
3843  return (length+1);
3844}
3845
3846
3847/*2
3848* looks up the position of p in T
3849* set[0] is the smallest with respect to the ordering-procedure
3850* pComp
3851*/
3852int posInT1 (const TSet set,const int length,LObject &p)
3853{
3854  if (length==-1) return 0;
3855
3856  if (pLmCmp(set[length].p,p.p)!= currRing->OrdSgn) return length+1;
3857
3858  int i;
3859  int an = 0;
3860  int en= length;
3861
3862  loop
3863  {
3864    if (an >= en-1)
3865    {
3866      if (pLmCmp(set[an].p,p.p) == currRing->OrdSgn) return an;
3867      return en;
3868    }
3869    i=(an+en) / 2;
3870    if (pLmCmp(set[i].p,p.p) == currRing->OrdSgn) en=i;
3871    else                                 an=i;
3872  }
3873}
3874
3875/*2
3876* looks up the position of p in T
3877* set[0] is the smallest with respect to the ordering-procedure
3878* length
3879*/
3880int posInT2 (const TSet set,const int length,LObject &p)
3881{
3882  p.GetpLength();
3883  if (length==-1)
3884    return 0;
3885  if (set[length].length<p.length)
3886    return length+1;
3887
3888  int i;
3889  int an = 0;
3890  int en= length;
3891
3892  loop
3893  {
3894    if (an >= en-1)
3895    {
3896      if (set[an].length>p.length) return an;
3897      return en;
3898    }
3899    i=(an+en) / 2;
3900    if (set[i].length>p.length) en=i;
3901    else                        an=i;
3902  }
3903}
3904
3905/*2
3906* looks up the position of p in T
3907* set[0] is the smallest with respect to the ordering-procedure
3908* totaldegree,pComp
3909*/
3910int posInT11 (const TSet set,const int length,LObject &p)
3911/*{
3912 * int j=0;
3913 * int o;
3914 *
3915 * o = p.GetpFDeg();
3916 * loop
3917 * {
3918 *   if ((pFDeg(set[j].p) > o)
3919 *   || ((pFDeg(set[j].p) == o) && (pLmCmp(set[j].p,p.p) == currRing->OrdSgn)))
3920 *   {
3921 *     return j;
3922 *   }
3923 *   j++;
3924 *   if (j > length) return j;
3925 * }
3926 *}
3927 */
3928{
3929  if (length==-1) return 0;
3930
3931  int o = p.GetpFDeg();
3932  int op = set[length].GetpFDeg();
3933
3934  if ((op < o)
3935  || ((op == o) && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
3936    return length+1;
3937
3938  int i;
3939  int an = 0;
3940  int en= length;
3941
3942  loop
3943  {
3944    if (an >= en-1)
3945    {
3946      op= set[an].GetpFDeg();
3947      if ((op > o)
3948      || (( op == o) && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
3949        return an;
3950      return en;
3951    }
3952    i=(an+en) / 2;
3953    op = set[i].GetpFDeg();
3954    if (( op > o)
3955    || (( op == o) && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
3956      en=i;
3957    else
3958      an=i;
3959  }
3960}
3961
3962/*2 Pos for rings T: Here I am
3963* looks up the position of p in T
3964* set[0] is the smallest with respect to the ordering-procedure
3965* totaldegree,pComp
3966*/
3967int posInTrg0 (const TSet set,const int length,LObject &p)
3968{
3969  if (length==-1) return 0;
3970  int o = p.GetpFDeg();
3971  int op = set[length].GetpFDeg();
3972  int i;
3973  int an = 0;
3974  int en = length;
3975  int cmp_int = currRing->OrdSgn;
3976  if ((op < o) || (pLmCmp(set[length].p,p.p)== -cmp_int))
3977    return length+1;
3978  int cmp;
3979  loop
3980  {
3981    if (an >= en-1)
3982    {
3983      op = set[an].GetpFDeg();
3984      if (op > o) return an;
3985      if (op < 0) return en;
3986      cmp = pLmCmp(set[an].p,p.p);
3987      if (cmp == cmp_int)  return an;
3988      if (cmp == -cmp_int) return en;
3989      if (nGreater(pGetCoeff(p.p), pGetCoeff(set[an].p))) return en;
3990      return an;
3991    }
3992    i = (an + en) / 2;
3993    op = set[i].GetpFDeg();
3994    if (op > o)       en = i;
3995    else if (op < o)  an = i;
3996    else
3997    {
3998      cmp = pLmCmp(set[i].p,p.p);
3999      if (cmp == cmp_int)                                     en = i;
4000      else if (cmp == -cmp_int)                               an = i;
4001      else if (nGreater(pGetCoeff(p.p), pGetCoeff(set[i].p))) an = i;
4002      else                                                    en = i;
4003    }
4004  }
4005}
4006/*
4007  int o = p.GetpFDeg();
4008  int op = set[length].GetpFDeg();
4009
4010  if ((op < o)
4011  || ((op == o) && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4012    return length+1;
4013
4014  int i;
4015  int an = 0;
4016  int en= length;
4017
4018  loop
4019  {
4020    if (an >= en-1)
4021    {
4022      op= set[an].GetpFDeg();
4023      if ((op > o)
4024      || (( op == o) && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4025        return an;
4026      return en;
4027    }
4028    i=(an+en) / 2;
4029    op = set[i].GetpFDeg();
4030    if (( op > o)
4031    || (( op == o) && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4032      en=i;
4033    else
4034      an=i;
4035  }
4036}
4037  */
4038/*2
4039* looks up the position of p in T
4040* set[0] is the smallest with respect to the ordering-procedure
4041* totaldegree,pComp
4042*/
4043int posInT110 (const TSet set,const int length,LObject &p)
4044{
4045  p.GetpLength();
4046  if (length==-1) return 0;
4047
4048  int o = p.GetpFDeg();
4049  int op = set[length].GetpFDeg();
4050
4051  if (( op < o)
4052  || (( op == o) && (set[length].length<p.length))
4053  || (( op == o) && (set[length].length == p.length)
4054     && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4055    return length+1;
4056
4057  int i;
4058  int an = 0;
4059  int en= length;
4060  loop
4061  {
4062    if (an >= en-1)
4063    {
4064      op = set[an].GetpFDeg();
4065      if (( op > o)
4066      || (( op == o) && (set[an].length > p.length))
4067      || (( op == o) && (set[an].length == p.length)
4068         && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4069        return an;
4070      return en;
4071    }
4072    i=(an+en) / 2;
4073    op = set[i].GetpFDeg();
4074    if (( op > o)
4075    || (( op == o) && (set[i].length > p.length))
4076    || (( op == o) && (set[i].length == p.length)
4077       && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4078      en=i;
4079    else
4080      an=i;
4081  }
4082}
4083
4084/*2
4085* looks up the position of p in set
4086* set[0] is the smallest with respect to the ordering-procedure
4087* pFDeg
4088*/
4089int posInT13 (const TSet set,const int length,LObject &p)
4090{
4091  if (length==-1) return 0;
4092
4093  int o = p.GetpFDeg();
4094
4095  if (set[length].GetpFDeg() <= o)
4096    return length+1;
4097
4098  int i;
4099  int an = 0;
4100  int en= length;
4101  loop
4102  {
4103    if (an >= en-1)
4104    {
4105      if (set[an].GetpFDeg() > o)
4106        return an;
4107      return en;
4108    }
4109    i=(an+en) / 2;
4110    if (set[i].GetpFDeg() > o)
4111      en=i;
4112    else
4113      an=i;
4114  }
4115}
4116
4117// determines the position based on: 1.) Ecart 2.) pLength
4118int posInT_EcartpLength(const TSet set,const int length,LObject &p)
4119{
4120  int ol = p.GetpLength();
4121  if (length==-1) return 0;
4122
4123  int op=p.ecart;
4124
4125  int oo=set[length].ecart;
4126  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
4127    return length+1;
4128
4129  int i;
4130  int an = 0;
4131  int en= length;
4132  loop
4133    {
4134      if (an >= en-1)
4135      {
4136        int oo=set[an].ecart;
4137        if((oo > op)
4138           || ((oo==op) && (set[an].pLength > ol)))
4139          return an;
4140        return en;
4141      }
4142      i=(an+en) / 2;
4143      int oo=set[i].ecart;
4144      if ((oo > op)
4145          || ((oo == op) && (set[i].pLength > ol)))
4146        en=i;
4147      else
4148        an=i;
4149    }
4150}
4151
4152/*2
4153* looks up the position of p in set
4154* set[0] is the smallest with respect to the ordering-procedure
4155* maximaldegree, pComp
4156*/
4157int posInT15 (const TSet set,const int length,LObject &p)
4158/*{
4159 *int j=0;
4160 * int o;
4161 *
4162 * o = p.GetpFDeg()+p.ecart;
4163 * loop
4164 * {
4165 *   if ((set[j].GetpFDeg()+set[j].ecart > o)
4166 *   || ((set[j].GetpFDeg()+set[j].ecart == o)
4167 *     && (pLmCmp(set[j].p,p.p) == currRing->OrdSgn)))
4168 *   {
4169 *     return j;
4170 *   }
4171 *   j++;
4172 *   if (j > length) return j;
4173 * }
4174 *}
4175 */
4176{
4177  if (length==-1) return 0;
4178
4179  int o = p.GetpFDeg() + p.ecart;
4180  int op = set[length].GetpFDeg()+set[length].ecart;
4181
4182  if ((op < o)
4183  || ((op == o)
4184     && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4185    return length+1;
4186
4187  int i;
4188  int an = 0;
4189  int en= length;
4190  loop
4191  {
4192    if (an >= en-1)
4193    {
4194      op = set[an].GetpFDeg()+set[an].ecart;
4195      if (( op > o)
4196      || (( op  == o) && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4197        return an;
4198      return en;
4199    }
4200    i=(an+en) / 2;
4201    op = set[i].GetpFDeg()+set[i].ecart;
4202    if (( op > o)
4203    || (( op == o) && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4204      en=i;
4205    else
4206      an=i;
4207  }
4208}
4209
4210/*2
4211* looks up the position of p in set
4212* set[0] is the smallest with respect to the ordering-procedure
4213* pFDeg+ecart, ecart, pComp
4214*/
4215int posInT17 (const TSet set,const int length,LObject &p)
4216/*
4217*{
4218* int j=0;
4219* int  o;
4220*
4221*  o = p.GetpFDeg()+p.ecart;
4222*  loop
4223*  {
4224*    if ((pFDeg(set[j].p)+set[j].ecart > o)
4225*    || (((pFDeg(set[j].p)+set[j].ecart == o)
4226*      && (set[j].ecart < p.ecart)))
4227*    || ((pFDeg(set[j].p)+set[j].ecart == o)
4228*      && (set[j].ecart==p.ecart)
4229*      && (pLmCmp(set[j].p,p.p)==currRing->OrdSgn)))
4230*      return j;
4231*    j++;
4232*    if (j > length) return j;
4233*  }
4234* }
4235*/
4236{
4237  if (length==-1) return 0;
4238
4239  int o = p.GetpFDeg() + p.ecart;
4240  int op = set[length].GetpFDeg()+set[length].ecart;
4241
4242  if ((op < o)
4243  || (( op == o) && (set[length].ecart > p.ecart))
4244  || (( op == o) && (set[length].ecart==p.ecart)
4245     && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4246    return length+1;
4247
4248  int i;
4249  int an = 0;
4250  int en= length;
4251  loop
4252  {
4253    if (an >= en-1)
4254    {
4255      op = set[an].GetpFDeg()+set[an].ecart;
4256      if (( op > o)
4257      || (( op == o) && (set[an].ecart < p.ecart))
4258      || (( op  == o) && (set[an].ecart==p.ecart)
4259         && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4260        return an;
4261      return en;
4262    }
4263    i=(an+en) / 2;
4264    op = set[i].GetpFDeg()+set[i].ecart;
4265    if ((op > o)
4266    || (( op == o) && (set[i].ecart < p.ecart))
4267    || (( op == o) && (set[i].ecart == p.ecart)
4268       && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4269      en=i;
4270    else
4271      an=i;
4272  }
4273}
4274/*2
4275* looks up the position of p in set
4276* set[0] is the smallest with respect to the ordering-procedure
4277* pGetComp, pFDeg+ecart, ecart, pComp
4278*/
4279int posInT17_c (const TSet set,const int length,LObject &p)
4280{
4281  if (length==-1) return 0;
4282
4283  int cc = (-1+2*currRing->order[0]==ringorder_c);
4284  /* cc==1 for (c,..), cc==-1 for (C,..) */
4285  int o = p.GetpFDeg() + p.ecart;
4286  unsigned long c = pGetComp(p.p)*cc;
4287
4288  if (pGetComp(set[length].p)*cc < c)
4289    return length+1;
4290  if (pGetComp(set[length].p)*cc == c)
4291  {
4292    int op = set[length].GetpFDeg()+set[length].ecart;
4293    if ((op < o)
4294    || ((op == o) && (set[length].ecart > p.ecart))
4295    || ((op == o) && (set[length].ecart==p.ecart)
4296       && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4297      return length+1;
4298  }
4299
4300  int i;
4301  int an = 0;
4302  int en= length;
4303  loop
4304  {
4305    if (an >= en-1)
4306    {
4307      if (pGetComp(set[an].p)*cc < c)
4308        return en;
4309      if (pGetComp(set[an].p)*cc == c)
4310      {
4311        int op = set[an].GetpFDeg()+set[an].ecart;
4312        if ((op > o)
4313        || ((op == o) && (set[an].ecart < p.ecart))
4314        || ((op == o) && (set[an].ecart==p.ecart)
4315           && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4316          return an;
4317      }
4318      return en;
4319    }
4320    i=(an+en) / 2;
4321    if (pGetComp(set[i].p)*cc > c)
4322      en=i;
4323    else if (pGetComp(set[i].p)*cc == c)
4324    {
4325      int op = set[i].GetpFDeg()+set[i].ecart;
4326      if ((op > o)
4327      || ((op == o) && (set[i].ecart < p.ecart))
4328      || ((op == o) && (set[i].ecart == p.ecart)
4329         && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4330        en=i;
4331      else
4332        an=i;
4333    }
4334    else
4335      an=i;
4336  }
4337}
4338
4339/*2
4340* looks up the position of p in set
4341* set[0] is the smallest with respect to
4342* ecart, pFDeg, length
4343*/
4344int posInT19 (const TSet set,const int length,LObject &p)
4345{
4346  p.GetpLength();
4347  if (length==-1) return 0;
4348
4349  int o = p.ecart;
4350  int op=p.GetpFDeg();
4351
4352  if (set[length].ecart < o)
4353    return length+1;
4354  if (set[length].ecart == o)
4355  {
4356     int oo=set[length].GetpFDeg();
4357     if ((oo < op) || ((oo==op) && (set[length].length < p.length)))
4358       return length+1;
4359  }
4360
4361  int i;
4362  int an = 0;
4363  int en= length;
4364  loop
4365  {
4366    if (an >= en-1)
4367    {
4368      if (set[an].ecart > o)
4369        return an;
4370      if (set[an].ecart == o)
4371      {
4372         int oo=set[an].GetpFDeg();
4373         if((oo > op)
4374         || ((oo==op) && (set[an].length > p.length)))
4375           return an;
4376      }
4377      return en;
4378    }
4379    i=(an+en) / 2;
4380    if (set[i].ecart > o)
4381      en=i;
4382    else if (set[i].ecart == o)
4383    {
4384       int oo=set[i].GetpFDeg();
4385       if ((oo > op)
4386       || ((oo == op) && (set[i].length > p.length)))
4387         en=i;
4388       else
4389        an=i;
4390    }
4391    else
4392      an=i;
4393  }
4394}
4395
4396/*2
4397*looks up the position of polynomial p in set
4398*set[length] is the smallest element in set with respect
4399*to the ordering-procedure pComp
4400*/
4401int posInLSpecial (const LSet set, const int length,
4402                   LObject *p,const kStrategy)
4403{
4404  if (length<0) return 0;
4405
4406  int d=p->GetpFDeg();
4407  int op=set[length].GetpFDeg();
4408
4409  if ((op > d)
4410  || ((op == d) && (p->p1!=NULL)&&(set[length].p1==NULL))
4411  || (pLmCmp(set[length].p,p->p)== currRing->OrdSgn))
4412     return length+1;
4413
4414  int i;
4415  int an = 0;
4416  int en= length;
4417  loop
4418  {
4419    if (an >= en-1)
4420    {
4421      op=set[an].GetpFDeg();
4422      if ((op > d)
4423      || ((op == d) && (p->p1!=NULL) && (set[an].p1==NULL))
4424      || (pLmCmp(set[an].p,p->p)== currRing->OrdSgn))
4425         return en;
4426      return an;
4427    }
4428    i=(an+en) / 2;
4429    op=set[i].GetpFDeg();
4430    if ((op>d)
4431    || ((op==d) && (p->p1!=NULL) && (set[i].p1==NULL))
4432    || (pLmCmp(set[i].p,p->p) == currRing->OrdSgn))
4433      an=i;
4434    else
4435      en=i;
4436  }
4437}
4438
4439/*2
4440*looks up the position of polynomial p in set
4441*set[length] is the smallest element in set with respect
4442*to the ordering-procedure pComp
4443*/
4444int posInL0 (const LSet set, const int length,
4445             LObject* p,const kStrategy)
4446{
4447  if (length<0) return 0;
4448
4449  if (pLmCmp(set[length].p,p->p)== currRing->OrdSgn)
4450    return length+1;
4451
4452  int i;
4453  int an = 0;
4454  int en= length;
4455  loop
4456  {
4457    if (an >= en-1)
4458    {
4459      if (pLmCmp(set[an].p,p->p) == currRing->OrdSgn) return en;
4460      return an;
4461    }
4462    i=(an+en) / 2;
4463    if (pLmCmp(set[i].p,p->p) == currRing->OrdSgn) an=i;
4464    else                                 en=i;
4465    /*aend. fuer lazy == in !=- machen */
4466  }
4467}
4468
4469/*2
4470* looks up the position of polynomial p in set
4471* e is the ecart of p
4472* set[length] is the smallest element in set with respect
4473* to the signature order
4474*/
4475int posInLSig (const LSet set, const int length,
4476            LObject* p,const kStrategy strat)
4477{
4478if (length<0) return 0;
4479if (pLmCmp(set[length].sig,p->sig)== currRing->OrdSgn)
4480  return length+1;
4481
4482int i;
4483int an = 0;
4484int en= length;
4485loop
4486{
4487  if (an >= en-1)
4488  {
4489    if (pLmCmp(set[an].sig,p->sig) == currRing->OrdSgn) return en;
4490    return an;
4491  }
4492  i=(an+en) / 2;
4493  if (pLmCmp(set[i].sig,p->sig) == currRing->OrdSgn) an=i;
4494  else                                      en=i;
4495  /*aend. fuer lazy == in !=- machen */
4496}
4497}
4498
4499/*2
4500*
4501* is only used in F5C, must ensure that the interreduction process does add new
4502* critical pairs to strat->L only behind all other critical pairs which are
4503* still in strat->L!
4504*/
4505int posInLF5C (const LSet set, const int length,
4506            LObject* p,const kStrategy strat)
4507{
4508  return strat->Ll+1;
4509}
4510
4511/*2
4512* looks up the position of polynomial p in set
4513* e is the ecart of p
4514* set[length] is the smallest element in set with respect
4515* to the ordering-procedure totaldegree,pComp
4516*/
4517int posInL11 (const LSet set, const int length,
4518              LObject* p,const kStrategy)
4519/*{
4520 * int j=0;
4521 * int o;
4522 *
4523 * o = p->GetpFDeg();
4524 * loop
4525 * {
4526 *   if (j > length)            return j;
4527 *   if ((set[j].GetpFDeg() < o)) return j;
4528 *   if ((set[j].GetpFDeg() == o) && (pLmCmp(set[j].p,p->p) == -currRing->OrdSgn))
4529 *   {
4530 *     return j;
4531 *   }
4532 *   j++;
4533 * }
4534 *}
4535 */
4536{
4537  if (length<0) return 0;
4538
4539  int o = p->GetpFDeg();
4540  int op = set[length].GetpFDeg();
4541
4542  if ((op > o)
4543  || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4544    return length+1;
4545  int i;
4546  int an = 0;
4547  int en= length;
4548  loop
4549  {
4550    if (an >= en-1)
4551    {
4552      op = set[an].GetpFDeg();
4553      if ((op > o)
4554      || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4555        return en;
4556      return an;
4557    }
4558    i=(an+en) / 2;
4559    op = set[i].GetpFDeg();
4560    if ((op > o)
4561    || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4562      an=i;
4563    else
4564      en=i;
4565  }
4566}
4567
4568/*2 Position for rings L: Here I am
4569* looks up the position of polynomial p in set
4570* e is the ecart of p
4571* set[length] is the smallest element in set with respect
4572* to the ordering-procedure totaldegree,pComp
4573*/
4574inline int getIndexRng(long coeff)
4575{
4576  if (coeff == 0) return -1;
4577  long tmp = coeff;
4578  int ind = 0;
4579  while (tmp % 2 == 0)
4580  {
4581    tmp = tmp / 2;
4582    ind++;
4583  }
4584  return ind;
4585}
4586
4587int posInLrg0 (const LSet set, const int length,
4588              LObject* p,const kStrategy)
4589/*          if (nGreater(pGetCoeff(p), pGetCoeff(set[an]))) return en;
4590        if (pLmCmp(set[i],p) == cmp_int)         en = i;
4591        else if (pLmCmp(set[i],p) == -cmp_int)   an = i;
4592        else
4593        {
4594          if (nGreater(pGetCoeff(p), pGetCoeff(set[i]))) an = i;
4595          else en = i;
4596        }*/
4597{
4598  if (length < 0) return 0;
4599
4600  int o = p->GetpFDeg();
4601  int op = set[length].GetpFDeg();
4602
4603  if ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4604    return length + 1;
4605  int i;
4606  int an = 0;
4607  int en = length;
4608  loop
4609  {
4610    if (an >= en - 1)
4611    {
4612      op = set[an].GetpFDeg();
4613      if ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4614        return en;
4615      return an;
4616    }
4617    i = (an+en) / 2;
4618    op = set[i].GetpFDeg();
4619    if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4620      an = i;
4621    else
4622      en = i;
4623  }
4624}
4625
4626/*{
4627  if (length < 0) return 0;
4628
4629  int o = p->GetpFDeg();
4630  int op = set[length].GetpFDeg();
4631
4632  int inde = getIndexRng((unsigned long) pGetCoeff(set[length].p));
4633  int indp = getIndexRng((unsigned long) pGetCoeff(p->p));
4634  int inda;
4635  int indi;
4636
4637  if ((inda > indp) || ((inda == inde) && ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))))
4638    return length + 1;
4639  int i;
4640  int an = 0;
4641  inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
4642  int en = length;
4643  loop
4644  {
4645    if (an >= en-1)
4646    {
4647      op = set[an].GetpFDeg();
4648      if ((indp > inda) || ((indp == inda) && ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))))
4649        return en;
4650      return an;
4651    }
4652    i = (an + en) / 2;
4653    indi = getIndexRng((unsigned long) pGetCoeff(set[i].p));
4654    op = set[i].GetpFDeg();
4655    if ((indi > indp) || ((indi == indp) && ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))))
4656    // if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4657    {
4658      an = i;
4659      inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
4660    }
4661    else
4662      en = i;
4663  }
4664} */
4665
4666/*2
4667* looks up the position of polynomial p in set
4668* set[length] is the smallest element in set with respect
4669* to the ordering-procedure totaldegree,pLength0
4670*/
4671int posInL110 (const LSet set, const int length,
4672               LObject* p,const kStrategy)
4673{
4674  if (length<0) return 0;
4675
4676  int o = p->GetpFDeg();
4677  int op = set[length].GetpFDeg();
4678
4679  if ((op > o)
4680  || ((op == o) && (set[length].length >p->length))
4681  || ((op == o) && (set[length].length <= p->length)
4682     && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4683    return length+1;
4684  int i;
4685  int an = 0;
4686  int en= length;
4687  loop
4688  {
4689    if (an >= en-1)
4690    {
4691      op = set[an].GetpFDeg();
4692      if ((op > o)
4693      || ((op == o) && (set[an].length >p->length))
4694      || ((op == o) && (set[an].length <=p->length)
4695         && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4696        return en;
4697      return an;
4698    }
4699    i=(an+en) / 2;
4700    op = set[i].GetpFDeg();
4701    if ((op > o)
4702    || ((op == o) && (set[i].length > p->length))
4703    || ((op == o) && (set[i].length <= p->length)
4704       && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4705      an=i;
4706    else
4707      en=i;
4708  }
4709}
4710
4711/*2
4712* looks up the position of polynomial p in set
4713* e is the ecart of p
4714* set[length] is the smallest element in set with respect
4715* to the ordering-procedure totaldegree
4716*/
4717int posInL13 (const LSet set, const int length,
4718              LObject* p,const kStrategy)
4719{
4720  if (length<0) return 0;
4721
4722  int o = p->GetpFDeg();
4723
4724  if (set[length].GetpFDeg() > o)
4725    return length+1;
4726
4727  int i;
4728  int an = 0;
4729  int en= length;
4730  loop
4731  {
4732    if (an >= en-1)
4733    {
4734      if (set[an].GetpFDeg() >= o)
4735        return en;
4736      return an;
4737    }
4738    i=(an+en) / 2;
4739    if (set[i].GetpFDeg() >= o)
4740      an=i;
4741    else
4742      en=i;
4743  }
4744}
4745
4746/*2
4747* looks up the position of polynomial p in set
4748* e is the ecart of p
4749* set[length] is the smallest element in set with respect
4750* to the ordering-procedure maximaldegree,pComp
4751*/
4752int posInL15 (const LSet set, const int length,
4753              LObject* p,const kStrategy)
4754/*{
4755 * int j=0;
4756 * int o;
4757 *
4758 * o = p->ecart+p->GetpFDeg();
4759 * loop
4760 * {
4761 *   if (j > length)                       return j;
4762 *   if (set[j].GetpFDeg()+set[j].ecart < o) return j;
4763 *   if ((set[j].GetpFDeg()+set[j].ecart == o)
4764 *   && (pLmCmp(set[j].p,p->p) == -currRing->OrdSgn))
4765 *   {
4766 *     return j;
4767 *   }
4768 *   j++;
4769 * }
4770 *}
4771 */
4772{
4773  if (length<0) return 0;
4774
4775  int o = p->GetpFDeg() + p->ecart;
4776  int op = set[length].GetpFDeg() + set[length].ecart;
4777
4778  if ((op > o)
4779  || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4780    return length+1;
4781  int i;
4782  int an = 0;
4783  int en= length;
4784  loop
4785  {
4786    if (an >= en-1)
4787    {
4788      op = set[an].GetpFDeg() + set[an].ecart;
4789      if ((op > o)
4790      || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4791        return en;
4792      return an;
4793    }
4794    i=(an+en) / 2;
4795    op = set[i].GetpFDeg() + set[i].ecart;
4796    if ((op > o)
4797    || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4798      an=i;
4799    else
4800      en=i;
4801  }
4802}
4803
4804/*2
4805* looks up the position of polynomial p in set
4806* e is the ecart of p
4807* set[length] is the smallest element in set with respect
4808* to the ordering-procedure totaldegree
4809*/
4810int posInL17 (const LSet set, const int length,
4811              LObject* p,const kStrategy)
4812{
4813  if (length<0) return 0;
4814
4815  int o = p->GetpFDeg() + p->ecart;
4816
4817  if ((set[length].GetpFDeg() + set[length].ecart > o)
4818  || ((set[length].GetpFDeg() + set[length].ecart == o)
4819     && (set[length].ecart > p->ecart))
4820  || ((set[length].GetpFDeg() + set[length].ecart == o)
4821     && (set[length].ecart == p->ecart)
4822     && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4823    return length+1;
4824  int i;
4825  int an = 0;
4826  int en= length;
4827  loop
4828  {
4829    if (an >= en-1)
4830    {
4831      if ((set[an].GetpFDeg() + set[an].ecart > o)
4832      || ((set[an].GetpFDeg() + set[an].ecart == o)
4833         && (set[an].ecart > p->ecart))
4834      || ((set[an].GetpFDeg() + set[an].ecart == o)
4835         && (set[an].ecart == p->ecart)
4836         && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4837        return en;
4838      return an;
4839    }
4840    i=(an+en) / 2;
4841    if ((set[i].GetpFDeg() + set[i].ecart > o)
4842    || ((set[i].GetpFDeg() + set[i].ecart == o)
4843       && (set[i].ecart > p->ecart))
4844    || ((set[i].GetpFDeg() +set[i].ecart == o)
4845       && (set[i].ecart == p->ecart)
4846       && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4847      an=i;
4848    else
4849      en=i;
4850  }
4851}
4852/*2
4853* looks up the position of polynomial p in set
4854* e is the ecart of p
4855* set[length] is the smallest element in set with respect
4856* to the ordering-procedure pComp
4857*/
4858int posInL17_c (const LSet set, const int length,
4859                LObject* p,const kStrategy)
4860{
4861  if (length<0) return 0;
4862
4863  int cc = (-1+2*currRing->order[0]==ringorder_c);
4864  /* cc==1 for (c,..), cc==-1 for (C,..) */
4865  unsigned long c = pGetComp(p->p)*cc;
4866  int o = p->GetpFDeg() + p->ecart;
4867
4868  if (pGetComp(set[length].p)*cc > c)
4869    return length+1;
4870  if (pGetComp(set[length].p)*cc == c)
4871  {
4872    if ((set[length].GetpFDeg() + set[length].ecart > o)
4873    || ((set[length].GetpFDeg() + set[length].ecart == o)
4874       && (set[length].ecart > p->ecart))
4875    || ((set[length].GetpFDeg() + set[length].ecart == o)
4876       && (set[length].ecart == p->ecart)
4877       && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4878      return length+1;
4879  }
4880  int i;
4881  int an = 0;
4882  int en= length;
4883  loop
4884  {
4885    if (an >= en-1)
4886    {
4887      if (pGetComp(set[an].p)*cc > c)
4888        return en;
4889      if (pGetComp(set[an].p)*cc == c)
4890      {
4891        if ((set[an].GetpFDeg() + set[an].ecart > o)
4892        || ((set[an].GetpFDeg() + set[an].ecart == o)
4893           && (set[an].ecart > p->ecart))
4894        || ((set[an].GetpFDeg() + set[an].ecart == o)
4895           && (set[an].ecart == p->ecart)
4896           && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4897          return en;
4898      }
4899      return an;
4900    }
4901    i=(an+en) / 2;
4902    if (pGetComp(set[i].p)*cc > c)
4903      an=i;
4904    else if (pGetComp(set[i].p)*cc == c)
4905    {
4906      if ((set[i].GetpFDeg() + set[i].ecart > o)
4907      || ((set[i].GetpFDeg() + set[i].ecart == o)
4908         && (set[i].ecart > p->ecart))
4909      || ((set[i].GetpFDeg() +set[i].ecart == o)
4910         && (set[i].ecart == p->ecart)
4911         && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4912        an=i;
4913      else
4914        en=i;
4915    }
4916    else
4917      en=i;
4918  }
4919}
4920
4921/*
4922 * SYZYGY CRITERION for signature-based standard basis algorithms
4923 */
4924BOOLEAN syzCriterion(poly sig, unsigned long not_sevSig, kStrategy strat)
4925{
4926//#if 1
4927#ifdef DEBUGF5
4928  Print("syzygy criterion checks:  ");
4929  pWrite(sig);
4930#endif
4931  for (int k=0; k<strat->syzl; k++)
4932  {
4933//#if 1
4934#ifdef DEBUGF5
4935    Print("checking with: %d --  ",k);
4936    pWrite(pHead(strat->syz[k]));
4937#endif
4938    if (p_LmShortDivisibleBy(strat->syz[k], strat->sevSyz[k], sig, not_sevSig, currRing))
4939    {
4940//#if 1
4941#ifdef DEBUGF5
4942      printf("DELETE!\n");
4943#endif
4944      return TRUE;
4945    }
4946  }
4947  return FALSE;
4948}
4949
4950/*
4951 * SYZYGY CRITERION for signature-based standard basis algorithms
4952 */
4953BOOLEAN syzCriterionInc(poly sig, unsigned long not_sevSig, kStrategy strat)
4954{
4955//#if 1
4956#ifdef DEBUGF5
4957  Print("syzygy criterion checks:  ");
4958  pWrite(sig);
4959#endif
4960  int comp = p_GetComp(sig, currRing);
4961  int min, max;
4962  if (comp<=1)
4963    return FALSE;
4964  else
4965  {
4966    min = strat->syzIdx[comp-2];
4967    //printf("SYZIDX %d/%d\n",strat->syzIdx[comp-2],comp-2);
4968    //printf("SYZIDX %d/%d\n",strat->syzIdx[comp-1],comp-1);
4969    //printf("SYZIDX %d/%d\n",strat->syzIdx[comp],comp);
4970    if (comp == strat->currIdx)
4971    {
4972      max = strat->syzl;
4973    }
4974    else
4975    {
4976      max = strat->syzIdx[comp-1];
4977    }
4978    for (int k=min; k<max; k++)
4979    {
4980#ifdef DEBUGF5
4981      printf("COMP %d/%d - MIN %d - MAX %d - SYZL %ld\n",comp,strat->currIdx,min,max,strat->syzl);
4982      Print("checking with: %d --  ",k);
4983      pWrite(pHead(strat->syz[k]));
4984#endif
4985      if (p_LmShortDivisibleBy(strat->syz[k], strat->sevSyz[k], sig, not_sevSig, currRing))
4986        return TRUE;
4987    }
4988    return FALSE;
4989  }
4990}
4991
4992/*
4993 * REWRITTEN CRITERION for signature-based standard basis algorithms
4994 */
4995BOOLEAN faugereRewCriterion(poly sig, unsigned long not_sevSig, kStrategy strat, int start=0)
4996{
4997  //printf("Faugere Rewritten Criterion\n");
4998//#if 1
4999#ifdef DEBUGF5
5000  printf("rewritten criterion checks:  ");
5001  pWrite(sig);
5002#endif
5003  //for(int k = start; k<strat->sl+1; k++)
5004  for(int k = strat->sl; k>start; k--)
5005  {
5006//#if 1
5007#ifdef DEBUGF5
5008    Print("checking with:  ");
5009    pWrite(strat->sig[k]);
5010    pWrite(pHead(strat->S[k]));
5011#endif
5012    if (p_LmShortDivisibleBy(strat->sig[k], strat->sevSig[k], sig, not_sevSig, currRing))
5013    //if (p_LmEqual(strat->sig[k], sig, currRing))
5014    {
5015//#if 1
5016#ifdef DEBUGF5
5017      printf("DELETE!\n");
5018#endif
5019      return TRUE;
5020    }
5021  }
5022#ifdef DEBUGF5
5023  Print("ALL ELEMENTS OF S\n----------------------------------------\n");
5024  for(int kk = 0; kk<strat->sl+1; kk++)
5025  {
5026    pWrite(pHead(strat->S[kk]));
5027  }
5028  Print("------------------------------\n");
5029#endif
5030  return FALSE;
5031}
5032
5033/*
5034 * REWRITTEN CRITERION for signature-based standard basis algorithms
5035 ***************************************************************************
5036 * TODO:This should become the version of Arri/Perry resp. Bjarke/Stillman *
5037 ***************************************************************************
5038 */
5039
5040// real implementation of arri's rewritten criterion, only called once in
5041// kstd2.cc, right before starting reduction
5042// IDEA:  Arri says that it is enough to consider 1 polynomial for each unique
5043//        signature appearing during the computations. Thus we first of all go
5044//        through strat->L and delete all other pairs of the same signature,
5045//        keeping only the one with least possible leading monomial. After this
5046//        we check if we really need to compute this critical pair at all: There
5047//        can be elements already in strat->S whose signatures divide the
5048//        signature of the critical pair in question and whose multiplied
5049//        leading monomials are smaller than the leading monomial of the
5050//        critical pair. In this situation we can discard the critical pair
5051//        completely.
5052BOOLEAN arriRewCriterion(poly sig, unsigned long /*not_sevSig*/, kStrategy strat, int start=0)
5053{
5054  //printf("Arri Rewritten Criterion\n");
5055  while (strat->Ll > 0 && pLmEqual(strat->L[strat->Ll].sig,strat->P.sig))
5056  {
5057    // deletes the short spoly
5058#ifdef HAVE_RINGS
5059    if (rField_is_Ring(currRing))
5060      pLmDelete(strat->L[strat->Ll].p);
5061    else
5062#endif
5063      pLmFree(strat->L[strat->Ll].p);
5064
5065    // TODO: needs some masking
5066    // TODO: masking needs to vanish once the signature
5067    //       sutff is completely implemented
5068    strat->L[strat->Ll].p = NULL;
5069    poly m1 = NULL, m2 = NULL;
5070
5071    // check that spoly creation is ok
5072    while (strat->tailRing != currRing &&
5073          !kCheckSpolyCreation(&(strat->L[strat->Ll]), strat, m1, m2))
5074    {
5075      assume(m1 == NULL && m2 == NULL);
5076      // if not, change to a ring where exponents are at least
5077      // large enough
5078      if (!kStratChangeTailRing(strat))
5079      {
5080        WerrorS("OVERFLOW...");
5081        break;
5082      }
5083    }
5084    // create the real one
5085    ksCreateSpoly(&(strat->L[strat->Ll]), NULL, strat->use_buckets,
5086                  strat->tailRing, m1, m2, strat->R);
5087    if (strat->P.GetLmCurrRing() == NULL)
5088    {
5089      deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
5090    }
5091    if (strat->L[strat->Ll].GetLmCurrRing() == NULL)
5092    {
5093      strat->P.Delete();
5094      strat->P = strat->L[strat->Ll];
5095      strat->Ll--;
5096    }
5097
5098    if (strat->P.GetLmCurrRing() != NULL && strat->L[strat->Ll].GetLmCurrRing() != NULL)
5099    {
5100      if (pLmCmp(strat->P.GetLmCurrRing(),strat->L[strat->Ll].GetLmCurrRing()) == -1)
5101      {
5102        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
5103      }
5104      else
5105      {
5106        strat->P.Delete();
5107        strat->P = strat->L[strat->Ll];
5108        strat->Ll--;
5109      }
5110    }
5111  }
5112  for (int ii=strat->sl; ii>-1; ii--)
5113  {
5114    if (p_LmShortDivisibleBy(strat->sig[ii], strat->sevSig[ii], strat->P.sig, ~strat->P.sevSig, currRing))
5115    {
5116      if (!(pLmCmp(ppMult_mm(strat->P.sig,pHead(strat->S[ii])),ppMult_mm(strat->sig[ii],strat->P.GetLmCurrRing())) == 1))
5117      {
5118        strat->P.Delete();
5119        return TRUE;
5120      }
5121    }
5122  }
5123  return FALSE;
5124}
5125
5126/***************************************************************
5127 *
5128 * Tail reductions
5129 *
5130 ***************************************************************/
5131TObject*
5132kFindDivisibleByInS(kStrategy strat, int pos, LObject* L, TObject *T,
5133                    long ecart)
5134{
5135  int j = 0;
5136  const unsigned long not_sev = ~L->sev;
5137  const unsigned long* sev = strat->sevS;
5138  poly p;
5139  ring r;
5140  L->GetLm(p, r);
5141
5142  assume(~not_sev == p_GetShortExpVector(p, r));
5143
5144  if (r == currRing)
5145  {
5146    loop
5147    {
5148      if (j > pos) return NULL;
5149#if defined(PDEBUG) || defined(PDIV_DEBUG)
5150      if (p_LmShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
5151          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
5152        break;
5153#else
5154      if (!(sev[j] & not_sev) &&
5155          (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
5156          p_LmDivisibleBy(strat->S[j], p, r))
5157        break;
5158
5159#endif
5160      j++;
5161    }
5162    // if called from NF, T objects do not exist:
5163    if (strat->tl < 0 || strat->S_2_R[j] == -1)
5164    {
5165      T->Set(strat->S[j], r, strat->tailRing);
5166      return T;
5167    }
5168    else
5169    {
5170/////      assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL
5171/////      && strat->S_2_T(j)->p == strat->S[j]); // wrong?
5172//      assume (j >= 0 && j <= strat->sl && strat->S_2_T(j) != NULL && strat->S_2_T(j)->p == strat->S[j]);
5173      return strat->S_2_T(j);
5174    }
5175  }
5176  else
5177  {
5178    TObject* t;
5179    loop
5180    {
5181      if (j > pos) return NULL;
5182      assume(strat->S_2_R[j] != -1);
5183#if defined(PDEBUG) || defined(PDIV_DEBUG)
5184      t = strat->S_2_T(j);
5185      assume(t != NULL && t->t_p != NULL && t->tailRing == r);
5186      if (p_LmShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
5187          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
5188        return t;
5189#else
5190      if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
5191      {
5192        t = strat->S_2_T(j);
5193        assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
5194        if (p_LmDivisibleBy(t->t_p, p, r)) return t;
5195      }
5196#endif
5197      j++;
5198    }
5199  }
5200}
5201
5202poly redtail (LObject* L, int pos, kStrategy strat)
5203{
5204  poly h, hn;
5205  strat->redTailChange=FALSE;
5206
5207  poly p = L->p;
5208  if (strat->noTailReduction || pNext(p) == NULL)
5209    return p;
5210
5211  LObject Ln(strat->tailRing);
5212  TObject* With;
5213  // placeholder in case strat->tl < 0
5214  TObject  With_s(strat->tailRing);
5215  h = p;
5216  hn = pNext(h);
5217  long op = strat->tailRing->pFDeg(hn, strat->tailRing);
5218  long e;
5219  int l;
5220  BOOLEAN save_HE=strat->kHEdgeFound;
5221  strat->kHEdgeFound |=
5222    ((Kstd1_deg>0) && (op<=Kstd1_deg)) || TEST_OPT_INFREDTAIL;
5223
5224  while(hn != NULL)
5225  {
5226    op = strat->tailRing->pFDeg(hn, strat->tailRing);
5227    if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
5228    e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
5229    loop
5230    {
5231      Ln.Set(hn, strat->tailRing);
5232      Ln.sev = p_GetShortExpVector(hn, strat->tailRing);
5233      if (strat->kHEdgeFound)
5234        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
5235      else
5236        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s, e);
5237      if (With == NULL) break;
5238      With->length=0;
5239      With->pLength=0;
5240      strat->redTailChange=TRUE;
5241      if (ksReducePolyTail(L, With, h, strat->kNoetherTail()))
5242      {
5243        // reducing the tail would violate the exp bound
5244        if (kStratChangeTailRing(strat, L))
5245        {
5246          strat->kHEdgeFound = save_HE;
5247          return redtail(L, pos, strat);
5248        }
5249        else
5250          return NULL;
5251      }
5252      hn = pNext(h);
5253      if (hn == NULL) goto all_done;
5254      op = strat->tailRing->pFDeg(hn, strat->tailRing);
5255      if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
5256      e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
5257    }
5258    h = hn;
5259    hn = pNext(h);
5260  }
5261
5262  all_done:
5263  if (strat->redTailChange)
5264  {
5265    L->pLength = 0;
5266  }
5267  strat->kHEdgeFound = save_HE;
5268  return p;
5269}
5270
5271poly redtail (poly p, int pos, kStrategy strat)
5272{
5273  LObject L(p, currRing);
5274  return redtail(&L, pos, strat);
5275}
5276
5277poly redtailBba (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
5278{
5279#define REDTAIL_CANONICALIZE 100
5280  strat->redTailChange=FALSE;
5281  if (strat->noTailReduction) return L->GetLmCurrRing();
5282  poly h, p;
5283  p = h = L->GetLmTailRing();
5284  if ((h==NULL) || (pNext(h)==NULL))
5285    return L->GetLmCurrRing();
5286
5287  TObject* With;
5288  // placeholder in case strat->tl < 0
5289  TObject  With_s(strat->tailRing);
5290
5291  LObject Ln(pNext(h), strat->tailRing);
5292  Ln.pLength = L->GetpLength() - 1;
5293
5294  pNext(h) = NULL;
5295  if (L->p != NULL) pNext(L->p) = NULL;
5296  L->pLength = 1;
5297
5298  Ln.PrepareRed(strat->use_buckets);
5299
5300  int cnt=REDTAIL_CANONICALIZE;
5301  while(!Ln.IsNull())
5302  {
5303    loop
5304    {
5305      Ln.SetShortExpVector();
5306      if (withT)
5307      {
5308        int j;
5309        j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
5310        if (j < 0) break;
5311        With = &(strat->T[j]);
5312      }
5313      else
5314      {
5315        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
5316        if (With == NULL) break;
5317      }
5318      cnt--;
5319      if (cnt==0)
5320      {
5321        cnt=REDTAIL_CANONICALIZE;
5322        /*poly tmp=*/Ln.CanonicalizeP();
5323        if (normalize)
5324        {
5325          Ln.Normalize();
5326          //pNormalize(tmp);
5327          //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
5328        }
5329      }
5330      if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
5331      {
5332        With->pNorm();
5333      }
5334      strat->redTailChange=TRUE;
5335      if (ksReducePolyTail(L, With, &Ln))
5336      {
5337        // reducing the tail would violate the exp bound
5338        //  set a flag and hope for a retry (in bba)
5339        strat->completeReduce_retry=TRUE;
5340        if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
5341        do
5342        {
5343          pNext(h) = Ln.LmExtractAndIter();
5344          pIter(h);
5345          L->pLength++;
5346        } while (!Ln.IsNull());
5347        goto all_done;
5348      }
5349      if (Ln.IsNull()) goto all_done;
5350      if (! withT) With_s.Init(currRing);
5351    }
5352    pNext(h) = Ln.LmExtractAndIter();
5353    pIter(h);
5354    pNormalize(h);
5355    L->pLength++;
5356  }
5357
5358  all_done:
5359  Ln.Delete();
5360  if (L->p != NULL) pNext(L->p) = pNext(p);
5361
5362  if (strat->redTailChange)
5363  {
5364    L->length = 0;
5365  }
5366
5367  //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
5368  //L->Normalize(); // HANNES: should have a test
5369  kTest_L(L);
5370  return L->GetLmCurrRing();
5371}
5372
5373#ifdef HAVE_RINGS
5374poly redtailBba_Z (LObject* L, int pos, kStrategy strat )
5375// normalize=FALSE, withT=FALSE, coeff=Z
5376{
5377  strat->redTailChange=FALSE;
5378  if (strat->noTailReduction) return L->GetLmCurrRing();
5379  poly h, p;
5380  p = h = L->GetLmTailRing();
5381  if ((h==NULL) || (pNext(h)==NULL))
5382    return L->GetLmCurrRing();
5383
5384  TObject* With;
5385  // placeholder in case strat->tl < 0
5386  TObject  With_s(strat->tailRing);
5387
5388  LObject Ln(pNext(h), strat->tailRing);
5389  Ln.pLength = L->GetpLength() - 1;
5390
5391  pNext(h) = NULL;
5392  if (L->p != NULL) pNext(L->p) = NULL;
5393  L->pLength = 1;
5394
5395  Ln.PrepareRed(strat->use_buckets);
5396
5397  int cnt=REDTAIL_CANONICALIZE;
5398  while(!Ln.IsNull())
5399  {
5400    loop
5401    {
5402      Ln.SetShortExpVector();
5403      With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
5404      if (With == NULL) break;
5405      cnt--;
5406      if (cnt==0)
5407      {
5408        cnt=REDTAIL_CANONICALIZE;
5409        /*poly tmp=*/Ln.CanonicalizeP();
5410      }
5411      // we are in Z, do not call pNorm
5412      strat->redTailChange=TRUE;
5413      // test divisibility of coefs:
5414      poly p_Ln=Ln.GetLmCurrRing();
5415      poly p_With=With->GetLmCurrRing();
5416      number z=n_IntMod(pGetCoeff(p_Ln),pGetCoeff(p_With), currRing->cf);
5417      if (!nIsZero(z))
5418      {
5419        // subtract z*Ln, add z.Ln to L
5420        poly m=pHead(p_Ln);
5421        pSetCoeff(m,z);
5422        poly mm=pHead(m);
5423        pNext(h) = m;
5424        pIter(h);
5425        L->pLength++;
5426        mm=pNeg(mm);
5427        if (Ln.bucket!=NULL)
5428        {
5429          int dummy=1;
5430          kBucket_Add_q(Ln.bucket,mm,&dummy);
5431        }
5432        else
5433        {
5434          if (Ln.p!=NULL) Ln.p=pAdd(Ln.p,mm);
5435          else if (Ln.t_p!=NULL)  Ln.t_p=p_Add_q(Ln.t_p,mm,strat->tailRing);
5436        }
5437      }
5438      else
5439        nDelete(&z);
5440
5441      if (ksReducePolyTail(L, With, &Ln))
5442      {
5443        // reducing the tail would violate the exp bound
5444        //  set a flag and hope for a retry (in bba)
5445        strat->completeReduce_retry=TRUE;
5446        if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
5447        do
5448        {
5449          pNext(h) = Ln.LmExtractAndIter();
5450          pIter(h);
5451          L->pLength++;
5452        } while (!Ln.IsNull());
5453        goto all_done;
5454      }
5455      if (Ln.IsNull()) goto all_done;
5456      With_s.Init(currRing);
5457    }
5458    pNext(h) = Ln.LmExtractAndIter();
5459    pIter(h);
5460    pNormalize(h);
5461    L->pLength++;
5462  }
5463
5464  all_done:
5465  Ln.Delete();
5466  if (L->p != NULL) pNext(L->p) = pNext(p);
5467
5468  if (strat->redTailChange)
5469  {
5470    L->length = 0;
5471  }
5472
5473  //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
5474  //L->Normalize(); // HANNES: should have a test
5475  kTest_L(L);
5476  return L->GetLmCurrRing();
5477}
5478#endif
5479
5480/*2
5481*checks the change degree and write progress report
5482*/
5483void message (int i,int* reduc,int* olddeg,kStrategy strat, int red_result)
5484{
5485  if (i != *olddeg)
5486  {
5487    Print("%d",i);
5488    *olddeg = i;
5489  }
5490  if (TEST_OPT_OLDSTD)
5491  {
5492    if (strat->Ll != *reduc)
5493    {
5494      if (strat->Ll != *reduc-1)
5495        Print("(%d)",strat->Ll+1);
5496      else
5497        PrintS("-");
5498      *reduc = strat->Ll;
5499    }
5500    else
5501      PrintS(".");
5502    mflush();
5503  }
5504  else
5505  {
5506    if (red_result == 0)
5507      PrintS("-");
5508    else if (red_result < 0)
5509      PrintS(".");
5510    if ((red_result > 0) || ((strat->Ll % 100)==99))
5511    {
5512      if (strat->Ll != *reduc && strat->Ll > 0)
5513      {
5514        Print("(%d)",strat->Ll+1);
5515        *reduc = strat->Ll;
5516      }
5517    }
5518  }
5519}
5520
5521/*2
5522*statistics
5523*/
5524void messageStat (int hilbcount,kStrategy strat)
5525{
5526  //PrintS("\nUsage/Allocation of temporary storage:\n");
5527  //Print("%d/%d polynomials in standard base\n",srmax,IDELEMS(Shdl));
5528  //Print("%d/%d polynomials in set L (for lazy alg.)",lrmax+1,strat->Lmax);
5529  Print("product criterion:%d chain criterion:%d\n",strat->cp,strat->c3);
5530  if (hilbcount!=0) Print("hilbert series criterion:%d\n",hilbcount);
5531  /* in usual case strat->cv is 0, it gets changed only in shift routines */
5532  if (strat->cv!=0) Print("shift V criterion:%d\n",strat->cv);
5533  /*mflush();*/
5534}
5535
5536#ifdef KDEBUG
5537/*2
5538*debugging output: all internal sets, if changed
5539*for testing purpuse only/has to be changed for later use
5540*/
5541void messageSets (kStrategy strat)
5542{
5543  int i;
5544  if (strat->news)
5545  {
5546    PrintS("set S");
5547    for (i=0; i<=strat->sl; i++)
5548    {
5549      Print("\n  %d:",i);
5550      p_wrp(strat->S[i], currRing, strat->tailRing);
5551    }
5552    strat->news = FALSE;
5553  }
5554  if (strat->newt)
5555  {
5556    PrintS("\nset T");
5557    for (i=0; i<=strat->tl; i++)
5558    {
5559      Print("\n  %d:",i);
5560      strat->T[i].wrp();
5561      Print(" o:%ld e:%d l:%d",
5562        strat->T[i].pFDeg(),strat->T[i].ecart,strat->T[i].length);
5563    }
5564    strat->newt = FALSE;
5565  }
5566  PrintS("\nset L");
5567  for (i=strat->Ll; i>=0; i--)
5568  {
5569    Print("\n%d:",i);
5570    p_wrp(strat->L[i].p1, currRing, strat->tailRing);
5571    PrintS("  ");
5572    p_wrp(strat->L[i].p2, currRing, strat->tailRing);
5573    PrintS(" lcm: ");p_wrp(strat->L[i].lcm, currRing);
5574    PrintS("\n  p : ");
5575    strat->L[i].wrp();
5576    Print("  o:%ld e:%d l:%d",
5577          strat->L[i].pFDeg(),strat->L[i].ecart,strat->L[i].length);
5578  }
5579  PrintLn();
5580}
5581
5582#endif
5583
5584
5585/*2
5586*construct the set s from F
5587*/
5588void initS (ideal F, ideal Q, kStrategy strat)
5589{
5590  int   i,pos;
5591
5592  if (Q!=NULL) i=((IDELEMS(F)+IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5593  else         i=((IDELEMS(F)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5594  strat->ecartS=initec(i);
5595  strat->sevS=initsevS(i);
5596  strat->S_2_R=initS_2_R(i);
5597  strat->fromQ=NULL;
5598  strat->Shdl=idInit(i,F->rank);
5599  strat->S=strat->Shdl->m;
5600  /*- put polys into S -*/
5601  if (Q!=NULL)
5602  {
5603    strat->fromQ=initec(i);
5604    memset(strat->fromQ,0,i*sizeof(int));
5605    for (i=0; i<IDELEMS(Q); i++)
5606    {
5607      if (Q->m[i]!=NULL)
5608      {
5609        LObject h;
5610        h.p = pCopy(Q->m[i]);
5611        if (TEST_OPT_INTSTRATEGY)
5612        {
5613          //pContent(h.p);
5614          h.pCleardenom(); // also does a pContent
5615        }
5616        else
5617        {
5618          h.pNorm();
5619        }
5620        if (currRing->OrdSgn==-1)
5621        {
5622          deleteHC(&h, strat);
5623        }
5624        if (h.p!=NULL)
5625        {
5626          strat->initEcart(&h);
5627          if (strat->sl==-1)
5628            pos =0;
5629          else
5630          {
5631            pos = posInS(strat,strat->sl,h.p,h.ecart);
5632          }
5633          h.sev = pGetShortExpVector(h.p);
5634          strat->enterS(h,pos,strat,-1);
5635          strat->fromQ[pos]=1;
5636        }
5637      }
5638    }
5639  }
5640  for (i=0; i<IDELEMS(F); i++)
5641  {
5642    if (F->m[i]!=NULL)
5643    {
5644      LObject h;
5645      h.p = pCopy(F->m[i]);
5646      if (currRing->OrdSgn==-1)
5647      {
5648        cancelunit(&h);  /*- tries to cancel a unit -*/
5649        deleteHC(&h, strat);
5650      }
5651      if (h.p!=NULL)
5652      // do not rely on the input being a SB!
5653      {
5654        if (TEST_OPT_INTSTRATEGY)
5655        {
5656          //pContent(h.p);
5657          h.pCleardenom(); // also does a pContent
5658        }
5659        else
5660        {
5661          h.pNorm();
5662        }
5663        strat->initEcart(&h);
5664        if (strat->sl==-1)
5665          pos =0;
5666        else
5667          pos = posInS(strat,strat->sl,h.p,h.ecart);
5668        h.sev = pGetShortExpVector(h.p);
5669        strat->enterS(h,pos,strat,-1);
5670      }
5671    }
5672  }
5673  /*- test, if a unit is in F -*/
5674  if ((strat->sl>=0)
5675#ifdef HAVE_RINGS
5676       && n_IsUnit(pGetCoeff(strat->S[0]),currRing->cf)
5677#endif
5678       && pIsConstant(strat->S[0]))
5679  {
5680    while (strat->sl>0) deleteInS(strat->sl,strat);
5681  }
5682}
5683
5684void initSL (ideal F, ideal Q,kStrategy strat)
5685{
5686  int   i,pos;
5687
5688  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5689  else i=setmaxT;
5690  strat->ecartS=initec(i);
5691  strat->sevS=initsevS(i);
5692  strat->S_2_R=initS_2_R(i);
5693  strat->fromQ=NULL;
5694  strat->Shdl=idInit(i,F->rank);
5695  strat->S=strat->Shdl->m;
5696  /*- put polys into S -*/
5697  if (Q!=NULL)
5698  {
5699    strat->fromQ=initec(i);
5700    memset(strat->fromQ,0,i*sizeof(int));
5701    for (i=0; i<IDELEMS(Q); i++)
5702    {
5703      if (Q->m[i]!=NULL)
5704      {
5705        LObject h;
5706        h.p = pCopy(Q->m[i]);
5707        if (currRing->OrdSgn==-1)
5708        {
5709          deleteHC(&h,strat);
5710        }
5711        if (TEST_OPT_INTSTRATEGY)
5712        {
5713          //pContent(h.p);
5714          h.pCleardenom(); // also does a pContent
5715        }
5716        else
5717        {
5718          h.pNorm();
5719        }
5720        if (h.p!=NULL)
5721        {
5722          strat->initEcart(&h);
5723          if (strat->sl==-1)
5724            pos =0;
5725          else
5726          {
5727            pos = posInS(strat,strat->sl,h.p,h.ecart);
5728          }
5729          h.sev = pGetShortExpVector(h.p);
5730          strat->enterS(h,pos,strat,-1);
5731          strat->fromQ[pos]=1;
5732        }
5733      }
5734    }
5735  }
5736  for (i=0; i<IDELEMS(F); i++)
5737  {
5738    if (F->m[i]!=NULL)
5739    {
5740      LObject h;
5741      h.p = pCopy(F->m[i]);
5742      if (h.p!=NULL)
5743      {
5744        if (currRing->OrdSgn==-1)
5745        {
5746          cancelunit(&h);  /*- tries to cancel a unit -*/
5747          deleteHC(&h, strat);
5748        }
5749        if (h.p!=NULL)
5750        {
5751          if (TEST_OPT_INTSTRATEGY)
5752          {
5753            //pContent(h.p);
5754            h.pCleardenom(); // also does a pContent
5755          }
5756          else
5757          {
5758            h.pNorm();
5759          }
5760          strat->initEcart(&h);
5761          if (strat->Ll==-1)
5762            pos =0;
5763          else
5764            pos = strat->posInL(strat->L,strat->Ll,&h,strat);
5765          h.sev = pGetShortExpVector(h.p);
5766          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
5767        }
5768      }
5769    }
5770  }
5771  /*- test, if a unit is in F -*/
5772
5773  if ((strat->Ll>=0)
5774#ifdef HAVE_RINGS
5775       && n_IsUnit(pGetCoeff(strat->L[strat->Ll].p), currRing->cf)
5776#endif
5777       && pIsConstant(strat->L[strat->Ll].p))
5778  {
5779    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
5780  }
5781}
5782
5783void initSLSba (ideal F, ideal Q,kStrategy strat)
5784{
5785  int   i,pos;
5786  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5787  else i=setmaxT;
5788  strat->ecartS =   initec(i);
5789  strat->fromS  =   initec(i);
5790  strat->sevS   =   initsevS(i);
5791  strat->sevSig =   initsevS(i);
5792  strat->S_2_R  =   initS_2_R(i);
5793  strat->fromQ  =   NULL;
5794  strat->Shdl   =   idInit(i,F->rank);
5795  strat->S      =   strat->Shdl->m;
5796  strat->sig    =   (poly *)omAlloc0(i*sizeof(poly));
5797  if (!strat->incremental)
5798  {
5799    strat->syz    = (poly *)omAlloc0(i*sizeof(poly));
5800    strat->sevSyz = initsevS(i);
5801    strat->syzmax = i;
5802    strat->syzl   = 0;
5803  }
5804  /*- put polys into S -*/
5805  if (Q!=NULL)
5806  {
5807    strat->fromQ=initec(i);
5808    memset(strat->fromQ,0,i*sizeof(int));
5809    for (i=0; i<IDELEMS(Q); i++)
5810    {
5811      if (Q->m[i]!=NULL)
5812      {
5813        LObject h;
5814        h.p = pCopy(Q->m[i]);
5815        if (currRing->OrdSgn==-1)
5816        {
5817          deleteHC(&h,strat);
5818        }
5819        if (TEST_OPT_INTSTRATEGY)
5820        {
5821          //pContent(h.p);
5822          h.pCleardenom(); // also does a pContent
5823        }
5824        else
5825        {
5826          h.pNorm();
5827        }
5828        if (h.p!=NULL)
5829        {
5830          strat->initEcart(&h);
5831          if (strat->sl==-1)
5832            pos =0;
5833          else
5834          {
5835            pos = posInS(strat,strat->sl,h.p,h.ecart);
5836          }
5837          h.sev = pGetShortExpVector(h.p);
5838          strat->enterS(h,pos,strat,-1);
5839          strat->fromQ[pos]=1;
5840        }
5841      }
5842    }
5843  }
5844  for (i=0; i<IDELEMS(F); i++)
5845  {
5846    if (F->m[i]!=NULL)
5847    {
5848      LObject h;
5849      h.p = pCopy(F->m[i]);
5850      h.sig = pOne();
5851      //h.sig = pInit();
5852      //p_SetCoeff(h.sig,nInit(1),currRing);
5853      p_SetComp(h.sig,i+1,currRing);
5854      // if we are working with the Schreyer order we generate it
5855      // by multiplying the initial signatures with the leading monomial
5856      // of the corresponding initial polynomials generating the ideal
5857      // => we can keep the underlying monomial order and get a Schreyer
5858      //    order without any bigger overhead
5859      if (!strat->incremental)
5860      {
5861        p_ExpVectorAdd (h.sig,F->m[i],currRing); 
5862      }
5863      h.sevSig = pGetShortExpVector(h.sig);
5864#ifdef DEBUGF5
5865      pWrite(h.p);
5866      pWrite(h.sig);
5867#endif
5868      if (h.p!=NULL)
5869      {
5870        if (currRing->OrdSgn==-1)
5871        {
5872          cancelunit(&h);  /*- tries to cancel a unit -*/
5873          deleteHC(&h, strat);
5874        }
5875        if (h.p!=NULL)
5876        {
5877          if (TEST_OPT_INTSTRATEGY)
5878          {
5879            //pContent(h.p);
5880            h.pCleardenom(); // also does a pContent
5881          }
5882          else
5883          {
5884            h.pNorm();
5885          }
5886          strat->initEcart(&h);
5887          if (strat->Ll==-1)
5888            pos =0;
5889          else
5890            pos = strat->posInLSba(strat->L,strat->Ll,&h,strat);
5891          h.sev = pGetShortExpVector(h.p);
5892          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
5893        }
5894      }
5895      /*
5896      if (!strat->incremental)
5897      {
5898        for(j=0;j<i;j++)
5899        {
5900          strat->syz[ctr] = pCopy(F->m[j]);
5901          p_SetCompP(strat->syz[ctr],i+1,currRing);
5902          // add LM(F->m[i]) to the signature to get a Schreyer order
5903          // without changing the underlying polynomial ring at all
5904          p_ExpVectorAdd (strat->syz[ctr],F->m[i],currRing); 
5905          // since p_Add_q() destroys all input
5906          // data we need to recreate help
5907          // each time
5908          poly help = pCopy(F->m[i]);
5909          p_SetCompP(help,j+1,currRing);
5910          pWrite(strat->syz[ctr]);
5911          pWrite(help);
5912          printf("%d\n",pLmCmp(strat->syz[ctr],help));
5913          strat->syz[ctr] = p_Add_q(strat->syz[ctr],help,currRing);
5914          printf("%d. SYZ  ",ctr);
5915          pWrite(strat->syz[ctr]);
5916          strat->sevSyz[ctr] = p_GetShortExpVector(strat->syz[ctr],currRing);
5917          ctr++;
5918        }
5919        strat->syzl = ps;
5920      }
5921      */
5922    }
5923  }
5924  /*- test, if a unit is in F -*/
5925
5926  if ((strat->Ll>=0)
5927#ifdef HAVE_RINGS
5928       && n_IsUnit(pGetCoeff(strat->L[strat->Ll].p), currRing->cf)
5929#endif
5930       && pIsConstant(strat->L[strat->Ll].p))
5931  {
5932    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
5933  }
5934}
5935
5936void initSyzRules (kStrategy strat)
5937{
5938  if( strat->S[0] )
5939  {
5940    if( strat->S[1] )
5941    {
5942      omFreeSize(strat->syzIdx,(strat->syzidxmax)*sizeof(int));
5943      omFreeSize(strat->sevSyz,(strat->syzmax)*sizeof(unsigned long));
5944      omFreeSize(strat->syz,(strat->syzmax)*sizeof(poly));
5945    }
5946    int i, j, k, diff, comp, comp_old, ps=0, ctr=0;
5947    /************************************************************
5948     * computing the length of the syzygy array needed
5949     ***********************************************************/
5950    for(i=1; i<=strat->sl; i++)
5951    {
5952      if (pGetComp(strat->sig[i-1]) != pGetComp(strat->sig[i]))
5953      { 
5954        ps += i;
5955      }
5956    }
5957    ps += strat->sl+1;
5958    //comp              = pGetComp (strat->P.sig);
5959    comp              = strat->currIdx;
5960    strat->syzIdx     = initec(comp);
5961    strat->sevSyz     = initsevS(ps);
5962    strat->syz        = (poly *)omAlloc(ps*sizeof(poly));
5963    strat->syzl       = strat->syzmax = ps;
5964    strat->syzidxmax  = comp;
5965#ifdef DEBUGF5 || DEBUGF51
5966    printf("------------- GENERATING SYZ RULES NEW ---------------\n");
5967#endif
5968    i = 1; 
5969    j = 0;
5970    /************************************************************
5971     * generating the leading terms of the principal syzygies
5972     ***********************************************************/
5973    while (i <= strat->sl)
5974    {
5975      /**********************************************************
5976       * principal syzygies start with component index 2
5977       * the array syzIdx starts with index 0
5978       * => the rules for a signature with component comp start
5979       *    at strat->syz[strat->syzIdx[comp-2]] !
5980       *********************************************************/
5981      if (pGetComp(strat->sig[i-1]) != pGetComp(strat->sig[i]))
5982      {
5983        comp      = pGetComp(strat->sig[i]);
5984        comp_old  = pGetComp(strat->sig[i-1]);
5985        diff      = comp - comp_old - 1;
5986        // diff should be zero, but sometimes also the initial generating
5987        // elements of the input ideal reduce to zero. then there is an
5988        // index-gap between the signatures. for these inbetween signatures we
5989        // can safely set syzIdx[j] = 0 as no such element will be ever computed
5990        // in the following.
5991        // doing this, we keep the relation "j = comp - 2" alive, which makes
5992        // jumps way easier when checking criteria
5993        while (diff>0)
5994        {
5995          strat->syzIdx[j]  = 0;
5996          diff--;
5997          j++;
5998        }
5999        strat->syzIdx[j]  = ctr;
6000        j++;
6001        for (k = 0; k<i; k++)
6002        {
6003          poly p          = pOne();
6004          pLcm(strat->S[k],strat->S[i],p);
6005          strat->syz[ctr] = p;
6006          p_SetCompP (strat->syz[ctr], comp, currRing);
6007          poly q          = p_Copy(p, currRing);
6008          q               = p_Neg (q, currRing);
6009          p_SetCompP (q, p_GetComp(strat->sig[k], currRing), currRing);
6010          strat->syz[ctr] = p_Add_q (strat->syz[ctr], q, currRing);
6011#if defined(DEBUGF5) || defined(DEBUGF51)
6012          pWrite(strat->syz[ctr]);
6013#endif
6014          strat->sevSyz[ctr] = p_GetShortExpVector(strat->syz[ctr],currRing);
6015          ctr++;
6016        }
6017      }
6018      i++;
6019    }
6020    /**************************************************************
6021    * add syzygies for upcoming first element of new iteration step
6022    **************************************************************/
6023    comp      = strat->currIdx;
6024    comp_old  = pGetComp(strat->sig[i-1]);
6025    diff      = comp - comp_old - 1;
6026    // diff should be zero, but sometimes also the initial generating
6027    // elements of the input ideal reduce to zero. then there is an
6028    // index-gap between the signatures. for these inbetween signatures we
6029    // can safely set syzIdx[j] = 0 as no such element will be ever computed
6030    // in the following.
6031    // doing this, we keep the relation "j = comp - 2" alive, which makes
6032    // jumps way easier when checking criteria
6033    while (diff>0)
6034    {
6035      strat->syzIdx[j]  = 0;
6036      diff--;
6037      j++;
6038    }
6039    strat->syzIdx[j]  = ctr;
6040    for (k = 0; k<strat->sl+1; k++)
6041    {
6042      strat->syz[ctr] = p_Copy (pHead(strat->S[k]), currRing);
6043      p_SetCompP (strat->syz[ctr], comp, currRing);
6044      poly q          = p_Copy (pHead(strat->L[strat->Ll].p), currRing);
6045      q               = p_Neg (q, currRing);
6046      p_SetCompP (q, p_GetComp(strat->sig[k], currRing), currRing);
6047      strat->syz[ctr] = p_Add_q (strat->syz[ctr], q, currRing);
6048//#if 1
6049#if DEBUGF5 || DEBUGF51
6050      printf("..");
6051      pWrite(strat->syz[ctr]);
6052#endif
6053      strat->sevSyz[ctr] = p_GetShortExpVector(strat->syz[ctr],currRing);
6054      ctr++;
6055    }
6056//#if 1
6057#ifdef DEBUGF5
6058    Print("Principal syzygies:\n");
6059    Print("--------------------------------\n");
6060    for(i=0;i<=ps-1;i++)
6061    {
6062      pWrite(strat->syz[i]);
6063    }
6064    Print("--------------------------------\n");
6065#endif
6066
6067  }
6068}
6069
6070
6071
6072/*2
6073*construct the set s from F and {P}