source: git/kernel/kutil.cc @ 286273

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