source: git/kernel/kutil.cc @ 0758b5

fieker-DuValspielwiese
Last change on this file since 0758b5 was 0758b5, checked in by Christian Eder, 12 years ago
spielwiese compiles with sba Todo: Add sba() call
  • Property mode set to 100644
File size: 245.9 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      L->last = NULL;
254    }
255
256    if (!fromNext && p_Cmp(p,strat->kNoetherTail(), L->tailRing) == -1)
257    {
258      L->Delete();
259      L->Clear();
260      L->ecart = -1;
261      if (bucket != NULL) kBucketDestroy(&bucket);
262      return;
263    }
264    p1 = p;
265    while (pNext(p1)!=NULL)
266    {
267      if (p_LmCmp(pNext(p1), strat->kNoetherTail(), L->tailRing) == -1)
268      {
269        L->last = p1;
270        p_Delete(&pNext(p1), L->tailRing);
271        if (p1 == p)
272        {
273          if (L->t_p != NULL)
274          {
275            assume(L->p != NULL && p == L->t_p);
276            pNext(L->p) = NULL;
277          }
278          L->max  = NULL;
279        }
280        else if (fromNext)
281          L->max  = p_GetMaxExpP(pNext(L->p), L->tailRing ); // p1;
282        //if (L->pLength != 0)
283        L->pLength = l;
284        // Hmmm when called from updateT, then only
285        // reset ecart when cut
286        if (fromNext)
287          L->ecart = L->pLDeg() - L->GetpFDeg();
288        break;
289      }
290      l++;
291      pIter(p1);
292    }
293    if (! fromNext)
294    {
295      L->SetpFDeg();
296      L->ecart = L->pLDeg(strat->LDegLast) - L->GetpFDeg();
297    }
298    if (bucket != NULL)
299    {
300      if (L->pLength > 1)
301      {
302        kBucketInit(bucket, pNext(p), L->pLength - 1);
303        pNext(p) = NULL;
304        if (L->t_p != NULL) pNext(L->t_p) = NULL;
305        L->pLength = 0;
306        L->bucket = bucket;
307        L->last = NULL;
308      }
309      else
310        kBucketDestroy(&bucket);
311    }
312    kTest_L(L);
313  }
314}
315
316void deleteHC(poly* p, int* e, int* l,kStrategy strat)
317{
318  LObject L(*p, currRing, strat->tailRing);
319
320  deleteHC(&L, strat);
321  *p = L.p;
322  *e = L.ecart;
323  *l = L.length;
324  if (L.t_p != NULL) p_LmFree(L.t_p, strat->tailRing);
325}
326
327/*2
328*tests if p.p=monomial*unit and cancels the unit
329*/
330void cancelunit (LObject* L,BOOLEAN inNF)
331{
332  int  i;
333  poly h;
334
335  if(rHasGlobalOrdering (currRing)) return;
336  if(TEST_OPT_CANCELUNIT) return;
337
338  ring r = L->tailRing;
339  poly p = L->GetLmTailRing();
340
341#ifdef HAVE_RINGS_LOC
342  // Leading coef have to be a unit
343  if ( !(nIsUnit(p_GetCoeff(p, r))) ) return;
344#endif
345
346  if(p_GetComp(p, r) != 0 && !p_OneComp(p, r)) return;
347
348//    for(i=r->N;i>0;i--)
349//    {
350//      if ((p_GetExp(p,i,r)>0) && (rIsPolyVar(i, r)==TRUE)) return;
351//    }
352  h = pNext(p);
353  loop
354  {
355    if (h==NULL)
356    {
357      p_Delete(&pNext(p), r);
358      if (!inNF)
359      {
360        number eins=nInit(1);
361        if (L->p != NULL)  pSetCoeff(L->p,eins);
362        else if (L->t_p != NULL) nDelete(&pGetCoeff(L->t_p));
363        if (L->t_p != NULL) pSetCoeff0(L->t_p,eins);
364      }
365      L->ecart = 0;
366      L->length = 1;
367      //if (L->pLength > 0)
368      L->pLength = 1;
369      if (L->last != NULL) L->last = p;
370      L->max = NULL;
371
372      if (L->t_p != NULL && pNext(L->t_p) != NULL)
373        pNext(L->t_p) = NULL;
374      if (L->p != NULL && pNext(L->p) != NULL)
375        pNext(L->p) = NULL;
376      return;
377    }
378    i = 0;
379    loop
380    {
381      i++;
382      if (p_GetExp(p,i,r) > p_GetExp(h,i,r)) return ; // does not divide
383      if (i == r->N) break; // does divide, try next monom
384    }
385    pIter(h);
386  }
387}
388
389/*2
390*pp is the new element in s
391*returns TRUE (in strat->kHEdgeFound) if
392*-HEcke is allowed
393*-we are in the last componente of the vector
394*-on all axis are monomials (all elements in NotUsedAxis are FALSE)
395*returns FALSE for pLexOrderings,
396*assumes in module case an ordering of type c* !!
397* HEckeTest is only called with strat->kHEdgeFound==FALSE !
398*/
399void HEckeTest (poly pp,kStrategy strat)
400{
401  int   j,k,p;
402
403  strat->kHEdgeFound=FALSE;
404  if (currRing->pLexOrder || currRing->MixedOrder)
405  {
406    return;
407  }
408  if (strat->ak > 1)           /*we are in the module case*/
409  {
410    return; // until ....
411    //if (!pVectorOut)     /*pVectorOut <=> order = c,* */
412    //  return FALSE;
413    //if (pGetComp(pp) < strat->ak) /* ak is the number of the last component */
414    //  return FALSE;
415  }
416  k = 0;
417  p=pIsPurePower(pp);
418  if (p!=0) strat->NotUsedAxis[p] = FALSE;
419  /*- the leading term of pp is a power of the p-th variable -*/
420  for (j=(currRing->N);j>0; j--)
421  {
422    if (strat->NotUsedAxis[j])
423    {
424      return;
425    }
426  }
427  strat->kHEdgeFound=TRUE;
428}
429
430/*2
431*utilities for TSet, LSet
432*/
433inline static intset initec (const int maxnr)
434{
435  return (intset)omAlloc(maxnr*sizeof(int));
436}
437
438inline static unsigned long* initsevS (const int maxnr)
439{
440  return (unsigned long*)omAlloc0(maxnr*sizeof(unsigned long));
441}
442inline static int* initS_2_R (const int maxnr)
443{
444  return (int*)omAlloc0(maxnr*sizeof(int));
445}
446
447static inline void enlargeT (TSet &T, TObject** &R, unsigned long* &sevT,
448                             int &length, const int incr)
449{
450  assume(T!=NULL);
451  assume(sevT!=NULL);
452  assume(R!=NULL);
453  assume((length+incr) > 0);
454
455  int i;
456  T = (TSet)omRealloc0Size(T, length*sizeof(TObject),
457                           (length+incr)*sizeof(TObject));
458
459  sevT = (unsigned long*) omReallocSize(sevT, length*sizeof(long*),
460                           (length+incr)*sizeof(long*));
461
462  R = (TObject**)omRealloc0Size(R,length*sizeof(TObject*),
463                                (length+incr)*sizeof(TObject*));
464  for (i=length-1;i>=0;i--) R[T[i].i_r] = &(T[i]);
465  length += incr;
466}
467
468void cleanT (kStrategy strat)
469{
470  int i,j;
471  poly  p;
472  assume(currRing == strat->tailRing || strat->tailRing != NULL);
473
474  pShallowCopyDeleteProc p_shallow_copy_delete =
475    (strat->tailRing != currRing ?
476     pGetShallowCopyDeleteProc(strat->tailRing, currRing) :
477     NULL);
478
479  for (j=0; j<=strat->tl; j++)
480  {
481    p = strat->T[j].p;
482    strat->T[j].p=NULL;
483    if (strat->T[j].max != NULL)
484    {
485      p_LmFree(strat->T[j].max, strat->tailRing);
486    }
487    i = -1;
488    loop
489    {
490      i++;
491      if (i>strat->sl)
492      {
493        if (strat->T[j].t_p != NULL)
494        {
495          p_Delete(&(strat->T[j].t_p), strat->tailRing);
496          p_LmFree(p, currRing);
497        }
498        else
499          pDelete(&p);
500        break;
501      }
502      if (p == strat->S[i])
503      {
504        if (strat->T[j].t_p != NULL)
505        {
506          assume(p_shallow_copy_delete != NULL);
507          pNext(p) = p_shallow_copy_delete(pNext(p),strat->tailRing,currRing,
508                                           currRing->PolyBin);
509          p_LmFree(strat->T[j].t_p, strat->tailRing);
510        }
511        break;
512      }
513    }
514  }
515  strat->tl=-1;
516}
517
518//LSet initL ()
519//{
520//  int i;
521//  LSet l = (LSet)omAlloc(setmaxL*sizeof(LObject));
522//  return l;
523//}
524
525static inline void enlargeL (LSet* L,int* length,const int incr)
526{
527  assume((*L)!=NULL);
528  assume((length+incr)>0);
529
530  *L = (LSet)omReallocSize((*L),(*length)*sizeof(LObject),
531                                   ((*length)+incr)*sizeof(LObject));
532  (*length) += incr;
533}
534
535void initPairtest(kStrategy strat)
536{
537  strat->pairtest = (BOOLEAN *)omAlloc0((strat->sl+2)*sizeof(BOOLEAN));
538}
539
540/*2
541*test whether (p1,p2) or (p2,p1) is in L up position length
542*it returns TRUE if yes and the position k
543*/
544BOOLEAN isInPairsetL(int length,poly p1,poly p2,int*  k,kStrategy strat)
545{
546  LObject *p=&(strat->L[length]);
547
548  *k = length;
549  loop
550  {
551    if ((*k) < 0) return FALSE;
552    if (((p1 == (*p).p1) && (p2 == (*p).p2))
553    ||  ((p1 == (*p).p2) && (p2 == (*p).p1)))
554      return TRUE;
555    (*k)--;
556    p--;
557  }
558}
559
560/*2
561*in B all pairs have the same element p on the right
562*it tests whether (q,p) is in B and returns TRUE if yes
563*and the position k
564*/
565BOOLEAN isInPairsetB(poly q,int*  k,kStrategy strat)
566{
567  LObject *p=&(strat->B[strat->Bl]);
568
569  *k = strat->Bl;
570  loop
571  {
572    if ((*k) < 0) return FALSE;
573    if (q == (*p).p1)
574      return TRUE;
575    (*k)--;
576    p--;
577  }
578}
579
580int kFindInT(poly p, TSet T, int tlength)
581{
582  int i;
583
584  for (i=0; i<=tlength; i++)
585  {
586    if (T[i].p == p) return i;
587  }
588  return -1;
589}
590
591int kFindInT(poly p, kStrategy strat)
592{
593  int i;
594  do
595  {
596    i = kFindInT(p, strat->T, strat->tl);
597    if (i >= 0) return i;
598    strat = strat->next;
599  }
600  while (strat != NULL);
601  return -1;
602}
603
604#ifdef KDEBUG
605
606void sTObject::wrp()
607{
608  if (t_p != NULL) p_wrp(t_p, tailRing);
609  else if (p != NULL) p_wrp(p, currRing, tailRing);
610  else ::wrp(NULL);
611}
612
613#define kFalseReturn(x) do { if (!x) return FALSE;} while (0)
614
615// check that Lm's of a poly from T are "equal"
616static const char* kTest_LmEqual(poly p, poly t_p, ring tailRing)
617{
618  int i;
619  for (i=1; i<=tailRing->N; i++)
620  {
621    if (p_GetExp(p, i, currRing) != p_GetExp(t_p, i, tailRing))
622      return "Lm[i] different";
623  }
624  if (p_GetComp(p, currRing) != p_GetComp(t_p, tailRing))
625    return "Lm[0] different";
626  if (pNext(p) != pNext(t_p))
627    return "Lm.next different";
628  if (pGetCoeff(p) != pGetCoeff(t_p))
629    return "Lm.coeff different";
630  return NULL;
631}
632
633static BOOLEAN sloppy_max = FALSE;
634BOOLEAN kTest_T(TObject * T, ring strat_tailRing, int i, char TN)
635{
636  ring tailRing = T->tailRing;
637  if (strat_tailRing == NULL) strat_tailRing = tailRing;
638  r_assume(strat_tailRing == tailRing);
639
640  poly p = T->p;
641  ring r = currRing;
642
643  if (T->p == NULL && T->t_p == NULL && i >= 0)
644    return dReportError("%c[%d].poly is NULL", TN, i);
645
646  if (T->tailRing != currRing)
647  {
648    if (T->t_p == NULL && i > 0)
649      return dReportError("%c[%d].t_p is NULL", TN, i);
650    pFalseReturn(p_Test(T->t_p, T->tailRing));
651    if (T->p != NULL) pFalseReturn(p_LmTest(T->p, currRing));
652    if (T->p != NULL && T->t_p != NULL)
653    {
654      const char* msg = kTest_LmEqual(T->p, T->t_p, T->tailRing);
655      if (msg != NULL)
656        return dReportError("%c[%d] %s", TN, i, msg);
657      r = T->tailRing;
658      p = T->t_p;
659    }
660    if (T->p == NULL)
661    {
662      p = T->t_p;
663      r = T->tailRing;
664    }
665    if (T->t_p != NULL && i >= 0 && TN == 'T')
666    {
667      if (pNext(T->t_p) == NULL)
668      {
669        if (T->max != NULL)
670          return dReportError("%c[%d].max is not NULL as it should be", TN, i);
671      }
672      else
673      {
674        if (T->max == NULL)
675          return dReportError("%c[%d].max is NULL", TN, i);
676        if (pNext(T->max) != NULL)
677          return dReportError("pNext(%c[%d].max) != NULL", TN, i);
678
679        pFalseReturn(p_CheckPolyRing(T->max, tailRing));
680        omCheckBinAddrSize(T->max, (omSizeWOfBin(tailRing->PolyBin))*SIZEOF_LONG);
681#if KDEBUG > 0
682        if (! sloppy_max)
683        {
684          poly test_max = p_GetMaxExpP(pNext(T->t_p), tailRing);
685          p_Setm(T->max, tailRing);
686          p_Setm(test_max, tailRing);
687          BOOLEAN equal = p_ExpVectorEqual(T->max, test_max, tailRing);
688          if (! equal)
689            return dReportError("%c[%d].max out of sync", TN, i);
690          p_LmFree(test_max, tailRing);
691        }
692#endif
693      }
694    }
695  }
696  else
697  {
698    if (T->max != NULL)
699      return dReportError("%c[%d].max != NULL but tailRing == currRing",TN,i);
700    if (T->t_p != NULL)
701      return dReportError("%c[%d].t_p != NULL but tailRing == currRing",TN,i);
702    if (T->p == NULL && i > 0)
703      return dReportError("%c[%d].p is NULL", TN, i);
704    pFalseReturn(p_Test(T->p, currRing));
705  }
706
707  if (i >= 0 && T->pLength != 0
708  && ! rIsSyzIndexRing(currRing) && T->pLength != pLength(p))
709  {
710    int l=T->pLength;
711    T->pLength=pLength(p);
712    return dReportError("%c[%d] pLength error: has %d, specified to have %d",
713                        TN, i , pLength(p), l);
714  }
715
716  // check FDeg,  for elements in L and T
717  if (i >= 0 && (TN == 'T' || TN == 'L'))
718  {
719    // FDeg has ir element from T of L set
720    if (T->FDeg  != T->pFDeg())
721    {
722      int d=T->FDeg;
723      T->FDeg=T->pFDeg();
724      return dReportError("%c[%d] FDeg error: has %d, specified to have %d",
725                          TN, i , T->pFDeg(), d);
726    }
727  }
728
729  // check is_normalized for elements in T
730  if (i >= 0 && TN == 'T')
731  {
732    if (T->is_normalized && ! nIsOne(pGetCoeff(p)))
733      return dReportError("T[%d] is_normalized error", i);
734
735  }
736  return TRUE;
737}
738
739BOOLEAN kTest_L(LObject *L, ring strat_tailRing,
740                BOOLEAN testp, int lpos, TSet T, int tlength)
741{
742  if (testp)
743  {
744    poly pn = NULL;
745    if (L->bucket != NULL)
746    {
747      kFalseReturn(kbTest(L->bucket));
748      r_assume(L->bucket->bucket_ring == L->tailRing);
749      if (L->p != NULL && pNext(L->p) != NULL)
750      {
751        pn = pNext(L->p);
752        pNext(L->p) = NULL;
753      }
754    }
755    kFalseReturn(kTest_T(L, strat_tailRing, lpos, 'L'));
756    if (pn != NULL)
757      pNext(L->p) = pn;
758
759    ring r;
760    poly p;
761    L->GetLm(p, r);
762    if (L->sev != 0 && p_GetShortExpVector(p, r) != L->sev)
763    {
764      return dReportError("L[%d] wrong sev: has %o, specified to have %o",
765                          lpos, p_GetShortExpVector(p, r), L->sev);
766    }
767    if (lpos > 0 && L->last != NULL && pLast(p) != L->last)
768    {
769      return dReportError("L[%d] last wrong: has %p specified to have %p",
770                          lpos, pLast(p), L->last);
771    }
772  }
773  if (L->p1 == NULL)
774  {
775    // L->p2 either NULL or "normal" poly
776    pFalseReturn(pp_Test(L->p2, currRing, L->tailRing));
777  }
778  else if (tlength > 0 && T != NULL && (lpos >=0))
779  {
780    // now p1 and p2 must be != NULL and must be contained in T
781    int i;
782    i = kFindInT(L->p1, T, tlength);
783    if (i < 0)
784      return dReportError("L[%d].p1 not in T",lpos);
785    i = kFindInT(L->p2, T, tlength);
786    if (i < 0)
787      return dReportError("L[%d].p2 not in T",lpos);
788  }
789  return TRUE;
790}
791
792BOOLEAN kTest (kStrategy strat)
793{
794  int i;
795
796  // test P
797  kFalseReturn(kTest_L(&(strat->P), strat->tailRing,
798                       (strat->P.p != NULL && pNext(strat->P.p)!=strat->tail),
799                       -1, strat->T, strat->tl));
800
801  // test T
802  if (strat->T != NULL)
803  {
804    for (i=0; i<=strat->tl; i++)
805    {
806      kFalseReturn(kTest_T(&(strat->T[i]), strat->tailRing, i, 'T'));
807      if (strat->sevT[i] != pGetShortExpVector(strat->T[i].p))
808        return dReportError("strat->sevT[%d] out of sync", i);
809    }
810  }
811
812  // test L
813  if (strat->L != NULL)
814  {
815    for (i=0; i<=strat->Ll; i++)
816    {
817      kFalseReturn(kTest_L(&(strat->L[i]), strat->tailRing,
818                           strat->L[i].Next() != strat->tail, i,
819                           strat->T, strat->tl));
820      // may be unused
821      //if (strat->use_buckets && strat->L[i].Next() != strat->tail &&
822      //    strat->L[i].Next() != NULL && strat->L[i].p1 != NULL)
823      //{
824      //  assume(strat->L[i].bucket != NULL);
825      //}
826    }
827  }
828
829  // test S
830  if (strat->S != NULL)
831    kFalseReturn(kTest_S(strat));
832
833  return TRUE;
834}
835
836BOOLEAN kTest_S(kStrategy strat)
837{
838  int i;
839  BOOLEAN ret = TRUE;
840  for (i=0; i<=strat->sl; i++)
841  {
842    if (strat->S[i] != NULL &&
843        strat->sevS[i] != pGetShortExpVector(strat->S[i]))
844    {
845      return dReportError("S[%d] wrong sev: has %o, specified to have %o",
846                          i , pGetShortExpVector(strat->S[i]), strat->sevS[i]);
847    }
848  }
849  return ret;
850}
851
852
853
854BOOLEAN kTest_TS(kStrategy strat)
855{
856  int i, j;
857  BOOLEAN ret = TRUE;
858  kFalseReturn(kTest(strat));
859
860  // test strat->R, strat->T[i].i_r
861  for (i=0; i<=strat->tl; i++)
862  {
863    if (strat->T[i].i_r < 0 || strat->T[i].i_r > strat->tl)
864      return dReportError("strat->T[%d].i_r == %d out of bounds", i,
865                          strat->T[i].i_r);
866    if (strat->R[strat->T[i].i_r] != &(strat->T[i]))
867      return dReportError("T[%d].i_r with R out of sync", i);
868  }
869  // test containment of S inT
870  if (strat->S != NULL)
871  {
872    for (i=0; i<=strat->sl; i++)
873    {
874      j = kFindInT(strat->S[i], strat->T, strat->tl);
875      if (j < 0)
876        return dReportError("S[%d] not in T", i);
877      if (strat->S_2_R[i] != strat->T[j].i_r)
878        return dReportError("S_2_R[%d]=%d != T[%d].i_r=%d\n",
879                            i, strat->S_2_R[i], j, strat->T[j].i_r);
880    }
881  }
882  // test strat->L[i].i_r1
883  for (i=0; i<=strat->Ll; i++)
884  {
885    if (strat->L[i].p1 != NULL && strat->L[i].p2)
886    {
887      if (strat->L[i].i_r1 < 0 ||
888          strat->L[i].i_r1 > strat->tl ||
889          strat->L[i].T_1(strat)->p != strat->L[i].p1)
890        return dReportError("L[%d].i_r1 out of sync", i);
891      if (strat->L[i].i_r2 < 0 ||
892          strat->L[i].i_r2 > strat->tl ||
893          strat->L[i].T_2(strat)->p != strat->L[i].p2);
894    }
895    else
896    {
897      if (strat->L[i].i_r1 != -1)
898        return dReportError("L[%d].i_r1 out of sync", i);
899      if (strat->L[i].i_r2 != -1)
900        return dReportError("L[%d].i_r2 out of sync", i);
901    }
902    if (strat->L[i].i_r != -1)
903      return dReportError("L[%d].i_r out of sync", i);
904  }
905  return TRUE;
906}
907
908#endif // KDEBUG
909
910/*2
911*cancels the i-th polynomial in the standardbase s
912*/
913void deleteInS (int i,kStrategy strat)
914{
915#ifdef ENTER_USE_MEMMOVE
916  memmove(&(strat->S[i]), &(strat->S[i+1]), (strat->sl - i)*sizeof(poly));
917  memmove(&(strat->ecartS[i]),&(strat->ecartS[i+1]),(strat->sl - i)*sizeof(int));
918  memmove(&(strat->sevS[i]),&(strat->sevS[i+1]),(strat->sl - i)*sizeof(unsigned long));
919  memmove(&(strat->S_2_R[i]),&(strat->S_2_R[i+1]),(strat->sl - i)*sizeof(int));
920#else
921  int j;
922  for (j=i; j<strat->sl; j++)
923  {
924    strat->S[j] = strat->S[j+1];
925    strat->ecartS[j] = strat->ecartS[j+1];
926    strat->sevS[j] = strat->sevS[j+1];
927    strat->S_2_R[j] = strat->S_2_R[j+1];
928  }
929#endif
930  if (strat->lenS!=NULL)
931  {
932#ifdef ENTER_USE_MEMMOVE
933    memmove(&(strat->lenS[i]),&(strat->lenS[i+1]),(strat->sl - i)*sizeof(int));
934#else
935    for (j=i; j<strat->sl; j++) strat->lenS[j] = strat->lenS[j+1];
936#endif
937  }
938  if (strat->lenSw!=NULL)
939  {
940#ifdef ENTER_USE_MEMMOVE
941    memmove(&(strat->lenSw[i]),&(strat->lenSw[i+1]),(strat->sl - i)*sizeof(wlen_type));
942#else
943    for (j=i; j<strat->sl; j++) strat->lenSw[j] = strat->lenSw[j+1];
944#endif
945  }
946  if (strat->fromQ!=NULL)
947  {
948#ifdef ENTER_USE_MEMMOVE
949    memmove(&(strat->fromQ[i]),&(strat->fromQ[i+1]),(strat->sl - i)*sizeof(int));
950#else
951    for (j=i; j<strat->sl; j++)
952    {
953      strat->fromQ[j] = strat->fromQ[j+1];
954    }
955#endif
956  }
957  strat->S[strat->sl] = NULL;
958  strat->sl--;
959}
960
961
962/*2
963*cancels the i-th polynomial in the standardbase s
964*/
965void deleteInSSba (int i,kStrategy strat)
966{
967#ifdef ENTER_USE_MEMMOVE
968  memmove(&(strat->S[i]), &(strat->S[i+1]), (strat->sl - i)*sizeof(poly));
969  memmove(&(strat->sig[i]), &(strat->sig[i+1]), (strat->sl - i)*sizeof(poly));
970  memmove(&(strat->ecartS[i]),&(strat->ecartS[i+1]),(strat->sl - i)*sizeof(int));
971  memmove(&(strat->sevS[i]),&(strat->sevS[i+1]),(strat->sl - i)*sizeof(unsigned long));
972  memmove(&(strat->sevSig[i]),&(strat->sevSig[i+1]),(strat->sl - i)*sizeof(unsigned long));
973  memmove(&(strat->S_2_R[i]),&(strat->S_2_R[i+1]),(strat->sl - i)*sizeof(int));
974  memmove(&(strat->fromS[i]),&(strat->fromS[i+1]),(strat->sl - i)*sizeof(int));
975#else
976  int j;
977  for (j=i; j<strat->sl; j++)
978  {
979    strat->S[j] = strat->S[j+1];
980    strat->sig[j] = strat->sig[j+1];
981    strat->ecartS[j] = strat->ecartS[j+1];
982    strat->sevS[j] = strat->sevS[j+1];
983    strat->sevSig[j] = strat->sevSig[j+1];
984    strat->S_2_R[j] = strat->S_2_R[j+1];
985    strat->fromS[j] = strat->fromS[j+1];
986  }
987#endif
988  if (strat->lenS!=NULL)
989  {
990#ifdef ENTER_USE_MEMMOVE
991    memmove(&(strat->lenS[i]),&(strat->lenS[i+1]),(strat->sl - i)*sizeof(int));
992#else
993    for (j=i; j<strat->sl; j++) strat->lenS[j] = strat->lenS[j+1];
994#endif
995  }
996  if (strat->lenSw!=NULL)
997  {
998#ifdef ENTER_USE_MEMMOVE
999    memmove(&(strat->lenSw[i]),&(strat->lenSw[i+1]),(strat->sl - i)*sizeof(wlen_type));
1000#else
1001    for (j=i; j<strat->sl; j++) strat->lenSw[j] = strat->lenSw[j+1];
1002#endif
1003  }
1004  if (strat->fromQ!=NULL)
1005  {
1006#ifdef ENTER_USE_MEMMOVE
1007    memmove(&(strat->fromQ[i]),&(strat->fromQ[i+1]),(strat->sl - i)*sizeof(int));
1008#else
1009    for (j=i; j<strat->sl; j++)
1010    {
1011      strat->fromQ[j] = strat->fromQ[j+1];
1012    }
1013#endif
1014  }
1015  strat->S[strat->sl] = NULL;
1016  strat->sl--;
1017}
1018
1019/*2
1020*cancels the j-th polynomial in the set
1021*/
1022void deleteInL (LSet set, int *length, int j,kStrategy strat)
1023{
1024  if (set[j].lcm!=NULL)
1025  {
1026#ifdef HAVE_RINGS
1027    if (pGetCoeff(set[j].lcm) != NULL)
1028      pLmDelete(set[j].lcm);
1029    else
1030#endif
1031      pLmFree(set[j].lcm);
1032  }
1033  if (set[j].p!=NULL)
1034  {
1035    if (pNext(set[j].p) == strat->tail)
1036    {
1037#ifdef HAVE_RINGS
1038      if (pGetCoeff(set[j].p) != NULL)
1039        pLmDelete(set[j].p);
1040      else
1041#endif
1042        pLmFree(set[j].p);
1043      /*- tail belongs to several int spolys -*/
1044    }
1045    else
1046    {
1047      // search p in T, if it is there, do not delete it
1048      if (currRing->OrdSgn != -1 || kFindInT(set[j].p, strat) < 0)
1049      {
1050        // assure that for global orderings kFindInT fails
1051        assume(currRing->OrdSgn == -1 || kFindInT(set[j].p, strat) < 0);
1052        set[j].Delete();
1053      }
1054    }
1055  }
1056  if (*length > 0 && j < *length)
1057  {
1058#ifdef ENTER_USE_MEMMOVE
1059    memmove(&(set[j]), &(set[j+1]), (*length - j)*sizeof(LObject));
1060#else
1061    int i;
1062    for (i=j; i < (*length); i++)
1063      set[i] = set[i+1];
1064#endif
1065  }
1066#ifdef KDEBUG
1067  memset(&(set[*length]),0,sizeof(LObject));
1068#endif
1069  (*length)--;
1070}
1071
1072/*2
1073*enters p at position at in L
1074*/
1075void enterL (LSet *set,int *length, int *LSetmax, LObject p,int at)
1076{
1077  // this should be corrected
1078  assume(p.FDeg == p.pFDeg());
1079
1080  if ((*length)>=0)
1081  {
1082    if ((*length) == (*LSetmax)-1) enlargeL(set,LSetmax,setmaxLinc);
1083    if (at <= (*length))
1084#ifdef ENTER_USE_MEMMOVE
1085      memmove(&((*set)[at+1]), &((*set)[at]), ((*length)-at+1)*sizeof(LObject));
1086#else
1087    for (i=(*length)+1; i>=at+1; i--) (*set)[i] = (*set)[i-1];
1088#endif
1089  }
1090  else at = 0;
1091  (*set)[at] = p;
1092  (*length)++;
1093}
1094
1095/*2
1096* computes the normal ecart;
1097* used in mora case and if pLexOrder & sugar in bba case
1098*/
1099void initEcartNormal (LObject* h)
1100{
1101  h->FDeg = h->pFDeg();
1102  h->ecart = h->pLDeg() - h->FDeg;
1103  // h->length is set by h->pLDeg
1104  h->length=h->pLength=pLength(h->p);
1105}
1106
1107void initEcartBBA (LObject* h)
1108{
1109  h->FDeg = h->pFDeg();
1110  (*h).ecart = 0;
1111  h->length=h->pLength=pLength(h->p);
1112}
1113
1114void initEcartPairBba (LObject* Lp,poly /*f*/,poly /*g*/,int /*ecartF*/,int /*ecartG*/)
1115{
1116  Lp->FDeg = Lp->pFDeg();
1117  (*Lp).ecart = 0;
1118  (*Lp).length = 0;
1119}
1120
1121void initEcartPairMora (LObject* Lp,poly /*f*/,poly /*g*/,int ecartF,int ecartG)
1122{
1123  Lp->FDeg = Lp->pFDeg();
1124  (*Lp).ecart = si_max(ecartF,ecartG);
1125  (*Lp).ecart = (*Lp).ecart- (Lp->FDeg -p_FDeg((*Lp).lcm,currRing));
1126  (*Lp).length = 0;
1127}
1128
1129/*2
1130*if ecart1<=ecart2 it returns TRUE
1131*/
1132static inline BOOLEAN sugarDivisibleBy(int ecart1, int ecart2)
1133{
1134  return (ecart1 <= ecart2);
1135}
1136
1137#ifdef HAVE_RINGS
1138/*2
1139* put the pair (s[i],p)  into the set B, ecart=ecart(p) (ring case)
1140*/
1141void enterOnePairRing (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
1142{
1143  assume(i<=strat->sl);
1144  int      l,j,compare,compareCoeff;
1145  LObject  Lp;
1146
1147  if (strat->interred_flag) return;
1148#ifdef KDEBUG
1149  Lp.ecart=0; Lp.length=0;
1150#endif
1151  /*- computes the lcm(s[i],p) -*/
1152  Lp.lcm = pInit();
1153  pSetCoeff0(Lp.lcm, n_Lcm(pGetCoeff(p), pGetCoeff(strat->S[i]), currRing->cf));
1154  // Lp.lcm == 0
1155  if (nIsZero(pGetCoeff(Lp.lcm)))
1156  {
1157#ifdef KDEBUG
1158      if (TEST_OPT_DEBUG)
1159      {
1160        PrintS("--- Lp.lcm == 0\n");
1161        PrintS("p:");
1162        wrp(p);
1163        Print("  strat->S[%d]:", i);
1164        wrp(strat->S[i]);
1165        PrintLn();
1166      }
1167#endif
1168      strat->cp++;
1169      pLmDelete(Lp.lcm);
1170      return;
1171  }
1172  // basic product criterion
1173  pLcm(p,strat->S[i],Lp.lcm);
1174  pSetm(Lp.lcm);
1175  assume(!strat->sugarCrit);
1176  if (pHasNotCF(p,strat->S[i]) && n_IsUnit(pGetCoeff(p),currRing->cf)
1177      && n_IsUnit(pGetCoeff(strat->S[i]),currRing->cf))
1178  {
1179#ifdef KDEBUG
1180      if (TEST_OPT_DEBUG)
1181      {
1182        PrintS("--- product criterion func enterOnePairRing type 1\n");
1183        PrintS("p:");
1184        wrp(p);
1185        Print("  strat->S[%d]:", i);
1186        wrp(strat->S[i]);
1187        PrintLn();
1188      }
1189#endif
1190      strat->cp++;
1191      pLmDelete(Lp.lcm);
1192      return;
1193  }
1194  assume(!strat->fromT);
1195  /*
1196  *the set B collects the pairs of type (S[j],p)
1197  *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
1198  *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1199  *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1200  */
1201  for(j = strat->Bl;j>=0;j--)
1202  {
1203    compare=pDivCompRing(strat->B[j].lcm,Lp.lcm);
1204    compareCoeff = n_DivComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(Lp.lcm), currRing->cf);
1205    if (compareCoeff == pDivComp_EQUAL || compare == compareCoeff)
1206    {
1207      if (compare == 1)
1208      {
1209        strat->c3++;
1210#ifdef KDEBUG
1211        if (TEST_OPT_DEBUG)
1212        {
1213          PrintS("--- chain criterion type 1\n");
1214          PrintS("strat->B[j]:");
1215          wrp(strat->B[j].lcm);
1216          PrintS("  Lp.lcm:");
1217          wrp(Lp.lcm);
1218          PrintLn();
1219        }
1220#endif
1221        if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1222        {
1223          pLmDelete(Lp.lcm);
1224          return;
1225        }
1226        break;
1227      }
1228      else
1229      if (compare == -1)
1230      {
1231#ifdef KDEBUG
1232        if (TEST_OPT_DEBUG)
1233        {
1234          PrintS("--- chain criterion type 2\n");
1235          Print("strat->B[%d].lcm:",j);
1236          wrp(strat->B[j].lcm);
1237          PrintS("  Lp.lcm:");
1238          wrp(Lp.lcm);
1239          PrintLn();
1240        }
1241#endif
1242        deleteInL(strat->B,&strat->Bl,j,strat);
1243        strat->c3++;
1244      }
1245    }
1246    if ((compare == pDivComp_EQUAL) && (compareCoeff != 2))
1247    {
1248      if (compareCoeff == pDivComp_LESS)
1249      {
1250#ifdef KDEBUG
1251        if (TEST_OPT_DEBUG)
1252        {
1253          PrintS("--- chain criterion type 3\n");
1254          Print("strat->B[%d].lcm:", j);
1255          wrp(strat->B[j].lcm);
1256          PrintS("  Lp.lcm:");
1257          wrp(Lp.lcm);
1258          PrintLn();
1259        }
1260#endif
1261        strat->c3++;
1262        if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1263        {
1264          pLmDelete(Lp.lcm);
1265          return;
1266        }
1267        break;
1268      }
1269      else
1270      // Add hint for same LM and LC (later) (TODO Oliver)
1271      // if (compareCoeff == pDivComp_GREATER)
1272      {
1273#ifdef KDEBUG
1274        if (TEST_OPT_DEBUG)
1275        {
1276          PrintS("--- chain criterion type 4\n");
1277          Print("strat->B[%d].lcm:", j);
1278          wrp(strat->B[j].lcm);
1279          PrintS("  Lp.lcm:");
1280          wrp(Lp.lcm);
1281          PrintLn();
1282        }
1283#endif
1284        deleteInL(strat->B,&strat->Bl,j,strat);
1285        strat->c3++;
1286      }
1287    }
1288  }
1289  /*
1290  *the pair (S[i],p) enters B if the spoly != 0
1291  */
1292  /*-  compute the short s-polynomial -*/
1293  if ((strat->S[i]==NULL) || (p==NULL)) {
1294#ifdef KDEBUG
1295    if (TEST_OPT_DEBUG)
1296    {
1297      PrintS("--- spoly = NULL\n");
1298    }
1299#endif
1300    pLmDelete(Lp.lcm);
1301    return;
1302  }
1303  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
1304  {
1305    // Is from a previous computed GB, therefore we know that spoly will
1306    // reduce to zero. Oliver.
1307    WarnS("Could we come here? 8738947389");
1308    Lp.p=NULL;
1309  }
1310  else
1311  {
1312    Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
1313  }
1314  if (Lp.p == NULL)
1315  {
1316#ifdef KDEBUG
1317    if (TEST_OPT_DEBUG)
1318    {
1319      PrintS("--- spoly = NULL\n");
1320    }
1321#endif
1322    /*- the case that the s-poly is 0 -*/
1323    if (strat->pairtest==NULL) initPairtest(strat);
1324    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
1325    strat->pairtest[strat->sl+1] = TRUE;
1326    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
1327    /*
1328    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
1329    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
1330    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
1331    *term of p devides the lcm(s,r)
1332    *(this canceling should be done here because
1333    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
1334    *the first case is handeled in chainCrit
1335    */
1336    pLmDelete(Lp.lcm);
1337  }
1338  else
1339  {
1340    /*- the pair (S[i],p) enters B -*/
1341    Lp.p1 = strat->S[i];
1342    Lp.p2 = p;
1343
1344    pNext(Lp.p) = strat->tail;
1345
1346    if (atR >= 0)
1347    {
1348      Lp.i_r2 = atR;
1349      Lp.i_r1 = strat->S_2_R[i];
1350    }
1351    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1352    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
1353    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
1354  }
1355}
1356
1357
1358/*2
1359* put the  lcm(s[i],p)  into the set B
1360*/
1361
1362BOOLEAN enterOneStrongPoly (int i,poly p,int /*ecart*/, int /*isFromQ*/,kStrategy strat, int atR = -1)
1363{
1364  number d, s, t;
1365  assume(i<=strat->sl);
1366  assume(atR >= 0);
1367  poly m1, m2, gcd;
1368
1369  d = n_ExtGcd(pGetCoeff(p), pGetCoeff(strat->S[i]), &s, &t, currRing->cf);
1370
1371  if (nIsZero(s) || nIsZero(t))  // evtl. durch divBy tests ersetzen
1372  {
1373    nDelete(&d);
1374    nDelete(&s);
1375    nDelete(&t);
1376    return FALSE;
1377  }
1378
1379  k_GetStrongLeadTerms(p, strat->S[i], currRing, m1, m2, gcd, strat->tailRing);
1380  //p_Test(m1,strat->tailRing);
1381  //p_Test(m2,strat->tailRing);
1382  while (! kCheckStrongCreation(atR, m1, i, m2, strat) )
1383  {
1384    memset(&(strat->P), 0, sizeof(strat->P));
1385    kStratChangeTailRing(strat);
1386    strat->P = *(strat->R[atR]);
1387    p_LmFree(m1, strat->tailRing);
1388    p_LmFree(m2, strat->tailRing);
1389    p_LmFree(gcd, currRing);
1390    k_GetStrongLeadTerms(p, strat->S[i], currRing, m1, m2, gcd, strat->tailRing);
1391  }
1392  pSetCoeff0(m1, s);
1393  pSetCoeff0(m2, t);
1394  pSetCoeff0(gcd, d);
1395  p_Test(m1,strat->tailRing);
1396  p_Test(m2,strat->tailRing);
1397
1398#ifdef KDEBUG
1399  if (TEST_OPT_DEBUG)
1400  {
1401    // Print("t = %d; s = %d; d = %d\n", nInt(t), nInt(s), nInt(d));
1402    PrintS("m1 = ");
1403    p_wrp(m1, strat->tailRing);
1404    PrintS(" ; m2 = ");
1405    p_wrp(m2, strat->tailRing);
1406    PrintS(" ; gcd = ");
1407    wrp(gcd);
1408    PrintS("\n--- create strong gcd poly: ");
1409    Print("\n p: ", i);
1410    wrp(p);
1411    Print("\n strat->S[%d]: ", i);
1412    wrp(strat->S[i]);
1413    PrintS(" ---> ");
1414  }
1415#endif
1416
1417  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);
1418  p_LmDelete(m1, strat->tailRing);
1419  p_LmDelete(m2, strat->tailRing);
1420
1421#ifdef KDEBUG
1422  if (TEST_OPT_DEBUG)
1423  {
1424    wrp(gcd);
1425    PrintLn();
1426  }
1427#endif
1428
1429  LObject h;
1430  h.p = gcd;
1431  h.tailRing = strat->tailRing;
1432  int posx;
1433  h.pCleardenom();
1434  strat->initEcart(&h);
1435  if (strat->Ll==-1)
1436    posx =0;
1437  else
1438    posx = strat->posInL(strat->L,strat->Ll,&h,strat);
1439  h.sev = pGetShortExpVector(h.p);
1440  if (currRing!=strat->tailRing)
1441    h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
1442  enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
1443  return TRUE;
1444}
1445#endif
1446
1447/*2
1448* put the pair (s[i],p)  into the set B, ecart=ecart(p)
1449*/
1450
1451void enterOnePairNormal (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
1452{
1453  assume(i<=strat->sl);
1454  if (strat->interred_flag) return;
1455
1456  int      l,j,compare;
1457  LObject  Lp;
1458  Lp.i_r = -1;
1459
1460#ifdef KDEBUG
1461  Lp.ecart=0; Lp.length=0;
1462#endif
1463  /*- computes the lcm(s[i],p) -*/
1464  Lp.lcm = pInit();
1465
1466#ifndef HAVE_RATGRING
1467  pLcm(p,strat->S[i],Lp.lcm);
1468#elif defined(HAVE_RATGRING)
1469  //  if (rIsRatGRing(currRing))
1470  pLcmRat(p,strat->S[i],Lp.lcm, currRing->real_var_start); // int rat_shift
1471#endif
1472  pSetm(Lp.lcm);
1473
1474
1475  if (strat->sugarCrit && ALLOW_PROD_CRIT(strat))
1476  {
1477    if((!((strat->ecartS[i]>0)&&(ecart>0)))
1478    && pHasNotCF(p,strat->S[i]))
1479    {
1480    /*
1481    *the product criterion has applied for (s,p),
1482    *i.e. lcm(s,p)=product of the leading terms of s and p.
1483    *Suppose (s,r) is in L and the leading term
1484    *of p divides lcm(s,r)
1485    *(==> the leading term of p divides the leading term of r)
1486    *but the leading term of s does not divide the leading term of r
1487    *(notice that tis condition is automatically satisfied if r is still
1488    *in S), then (s,r) can be cancelled.
1489    *This should be done here because the
1490    *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
1491    *
1492    *Moreover, skipping (s,r) holds also for the noncommutative case.
1493    */
1494      strat->cp++;
1495      pLmFree(Lp.lcm);
1496      Lp.lcm=NULL;
1497      return;
1498    }
1499    else
1500      Lp.ecart = si_max(ecart,strat->ecartS[i]);
1501    if (strat->fromT && (strat->ecartS[i]>ecart))
1502    {
1503      pLmFree(Lp.lcm);
1504      Lp.lcm=NULL;
1505      return;
1506      /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
1507    }
1508    /*
1509    *the set B collects the pairs of type (S[j],p)
1510    *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
1511    *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1512    *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1513    */
1514    {
1515      j = strat->Bl;
1516      loop
1517      {
1518        if (j < 0)  break;
1519        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
1520        if ((compare==1)
1521        &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
1522        {
1523          strat->c3++;
1524          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1525          {
1526            pLmFree(Lp.lcm);
1527            return;
1528          }
1529          break;
1530        }
1531        else
1532        if ((compare ==-1)
1533        && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
1534        {
1535          deleteInL(strat->B,&strat->Bl,j,strat);
1536          strat->c3++;
1537        }
1538        j--;
1539      }
1540    }
1541  }
1542  else /*sugarcrit*/
1543  {
1544    if (ALLOW_PROD_CRIT(strat))
1545    {
1546      // if currRing->nc_type!=quasi (or skew)
1547      // TODO: enable productCrit for super commutative algebras...
1548      if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
1549      pHasNotCF(p,strat->S[i]))
1550      {
1551      /*
1552      *the product criterion has applied for (s,p),
1553      *i.e. lcm(s,p)=product of the leading terms of s and p.
1554      *Suppose (s,r) is in L and the leading term
1555      *of p devides lcm(s,r)
1556      *(==> the leading term of p devides the leading term of r)
1557      *but the leading term of s does not devide the leading term of r
1558      *(notice that tis condition is automatically satisfied if r is still
1559      *in S), then (s,r) can be canceled.
1560      *This should be done here because the
1561      *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
1562      */
1563          strat->cp++;
1564          pLmFree(Lp.lcm);
1565          Lp.lcm=NULL;
1566          return;
1567      }
1568      if (strat->fromT && (strat->ecartS[i]>ecart))
1569      {
1570        pLmFree(Lp.lcm);
1571        Lp.lcm=NULL;
1572        return;
1573        /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
1574      }
1575      /*
1576      *the set B collects the pairs of type (S[j],p)
1577      *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
1578      *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1579      *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1580      */
1581      for(j = strat->Bl;j>=0;j--)
1582      {
1583        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
1584        if (compare==1)
1585        {
1586          strat->c3++;
1587          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1588          {
1589            pLmFree(Lp.lcm);
1590            return;
1591          }
1592          break;
1593        }
1594        else
1595        if (compare ==-1)
1596        {
1597          deleteInL(strat->B,&strat->Bl,j,strat);
1598          strat->c3++;
1599        }
1600      }
1601    }
1602  }
1603  /*
1604  *the pair (S[i],p) enters B if the spoly != 0
1605  */
1606  /*-  compute the short s-polynomial -*/
1607  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
1608    pNorm(p);
1609
1610  if ((strat->S[i]==NULL) || (p==NULL))
1611    return;
1612
1613  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
1614    Lp.p=NULL;
1615  else
1616  {
1617    #ifdef HAVE_PLURAL
1618    if ( rIsPluralRing(currRing) )
1619    {
1620      if(pHasNotCF(p, strat->S[i]))
1621      {
1622         if(ncRingType(currRing) == nc_lie)
1623         {
1624             // generalized prod-crit for lie-type
1625             strat->cp++;
1626             Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i], currRing);
1627         }
1628         else
1629        if( ALLOW_PROD_CRIT(strat) )
1630        {
1631            // product criterion for homogeneous case in SCA
1632            strat->cp++;
1633            Lp.p = NULL;
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      else
1645      {
1646        Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
1647              nc_CreateShortSpoly(strat->S[i], p, currRing);
1648
1649        assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
1650        pNext(Lp.p) = strat->tail; // !!!
1651
1652      }
1653
1654
1655#if MYTEST
1656      if (TEST_OPT_DEBUG)
1657      {
1658        PrintS("enterOnePairNormal::\n strat->S[i]: "); pWrite(strat->S[i]);
1659        PrintS("p: "); pWrite(p);
1660        PrintS("SPoly: "); pWrite(Lp.p);
1661      }
1662#endif
1663
1664    }
1665    else
1666    #endif
1667    {
1668      assume(!rIsPluralRing(currRing));
1669      Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
1670#if MYTEST
1671      if (TEST_OPT_DEBUG)
1672      {
1673        PrintS("enterOnePairNormal::\n strat->S[i]: "); pWrite(strat->S[i]);
1674        PrintS("p: "); pWrite(p);
1675        PrintS("commutative SPoly: "); pWrite(Lp.p);
1676      }
1677#endif
1678
1679      }
1680  }
1681  if (Lp.p == NULL)
1682  {
1683    /*- the case that the s-poly is 0 -*/
1684    if (strat->pairtest==NULL) initPairtest(strat);
1685    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
1686    strat->pairtest[strat->sl+1] = TRUE;
1687    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
1688    /*
1689    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
1690    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
1691    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
1692    *term of p devides the lcm(s,r)
1693    *(this canceling should be done here because
1694    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
1695    *the first case is handeled in chainCrit
1696    */
1697    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
1698  }
1699  else
1700  {
1701    /*- the pair (S[i],p) enters B -*/
1702    Lp.p1 = strat->S[i];
1703    Lp.p2 = p;
1704
1705    if (
1706        (!rIsPluralRing(currRing))
1707//      ||  (rIsPluralRing(currRing) && (ncRingType(currRing) != nc_lie))
1708       )
1709    {
1710      assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
1711      pNext(Lp.p) = strat->tail; // !!!
1712    }
1713
1714    if (atR >= 0)
1715    {
1716      Lp.i_r1 = strat->S_2_R[i];
1717      Lp.i_r2 = atR;
1718    }
1719    else
1720    {
1721      Lp.i_r1 = -1;
1722      Lp.i_r2 = -1;
1723    }
1724    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1725
1726    if (TEST_OPT_INTSTRATEGY)
1727    {
1728      if (!rIsPluralRing(currRing))
1729        nDelete(&(Lp.p->coef));
1730    }
1731
1732    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
1733    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
1734  }
1735}
1736
1737/*2
1738* put the pair (s[i],p)  into the set B, ecart=ecart(p)
1739* NOTE: here we need to add the signature-based criteria
1740*/
1741
1742void enterOnePairSig (int i, poly p, poly pSig, int from, int ecart, int isFromQ, kStrategy strat, int atR = -1)
1743{
1744  assume(i<=strat->sl);
1745  if (strat->interred_flag) return;
1746
1747  int      l;
1748  poly m1 = NULL,m2 = NULL; // we need the multipliers for the s-polynomial to compute
1749              // the corresponding signatures for criteria checks
1750  LObject  Lp;
1751  poly last;
1752  poly pSigMult = p_Copy(pSig,currRing);
1753  poly sSigMult = p_Copy(strat->sig[i],currRing);
1754  unsigned long pSigMultNegSev,sSigMultNegSev;
1755  Lp.i_r = -1;
1756
1757#ifdef KDEBUG
1758  Lp.ecart=0; Lp.length=0;
1759#endif
1760  /*- computes the lcm(s[i],p) -*/
1761  Lp.lcm = pInit();
1762  k_GetLeadTerms(p,strat->S[i],currRing,m1,m2,currRing);
1763#ifndef HAVE_RATGRING
1764  pLcm(p,strat->S[i],Lp.lcm);
1765#elif defined(HAVE_RATGRING)
1766  //  if (rIsRatGRing(currRing))
1767  pLcmRat(p,strat->S[i],Lp.lcm, currRing->real_var_start); // int rat_shift
1768#endif
1769  pSetm(Lp.lcm);
1770
1771  // set coeffs of multipliers m1 and m2
1772  pSetCoeff0(m1, nInit(1));
1773  pSetCoeff0(m2, nInit(1));
1774//#if 1
1775#ifdef DEBUGF5
1776  Print("P1  ");
1777  pWrite(pHead(p));
1778  Print("FROM: %d\n", from);
1779  Print("P2  ");
1780  pWrite(pHead(strat->S[i]));
1781  Print("FROM: %d\n", strat->fromS[i]);
1782  Print("M1  ");
1783  pWrite(m1);
1784  Print("M2  ");
1785  pWrite(m2);
1786#endif
1787  // get multiplied signatures for testing
1788  pSigMult = currRing->p_Procs->pp_Mult_mm(pSigMult,m1,currRing,last);
1789  pSigMultNegSev = ~p_GetShortExpVector(pSigMult,currRing);
1790  sSigMult = currRing->p_Procs->pp_Mult_mm(sSigMult,m2,currRing,last);
1791  sSigMultNegSev = ~p_GetShortExpVector(sSigMult,currRing);
1792 
1793  pDelete (&m1);
1794  pDelete (&m2);
1795
1796//#if 1
1797#ifdef DEBUGF5
1798  Print("----------------\n");
1799  pWrite(pSigMult);
1800  pWrite(sSigMult);
1801  Print("----------------\n");
1802#endif
1803  // testing by syzCrit = F5 Criterion
1804  // testing by rewCrit1 = Rewritten Criterion
1805  if  ( strat->syzCrit(pSigMult,pSigMultNegSev,strat) ||
1806        strat->syzCrit(sSigMult,sSigMultNegSev,strat) 
1807        || strat->rewCrit1(sSigMult,sSigMultNegSev,strat,i+1)
1808      )
1809  {
1810    pDelete(&pSigMult);
1811    pDelete(&sSigMult);
1812    strat->cp++;
1813    pLmFree(Lp.lcm);
1814    Lp.lcm=NULL;
1815    return;
1816  }
1817  // in any case Lp is checked up to the next strat->P which is added
1818  // to S right after this critical pair creation.
1819  // NOTE: this even holds if the 2nd generator gives the bigger signature
1820  //       moreover, this improves rewCriterion,
1821  //       i.e. strat->checked > strat->from if and only if the 2nd generator
1822  //       gives the bigger signature.
1823  Lp.checked = strat->sl+1;
1824  int sigCmp = p_LmCmp(pSigMult,sSigMult,currRing);
1825//#if 1
1826#if DEBUGF5
1827  printf("IN PAIR GENERATION - COMPARING SIGS: %d\n",sigCmp);
1828  pWrite(pSigMult);
1829  pWrite(sSigMult);
1830#endif
1831  if(sigCmp==0)
1832  {
1833    // printf("!!!!   EQUAL SIGS   !!!!\n");
1834    // pSig = sSig, delete element due to Rewritten Criterion
1835    strat->cp++;
1836    pDelete(&pSigMult);
1837    pDelete(&sSigMult);
1838    pLmFree(Lp.lcm);
1839    Lp.lcm=NULL;
1840    return;
1841  }
1842  // at this point it is clear that the pair will be added to L, since it has
1843  // passed all tests up to now
1844
1845  // store from which element this pair comes from for further tests
1846  Lp.from = strat->sl+1;   
1847  if(sigCmp==currRing->OrdSgn)
1848  {
1849    // pSig > sSig
1850    pDelete (&sSigMult);
1851    Lp.sig    = pSigMult;
1852    Lp.sevSig = ~pSigMultNegSev;
1853  }
1854  else
1855  {
1856    // pSig < sSig
1857    pDelete (&pSigMult);
1858    Lp.sig    = sSigMult;
1859    Lp.sevSig = ~sSigMultNegSev;
1860  }
1861#if DEBUGF5
1862  printf("SIGNATURE OF PAIR:  ");
1863  pWrite(Lp.sig);
1864#endif
1865  /*
1866  *the pair (S[i],p) enters B if the spoly != 0
1867  */
1868  /*-  compute the short s-polynomial -*/
1869  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
1870    pNorm(p);
1871
1872  if ((strat->S[i]==NULL) || (p==NULL))
1873    return;
1874
1875  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
1876    Lp.p=NULL;
1877  else
1878  {
1879    #ifdef HAVE_PLURAL
1880    if ( rIsPluralRing(currRing) )
1881    {
1882      if(pHasNotCF(p, strat->S[i]))
1883      {
1884         if(ncRingType(currRing) == nc_lie)
1885         {
1886             // generalized prod-crit for lie-type
1887             strat->cp++;
1888             Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i], currRing);
1889         }
1890         else
1891        if( ALLOW_PROD_CRIT(strat) )
1892        {
1893            // product criterion for homogeneous case in SCA
1894            strat->cp++;
1895            Lp.p = NULL;
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      else
1907      {
1908        Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
1909              nc_CreateShortSpoly(strat->S[i], p, currRing);
1910
1911        assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
1912        pNext(Lp.p) = strat->tail; // !!!
1913
1914      }
1915
1916
1917#if MYTEST
1918      if (TEST_OPT_DEBUG)
1919      {
1920        PrintS("enterOnePairNormal::\n strat->S[i]: "); pWrite(strat->S[i]);
1921        PrintS("p: "); pWrite(p);
1922        PrintS("SPoly: "); pWrite(Lp.p);
1923      }
1924#endif
1925
1926    }
1927    else
1928    #endif
1929    {
1930      assume(!rIsPluralRing(currRing));
1931      Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
1932#if MYTEST
1933      if (TEST_OPT_DEBUG)
1934      {
1935        PrintS("enterOnePairNormal::\n strat->S[i]: "); pWrite(strat->S[i]);
1936        PrintS("p: "); pWrite(p);
1937        PrintS("commutative SPoly: "); pWrite(Lp.p);
1938      }
1939#endif
1940
1941      }
1942  }
1943  if (Lp.p == NULL)
1944  {
1945    /*- the case that the s-poly is 0 -*/
1946    if (strat->pairtest==NULL) initPairtest(strat);
1947    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
1948    strat->pairtest[strat->sl+1] = TRUE;
1949    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
1950    /*
1951    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
1952    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
1953    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
1954    *term of p devides the lcm(s,r)
1955    *(this canceling should be done here because
1956    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
1957    *the first case is handeled in chainCrit
1958    */
1959    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
1960  }
1961  else
1962  {
1963    /*- the pair (S[i],p) enters B -*/
1964    Lp.p1 = strat->S[i];
1965    Lp.p2 = p;
1966
1967    if (
1968        (!rIsPluralRing(currRing))
1969//      ||  (rIsPluralRing(currRing) && (ncRingType(currRing) != nc_lie))
1970       )
1971    {
1972      assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
1973      pNext(Lp.p) = strat->tail; // !!!
1974    }
1975
1976    if (atR >= 0)
1977    {
1978      Lp.i_r1 = strat->S_2_R[i];
1979      Lp.i_r2 = atR;
1980    }
1981    else
1982    {
1983      Lp.i_r1 = -1;
1984      Lp.i_r2 = -1;
1985    }
1986    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1987
1988    if (TEST_OPT_INTSTRATEGY)
1989    {
1990      if (!rIsPluralRing(currRing))
1991        nDelete(&(Lp.p->coef));
1992    }
1993
1994    l = strat->posInLSba(strat->B,strat->Bl,&Lp,strat);
1995    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
1996  }
1997}
1998
1999/*2
2000* put the pair (s[i],p) into the set L, ecart=ecart(p)
2001* in the case that s forms a SB of (s)
2002*/
2003void enterOnePairSpecial (int i,poly p,int ecart,kStrategy strat, int atR = -1)
2004{
2005  //PrintS("try ");wrp(strat->S[i]);PrintS(" and ");wrp(p);PrintLn();
2006  if(pHasNotCF(p,strat->S[i]))
2007  {
2008    //PrintS("prod-crit\n");
2009    if(ALLOW_PROD_CRIT(strat))
2010    {
2011      //PrintS("prod-crit\n");
2012      strat->cp++;
2013      return;
2014    }
2015  }
2016
2017  int      l,j,compare;
2018  LObject  Lp;
2019  Lp.i_r = -1;
2020
2021  Lp.lcm = pInit();
2022  pLcm(p,strat->S[i],Lp.lcm);
2023  pSetm(Lp.lcm);
2024  for(j = strat->Ll;j>=0;j--)
2025  {
2026    compare=pDivComp(strat->L[j].lcm,Lp.lcm);
2027    if ((compare==1) || (pLmEqual(strat->L[j].lcm,Lp.lcm)))
2028    {
2029      //PrintS("c3-crit\n");
2030      strat->c3++;
2031      pLmFree(Lp.lcm);
2032      return;
2033    }
2034    else if (compare ==-1)
2035    {
2036      //Print("c3-crit with L[%d]\n",j);
2037      deleteInL(strat->L,&strat->Ll,j,strat);
2038      strat->c3++;
2039    }
2040  }
2041  /*-  compute the short s-polynomial -*/
2042
2043  #ifdef HAVE_PLURAL
2044  if (rIsPluralRing(currRing))
2045  {
2046    Lp.p = nc_CreateShortSpoly(strat->S[i],p, currRing); // ??? strat->tailRing?
2047  }
2048  else
2049  #endif
2050    Lp.p = ksCreateShortSpoly(strat->S[i],p,strat->tailRing);
2051
2052  if (Lp.p == NULL)
2053  {
2054     //PrintS("short spoly==NULL\n");
2055     pLmFree(Lp.lcm);
2056  }
2057  else
2058  {
2059    /*- the pair (S[i],p) enters L -*/
2060    Lp.p1 = strat->S[i];
2061    Lp.p2 = p;
2062    if (atR >= 0)
2063    {
2064      Lp.i_r1 = strat->S_2_R[i];
2065      Lp.i_r2 = atR;
2066    }
2067    else
2068    {
2069      Lp.i_r1 = -1;
2070      Lp.i_r2 = -1;
2071    }
2072    assume(pNext(Lp.p) == NULL);
2073    pNext(Lp.p) = strat->tail;
2074    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
2075    if (TEST_OPT_INTSTRATEGY)
2076    {
2077      nDelete(&(Lp.p->coef));
2078    }
2079    l = strat->posInL(strat->L,strat->Ll,&Lp,strat);
2080    //Print("-> L[%d]\n",l);
2081    enterL(&strat->L,&strat->Ll,&strat->Lmax,Lp,l);
2082  }
2083}
2084
2085/*2
2086* merge set B into L
2087*/
2088void kMergeBintoL(kStrategy strat)
2089{
2090  int j=strat->Ll+strat->Bl+1;
2091  if (j>strat->Lmax)
2092  {
2093    j=((j+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
2094    strat->L = (LSet)omReallocSize(strat->L,strat->Lmax*sizeof(LObject),
2095                                 j*sizeof(LObject));
2096    strat->Lmax=j;
2097  }
2098  j = strat->Ll;
2099  int i;
2100  for (i=strat->Bl; i>=0; i--)
2101  {
2102    j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
2103    enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
2104  }
2105  strat->Bl = -1;
2106}
2107
2108/*2
2109* merge set B into L
2110*/
2111void kMergeBintoLSba(kStrategy strat)
2112{
2113  int j=strat->Ll+strat->Bl+1;
2114  if (j>strat->Lmax)
2115  {
2116    j=((j+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
2117    strat->L = (LSet)omReallocSize(strat->L,strat->Lmax*sizeof(LObject),
2118                                 j*sizeof(LObject));
2119    strat->Lmax=j;
2120  }
2121  j = strat->Ll;
2122  int i;
2123  for (i=strat->Bl; i>=0; i--)
2124  {
2125    j = strat->posInLSba(strat->L,j,&(strat->B[i]),strat);
2126    enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
2127  }
2128  strat->Bl = -1;
2129}
2130/*2
2131*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
2132*using the chain-criterion in B and L and enters B to L
2133*/
2134void chainCritNormal (poly p,int ecart,kStrategy strat)
2135{
2136  int i,j,l;
2137
2138  /*
2139  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
2140  *In this case all elements in B such
2141  *that their lcm is divisible by the leading term of S[i] can be canceled
2142  */
2143  if (strat->pairtest!=NULL)
2144  {
2145    {
2146      /*- i.e. there is an i with pairtest[i]==TRUE -*/
2147      for (j=0; j<=strat->sl; j++)
2148      {
2149        if (strat->pairtest[j])
2150        {
2151          for (i=strat->Bl; i>=0; i--)
2152          {
2153            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
2154            {
2155              deleteInL(strat->B,&strat->Bl,i,strat);
2156              strat->c3++;
2157            }
2158          }
2159        }
2160      }
2161    }
2162    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
2163    strat->pairtest=NULL;
2164  }
2165  if (strat->Gebauer || strat->fromT)
2166  {
2167    if (strat->sugarCrit)
2168    {
2169    /*
2170    *suppose L[j] == (s,r) and p/lcm(s,r)
2171    *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
2172    *and in case the sugar is o.k. then L[j] can be canceled
2173    */
2174      for (j=strat->Ll; j>=0; j--)
2175      {
2176        if (sugarDivisibleBy(ecart,strat->L[j].ecart)
2177        && ((pNext(strat->L[j].p) == strat->tail) || (currRing->OrdSgn==1))
2178        && pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2179        {
2180          if (strat->L[j].p == strat->tail)
2181          {
2182              deleteInL(strat->L,&strat->Ll,j,strat);
2183              strat->c3++;
2184          }
2185        }
2186      }
2187      /*
2188      *this is GEBAUER-MOELLER:
2189      *in B all elements with the same lcm except the "best"
2190      *(i.e. the last one in B with this property) will be canceled
2191      */
2192      j = strat->Bl;
2193      loop /*cannot be changed into a for !!! */
2194      {
2195        if (j <= 0) break;
2196        i = j-1;
2197        loop
2198        {
2199          if (i <  0) break;
2200          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
2201          {
2202            strat->c3++;
2203            if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
2204            {
2205              deleteInL(strat->B,&strat->Bl,i,strat);
2206              j--;
2207            }
2208            else
2209            {
2210              deleteInL(strat->B,&strat->Bl,j,strat);
2211              break;
2212            }
2213          }
2214          i--;
2215        }
2216        j--;
2217      }
2218    }
2219    else /*sugarCrit*/
2220    {
2221      /*
2222      *suppose L[j] == (s,r) and p/lcm(s,r)
2223      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
2224      *and in case the sugar is o.k. then L[j] can be canceled
2225      */
2226      for (j=strat->Ll; j>=0; j--)
2227      {
2228        if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2229        {
2230          if ((pNext(strat->L[j].p) == strat->tail)||(currRing->OrdSgn==1))
2231          {
2232            deleteInL(strat->L,&strat->Ll,j,strat);
2233            strat->c3++;
2234          }
2235        }
2236      }
2237      /*
2238      *this is GEBAUER-MOELLER:
2239      *in B all elements with the same lcm except the "best"
2240      *(i.e. the last one in B with this property) will be canceled
2241      */
2242      j = strat->Bl;
2243      loop   /*cannot be changed into a for !!! */
2244      {
2245        if (j <= 0) break;
2246        for(i=j-1; i>=0; i--)
2247        {
2248          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
2249          {
2250            strat->c3++;
2251            deleteInL(strat->B,&strat->Bl,i,strat);
2252            j--;
2253          }
2254        }
2255        j--;
2256      }
2257    }
2258    /*
2259    *the elements of B enter L
2260    */
2261    kMergeBintoL(strat);
2262  }
2263  else
2264  {
2265    for (j=strat->Ll; j>=0; j--)
2266    {
2267      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2268      {
2269        if ((pNext(strat->L[j].p) == strat->tail)||(currRing->OrdSgn==1))
2270        {
2271          deleteInL(strat->L,&strat->Ll,j,strat);
2272          strat->c3++;
2273        }
2274      }
2275    }
2276    /*
2277    *this is our MODIFICATION of GEBAUER-MOELLER:
2278    *First the elements of B enter L,
2279    *then we fix a lcm and the "best" element in L
2280    *(i.e the last in L with this lcm and of type (s,p))
2281    *and cancel all the other elements of type (r,p) with this lcm
2282    *except the case the element (s,r) has also the same lcm
2283    *and is on the worst position with respect to (s,p) and (r,p)
2284    */
2285    /*
2286    *B enters to L/their order with respect to B is permutated for elements
2287    *B[i].p with the same leading term
2288    */
2289    kMergeBintoL(strat);
2290    j = strat->Ll;
2291    loop  /*cannot be changed into a for !!! */
2292    {
2293      if (j <= 0)
2294      {
2295        /*now L[0] cannot be canceled any more and the tail can be removed*/
2296        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2297        break;
2298      }
2299      if (strat->L[j].p2 == p)
2300      {
2301        i = j-1;
2302        loop
2303        {
2304          if (i < 0)  break;
2305          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2306          {
2307            /*L[i] could be canceled but we search for a better one to cancel*/
2308            strat->c3++;
2309            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2310            && (pNext(strat->L[l].p) == strat->tail)
2311            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2312            && pDivisibleBy(p,strat->L[l].lcm))
2313            {
2314              /*
2315              *"NOT equal(...)" because in case of "equal" the element L[l]
2316              *is "older" and has to be from theoretical point of view behind
2317              *L[i], but we do not want to reorder L
2318              */
2319              strat->L[i].p2 = strat->tail;
2320              /*
2321              *L[l] will be canceled, we cannot cancel L[i] later on,
2322              *so we mark it with "tail"
2323              */
2324              deleteInL(strat->L,&strat->Ll,l,strat);
2325              i--;
2326            }
2327            else
2328            {
2329              deleteInL(strat->L,&strat->Ll,i,strat);
2330            }
2331            j--;
2332          }
2333          i--;
2334        }
2335      }
2336      else if (strat->L[j].p2 == strat->tail)
2337      {
2338        /*now L[j] cannot be canceled any more and the tail can be removed*/
2339        strat->L[j].p2 = p;
2340      }
2341      j--;
2342    }
2343  }
2344}
2345/*2
2346*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
2347*using the chain-criterion in B and L and enters B to L
2348*/
2349void chainCritSig (poly p,int ecart,kStrategy strat)
2350{
2351  int i,j,l;
2352  kMergeBintoLSba(strat);
2353  j = strat->Ll;
2354  loop  /*cannot be changed into a for !!! */
2355  {
2356    if (j <= 0)
2357    {
2358      /*now L[0] cannot be canceled any more and the tail can be removed*/
2359      if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2360      break;
2361    }
2362    if (strat->L[j].p2 == p)
2363    {
2364      i = j-1;
2365      loop
2366      {
2367        if (i < 0)  break;
2368        if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2369        {
2370          /*L[i] could be canceled but we search for a better one to cancel*/
2371          strat->c3++;
2372          if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2373              && (pNext(strat->L[l].p) == strat->tail)
2374              && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2375              && pDivisibleBy(p,strat->L[l].lcm))
2376          {
2377            /*
2378             *"NOT equal(...)" because in case of "equal" the element L[l]
2379             *is "older" and has to be from theoretical point of view behind
2380             *L[i], but we do not want to reorder L
2381             */
2382            strat->L[i].p2 = strat->tail;
2383            /*
2384             *L[l] will be canceled, we cannot cancel L[i] later on,
2385             *so we mark it with "tail"
2386             */
2387            deleteInL(strat->L,&strat->Ll,l,strat);
2388            i--;
2389          }
2390          else
2391          {
2392            deleteInL(strat->L,&strat->Ll,i,strat);
2393          }
2394          j--;
2395        }
2396        i--;
2397      }
2398    }
2399    else if (strat->L[j].p2 == strat->tail)
2400    {
2401      /*now L[j] cannot be canceled any more and the tail can be removed*/
2402      strat->L[j].p2 = p;
2403    }
2404    j--;
2405  }
2406}
2407#ifdef HAVE_RATGRING
2408void chainCritPart (poly p,int ecart,kStrategy strat)
2409{
2410  int i,j,l;
2411
2412  /*
2413  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
2414  *In this case all elements in B such
2415  *that their lcm is divisible by the leading term of S[i] can be canceled
2416  */
2417  if (strat->pairtest!=NULL)
2418  {
2419    {
2420      /*- i.e. there is an i with pairtest[i]==TRUE -*/
2421      for (j=0; j<=strat->sl; j++)
2422      {
2423        if (strat->pairtest[j])
2424        {
2425          for (i=strat->Bl; i>=0; i--)
2426          {
2427            if (_p_LmDivisibleByPart(strat->S[j],currRing,
2428               strat->B[i].lcm,currRing,
2429               currRing->real_var_start,currRing->real_var_end))
2430            {
2431              if(TEST_OPT_DEBUG)
2432              {
2433                 Print("chain-crit-part: S[%d]=",j);
2434                 p_wrp(strat->S[j],currRing);
2435                 Print(" divide B[%d].lcm=",i);
2436                 p_wrp(strat->B[i].lcm,currRing);
2437                 PrintLn();
2438              }
2439              deleteInL(strat->B,&strat->Bl,i,strat);
2440              strat->c3++;
2441            }
2442          }
2443        }
2444      }
2445    }
2446    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
2447    strat->pairtest=NULL;
2448  }
2449  if (strat->Gebauer || strat->fromT)
2450  {
2451    if (strat->sugarCrit)
2452    {
2453    /*
2454    *suppose L[j] == (s,r) and p/lcm(s,r)
2455    *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
2456    *and in case the sugar is o.k. then L[j] can be canceled
2457    */
2458      for (j=strat->Ll; j>=0; j--)
2459      {
2460        if (sugarDivisibleBy(ecart,strat->L[j].ecart)
2461        && ((pNext(strat->L[j].p) == strat->tail) || (currRing->OrdSgn==1))
2462        && pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2463        {
2464          if (strat->L[j].p == strat->tail)
2465          {
2466              if(TEST_OPT_DEBUG)
2467              {
2468                 PrintS("chain-crit-part: pCompareChainPart p=");
2469                 p_wrp(p,currRing);
2470                 Print(" delete L[%d]",j);
2471                 p_wrp(strat->L[j].lcm,currRing);
2472                 PrintLn();
2473              }
2474              deleteInL(strat->L,&strat->Ll,j,strat);
2475              strat->c3++;
2476          }
2477        }
2478      }
2479      /*
2480      *this is GEBAUER-MOELLER:
2481      *in B all elements with the same lcm except the "best"
2482      *(i.e. the last one in B with this property) will be canceled
2483      */
2484      j = strat->Bl;
2485      loop /*cannot be changed into a for !!! */
2486      {
2487        if (j <= 0) break;
2488        i = j-1;
2489        loop
2490        {
2491          if (i <  0) break;
2492          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
2493          {
2494            strat->c3++;
2495            if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
2496            {
2497              if(TEST_OPT_DEBUG)
2498              {
2499                 Print("chain-crit-part: sugar B[%d].lcm=",j);
2500                 p_wrp(strat->B[j].lcm,currRing);
2501                 Print(" delete B[%d]",i);
2502                 p_wrp(strat->B[i].lcm,currRing);
2503                 PrintLn();
2504              }
2505              deleteInL(strat->B,&strat->Bl,i,strat);
2506              j--;
2507            }
2508            else
2509            {
2510              if(TEST_OPT_DEBUG)
2511              {
2512                 Print("chain-crit-part: sugar B[%d].lcm=",i);
2513                 p_wrp(strat->B[i].lcm,currRing);
2514                 Print(" delete B[%d]",j);
2515                 p_wrp(strat->B[j].lcm,currRing);
2516                 PrintLn();
2517              }
2518              deleteInL(strat->B,&strat->Bl,j,strat);
2519              break;
2520            }
2521          }
2522          i--;
2523        }
2524        j--;
2525      }
2526    }
2527    else /*sugarCrit*/
2528    {
2529      /*
2530      *suppose L[j] == (s,r) and p/lcm(s,r)
2531      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
2532      *and in case the sugar is o.k. then L[j] can be canceled
2533      */
2534      for (j=strat->Ll; j>=0; j--)
2535      {
2536        if (pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2537        {
2538          if ((pNext(strat->L[j].p) == strat->tail)||(currRing->OrdSgn==1))
2539          {
2540              if(TEST_OPT_DEBUG)
2541              {
2542                 PrintS("chain-crit-part: sugar:pCompareChainPart p=");
2543                 p_wrp(p,currRing);
2544                 Print(" delete L[%d]",j);
2545                 p_wrp(strat->L[j].lcm,currRing);
2546                 PrintLn();
2547              }
2548            deleteInL(strat->L,&strat->Ll,j,strat);
2549            strat->c3++;
2550          }
2551        }
2552      }
2553      /*
2554      *this is GEBAUER-MOELLER:
2555      *in B all elements with the same lcm except the "best"
2556      *(i.e. the last one in B with this property) will be canceled
2557      */
2558      j = strat->Bl;
2559      loop   /*cannot be changed into a for !!! */
2560      {
2561        if (j <= 0) break;
2562        for(i=j-1; i>=0; i--)
2563        {
2564          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
2565          {
2566              if(TEST_OPT_DEBUG)
2567              {
2568                 Print("chain-crit-part: equal lcm B[%d].lcm=",j);
2569                 p_wrp(strat->B[j].lcm,currRing);
2570                 Print(" delete B[%d]\n",i);
2571              }
2572            strat->c3++;
2573            deleteInL(strat->B,&strat->Bl,i,strat);
2574            j--;
2575          }
2576        }
2577        j--;
2578      }
2579    }
2580    /*
2581    *the elements of B enter L
2582    */
2583    kMergeBintoL(strat);
2584  }
2585  else
2586  {
2587    for (j=strat->Ll; j>=0; j--)
2588    {
2589      if (pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2590      {
2591        if ((pNext(strat->L[j].p) == strat->tail)||(currRing->OrdSgn==1))
2592        {
2593              if(TEST_OPT_DEBUG)
2594              {
2595                 PrintS("chain-crit-part: pCompareChainPart p=");
2596                 p_wrp(p,currRing);
2597                 Print(" delete L[%d]",j);
2598                 p_wrp(strat->L[j].lcm,currRing);
2599                 PrintLn();
2600              }
2601          deleteInL(strat->L,&strat->Ll,j,strat);
2602          strat->c3++;
2603        }
2604      }
2605    }
2606    /*
2607    *this is our MODIFICATION of GEBAUER-MOELLER:
2608    *First the elements of B enter L,
2609    *then we fix a lcm and the "best" element in L
2610    *(i.e the last in L with this lcm and of type (s,p))
2611    *and cancel all the other elements of type (r,p) with this lcm
2612    *except the case the element (s,r) has also the same lcm
2613    *and is on the worst position with respect to (s,p) and (r,p)
2614    */
2615    /*
2616    *B enters to L/their order with respect to B is permutated for elements
2617    *B[i].p with the same leading term
2618    */
2619    kMergeBintoL(strat);
2620    j = strat->Ll;
2621    loop  /*cannot be changed into a for !!! */
2622    {
2623      if (j <= 0)
2624      {
2625        /*now L[0] cannot be canceled any more and the tail can be removed*/
2626        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2627        break;
2628      }
2629      if (strat->L[j].p2 == p)
2630      {
2631        i = j-1;
2632        loop
2633        {
2634          if (i < 0)  break;
2635          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2636          {
2637            /*L[i] could be canceled but we search for a better one to cancel*/
2638            strat->c3++;
2639            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2640            && (pNext(strat->L[l].p) == strat->tail)
2641            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2642            && _p_LmDivisibleByPart(p,currRing,
2643                           strat->L[l].lcm,currRing,
2644                           currRing->real_var_start, currRing->real_var_end))
2645
2646            {
2647              /*
2648              *"NOT equal(...)" because in case of "equal" the element L[l]
2649              *is "older" and has to be from theoretical point of view behind
2650              *L[i], but we do not want to reorder L
2651              */
2652              strat->L[i].p2 = strat->tail;
2653              /*
2654              *L[l] will be canceled, we cannot cancel L[i] later on,
2655              *so we mark it with "tail"
2656              */
2657              if(TEST_OPT_DEBUG)
2658              {
2659                 PrintS("chain-crit-part: divisible_by p=");
2660                 p_wrp(p,currRing);
2661                 Print(" delete L[%d]",l);
2662                 p_wrp(strat->L[l].lcm,currRing);
2663                 PrintLn();
2664              }
2665              deleteInL(strat->L,&strat->Ll,l,strat);
2666              i--;
2667            }
2668            else
2669            {
2670              if(TEST_OPT_DEBUG)
2671              {
2672                 PrintS("chain-crit-part: divisible_by(2) p=");
2673                 p_wrp(p,currRing);
2674                 Print(" delete L[%d]",i);
2675                 p_wrp(strat->L[i].lcm,currRing);
2676                 PrintLn();
2677              }
2678              deleteInL(strat->L,&strat->Ll,i,strat);
2679            }
2680            j--;
2681          }
2682          i--;
2683        }
2684      }
2685      else if (strat->L[j].p2 == strat->tail)
2686      {
2687        /*now L[j] cannot be canceled any more and the tail can be removed*/
2688        strat->L[j].p2 = p;
2689      }
2690      j--;
2691    }
2692  }
2693}
2694#endif
2695
2696/*2
2697*(s[0],h),...,(s[k],h) will be put to the pairset L
2698*/
2699void initenterpairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2700{
2701
2702  if ((strat->syzComp==0)
2703  || (pGetComp(h)<=strat->syzComp))
2704  {
2705    int j;
2706    BOOLEAN new_pair=FALSE;
2707
2708    if (pGetComp(h)==0)
2709    {
2710      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
2711      if ((isFromQ)&&(strat->fromQ!=NULL))
2712      {
2713        for (j=0; j<=k; j++)
2714        {
2715          if (!strat->fromQ[j])
2716          {
2717            new_pair=TRUE;
2718            strat->enterOnePair(j,h,ecart,isFromQ,strat, atR);
2719          //Print("j:%d, Ll:%d\n",j,strat->Ll);
2720          }
2721        }
2722      }
2723      else
2724      {
2725        new_pair=TRUE;
2726        for (j=0; j<=k; j++)
2727        {
2728          strat->enterOnePair(j,h,ecart,isFromQ,strat, atR);
2729          //Print("j:%d, Ll:%d\n",j,strat->Ll);
2730        }
2731      }
2732    }
2733    else
2734    {
2735      for (j=0; j<=k; j++)
2736      {
2737        if ((pGetComp(h)==pGetComp(strat->S[j]))
2738        || (pGetComp(strat->S[j])==0))
2739        {
2740          new_pair=TRUE;
2741          strat->enterOnePair(j,h,ecart,isFromQ,strat, atR);
2742        //Print("j:%d, Ll:%d\n",j,strat->Ll);
2743        }
2744      }
2745    }
2746
2747    if (new_pair)
2748    {
2749#ifdef HAVE_RATGRING
2750      if (currRing->real_var_start>0)
2751        chainCritPart(h,ecart,strat);
2752      else
2753#endif
2754      strat->chainCrit(h,ecart,strat);
2755    }
2756  }
2757}
2758
2759/*2
2760*(s[0],h),...,(s[k],h) will be put to the pairset L
2761*using signatures <= only for signature-based standard basis algorithms
2762*/
2763void initenterpairsSig (poly h,poly hSig,int hFrom,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2764{
2765
2766  if ((strat->syzComp==0)
2767  || (pGetComp(h)<=strat->syzComp))
2768  {
2769    int j;
2770    BOOLEAN new_pair=FALSE;
2771
2772    if (pGetComp(h)==0)
2773    {
2774      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
2775      if ((isFromQ)&&(strat->fromQ!=NULL))
2776      {
2777        for (j=0; j<=k; j++)
2778        {
2779          if (!strat->fromQ[j])
2780          {
2781            new_pair=TRUE;
2782            enterOnePairSig(j,h,hSig,hFrom,ecart,isFromQ,strat, atR);
2783          //Print("j:%d, Ll:%d\n",j,strat->Ll);
2784          }
2785        }
2786      }
2787      else
2788      {
2789        new_pair=TRUE;
2790        for (j=0; j<=k; j++)
2791        {
2792          enterOnePairSig(j,h,hSig,hFrom,ecart,isFromQ,strat, atR);
2793          //Print("j:%d, Ll:%d\n",j,strat->Ll);
2794        }
2795      }
2796    }
2797    else
2798    {
2799      for (j=0; j<=k; j++)
2800      {
2801        if ((pGetComp(h)==pGetComp(strat->S[j]))
2802        || (pGetComp(strat->S[j])==0))
2803        {
2804          new_pair=TRUE;
2805          enterOnePairSig(j,h,hSig,hFrom,ecart,isFromQ,strat, atR);
2806        //Print("j:%d, Ll:%d\n",j,strat->Ll);
2807        }
2808      }
2809    }
2810
2811    if (new_pair)
2812    {
2813#ifdef HAVE_RATGRING
2814      if (currRing->real_var_start>0)
2815        chainCritPart(h,ecart,strat);
2816      else
2817#endif
2818      strat->chainCrit(h,ecart,strat);
2819    }
2820  }
2821}
2822
2823#ifdef HAVE_RINGS
2824/*2
2825*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
2826*using the chain-criterion in B and L and enters B to L
2827*/
2828void chainCritRing (poly p,int, kStrategy strat)
2829{
2830  int i,j,l;
2831  /*
2832  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
2833  *In this case all elements in B such
2834  *that their lcm is divisible by the leading term of S[i] can be canceled
2835  */
2836  if (strat->pairtest!=NULL)
2837  {
2838    {
2839      /*- i.e. there is an i with pairtest[i]==TRUE -*/
2840      for (j=0; j<=strat->sl; j++)
2841      {
2842        if (strat->pairtest[j])
2843        {
2844          for (i=strat->Bl; i>=0; i--)
2845          {
2846            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
2847            {
2848#ifdef KDEBUG
2849              if (TEST_OPT_DEBUG)
2850              {
2851                PrintS("--- chain criterion func chainCritRing type 1\n");
2852                PrintS("strat->S[j]:");
2853                wrp(strat->S[j]);
2854                PrintS("  strat->B[i].lcm:");
2855                wrp(strat->B[i].lcm);
2856                PrintLn();
2857              }
2858#endif
2859              deleteInL(strat->B,&strat->Bl,i,strat);
2860              strat->c3++;
2861            }
2862          }
2863        }
2864      }
2865    }
2866    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
2867    strat->pairtest=NULL;
2868  }
2869  assume(!(strat->Gebauer || strat->fromT));
2870  for (j=strat->Ll; j>=0; j--)
2871  {
2872    if (strat->L[j].lcm != NULL && n_DivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(p), currRing->cf))
2873    {
2874      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2875      {
2876        if ((pNext(strat->L[j].p) == strat->tail) || (currRing->OrdSgn==1))
2877        {
2878          deleteInL(strat->L,&strat->Ll,j,strat);
2879          strat->c3++;
2880#ifdef KDEBUG
2881              if (TEST_OPT_DEBUG)
2882              {
2883                PrintS("--- chain criterion func chainCritRing type 2\n");
2884                PrintS("strat->L[j].p:");
2885                wrp(strat->L[j].p);
2886                PrintS("  p:");
2887                wrp(p);
2888                PrintLn();
2889              }
2890#endif
2891        }
2892      }
2893    }
2894  }
2895  /*
2896  *this is our MODIFICATION of GEBAUER-MOELLER:
2897  *First the elements of B enter L,
2898  *then we fix a lcm and the "best" element in L
2899  *(i.e the last in L with this lcm and of type (s,p))
2900  *and cancel all the other elements of type (r,p) with this lcm
2901  *except the case the element (s,r) has also the same lcm
2902  *and is on the worst position with respect to (s,p) and (r,p)
2903  */
2904  /*
2905  *B enters to L/their order with respect to B is permutated for elements
2906  *B[i].p with the same leading term
2907  */
2908  kMergeBintoL(strat);
2909  j = strat->Ll;
2910  loop  /*cannot be changed into a for !!! */
2911  {
2912    if (j <= 0)
2913    {
2914      /*now L[0] cannot be canceled any more and the tail can be removed*/
2915      if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2916      break;
2917    }
2918    if (strat->L[j].p2 == p) // Was the element added from B?
2919    {
2920      i = j-1;
2921      loop
2922      {
2923        if (i < 0)  break;
2924        // Element is from B and has the same lcm as L[j]
2925        if ((strat->L[i].p2 == p) && n_DivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(strat->L[i].lcm), currRing->cf)
2926             && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2927        {
2928          /*L[i] could be canceled but we search for a better one to cancel*/
2929          strat->c3++;
2930#ifdef KDEBUG
2931          if (TEST_OPT_DEBUG)
2932          {
2933            PrintS("--- chain criterion func chainCritRing type 3\n");
2934            PrintS("strat->L[j].lcm:");
2935            wrp(strat->L[j].lcm);
2936            PrintS("  strat->L[i].lcm:");
2937            wrp(strat->L[i].lcm);
2938            PrintLn();
2939          }
2940#endif
2941          if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2942          && (pNext(strat->L[l].p) == strat->tail)
2943          && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2944          && pDivisibleBy(p,strat->L[l].lcm))
2945          {
2946            /*
2947            *"NOT equal(...)" because in case of "equal" the element L[l]
2948            *is "older" and has to be from theoretical point of view behind
2949            *L[i], but we do not want to reorder L
2950            */
2951            strat->L[i].p2 = strat->tail;
2952            /*
2953            *L[l] will be canceled, we cannot cancel L[i] later on,
2954            *so we mark it with "tail"
2955            */
2956            deleteInL(strat->L,&strat->Ll,l,strat);
2957            i--;
2958          }
2959          else
2960          {
2961            deleteInL(strat->L,&strat->Ll,i,strat);
2962          }
2963          j--;
2964        }
2965        i--;
2966      }
2967    }
2968    else if (strat->L[j].p2 == strat->tail)
2969    {
2970      /*now L[j] cannot be canceled any more and the tail can be removed*/
2971      strat->L[j].p2 = p;
2972    }
2973    j--;
2974  }
2975}
2976#endif
2977
2978#ifdef HAVE_RINGS
2979long ind2(long arg)
2980{
2981  long ind = 0;
2982  if (arg <= 0) return 0;
2983  while (arg%2 == 0)
2984  {
2985    arg = arg / 2;
2986    ind++;
2987  }
2988  return ind;
2989}
2990
2991long ind_fact_2(long arg)
2992{
2993  long ind = 0;
2994  if (arg <= 0) return 0;
2995  if (arg%2 == 1) { arg--; }
2996  while (arg > 0)
2997  {
2998    ind += ind2(arg);
2999    arg = arg - 2;
3000  }
3001  return ind;
3002}
3003#endif
3004
3005#ifdef HAVE_VANIDEAL
3006long twoPow(long arg)
3007{
3008  return 1L << arg;
3009}
3010
3011/*2
3012* put the pair (p, f) in B and f in T
3013*/
3014void enterOneZeroPairRing (poly f, poly t_p, poly p, int ecart, kStrategy strat, int atR = -1)
3015{
3016  int      l,j,compare,compareCoeff;
3017  LObject  Lp;
3018
3019  if (strat->interred_flag) return;
3020#ifdef KDEBUG
3021  Lp.ecart=0; Lp.length=0;
3022#endif
3023  /*- computes the lcm(s[i],p) -*/
3024  Lp.lcm = pInit();
3025
3026  pLcm(p,f,Lp.lcm);
3027  pSetm(Lp.lcm);
3028  pSetCoeff(Lp.lcm, nLcm(pGetCoeff(p), pGetCoeff(f), currRing));
3029  assume(!strat->sugarCrit);
3030  assume(!strat->fromT);
3031  /*
3032  *the set B collects the pairs of type (S[j],p)
3033  *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
3034  *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
3035  *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
3036  */
3037  for(j = strat->Bl;j>=0;j--)
3038  {
3039    compare=pDivCompRing(strat->B[j].lcm,Lp.lcm);
3040    compareCoeff = nDivComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(Lp.lcm));
3041    if (compareCoeff == 0 || compare == compareCoeff)
3042    {
3043      if (compare == 1)
3044      {
3045        strat->c3++;
3046        pLmDelete(Lp.lcm);
3047        return;
3048      }
3049      else
3050      if (compare == -1)
3051      {
3052        deleteInL(strat->B,&strat->Bl,j,strat);
3053        strat->c3++;
3054      }
3055    }
3056    if (compare == pDivComp_EQUAL)
3057    {
3058      // Add hint for same LM and direction of LC (later) (TODO Oliver)
3059      if (compareCoeff == 1)
3060      {
3061        strat->c3++;
3062        pLmDelete(Lp.lcm);
3063        return;
3064      }
3065      else
3066      if (compareCoeff == -1)
3067      {
3068        deleteInL(strat->B,&strat->Bl,j,strat);
3069        strat->c3++;
3070      }
3071    }
3072  }
3073  /*
3074  *the pair (S[i],p) enters B if the spoly != 0
3075  */
3076  /*-  compute the short s-polynomial -*/
3077  if ((f==NULL) || (p==NULL)) return;
3078  pNorm(p);
3079  {
3080    Lp.p = ksCreateShortSpoly(f, p, strat->tailRing);
3081  }
3082  if (Lp.p == NULL) //deactivated, as we are adding pairs with zeropoly and not from S
3083  {
3084    /*- the case that the s-poly is 0 -*/
3085//    if (strat->pairtest==NULL) initPairtest(strat);
3086//    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
3087//    strat->pairtest[strat->sl+1] = TRUE;
3088    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
3089    /*
3090    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
3091    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
3092    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
3093    *term of p devides the lcm(s,r)
3094    *(this canceling should be done here because
3095    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
3096    *the first case is handeled in chainCrit
3097    */
3098    if (Lp.lcm!=NULL) pLmDelete(Lp.lcm);
3099  }
3100  else
3101  {
3102    /*- the pair (S[i],p) enters B -*/
3103    Lp.p1 = f;
3104    Lp.p2 = p;
3105
3106    pNext(Lp.p) = strat->tail;
3107
3108    LObject tmp_h(f, currRing, strat->tailRing);
3109    tmp_h.SetShortExpVector();
3110    strat->initEcart(&tmp_h);
3111    tmp_h.sev = pGetShortExpVector(tmp_h.p);
3112    tmp_h.t_p = t_p;
3113
3114    enterT(tmp_h, strat, strat->tl + 1);
3115
3116    if (atR >= 0)
3117    {
3118      Lp.i_r2 = atR;
3119      Lp.i_r1 = strat->tl;
3120    }
3121
3122    strat->initEcartPair(&Lp,f,p,0/*strat->ecartS[i]*/,ecart);     // Attention: TODO: break ecart
3123    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
3124    enterL(&strat->B, &strat->Bl, &strat->Bmax, Lp, l);
3125  }
3126}
3127
3128/* Helper for kCreateZeroPoly
3129 * enumerating the exponents
3130ring r = 2^2, (a, b, c), lp; ideal G0 = system("createG0"); ideal G = interred(G0); ncols(G0); ncols(G);
3131 */
3132
3133int nextZeroSimplexExponent (long exp[], long ind[], long cexp[], long cind[], long* cabsind, long step[], long bound, long N)
3134/* gives the next exponent from the set H_1 */
3135{
3136  long add = ind2(cexp[1] + 2);
3137  if ((*cabsind < bound) && (*cabsind - step[1] + add < bound))
3138  {
3139    cexp[1] += 2;
3140    cind[1] += add;
3141    *cabsind += add;
3142  }
3143  else
3144  {
3145    // cabsind >= habsind
3146    if (N == 1) return 0;
3147    int i = 1;
3148    while (exp[i] == cexp[i] && i <= N) i++;
3149    cexp[i] = exp[i];
3150    *cabsind -= cind[i];
3151    cind[i] = ind[i];
3152    step[i] = 500000;
3153    *cabsind += cind[i];
3154    // Print("in: %d\n", *cabsind);
3155    i += 1;
3156    if (i > N) return 0;
3157    do
3158    {
3159      step[1] = 500000;
3160      for (int j = i + 1; j <= N; j++)
3161      {
3162        if (step[1] > step[j]) step[1] = step[j];
3163      }
3164      add = ind2(cexp[i] + 2);
3165      if (*cabsind - step[1] + add >= bound)
3166      {
3167        cexp[i] = exp[i];
3168        *cabsind -= cind[i];
3169        cind[i] = ind[i];
3170        *cabsind += cind[i];
3171        step[i] = 500000;
3172        i += 1;
3173        if (i > N) return 0;
3174      }
3175      else step[1] = -1;
3176    } while (step[1] != -1);
3177    step[1] = 500000;
3178    cexp[i] += 2;
3179    cind[i] += add;
3180    *cabsind += add;
3181    if (add < step[i]) step[i] = add;
3182    for (i = 2; i <= N; i++)
3183    {
3184      if (step[1] > step[i]) step[1] = step[i];
3185    }
3186  }
3187  return 1;
3188}
3189
3190/*
3191 * Creates the zero Polynomial on position exp
3192 * long exp[] : exponent of leading term
3193 * cabsind    : total 2-ind of exp (if -1 will be computed)
3194 * poly* t_p  : will hold the LT in tailRing
3195 * leadRing   : ring for the LT
3196 * tailRing   : ring for the tail
3197 */
3198
3199poly kCreateZeroPoly(long exp[], long cabsind, poly* t_p, ring leadRing, ring tailRing)
3200{
3201
3202  poly zeroPoly = NULL;
3203
3204  number tmp1;
3205  poly tmp2, tmp3;
3206
3207  if (cabsind == -1)
3208  {
3209    cabsind = 0;
3210    for (int i = 1; i <= leadRing->N; i++)
3211    {
3212      cabsind += ind_fact_2(exp[i]);
3213    }
3214//    Print("cabsind: %d\n", cabsind);
3215  }
3216  if (cabsind < leadRing->ch)
3217  {
3218    zeroPoly = p_ISet(twoPow(leadRing->ch - cabsind), tailRing);
3219  }
3220  else
3221  {
3222    zeroPoly = p_ISet(1, tailRing);
3223  }
3224  for (int i = 1; i <= leadRing->N; i++)
3225  {
3226    for (long j = 1; j <= exp[i]; j++)
3227    {
3228      tmp1 = nInit(j);
3229      tmp2 = p_ISet(1, tailRing);
3230      p_SetExp(tmp2, i, 1, tailRing);
3231      p_Setm(tmp2, tailRing);
3232      if (nIsZero(tmp1))
3233      { // should nowbe obsolet, test ! TODO OLIVER
3234        zeroPoly = p_Mult_q(zeroPoly, tmp2, tailRing);
3235      }
3236      else
3237      {
3238        tmp3 = p_NSet(nCopy(tmp1), tailRing);
3239        zeroPoly = p_Mult_q(zeroPoly, p_Add_q(tmp3, tmp2, tailRing), tailRing);
3240      }
3241    }
3242  }
3243  tmp2 = p_NSet(nCopy(pGetCoeff(zeroPoly)), leadRing);
3244  for (int i = 1; i <= leadRing->N; i++)
3245  {
3246    pSetExp(tmp2, i, p_GetExp(zeroPoly, i, tailRing));
3247  }
3248  p_Setm(tmp2, leadRing);
3249  *t_p = zeroPoly;
3250  zeroPoly = pNext(zeroPoly);
3251  pNext(*t_p) = NULL;
3252  pNext(tmp2) = zeroPoly;
3253  return tmp2;
3254}
3255
3256// #define OLI_DEBUG
3257
3258/*
3259 * Generate the s-polynomial for the virtual set of zero-polynomials
3260 */
3261
3262void initenterzeropairsRing (poly p, int ecart, kStrategy strat, int atR)
3263{
3264  // Initialize
3265  long exp[50];            // The exponent of \hat{X} (basepoint)
3266  long cexp[50];           // The current exponent for iterating over all
3267  long ind[50];            // The power of 2 in the i-th component of exp
3268  long cind[50];           // analog for cexp
3269  long mult[50];           // How to multiply the elements of G
3270  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
3271  long habsind = 0;        // The abs. index of the coefficient of h
3272  long step[50];           // The last increases
3273  for (int i = 1; i <= currRing->N; i++)
3274  {
3275    exp[i] = p_GetExp(p, i, currRing);
3276    if (exp[i] & 1 != 0)
3277    {
3278      exp[i] = exp[i] - 1;
3279      mult[i] = 1;
3280    }
3281    cexp[i] = exp[i];
3282    ind[i] = ind_fact_2(exp[i]);
3283    cabsind += ind[i];
3284    cind[i] = ind[i];
3285    step[i] = 500000;
3286  }
3287  step[1] = 500000;
3288  habsind = ind2((long) p_GetCoeff(p, currRing));
3289  long bound = currRing->ch - habsind;
3290#ifdef OLI_DEBUG
3291  PrintS("-------------\npoly  :");
3292  wrp(p);
3293  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
3294  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
3295  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
3296  Print("bound : %d\n", bound);
3297  Print("cind  : %d\n", cabsind);
3298#endif
3299  if (cabsind == 0)
3300  {
3301    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
3302    {
3303      return;
3304    }
3305  }
3306  // Now the whole simplex
3307  do
3308  {
3309    // Build s-polynomial
3310    // 2**ind-def * mult * g - exp-def * h
3311    poly t_p;
3312    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, strat->tailRing);
3313#ifdef OLI_DEBUG
3314    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
3315    Print("zPoly : ");
3316    wrp(zeroPoly);
3317    Print("\n");
3318#endif
3319    enterOneZeroPairRing(zeroPoly, t_p, p, ecart, strat, atR);
3320  }
3321  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
3322}
3323
3324/*
3325 * Create the Groebner basis of the vanishing polynomials.
3326 */
3327
3328ideal createG0()
3329{
3330  // Initialize
3331  long exp[50];            // The exponent of \hat{X} (basepoint)
3332  long cexp[50];           // The current exponent for iterating over all
3333  long ind[50];            // The power of 2 in the i-th component of exp
3334  long cind[50];           // analog for cexp
3335  long mult[50];           // How to multiply the elements of G
3336  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
3337  long habsind = 0;        // The abs. index of the coefficient of h
3338  long step[50];           // The last increases
3339  for (int i = 1; i <= currRing->N; i++)
3340  {
3341    exp[i] = 0;
3342    cexp[i] = exp[i];
3343    ind[i] = 0;
3344    step[i] = 500000;
3345    cind[i] = ind[i];
3346  }
3347  long bound = currRing->ch;
3348  step[1] = 500000;
3349#ifdef OLI_DEBUG
3350  PrintS("-------------\npoly  :");
3351//  wrp(p);
3352  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
3353  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
3354  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
3355  Print("bound : %d\n", bound);
3356  Print("cind  : %d\n", cabsind);
3357#endif
3358  if (cabsind == 0)
3359  {
3360    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
3361    {
3362      return idInit(1, 1);
3363    }
3364  }
3365  ideal G0 = idInit(1, 1);
3366  // Now the whole simplex
3367  do
3368  {
3369    // Build s-polynomial
3370    // 2**ind-def * mult * g - exp-def * h
3371    poly t_p;
3372    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, currRing);
3373#ifdef OLI_DEBUG
3374    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
3375    Print("zPoly : ");
3376    wrp(zeroPoly);
3377    Print("\n");
3378#endif
3379    // Add to ideal
3380    pEnlargeSet(&(G0->m), IDELEMS(G0), 1);
3381    IDELEMS(G0) += 1;
3382    G0->m[IDELEMS(G0) - 1] = zeroPoly;
3383  }
3384  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
3385  idSkipZeroes(G0);
3386  return G0;
3387}
3388#endif
3389
3390#ifdef HAVE_RINGS
3391/*2
3392*(s[0],h),...,(s[k],h) will be put to the pairset L
3393*/
3394void initenterstrongPairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
3395{
3396  const unsigned long iCompH = pGetComp(h);
3397  if (!nIsOne(pGetCoeff(h)))
3398  {
3399    int j;
3400    BOOLEAN new_pair=FALSE;
3401
3402    for (j=0; j<=k; j++)
3403    {
3404      // Print("j:%d, Ll:%d\n",j,strat->Ll);
3405//      if (((unsigned long) pGetCoeff(h) % (unsigned long) pGetCoeff(strat->S[j]) != 0) &&
3406//         ((unsigned long) pGetCoeff(strat->S[j]) % (unsigned long) pGetCoeff(h) != 0))
3407      if ( iCompH == pGetComp(strat->S[j]) )
3408      {
3409        {
3410          if (enterOneStrongPoly(j,h,ecart,isFromQ,strat, atR))
3411            new_pair=TRUE;
3412        }
3413      }
3414    }
3415  }
3416/*
3417ring r=256,(x,y,z),dp;
3418ideal I=12xz-133y, 2xy-z;
3419*/
3420
3421}
3422
3423/*2
3424* Generates spoly(0, h) if applicable. Assumes ring in Z/2^n.
3425*/
3426void enterExtendedSpoly(poly h,kStrategy strat)
3427{
3428  if (nIsOne(pGetCoeff(h))) return;
3429  number gcd;
3430  bool go = false;
3431  if (n_DivBy((number) 0, pGetCoeff(h), currRing->cf))
3432  {
3433    gcd = nIntDiv((number) 0, pGetCoeff(h));
3434    go = true;
3435  }
3436  else
3437    gcd = nGcd((number) 0, pGetCoeff(h), strat->tailRing);
3438  if (go || !nIsOne(gcd))
3439  {
3440    poly p = h->next;
3441    if (!go)
3442    {
3443      number tmp = gcd;
3444      gcd = nIntDiv(0, gcd);
3445      nDelete(&tmp);
3446    }
3447    p_Test(p,strat->tailRing);
3448    p = pp_Mult_nn(p, gcd, strat->tailRing);
3449    nDelete(&gcd);
3450
3451    if (p != NULL)
3452    {
3453      if (TEST_OPT_PROT)
3454      {
3455        PrintS("Z");
3456      }
3457#ifdef KDEBUG
3458      if (TEST_OPT_DEBUG)
3459      {
3460        PrintS("--- create zero spoly: ");
3461        p_wrp(h,currRing,strat->tailRing);
3462        PrintS(" ---> ");
3463      }
3464#endif
3465      poly tmp = pInit();
3466      pSetCoeff0(tmp, pGetCoeff(p));
3467      for (int i = 1; i <= rVar(currRing); i++)
3468      {
3469        pSetExp(tmp, i, p_GetExp(p, i, strat->tailRing));
3470      }
3471      if (rRing_has_Comp(currRing) && rRing_has_Comp(strat->tailRing))
3472      {
3473        p_SetComp(tmp, p_GetComp(p, strat->tailRing), currRing);
3474      }
3475      p_Setm(tmp, currRing);
3476      p = p_LmFreeAndNext(p, strat->tailRing);
3477      pNext(tmp) = p;
3478      LObject h;
3479      h.Init();
3480      h.p = tmp;
3481      h.tailRing = strat->tailRing;
3482      int posx;
3483      if (h.p!=NULL)
3484      {
3485        if (TEST_OPT_INTSTRATEGY)
3486        {
3487          //pContent(h.p);
3488          h.pCleardenom(); // also does a pContent
3489        }
3490        else
3491        {
3492          h.pNorm();
3493        }
3494        strat->initEcart(&h);
3495        if (strat->Ll==-1)
3496          posx =0;
3497        else
3498          posx = strat->posInL(strat->L,strat->Ll,&h,strat);
3499        h.sev = pGetShortExpVector(h.p);
3500        if (strat->tailRing != currRing)
3501        {
3502          h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
3503        }
3504#ifdef KDEBUG
3505        if (TEST_OPT_DEBUG)
3506        {
3507          p_wrp(tmp,currRing,strat->tailRing);
3508          PrintLn();
3509        }
3510#endif
3511        enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
3512      }
3513    }
3514  }
3515  nDelete(&gcd);
3516}
3517
3518void clearSbatch (poly h,int k,int pos,kStrategy strat)
3519{
3520  int j = pos;
3521  if ( (!strat->fromT)
3522  && (1//(strat->syzComp==0)
3523    //||(pGetComp(h)<=strat->syzComp)))
3524  ))
3525  {
3526    // Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
3527    unsigned long h_sev = pGetShortExpVector(h);
3528    loop
3529    {
3530      if (j > k) break;
3531      clearS(h,h_sev, &j,&k,strat);
3532      j++;
3533    }
3534    // Print("end clearS sl=%d\n",strat->sl);
3535  }
3536}
3537
3538/*2
3539* Generates a sufficient set of spolys (maybe just a finite generating
3540* set of the syzygys)
3541*/
3542void superenterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
3543{
3544    assume (rField_is_Ring(currRing));
3545    // enter also zero divisor * poly, if this is non zero and of smaller degree
3546    if (!(rField_is_Domain(currRing))) enterExtendedSpoly(h, strat);
3547    initenterpairs(h, k, ecart, 0, strat, atR);
3548    initenterstrongPairs(h, k, ecart, 0, strat, atR);
3549    clearSbatch(h, k, pos, strat);
3550}
3551#endif
3552
3553/*2
3554*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
3555*superfluous elements in S will be deleted
3556*/
3557void enterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
3558{
3559  int j=pos;
3560
3561#ifdef HAVE_RINGS
3562  assume (!rField_is_Ring(currRing));
3563#endif
3564
3565  initenterpairs(h,k,ecart,0,strat, atR);
3566  if ( (!strat->fromT)
3567  && ((strat->syzComp==0)
3568    ||(pGetComp(h)<=strat->syzComp)))
3569  {
3570    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
3571    unsigned long h_sev = pGetShortExpVector(h);
3572    loop
3573    {
3574      if (j > k) break;
3575      clearS(h,h_sev, &j,&k,strat);
3576      j++;
3577    }
3578    //Print("end clearS sl=%d\n",strat->sl);
3579  }
3580 // PrintS("end enterpairs\n");
3581}
3582
3583/*2
3584*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
3585*superfluous elements in S will be deleted
3586*this is a special variant of signature-based algorithms including the
3587*signatures for criteria checks
3588*/
3589void enterpairsSig (poly h,poly hSig,int hFrom,int k,int ecart,int pos,kStrategy strat, int atR)
3590{
3591int j=pos;
3592
3593#ifdef HAVE_RINGS
3594assume (!rField_is_Ring(currRing));
3595#endif
3596
3597initenterpairsSig(h,hSig,hFrom,k,ecart,0,strat, atR);
3598if ( (!strat->fromT)
3599&& ((strat->syzComp==0)
3600  ||(pGetComp(h)<=strat->syzComp)))
3601{
3602  //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
3603  unsigned long h_sev = pGetShortExpVector(h);
3604  loop
3605  {
3606    if (j > k) break;
3607    clearS(h,h_sev, &j,&k,strat);
3608    j++;
3609  }
3610  //Print("end clearS sl=%d\n",strat->sl);
3611}
3612// PrintS("end enterpairs\n");
3613}
3614
3615/*2
3616*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
3617*superfluous elements in S will be deleted
3618*/
3619void enterpairsSpecial (poly h,int k,int ecart,int pos,kStrategy strat, int atR = -1)
3620{
3621  int j;
3622  const int iCompH = pGetComp(h);
3623
3624  for (j=0; j<=k; j++)
3625  {
3626    const int iCompSj = pGetComp(strat->S[j]);
3627    if ((iCompH==iCompSj)
3628        || (0==iCompH) // TODO: what about this case???
3629        || (0==iCompSj))
3630    {
3631      enterOnePairSpecial(j,h,ecart,strat, atR);
3632    }
3633  }
3634
3635  if (strat->noClearS) return;
3636
3637//   #ifdef HAVE_PLURAL
3638/*
3639  if (rIsPluralRing(currRing))
3640  {
3641    j=pos;
3642    loop
3643    {
3644      if (j > k) break;
3645
3646      if (pLmDivisibleBy(h, strat->S[j]))
3647      {
3648        deleteInS(j, strat);
3649        j--;
3650        k--;
3651      }
3652
3653      j++;
3654    }
3655  }
3656  else
3657*/
3658//   #endif // ??? Why was the following cancelation disabled for non-commutative rings?
3659  {
3660    j=pos;
3661    loop
3662    {
3663      unsigned long h_sev = pGetShortExpVector(h);
3664      if (j > k) break;
3665      clearS(h,h_sev,&j,&k,strat);
3666      j++;
3667    }
3668  }
3669}
3670
3671/*2
3672*reorders  s with respect to posInS,
3673*suc is the first changed index or zero
3674*/
3675
3676void reorderS (int* suc,kStrategy strat)
3677{
3678  int i,j,at,ecart, s2r;
3679  int fq=0;
3680  unsigned long sev;
3681  poly  p;
3682  int new_suc=strat->sl+1;
3683  i= *suc;
3684  if (i<0) i=0;
3685
3686  for (; i<=strat->sl; i++)
3687  {
3688    at = posInS(strat,i-1,strat->S[i],strat->ecartS[i]);
3689    if (at != i)
3690    {
3691      if (new_suc > at) new_suc = at;
3692      p = strat->S[i];
3693      ecart = strat->ecartS[i];
3694      sev = strat->sevS[i];
3695      s2r = strat->S_2_R[i];
3696      if (strat->fromQ!=NULL) fq=strat->fromQ[i];
3697      for (j=i; j>=at+1; j--)
3698      {
3699        strat->S[j] = strat->S[j-1];
3700        strat->ecartS[j] = strat->ecartS[j-1];
3701        strat->sevS[j] = strat->sevS[j-1];
3702        strat->S_2_R[j] = strat->S_2_R[j-1];
3703      }
3704      strat->S[at] = p;
3705      strat->ecartS[at] = ecart;
3706      strat->sevS[at] = sev;
3707      strat->S_2_R[at] = s2r;
3708      if (strat->fromQ!=NULL)
3709      {
3710        for (j=i; j>=at+1; j--)
3711        {
3712          strat->fromQ[j] = strat->fromQ[j-1];
3713        }
3714        strat->fromQ[at]=fq;
3715      }
3716    }
3717  }
3718  if (new_suc <= strat->sl) *suc=new_suc;
3719  else                      *suc=-1;
3720}
3721
3722
3723/*2
3724*looks up the position of p in set
3725*set[0] is the smallest with respect to the ordering-procedure deg/pComp
3726* Assumption: posInS only depends on the leading term
3727*             otherwise, bba has to be changed
3728*/
3729int posInS (const kStrategy strat, const int length,const poly p,
3730            const int ecart_p)
3731{
3732  if(length==-1) return 0;
3733  polyset set=strat->S;
3734  int i;
3735  int an = 0;
3736  int en = length;
3737  int cmp_int = currRing->OrdSgn;
3738  if ((currRing->MixedOrder)
3739#ifdef HAVE_PLURAL
3740  && (currRing->real_var_start==0)
3741#endif
3742#if 0
3743  || ((strat->ak>0) && ((currRing->order[0]==ringorder_c)||((currRing->order[0]==ringorder_C))))
3744#endif
3745  )
3746  {
3747    int o=p_Deg(p,currRing);
3748    int oo=p_Deg(set[length],currRing);
3749
3750    if ((oo<o)
3751    || ((o==oo) && (pLmCmp(set[length],p)!= cmp_int)))
3752      return length+1;
3753
3754    loop
3755    {
3756      if (an >= en-1)
3757      {
3758        if ((p_Deg(set[an],currRing)>=o) && (pLmCmp(set[an],p) == cmp_int))
3759        {
3760          return an;
3761        }
3762        return en;
3763      }
3764      i=(an+en) / 2;
3765      if ((p_Deg(set[i],currRing)>=o) && (pLmCmp(set[i],p) == cmp_int)) en=i;
3766      else                              an=i;
3767    }
3768  }
3769  else
3770  {
3771#ifdef HAVE_RINGS
3772    if (rField_is_Ring(currRing))
3773    {
3774      if (pLmCmp(set[length],p)== -cmp_int)
3775        return length+1;
3776      int cmp;
3777      loop
3778      {
3779        if (an >= en-1)
3780        {
3781          cmp = pLmCmp(set[an],p);
3782          if (cmp == cmp_int)  return an;
3783          if (cmp == -cmp_int) return en;
3784          if (n_DivBy(pGetCoeff(p), pGetCoeff(set[an]), currRing->cf)) return en;
3785          return an;
3786        }
3787        i = (an+en) / 2;
3788        cmp = pLmCmp(set[i],p);
3789        if (cmp == cmp_int)         en = i;
3790        else if (cmp == -cmp_int)   an = i;
3791        else
3792        {
3793          if (n_DivBy(pGetCoeff(p), pGetCoeff(set[i]), currRing->cf)) an = i;
3794          else en = i;
3795        }
3796      }
3797    }
3798    else
3799#endif
3800    if (pLmCmp(set[length],p)== -cmp_int)
3801      return length+1;
3802
3803    loop
3804    {
3805      if (an >= en-1)
3806      {
3807        if (pLmCmp(set[an],p) == cmp_int) return an;
3808        if (pLmCmp(set[an],p) == -cmp_int) return en;
3809        if ((cmp_int!=1)
3810        && ((strat->ecartS[an])>ecart_p))
3811          return an;
3812        return en;
3813      }
3814      i=(an+en) / 2;
3815      if (pLmCmp(set[i],p) == cmp_int) en=i;
3816      else if (pLmCmp(set[i],p) == -cmp_int) an=i;
3817      else
3818      {
3819        if ((cmp_int!=1)
3820        &&((strat->ecartS[i])<ecart_p))
3821          en=i;
3822        else
3823          an=i;
3824      }
3825    }
3826  }
3827}
3828
3829
3830/*2
3831* looks up the position of p in set
3832* the position is the last one
3833*/
3834int posInT0 (const TSet,const int length,LObject &)
3835{
3836  return (length+1);
3837}
3838
3839
3840/*2
3841* looks up the position of p in T
3842* set[0] is the smallest with respect to the ordering-procedure
3843* pComp
3844*/
3845int posInT1 (const TSet set,const int length,LObject &p)
3846{
3847  if (length==-1) return 0;
3848
3849  if (pLmCmp(set[length].p,p.p)!= currRing->OrdSgn) return length+1;
3850
3851  int i;
3852  int an = 0;
3853  int en= length;
3854
3855  loop
3856  {
3857    if (an >= en-1)
3858    {
3859      if (pLmCmp(set[an].p,p.p) == currRing->OrdSgn) return an;
3860      return en;
3861    }
3862    i=(an+en) / 2;
3863    if (pLmCmp(set[i].p,p.p) == currRing->OrdSgn) en=i;
3864    else                                 an=i;
3865  }
3866}
3867
3868/*2
3869* looks up the position of p in T
3870* set[0] is the smallest with respect to the ordering-procedure
3871* length
3872*/
3873int posInT2 (const TSet set,const int length,LObject &p)
3874{
3875  p.GetpLength();
3876  if (length==-1)
3877    return 0;
3878  if (set[length].length<p.length)
3879    return length+1;
3880
3881  int i;
3882  int an = 0;
3883  int en= length;
3884
3885  loop
3886  {
3887    if (an >= en-1)
3888    {
3889      if (set[an].length>p.length) return an;
3890      return en;
3891    }
3892    i=(an+en) / 2;
3893    if (set[i].length>p.length) en=i;
3894    else                        an=i;
3895  }
3896}
3897
3898/*2
3899* looks up the position of p in T
3900* set[0] is the smallest with respect to the ordering-procedure
3901* totaldegree,pComp
3902*/
3903int posInT11 (const TSet set,const int length,LObject &p)
3904/*{
3905 * int j=0;
3906 * int o;
3907 *
3908 * o = p.GetpFDeg();
3909 * loop
3910 * {
3911 *   if ((pFDeg(set[j].p) > o)
3912 *   || ((pFDeg(set[j].p) == o) && (pLmCmp(set[j].p,p.p) == currRing->OrdSgn)))
3913 *   {
3914 *     return j;
3915 *   }
3916 *   j++;
3917 *   if (j > length) return j;
3918 * }
3919 *}
3920 */
3921{
3922  if (length==-1) return 0;
3923
3924  int o = p.GetpFDeg();
3925  int op = set[length].GetpFDeg();
3926
3927  if ((op < o)
3928  || ((op == o) && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
3929    return length+1;
3930
3931  int i;
3932  int an = 0;
3933  int en= length;
3934
3935  loop
3936  {
3937    if (an >= en-1)
3938    {
3939      op= set[an].GetpFDeg();
3940      if ((op > o)
3941      || (( op == o) && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
3942        return an;
3943      return en;
3944    }
3945    i=(an+en) / 2;
3946    op = set[i].GetpFDeg();
3947    if (( op > o)
3948    || (( op == o) && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
3949      en=i;
3950    else
3951      an=i;
3952  }
3953}
3954
3955/*2 Pos for rings T: Here I am
3956* looks up the position of p in T
3957* set[0] is the smallest with respect to the ordering-procedure
3958* totaldegree,pComp
3959*/
3960int posInTrg0 (const TSet set,const int length,LObject &p)
3961{
3962  if (length==-1) return 0;
3963  int o = p.GetpFDeg();
3964  int op = set[length].GetpFDeg();
3965  int i;
3966  int an = 0;
3967  int en = length;
3968  int cmp_int = currRing->OrdSgn;
3969  if ((op < o) || (pLmCmp(set[length].p,p.p)== -cmp_int))
3970    return length+1;
3971  int cmp;
3972  loop
3973  {
3974    if (an >= en-1)
3975    {
3976      op = set[an].GetpFDeg();
3977      if (op > o) return an;
3978      if (op < 0) return en;
3979      cmp = pLmCmp(set[an].p,p.p);
3980      if (cmp == cmp_int)  return an;
3981      if (cmp == -cmp_int) return en;
3982      if (nGreater(pGetCoeff(p.p), pGetCoeff(set[an].p))) return en;
3983      return an;
3984    }
3985    i = (an + en) / 2;
3986    op = set[i].GetpFDeg();
3987    if (op > o)       en = i;
3988    else if (op < o)  an = i;
3989    else
3990    {
3991      cmp = pLmCmp(set[i].p,p.p);
3992      if (cmp == cmp_int)                                     en = i;
3993      else if (cmp == -cmp_int)                               an = i;
3994      else if (nGreater(pGetCoeff(p.p), pGetCoeff(set[i].p))) an = i;
3995      else                                                    en = i;
3996    }
3997  }
3998}
3999/*
4000  int o = p.GetpFDeg();
4001  int op = set[length].GetpFDeg();
4002
4003  if ((op < o)
4004  || ((op == o) && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4005    return length+1;
4006
4007  int i;
4008  int an = 0;
4009  int en= length;
4010
4011  loop
4012  {
4013    if (an >= en-1)
4014    {
4015      op= set[an].GetpFDeg();
4016      if ((op > o)
4017      || (( op == o) && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4018        return an;
4019      return en;
4020    }
4021    i=(an+en) / 2;
4022    op = set[i].GetpFDeg();
4023    if (( op > o)
4024    || (( op == o) && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4025      en=i;
4026    else
4027      an=i;
4028  }
4029}
4030  */
4031/*2
4032* looks up the position of p in T
4033* set[0] is the smallest with respect to the ordering-procedure
4034* totaldegree,pComp
4035*/
4036int posInT110 (const TSet set,const int length,LObject &p)
4037{
4038  p.GetpLength();
4039  if (length==-1) return 0;
4040
4041  int o = p.GetpFDeg();
4042  int op = set[length].GetpFDeg();
4043
4044  if (( op < o)
4045  || (( op == o) && (set[length].length<p.length))
4046  || (( op == o) && (set[length].length == p.length)
4047     && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4048    return length+1;
4049
4050  int i;
4051  int an = 0;
4052  int en= length;
4053  loop
4054  {
4055    if (an >= en-1)
4056    {
4057      op = set[an].GetpFDeg();
4058      if (( op > o)
4059      || (( op == o) && (set[an].length > p.length))
4060      || (( op == o) && (set[an].length == p.length)
4061         && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4062        return an;
4063      return en;
4064    }
4065    i=(an+en) / 2;
4066    op = set[i].GetpFDeg();
4067    if (( op > o)
4068    || (( op == o) && (set[i].length > p.length))
4069    || (( op == o) && (set[i].length == p.length)
4070       && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4071      en=i;
4072    else
4073      an=i;
4074  }
4075}
4076
4077/*2
4078* looks up the position of p in set
4079* set[0] is the smallest with respect to the ordering-procedure
4080* pFDeg
4081*/
4082int posInT13 (const TSet set,const int length,LObject &p)
4083{
4084  if (length==-1) return 0;
4085
4086  int o = p.GetpFDeg();
4087
4088  if (set[length].GetpFDeg() <= o)
4089    return length+1;
4090
4091  int i;
4092  int an = 0;
4093  int en= length;
4094  loop
4095  {
4096    if (an >= en-1)
4097    {
4098      if (set[an].GetpFDeg() > o)
4099        return an;
4100      return en;
4101    }
4102    i=(an+en) / 2;
4103    if (set[i].GetpFDeg() > o)
4104      en=i;
4105    else
4106      an=i;
4107  }
4108}
4109
4110// determines the position based on: 1.) Ecart 2.) pLength
4111int posInT_EcartpLength(const TSet set,const int length,LObject &p)
4112{
4113  int ol = p.GetpLength();
4114  if (length==-1) return 0;
4115
4116  int op=p.ecart;
4117
4118  int oo=set[length].ecart;
4119  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
4120    return length+1;
4121
4122  int i;
4123  int an = 0;
4124  int en= length;
4125  loop
4126    {
4127      if (an >= en-1)
4128      {
4129        int oo=set[an].ecart;
4130        if((oo > op)
4131           || ((oo==op) && (set[an].pLength > ol)))
4132          return an;
4133        return en;
4134      }
4135      i=(an+en) / 2;
4136      int oo=set[i].ecart;
4137      if ((oo > op)
4138          || ((oo == op) && (set[i].pLength > ol)))
4139        en=i;
4140      else
4141        an=i;
4142    }
4143}
4144
4145/*2
4146* looks up the position of p in set
4147* set[0] is the smallest with respect to the ordering-procedure
4148* maximaldegree, pComp
4149*/
4150int posInT15 (const TSet set,const int length,LObject &p)
4151/*{
4152 *int j=0;
4153 * int o;
4154 *
4155 * o = p.GetpFDeg()+p.ecart;
4156 * loop
4157 * {
4158 *   if ((set[j].GetpFDeg()+set[j].ecart > o)
4159 *   || ((set[j].GetpFDeg()+set[j].ecart == o)
4160 *     && (pLmCmp(set[j].p,p.p) == currRing->OrdSgn)))
4161 *   {
4162 *     return j;
4163 *   }
4164 *   j++;
4165 *   if (j > length) return j;
4166 * }
4167 *}
4168 */
4169{
4170  if (length==-1) return 0;
4171
4172  int o = p.GetpFDeg() + p.ecart;
4173  int op = set[length].GetpFDeg()+set[length].ecart;
4174
4175  if ((op < o)
4176  || ((op == o)
4177     && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4178    return length+1;
4179
4180  int i;
4181  int an = 0;
4182  int en= length;
4183  loop
4184  {
4185    if (an >= en-1)
4186    {
4187      op = set[an].GetpFDeg()+set[an].ecart;
4188      if (( op > o)
4189      || (( op  == o) && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4190        return an;
4191      return en;
4192    }
4193    i=(an+en) / 2;
4194    op = set[i].GetpFDeg()+set[i].ecart;
4195    if (( op > o)
4196    || (( op == o) && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4197      en=i;
4198    else
4199      an=i;
4200  }
4201}
4202
4203/*2
4204* looks up the position of p in set
4205* set[0] is the smallest with respect to the ordering-procedure
4206* pFDeg+ecart, ecart, pComp
4207*/
4208int posInT17 (const TSet set,const int length,LObject &p)
4209/*
4210*{
4211* int j=0;
4212* int  o;
4213*
4214*  o = p.GetpFDeg()+p.ecart;
4215*  loop
4216*  {
4217*    if ((pFDeg(set[j].p)+set[j].ecart > o)
4218*    || (((pFDeg(set[j].p)+set[j].ecart == o)
4219*      && (set[j].ecart < p.ecart)))
4220*    || ((pFDeg(set[j].p)+set[j].ecart == o)
4221*      && (set[j].ecart==p.ecart)
4222*      && (pLmCmp(set[j].p,p.p)==currRing->OrdSgn)))
4223*      return j;
4224*    j++;
4225*    if (j > length) return j;
4226*  }
4227* }
4228*/
4229{
4230  if (length==-1) return 0;
4231
4232  int o = p.GetpFDeg() + p.ecart;
4233  int op = set[length].GetpFDeg()+set[length].ecart;
4234
4235  if ((op < o)
4236  || (( op == o) && (set[length].ecart > p.ecart))
4237  || (( op == o) && (set[length].ecart==p.ecart)
4238     && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4239    return length+1;
4240
4241  int i;
4242  int an = 0;
4243  int en= length;
4244  loop
4245  {
4246    if (an >= en-1)
4247    {
4248      op = set[an].GetpFDeg()+set[an].ecart;
4249      if (( op > o)
4250      || (( op == o) && (set[an].ecart < p.ecart))
4251      || (( op  == o) && (set[an].ecart==p.ecart)
4252         && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4253        return an;
4254      return en;
4255    }
4256    i=(an+en) / 2;
4257    op = set[i].GetpFDeg()+set[i].ecart;
4258    if ((op > o)
4259    || (( op == o) && (set[i].ecart < p.ecart))
4260    || (( op == o) && (set[i].ecart == p.ecart)
4261       && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4262      en=i;
4263    else
4264      an=i;
4265  }
4266}
4267/*2
4268* looks up the position of p in set
4269* set[0] is the smallest with respect to the ordering-procedure
4270* pGetComp, pFDeg+ecart, ecart, pComp
4271*/
4272int posInT17_c (const TSet set,const int length,LObject &p)
4273{
4274  if (length==-1) return 0;
4275
4276  int cc = (-1+2*currRing->order[0]==ringorder_c);
4277  /* cc==1 for (c,..), cc==-1 for (C,..) */
4278  int o = p.GetpFDeg() + p.ecart;
4279  unsigned long c = pGetComp(p.p)*cc;
4280
4281  if (pGetComp(set[length].p)*cc < c)
4282    return length+1;
4283  if (pGetComp(set[length].p)*cc == c)
4284  {
4285    int op = set[length].GetpFDeg()+set[length].ecart;
4286    if ((op < o)
4287    || ((op == o) && (set[length].ecart > p.ecart))
4288    || ((op == o) && (set[length].ecart==p.ecart)
4289       && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4290      return length+1;
4291  }
4292
4293  int i;
4294  int an = 0;
4295  int en= length;
4296  loop
4297  {
4298    if (an >= en-1)
4299    {
4300      if (pGetComp(set[an].p)*cc < c)
4301        return en;
4302      if (pGetComp(set[an].p)*cc == c)
4303      {
4304        int op = set[an].GetpFDeg()+set[an].ecart;
4305        if ((op > o)
4306        || ((op == o) && (set[an].ecart < p.ecart))
4307        || ((op == o) && (set[an].ecart==p.ecart)
4308           && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
4309          return an;
4310      }
4311      return en;
4312    }
4313    i=(an+en) / 2;
4314    if (pGetComp(set[i].p)*cc > c)
4315      en=i;
4316    else if (pGetComp(set[i].p)*cc == c)
4317    {
4318      int op = set[i].GetpFDeg()+set[i].ecart;
4319      if ((op > o)
4320      || ((op == o) && (set[i].ecart < p.ecart))
4321      || ((op == o) && (set[i].ecart == p.ecart)
4322         && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
4323        en=i;
4324      else
4325        an=i;
4326    }
4327    else
4328      an=i;
4329  }
4330}
4331
4332/*2
4333* looks up the position of p in set
4334* set[0] is the smallest with respect to
4335* ecart, pFDeg, length
4336*/
4337int posInT19 (const TSet set,const int length,LObject &p)
4338{
4339  p.GetpLength();
4340  if (length==-1) return 0;
4341
4342  int o = p.ecart;
4343  int op=p.GetpFDeg();
4344
4345  if (set[length].ecart < o)
4346    return length+1;
4347  if (set[length].ecart == o)
4348  {
4349     int oo=set[length].GetpFDeg();
4350     if ((oo < op) || ((oo==op) && (set[length].length < p.length)))
4351       return length+1;
4352  }
4353
4354  int i;
4355  int an = 0;
4356  int en= length;
4357  loop
4358  {
4359    if (an >= en-1)
4360    {
4361      if (set[an].ecart > o)
4362        return an;
4363      if (set[an].ecart == o)
4364      {
4365         int oo=set[an].GetpFDeg();
4366         if((oo > op)
4367         || ((oo==op) && (set[an].length > p.length)))
4368           return an;
4369      }
4370      return en;
4371    }
4372    i=(an+en) / 2;
4373    if (set[i].ecart > o)
4374      en=i;
4375    else if (set[i].ecart == o)
4376    {
4377       int oo=set[i].GetpFDeg();
4378       if ((oo > op)
4379       || ((oo == op) && (set[i].length > p.length)))
4380         en=i;
4381       else
4382        an=i;
4383    }
4384    else
4385      an=i;
4386  }
4387}
4388
4389/*2
4390*looks up the position of polynomial p in set
4391*set[length] is the smallest element in set with respect
4392*to the ordering-procedure pComp
4393*/
4394int posInLSpecial (const LSet set, const int length,
4395                   LObject *p,const kStrategy)
4396{
4397  if (length<0) return 0;
4398
4399  int d=p->GetpFDeg();
4400  int op=set[length].GetpFDeg();
4401
4402  if ((op > d)
4403  || ((op == d) && (p->p1!=NULL)&&(set[length].p1==NULL))
4404  || (pLmCmp(set[length].p,p->p)== currRing->OrdSgn))
4405     return length+1;
4406
4407  int i;
4408  int an = 0;
4409  int en= length;
4410  loop
4411  {
4412    if (an >= en-1)
4413    {
4414      op=set[an].GetpFDeg();
4415      if ((op > d)
4416      || ((op == d) && (p->p1!=NULL) && (set[an].p1==NULL))
4417      || (pLmCmp(set[an].p,p->p)== currRing->OrdSgn))
4418         return en;
4419      return an;
4420    }
4421    i=(an+en) / 2;
4422    op=set[i].GetpFDeg();
4423    if ((op>d)
4424    || ((op==d) && (p->p1!=NULL) && (set[i].p1==NULL))
4425    || (pLmCmp(set[i].p,p->p) == currRing->OrdSgn))
4426      an=i;
4427    else
4428      en=i;
4429  }
4430}
4431
4432/*2
4433*looks up the position of polynomial p in set
4434*set[length] is the smallest element in set with respect
4435*to the ordering-procedure pComp
4436*/
4437int posInL0 (const LSet set, const int length,
4438             LObject* p,const kStrategy)
4439{
4440  if (length<0) return 0;
4441
4442  if (pLmCmp(set[length].p,p->p)== currRing->OrdSgn)
4443    return length+1;
4444
4445  int i;
4446  int an = 0;
4447  int en= length;
4448  loop
4449  {
4450    if (an >= en-1)
4451    {
4452      if (pLmCmp(set[an].p,p->p) == currRing->OrdSgn) return en;
4453      return an;
4454    }
4455    i=(an+en) / 2;
4456    if (pLmCmp(set[i].p,p->p) == currRing->OrdSgn) an=i;
4457    else                                 en=i;
4458    /*aend. fuer lazy == in !=- machen */
4459  }
4460}
4461
4462/*2
4463* looks up the position of polynomial p in set
4464* e is the ecart of p
4465* set[length] is the smallest element in set with respect
4466* to the signature order
4467*/
4468int posInLSig (const LSet set, const int length,
4469            LObject* p,const kStrategy strat)
4470{
4471if (length<0) return 0;
4472if (pLmCmp(set[length].sig,p->sig)== currRing->OrdSgn)
4473  return length+1;
4474
4475int i;
4476int an = 0;
4477int en= length;
4478loop
4479{
4480  if (an >= en-1)
4481  {
4482    if (pLmCmp(set[an].sig,p->sig) == currRing->OrdSgn) return en;
4483    return an;
4484  }
4485  i=(an+en) / 2;
4486  if (pLmCmp(set[i].sig,p->sig) == currRing->OrdSgn) an=i;
4487  else                                      en=i;
4488  /*aend. fuer lazy == in !=- machen */
4489}
4490}
4491
4492/*2
4493*
4494* is only used in F5C, must ensure that the interreduction process does add new
4495* critical pairs to strat->L only behind all other critical pairs which are
4496* still in strat->L!
4497*/
4498int posInLF5C (const LSet set, const int length,
4499            LObject* p,const kStrategy strat)
4500{
4501  return strat->Ll+1;
4502}
4503
4504/*2
4505* looks up the position of polynomial p in set
4506* e is the ecart of p
4507* set[length] is the smallest element in set with respect
4508* to the ordering-procedure totaldegree,pComp
4509*/
4510int posInL11 (const LSet set, const int length,
4511              LObject* p,const kStrategy)
4512/*{
4513 * int j=0;
4514 * int o;
4515 *
4516 * o = p->GetpFDeg();
4517 * loop
4518 * {
4519 *   if (j > length)            return j;
4520 *   if ((set[j].GetpFDeg() < o)) return j;
4521 *   if ((set[j].GetpFDeg() == o) && (pLmCmp(set[j].p,p->p) == -currRing->OrdSgn))
4522 *   {
4523 *     return j;
4524 *   }
4525 *   j++;
4526 * }
4527 *}
4528 */
4529{
4530  if (length<0) return 0;
4531
4532  int o = p->GetpFDeg();
4533  int op = set[length].GetpFDeg();
4534
4535  if ((op > o)
4536  || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4537    return length+1;
4538  int i;
4539  int an = 0;
4540  int en= length;
4541  loop
4542  {
4543    if (an >= en-1)
4544    {
4545      op = set[an].GetpFDeg();
4546      if ((op > o)
4547      || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4548        return en;
4549      return an;
4550    }
4551    i=(an+en) / 2;
4552    op = set[i].GetpFDeg();
4553    if ((op > o)
4554    || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4555      an=i;
4556    else
4557      en=i;
4558  }
4559}
4560
4561/*2 Position for rings L: Here I am
4562* looks up the position of polynomial p in set
4563* e is the ecart of p
4564* set[length] is the smallest element in set with respect
4565* to the ordering-procedure totaldegree,pComp
4566*/
4567inline int getIndexRng(long coeff)
4568{
4569  if (coeff == 0) return -1;
4570  long tmp = coeff;
4571  int ind = 0;
4572  while (tmp % 2 == 0)
4573  {
4574    tmp = tmp / 2;
4575    ind++;
4576  }
4577  return ind;
4578}
4579
4580int posInLrg0 (const LSet set, const int length,
4581              LObject* p,const kStrategy)
4582/*          if (nGreater(pGetCoeff(p), pGetCoeff(set[an]))) return en;
4583        if (pLmCmp(set[i],p) == cmp_int)         en = i;
4584        else if (pLmCmp(set[i],p) == -cmp_int)   an = i;
4585        else
4586        {
4587          if (nGreater(pGetCoeff(p), pGetCoeff(set[i]))) an = i;
4588          else en = i;
4589        }*/
4590{
4591  if (length < 0) return 0;
4592
4593  int o = p->GetpFDeg();
4594  int op = set[length].GetpFDeg();
4595
4596  if ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4597    return length + 1;
4598  int i;
4599  int an = 0;
4600  int en = length;
4601  loop
4602  {
4603    if (an >= en - 1)
4604    {
4605      op = set[an].GetpFDeg();
4606      if ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4607        return en;
4608      return an;
4609    }
4610    i = (an+en) / 2;
4611    op = set[i].GetpFDeg();
4612    if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4613      an = i;
4614    else
4615      en = i;
4616  }
4617}
4618
4619/*{
4620  if (length < 0) return 0;
4621
4622  int o = p->GetpFDeg();
4623  int op = set[length].GetpFDeg();
4624
4625  int inde = getIndexRng((unsigned long) pGetCoeff(set[length].p));
4626  int indp = getIndexRng((unsigned long) pGetCoeff(p->p));
4627  int inda;
4628  int indi;
4629
4630  if ((inda > indp) || ((inda == inde) && ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))))
4631    return length + 1;
4632  int i;
4633  int an = 0;
4634  inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
4635  int en = length;
4636  loop
4637  {
4638    if (an >= en-1)
4639    {
4640      op = set[an].GetpFDeg();
4641      if ((indp > inda) || ((indp == inda) && ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))))
4642        return en;
4643      return an;
4644    }
4645    i = (an + en) / 2;
4646    indi = getIndexRng((unsigned long) pGetCoeff(set[i].p));
4647    op = set[i].GetpFDeg();
4648    if ((indi > indp) || ((indi == indp) && ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))))
4649    // if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4650    {
4651      an = i;
4652      inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
4653    }
4654    else
4655      en = i;
4656  }
4657} */
4658
4659/*2
4660* looks up the position of polynomial p in set
4661* set[length] is the smallest element in set with respect
4662* to the ordering-procedure totaldegree,pLength0
4663*/
4664int posInL110 (const LSet set, const int length,
4665               LObject* p,const kStrategy)
4666{
4667  if (length<0) return 0;
4668
4669  int o = p->GetpFDeg();
4670  int op = set[length].GetpFDeg();
4671
4672  if ((op > o)
4673  || ((op == o) && (set[length].length >p->length))
4674  || ((op == o) && (set[length].length <= p->length)
4675     && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4676    return length+1;
4677  int i;
4678  int an = 0;
4679  int en= length;
4680  loop
4681  {
4682    if (an >= en-1)
4683    {
4684      op = set[an].GetpFDeg();
4685      if ((op > o)
4686      || ((op == o) && (set[an].length >p->length))
4687      || ((op == o) && (set[an].length <=p->length)
4688         && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4689        return en;
4690      return an;
4691    }
4692    i=(an+en) / 2;
4693    op = set[i].GetpFDeg();
4694    if ((op > o)
4695    || ((op == o) && (set[i].length > p->length))
4696    || ((op == o) && (set[i].length <= p->length)
4697       && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4698      an=i;
4699    else
4700      en=i;
4701  }
4702}
4703
4704/*2
4705* looks up the position of polynomial p in set
4706* e is the ecart of p
4707* set[length] is the smallest element in set with respect
4708* to the ordering-procedure totaldegree
4709*/
4710int posInL13 (const LSet set, const int length,
4711              LObject* p,const kStrategy)
4712{
4713  if (length<0) return 0;
4714
4715  int o = p->GetpFDeg();
4716
4717  if (set[length].GetpFDeg() > o)
4718    return length+1;
4719
4720  int i;
4721  int an = 0;
4722  int en= length;
4723  loop
4724  {
4725    if (an >= en-1)
4726    {
4727      if (set[an].GetpFDeg() >= o)
4728        return en;
4729      return an;
4730    }
4731    i=(an+en) / 2;
4732    if (set[i].GetpFDeg() >= o)
4733      an=i;
4734    else
4735      en=i;
4736  }
4737}
4738
4739/*2
4740* looks up the position of polynomial p in set
4741* e is the ecart of p
4742* set[length] is the smallest element in set with respect
4743* to the ordering-procedure maximaldegree,pComp
4744*/
4745int posInL15 (const LSet set, const int length,
4746              LObject* p,const kStrategy)
4747/*{
4748 * int j=0;
4749 * int o;
4750 *
4751 * o = p->ecart+p->GetpFDeg();
4752 * loop
4753 * {
4754 *   if (j > length)                       return j;
4755 *   if (set[j].GetpFDeg()+set[j].ecart < o) return j;
4756 *   if ((set[j].GetpFDeg()+set[j].ecart == o)
4757 *   && (pLmCmp(set[j].p,p->p) == -currRing->OrdSgn))
4758 *   {
4759 *     return j;
4760 *   }
4761 *   j++;
4762 * }
4763 *}
4764 */
4765{
4766  if (length<0) return 0;
4767
4768  int o = p->GetpFDeg() + p->ecart;
4769  int op = set[length].GetpFDeg() + set[length].ecart;
4770
4771  if ((op > o)
4772  || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4773    return length+1;
4774  int i;
4775  int an = 0;
4776  int en= length;
4777  loop
4778  {
4779    if (an >= en-1)
4780    {
4781      op = set[an].GetpFDeg() + set[an].ecart;
4782      if ((op > o)
4783      || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4784        return en;
4785      return an;
4786    }
4787    i=(an+en) / 2;
4788    op = set[i].GetpFDeg() + set[i].ecart;
4789    if ((op > o)
4790    || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4791      an=i;
4792    else
4793      en=i;
4794  }
4795}
4796
4797/*2
4798* looks up the position of polynomial p in set
4799* e is the ecart of p
4800* set[length] is the smallest element in set with respect
4801* to the ordering-procedure totaldegree
4802*/
4803int posInL17 (const LSet set, const int length,
4804              LObject* p,const kStrategy)
4805{
4806  if (length<0) return 0;
4807
4808  int o = p->GetpFDeg() + p->ecart;
4809
4810  if ((set[length].GetpFDeg() + set[length].ecart > o)
4811  || ((set[length].GetpFDeg() + set[length].ecart == o)
4812     && (set[length].ecart > p->ecart))
4813  || ((set[length].GetpFDeg() + set[length].ecart == o)
4814     && (set[length].ecart == p->ecart)
4815     && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4816    return length+1;
4817  int i;
4818  int an = 0;
4819  int en= length;
4820  loop
4821  {
4822    if (an >= en-1)
4823    {
4824      if ((set[an].GetpFDeg() + set[an].ecart > o)
4825      || ((set[an].GetpFDeg() + set[an].ecart == o)
4826         && (set[an].ecart > p->ecart))
4827      || ((set[an].GetpFDeg() + set[an].ecart == o)
4828         && (set[an].ecart == p->ecart)
4829         && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4830        return en;
4831      return an;
4832    }
4833    i=(an+en) / 2;
4834    if ((set[i].GetpFDeg() + set[i].ecart > o)
4835    || ((set[i].GetpFDeg() + set[i].ecart == o)
4836       && (set[i].ecart > p->ecart))
4837    || ((set[i].GetpFDeg() +set[i].ecart == o)
4838       && (set[i].ecart == p->ecart)
4839       && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4840      an=i;
4841    else
4842      en=i;
4843  }
4844}
4845/*2
4846* looks up the position of polynomial p in set
4847* e is the ecart of p
4848* set[length] is the smallest element in set with respect
4849* to the ordering-procedure pComp
4850*/
4851int posInL17_c (const LSet set, const int length,
4852                LObject* p,const kStrategy)
4853{
4854  if (length<0) return 0;
4855
4856  int cc = (-1+2*currRing->order[0]==ringorder_c);
4857  /* cc==1 for (c,..), cc==-1 for (C,..) */
4858  unsigned long c = pGetComp(p->p)*cc;
4859  int o = p->GetpFDeg() + p->ecart;
4860
4861  if (pGetComp(set[length].p)*cc > c)
4862    return length+1;
4863  if (pGetComp(set[length].p)*cc == c)
4864  {
4865    if ((set[length].GetpFDeg() + set[length].ecart > o)
4866    || ((set[length].GetpFDeg() + set[length].ecart == o)
4867       && (set[length].ecart > p->ecart))
4868    || ((set[length].GetpFDeg() + set[length].ecart == o)
4869       && (set[length].ecart == p->ecart)
4870       && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
4871      return length+1;
4872  }
4873  int i;
4874  int an = 0;
4875  int en= length;
4876  loop
4877  {
4878    if (an >= en-1)
4879    {
4880      if (pGetComp(set[an].p)*cc > c)
4881        return en;
4882      if (pGetComp(set[an].p)*cc == c)
4883      {
4884        if ((set[an].GetpFDeg() + set[an].ecart > o)
4885        || ((set[an].GetpFDeg() + set[an].ecart == o)
4886           && (set[an].ecart > p->ecart))
4887        || ((set[an].GetpFDeg() + set[an].ecart == o)
4888           && (set[an].ecart == p->ecart)
4889           && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
4890          return en;
4891      }
4892      return an;
4893    }
4894    i=(an+en) / 2;
4895    if (pGetComp(set[i].p)*cc > c)
4896      an=i;
4897    else if (pGetComp(set[i].p)*cc == c)
4898    {
4899      if ((set[i].GetpFDeg() + set[i].ecart > o)
4900      || ((set[i].GetpFDeg() + set[i].ecart == o)
4901         && (set[i].ecart > p->ecart))
4902      || ((set[i].GetpFDeg() +set[i].ecart == o)
4903         && (set[i].ecart == p->ecart)
4904         && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
4905        an=i;
4906      else
4907        en=i;
4908    }
4909    else
4910      en=i;
4911  }
4912}
4913
4914/*
4915 * SYZYGY CRITERION for signature-based standard basis algorithms
4916 */
4917BOOLEAN syzCriterion(poly sig, unsigned long not_sevSig, kStrategy strat)
4918{
4919//#if 1
4920#ifdef DEBUGF5
4921  Print("syzygy criterion checks:  ");
4922  pWrite(sig);
4923#endif
4924  for (int k=0; k<strat->syzl; k++)
4925  {
4926//#if 1
4927#ifdef DEBUGF5
4928    Print("checking with: %d --  ",k);
4929    pWrite(pHead(strat->syz[k]));
4930#endif
4931    if (p_LmShortDivisibleBy(strat->syz[k], strat->sevSyz[k], sig, not_sevSig, currRing))
4932    {
4933//#if 1
4934#ifdef DEBUGF5
4935      printf("DELETE!\n");
4936#endif
4937      return TRUE;
4938    }
4939  }
4940  return FALSE;
4941}
4942
4943/*
4944 * SYZYGY CRITERION for signature-based standard basis algorithms
4945 */
4946BOOLEAN syzCriterionInc(poly sig, unsigned long not_sevSig, kStrategy strat)
4947{
4948//#if 1
4949#ifdef DEBUGF5
4950  Print("syzygy criterion checks:  ");
4951  pWrite(sig);
4952#endif
4953  int comp = p_GetComp(sig, currRing);
4954  int min, max;
4955  if (comp<=1)
4956    return FALSE;
4957  else
4958  {
4959    min = strat->syzIdx[comp-2];
4960    //printf("SYZIDX %d/%d\n",strat->syzIdx[comp-2],comp-2);
4961    //printf("SYZIDX %d/%d\n",strat->syzIdx[comp-1],comp-1);
4962    //printf("SYZIDX %d/%d\n",strat->syzIdx[comp],comp);
4963    if (comp == strat->currIdx)
4964    {
4965      max = strat->syzl;
4966    }
4967    else
4968    {
4969      max = strat->syzIdx[comp-1];
4970    }
4971    for (int k=min; k<max; k++)
4972    {
4973#ifdef DEBUGF5
4974      printf("COMP %d/%d - MIN %d - MAX %d - SYZL %ld\n",comp,strat->currIdx,min,max,strat->syzl);
4975      Print("checking with: %d --  ",k);
4976      pWrite(pHead(strat->syz[k]));
4977#endif
4978      if (p_LmShortDivisibleBy(strat->syz[k], strat->sevSyz[k], sig, not_sevSig, currRing))
4979        return TRUE;
4980    }
4981    return FALSE;
4982  }
4983}
4984
4985/*
4986 * REWRITTEN CRITERION for signature-based standard basis algorithms
4987 */
4988BOOLEAN faugereRewCriterion(poly sig, unsigned long not_sevSig, kStrategy strat, int start=0)
4989{
4990  //printf("Faugere Rewritten Criterion\n");
4991//#if 1
4992#ifdef DEBUGF5
4993  printf("rewritten criterion checks:  ");
4994  pWrite(sig);
4995#endif
4996  //for(int k = start; k<strat->sl+1; k++)
4997  for(int k = strat->sl; k>start; k--)
4998  {
4999//#if 1
5000#ifdef DEBUGF5
5001    Print("checking with:  ");
5002    pWrite(strat->sig[k]);
5003    pWrite(pHead(strat->S[k]));
5004#endif
5005    if (p_LmShortDivisibleBy(strat->sig[k], strat->sevSig[k], sig, not_sevSig, currRing))
5006    //if (p_LmEqual(strat->sig[k], sig, currRing))
5007    {
5008//#if 1
5009#ifdef DEBUGF5
5010      printf("DELETE!\n");
5011#endif
5012      return TRUE;
5013    }
5014  }
5015#ifdef DEBUGF5
5016  Print("ALL ELEMENTS OF S\n----------------------------------------\n");
5017  for(int kk = 0; kk<strat->sl+1; kk++)
5018  {
5019    pWrite(pHead(strat->S[kk]));
5020  }
5021  Print("------------------------------\n");
5022#endif
5023  return FALSE;
5024}
5025
5026/*
5027 * REWRITTEN CRITERION for signature-based standard basis algorithms
5028 ***************************************************************************
5029 * TODO:This should become the version of Arri/Perry resp. Bjarke/Stillman *
5030 ***************************************************************************
5031 */
5032
5033// real implementation of arri's rewritten criterion, only called once in
5034// kstd2.cc, right before starting reduction
5035// IDEA:  Arri says that it is enough to consider 1 polynomial for each unique
5036//        signature appearing during the computations. Thus we first of all go
5037//        through strat->L and delete all other pairs of the same signature,
5038//        keeping only the one with least possible leading monomial. After this
5039//        we check if we really need to compute this critical pair at all: There
5040//        can be elements already in strat->S whose signatures divide the
5041//        signature of the critical pair in question and whose multiplied
5042//        leading monomials are smaller than the leading monomial of the
5043//        critical pair. In this situation we can discard the critical pair
5044//        completely.
5045BOOLEAN arriRewCriterion(poly sig, unsigned long not_sevSig, kStrategy strat, int start=0)
5046{
5047  //printf("Arri Rewritten Criterion\n");
5048  while (strat->Ll > 0 && pLmEqual(strat->L[strat->Ll].sig,strat->P.sig))
5049  {
5050    // deletes the short spoly
5051#ifdef HAVE_RINGS
5052    if (rField_is_Ring(currRing))
5053      pLmDelete(strat->L[strat->Ll].p);
5054    else
5055#endif
5056      pLmFree(strat->L[strat->Ll].p);
5057
5058    // TODO: needs some masking
5059    // TODO: masking needs to vanish once the signature
5060    //       sutff is completely implemented
5061    strat->L[strat->Ll].p = NULL;
5062    poly m1 = NULL, m2 = NULL;
5063
5064    // check that spoly creation is ok
5065    while (strat->tailRing != currRing &&
5066          !kCheckSpolyCreation(&(strat->L[strat->Ll]), strat, m1, m2))
5067    {
5068      assume(m1 == NULL && m2 == NULL);
5069      // if not, change to a ring where exponents are at least
5070      // large enough
5071      if (!kStratChangeTailRing(strat))
5072      {
5073        WerrorS("OVERFLOW...");
5074        break;
5075      }
5076    }
5077    // create the real one
5078    ksCreateSpoly(&(strat->L[strat->Ll]), NULL, strat->use_buckets,
5079                  strat->tailRing, m1, m2, strat->R);
5080    if (strat->P.GetLmCurrRing() == NULL)
5081    {
5082      deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
5083    }
5084    if (strat->L[strat->Ll].GetLmCurrRing() == NULL)
5085    {
5086      strat->P.Delete();
5087      strat->P = strat->L[strat->Ll];
5088      strat->Ll--;
5089    }
5090
5091    if (strat->P.GetLmCurrRing() != NULL && strat->L[strat->Ll].GetLmCurrRing() != NULL)
5092    {
5093      if (pLmCmp(strat->P.GetLmCurrRing(),strat->L[strat->Ll].GetLmCurrRing()) == -1)
5094      {
5095        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
5096      }
5097      else
5098      {
5099        strat->P.Delete();
5100        strat->P = strat->L[strat->Ll];
5101        strat->Ll--;
5102      }
5103    }
5104  }
5105  for (int ii=strat->sl; ii>-1; ii--)
5106  {
5107    if (p_LmShortDivisibleBy(strat->sig[ii], strat->sevSig[ii], strat->P.sig, ~strat->P.sevSig, currRing))
5108    {
5109      if (!(pLmCmp(ppMult_mm(strat->P.sig,pHead(strat->S[ii])),ppMult_mm(strat->sig[ii],strat->P.GetLmCurrRing())) == 1))
5110      {
5111        strat->P.Delete();
5112        return TRUE;
5113      }
5114    }
5115  }
5116  return FALSE;
5117}
5118
5119/***************************************************************
5120 *
5121 * Tail reductions
5122 *
5123 ***************************************************************/
5124TObject*
5125kFindDivisibleByInS(kStrategy strat, int pos, LObject* L, TObject *T,
5126                    long ecart)
5127{
5128  int j = 0;
5129  const unsigned long not_sev = ~L->sev;
5130  const unsigned long* sev = strat->sevS;
5131  poly p;
5132  ring r;
5133  L->GetLm(p, r);
5134
5135  assume(~not_sev == p_GetShortExpVector(p, r));
5136
5137  if (r == currRing)
5138  {
5139    loop
5140    {
5141      if (j > pos) return NULL;
5142#if defined(PDEBUG) || defined(PDIV_DEBUG)
5143      if (p_LmShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
5144          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
5145        break;
5146#else
5147      if (!(sev[j] & not_sev) &&
5148          (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
5149          p_LmDivisibleBy(strat->S[j], p, r))
5150        break;
5151
5152#endif
5153      j++;
5154    }
5155    // if called from NF, T objects do not exist:
5156    if (strat->tl < 0 || strat->S_2_R[j] == -1)
5157    {
5158      T->Set(strat->S[j], r, strat->tailRing);
5159      return T;
5160    }
5161    else
5162    {
5163/////      assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL
5164/////      && strat->S_2_T(j)->p == strat->S[j]); // wrong?
5165//      assume (j >= 0 && j <= strat->sl && strat->S_2_T(j) != NULL && strat->S_2_T(j)->p == strat->S[j]);
5166      return strat->S_2_T(j);
5167    }
5168  }
5169  else
5170  {
5171    TObject* t;
5172    loop
5173    {
5174      if (j > pos) return NULL;
5175      assume(strat->S_2_R[j] != -1);
5176#if defined(PDEBUG) || defined(PDIV_DEBUG)
5177      t = strat->S_2_T(j);
5178      assume(t != NULL && t->t_p != NULL && t->tailRing == r);
5179      if (p_LmShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
5180          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
5181        return t;
5182#else
5183      if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
5184      {
5185        t = strat->S_2_T(j);
5186        assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
5187        if (p_LmDivisibleBy(t->t_p, p, r)) return t;
5188      }
5189#endif
5190      j++;
5191    }
5192  }
5193}
5194
5195poly redtail (LObject* L, int pos, kStrategy strat)
5196{
5197  poly h, hn;
5198  strat->redTailChange=FALSE;
5199
5200  poly p = L->p;
5201  if (strat->noTailReduction || pNext(p) == NULL)
5202    return p;
5203
5204  LObject Ln(strat->tailRing);
5205  TObject* With;
5206  // placeholder in case strat->tl < 0
5207  TObject  With_s(strat->tailRing);
5208  h = p;
5209  hn = pNext(h);
5210  long op = strat->tailRing->pFDeg(hn, strat->tailRing);
5211  long e;
5212  int l;
5213  BOOLEAN save_HE=strat->kHEdgeFound;
5214  strat->kHEdgeFound |=
5215    ((Kstd1_deg>0) && (op<=Kstd1_deg)) || TEST_OPT_INFREDTAIL;
5216
5217  while(hn != NULL)
5218  {
5219    op = strat->tailRing->pFDeg(hn, strat->tailRing);
5220    if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
5221    e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
5222    loop
5223    {
5224      Ln.Set(hn, strat->tailRing);
5225      Ln.sev = p_GetShortExpVector(hn, strat->tailRing);
5226      if (strat->kHEdgeFound)
5227        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
5228      else
5229        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s, e);
5230      if (With == NULL) break;
5231      With->length=0;
5232      With->pLength=0;
5233      strat->redTailChange=TRUE;
5234      if (ksReducePolyTail(L, With, h, strat->kNoetherTail()))
5235      {
5236        // reducing the tail would violate the exp bound
5237        if (kStratChangeTailRing(strat, L))
5238        {
5239          strat->kHEdgeFound = save_HE;
5240          return redtail(L, pos, strat);
5241        }
5242        else
5243          return NULL;
5244      }
5245      hn = pNext(h);
5246      if (hn == NULL) goto all_done;
5247      op = strat->tailRing->pFDeg(hn, strat->tailRing);
5248      if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
5249      e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
5250    }
5251    h = hn;
5252    hn = pNext(h);
5253  }
5254
5255  all_done:
5256  if (strat->redTailChange)
5257  {
5258    L->last = NULL;
5259    L->pLength = 0;
5260  }
5261  strat->kHEdgeFound = save_HE;
5262  return p;
5263}
5264
5265poly redtail (poly p, int pos, kStrategy strat)
5266{
5267  LObject L(p, currRing);
5268  return redtail(&L, pos, strat);
5269}
5270
5271poly redtailBba (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
5272{
5273#define REDTAIL_CANONICALIZE 100
5274  strat->redTailChange=FALSE;
5275  if (strat->noTailReduction) return L->GetLmCurrRing();
5276  poly h, p;
5277  p = h = L->GetLmTailRing();
5278  if ((h==NULL) || (pNext(h)==NULL))
5279    return L->GetLmCurrRing();
5280
5281  TObject* With;
5282  // placeholder in case strat->tl < 0
5283  TObject  With_s(strat->tailRing);
5284
5285  LObject Ln(pNext(h), strat->tailRing);
5286  Ln.pLength = L->GetpLength() - 1;
5287
5288  pNext(h) = NULL;
5289  if (L->p != NULL) pNext(L->p) = NULL;
5290  L->pLength = 1;
5291
5292  Ln.PrepareRed(strat->use_buckets);
5293
5294  int cnt=REDTAIL_CANONICALIZE;
5295  while(!Ln.IsNull())
5296  {
5297    loop
5298    {
5299      Ln.SetShortExpVector();
5300      if (withT)
5301      {
5302        int j;
5303        j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
5304        if (j < 0) break;
5305        With = &(strat->T[j]);
5306      }
5307      else
5308      {
5309        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
5310        if (With == NULL) break;
5311      }
5312      cnt--;
5313      if (cnt==0)
5314      {
5315        cnt=REDTAIL_CANONICALIZE;
5316        /*poly tmp=*/Ln.CanonicalizeP();
5317        if (normalize)
5318        {
5319          Ln.Normalize();
5320          //pNormalize(tmp);
5321          //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
5322        }
5323      }
5324      if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
5325      {
5326        With->pNorm();
5327      }
5328      strat->redTailChange=TRUE;
5329      if (ksReducePolyTail(L, With, &Ln))
5330      {
5331        // reducing the tail would violate the exp bound
5332        //  set a flag and hope for a retry (in bba)
5333        strat->completeReduce_retry=TRUE;
5334        if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
5335        do
5336        {
5337          pNext(h) = Ln.LmExtractAndIter();
5338          pIter(h);
5339          L->pLength++;
5340        } while (!Ln.IsNull());
5341        goto all_done;
5342      }
5343      if (Ln.IsNull()) goto all_done;
5344      if (! withT) With_s.Init(currRing);
5345    }
5346    pNext(h) = Ln.LmExtractAndIter();
5347    pIter(h);
5348    pNormalize(h);
5349    L->pLength++;
5350  }
5351
5352  all_done:
5353  Ln.Delete();
5354  if (L->p != NULL) pNext(L->p) = pNext(p);
5355
5356  if (strat->redTailChange)
5357  {
5358    L->last = NULL;
5359    L->length = 0;
5360  }
5361
5362  //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
5363  //L->Normalize(); // HANNES: should have a test
5364  kTest_L(L);
5365  return L->GetLmCurrRing();
5366}
5367
5368#ifdef HAVE_RINGS
5369poly redtailBba_Z (LObject* L, int pos, kStrategy strat )
5370// normalize=FALSE, withT=FALSE, coeff=Z
5371{
5372  strat->redTailChange=FALSE;
5373  if (strat->noTailReduction) return L->GetLmCurrRing();
5374  poly h, p;
5375  p = h = L->GetLmTailRing();
5376  if ((h==NULL) || (pNext(h)==NULL))
5377    return L->GetLmCurrRing();
5378
5379  TObject* With;
5380  // placeholder in case strat->tl < 0
5381  TObject  With_s(strat->tailRing);
5382
5383  LObject Ln(pNext(h), strat->tailRing);
5384  Ln.pLength = L->GetpLength() - 1;
5385
5386  pNext(h) = NULL;
5387  if (L->p != NULL) pNext(L->p) = NULL;
5388  L->pLength = 1;
5389
5390  Ln.PrepareRed(strat->use_buckets);
5391
5392  int cnt=REDTAIL_CANONICALIZE;
5393  while(!Ln.IsNull())
5394  {
5395    loop
5396    {
5397      Ln.SetShortExpVector();
5398      With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
5399      if (With == NULL) break;
5400      cnt--;
5401      if (cnt==0)
5402      {
5403        cnt=REDTAIL_CANONICALIZE;
5404        /*poly tmp=*/Ln.CanonicalizeP();
5405      }
5406      // we are in Z, do not call pNorm
5407      strat->redTailChange=TRUE;
5408      // test divisibility of coefs:
5409      poly p_Ln=Ln.GetLmCurrRing();
5410      poly p_With=With->GetLmCurrRing();
5411      number z=n_IntMod(pGetCoeff(p_Ln),pGetCoeff(p_With), currRing->cf);
5412      if (!nIsZero(z))
5413      {
5414        // subtract z*Ln, add z.Ln to L
5415        poly m=pHead(p_Ln);
5416        pSetCoeff(m,z);
5417        poly mm=pHead(m);
5418        pNext(h) = m;
5419        pIter(h);
5420        L->pLength++;
5421        mm=pNeg(mm);
5422        if (Ln.bucket!=NULL)
5423        {
5424          int dummy=1;
5425          kBucket_Add_q(Ln.bucket,mm,&dummy);
5426        }
5427        else
5428        {
5429          if (Ln.p!=NULL) Ln.p=pAdd(Ln.p,mm);
5430          else if (Ln.t_p!=NULL)  Ln.t_p=p_Add_q(Ln.t_p,mm,strat->tailRing);
5431        }
5432      }
5433      else
5434        nDelete(&z);
5435
5436      if (ksReducePolyTail(L, With, &Ln))
5437      {
5438        // reducing the tail would violate the exp bound
5439        //  set a flag and hope for a retry (in bba)
5440        strat->completeReduce_retry=TRUE;
5441        if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
5442        do
5443        {
5444          pNext(h) = Ln.LmExtractAndIter();
5445          pIter(h);
5446          L->pLength++;
5447        } while (!Ln.IsNull());
5448        goto all_done;
5449      }
5450      if (Ln.IsNull()) goto all_done;
5451      With_s.Init(currRing);
5452    }
5453    pNext(h) = Ln.LmExtractAndIter();
5454    pIter(h);
5455    pNormalize(h);
5456    L->pLength++;
5457  }
5458
5459  all_done:
5460  Ln.Delete();
5461  if (L->p != NULL) pNext(L->p) = pNext(p);
5462
5463  if (strat->redTailChange)
5464  {
5465    L->last = NULL;
5466    L->length = 0;
5467  }
5468
5469  //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
5470  //L->Normalize(); // HANNES: should have a test
5471  kTest_L(L);
5472  return L->GetLmCurrRing();
5473}
5474#endif
5475
5476/*2
5477*checks the change degree and write progress report
5478*/
5479void message (int i,int* reduc,int* olddeg,kStrategy strat, int red_result)
5480{
5481  if (i != *olddeg)
5482  {
5483    Print("%d",i);
5484    *olddeg = i;
5485  }
5486  if (TEST_OPT_OLDSTD)
5487  {
5488    if (strat->Ll != *reduc)
5489    {
5490      if (strat->Ll != *reduc-1)
5491        Print("(%d)",strat->Ll+1);
5492      else
5493        PrintS("-");
5494      *reduc = strat->Ll;
5495    }
5496    else
5497      PrintS(".");
5498    mflush();
5499  }
5500  else
5501  {
5502    if (red_result == 0)
5503      PrintS("-");
5504    else if (red_result < 0)
5505      PrintS(".");
5506    if ((red_result > 0) || ((strat->Ll % 100)==99))
5507    {
5508      if (strat->Ll != *reduc && strat->Ll > 0)
5509      {
5510        Print("(%d)",strat->Ll+1);
5511        *reduc = strat->Ll;
5512      }
5513    }
5514  }
5515}
5516
5517/*2
5518*statistics
5519*/
5520void messageStat (int hilbcount,kStrategy strat)
5521{
5522  //PrintS("\nUsage/Allocation of temporary storage:\n");
5523  //Print("%d/%d polynomials in standard base\n",srmax,IDELEMS(Shdl));
5524  //Print("%d/%d polynomials in set L (for lazy alg.)",lrmax+1,strat->Lmax);
5525  Print("product criterion:%d chain criterion:%d\n",strat->cp,strat->c3);
5526  if (hilbcount!=0) Print("hilbert series criterion:%d\n",hilbcount);
5527  /* in usual case strat->cv is 0, it gets changed only in shift routines */
5528  if (strat->cv!=0) Print("shift V criterion:%d\n",strat->cv);
5529  /*mflush();*/
5530}
5531
5532#ifdef KDEBUG
5533/*2
5534*debugging output: all internal sets, if changed
5535*for testing purpuse only/has to be changed for later use
5536*/
5537void messageSets (kStrategy strat)
5538{
5539  int i;
5540  if (strat->news)
5541  {
5542    PrintS("set S");
5543    for (i=0; i<=strat->sl; i++)
5544    {
5545      Print("\n  %d:",i);
5546      p_wrp(strat->S[i], currRing, strat->tailRing);
5547    }
5548    strat->news = FALSE;
5549  }
5550  if (strat->newt)
5551  {
5552    PrintS("\nset T");
5553    for (i=0; i<=strat->tl; i++)
5554    {
5555      Print("\n  %d:",i);
5556      strat->T[i].wrp();
5557      Print(" o:%ld e:%d l:%d",
5558        strat->T[i].pFDeg(),strat->T[i].ecart,strat->T[i].length);
5559    }
5560    strat->newt = FALSE;
5561  }
5562  PrintS("\nset L");
5563  for (i=strat->Ll; i>=0; i--)
5564  {
5565    Print("\n%d:",i);
5566    p_wrp(strat->L[i].p1, currRing, strat->tailRing);
5567    PrintS("  ");
5568    p_wrp(strat->L[i].p2, currRing, strat->tailRing);
5569    PrintS(" lcm: ");p_wrp(strat->L[i].lcm, currRing);
5570    PrintS("\n  p : ");
5571    strat->L[i].wrp();
5572    Print("  o:%ld e:%d l:%d",
5573          strat->L[i].pFDeg(),strat->L[i].ecart,strat->L[i].length);
5574  }
5575  PrintLn();
5576}
5577
5578#endif
5579
5580
5581/*2
5582*construct the set s from F
5583*/
5584void initS (ideal F, ideal Q, kStrategy strat)
5585{
5586  int   i,pos;
5587
5588  if (Q!=NULL) i=((IDELEMS(F)+IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5589  else         i=((IDELEMS(F)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5590  strat->ecartS=initec(i);
5591  strat->sevS=initsevS(i);
5592  strat->S_2_R=initS_2_R(i);
5593  strat->fromQ=NULL;
5594  strat->Shdl=idInit(i,F->rank);
5595  strat->S=strat->Shdl->m;
5596  /*- put polys into S -*/
5597  if (Q!=NULL)
5598  {
5599    strat->fromQ=initec(i);
5600    memset(strat->fromQ,0,i*sizeof(int));
5601    for (i=0; i<IDELEMS(Q); i++)
5602    {
5603      if (Q->m[i]!=NULL)
5604      {
5605        LObject h;
5606        h.p = pCopy(Q->m[i]);
5607        if (TEST_OPT_INTSTRATEGY)
5608        {
5609          //pContent(h.p);
5610          h.pCleardenom(); // also does a pContent
5611        }
5612        else
5613        {
5614          h.pNorm();
5615        }
5616        if (currRing->OrdSgn==-1)
5617        {
5618          deleteHC(&h, strat);
5619        }
5620        if (h.p!=NULL)
5621        {
5622          strat->initEcart(&h);
5623          if (strat->sl==-1)
5624            pos =0;
5625          else
5626          {
5627            pos = posInS(strat,strat->sl,h.p,h.ecart);
5628          }
5629          h.sev = pGetShortExpVector(h.p);
5630          strat->enterS(h,pos,strat,-1);
5631          strat->fromQ[pos]=1;
5632        }
5633      }
5634    }
5635  }
5636  for (i=0; i<IDELEMS(F); i++)
5637  {
5638    if (F->m[i]!=NULL)
5639    {
5640      LObject h;
5641      h.p = pCopy(F->m[i]);
5642      if (currRing->OrdSgn==-1)
5643      {
5644        cancelunit(&h);  /*- tries to cancel a unit -*/
5645        deleteHC(&h, strat);
5646      }
5647      if (h.p!=NULL)
5648      // do not rely on the input being a SB!
5649      {
5650        if (TEST_OPT_INTSTRATEGY)
5651        {
5652          //pContent(h.p);
5653          h.pCleardenom(); // also does a pContent
5654        }
5655        else
5656        {
5657          h.pNorm();
5658        }
5659        strat->initEcart(&h);
5660        if (strat->sl==-1)
5661          pos =0;
5662        else
5663          pos = posInS(strat,strat->sl,h.p,h.ecart);
5664        h.sev = pGetShortExpVector(h.p);
5665        strat->enterS(h,pos,strat,-1);
5666      }
5667    }
5668  }
5669  /*- test, if a unit is in F -*/
5670  if ((strat->sl>=0)
5671#ifdef HAVE_RINGS
5672       && n_IsUnit(pGetCoeff(strat->S[0]),currRing->cf)
5673#endif
5674       && pIsConstant(strat->S[0]))
5675  {
5676    while (strat->sl>0) deleteInS(strat->sl,strat);
5677  }
5678}
5679
5680void initSL (ideal F, ideal Q,kStrategy strat)
5681{
5682  int   i,pos;
5683
5684  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5685  else i=setmaxT;
5686  strat->ecartS=initec(i);
5687  strat->sevS=initsevS(i);
5688  strat->S_2_R=initS_2_R(i);
5689  strat->fromQ=NULL;
5690  strat->Shdl=idInit(i,F->rank);
5691  strat->S=strat->Shdl->m;
5692  /*- put polys into S -*/
5693  if (Q!=NULL)
5694  {
5695    strat->fromQ=initec(i);
5696    memset(strat->fromQ,0,i*sizeof(int));
5697    for (i=0; i<IDELEMS(Q); i++)
5698    {
5699      if (Q->m[i]!=NULL)
5700      {
5701        LObject h;
5702        h.p = pCopy(Q->m[i]);
5703        if (currRing->OrdSgn==-1)
5704        {
5705          deleteHC(&h,strat);
5706        }
5707        if (TEST_OPT_INTSTRATEGY)
5708        {
5709          //pContent(h.p);
5710          h.pCleardenom(); // also does a pContent
5711        }
5712        else
5713        {
5714          h.pNorm();
5715        }
5716        if (h.p!=NULL)
5717        {
5718          strat->initEcart(&h);
5719          if (strat->sl==-1)
5720            pos =0;
5721          else
5722          {
5723            pos = posInS(strat,strat->sl,h.p,h.ecart);
5724          }
5725          h.sev = pGetShortExpVector(h.p);
5726          strat->enterS(h,pos,strat,-1);
5727          strat->fromQ[pos]=1;
5728        }
5729      }
5730    }
5731  }
5732  for (i=0; i<IDELEMS(F); i++)
5733  {
5734    if (F->m[i]!=NULL)
5735    {
5736      LObject h;
5737      h.p = pCopy(F->m[i]);
5738      if (h.p!=NULL)
5739      {
5740        if (currRing->OrdSgn==-1)
5741        {
5742          cancelunit(&h);  /*- tries to cancel a unit -*/
5743          deleteHC(&h, strat);
5744        }
5745        if (h.p!=NULL)
5746        {
5747          if (TEST_OPT_INTSTRATEGY)
5748          {
5749            //pContent(h.p);
5750            h.pCleardenom(); // also does a pContent
5751          }
5752          else
5753          {
5754            h.pNorm();
5755          }
5756          strat->initEcart(&h);
5757          if (strat->Ll==-1)
5758            pos =0;
5759          else
5760            pos = strat->posInL(strat->L,strat->Ll,&h,strat);
5761          h.sev = pGetShortExpVector(h.p);
5762          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
5763        }
5764      }
5765    }
5766  }
5767  /*- test, if a unit is in F -*/
5768
5769  if ((strat->Ll>=0)
5770#ifdef HAVE_RINGS
5771       && n_IsUnit(pGetCoeff(strat->L[strat->Ll].p), currRing->cf)
5772#endif
5773       && pIsConstant(strat->L[strat->Ll].p))
5774  {
5775    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
5776  }
5777}
5778
5779void initSLSba (ideal F, ideal Q,kStrategy strat)
5780{
5781  int   i,j,pos, ctr=0, ps=0;
5782  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5783  else i=setmaxT;
5784  strat->ecartS =   initec(i);
5785  strat->fromS  =   initec(i);
5786  strat->sevS   =   initsevS(i);
5787  strat->sevSig =   initsevS(i);
5788  strat->S_2_R  =   initS_2_R(i);
5789  strat->fromQ  =   NULL;
5790  strat->Shdl   =   idInit(i,F->rank);
5791  strat->S      =   strat->Shdl->m;
5792  strat->sig    =   (poly *)omAlloc0(i*sizeof(poly));
5793  if (!strat->incremental)
5794  {
5795    strat->syz    = (poly *)omAlloc0(i*sizeof(poly));
5796    strat->sevSyz = initsevS(i);
5797    strat->syzmax = i;
5798    strat->syzl   = 0;
5799  }
5800  /*- put polys into S -*/
5801  if (Q!=NULL)
5802  {
5803    strat->fromQ=initec(i);
5804    memset(strat->fromQ,0,i*sizeof(int));
5805    for (i=0; i<IDELEMS(Q); i++)
5806    {
5807      if (Q->m[i]!=NULL)
5808      {
5809        LObject h;
5810        h.p = pCopy(Q->m[i]);
5811        if (currRing->OrdSgn==-1)
5812        {
5813          deleteHC(&h,strat);
5814        }
5815        if (TEST_OPT_INTSTRATEGY)
5816        {
5817          //pContent(h.p);
5818          h.pCleardenom(); // also does a pContent
5819        }
5820        else
5821        {
5822          h.pNorm();
5823        }
5824        if (h.p!=NULL)
5825        {
5826          strat->initEcart(&h);
5827          if (strat->sl==-1)
5828            pos =0;
5829          else
5830          {
5831            pos = posInS(strat,strat->sl,h.p,h.ecart);
5832          }
5833          h.sev = pGetShortExpVector(h.p);
5834          strat->enterS(h,pos,strat,-1);
5835          strat->fromQ[pos]=1;
5836        }
5837      }
5838    }
5839  }
5840  for (i=0; i<IDELEMS(F); i++)
5841  {
5842    if (F->m[i]!=NULL)
5843    {
5844      LObject h;
5845      h.p = pCopy(F->m[i]);
5846      h.sig = pOne();
5847      //h.sig = pInit();
5848      //p_SetCoeff(h.sig,nInit(1),currRing);
5849      p_SetComp(h.sig,i+1,currRing);
5850      // if we are working with the Schreyer order we generate it
5851      // by multiplying the initial signatures with the leading monomial
5852      // of the corresponding initial polynomials generating the ideal
5853      // => we can keep the underlying monomial order and get a Schreyer
5854      //    order without any bigger overhead
5855      if (!strat->incremental)
5856      {
5857        p_ExpVectorAdd (h.sig,F->m[i],currRing); 
5858      }
5859      h.sevSig = pGetShortExpVector(h.sig);
5860#ifdef DEBUGF5
5861      pWrite(h.p);
5862      pWrite(h.sig);
5863#endif
5864      if (h.p!=NULL)
5865      {
5866        if (currRing->OrdSgn==-1)
5867        {
5868          cancelunit(&h);  /*- tries to cancel a unit -*/
5869          deleteHC(&h, strat);
5870        }
5871        if (h.p!=NULL)
5872        {
5873          if (TEST_OPT_INTSTRATEGY)
5874          {
5875            //pContent(h.p);
5876            h.pCleardenom(); // also does a pContent
5877          }
5878          else
5879          {
5880            h.pNorm();
5881          }
5882          strat->initEcart(&h);
5883          if (strat->Ll==-1)
5884            pos =0;
5885          else
5886            pos = strat->posInLSba(strat->L,strat->Ll,&h,strat);
5887          h.sev = pGetShortExpVector(h.p);
5888          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
5889        }
5890      }
5891      /*
5892      if (!strat->incremental)
5893      {
5894        for(j=0;j<i;j++)
5895        {
5896          strat->syz[ctr] = pCopy(F->m[j]);
5897          p_SetCompP(strat->syz[ctr],i+1,currRing);
5898          // add LM(F->m[i]) to the signature to get a Schreyer order
5899          // without changing the underlying polynomial ring at all
5900          p_ExpVectorAdd (strat->syz[ctr],F->m[i],currRing); 
5901          // since p_Add_q() destroys all input
5902          // data we need to recreate help
5903          // each time
5904          poly help = pCopy(F->m[i]);
5905          p_SetCompP(help,j+1,currRing);
5906          pWrite(strat->syz[ctr]);
5907          pWrite(help);
5908          printf("%d\n",pLmCmp(strat->syz[ctr],help));
5909          strat->syz[ctr] = p_Add_q(strat->syz[ctr],help,currRing);
5910          printf("%d. SYZ  ",ctr);
5911          pWrite(strat->syz[ctr]);
5912          strat->sevSyz[ctr] = p_GetShortExpVector(strat->syz[ctr],currRing);
5913          ctr++;
5914        }
5915        strat->syzl = ps;
5916      }
5917      */
5918    }
5919  }
5920  /*- test, if a unit is in F -*/
5921
5922  if ((strat->Ll>=0)
5923#ifdef HAVE_RINGS
5924       && n_IsUnit(pGetCoeff(strat->L[strat->Ll].p), currRing->cf)
5925#endif
5926       && pIsConstant(strat->L[strat->Ll].p))
5927  {
5928    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
5929  }
5930}
5931
5932void initSyzRules (kStrategy strat)
5933{
5934  if( strat->S[0] )
5935  {
5936    if( strat->S[1] )
5937    {
5938      omFreeSize(strat->syzIdx,(strat->syzidxmax)*sizeof(int));
5939      omFreeSize(strat->sevSyz,(strat->syzmax)*sizeof(unsigned long));
5940      omFreeSize(strat->syz,(strat->syzmax)*sizeof(poly));
5941    }
5942    int i, j, k, diff, comp, comp_old, ps=0, ctr=0;
5943    /************************************************************
5944     * computing the length of the syzygy array needed
5945     ***********************************************************/
5946    for(i=1; i<=strat->sl; i++)
5947    {
5948      if (pGetComp(strat->sig[i-1]) != pGetComp(strat->sig[i]))
5949      { 
5950        ps += i;
5951      }
5952    }
5953    ps += strat->sl+1;
5954    //comp              = pGetComp (strat->P.sig);
5955    comp              = strat->currIdx;
5956    strat->syzIdx     = initec(comp);
5957    strat->sevSyz     = initsevS(ps);
5958    strat->syz        = (poly *)omAlloc(ps*sizeof(poly));
5959    strat->syzl       = strat->syzmax = ps;
5960    strat->syzidxmax  = comp;
5961#ifdef DEBUGF5 || DEBUGF51
5962    printf("------------- GENERATING SYZ RULES NEW ---------------\n");
5963#endif
5964    i = 1; 
5965    j = 0;
5966    /************************************************************
5967     * generating the leading terms of the principal syzygies
5968     ***********************************************************/
5969    while (i <= strat->sl)
5970    {
5971      /**********************************************************
5972       * principal syzygies start with component index 2
5973       * the array syzIdx starts with index 0
5974       * => the rules for a signature with component comp start
5975       *    at strat->syz[strat->syzIdx[comp-2]] !
5976       *********************************************************/
5977      if (pGetComp(strat->sig[i-1]) != pGetComp(strat->sig[i]))
5978      {
5979        comp      = pGetComp(strat->sig[i]);
5980        comp_old  = pGetComp(strat->sig[i-1]);
5981        diff      = comp - comp_old - 1;
5982        // diff should be zero, but sometimes also the initial generating
5983        // elements of the input ideal reduce to zero. then there is an
5984        // index-gap between the signatures. for these inbetween signatures we
5985        // can safely set syzIdx[j] = 0 as no such element will be ever computed
5986        // in the following.
5987        // doing this, we keep the relation "j = comp - 2" alive, which makes
5988        // jumps way easier when checking criteria
5989        while (diff>0)
5990        {
5991          strat->syzIdx[j]  = 0;
5992          diff--;
5993          j++;
5994        }
5995        strat->syzIdx[j]  = ctr;
5996        j++;
5997        for (k = 0; k<i; k++)
5998        {
5999          poly p          = pOne();
6000          pLcm(strat->S[k],strat->S[i],p);
6001          strat->syz[ctr] = p;
6002          p_SetCompP (strat->syz[ctr], comp, currRing);
6003          poly q          = p_Copy(p, currRing);
6004          q               = p_Neg (q, currRing);
6005          p_SetCompP (q, p_GetComp(strat->sig[k], currRing), currRing);
6006          strat->syz[ctr] = p_Add_q (strat->syz[ctr], q, currRing);
6007#ifdef DEBUGF5 || DEBUGF51
6008          pWrite(strat->syz[ctr]);
6009#endif
6010          strat->sevSyz[ctr] = p_GetShortExpVector(strat->syz[ctr],currRing);
6011          ctr++;
6012        }
6013      }
6014      i++;
6015    }
6016    /**************************************************************
6017    * add syzygies for upcoming first element of new iteration step
6018    **************************************************************/
6019    comp      = strat->currIdx;
6020    comp_old  = pGetComp(strat->sig[i-1]);
6021    diff      = comp - comp_old - 1;
6022    // diff should be zero, but sometimes also the initial generating
6023    // elements of the input ideal reduce to zero. then there is an
6024    // index-gap between the signatures. for these inbetween signatures we
6025    // can safely set syzIdx[j] = 0 as no such element will be ever computed
6026    // in the following.
6027    // doing this, we keep the relation "j = comp - 2" alive, which makes
6028    // jumps way easier when checking criteria
6029    while (diff>0)
6030    {
6031      strat->syzIdx[j]  = 0;
6032      diff--;
6033      j++;
6034    }
6035    strat->syzIdx[j]  = ctr;
6036    for (k = 0; k<strat->sl+1; k++)
6037    {
6038      strat->syz[ctr] = p_Copy (pHead(strat->S[k]), currRing);
6039      p_SetCompP (strat->syz[ctr], comp, currRing);
6040      poly q          = p_Copy (pHead(strat->L[strat->Ll].p), currRing);
6041      q               = p_Neg (q, currRing);
6042      p_SetCompP (q, p_GetComp(strat->sig[k], currRing), currRing);
6043      strat->syz[ctr] = p_Add_q (strat->syz[ctr], q, currRing);
6044//#if 1
6045#if DEBUGF5 || DEBUGF51
6046      printf("..");
6047      pWrite(strat->syz[ctr]);
6048#endif
6049      strat->sevSyz[ctr] = p_GetShortExpVector(strat->syz[ctr],currRing);
6050      ctr++;
6051    }
6052//#if 1
6053#ifdef DEBUGF5
6054    Print("Principal syzygies:\n");
6055    Print("--------------------------------\n");
6056    for(i=0;i<=ps-1;i++)
6057    {
6058      pWrite(strat->syz[i]);
6059    }