source: git/kernel/kutil.cc @ fee33e

spielwiese
Last change on this file since fee33e was 83be980, checked in by Christian Eder, 12 years ago
adds signature-based algorithm files from master, does not build right now: fixes kstd1.cc for compilation
  • Property mode set to 100644
File size: 227.6 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,j,compare;
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==pOrdSgn)
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]);
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)== pOrdSgn)
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) == pOrdSgn) return en;
4483    return an;
4484  }
4485  i=(an+en) / 2;
4486  if (pLmCmp(set[i].sig,p->sig) == pOrdSgn) 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 *
4916 * Tail reductions
4917 *
4918 ***************************************************************/
4919TObject*
4920kFindDivisibleByInS(kStrategy strat, int pos, LObject* L, TObject *T,
4921                    long ecart)
4922{
4923  int j = 0;
4924  const unsigned long not_sev = ~L->sev;
4925  const unsigned long* sev = strat->sevS;
4926  poly p;
4927  ring r;
4928  L->GetLm(p, r);
4929
4930  assume(~not_sev == p_GetShortExpVector(p, r));
4931
4932  if (r == currRing)
4933  {
4934    loop
4935    {
4936      if (j > pos) return NULL;
4937#if defined(PDEBUG) || defined(PDIV_DEBUG)
4938      if (p_LmShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
4939          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4940        break;
4941#else
4942      if (!(sev[j] & not_sev) &&
4943          (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
4944          p_LmDivisibleBy(strat->S[j], p, r))
4945        break;
4946
4947#endif
4948      j++;
4949    }
4950    // if called from NF, T objects do not exist:
4951    if (strat->tl < 0 || strat->S_2_R[j] == -1)
4952    {
4953      T->Set(strat->S[j], r, strat->tailRing);
4954      return T;
4955    }
4956    else
4957    {
4958/////      assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL
4959/////      && strat->S_2_T(j)->p == strat->S[j]); // wrong?
4960//      assume (j >= 0 && j <= strat->sl && strat->S_2_T(j) != NULL && strat->S_2_T(j)->p == strat->S[j]);
4961      return strat->S_2_T(j);
4962    }
4963  }
4964  else
4965  {
4966    TObject* t;
4967    loop
4968    {
4969      if (j > pos) return NULL;
4970      assume(strat->S_2_R[j] != -1);
4971#if defined(PDEBUG) || defined(PDIV_DEBUG)
4972      t = strat->S_2_T(j);
4973      assume(t != NULL && t->t_p != NULL && t->tailRing == r);
4974      if (p_LmShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
4975          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4976        return t;
4977#else
4978      if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4979      {
4980        t = strat->S_2_T(j);
4981        assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
4982        if (p_LmDivisibleBy(t->t_p, p, r)) return t;
4983      }
4984#endif
4985      j++;
4986    }
4987  }
4988}
4989
4990poly redtail (LObject* L, int pos, kStrategy strat)
4991{
4992  poly h, hn;
4993  strat->redTailChange=FALSE;
4994
4995  poly p = L->p;
4996  if (strat->noTailReduction || pNext(p) == NULL)
4997    return p;
4998
4999  LObject Ln(strat->tailRing);
5000  TObject* With;
5001  // placeholder in case strat->tl < 0
5002  TObject  With_s(strat->tailRing);
5003  h = p;
5004  hn = pNext(h);
5005  long op = strat->tailRing->pFDeg(hn, strat->tailRing);
5006  long e;
5007  int l;
5008  BOOLEAN save_HE=strat->kHEdgeFound;
5009  strat->kHEdgeFound |=
5010    ((Kstd1_deg>0) && (op<=Kstd1_deg)) || TEST_OPT_INFREDTAIL;
5011
5012  while(hn != NULL)
5013  {
5014    op = strat->tailRing->pFDeg(hn, strat->tailRing);
5015    if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
5016    e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
5017    loop
5018    {
5019      Ln.Set(hn, strat->tailRing);
5020      Ln.sev = p_GetShortExpVector(hn, strat->tailRing);
5021      if (strat->kHEdgeFound)
5022        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
5023      else
5024        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s, e);
5025      if (With == NULL) break;
5026      With->length=0;
5027      With->pLength=0;
5028      strat->redTailChange=TRUE;
5029      if (ksReducePolyTail(L, With, h, strat->kNoetherTail()))
5030      {
5031        // reducing the tail would violate the exp bound
5032        if (kStratChangeTailRing(strat, L))
5033        {
5034          strat->kHEdgeFound = save_HE;
5035          return redtail(L, pos, strat);
5036        }
5037        else
5038          return NULL;
5039      }
5040      hn = pNext(h);
5041      if (hn == NULL) goto all_done;
5042      op = strat->tailRing->pFDeg(hn, strat->tailRing);
5043      if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
5044      e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
5045    }
5046    h = hn;
5047    hn = pNext(h);
5048  }
5049
5050  all_done:
5051  if (strat->redTailChange)
5052  {
5053    L->last = NULL;
5054    L->pLength = 0;
5055  }
5056  strat->kHEdgeFound = save_HE;
5057  return p;
5058}
5059
5060poly redtail (poly p, int pos, kStrategy strat)
5061{
5062  LObject L(p, currRing);
5063  return redtail(&L, pos, strat);
5064}
5065
5066poly redtailBba (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
5067{
5068#define REDTAIL_CANONICALIZE 100
5069  strat->redTailChange=FALSE;
5070  if (strat->noTailReduction) return L->GetLmCurrRing();
5071  poly h, p;
5072  p = h = L->GetLmTailRing();
5073  if ((h==NULL) || (pNext(h)==NULL))
5074    return L->GetLmCurrRing();
5075
5076  TObject* With;
5077  // placeholder in case strat->tl < 0
5078  TObject  With_s(strat->tailRing);
5079
5080  LObject Ln(pNext(h), strat->tailRing);
5081  Ln.pLength = L->GetpLength() - 1;
5082
5083  pNext(h) = NULL;
5084  if (L->p != NULL) pNext(L->p) = NULL;
5085  L->pLength = 1;
5086
5087  Ln.PrepareRed(strat->use_buckets);
5088
5089  int cnt=REDTAIL_CANONICALIZE;
5090  while(!Ln.IsNull())
5091  {
5092    loop
5093    {
5094      Ln.SetShortExpVector();
5095      if (withT)
5096      {
5097        int j;
5098        j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
5099        if (j < 0) break;
5100        With = &(strat->T[j]);
5101      }
5102      else
5103      {
5104        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
5105        if (With == NULL) break;
5106      }
5107      cnt--;
5108      if (cnt==0)
5109      {
5110        cnt=REDTAIL_CANONICALIZE;
5111        /*poly tmp=*/Ln.CanonicalizeP();
5112        if (normalize)
5113        {
5114          Ln.Normalize();
5115          //pNormalize(tmp);
5116          //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
5117        }
5118      }
5119      if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
5120      {
5121        With->pNorm();
5122      }
5123      strat->redTailChange=TRUE;
5124      if (ksReducePolyTail(L, With, &Ln))
5125      {
5126        // reducing the tail would violate the exp bound
5127        //  set a flag and hope for a retry (in bba)
5128        strat->completeReduce_retry=TRUE;
5129        if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
5130        do
5131        {
5132          pNext(h) = Ln.LmExtractAndIter();
5133          pIter(h);
5134          L->pLength++;
5135        } while (!Ln.IsNull());
5136        goto all_done;
5137      }
5138      if (Ln.IsNull()) goto all_done;
5139      if (! withT) With_s.Init(currRing);
5140    }
5141    pNext(h) = Ln.LmExtractAndIter();
5142    pIter(h);
5143    pNormalize(h);
5144    L->pLength++;
5145  }
5146
5147  all_done:
5148  Ln.Delete();
5149  if (L->p != NULL) pNext(L->p) = pNext(p);
5150
5151  if (strat->redTailChange)
5152  {
5153    L->last = NULL;
5154    L->length = 0;
5155  }
5156
5157  //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
5158  //L->Normalize(); // HANNES: should have a test
5159  kTest_L(L);
5160  return L->GetLmCurrRing();
5161}
5162
5163#ifdef HAVE_RINGS
5164poly redtailBba_Z (LObject* L, int pos, kStrategy strat )
5165// normalize=FALSE, withT=FALSE, coeff=Z
5166{
5167  strat->redTailChange=FALSE;
5168  if (strat->noTailReduction) return L->GetLmCurrRing();
5169  poly h, p;
5170  p = h = L->GetLmTailRing();
5171  if ((h==NULL) || (pNext(h)==NULL))
5172    return L->GetLmCurrRing();
5173
5174  TObject* With;
5175  // placeholder in case strat->tl < 0
5176  TObject  With_s(strat->tailRing);
5177
5178  LObject Ln(pNext(h), strat->tailRing);
5179  Ln.pLength = L->GetpLength() - 1;
5180
5181  pNext(h) = NULL;
5182  if (L->p != NULL) pNext(L->p) = NULL;
5183  L->pLength = 1;
5184
5185  Ln.PrepareRed(strat->use_buckets);
5186
5187  int cnt=REDTAIL_CANONICALIZE;
5188  while(!Ln.IsNull())
5189  {
5190    loop
5191    {
5192      Ln.SetShortExpVector();
5193      With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
5194      if (With == NULL) break;
5195      cnt--;
5196      if (cnt==0)
5197      {
5198        cnt=REDTAIL_CANONICALIZE;
5199        /*poly tmp=*/Ln.CanonicalizeP();
5200      }
5201      // we are in Z, do not call pNorm
5202      strat->redTailChange=TRUE;
5203      // test divisibility of coefs:
5204      poly p_Ln=Ln.GetLmCurrRing();
5205      poly p_With=With->GetLmCurrRing();
5206      number z=n_IntMod(pGetCoeff(p_Ln),pGetCoeff(p_With), currRing->cf);
5207      if (!nIsZero(z))
5208      {
5209        // subtract z*Ln, add z.Ln to L
5210        poly m=pHead(p_Ln);
5211        pSetCoeff(m,z);
5212        poly mm=pHead(m);
5213        pNext(h) = m;
5214        pIter(h);
5215        L->pLength++;
5216        mm=pNeg(mm);
5217        if (Ln.bucket!=NULL)
5218        {
5219          int dummy=1;
5220          kBucket_Add_q(Ln.bucket,mm,&dummy);
5221        }
5222        else
5223        {
5224          if (Ln.p!=NULL) Ln.p=pAdd(Ln.p,mm);
5225          else if (Ln.t_p!=NULL)  Ln.t_p=p_Add_q(Ln.t_p,mm,strat->tailRing);
5226        }
5227      }
5228      else
5229        nDelete(&z);
5230
5231      if (ksReducePolyTail(L, With, &Ln))
5232      {
5233        // reducing the tail would violate the exp bound
5234        //  set a flag and hope for a retry (in bba)
5235        strat->completeReduce_retry=TRUE;
5236        if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
5237        do
5238        {
5239          pNext(h) = Ln.LmExtractAndIter();
5240          pIter(h);
5241          L->pLength++;
5242        } while (!Ln.IsNull());
5243        goto all_done;
5244      }
5245      if (Ln.IsNull()) goto all_done;
5246      With_s.Init(currRing);
5247    }
5248    pNext(h) = Ln.LmExtractAndIter();
5249    pIter(h);
5250    pNormalize(h);
5251    L->pLength++;
5252  }
5253
5254  all_done:
5255  Ln.Delete();
5256  if (L->p != NULL) pNext(L->p) = pNext(p);
5257
5258  if (strat->redTailChange)
5259  {
5260    L->last = NULL;
5261    L->length = 0;
5262  }
5263
5264  //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
5265  //L->Normalize(); // HANNES: should have a test
5266  kTest_L(L);
5267  return L->GetLmCurrRing();
5268}
5269#endif
5270
5271/*2
5272*checks the change degree and write progress report
5273*/
5274void message (int i,int* reduc,int* olddeg,kStrategy strat, int red_result)
5275{
5276  if (i != *olddeg)
5277  {
5278    Print("%d",i);
5279    *olddeg = i;
5280  }
5281  if (TEST_OPT_OLDSTD)
5282  {
5283    if (strat->Ll != *reduc)
5284    {
5285      if (strat->Ll != *reduc-1)
5286        Print("(%d)",strat->Ll+1);
5287      else
5288        PrintS("-");
5289      *reduc = strat->Ll;
5290    }
5291    else
5292      PrintS(".");
5293    mflush();
5294  }
5295  else
5296  {
5297    if (red_result == 0)
5298      PrintS("-");
5299    else if (red_result < 0)
5300      PrintS(".");
5301    if ((red_result > 0) || ((strat->Ll % 100)==99))
5302    {
5303      if (strat->Ll != *reduc && strat->Ll > 0)
5304      {
5305        Print("(%d)",strat->Ll+1);
5306        *reduc = strat->Ll;
5307      }
5308    }
5309  }
5310}
5311
5312/*2
5313*statistics
5314*/
5315void messageStat (int hilbcount,kStrategy strat)
5316{
5317  //PrintS("\nUsage/Allocation of temporary storage:\n");
5318  //Print("%d/%d polynomials in standard base\n",srmax,IDELEMS(Shdl));
5319  //Print("%d/%d polynomials in set L (for lazy alg.)",lrmax+1,strat->Lmax);
5320  Print("product criterion:%d chain criterion:%d\n",strat->cp,strat->c3);
5321  if (hilbcount!=0) Print("hilbert series criterion:%d\n",hilbcount);
5322  /* in usual case strat->cv is 0, it gets changed only in shift routines */
5323  if (strat->cv!=0) Print("shift V criterion:%d\n",strat->cv);
5324  /*mflush();*/
5325}
5326
5327#ifdef KDEBUG
5328/*2
5329*debugging output: all internal sets, if changed
5330*for testing purpuse only/has to be changed for later use
5331*/
5332void messageSets (kStrategy strat)
5333{
5334  int i;
5335  if (strat->news)
5336  {
5337    PrintS("set S");
5338    for (i=0; i<=strat->sl; i++)
5339    {
5340      Print("\n  %d:",i);
5341      p_wrp(strat->S[i], currRing, strat->tailRing);
5342    }
5343    strat->news = FALSE;
5344  }
5345  if (strat->newt)
5346  {
5347    PrintS("\nset T");
5348    for (i=0; i<=strat->tl; i++)
5349    {
5350      Print("\n  %d:",i);
5351      strat->T[i].wrp();
5352      Print(" o:%ld e:%d l:%d",
5353        strat->T[i].pFDeg(),strat->T[i].ecart,strat->T[i].length);
5354    }
5355    strat->newt = FALSE;
5356  }
5357  PrintS("\nset L");
5358  for (i=strat->Ll; i>=0; i--)
5359  {
5360    Print("\n%d:",i);
5361    p_wrp(strat->L[i].p1, currRing, strat->tailRing);
5362    PrintS("  ");
5363    p_wrp(strat->L[i].p2, currRing, strat->tailRing);
5364    PrintS(" lcm: ");p_wrp(strat->L[i].lcm, currRing);
5365    PrintS("\n  p : ");
5366    strat->L[i].wrp();
5367    Print("  o:%ld e:%d l:%d",
5368          strat->L[i].pFDeg(),strat->L[i].ecart,strat->L[i].length);
5369  }
5370  PrintLn();
5371}
5372
5373#endif
5374
5375
5376/*2
5377*construct the set s from F
5378*/
5379void initS (ideal F, ideal Q, kStrategy strat)
5380{
5381  int   i,pos;
5382
5383  if (Q!=NULL) i=((IDELEMS(F)+IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5384  else         i=((IDELEMS(F)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5385  strat->ecartS=initec(i);
5386  strat->sevS=initsevS(i);
5387  strat->S_2_R=initS_2_R(i);
5388  strat->fromQ=NULL;
5389  strat->Shdl=idInit(i,F->rank);
5390  strat->S=strat->Shdl->m;
5391  /*- put polys into S -*/
5392  if (Q!=NULL)
5393  {
5394    strat->fromQ=initec(i);
5395    memset(strat->fromQ,0,i*sizeof(int));
5396    for (i=0; i<IDELEMS(Q); i++)
5397    {
5398      if (Q->m[i]!=NULL)
5399      {
5400        LObject h;
5401        h.p = pCopy(Q->m[i]);
5402        if (TEST_OPT_INTSTRATEGY)
5403        {
5404          //pContent(h.p);
5405          h.pCleardenom(); // also does a pContent
5406        }
5407        else
5408        {
5409          h.pNorm();
5410        }
5411        if (currRing->OrdSgn==-1)
5412        {
5413          deleteHC(&h, strat);
5414        }
5415        if (h.p!=NULL)
5416        {
5417          strat->initEcart(&h);
5418          if (strat->sl==-1)
5419            pos =0;
5420          else
5421          {
5422            pos = posInS(strat,strat->sl,h.p,h.ecart);
5423          }
5424          h.sev = pGetShortExpVector(h.p);
5425          strat->enterS(h,pos,strat,-1);
5426          strat->fromQ[pos]=1;
5427        }
5428      }
5429    }
5430  }
5431  for (i=0; i<IDELEMS(F); i++)
5432  {
5433    if (F->m[i]!=NULL)
5434    {
5435      LObject h;
5436      h.p = pCopy(F->m[i]);
5437      if (currRing->OrdSgn==-1)
5438      {
5439        cancelunit(&h);  /*- tries to cancel a unit -*/
5440        deleteHC(&h, strat);
5441      }
5442      if (h.p!=NULL)
5443      // do not rely on the input being a SB!
5444      {
5445        if (TEST_OPT_INTSTRATEGY)
5446        {
5447          //pContent(h.p);
5448          h.pCleardenom(); // also does a pContent
5449        }
5450        else
5451        {
5452          h.pNorm();
5453        }
5454        strat->initEcart(&h);
5455        if (strat->sl==-1)
5456          pos =0;
5457        else
5458          pos = posInS(strat,strat->sl,h.p,h.ecart);
5459        h.sev = pGetShortExpVector(h.p);
5460        strat->enterS(h,pos,strat,-1);
5461      }
5462    }
5463  }
5464  /*- test, if a unit is in F -*/
5465  if ((strat->sl>=0)
5466#ifdef HAVE_RINGS
5467       && n_IsUnit(pGetCoeff(strat->S[0]),currRing->cf)
5468#endif
5469       && pIsConstant(strat->S[0]))
5470  {
5471    while (strat->sl>0) deleteInS(strat->sl,strat);
5472  }
5473}
5474
5475void initSL (ideal F, ideal Q,kStrategy strat)
5476{
5477  int   i,pos;
5478
5479  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5480  else i=setmaxT;
5481  strat->ecartS=initec(i);
5482  strat->sevS=initsevS(i);
5483  strat->S_2_R=initS_2_R(i);
5484  strat->fromQ=NULL;
5485  strat->Shdl=idInit(i,F->rank);
5486  strat->S=strat->Shdl->m;
5487  /*- put polys into S -*/
5488  if (Q!=NULL)
5489  {
5490    strat->fromQ=initec(i);
5491    memset(strat->fromQ,0,i*sizeof(int));
5492    for (i=0; i<IDELEMS(Q); i++)
5493    {
5494      if (Q->m[i]!=NULL)
5495      {
5496        LObject h;
5497        h.p = pCopy(Q->m[i]);
5498        if (currRing->OrdSgn==-1)
5499        {
5500          deleteHC(&h,strat);
5501        }
5502        if (TEST_OPT_INTSTRATEGY)
5503        {
5504          //pContent(h.p);
5505          h.pCleardenom(); // also does a pContent
5506        }
5507        else
5508        {
5509          h.pNorm();
5510        }
5511        if (h.p!=NULL)
5512        {
5513          strat->initEcart(&h);
5514          if (strat->sl==-1)
5515            pos =0;
5516          else
5517          {
5518            pos = posInS(strat,strat->sl,h.p,h.ecart);
5519          }
5520          h.sev = pGetShortExpVector(h.p);
5521          strat->enterS(h,pos,strat,-1);
5522          strat->fromQ[pos]=1;
5523        }
5524      }
5525    }
5526  }
5527  for (i=0; i<IDELEMS(F); i++)
5528  {
5529    if (F->m[i]!=NULL)
5530    {
5531      LObject h;
5532      h.p = pCopy(F->m[i]);
5533      if (h.p!=NULL)
5534      {
5535        if (currRing->OrdSgn==-1)
5536        {
5537          cancelunit(&h);  /*- tries to cancel a unit -*/
5538          deleteHC(&h, strat);
5539        }
5540        if (h.p!=NULL)
5541        {
5542          if (TEST_OPT_INTSTRATEGY)
5543          {
5544            //pContent(h.p);
5545            h.pCleardenom(); // also does a pContent
5546          }
5547          else
5548          {
5549            h.pNorm();
5550          }
5551          strat->initEcart(&h);
5552          if (strat->Ll==-1)
5553            pos =0;
5554          else
5555            pos = strat->posInL(strat->L,strat->Ll,&h,strat);
5556          h.sev = pGetShortExpVector(h.p);
5557          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
5558        }
5559      }
5560    }
5561  }
5562  /*- test, if a unit is in F -*/
5563
5564  if ((strat->Ll>=0)
5565#ifdef HAVE_RINGS
5566       && n_IsUnit(pGetCoeff(strat->L[strat->Ll].p), currRing->cf)
5567#endif
5568       && pIsConstant(strat->L[strat->Ll].p))
5569  {
5570    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
5571  }
5572}
5573
5574void initSLSba (ideal F, ideal Q,kStrategy strat)
5575{
5576  int   i,j,pos, ctr=0, ps=0;
5577  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5578  else i=setmaxT;
5579  strat->ecartS =   initec(i);
5580  strat->fromS  =   initec(i);
5581  strat->sevS   =   initsevS(i);
5582  strat->sevSig =   initsevS(i);
5583  strat->S_2_R  =   initS_2_R(i);
5584  strat->fromQ  =   NULL;
5585  strat->Shdl   =   idInit(i,F->rank);
5586  strat->S      =   strat->Shdl->m;
5587  strat->sig    =   (poly *)omAlloc0(i*sizeof(poly));
5588  if (!strat->incremental)
5589  {
5590    strat->syz    = (poly *)omAlloc0(i*sizeof(poly));
5591    strat->sevSyz = initsevS(i);
5592    strat->syzmax = i;
5593    strat->syzl   = 0;
5594  }
5595  /*- put polys into S -*/
5596  if (Q!=NULL)
5597  {
5598    strat->fromQ=initec(i);
5599    memset(strat->fromQ,0,i*sizeof(int));
5600    for (i=0; i<IDELEMS(Q); i++)
5601    {
5602      if (Q->m[i]!=NULL)
5603      {
5604        LObject h;
5605        h.p = pCopy(Q->m[i]);
5606        if (pOrdSgn==-1)
5607        {
5608          deleteHC(&h,strat);
5609        }
5610        if (TEST_OPT_INTSTRATEGY)
5611        {
5612          //pContent(h.p);
5613          h.pCleardenom(); // also does a pContent
5614        }
5615        else
5616        {
5617          h.pNorm();
5618        }
5619        if (h.p!=NULL)
5620        {
5621          strat->initEcart(&h);
5622          if (strat->sl==-1)
5623            pos =0;
5624          else
5625          {
5626            pos = posInS(strat,strat->sl,h.p,h.ecart);
5627          }
5628          h.sev = pGetShortExpVector(h.p);
5629          strat->enterS(h,pos,strat,-1);
5630          strat->fromQ[pos]=1;
5631        }
5632      }
5633    }
5634  }
5635  for (i=0; i<IDELEMS(F); i++)
5636  {
5637    if (F->m[i]!=NULL)
5638    {
5639      LObject h;
5640      h.p = pCopy(F->m[i]);
5641      h.sig = pOne();
5642      //h.sig = pInit();
5643      //p_SetCoeff(h.sig,nInit(1),currRing);
5644      p_SetComp(h.sig,i+1,currRing);
5645      // if we are working with the Schreyer order we generate it
5646      // by multiplying the initial signatures with the leading monomial
5647      // of the corresponding initial polynomials generating the ideal
5648      // => we can keep the underlying monomial order and get a Schreyer
5649      //    order without any bigger overhead
5650      if (!strat->incremental)
5651      {
5652        p_ExpVectorAdd (h.sig,F->m[i],currRing); 
5653      }
5654      h.sevSig = pGetShortExpVector(h.sig);
5655#ifdef DEBUGF5
5656      pWrite(h.p);
5657      pWrite(h.sig);
5658#endif
5659      if (h.p!=NULL)
5660      {
5661        if (pOrdSgn==-1)
5662        {
5663          cancelunit(&h);  /*- tries to cancel a unit -*/
5664          deleteHC(&h, strat);
5665        }
5666        if (h.p!=NULL)
5667        {
5668          if (TEST_OPT_INTSTRATEGY)
5669          {
5670            //pContent(h.p);
5671            h.pCleardenom(); // also does a pContent
5672          }
5673          else
5674          {
5675            h.pNorm();
5676          }
5677          strat->initEcart(&h);
5678          if (strat->Ll==-1)
5679            pos =0;
5680          else
5681            pos = strat->posInLSba(strat->L,strat->Ll,&h,strat);
5682          h.sev = pGetShortExpVector(h.p);
5683          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
5684        }
5685      }
5686      /*
5687      if (!strat->incremental)
5688      {
5689        for(j=0;j<i;j++)
5690        {
5691          strat->syz[ctr] = pCopy(F->m[j]);
5692          p_SetCompP(strat->syz[ctr],i+1,currRing);
5693          // add LM(F->m[i]) to the signature to get a Schreyer order
5694          // without changing the underlying polynomial ring at all
5695          p_ExpVectorAdd (strat->syz[ctr],F->m[i],currRing); 
5696          // since p_Add_q() destroys all input
5697          // data we need to recreate help
5698          // each time
5699          poly help = pCopy(F->m[i]);
5700          p_SetCompP(help,j+1,currRing);
5701          pWrite(strat->syz[ctr]);
5702          pWrite(help);
5703          printf("%d\n",pLmCmp(strat->syz[ctr],help));
5704          strat->syz[ctr] = p_Add_q(strat->syz[ctr],help,currRing);
5705          printf("%d. SYZ  ",ctr);
5706          pWrite(strat->syz[ctr]);
5707          strat->sevSyz[ctr] = p_GetShortExpVector(strat->syz[ctr],currRing);
5708          ctr++;
5709        }
5710        strat->syzl = ps;
5711      }
5712      */
5713    }
5714  }
5715  /*- test, if a unit is in F -*/
5716
5717  if ((strat->Ll>=0)
5718#ifdef HAVE_RINGS
5719       && nIsUnit(pGetCoeff(strat->L[strat->Ll].p))
5720#endif
5721       && pIsConstant(strat->L[strat->Ll].p))
5722  {
5723    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
5724  }
5725}
5726
5727void initSyzRules (kStrategy strat)
5728{
5729  if( strat->S[0] )
5730  {
5731    if( strat->S[1] )
5732    {
5733      omFreeSize(strat->syzIdx,(strat->syzidxmax)*sizeof(int));
5734      omFreeSize(strat->sevSyz,(strat->syzmax)*sizeof(unsigned long));
5735      omFreeSize(strat->syz,(strat->syzmax)*sizeof(poly));
5736    }
5737    int i, j, k, diff, comp, comp_old, ps=0, ctr=0;
5738    /************************************************************
5739     * computing the length of the syzygy array needed
5740     ***********************************************************/
5741    for(i=1; i<=strat->sl; i++)
5742    {
5743      if (pGetComp(strat->sig[i-1]) != pGetComp(strat->sig[i]))
5744      { 
5745        ps += i;
5746      }
5747    }
5748    ps += strat->sl+1;
5749    //comp              = pGetComp (strat->P.sig);
5750    comp              = strat->currIdx;
5751    strat->syzIdx     = initec(comp);
5752    strat->sevSyz     = initsevS(ps);
5753    strat->syz        = (poly *)omAlloc(ps*sizeof(poly));
5754    strat->syzl       = strat->syzmax = ps;
5755    strat->syzidxmax  = comp;
5756#ifdef DEBUGF5 || DEBUGF51
5757    printf("------------- GENERATING SYZ RULES NEW ---------------\n");
5758#endif
5759    i = 1; 
5760    j = 0;
5761    /************************************************************
5762     * generating the leading terms of the principal syzygies
5763     ***********************************************************/
5764    while (i <= strat->sl)
5765    {
5766      /**********************************************************
5767       * principal syzygies start with component index 2
5768       * the array syzIdx starts with index 0
5769       * => the rules for a signature with component comp start
5770       *    at strat->syz[strat->syzIdx[comp-2]] !
5771       *********************************************************/
5772      if (pGetComp(strat->sig[i-1]) != pGetComp(strat->sig[i]))
5773      {
5774        comp      = pGetComp(strat->sig[i]);
5775        comp_old  = pGetComp(strat->sig[i-1]);
5776        diff      = comp - comp_old - 1;
5777        // diff should be zero, but sometimes also the initial generating
5778        // elements of the input ideal reduce to zero. then there is an
5779        // index-gap between the signatures. for these inbetween signatures we
5780        // can safely set syzIdx[j] = 0 as no such element will be ever computed
5781        // in the following.
5782        // doing this, we keep the relation "j = comp - 2" alive, which makes
5783        // jumps way easier when checking criteria
5784        while (diff>0)
5785        {
5786          strat->syzIdx[j]  = 0;
5787          diff--;
5788          j++;
5789        }
5790        strat->syzIdx[j]  = ctr;
5791        j++;
5792        for (k = 0; k<i; k++)
5793        {
5794          poly p          = pOne();
5795          pLcm(strat->S[k],strat->S[i],p);
5796          strat->syz[ctr] = p;
5797          p_SetCompP (strat->syz[ctr], comp, currRing);
5798          poly q          = p_Copy(p, currRing);
5799          q               = p_Neg (q, currRing);
5800          p_SetCompP (q, p_GetComp(strat->sig[k], currRing), currRing);
5801          strat->syz[ctr] = p_Add_q (strat->syz[ctr], q, currRing);
5802#ifdef DEBUGF5 || DEBUGF51
5803          pWrite(strat->syz[ctr]);
5804#endif
5805          strat->sevSyz[ctr] = p_GetShortExpVector(strat->syz[ctr],currRing);
5806          ctr++;
5807        }
5808      }
5809      i++;
5810    }
5811    /**************************************************************
5812    * add syzygies for upcoming first element of new iteration step
5813    **************************************************************/
5814    comp      = strat->currIdx;
5815    comp_old  = pGetComp(strat->sig[i-1]);
5816    diff      = comp - comp_old - 1;
5817    // diff should be zero, but sometimes also the initial generating
5818    // elements of the input ideal reduce to zero. then there is an
5819    // index-gap between the signatures. for these inbetween signatures we
5820    // can safely set syzIdx[j] = 0 as no such element will be ever computed
5821    // in the following.
5822    // doing this, we keep the relation "j = comp - 2" alive, which makes
5823    // jumps way easier when checking criteria
5824    while (diff>0)
5825    {
5826      strat->syzIdx[j]  = 0;
5827      diff--;
5828      j++;
5829    }
5830    strat->syzIdx[j]  = ctr;
5831    for (k = 0; k<strat->sl+1; k++)
5832    {
5833      strat->syz[ctr] = p_Copy (pHead(strat->S[k]), currRing);
5834      p_SetCompP (strat->syz[ctr], comp, currRing);
5835      poly q          = p_Copy (pHead(strat->L[strat->Ll].p), currRing);
5836      q               = p_Neg (q, currRing);
5837      p_SetCompP (q, p_GetComp(strat->sig[k], currRing), currRing);
5838      strat->syz[ctr] = p_Add_q (strat->syz[ctr], q, currRing);
5839//#if 1
5840#if DEBUGF5 || DEBUGF51
5841      printf("..");
5842      pWrite(strat->syz[ctr]);
5843#endif
5844      strat->sevSyz[ctr] = p_GetShortExpVector(strat->syz[ctr],currRing);
5845      ctr++;
5846    }
5847//#if 1
5848#ifdef DEBUGF5
5849    Print("Principal syzygies:\n");
5850    Print("--------------------------------\n");
5851    for(i=0;i<=ps-1;i++)
5852    {
5853      pWrite(strat->syz[i]);
5854    }
5855    Print("--------------------------------\n");
5856#endif
5857
5858  }
5859}
5860
5861
5862
5863/*2
5864*construct the set s from F and {P}
5865*/
5866void initSSpecial (ideal F, ideal Q, ideal P,kStrategy strat)
5867{
5868  int   i,pos;
5869
5870  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
5871  else i=setmaxT;
5872  i=((i+IDELEMS(F)+IDELEMS(P)+15)/16)*16;
5873  strat->ecartS=initec(i);
5874  strat->sevS=initsevS(i);
5875  strat->S_2_R=initS_2_R(i);
5876  strat->fromQ=NULL;
5877  strat->Shdl=idInit(i,F->rank);
5878  strat->S=strat->Shdl->m;
5879
5880  /*- put polys into S -*/
5881  if (Q!=NULL)
5882  {
5883    strat->fromQ=initec(i);
5884    memset(strat->fromQ,0,i*sizeof(int));
5885    for (i=0; i<IDELEMS(Q); i++)
5886    {
5887      if (Q->m[i]!=NULL)
5888      {
5889        LObject h;
5890        h.p = pCopy(Q->m[i]);
5891        //if (TEST_OPT_INTSTRATEGY)
5892        //{
5893        //  //pContent(h.p);
5894        //  h.pCleardenom(); // also does a pContent
5895        //}
5896        //else
5897        //{
5898        //  h.pNorm();
5899        //}
5900        if (currRing->OrdSgn==-1)
5901        {
5902          deleteHC(&h,strat);
5903        }
5904        if (h.p!=NULL)
5905        {
5906          strat->initEcart(&h);
5907          if (strat->sl==-1)
5908            pos =0;
5909          else
5910          {
5911            pos = posInS(strat,strat->sl,h.p,h.ecart);
5912          }
5913          h.sev = pGetShortExpVector(h.p);
5914          strat->enterS(h,pos,strat, strat->tl+1);
5915          enterT(h, strat);
5916          strat->fromQ[pos]=1;
5917        }
5918      }
5919    }
5920  }
5921  /*- put polys into S -*/
5922  for (i=0; i<IDELEMS(F); i++)
5923  {
5924    if (F->m[i]!=NULL)
5925    {
5926      LObject h;
5927      h.p = pCopy(F->m[i]);
5928      if (currRing->OrdSgn==-1)
5929      {
5930        deleteHC(&h,strat);
5931      }
5932      else
5933      {
5934        h.p=redtailBba(h.p,strat->sl,strat);
5935      }
5936      if (h.p!=NULL)
5937      {
5938        strat->initEcart(&h);
5939        if (strat->sl==-1)
5940          pos =0;
5941        else
5942          pos = posInS(strat,strat->sl,h.p,h.ecart);
5943        h.sev = pGetShortExpVector(h.p);
5944        strat->enterS(h,pos,strat, strat->tl+1);
5945        enterT(h,strat);
5946      }
5947    }
5948  }
5949  for (i=0; i<IDELEMS(P); i++)
5950  {
5951    if (P->m[i]!=NULL)
5952    {
5953      LObject h;
5954      h.p=pCopy(P->m[i]);
5955      if (TEST_OPT_INTSTRATEGY)
5956      {
5957        h.pCleardenom();
5958      }
5959      else
5960      {
5961        h.pNorm();
5962      }
5963      if(strat->sl>=0)
5964      {
5965        if (currRing->OrdSgn==1)
5966        {
5967          h.p=redBba(h.p,strat->sl,strat);
5968          if (h.p!=NULL)
5969          {
5970            h.p=redtailBba(h.p,strat->sl,strat);
5971          }
5972        }
5973        else
5974        {
5975          h.p=redMora(h.p,strat->sl,strat);
5976        }
5977        if(h.p!=NULL)
5978        {
5979          strat->initEcart(&h);
5980          if (TEST_OPT_INTSTRATEGY)
5981          {
5982            h.pCleardenom();
5983          }
5984          else
5985          {
5986            h.is_normalized = 0;
5987            h.pNorm();
5988          }
5989          h.sev = pGetShortExpVector(h.p);
5990          h.SetpFDeg();
5991          pos = posInS(strat,strat->sl,h.p,h.ecart);
5992          enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
5993          strat->enterS(h,pos,strat, strat->tl+1);
5994          enterT(h,strat);
5995        }
5996      }
5997      else
5998      {
5999        h.sev = pGetShortExpVector(h.p);
6000        strat->initEcart(&h);
6001        strat->enterS(h,0,strat, strat->tl+1);
6002        enterT(h,strat);
6003      }
6004    }
6005  }
6006}
6007/*2
6008* reduces h using the set S
6009* procedure used in cancelunit1
6010*/
6011static poly redBba1 (poly h,int maxIndex,kStrategy strat)
6012{
6013  int j = 0;
6014  unsigned long not_sev = ~ pGetShortExpVector(h);
6015
6016  while (j <= maxIndex)
6017  {
6018    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j],h, not_sev))
6019       return ksOldSpolyRedNew(strat->S[j],h,strat->kNoetherTail());
6020    else j++;
6021  }
6022  return h;
6023}
6024
6025/*2
6026*tests if p.p=monomial*unit and cancels the unit
6027*/
6028void cancelunit1 (LObject* p,int *suc, int index,kStrategy strat )
6029{
6030  int k;
6031  poly r,h,h1,q;
6032
6033  if (!pIsVector((*p).p) && ((*p).ecart != 0))
6034  {
6035#ifdef HAVE_RINGS_LOC
6036    // Leading coef have to be a unit
6037    if ( !(nIsUnit(p_GetCoeff((*p).p, r))) ) return;
6038#endif
6039    k = 0;
6040    h1 = r = pCopy((*p).p);
6041    h =pNext(r);
6042    loop
6043    {
6044      if (h==NULL)
6045      {
6046        pDelete(&r);
6047        pDelete(&(pNext((*p).p)));
6048        (*p).ecart = 0;
6049        (*p).length = 1;
6050#ifdef HAVE_RINGS_LOC
6051        (*p).pLength = 1;  // Why wasn't this set already?
6052#endif
6053        (*suc)=0;
6054        return;
6055      }
6056      if (!pDivisibleBy(r,h))
6057      {
6058        q=redBba1(h,index ,strat);
6059        if (q != h)
6060        {
6061          k++;
6062          pDelete(&h);
6063          pNext(h1) = h = q;
6064        }
6065        else
6066        {
6067          pDelete(&r);
6068          return;
6069        }
6070      }
6071      else
6072      {
6073        h1 = h;
6074        pIter(h);
6075      }
6076      if (k > 10)
6077      {
6078        pDelete(&r);
6079        return;
6080      }
6081    }
6082  }
6083}
6084
6085#if 0
6086/*2
6087* reduces h using the elements from Q in the set S
6088* procedure used in updateS
6089* must not be used for elements of Q or elements of an ideal !
6090*/
6091static poly redQ (poly h, int j, kStrategy strat)
6092{
6093  int start;
6094  unsigned long not_sev = ~ pGetShortExpVector(h);
6095  while ((j <= strat->sl) && (pGetComp(strat->S[j])!=0)) j++;
6096  start=j;
6097  while (j<=strat->sl)
6098  {
6099    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
6100    {
6101      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
6102      if (h==NULL) return NULL;
6103      j = start;
6104      not_sev = ~ pGetShortExpVector(h);
6105    }
6106    else j++;
6107  }
6108  return h;
6109}
6110#endif
6111
6112/*2
6113* reduces h using the set S
6114* procedure used in updateS
6115*/
6116static poly redBba (poly h,int maxIndex,kStrategy strat)
6117{
6118  int j = 0;
6119  unsigned long not_sev = ~ pGetShortExpVector(h);
6120
6121  while (j <= maxIndex)
6122  {
6123    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
6124    {
6125      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
6126      if (h==NULL) return NULL;
6127      j = 0;
6128      not_sev = ~ pGetShortExpVector(h);    }
6129    else j++;
6130  }
6131  return h;
6132}
6133
6134/*2
6135* reduces h using the set S
6136*e is the ecart of h
6137*procedure used in updateS
6138*/
6139static poly redMora (poly h,int maxIndex,kStrategy strat)
6140{
6141  int  j=0;
6142  int  e,l;
6143  unsigned long not_sev = ~ pGetShortExpVector(h);
6144
6145  if (maxIndex >= 0)
6146  {
6147    e = currRing->pLDeg(h,&l,currRing)-p_FDeg(h,currRing);
6148    do
6149    {
6150      if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev)
6151      && ((e >= strat->ecartS[j]) || strat->kHEdgeFound))
6152      {
6153#ifdef KDEBUG
6154        if (TEST_OPT_DEBUG)
6155          {PrintS("reduce ");wrp(h);Print(" with S[%d] (",j);wrp(strat->S[j]);}
6156#endif
6157        h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
6158#ifdef KDEBUG
6159        if(TEST_OPT_DEBUG)
6160          {PrintS(")\nto "); wrp(h); PrintLn();}
6161#endif
6162        // pDelete(&h);
6163        if (h == NULL) return NULL;
6164        e = currRing->pLDeg(h,&l,currRing)-p_FDeg(h,currRing);
6165        j = 0;
6166        not_sev = ~ pGetShortExpVector(h);
6167      }
6168      else j++;
6169    }
6170    while (j <= maxIndex);
6171  }
6172  return h;
6173}
6174
6175/*2
6176*updates S:
6177*the result is a set of polynomials which are in
6178*normalform with respect to S
6179*/
6180void updateS(BOOLEAN toT,kStrategy strat)
6181{
6182  LObject h;
6183  int i, suc=0;
6184  poly redSi=NULL;
6185  BOOLEAN change,any_change;
6186//  Print("nach initS: updateS start mit sl=%d\n",(strat->sl));
6187//  for (i=0; i<=(strat->sl); i++)
6188//  {
6189//    Print("s%d:",i);
6190//    if (strat->fromQ!=NULL) Print("(Q:%d) ",strat->fromQ[i]);
6191//    pWrite(strat->S[i]);
6192//  }
6193//  Print("currRing->OrdSgn=%d\n", currRing->OrdSgn);
6194  any_change=FALSE;
6195  if (currRing->OrdSgn==1)
6196  {
6197    while (suc != -1)
6198    {
6199      i=suc+1;
6200      while (i<=strat->sl)
6201      {
6202        change=FALSE;
6203        if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
6204        {
6205          redSi = pHead(strat->S[i]);
6206          strat->S[i] = redBba(strat->S[i],i-1,strat);
6207          //if ((strat->ak!=0)&&(strat->S[i]!=NULL))
6208          //  strat->S[i]=redQ(strat->S[i],i+1,strat); /*reduce S[i] mod Q*/
6209          if (pCmp(redSi,strat->S[i])!=0)
6210          {
6211            change=TRUE;
6212            any_change=TRUE;
6213            #ifdef KDEBUG
6214            if (TEST_OPT_DEBUG)
6215            {
6216              PrintS("reduce:");
6217              wrp(redSi);PrintS(" to ");p_wrp(strat->S[i], currRing, strat->tailRing);PrintLn();
6218            }
6219            #endif
6220            if (TEST_OPT_PROT)
6221            {
6222              if (strat->S[i]==NULL)
6223                PrintS("V");
6224              else
6225                PrintS("v");
6226              mflush();
6227            }
6228          }
6229          pLmDelete(&redSi);
6230          if (strat->S[i]==NULL)
6231          {
6232            deleteInS(i,strat);
6233            i--;
6234          }
6235          else if (change)
6236          {
6237            if (TEST_OPT_INTSTRATEGY)
6238            {
6239              if (TEST_OPT_CONTENTSB)
6240                {
6241                  number n;
6242                  p_Cleardenom_n(strat->S[i], currRing, n);// also does a pContent
6243                  if (!nIsOne(n))
6244                    {
6245                      denominator_list denom=(denominator_list)omAlloc(sizeof(denominator_list_s));
6246                      denom->n=nInvers(n);
6247                      denom->next=DENOMINATOR_LIST;
6248                      DENOMINATOR_LIST=denom;
6249                    }
6250                  nDelete(&n);
6251                }
6252              else
6253                {
6254                  //pContent(strat->S[i]);
6255                  strat->S[i]=p_Cleardenom(strat->S[i], currRing);// also does a pContent
6256                }
6257            }
6258            else
6259            {
6260              pNorm(strat->S[i]);
6261            }
6262            strat->sevS[i] = pGetShortExpVector(strat->S[i]);
6263          }
6264        }
6265        i++;
6266      }
6267      if (any_change) reorderS(&suc,strat);
6268      else break;
6269    }
6270    if (toT)
6271    {
6272      for (i=0; i<=strat->sl; i++)
6273      {
6274        if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
6275        {
6276          h.p = redtailBba(strat->S[i],i-1,strat);
6277          if (TEST_OPT_INTSTRATEGY)
6278          {
6279            h.pCleardenom();// also does a pContent
6280          }
6281        }
6282        else
6283        {
6284          h.p = strat->S[i];
6285        }
6286        strat->initEcart(&h);
6287        if (strat->honey)
6288        {
6289          strat->ecartS[i] = h.ecart;
6290        }
6291        if (strat->sevS[i] == 0) {strat->sevS[i] = pGetShortExpVector(h.p);}
6292        else assume(strat->sevS[i] == pGetShortExpVector(h.p));
6293        h.sev = strat->sevS[i];
6294        /*puts the elements of S also to T*/
6295        strat->initEcart(&h);
6296        enterT(h,strat);
6297        strat->S_2_R[i] = strat->tl;
6298      }
6299    }
6300  }
6301  else
6302  {
6303    while (suc != -1)
6304    {
6305      i=suc;
6306      while (i<=strat->sl)
6307      {
6308        change=FALSE;
6309        if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
6310        {
6311          redSi=pHead((strat->S)[i]);
6312          (strat->S)[i] = redMora((strat->S)[i],i-1,strat);
6313          if ((strat->S)[i]==NULL)
6314          {
6315            deleteInS(i,strat);
6316            i--;
6317          }
6318          else if (pCmp((strat->S)[i],redSi)!=0)
6319          {
6320            any_change=TRUE;
6321            h.p = strat->S[i];
6322            strat->initEcart(&h);
6323            strat->ecartS[i] = h.ecart;
6324            if (TEST_OPT_INTSTRATEGY)
6325            {
6326              if (TEST_OPT_CONTENTSB)
6327                {
6328                  number n;
6329                  p_Cleardenom_n(strat->S[i], currRing, n);// also does a pContent
6330                  if (!nIsOne(n))
6331                    {
6332                      denominator_list denom=(denominator_list)omAlloc(sizeof(denominator_list_s));
6333                      denom->n=nInvers(n);
6334                      denom->next=DENOMINATOR_LIST;
6335                      DENOMINATOR_LIST=denom;
6336                    }
6337                  nDelete(&n);
6338                }
6339              else
6340                {
6341                  //pContent(strat->S[i]);
6342                  strat->S[i]=p_Cleardenom(strat->S[i], currRing);// also does a pContent
6343                }
6344            }
6345            else
6346            {
6347              pNorm(strat->S[i]); // == h.p
6348            }
6349            h.sev =  pGetShortExpVector(h.p);
6350            strat->sevS[i] = h.sev;
6351          }
6352          pLmDelete(&redSi);
6353          kTest(strat);
6354        }
6355        i++;
6356      }
6357#ifdef KDEBUG
6358      kTest(strat);
6359#endif
6360      if (any_change) reorderS(&suc,strat);
6361      else { suc=-1; break; }
6362      if (h.p!=NULL)
6363      {
6364        if (!strat->kHEdgeFound)
6365        {
6366          /*strat->kHEdgeFound =*/ HEckeTest(h.p,strat);
6367        }
6368        if (strat->kHEdgeFound)
6369          newHEdge(strat);
6370      }
6371    }
6372    for (i=0; i<=strat->sl; i++)
6373    {
6374      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
6375      {
6376        strat->S[i] = h.p = redtail(strat->S[i],strat->sl,strat);
6377        strat->initEcart(&h);
6378        strat->ecartS[i] = h.ecart;
6379        h.sev = pGetShortExpVector(h.p);
6380        strat->sevS[i] = h.sev;
6381      }
6382      else
6383      {
6384        h.p = strat->S[i];
6385        h.ecart=strat->ecartS[i];
6386        h.sev = strat->sevS[i];
6387        h.length = h.pLength = pLength(h.p);
6388      }
6389      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
6390        cancelunit1(&h,&suc,strat->sl,strat);
6391      h.SetpFDeg();
6392      /*puts the elements of S also to T*/
6393      enterT(h,strat);
6394      strat->S_2_R[i] = strat->tl;
6395    }
6396    if (suc!= -1) updateS(toT,strat);
6397  }
6398#ifdef KDEBUG
6399  kTest(strat);
6400#endif
6401}
6402
6403
6404/*2
6405* -puts p to the standardbasis s at position at
6406* -saves the result in S
6407*/
6408void enterSBba (LObject p,int atS,kStrategy strat, int atR)
6409{
6410  strat->news = TRUE;
6411  /*- puts p to the standardbasis s at position at -*/
6412  if (strat->sl == IDELEMS(strat->Shdl)-1)
6413  {
6414    strat->sevS = (unsigned long*) omRealloc0Size(strat->sevS,
6415                                    IDELEMS(strat->Shdl)*sizeof(unsigned long),
6416                                    (IDELEMS(strat->Shdl)+setmaxTinc)
6417                                                  *sizeof(unsigned long));
6418    strat->ecartS = (intset)omReallocSize(strat->ecartS,
6419                                          IDELEMS(strat->Shdl)*sizeof(int),
6420                                          (IDELEMS(strat->Shdl)+setmaxTinc)
6421                                                  *sizeof(int));
6422    strat->S_2_R = (int*) omRealloc0Size(strat->S_2_R,
6423                                         IDELEMS(strat->Shdl)*sizeof(int),
6424                                         (IDELEMS(strat->Shdl)+setmaxTinc)
6425                                                  *sizeof(int));
6426    if (strat->lenS!=NULL)
6427      strat->lenS=(int*)omRealloc0Size(strat->lenS,
6428                                       IDELEMS(strat->Shdl)*sizeof(int),
6429                                       (IDELEMS(strat->Shdl)+setmaxTinc)
6430                                                 *sizeof(int));
6431    if (strat->lenSw!=NULL)
6432      strat->lenSw=(wlen_type*)omRealloc0Size(strat->lenSw,
6433                                       IDELEMS(strat->Shdl)*sizeof(wlen_type),
6434                                       (IDELEMS(strat->Shdl)+setmaxTinc)
6435                                                 *sizeof(wlen_type));
6436    if (strat->fromQ!=NULL)
6437    {
6438      strat->fromQ = (intset)omReallocSize(strat->fromQ,
6439                                    IDELEMS(strat->Shdl)*sizeof(int),
6440                                    (IDELEMS(strat->Shdl)+setmaxTinc)*sizeof(int));
6441    }
6442    pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmaxTinc);
6443    IDELEMS(strat->Shdl)+=setmaxTinc;
6444    strat->Shdl->m=strat->S;
6445  }
6446  if (atS <= strat->sl)
6447  {
6448#ifdef ENTER_USE_MEMMOVE
6449// #if 0
6450    memmove(&(strat->S[atS+1]), &(strat->S[atS]),
6451            (strat->sl - atS + 1)*sizeof(poly));
6452    memmove(&(strat->ecartS[atS+1]), &(strat->ecartS[atS]),
6453            (strat->sl - atS + 1)*sizeof(int));
6454    memmove(&(strat->sevS[atS+1]), &(strat->sevS[atS]),
6455            (strat->sl - atS + 1)*sizeof(unsigned long));
6456    memmove(&(strat->S_2_R[atS+1]), &(strat->S_2_R[atS]),
6457            (strat->sl - atS + 1)*sizeof(int));
6458    if (strat->lenS!=NULL)
6459    memmove(&(strat->lenS[atS+1]), &(strat->lenS[atS]),
6460            (strat->sl - atS + 1)*sizeof(int));
6461    if (strat->lenSw!=NULL)
6462    memmove(&(strat->lenSw[atS+1]), &(strat->lenSw[atS]),
6463            (strat->sl - atS + 1)*sizeof(wlen_type));
6464#else
6465    for (i=strat->sl+1; i>=atS+1; i--)
6466    {
6467      strat->S[i] = strat->S[i-1];
6468      strat->ecartS[i] = strat->ecartS[i-1];
6469      strat->sevS[i] = strat->sevS[i-1];
6470      strat->S_2_R[i] = strat->S_2_R[i-1];
6471    }
6472    if (strat->lenS!=NULL)
6473    for (i=strat->sl+1; i>=atS+1; i--)
6474      strat->lenS[i] = strat->lenS[i-1];
6475    if (strat->lenSw!=NULL)
6476    for (i=strat->sl+1; i>=atS+1; i--)
6477      strat->lenSw[i] = strat->lenSw[i-1];
6478#endif
6479  }
6480  if (strat->fromQ!=NULL)
6481  {
6482#ifdef ENTER_USE_MEMMOVE
6483    memmove(&(strat->fromQ[atS+1]), &(strat->fromQ[atS]),
6484                  (strat->sl - atS + 1)*sizeof(int));
6485#else
6486    for (i=strat->sl+1; i>=atS+1; i--)
6487    {
6488      strat->fromQ[i] = strat->fromQ[i-1];
6489    }
6490#endif
6491    strat->fromQ[atS]=0;
6492  }
6493
6494  /*- save result -*/
6495  strat->S[atS] = p.p;
6496  if (strat->honey) strat->ecartS[atS] = p.ecart;
6497  if (p.sev == 0)
6498    p.sev = pGetShortExpVector(p.p);
6499  else
6500    assume(p.sev == pGetShortExpVector(p.p));
6501  strat->sevS[atS] = p.sev;
6502  strat->ecartS[atS] = p.ecart;
6503  strat->S_2_R[atS] = atR;
6504  strat->sl++;
6505}
6506
6507/*2
6508* -puts p to the standardbasis s at position at
6509* -saves the result in S
6510*/
6511void enterSSba (LObject p,int atS,kStrategy strat, int atR)
6512{
6513  int i;
6514  strat->news = TRUE;
6515  /*- puts p to the standardbasis s at position at -*/
6516  if (strat->sl == IDELEMS(strat->Shdl)-1)
6517  {
6518    strat->sevS = (unsigned long*) omRealloc0Size(strat->sevS,
6519                                    IDELEMS(strat->Shdl)*sizeof(unsigned long),
6520                                    (IDELEMS(strat->Shdl)+setmaxTinc)
6521                                                  *sizeof(unsigned long));
6522    strat->sevSig = (unsigned long*) omRealloc0Size(strat->sevSig,
6523                                    IDELEMS(strat->Shdl)*sizeof(unsigned long),
6524                                    (IDELEMS(strat->Shdl)+setmaxTinc)
6525                                                  *sizeof(unsigned long));
6526    strat->ecartS = (intset)omReallocSize(strat->ecartS,
6527                                          IDELEMS(strat->Shdl)*sizeof(int),
6528                                          (IDELEMS(strat->Shdl)+setmaxTinc)
6529                                                  *sizeof(int));
6530    strat->fromS = (intset)omReallocSize(strat->fromS,
6531                                          IDELEMS(strat->Shdl)*sizeof(int),
6532                                          (IDELEMS(strat->Shdl)+setmaxTinc)
6533                                                  *sizeof(int));
6534    strat->S_2_R = (int*) omRealloc0Size(strat->S_2_R,
6535                                         IDELEMS(strat->Shdl)*sizeof(int),
6536                                         (IDELEMS(strat->Shdl)+setmaxTinc)
6537                                                  *sizeof(int));
6538    if (strat->lenS!=NULL)
6539      strat->lenS=(int*)omRealloc0Size(strat->lenS,
6540                                       IDELEMS(strat->Shdl)*sizeof(int),
6541                                       (IDELEMS(strat->Shdl)+setmaxTinc)
6542                                                 *sizeof(int));
6543    if (strat->lenSw!=NULL)
6544      strat->lenSw=(wlen_type*)omRealloc0Size(strat->lenSw,
6545                                       IDELEMS(strat->Shdl)*sizeof(wlen_type),
6546                                       (IDELEMS(strat->Shdl)+setmaxTinc)
6547                                                 *sizeof(wlen_type));
6548    if (strat->fromQ!=NULL)
6549    {
6550      strat->fromQ = (intset)omReallocSize(strat->fromQ,
6551                                    IDELEMS(strat->Shdl)*sizeof(int),
6552                                    (IDELEMS(strat->Shdl)+setmaxTinc)*sizeof(int));
6553    }
6554    pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmaxTinc);
6555    pEnlargeSet(&strat->sig,IDELEMS(strat->Shdl),setmaxTinc);
6556    IDELEMS(strat->Shdl)+=setmaxTinc;
6557    strat->Shdl->m=strat->S;
6558  }
6559  // in a signature-based algorithm the following situation will never
6560  // appear due to the fact that the critical pairs are already sorted
6561  // by increasing signature.
6562  if (atS <= strat->sl)
6563  {
6564#ifdef ENTER_USE_MEMMOVE
6565// #if 0
6566    memmove(&(strat->S[atS+1]), &(strat->S[atS]),
6567            (strat->sl - atS + 1)*sizeof(poly));
6568    memmove(&(strat->ecartS[atS+1]), &(strat->ecartS[atS]),
6569            (strat->sl - atS + 1)*sizeof(int));
6570    memmove(&(strat->fromS[atS+1]), &(strat->fromS[atS]),
6571            (strat->sl - atS + 1)*sizeof(int));
6572    memmove(&(strat->sevS[atS+1]), &(strat->sevS[atS]),
6573            (strat->sl - atS + 1)*sizeof(unsigned long));
6574    memmove(&(strat->S_2_R[atS+1]), &(strat->S_2_R[atS]),
6575            (strat->sl - atS + 1)*sizeof(int));
6576    if (strat->lenS!=NULL)
6577    memmove(&(strat->lenS[atS+1]), &(strat->lenS[atS]),
6578            (strat->sl - atS + 1)*sizeof(int));
6579    if (strat->lenSw!=NULL)
6580    memmove(&(strat->lenSw[atS+1]), &(strat->lenSw[atS]),
6581            (strat->sl - atS + 1)*sizeof(wlen_type));
6582#else
6583    for (i=strat->sl+1; i>=atS+1; i--)
6584    {
6585      strat->S[i] = strat->S[i-1];
6586      strat->ecartS[i] = strat->ecartS[i-1];
6587      strat->fromS[i] = strat->fromS[i-1];
6588      strat->sevS[i] = strat->sevS[i-1];
6589      strat->S_2_R[i] = strat->S_2_R[i-1];
6590    }
6591    if (strat->lenS!=NULL)
6592    for (i=strat->sl+1; i>=atS+1; i--)
6593      strat->lenS[i] = strat->lenS[i-1];
6594    if (strat->lenSw!=NULL)
6595    for (i=strat->sl+1; i>=atS+1; i--)
6596      strat->lenSw[i] = strat->lenSw[i-1];
6597#endif
6598  }
6599  if (strat->fromQ!=NULL)
6600  {
6601#ifdef ENTER_USE_MEMMOVE
6602    memmove(&(strat->fromQ[atS+1]), &(strat->fromQ[atS]),
6603                  (strat->sl - atS + 1)*sizeof(int));
6604#else
6605    for (i=strat->sl+1; i>=atS+1; i--)
6606    {
6607      strat->fromQ[i] = strat->fromQ[i-1];
6608    }
6609#endif
6610    strat->fromQ[atS]=0;
6611  }
6612
6613  /*- save result -*/
6614  strat->S[atS] = p.p;
6615  strat->sig[atS] = p.sig; // TODO: get ths correct signature in here!
6616  if (strat->honey) strat->ecartS[atS] = p.ecart;
6617  if (p.sev == 0)
6618    p.sev = pGetShortExpVector(p.p);
6619  else
6620    assume(p.sev == pGetShortExpVector(p.p));
6621  strat->sevS[atS] = p.sev;
6622  // during the interreduction process of a signature-based algorithm we do not
6623  // compute the signature at this point, but when the whole interreduction
6624  // process finishes, i.e. f5c terminates!
6625  if (p.sig != NULL)
6626  {
6627    if (p.sevSig == 0)
6628      p.sevSig = pGetShortExpVector(p.sig);
6629    else
6630      assume(p.sevSig == pGetShortExpVector(p.sig));
6631    strat->sevSig[atS] = p.sevSig; // TODO: get the correct signature in here!
6632  }
6633  strat->ecartS[atS] = p.ecart;
6634  strat->fromS[atS] = p.from;
6635  strat->S_2_R[atS] = atR;
6636  strat->sl++;
6637#ifdef DEBUGF5
6638  int k;
6639  Print("--- LIST S: %d ---\n",strat->sl);
6640  for(k=0;k<=strat->sl;k++)
6641  {
6642    pWrite(strat->sig[k]);
6643  }
6644  Print("--- LIST S END ---\n");
6645#endif
6646}
6647
6648/*2
6649* puts p to the set T at position atT
6650*/
6651void enterT(LObject p, kStrategy strat, int atT)
6652{
6653  int i;
6654
6655  pp_Test(p.p, currRing, p.tailRing);
6656  assume(strat->tailRing == p.tailRing);
6657  // redMoraNF complains about this -- but, we don't really
6658  // neeed this so far
6659  assume(p.pLength == 0 || pLength(p.p) == p.pLength || rIsSyzIndexRing(currRing)); // modulo syzring
6660  assume(p.FDeg == p.pFDeg());
6661  assume(!p.is_normalized || nIsOne(pGetCoeff(p.p)));
6662
6663#ifdef KDEBUG
6664  // do not put an LObject twice into T:
6665  for(i=strat->tl;i>=0;i--)
6666  {
6667    if (p.p==strat->T[i].p)
6668    {
6669      printf("already in T at pos %d of %d, atT=%d\n",i,strat->tl,atT);
6670      return;
6671    }
6672  }
6673#endif
6674  strat->newt = TRUE;
6675  if (atT < 0)
6676    atT = strat->posInT(strat->T, strat->tl, p);
6677  if (strat->tl == strat->tmax-1)
6678    enlargeT(strat->T,strat->R,strat->sevT,strat->tmax,setmaxTinc);
6679  if (atT <= strat->tl)
6680  {
6681#ifdef ENTER_USE_MEMMOVE
6682    memmove(&(strat->T[atT+1]), &(strat->T[atT]),
6683            (strat->tl-atT+1)*sizeof(TObject));
6684    memmove(&(strat->sevT[atT+1]), &(strat->sevT[atT]),
6685            (strat->tl-atT+1)*sizeof(unsigned long));
6686#endif
6687    for (i=strat->tl+1; i>=atT+1; i--)
6688    {
6689#ifndef ENTER_USE_MEMMOVE
6690      strat->T[i] = strat->T[i-1];
6691      strat->sevT[i] = strat->sevT[i-1];
6692#endif
6693      strat->R[strat->T[i].i_r] = &(strat->T[i]);
6694    }
6695  }
6696
6697  if (strat->tailBin != NULL && (pNext(p.p) != NULL))
6698  {
6699    pNext(p.p)=p_ShallowCopyDelete(pNext(p.p),
6700                                   (strat->tailRing != NULL ?
6701                                    strat->tailRing : currRing),
6702                                   strat->tailBin);
6703    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
6704  }
6705  strat->T[atT] = (TObject) p;
6706
6707  if (strat->tailRing != currRing && pNext(p.p) != NULL)
6708    strat->T[atT].max = p_GetMaxExpP(pNext(p.p), strat->tailRing);
6709  else
6710    strat->T[atT].max = NULL;
6711
6712  strat->tl++;
6713  strat->R[strat->tl] = &(strat->T[atT]);
6714  strat->T[atT].i_r = strat->tl;
6715  assume(p.sev == 0 || pGetShortExpVector(p.p) == p.sev);
6716  strat->sevT[atT] = (p.sev == 0 ? pGetShortExpVector(p.p) : p.sev);
6717  kTest_T(&(strat->T[atT]));
6718}
6719
6720/*2
6721* puts signature p.sig to the set syz
6722*/
6723void enterSyz(LObject p, kStrategy strat)
6724{
6725  int i = strat->syzl;
6726
6727  strat->newt = TRUE;
6728  if (strat->syzl == strat->syzmax)
6729  {
6730    pEnlargeSet(&strat->syz,strat->syzmax,setmaxTinc);
6731    strat->sevSyz = (unsigned long*) omRealloc0Size(strat->sevSyz,
6732                                    (strat->syzmax)*sizeof(unsigned long),
6733                                    ((strat->syzmax)+setmaxTinc)
6734                                                  *sizeof(unsigned long));
6735    strat->syzmax += setmaxTinc;
6736  }
6737  strat->syz[i] = p.sig;
6738  strat->sevSyz[i] = p.sevSig;
6739  strat->syzl++;
6740#ifdef DEBUGF5
6741  Print("last element in strat->syz: %d--%d  ",i+1,strat->syzmax);
6742  pWrite(strat->syz[i]);
6743#endif
6744  // recheck pairs in strat->L with new rule and delete correspondingly
6745  int cc = strat->Ll;
6746  while (cc>-1)
6747  {
6748    if (p_LmShortDivisibleBy( strat->syz[strat->syzl-1], strat->sevSyz[strat->syzl-1], 
6749                              strat->L[cc].sig, ~strat->L[cc].sevSig, currRing))
6750    {
6751      deleteInL(strat->L,&strat->Ll,cc,strat);
6752    }
6753    cc--;
6754  }
6755
6756}
6757
6758
6759void initHilbCrit(ideal/*F*/, ideal /*Q*/, intvec **hilb,kStrategy strat)
6760{
6761  if (strat->homog!=isHomog)
6762  {
6763    *hilb=NULL;
6764  }
6765}
6766
6767void initBuchMoraCrit(kStrategy strat)
6768{
6769  strat->enterOnePair=enterOnePairNormal;
6770  strat->chainCrit=chainCritNormal;
6771#ifdef HAVE_RINGS
6772  if (rField_is_Ring(currRing))
6773  {
6774    strat->enterOnePair=enterOnePairRing;
6775    strat->chainCrit=chainCritRing;
6776  }
6777#endif
6778#ifdef HAVE_RATGRING
6779  if (rIsRatGRing(currRing))
6780  {
6781     strat->chainCrit=chainCritPart;
6782     /* enterOnePairNormal get rational part in it */
6783  }
6784#endif
6785
6786  strat->sugarCrit =        TEST_OPT_SUGARCRIT;
6787  strat->Gebauer =          strat->homog || strat->sugarCrit;
6788  strat->honey =            !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
6789  if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
6790  strat->pairtest = NULL;
6791  /* alway use tailreduction, except:
6792  * - in local rings, - in lex order case, -in ring over extensions */
6793  strat->noTailReduction = !TEST_OPT_REDTAIL;
6794
6795#ifdef HAVE_PLURAL
6796  // and r is plural_ring
6797  //  hence this holds for r a rational_plural_ring
6798  if( rIsPluralRing(currRing) || (rIsSCA(currRing) && !strat->z2homog) )
6799  {    //or it has non-quasi-comm type... later
6800    strat->sugarCrit = FALSE;
6801    strat->Gebauer = FALSE;
6802    strat->honey = FALSE;
6803  }
6804#endif
6805
6806#ifdef HAVE_RINGS
6807  // Coefficient ring?
6808  if (rField_is_Ring(currRing))
6809  {
6810    strat->sugarCrit = FALSE;
6811    strat->Gebauer = FALSE ;
6812    strat->honey = FALSE;
6813  }
6814#endif
6815  #ifdef KDEBUG
6816  if (TEST_OPT_DEBUG)
6817  {
6818    if (strat->homog) PrintS("ideal/module is homogeneous\n");
6819    else              PrintS("ideal/module is not homogeneous\n");
6820  }
6821  #endif
6822}
6823
6824void initSbaCrit(kStrategy strat)
6825{
6826  //strat->enterOnePair=enterOnePairNormal;
6827  strat->enterOnePair = enterOnePairNormal;
6828  //strat->chainCrit=chainCritNormal;
6829  strat->chainCrit    = chainCritSig;
6830  /******************************************
6831   * rewCrit1 and rewCrit2 are already set in
6832   * kSba() in kstd1.cc
6833   *****************************************/
6834  //strat->rewCrit1     = faugereRewCriterion;
6835  if (strat->incremental)
6836  {
6837    strat->syzCrit  = syzCriterionInc;
6838  }
6839  else
6840  {
6841    strat->syzCrit  = syzCriterion;
6842  }
6843#ifdef HAVE_RINGS
6844  if (rField_is_Ring(currRing))
6845  {
6846    strat->enterOnePair=enterOnePairRing;
6847    strat->chainCrit=chainCritRing;
6848  }
6849#endif
6850#ifdef HAVE_RATGRING
6851  if (rIsRatGRing(currRing))
6852  {
6853     strat->chainCrit=chainCritPart;
6854     /* enterOnePairNormal get rational part in it */
6855  }
6856#endif
6857
6858  strat->sugarCrit =        TEST_OPT_SUGARCRIT;
6859  strat->Gebauer =          strat->homog || strat->sugarCrit;
6860  strat->honey =            !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
6861  if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
6862  strat->pairtest = NULL;
6863  /* alway use tailreduction, except:
6864  * - in local rings, - in lex order case, -in ring over extensions */
6865  strat->noTailReduction = !TEST_OPT_REDTAIL;
6866  //strat->noTailReduction = NULL;
6867
6868#ifdef HAVE_PLURAL
6869  // and r is plural_ring
6870  //  hence this holds for r a rational_plural_ring
6871  if( rIsPluralRing(currRing) || (rIsSCA(currRing) && !strat->z2homog) )
6872  {    //or it has non-quasi-comm type... later
6873    strat->sugarCrit = FALSE;
6874    strat->Gebauer = FALSE;
6875    strat->honey = FALSE;
6876  }
6877#endif
6878
6879#ifdef HAVE_RINGS
6880  // Coefficient ring?
6881  if (rField_is_Ring(currRing))
6882  {
6883    strat->sugarCrit = FALSE;
6884    strat->Gebauer = FALSE ;
6885    strat->honey = FALSE;
6886  }
6887#endif
6888  #ifdef KDEBUG
6889  if (TEST_OPT_DEBUG)
6890  {
6891    if (strat->homog) PrintS("ideal/module is homogeneous\n");
6892    else              PrintS("ideal/module is not homogeneous\n");
6893  }
6894  #endif
6895}
6896
6897BOOLEAN kPosInLDependsOnLength(int (*pos_in_l)
6898                               (const LSet set, const int length,
6899                                LObject* L,const kStrategy strat))
6900{
6901  if (pos_in_l == posInL110 ||
6902      pos_in_l == posInL10)
6903    return TRUE;
6904
6905  return FALSE;
6906}
6907
6908void initBuchMoraPos (kStrategy strat)
6909{
6910  if (currRing->OrdSgn==1)
6911  {
6912    if (strat->honey)
6913    {
6914      strat->posInL = posInL15;
6915      // ok -- here is the deal: from my experiments for Singular-2-0
6916      // I conclude that that posInT_EcartpLength is the best of
6917      // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
6918      // see the table at the end of this file
6919      if (TEST_OPT_OLDSTD)
6920        strat->posInT = posInT15;
6921      else
6922        strat->posInT = posInT_EcartpLength;
6923    }
6924    else if (currRing->pLexOrder && !TEST_OPT_INTSTRATEGY)
6925    {
6926      strat->posInL = posInL11;
6927      strat->posInT = posInT11;
6928    }
6929    else if (TEST_OPT_INTSTRATEGY)
6930    {
6931      strat->posInL = posInL11;
6932      strat->posInT = posInT11;
6933    }
6934    else
6935    {
6936      strat->posInL = posInL0;
6937      strat->posInT = posInT0;
6938    }
6939    //if (strat->minim>0) strat->posInL =posInLSpecial;
6940    if (strat->homog)
6941    {
6942       strat->posInL = posInL110;
6943       strat->posInT = posInT110;
6944    }
6945  }
6946  else
6947  {
6948    if (strat->homog)
6949    {
6950      strat->posInL = posInL11;
6951      strat->posInT = posInT11;
6952    }
6953    else
6954    {
6955      if ((currRing->order[0]==ringorder_c)
6956      ||(currRing->order[0]==ringorder_C))
6957      {
6958        strat->posInL = posInL17_c;
6959        strat->posInT = posInT17_c;
6960      }
6961      else
6962      {
6963        strat->posInL = posInL17;
6964        strat->posInT = posInT17;
6965      }
6966    }
6967  }
6968  if (strat->minim>0) strat->posInL =posInLSpecial;
6969  // for further tests only
6970  if ((BTEST1(11)) || (BTEST1(12)))
6971    strat->posInL = posInL11;
6972  else if ((BTEST1(13)) || (BTEST1(14)))
6973    strat->posInL = posInL13;
6974  else if ((BTEST1(15)) || (BTEST1(16)))
6975    strat->posInL = posInL15;
6976  else if ((BTEST1(17)) || (BTEST1(18)))
6977    strat->posInL = posInL17;
6978  if (BTEST1(11))
6979    strat->posInT = posInT11;
6980  else if (BTEST1(13))
6981    strat->posInT = posInT13;
6982  else if (BTEST1(15))
6983    strat->posInT = posInT15;
6984  else if ((BTEST1(17)))
6985    strat->posInT = posInT17;
6986  else if ((BTEST1(19)))
6987    strat->posInT = posInT19;
6988  else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
6989    strat->posInT = posInT1;
6990#ifdef HAVE_RINGS
6991  if (rField_is_Ring(currRing))
6992  {
6993    strat->posInL = posInL11;
6994    strat->posInT = posInT11;
6995  }
6996#endif
6997  strat->posInLDependsOnLength = kPosInLDependsOnLength(strat->posInL);
6998}
6999
7000void initBuchMora (ideal F,ideal Q,kStrategy strat)
7001{
7002  strat->interpt = BTEST1(OPT_INTERRUPT);
7003  strat->kHEdge=NULL;
7004  if (currRing->OrdSgn==1) strat->kHEdgeFound=FALSE;
7005  /*- creating temp data structures------------------- -*/
7006  strat->cp = 0;
7007  strat->c3 = 0;
7008  strat->tail = pInit();
7009  /*- set s -*/
7010  strat->sl = -1;
7011  /*- set L -*/
7012  strat->Lmax = ((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
7013  strat->Ll = -1;
7014  strat->L = initL(((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc);
7015  /*- set B -*/
7016  strat->Bmax = setmaxL;
7017  strat->Bl = -1;
7018  strat->B = initL();
7019  /*- set T -*/
7020  strat->tl = -1;
7021  strat->tmax = setmaxT;
7022  strat->T = initT();
7023  strat->R = initR();
7024  strat->sevT = initsevT();
7025  /*- init local data struct.---------------------------------------- -*/
7026  strat->P.ecart=0;
7027  strat->P.length=0;
7028  if (currRing->OrdSgn==-1)
7029  {
7030    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
7031    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
7032  }
7033  if(TEST_OPT_SB_1)
7034  {
7035    int i;
7036    ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
7037    for (i=strat->newIdeal;i<IDELEMS(F);i++)
7038    {
7039      P->m[i-strat->newIdeal] = F->m[i];
7040      F->m[i] = NULL;
7041    }
7042    initSSpecial(F,Q,P,strat);
7043    for (i=strat->newIdeal;i<IDELEMS(F);i++)
7044    {
7045      F->m[i] = P->m[i-strat->newIdeal];
7046      P->m[i-strat->newIdeal] = NULL;
7047    }
7048    idDelete(&P);
7049  }
7050  else
7051  {
7052    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
7053    // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
7054  }
7055  strat->fromT = FALSE;
7056  strat->noTailReduction = !TEST_OPT_REDTAIL;
7057  if (!TEST_OPT_SB_1)
7058  {
7059    updateS(TRUE,strat);
7060  }
7061  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
7062  strat->fromQ=NULL;
7063}
7064
7065void exitBuchMora (kStrategy strat)
7066{
7067  /*- release temp data -*/
7068  cleanT(strat);
7069  omFreeSize(strat->T,(strat->tmax)*sizeof(TObject));
7070  omFreeSize(strat->R,(strat->tmax)*sizeof(TObject*));
7071  omFreeSize(strat->sevT, (strat->tmax)*sizeof(unsigned long));
7072  omFreeSize(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
7073  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
7074  omFreeSize(strat->S_2_R,IDELEMS(strat->Shdl)*sizeof(int));
7075  /*- set L: should be empty -*/
7076  omFreeSize(strat->L,(strat->Lmax)*sizeof(LObject));
7077  /*- set B: should be empty -*/
7078  omFreeSize(strat->B,(strat->Bmax)*sizeof(LObject));
7079  pLmDelete(&strat->tail);
7080  strat->syzComp=0;
7081}
7082
7083/*2
7084* in the case of a standardbase of a module over a qring:
7085* replace polynomials in i by ak vectors,
7086* (the polynomial * unit vectors gen(1)..gen(ak)
7087* in every case (also for ideals:)
7088* deletes divisible vectors/polynomials
7089*/
7090void updateResult(ideal r,ideal Q, kStrategy strat)
7091{
7092  int l;
7093  if (strat->ak>0)
7094  {
7095    for (l=IDELEMS(r)-1;l>=0;l--)
7096    {
7097      if ((r->m[l]!=NULL) && (pGetComp(r->m[l])==0))
7098      {
7099        pDelete(&r->m[l]); // and set it to NULL
7100      }
7101    }
7102    int q;
7103    poly p;
7104    for (l=IDELEMS(r)-1;l>=0;l--)
7105    {
7106      if ((r->m[l]!=NULL)
7107      //&& (strat->syzComp>0)
7108      //&& (pGetComp(r->m[l])<=strat->syzComp)
7109      )
7110      {
7111        for(q=IDELEMS(Q)-1; q>=0;q--)
7112        {
7113          if ((Q->m[q]!=NULL)
7114          &&(pLmDivisibleBy(Q->m[q],r->m[l])))
7115          {
7116            if (TEST_OPT_REDSB)
7117            {
7118              p=r->m[l];
7119              r->m[l]=kNF(Q,NULL,p);
7120              pDelete(&p);
7121            }
7122            else
7123            {
7124              pDelete(&r->m[l]); // and set it to NULL
7125            }
7126            break;
7127          }
7128        }
7129      }
7130    }
7131  }
7132  else
7133  {
7134    int q;
7135    poly p;
7136    BOOLEAN reduction_found=FALSE;
7137    for (l=IDELEMS(r)-1;l>=0;l--)
7138    {
7139      if (r->m[l]!=NULL)
7140      {
7141        for(q=IDELEMS(Q)-1; q>=0;q--)
7142        {
7143          if ((Q->m[q]!=NULL)
7144          &&(pLmEqual(r->m[l],Q->m[q])))
7145          {
7146            if (TEST_OPT_REDSB)
7147            {
7148              p=r->m[l];
7149              r->m[l]=kNF(Q,NULL,p);
7150              pDelete(&p);
7151              reduction_found=TRUE;
7152            }
7153            else
7154            {
7155              pDelete(&r->m[l]); // and set it to NULL
7156            }
7157            break;
7158          }
7159        }
7160      }
7161    }
7162    if (/*TEST_OPT_REDSB &&*/ reduction_found)
7163    {
7164      for (l=IDELEMS(r)-1;l>=0;l--)
7165      {
7166        if (r->m[l]!=NULL)
7167        {
7168          for(q=IDELEMS(r)-1;q>=0;q--)
7169          {
7170            if ((l!=q)
7171            && (r->m[q]!=NULL)
7172            &&(pLmDivisibleBy(r->m[l],r->m[q])))
7173            {
7174              pDelete(&r->m[q]);
7175            }
7176          }
7177        }
7178      }
7179    }
7180  }
7181  idSkipZeroes(r);
7182}
7183
7184void completeReduce (kStrategy strat, BOOLEAN withT)
7185{
7186  int i;
7187  int low = (((currRing->OrdSgn==1) && (strat->ak==0)) ? 1 : 0);
7188  LObject L;
7189
7190#ifdef KDEBUG
7191  // need to set this: during tailreductions of T[i], T[i].max is out of
7192  // sync
7193  sloppy_max = TRUE;
7194#endif
7195
7196  strat->noTailReduction = FALSE;
7197  if (TEST_OPT_PROT)
7198  {
7199    PrintLn();
7200    if (timerv) writeTime("standard base computed:");
7201  }
7202  if (TEST_OPT_PROT)
7203  {
7204    Print("(S:%d)",strat->sl);mflush();
7205  }
7206  for (i=strat->sl; i>=low; i--)
7207  {
7208    int end_pos=strat->sl;
7209    if ((strat->fromQ!=NULL) && (strat->fromQ[i])) continue; // do not reduce Q_i
7210    if (strat->ak==0) end_pos=i-1;
7211    TObject* T_j = strat->s_2_t(i);
7212    if ((T_j != NULL)&&(T_j->p==strat->S[i]))
7213    {
7214      L = *T_j;
7215      #ifdef KDEBUG
7216      if (TEST_OPT_DEBUG)
7217      {
7218        Print("test S[%d]:",i);
7219        p_wrp(L.p,currRing,strat->tailRing);
7220        PrintLn();
7221      }
7222      #endif
7223      if (currRing->OrdSgn == 1)
7224        strat->S[i] = redtailBba(&L, end_pos, strat, withT);
7225      else
7226        strat->S[i] = redtail(&L, strat->sl, strat);
7227      #ifdef KDEBUG
7228      if (TEST_OPT_DEBUG)
7229      {
7230        Print("to (tailR) S[%d]:",i);
7231        p_wrp(strat->S[i],currRing,strat->tailRing);
7232        PrintLn();
7233      }
7234      #endif
7235
7236      if (strat->redTailChange && strat->tailRing != currRing)
7237      {
7238        if (T_j->max != NULL) p_LmFree(T_j->max, strat->tailRing);
7239        if (pNext(T_j->p) != NULL)
7240          T_j->max = p_GetMaxExpP(pNext(T_j->p), strat->tailRing);
7241        else
7242          T_j->max = NULL;
7243      }
7244      if (TEST_OPT_INTSTRATEGY)
7245        T_j->pCleardenom();
7246    }
7247    else
7248    {
7249      assume(currRing == strat->tailRing);
7250      #ifdef KDEBUG
7251      if (TEST_OPT_DEBUG)
7252      {
7253        Print("test S[%d]:",i);
7254        p_wrp(strat->S[i],currRing,strat->tailRing);
7255        PrintLn();
7256      }
7257      #endif
7258      if (currRing->OrdSgn == 1)
7259        strat->S[i] = redtailBba(strat->S[i], end_pos, strat, withT);
7260      else
7261        strat->S[i] = redtail(strat->S[i], strat->sl, strat);
7262      if (TEST_OPT_INTSTRATEGY)
7263      {
7264        if (TEST_OPT_CONTENTSB)
7265        {
7266          number n;
7267          p_Cleardenom_n(strat->S[i], currRing, n);// also does a pContent
7268          if (!nIsOne(n))
7269          {
7270            denominator_list denom=(denominator_list)omAlloc(sizeof(denominator_list_s));
7271            denom->n=nInvers(n);
7272            denom->next=DENOMINATOR_LIST;
7273            DENOMINATOR_LIST=denom;
7274          }
7275          nDelete(&n);
7276        }
7277        else
7278        {
7279          //pContent(strat->S[i]);
7280          strat->S[i]=p_Cleardenom(strat->S[i], currRing);// also does a pContent
7281        }
7282      }
7283      #ifdef KDEBUG
7284      if (TEST_OPT_DEBUG)
7285      {
7286        Print("to (-tailR) S[%d]:",i);
7287        p_wrp(strat->S[i],currRing,strat->tailRing);
7288        PrintLn();
7289      }
7290      #endif
7291    }
7292    if (TEST_OPT_PROT)
7293      PrintS("-");
7294  }
7295  if (TEST_OPT_PROT) PrintLn();
7296#ifdef KDEBUG
7297  sloppy_max = FALSE;
7298#endif
7299}
7300
7301
7302/*2
7303* computes the new strat->kHEdge and the new pNoether,
7304* returns TRUE, if pNoether has changed
7305*/
7306BOOLEAN newHEdge(kStrategy strat)
7307{
7308  int i,j;
7309  poly newNoether;
7310
7311#if 0
7312  if (currRing->weight_all_1)
7313    scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
7314  else
7315    scComputeHCw(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
7316#else
7317  scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
7318#endif
7319  if (strat->t_kHEdge != NULL) p_LmFree(strat->t_kHEdge, strat->tailRing);
7320  if (strat->tailRing != currRing)
7321    strat->t_kHEdge = k_LmInit_currRing_2_tailRing(strat->kHEdge, strat->tailRing);
7322  /* compare old and new noether*/
7323  newNoether = pLmInit(strat->kHEdge);
7324  j = p_FDeg(newNoether,currRing);
7325  for (i=1; i<=(currRing->N); i++)
7326  {
7327    if (pGetExp(newNoether, i) > 0) pDecrExp(newNoether,i);
7328  }
7329  pSetm(newNoether);
7330  if (j < strat->HCord) /*- statistics -*/
7331  {
7332    if (TEST_OPT_PROT)
7333    {
7334      Print("H(%d)",j);
7335      mflush();
7336    }
7337    strat->HCord=j;
7338    #ifdef KDEBUG
7339    if (TEST_OPT_DEBUG)
7340    {
7341      Print("H(%d):",j);
7342      wrp(strat->kHEdge);
7343      PrintLn();
7344    }
7345    #endif
7346  }
7347  if (pCmp(strat->kNoether,newNoether)!=1)
7348  {
7349    pDelete(&strat->kNoether);
7350    strat->kNoether=newNoether;
7351    if (strat->t_kNoether != NULL) p_LmFree(strat->t_kNoether, strat->tailRing);
7352    if (strat->tailRing != currRing)
7353      strat->t_kNoether = k_LmInit_currRing_2_tailRing(strat->kNoether, strat->tailRing);
7354
7355    return TRUE;
7356  }
7357  pLmFree(newNoether);
7358  return FALSE;
7359}
7360
7361/***************************************************************
7362 *
7363 * Routines related for ring changes during std computations
7364 *
7365 ***************************************************************/
7366BOOLEAN kCheckSpolyCreation(LObject *L, kStrategy strat, poly &m1, poly &m2)
7367{
7368  if (strat->overflow) return FALSE;
7369  assume(L->p1 != NULL && L->p2 != NULL);
7370  // shift changes: from 0 to -1
7371  assume(L->i_r1 >= -1 && L->i_r1 <= strat->tl);
7372  assume(L->i_r2 >= -1 && L->i_r2 <= strat->tl);
7373  assume(strat->tailRing != currRing);
7374
7375  if (! k_GetLeadTerms(L->p1, L->p2, currRing, m1, m2, strat->tailRing))
7376    return FALSE;
7377  // shift changes: extra case inserted
7378  if ((L->i_r1 == -1) || (L->i_r2 == -1) )
7379  {
7380    return TRUE;
7381  }
7382  poly p1_max = (strat->R[L->i_r1])->max;
7383  poly p2_max = (strat->R[L->i_r2])->max;
7384
7385  if ((p1_max != NULL && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
7386      (p2_max != NULL && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
7387  {
7388    p_LmFree(m1, strat->tailRing);
7389    p_LmFree(m2, strat->tailRing);
7390    m1 = NULL;
7391    m2 = NULL;
7392    return FALSE;
7393  }
7394  return TRUE;
7395}
7396
7397#ifdef HAVE_RINGS
7398/***************************************************************
7399 *
7400 * Checks, if we can compute the gcd poly / strong pair
7401 * gcd-poly = m1 * R[atR] + m2 * S[atS]
7402 *
7403 ***************************************************************/
7404BOOLEAN kCheckStrongCreation(int atR, poly m1, int atS, poly m2, kStrategy strat)
7405{
7406  assume(strat->S_2_R[atS] >= -1 && strat->S_2_R[atS] <= strat->tl);
7407  //assume(strat->tailRing != currRing);
7408
7409  poly p1_max = (strat->R[atR])->max;
7410  poly p2_max = (strat->R[strat->S_2_R[atS]])->max;
7411
7412  if ((p1_max != NULL && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
7413      (p2_max != NULL && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
7414  {
7415    return FALSE;
7416  }
7417  return TRUE;
7418}
7419#endif
7420
7421BOOLEAN kStratChangeTailRing(kStrategy strat, LObject *L, TObject* T, unsigned long expbound)
7422{
7423  assume((strat->tailRing == currRing) || (strat->tailRing->bitmask < currRing->bitmask));
7424  /* initial setup or extending */
7425
7426  if (expbound == 0) expbound = strat->tailRing->bitmask << 1;
7427  if (expbound >= currRing->bitmask) return FALSE;
7428  strat->overflow=FALSE;
7429  ring new_tailRing = rModifyRing(currRing,
7430                                  // Hmmm .. the condition pFDeg == p_Deg
7431                                  // might be too strong
7432#ifdef HAVE_RINGS
7433                                  (strat->homog && currRing->pFDeg == p_Deg && !(rField_is_Ring(currRing))), // TODO Oliver
7434#else
7435                                  (strat->homog && currRing->pFDeg == p_Deg), // omit_degree
7436#endif
7437                                  (strat->ak==0), // omit_comp if the input is an ideal
7438                                  expbound); // exp_limit
7439
7440  if (new_tailRing == currRing) return TRUE;
7441
7442  strat->pOrigFDeg_TailRing = new_tailRing->pFDeg;
7443  strat->pOrigLDeg_TailRing = new_tailRing->pLDeg;
7444
7445  if (currRing->pFDeg != currRing->pFDegOrig)
7446  {
7447    new_tailRing->pFDeg = currRing->pFDeg;
7448    new_tailRing->pLDeg = currRing->pLDeg;
7449  }
7450
7451  if (TEST_OPT_PROT)
7452    Print("[%lu:%d", (unsigned long) new_tailRing->bitmask, new_tailRing->ExpL_Size);
7453  kTest_TS(strat);
7454  assume(new_tailRing != strat->tailRing);
7455  pShallowCopyDeleteProc p_shallow_copy_delete
7456    = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
7457
7458  omBin new_tailBin = omGetStickyBinOfBin(new_tailRing->PolyBin);
7459
7460  int i;
7461  for (i=0; i<=strat->tl; i++)
7462  {
7463    strat->T[i].ShallowCopyDelete(new_tailRing, new_tailBin,
7464                                  p_shallow_copy_delete);
7465  }
7466  for (i=0; i<=strat->Ll; i++)
7467  {
7468    assume(strat->L[i].p != NULL);
7469    if (pNext(strat->L[i].p) != strat->tail)
7470      strat->L[i].ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
7471  }
7472  if (strat->P.t_p != NULL ||
7473      (strat->P.p != NULL && pNext(strat->P.p) != strat->tail))
7474    strat->P.ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
7475
7476  if (L != NULL && L->tailRing != new_tailRing)
7477  {
7478    if (L->i_r < 0)
7479      L->ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
7480    else
7481    {
7482      assume(L->i_r <= strat->tl);
7483      TObject* t_l = strat->R[L->i_r];
7484      assume(t_l != NULL);
7485      L->tailRing = new_tailRing;
7486      L->p = t_l->p;
7487      L->t_p = t_l->t_p;
7488      L->max = t_l->max;
7489    }
7490  }
7491
7492  if (T != NULL && T->tailRing != new_tailRing && T->i_r < 0)
7493    T->ShallowCopyDelete(new_tailRing, new_tailBin, p_shallow_copy_delete);
7494
7495  omMergeStickyBinIntoBin(strat->tailBin, strat->tailRing->PolyBin);
7496  if (strat->tailRing != currRing)
7497    rKillModifiedRing(strat->tailRing);
7498
7499  strat->tailRing = new_tailRing;
7500  strat->tailBin = new_tailBin;
7501  strat->p_shallow_copy_delete
7502    = pGetShallowCopyDeleteProc(currRing, new_tailRing);
7503
7504  if (strat->kHEdge != NULL)
7505  {
7506    if (strat->t_kHEdge != NULL)
7507      p_LmFree(strat->t_kHEdge, strat->tailRing);
7508    strat->t_kHEdge=k_LmInit_currRing_2_tailRing(strat->kHEdge, new_tailRing);
7509  }
7510
7511  if (strat->kNoether != NULL)
7512  {
7513    if (strat->t_kNoether != NULL)
7514      p_LmFree(strat->t_kNoether, strat->tailRing);
7515    strat->t_kNoether=k_LmInit_currRing_2_tailRing(strat->kNoether,
7516                                                   new_tailRing);
7517  }
7518  kTest_TS(strat);
7519  if (TEST_OPT_PROT)
7520    PrintS("]");
7521  return TRUE;
7522}
7523
7524void kStratInitChangeTailRing(kStrategy strat)
7525{
7526  unsigned long l = 0;
7527  int i;
7528  long e;
7529
7530  assume(strat->tailRing == currRing);
7531
7532  for (i=0; i<= strat->Ll; i++)
7533  {
7534    l = p_GetMaxExpL(strat->L[i].p, currRing, l);
7535  }
7536  for (i=0; i<=strat->tl; i++)
7537  {
7538    // Hmm ... this we could do in one Step
7539    l = p_GetMaxExpL(strat->T[i].p, currRing, l);
7540  }
7541  if (rField_is_Ring(currRing))
7542  {
7543    l *= 2;
7544  }
7545  e = p_GetMaxExp(l, currRing);
7546  if (e <= 1) e = 2;
7547
7548  kStratChangeTailRing(strat, NULL, NULL, e);
7549}
7550
7551skStrategy::skStrategy()
7552{
7553  memset(this, 0, sizeof(skStrategy));
7554#ifndef NDEBUG
7555  strat_nr++;
7556  nr=strat_nr;
7557  if (strat_fac_debug) Print("s(%d) created\n",nr);
7558#endif
7559  tailRing = currRing;
7560  P.tailRing = currRing;
7561  tl = -1;
7562  sl = -1;
7563#ifdef HAVE_LM_BIN
7564  lmBin = omGetStickyBinOfBin(currRing->PolyBin);
7565#endif
7566#ifdef HAVE_TAIL_BIN
7567  tailBin = omGetStickyBinOfBin(currRing->PolyBin);
7568#endif
7569  pOrigFDeg = currRing->pFDeg;
7570  pOrigLDeg = currRing->pLDeg;
7571}
7572
7573
7574skStrategy::~skStrategy()
7575{
7576  if (lmBin != NULL)
7577    omMergeStickyBinIntoBin(lmBin, currRing->PolyBin);
7578  if (tailBin != NULL)
7579    omMergeStickyBinIntoBin(tailBin,
7580                            (tailRing != NULL ? tailRing->PolyBin:
7581                             currRing->PolyBin));
7582  if (t_kHEdge != NULL)
7583    p_LmFree(t_kHEdge, tailRing);
7584  if (t_kNoether != NULL)
7585    p_LmFree(t_kNoether, tailRing);
7586
7587  if (currRing != tailRing)
7588    rKillModifiedRing(tailRing);
7589  pRestoreDegProcs(currRing,pOrigFDeg, pOrigLDeg);
7590}
7591
7592#if 0
7593Timings for the different possibilities of posInT:
7594            T15           EDL         DL          EL            L         1-2-3
7595Gonnet      43.26       42.30       38.34       41.98       38.40      100.04
7596Hairer_2_1   1.11        1.15        1.04        1.22        1.08        4.7
7597Twomat3      1.62        1.69        1.70        1.65        1.54       11.32
7598ahml         4.48        4.03        4.03        4.38        4.96       26.50
7599c7          15.02       13.98       15.16       13.24       17.31       47.89
7600c8         505.09      407.46      852.76      413.21      499.19        n/a
7601f855        12.65        9.27       14.97        8.78       14.23       33.12
7602gametwo6    11.47       11.35       14.57       11.20       12.02       35.07
7603gerhard_3    2.73        2.83        2.93        2.64        3.12        6.24
7604ilias13     22.89       22.46       24.62       20.60       23.34       53.86
7605noon8       40.68       37.02       37.99       36.82       35.59      877.16
7606rcyclic_19  48.22       42.29       43.99       45.35       51.51      204.29
7607rkat9       82.37       79.46       77.20       77.63       82.54      267.92
7608schwarz_11  16.46       16.81       16.76       16.81       16.72       35.56
7609test016     16.39       14.17       14.40       13.50       14.26       34.07
7610test017     34.70       36.01       33.16       35.48       32.75       71.45
7611test042     10.76       10.99       10.27       11.57       10.45       23.04
7612test058      6.78        6.75        6.51        6.95        6.22        9.47
7613test066     10.71       10.94       10.76       10.61       10.56       19.06
7614test073     10.75       11.11       10.17       10.79        8.63       58.10
7615test086     12.23       11.81       12.88       12.24       13.37       66.68
7616test103      5.05        4.80        5.47        4.64        4.89       11.90
7617test154     12.96       11.64       13.51       12.46       14.61       36.35
7618test162     65.27       64.01       67.35       59.79       67.54      196.46
7619test164      7.50        6.50        7.68        6.70        7.96       17.13
7620virasoro     3.39        3.50        3.35        3.47        3.70        7.66
7621#endif
7622
7623
7624//#ifdef HAVE_MORE_POS_IN_T
7625#if 1
7626// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
7627int posInT_EcartFDegpLength(const TSet set,const int length,LObject &p)
7628{
7629
7630  if (length==-1) return 0;
7631
7632  int o = p.ecart;
7633  int op=p.GetpFDeg();
7634  int ol = p.GetpLength();
7635
7636  if (set[length].ecart < o)
7637    return length+1;
7638  if (set[length].ecart == o)
7639  {
7640     int oo=set[length].GetpFDeg();
7641     if ((oo < op) || ((oo==op) && (set[length].length < ol)))
7642       return length+1;
7643  }
7644
7645  int i;
7646  int an = 0;
7647  int en= length;
7648  loop
7649  {
7650    if (an >= en-1)
7651    {
7652      if (set[an].ecart > o)
7653        return an;
7654      if (set[an].ecart == o)
7655      {
7656         int oo=set[an].GetpFDeg();
7657         if((oo > op)
7658         || ((oo==op) && (set[an].pLength > ol)))
7659           return an;
7660      }
7661      return en;
7662    }
7663    i=(an+en) / 2;
7664    if (set[i].ecart > o)
7665      en=i;
7666    else if (set[i].ecart == o)
7667    {
7668       int oo=set[i].GetpFDeg();
7669       if ((oo > op)
7670       || ((oo == op) && (set[i].pLength > ol)))
7671         en=i;
7672       else
7673        an=i;
7674    }
7675    else
7676      an=i;
7677  }
7678}
7679
7680// determines the position based on: 1.) FDeg 2.) pLength
7681int posInT_FDegpLength(const TSet set,const int length,LObject &p)
7682{
7683
7684  if (length==-1) return 0;
7685
7686  int op=p.GetpFDeg();
7687  int ol = p.GetpLength();
7688
7689  int oo=set[length].GetpFDeg();
7690  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
7691    return length+1;
7692
7693  int i;
7694  int an = 0;
7695  int en= length;
7696  loop
7697    {
7698      if (an >= en-1)
7699      {
7700        int oo=set[an].GetpFDeg();
7701        if((oo > op)
7702           || ((oo==op) && (set[an].pLength > ol)))
7703          return an;
7704        return en;
7705      }
7706      i=(an+en) / 2;
7707      int oo=set[i].GetpFDeg();
7708      if ((oo > op)
7709          || ((oo == op) && (set[i].pLength > ol)))
7710        en=i;
7711      else
7712        an=i;
7713    }
7714}
7715
7716
7717// determines the position based on: 1.) pLength
7718int posInT_pLength(const TSet set,const int length,LObject &p)
7719{
7720  int ol = p.GetpLength();
7721  if (length==-1)
7722    return 0;
7723  if (set[length].length<p.length)
7724    return length+1;
7725
7726  int i;
7727  int an = 0;
7728  int en= length;
7729
7730  loop
7731  {
7732    if (an >= en-1)
7733    {
7734      if (set[an].pLength>ol) return an;
7735      return en;
7736    }
7737    i=(an+en) / 2;
7738    if (set[i].pLength>ol) en=i;
7739    else                        an=i;
7740  }
7741}
7742#endif
7743
7744// kstd1.cc:
7745int redFirst (LObject* h,kStrategy strat);
7746int redEcart (LObject* h,kStrategy strat);
7747void enterSMora (LObject p,int atS,kStrategy strat, int atR=-1);
7748void enterSMoraNF (LObject p,int atS,kStrategy strat, int atR=-1);
7749// ../Singular/misc.cc:
7750extern char *  showOption();
7751
7752void kDebugPrint(kStrategy strat)
7753{
7754  PrintS("red: ");
7755    if (strat->red==redFirst) PrintS("redFirst\n");
7756    else if (strat->red==redHoney) PrintS("redHoney\n");
7757    else if (strat->red==redEcart) PrintS("redEcart\n");
7758    else if (strat->red==redHomog) PrintS("redHomog\n");
7759    else  Print("%p\n",(void*)strat->red);
7760  PrintS("posInT: ");
7761    if (strat->posInT==posInT0) PrintS("posInT0\n");
7762    else if (strat->posInT==posInT0) PrintS("posInT0\n");
7763    else if (strat->posInT==posInT1) PrintS("posInT1\n");
7764    else if (strat->posInT==posInT11) PrintS("posInT11\n");
7765    else if (strat->posInT==posInT110) PrintS("posInT110\n");
7766    else if (strat->posInT==posInT13) PrintS("posInT13\n");
7767    else if (strat->posInT==posInT15) PrintS("posInT15\n");
7768    else if (strat->posInT==posInT17) PrintS("posInT17\n");
7769    else if (strat->posInT==posInT17_c) PrintS("posInT17_c\n");
7770    else if (strat->posInT==posInT19) PrintS("posInT19\n");
7771    else if (strat->posInT==posInT2) PrintS("posInT2\n");
7772#ifdef HAVE_MORE_POS_IN_T
7773    else if (strat->posInT==posInT_EcartFDegpLength) PrintS("posInT_EcartFDegpLength\n");
7774    else if (strat->posInT==posInT_FDegpLength) PrintS("posInT_FDegpLength\n");
7775    else if (strat->posInT==posInT_pLength) PrintS("posInT_pLength\n");
7776#endif
7777    else if (strat->posInT==posInT_EcartpLength) PrintS("posInT_EcartpLength\n");
7778    else if (strat->posInT==posInTrg0) PrintS("posInTrg0\n");
7779    else  Print("%p\n",(void*)strat->posInT);
7780  PrintS("posInL: ");
7781    if (strat->posInL==posInL0) PrintS("posInL0\n");
7782    else if (strat->posInL==posInL10) PrintS("posInL10\n");
7783    else if (strat->posInL==posInL11) PrintS("posInL11\n");
7784    else if (strat->posInL==posInL110) PrintS("posInL110\n");
7785    else if (strat->posInL==posInL13) PrintS("posInL13\n");
7786    else if (strat->posInL==posInL15) PrintS("posInL15\n");
7787    else if (strat->posInL==posInL17) PrintS("posInL17\n");
7788    else if (strat->posInL==posInL17_c) PrintS("posInL17_c\n");
7789    else if (strat->posInL==posInLSpecial) PrintS("posInLSpecial\n");
7790    else if (strat->posInL==posInLrg0) PrintS("posInLrg0\n");
7791    else  Print("%p\n",(void*)strat->posInL);
7792  PrintS("enterS: ");
7793    if (strat->enterS==enterSBba) PrintS("enterSBba\n");
7794    else if (strat->enterS==enterSMora) PrintS("enterSMora\n");
7795    else if (strat->enterS==enterSMoraNF) PrintS("enterSMoraNF\n");
7796    else  Print("%p\n",(void*)strat->enterS);
7797  PrintS("initEcart: ");
7798    if (strat->initEcart==initEcartBBA) PrintS("initEcartBBA\n");
7799    else if (strat->initEcart==initEcartNormal) PrintS("initEcartNormal\n");
7800    else  Print("%p\n",(void*)strat->initEcart);
7801  PrintS("initEcartPair: ");
7802    if (strat->initEcartPair==initEcartPairBba) PrintS("initEcartPairBba\n");
7803    else if (strat->initEcartPair==initEcartPairMora) PrintS("initEcartPairMora\n");
7804    else  Print("%p\n",(void*)strat->initEcartPair);
7805  Print("homog=%d, LazyDegree=%d, LazyPass=%d, ak=%d,\n",
7806         strat->homog, strat->LazyDegree,strat->LazyPass, strat->ak);
7807  Print("honey=%d, sugarCrit=%d, Gebauer=%d, noTailReduction=%d, use_buckets=%d\n",
7808         strat->honey,strat->sugarCrit,strat->Gebauer,strat->noTailReduction,strat->use_buckets);
7809  Print("posInLDependsOnLength=%d, use_buckets=%d\n",
7810         strat->posInLDependsOnLength,strat->use_buckets);
7811  PrintS(showOption());PrintLn();
7812  PrintS("LDeg: ");
7813    if (currRing->pLDeg==pLDeg0) PrintS("pLDeg0");
7814    else if (currRing->pLDeg==pLDeg0c) PrintS("pLDeg0c");
7815    else if (currRing->pLDeg==pLDegb) PrintS("pLDegb");
7816    else if (currRing->pLDeg==pLDeg1) PrintS("pLDeg1");
7817    else if (currRing->pLDeg==pLDeg1c) PrintS("pLDeg1c");
7818    else if (currRing->pLDeg==pLDeg1_Deg) PrintS("pLDeg1_Deg");
7819    else if (currRing->pLDeg==pLDeg1c_Deg) PrintS("pLDeg1c_Deg");
7820    else if (currRing->pLDeg==pLDeg1_Totaldegree) PrintS("pLDeg1_Totaldegree");
7821    else if (currRing->pLDeg==pLDeg1c_Totaldegree) PrintS("pLDeg1c_Totaldegree");
7822    else if (currRing->pLDeg==pLDeg1_WFirstTotalDegree) PrintS("pLDeg1_WFirstTotalDegree");
7823    else if (currRing->pLDeg==pLDeg1c_WFirstTotalDegree) PrintS("pLDeg1c_WFirstTotalDegree");
7824    else if (currRing->pLDeg==maxdegreeWecart) PrintS("maxdegreeWecart");
7825    else Print("? (%lx)", (long)currRing->pLDeg);
7826    PrintS(" / ");
7827    if (strat->tailRing->pLDeg==pLDeg0) PrintS("pLDeg0");
7828    else if (strat->tailRing->pLDeg==pLDeg0c) PrintS("pLDeg0c");
7829    else if (strat->tailRing->pLDeg==pLDegb) PrintS("pLDegb");
7830    else if (strat->tailRing->pLDeg==pLDeg1) PrintS("pLDeg1");
7831    else if (strat->tailRing->pLDeg==pLDeg1c) PrintS("pLDeg1c");
7832    else if (strat->tailRing->pLDeg==pLDeg1_Deg) PrintS("pLDeg1_Deg");
7833    else if (strat->tailRing->pLDeg==pLDeg1c_Deg) PrintS("pLDeg1c_Deg");
7834    else if (strat->tailRing->pLDeg==pLDeg1_Totaldegree) PrintS("pLDeg1_Totaldegree");
7835    else if (strat->tailRing->pLDeg==pLDeg1c_Totaldegree) PrintS("pLDeg1c_Totaldegree");
7836    else if (strat->tailRing->pLDeg==pLDeg1_WFirstTotalDegree) PrintS("pLDeg1_WFirstTotalDegree");
7837    else if (strat->tailRing->pLDeg==pLDeg1c_WFirstTotalDegree) PrintS("pLDeg1c_WFirstTotalDegree");
7838    else if (strat->tailRing->pLDeg==maxdegreeWecart) PrintS("maxdegreeWecart");
7839    else Print("? (%lx)", (long)strat->tailRing->pLDeg);
7840    PrintLn();
7841  PrintS("currRing->pFDeg: ");
7842    if (currRing->pFDeg==p_Totaldegree) PrintS("p_Totaldegree");
7843    else if (currRing->pFDeg==p_WFirstTotalDegree) PrintS("pWFirstTotalDegree");
7844    else if (currRing->pFDeg==p_Deg) PrintS("p_Deg");
7845    else if (currRing->pFDeg==kHomModDeg) PrintS("kHomModDeg");
7846    else if (currRing->pFDeg==totaldegreeWecart) PrintS("totaldegreeWecart");
7847    else Print("? (%lx)", (long)currRing->pFDeg);
7848    PrintLn();
7849    Print(" syzring:%d, syzComp(strat):%d limit:%d\n",rIsSyzIndexRing(currRing),strat->syzComp,rGetCurrSyzLimit(currRing));
7850    if(TEST_OPT_DEGBOUND)
7851      Print(" degBound: %d\n", Kstd1_deg);
7852
7853}
7854
7855
7856#ifdef HAVE_SHIFTBBA
7857poly pMove2CurrTail(poly p, kStrategy strat)
7858{
7859  /* assume: p is completely in currRing */
7860  /* produces an object with LM in curring
7861     and TAIL in tailring */
7862  if (pNext(p)!=NULL)
7863  {
7864    pNext(p) = prMoveR(pNext(p), /* src */ currRing, /* dest */ strat->tailRing);
7865  }
7866  return(p);
7867}
7868#endif
7869
7870#ifdef HAVE_SHIFTBBA
7871poly pMoveCurrTail2poly(poly p, kStrategy strat)
7872{
7873  /* assume: p has  LM in curring and TAIL in tailring */
7874  /* convert it to complete currRing */
7875
7876  /* check that LM is in currRing */
7877  assume(p_LmCheckIsFromRing(p, currRing));
7878
7879  if (pNext(p)!=NULL)
7880  {
7881    pNext(p) = prMoveR(pNext(p), /* src */ strat->tailRing, /* dest */currRing);
7882  }
7883  return(p);
7884}
7885#endif
7886
7887#ifdef HAVE_SHIFTBBA
7888poly pCopyL2p(LObject H, kStrategy strat)
7889{
7890    /* restores a poly in currRing from LObject */
7891    LObject h = H;
7892    h.Copy();
7893    poly p;
7894    if (h.p == NULL)
7895    {
7896      if (h.t_p != NULL)
7897      {
7898         p = prMoveR(h.t_p, /* source ring: */ strat->tailRing, /* dest. ring: */ currRing);
7899        return(p);
7900      }
7901      else
7902      {
7903        /* h.tp == NULL -> the object is NULL */
7904        return(NULL);
7905      }
7906    }
7907    /* we're here if h.p != NULL */
7908    if (h.t_p == NULL)
7909    {
7910       /* then h.p is the whole poly in currRing */
7911       p = h.p;
7912      return(p);
7913    }
7914    /* we're here if h.p != NULL and h.t_p != NULL */
7915    // clean h.p, get poly from t_p
7916     pNext(h.p)=NULL;
7917     pDelete(&h.p);
7918     p = prMoveR(h.t_p, /* source ring: */ strat->tailRing,
7919                         /* dest. ring: */ currRing);
7920     // no need to clean h: we re-used the polys
7921    return(p);
7922}
7923#endif
7924
7925//LObject pCopyp2L(poly p, kStrategy strat)
7926//{
7927    /* creates LObject from the poly in currRing */
7928  /* actually put p into L.p and make L.t_p=NULL : does not work */
7929
7930//}
7931
7932// poly pCopyL2p(LObject H, kStrategy strat)
7933// {
7934//   /* restores a poly in currRing from LObject */
7935//   LObject h = H;
7936//   h.Copy();
7937//   poly p;
7938//   if (h.p == NULL)
7939//   {
7940//     if (h.t_p != NULL)
7941//     {
7942//       p = p_ShallowCopyDelete(h.t_p, (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
7943//       return(p);
7944//     }
7945//     else
7946//     {
7947//       /* h.tp == NULL -> the object is NULL */
7948//       return(NULL);
7949//     }
7950//   }
7951//   /* we're here if h.p != NULL */
7952
7953//   if (h.t_p == NULL)
7954//   {
7955//     /* then h.p is the whole poly in tailRing */
7956//     if (strat->tailBin != NULL && (pNext(h.p) != NULL))
7957//     {
7958//       p = p_ShallowCopyDelete(h.p, (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
7959//     }
7960//     return(p);
7961//   }
7962//   /* we're here if h.p != NULL and h.t_p != NULL */
7963//   p = pCopy(pHead(h.p)); // in currRing
7964//   if (strat->tailBin != NULL && (pNext(h.p) != NULL))
7965//   {
7966//     //    pNext(p) = p_ShallowCopyDelete(pNext(h.t_p), (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
7967//     poly pp = p_Copy(pNext(h.p), strat->tailRing);
7968//     //    poly p3 = p_Copy(pNext(h.p), currRing); // error
7969//       // p_ShallowCopyDelete(pNext(h.p), currRing, strat->tailBin); // the same as pp
7970//     poly p5 = p_ShallowCopyDelete(pNext(h.p), strat->tailRing, strat->tailBin);
7971//     pNext(p) = p_ShallowCopyDelete(h.t_p, strat->tailRing, strat->tailBin);
7972//     poly p4 = p_Copy(h.t_p, strat->tailRing);
7973//     //    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
7974//   }
7975//   //  pTest(p);
7976//   return(p);
7977// }
7978
7979#ifdef HAVE_SHIFTBBA
7980/* including the self pairs */
7981void updateSShift(kStrategy strat,int uptodeg,int lV)
7982{
7983  /* to use after updateS(toT=FALSE,strat) */
7984  /* fills T with shifted elt's of S */
7985  int i;
7986  LObject h;
7987  int atT = -1; // or figure out smth better
7988  strat->tl = -1; // init
7989  for (i=0; i<=strat->sl; i++)
7990  {
7991    memset(&h,0,sizeof(h));
7992    h.p =  strat->S[i]; // lm in currRing, tail in TR
7993    strat->initEcart(&h);
7994    h.sev = strat->sevS[i];
7995    h.t_p = NULL;
7996    h.GetTP(); // creates correct t_p
7997    /*puts the elements of S with their shifts to T*/
7998    //    int atT, int uptodeg, int lV)
7999    strat->S_2_R[i] = strat->tl + 1; // the el't with shift 0 will be inserted first
8000    // need a small check for above; we insert >=1 elements
8001    // insert this check into kTest_TS ?
8002    enterTShift(h,strat,atT,uptodeg,lV);
8003  }
8004  /* what about setting strat->tl? */
8005}
8006#endif
8007
8008#ifdef HAVE_SHIFTBBA
8009void initBuchMoraShift (ideal F,ideal Q,kStrategy strat)
8010{
8011  strat->interpt = BTEST1(OPT_INTERRUPT);
8012  strat->kHEdge=NULL;
8013  if (currRing->OrdSgn==1) strat->kHEdgeFound=FALSE;
8014  /*- creating temp data structures------------------- -*/
8015  strat->cp = 0;
8016  strat->c3 = 0;
8017  strat->cv = 0;
8018  strat->tail = pInit();
8019  /*- set s -*/
8020  strat->sl = -1;
8021  /*- set L -*/
8022  strat->Lmax = setmaxL;
8023  strat->Ll = -1;
8024  strat->L = initL();
8025  /*- set B -*/
8026  strat->Bmax = setmaxL;
8027  strat->Bl = -1;
8028  strat->B = initL();
8029  /*- set T -*/
8030  strat->tl = -1;
8031  strat->tmax = setmaxT;
8032  strat->T = initT();
8033  strat->R = initR();
8034  strat->sevT = initsevT();
8035  /*- init local data struct.---------------------------------------- -*/
8036  strat->P.ecart=0;
8037  strat->P.length=0;
8038  if (currRing->OrdSgn==-1)
8039  {
8040    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
8041    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
8042  }
8043  if(TEST_OPT_SB_1)
8044  {
8045    int i;
8046    ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
8047    for (i=strat->newIdeal;i<IDELEMS(F);i++)
8048    {
8049      P->m[i-strat->newIdeal] = F->m[i];
8050      F->m[i] = NULL;
8051    }
8052    initSSpecial(F,Q,P,strat);
8053    for (i=strat->newIdeal;i<IDELEMS(F);i++)
8054    {
8055      F->m[i] = P->m[i-strat->newIdeal];
8056      P->m[i-strat->newIdeal] = NULL;
8057    }
8058    idDelete(&P);
8059  }
8060  else
8061  {
8062    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
8063    // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
8064  }
8065  strat->fromT = FALSE;
8066  strat->noTailReduction = !TEST_OPT_REDTAIL;
8067  if (!TEST_OPT_SB_1)
8068  {
8069    /* the only change: we do not fill the set T*/
8070    updateS(FALSE,strat);
8071  }
8072  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
8073  strat->fromQ=NULL;
8074  /* more changes: fill the set T with all the shifts of elts of S*/
8075  /* is done by other procedure */
8076}
8077#endif
8078
8079#ifdef HAVE_SHIFTBBA
8080/*1
8081* put the pairs (sh \dot s[i],p)  into the set B, ecart=ecart(p)
8082*/
8083void enterOnePairManyShifts (int i, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int uptodeg, int lV)
8084{
8085  /* p comes from strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
8086
8087  assume(p_LmCheckIsFromRing(p,currRing));
8088  assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
8089
8090  /* cycles through all shifts of s[i] until uptodeg - lastVblock(s[i]) */
8091  /* that is create the pairs (f, s \dot g)  */
8092
8093  poly qq = strat->S[i]; //  lm in currRing, tail in tailRing
8094
8095  //  poly q = pCopy(pHead(strat->S[i])); // lm in currRing
8096  //  pNext(q) = prCopyR(pNext(strat->S[i]),strat->tailRing,currRing); // zero shift
8097
8098 /* determine how many elements we have to insert for a given s[i] */
8099  /* x(0)y(1)z(2) : lastVblock-1=2, to add until lastVblock=uptodeg-1 */
8100  /* hence, a total number of elt's to add is: */
8101  /*  int toInsert = 1 + (uptodeg-1) - (pLastVblock(p.p, lV) -1);  */
8102  int toInsert =  itoInsert(qq, uptodeg,  lV, strat->tailRing);
8103
8104#ifdef KDEBUG
8105    if (TEST_OPT_DEBUG)
8106    {
8107      //      Print("entered ManyShifts: with toInsert=%d",toInsert); PrintLn();
8108    }
8109#endif
8110
8111  assume(i<=strat->sl); // from OnePair
8112  if (strat->interred_flag) return; // ?
8113
8114  /* these vars hold for all shifts of s[i] */
8115  int ecartq = 0; //Hans says it's ok; we're in the homog case, no ecart
8116
8117  int qfromQ;
8118  if (strat->fromQ != NULL)
8119  {
8120    qfromQ = strat->fromQ[i];
8121  }
8122  else
8123  {
8124    qfromQ = -1;
8125  }
8126
8127  int j;
8128
8129  poly q, s;
8130
8131  // for the 0th shift: insert the orig. pair
8132  enterOnePairShift(qq, p, ecart, isFromQ, strat, -1, ecartq, qfromQ, 0, i, uptodeg, lV);
8133
8134  for (j=1; j<= toInsert; j++)
8135  {
8136    //    q = pLPshift(strat->S[i],j,uptodeg,lV);
8137    q = p_LPshiftT(qq, j, uptodeg, lV, strat, currRing);
8138    //    q = p_mLPshift(qq,j,uptodeg,lV,currRing); // lm in currRing, shift this monomial
8139    //    s = p_LPshift(pNext(qq), j, uptodeg, lV, strat->tailRing); // from tailRing
8140    //    pNext(q) = s; // in tailRing
8141    /* here we need to call enterOnePair with two polys ... */
8142
8143#ifdef KDEBUG
8144    if (TEST_OPT_DEBUG)
8145    {
8146      //      PrintS("ManyShifts: calling enterOnePairShift(q,p)");      PrintLn();
8147    }
8148#endif
8149    enterOnePairShift(q, p, ecart, isFromQ, strat, -1, ecartq, qfromQ, j, i, uptodeg, lV);
8150  }
8151}
8152#endif
8153
8154#ifdef HAVE_SHIFTBBA
8155/*1
8156* put the pairs (sh \dot qq,p)  into the set B, ecart=ecart(p)
8157* despite the name, not only self shifts
8158*/
8159void enterOnePairSelfShifts (poly qq, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int uptodeg, int lV)
8160{
8161
8162  /* format: p,qq are in LObject form: lm in CR, tail in TR */
8163  /* for true self pairs qq ==p  */
8164  /* we test both qq and p */
8165  assume(p_LmCheckIsFromRing(qq,currRing));
8166  assume(p_CheckIsFromRing(pNext(qq),strat->tailRing));
8167  assume(p_LmCheckIsFromRing(p,currRing));
8168  assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
8169
8170  /* since this proc is applied twice for (h, s*g) and (g,s*h), init j with 1 only */
8171
8172  //  int j = 0;
8173  int j = 1;
8174
8175  /* for such self pairs start with 1, not with 0 */
8176  if (qq == p) j=1;
8177
8178  /* should cycle through all shifts of q until uptodeg - lastVblock(q) */
8179  /* that is create the pairs (f, s \dot g)  */
8180
8181  int toInsert =  itoInsert(qq, uptodeg,  lV, strat->tailRing);
8182
8183#ifdef KDEBUG
8184    if (TEST_OPT_DEBUG)
8185    {
8186      //      Print("entered SelfShifts: with toInsert=%d",toInsert); PrintLn();
8187    }
8188#endif
8189
8190  poly q, s;
8191
8192  if (strat->interred_flag) return; // ?
8193
8194  /* these vars hold for all shifts of s[i] */
8195  int ecartq = 0; //Hans says it's ok; we're in the homog case, no ecart
8196  int qfromQ = 0; // strat->fromQ[i];
8197
8198  for (; j<= toInsert; j++)
8199  {
8200    //    q = pLPshift(strat->S[i],j,uptodeg,lV);
8201    /* we increase shifts by one; must delete q there*/
8202    //    q = qq; q = pMoveCurrTail2poly(q,strat);
8203    //    q = pLPshift(q,j,uptodeg,lV); //,currRing);
8204    q = p_LPshiftT(qq, j, uptodeg, lV, strat, currRing);
8205    //    q = p_mLPshift(qq,j,uptodeg,lV,currRing); // lm in currRing, shift this monomial
8206    //    s = p_LPshift(pNext(qq), j, uptodeg, lV, strat->tailRing); // from tailRing
8207    //    pNext(q) = s; // in tailRing
8208    /* here we need to call enterOnePair with two polys ... */
8209#ifdef KDEBUG
8210    if (TEST_OPT_DEBUG)
8211    {
8212      //      PrintS("SelfShifts: calling enterOnePairShift(q,p)");      PrintLn();
8213    }
8214#endif
8215    enterOnePairShift(q, p, ecart, isFromQ, strat, -1, ecartq, qfromQ, j, -1, uptodeg, lV);
8216  }
8217}
8218#endif
8219
8220#ifdef HAVE_SHIFTBBA
8221/*2
8222* put the pair (q,p)  into the set B, ecart=ecart(p), q is the shift of some s[i]
8223*/
8224void enterOnePairShift (poly q, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int ecartq, int qisFromQ, int shiftcount, int ifromS, int uptodeg, int lV)
8225{
8226
8227  /* Format: q and p are like strat->P.p, so lm in CR, tail in TR */
8228
8229  /* check this Formats: */
8230  assume(p_LmCheckIsFromRing(q,currRing));
8231  assume(p_CheckIsFromRing(pNext(q),strat->tailRing));
8232  assume(p_LmCheckIsFromRing(p,currRing));
8233  assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
8234
8235#ifdef KDEBUG
8236    if (TEST_OPT_DEBUG)
8237    {
8238//       PrintS("enterOnePairShift(q,p) invoked with q = ");
8239//       wrp(q); //      wrp(pHead(q));
8240//       PrintS(", p = ");
8241//       wrp(p); //wrp(pHead(p));
8242//       PrintLn();
8243    }
8244#endif
8245
8246  /* poly q stays for s[i], ecartq = ecart(q), qisFromQ = applies to q */
8247
8248  int qfromQ = qisFromQ;
8249
8250  /* need additionally: int up_to_degree, poly V0 with the variables in (0)  or just the number lV = the length of the first block */
8251
8252  if (strat->interred_flag) return;
8253
8254  int      l,j,compare;
8255  LObject  Lp;
8256  Lp.i_r = -1;
8257
8258#ifdef KDEBUG
8259  Lp.ecart=0; Lp.length=0;
8260#endif
8261  /*- computes the lcm(s[i],p) -*/
8262  Lp.lcm = pInit();
8263
8264  pLcm(p,q, Lp.lcm); // q is what was strat->S[i], so a poly in LM/TR presentation
8265  pSetm(Lp.lcm);
8266
8267  /* apply the V criterion */
8268  if (!isInV(Lp.lcm, lV))
8269  {
8270#ifdef KDEBUG
8271    if (TEST_OPT_DEBUG)
8272    {
8273      PrintS("V crit applied to q = ");
8274      wrp(q); //      wrp(pHead(q));
8275      PrintS(", p = ");
8276      wrp(p); //wrp(pHead(p));
8277      PrintLn();
8278    }
8279#endif
8280    pLmFree(Lp.lcm);
8281    Lp.lcm=NULL;
8282    /* + counter for applying the V criterion */
8283    strat->cv++;
8284    return;
8285  }
8286
8287  if (strat->sugarCrit && ALLOW_PROD_CRIT(strat))
8288  {
8289    if((!((ecartq>0)&&(ecart>0)))
8290    && pHasNotCF(p,q))
8291    {
8292    /*
8293    *the product criterion has applied for (s,p),
8294    *i.e. lcm(s,p)=product of the leading terms of s and p.
8295    *Suppose (s,r) is in L and the leading term
8296    *of p divides lcm(s,r)
8297    *(==> the leading term of p divides the leading term of r)
8298    *but the leading term of s does not divide the leading term of r
8299    *(notice that this condition is automatically satisfied if r is still
8300    *in S), then (s,r) can be cancelled.
8301    *This should be done here because the
8302    *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
8303    *
8304    *Moreover, skipping (s,r) holds also for the noncommutative case.
8305    */
8306      strat->cp++;
8307      pLmFree(Lp.lcm);
8308      Lp.lcm=NULL;
8309      return;
8310    }
8311    else
8312      Lp.ecart = si_max(ecart,ecartq);
8313    if (strat->fromT && (ecartq>ecart))
8314    {
8315      pLmFree(Lp.lcm);
8316      Lp.lcm=NULL;
8317      return;
8318      /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
8319    }
8320    /*
8321    *the set B collects the pairs of type (S[j],p)
8322    *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
8323    *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
8324    *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
8325    */
8326    {
8327      j = strat->Bl;
8328      loop
8329      {
8330        if (j < 0)  break;
8331        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
8332        if ((compare==1)
8333        &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
8334        {
8335          strat->c3++;
8336          if ((strat->fromQ==NULL) || (isFromQ==0) || (qfromQ==0))
8337          {
8338            pLmFree(Lp.lcm);
8339            return;
8340          }
8341          break;
8342        }
8343        else
8344        if ((compare ==-1)
8345        && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
8346        {
8347          deleteInL(strat->B,&strat->Bl,j,strat);
8348          strat->c3++;
8349        }
8350        j--;
8351      }
8352    }
8353  }
8354  else /*sugarcrit*/
8355  {
8356    if (ALLOW_PROD_CRIT(strat))
8357    {
8358      // if currRing->nc_type!=quasi (or skew)
8359      // TODO: enable productCrit for super commutative algebras...
8360      if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
8361      pHasNotCF(p,q))
8362      {
8363      /*
8364      *the product criterion has applied for (s,p),
8365      *i.e. lcm(s,p)=product of the leading terms of s and p.
8366      *Suppose (s,r) is in L and the leading term
8367      *of p devides lcm(s,r)
8368      *(==> the leading term of p devides the leading term of r)
8369      *but the leading term of s does not devide the leading term of r
8370      *(notice that tis condition is automatically satisfied if r is still
8371      *in S), then (s,r) can be canceled.
8372      *This should be done here because the
8373      *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
8374      */
8375          strat->cp++;
8376          pLmFree(Lp.lcm);
8377          Lp.lcm=NULL;
8378          return;
8379      }
8380      if (strat->fromT && (ecartq>ecart))
8381      {
8382        pLmFree(Lp.lcm);
8383        Lp.lcm=NULL;
8384        return;
8385        /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
8386      }
8387      /*
8388      *the set B collects the pairs of type (S[j],p)
8389      *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
8390      *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
8391      *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
8392      */
8393      for(j = strat->Bl;j>=0;j--)
8394      {
8395        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
8396        if (compare==1)
8397        {
8398          strat->c3++;
8399          if ((strat->fromQ==NULL) || (isFromQ==0) || (qfromQ==0))
8400          {
8401            pLmFree(Lp.lcm);
8402            return;
8403          }
8404          break;
8405        }
8406        else
8407        if (compare ==-1)
8408        {
8409          deleteInL(strat->B,&strat->Bl,j,strat);
8410          strat->c3++;
8411        }
8412      }
8413    }
8414  }
8415  /*
8416  *the pair (S[i],p) enters B if the spoly != 0
8417  */
8418  /*-  compute the short s-polynomial -*/
8419  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
8420    pNorm(p);
8421  if ((q==NULL) || (p==NULL))
8422    return;
8423  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (qfromQ!=0))
8424    Lp.p=NULL;
8425  else
8426  {
8427//     if ( rIsPluralRing(currRing) )
8428//     {
8429//       if(pHasNotCF(p, q))
8430//       {
8431//         if(ncRingType(currRing) == nc_lie)
8432//         {
8433//             // generalized prod-crit for lie-type
8434//             strat->cp++;
8435//             Lp.p = nc_p_Bracket_qq(pCopy(p),q, currRing);
8436//         }
8437//         else
8438//         if( ALLOW_PROD_CRIT(strat) )
8439//         {
8440//             // product criterion for homogeneous case in SCA
8441//             strat->cp++;
8442//             Lp.p = NULL;
8443//         }
8444//         else
8445//           Lp.p = nc_CreateSpoly(q,p,currRing); // ?
8446//       }
8447//       else  Lp.p = nc_CreateSpoly(q,p,currRing);
8448//     }
8449//     else
8450//     {
8451
8452    /* ksCreateShortSpoly needs two Lobject-kind presentations */
8453    /* p is already in this form, so convert q */
8454    //    q = pMove2CurrTail(q, strat);
8455    Lp.p = ksCreateShortSpoly(q, p, strat->tailRing);
8456      //  }
8457  }
8458  if (Lp.p == NULL)
8459  {
8460    /*- the case that the s-poly is 0 -*/
8461    /* TEMPORARILY DISABLED FOR SHIFTS because there is no i*/
8462//      if (strat->pairtest==NULL) initPairtest(strat);
8463//      strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
8464//      strat->pairtest[strat->sl+1] = TRUE;
8465    /* END _ TEMPORARILY DISABLED FOR SHIFTS */
8466    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
8467    /*
8468    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
8469    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
8470    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
8471    *term of p devides the lcm(s,r)
8472    *(this canceling should be done here because
8473    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
8474    *the first case is handeled in chainCrit
8475    */
8476    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
8477  }
8478  else
8479  {
8480    /*- the pair (S[i],p) enters B -*/
8481    /* both of them should have their LM in currRing and TAIL in tailring */
8482    Lp.p1 = q;  // already in the needed form
8483    Lp.p2 = p; // already in the needed form
8484
8485    if ( !rIsPluralRing(currRing) )
8486      pNext(Lp.p) = strat->tail;
8487
8488    /* TEMPORARILY DISABLED FOR SHIFTS because there's no i*/
8489    /* at the beginning we DO NOT set atR = -1 ANYMORE*/
8490    if ( (atR >= 0) && (shiftcount==0) && (ifromS >=0) )
8491    {
8492      Lp.i_r1 = kFindInT(Lp.p1,strat); //strat->S_2_R[ifromS];
8493      Lp.i_r2 = atR;
8494    }
8495    else
8496    {
8497      /* END _ TEMPORARILY DISABLED FOR SHIFTS */
8498      Lp.i_r1 = -1;
8499      Lp.i_r2 = -1;
8500     }
8501    strat->initEcartPair(&Lp,q,p,ecartq,ecart);
8502
8503    if (TEST_OPT_INTSTRATEGY)
8504    {
8505      if (!rIsPluralRing(currRing))
8506        nDelete(&(Lp.p->coef));
8507    }
8508
8509    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
8510    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
8511  }
8512}
8513#endif
8514
8515#ifdef HAVE_SHIFTBBA
8516/*2
8517*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
8518*superfluous elements in S will be deleted
8519*/
8520void enterpairsShift (poly h,int k,int ecart,int pos,kStrategy strat, int atR,int uptodeg, int lV)
8521{
8522  /* h is strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
8523  /* Q: what is exactly the strat->fromT ? A: a local case trick; don't need it yet*/
8524  int j=pos;
8525
8526#ifdef HAVE_RINGS
8527  assume (!rField_is_Ring(currRing));
8528#endif
8529  initenterpairsShift(h,k,ecart,0,strat, atR,uptodeg,lV);
8530  if ( (!strat->fromT)
8531  && ((strat->syzComp==0)
8532    ||(pGetComp(h)<=strat->syzComp)))
8533  {
8534    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
8535    unsigned long h_sev = pGetShortExpVector(h);
8536    loop
8537    {
8538      if (j > k) break;
8539      clearS(h,h_sev, &j,&k,strat);
8540      j++;
8541    }
8542    //Print("end clearS sl=%d\n",strat->sl);
8543  }
8544 // PrintS("end enterpairs\n");
8545}
8546#endif
8547
8548#ifdef HAVE_SHIFTBBA
8549/*3
8550*(s[0], s \dot h),...,(s[k],s \dot h) will be put to the pairset L
8551* also the pairs (h, s\dot s[0]), ..., (h, s\dot s[k]) enter L
8552* additionally we put the pairs (h, s \sdot h) for s>=1 to L
8553*/
8554void initenterpairsShift (poly h,int k,int ecart,int isFromQ, kStrategy strat, int atR, int uptodeg, int lV)
8555{
8556  /* h comes from strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
8557  //  atR = -1;
8558  if ((strat->syzComp==0)
8559  || (pGetComp(h)<=strat->syzComp))
8560  {
8561    int j;
8562    BOOLEAN new_pair=FALSE;
8563
8564    if (pGetComp(h)==0)
8565    {
8566      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
8567      if ((isFromQ)&&(strat->fromQ!=NULL))
8568      {
8569        for (j=0; j<=k; j++)
8570        {
8571          if (!strat->fromQ[j])
8572          {
8573            new_pair=TRUE;
8574            enterOnePairManyShifts(j,h,ecart,isFromQ,strat, atR,uptodeg,lV);
8575            // other side pairs:
8576            enterOnePairSelfShifts(h,strat->S[j],ecart,isFromQ,strat, atR,uptodeg,lV);
8577          //Print("j:%d, Ll:%d\n",j,strat->Ll);
8578          }
8579        }
8580      }
8581      else
8582      {
8583        new_pair=TRUE;
8584        for (j=0; j<=k; j++)
8585        {
8586          enterOnePairManyShifts(j,h,ecart,isFromQ,strat, atR,uptodeg,lV);
8587          // other side pairs
8588          enterOnePairSelfShifts(h,strat->S[j],ecart,isFromQ,strat, atR,uptodeg,lV);
8589        }
8590        /* HERE we put (h, s*h) pairs */
8591       /* enterOnePairSelfShifts (poly qq, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int uptodeg, int lV); */
8592       enterOnePairSelfShifts (h, h, ecart, isFromQ, strat, atR, uptodeg, lV);
8593      }
8594    }
8595    else
8596    {
8597      for (j=0; j<=k; j++)
8598      {
8599        if ((pGetComp(h)==pGetComp(strat->S[j]))
8600        || (pGetComp(strat->S[j])==0))
8601        {
8602          new_pair=TRUE;
8603          enterOnePairManyShifts(j,h,ecart,isFromQ,strat, atR, uptodeg, lV);
8604          // other side pairs
8605          enterOnePairSelfShifts(h,strat->S[j],ecart,isFromQ,strat, atR,uptodeg,lV);
8606        //Print("j:%d, Ll:%d\n",j,strat->Ll);
8607        }
8608      }
8609      /* HERE we put (h, s*h) pairs */
8610      enterOnePairSelfShifts (h, h, ecart, isFromQ, strat, atR, uptodeg, lV);
8611    }
8612
8613    if (new_pair)
8614    {
8615      strat->chainCrit(h,ecart,strat);
8616    }
8617
8618  }
8619}
8620#endif
8621
8622#ifdef HAVE_SHIFTBBA
8623/*2
8624* puts p to the set T, starting with the at position atT
8625* and inserts all admissible shifts of p
8626*/
8627void enterTShift(LObject p, kStrategy strat, int atT, int uptodeg, int lV)
8628{
8629  /* determine how many elements we have to insert */
8630  /* x(0)y(1)z(2) : lastVblock-1=2, to add until lastVblock=uptodeg-1 */
8631  /* hence, a total number of elt's to add is: */
8632  /*  int toInsert = 1 + (uptodeg-1) - (pLastVblock(p.p, lV) -1);  */
8633
8634  int toInsert =  itoInsert(p.p, uptodeg,  lV, strat->tailRing);
8635
8636#ifdef PDEBUG
8637  //  Print("enterTShift uses toInsert: %d", toInsert);  PrintLn();
8638#endif
8639  int i;
8640
8641  if (atT < 0)
8642    atT = strat->posInT(strat->T, strat->tl, p);
8643
8644  /* can call enterT in a sequence, e.g. */
8645
8646  /* shift0 = it's our model for further shifts */
8647  enterT(p,strat,atT);
8648  LObject qq;
8649  for (i=1; i<=toInsert; i++) // toIns - 1?
8650  {
8651    qq      = p; //qq.Copy();
8652    qq.p    = NULL;
8653    qq.max  = NULL;
8654    qq.t_p = p_LPshift(p_Copy(p.t_p,strat->tailRing), i, uptodeg, lV, strat->tailRing); // direct shift
8655    qq.GetP();
8656    // update q.sev
8657    qq.sev = pGetShortExpVector(qq.p);
8658    /* enter it into T, first el't is with the shift 0 */
8659    // compute the position for qq
8660    atT = strat->posInT(strat->T, strat->tl, qq);
8661    enterT(qq,strat,atT);
8662  }
8663/* Q: what to do with this one in the orig enterT ? */
8664/*  strat->R[strat->tl] = &(strat->T[atT]); */
8665/* Solution: it is done by enterT each time separately */
8666}
8667#endif
8668
8669#ifdef HAVE_SHIFTBBA
8670poly redtailBbaShift (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
8671{
8672  /* for the shift case need to run it with withT = TRUE */
8673  strat->redTailChange=FALSE;
8674  if (strat->noTailReduction) return L->GetLmCurrRing();
8675  poly h, p;
8676  p = h = L->GetLmTailRing();
8677  if ((h==NULL) || (pNext(h)==NULL))
8678    return L->GetLmCurrRing();
8679
8680  TObject* With;
8681  // placeholder in case strat->tl < 0
8682  TObject  With_s(strat->tailRing);
8683
8684  LObject Ln(pNext(h), strat->tailRing);
8685  Ln.pLength = L->GetpLength() - 1;
8686
8687  pNext(h) = NULL;
8688  if (L->p != NULL) pNext(L->p) = NULL;
8689  L->pLength = 1;
8690
8691  Ln.PrepareRed(strat->use_buckets);
8692
8693  while(!Ln.IsNull())
8694  {
8695    loop
8696    {
8697      Ln.SetShortExpVector();
8698      if (withT)
8699      {
8700        int j;
8701        j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
8702        if (j < 0) break;
8703        With = &(strat->T[j]);
8704      }
8705      else
8706      {
8707        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
8708        if (With == NULL) break;
8709      }
8710      if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
8711      {
8712        With->pNorm();
8713        //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
8714      }
8715      strat->redTailChange=TRUE;
8716      if (ksReducePolyTail(L, With, &Ln))
8717      {
8718        // reducing the tail would violate the exp bound
8719        //  set a flag and hope for a retry (in bba)
8720        strat->completeReduce_retry=TRUE;
8721        if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
8722        do
8723        {
8724          pNext(h) = Ln.LmExtractAndIter();
8725          pIter(h);
8726          L->pLength++;
8727        } while (!Ln.IsNull());
8728        goto all_done;
8729      }
8730      if (Ln.IsNull()) goto all_done;
8731      if (! withT) With_s.Init(currRing);
8732    }
8733    pNext(h) = Ln.LmExtractAndIter();
8734    pIter(h);
8735    L->pLength++;
8736  }
8737
8738  all_done:
8739  Ln.Delete();
8740  if (L->p != NULL) pNext(L->p) = pNext(p);
8741
8742  if (strat->redTailChange)
8743  {
8744    L->last = NULL;
8745    L->length = 0;
8746  }
8747  L->Normalize(); // HANNES: should have a test
8748  kTest_L(L);
8749  return L->GetLmCurrRing();
8750}
8751#endif
Note: See TracBrowser for help on using the repository browser.