source: git/kernel/kutil.cc @ f23590

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