source: git/kernel/kutil.cc @ 228e0b

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