source: git/kernel/kutil.cc @ 06f49a

spielwiese
Last change on this file since 06f49a was 06f49a, checked in by Hans Schönemann <hannes@…>, 15 years ago
*hannes: which to red. in completeReduce git-svn-id: file:///usr/local/Singular/svn/trunk@11747 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 186.9 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kutil.cc,v 1.136 2009-04-23 17:39:31 Singular Exp $ */
5/*
6* ABSTRACT: kernel: utils for kStd
7*/
8
9// #define PDEBUG 2
10// #define PDIV_DEBUG
11#define KUTIL_CC
12#include <stdlib.h>
13#include <string.h>
14#include "mod2.h"
15#include <mylimits.h>
16#include "structs.h"
17#include "gring.h"
18#include "sca.h"
19#ifdef KDEBUG
20#undef KDEBUG
21#define KDEBUG 2
22#endif
23
24#ifdef HAVE_RING2TOM
25#include "ideals.h"
26#endif
27
28// define if enterL, enterT should use memmove instead of doing it manually
29// on topgun, this is slightly faster (see monodromy_l.tst, homog_gonnet.sing)
30#ifndef SunOS_4
31#define ENTER_USE_MEMMOVE
32#endif
33
34// define, if the my_memmove inlines should be used instead of
35// system memmove -- it does not seem to pay off, though
36// #define ENTER_USE_MYMEMMOVE
37
38#include "kutil.h"
39#include "kbuckets.h"
40#include "febase.h"
41#include "omalloc.h"
42#include "numbers.h"
43#include "polys.h"
44#include "ring.h"
45#include "ideals.h"
46#include "timer.h"
47//#include "cntrlc.h"
48#include "stairc.h"
49#include "kstd1.h"
50#include "pShallowCopyDelete.h"
51
52/* shiftgb stuff */
53#include "shiftgb.h"
54#include "prCopy.h"
55
56#ifdef HAVE_RATGRING
57#include "ratgring.h"
58#endif
59
60#ifdef KDEBUG
61#undef KDEBUG
62#define KDEBUG 2
63#endif
64
65
66#ifdef ENTER_USE_MYMEMMOVE
67inline void _my_memmove_d_gt_s(unsigned long* d, unsigned long* s, long l)
68{
69  register unsigned long* _dl = (unsigned long*) d;
70  register unsigned long* _sl = (unsigned long*) s;
71  register long _i = l - 1;
72
73  do
74  {
75    _dl[_i] = _sl[_i];
76    _i--;
77  }
78  while (_i >= 0);
79}
80
81inline void _my_memmove_d_lt_s(unsigned long* d, unsigned long* s, long l)
82{
83  register long _ll = l;
84  register unsigned long* _dl = (unsigned long*) d;
85  register unsigned long* _sl = (unsigned long*) s;
86  register long _i = 0;
87
88  do
89  {
90    _dl[_i] = _sl[_i];
91    _i++;
92  }
93  while (_i < _ll);
94}
95
96inline void _my_memmove(void* d, void* s, long l)
97{
98  unsigned long _d = (unsigned long) d;
99  unsigned long _s = (unsigned long) s;
100  unsigned long _l = ((l) + SIZEOF_LONG - 1) >> LOG_SIZEOF_LONG;
101
102  if (_d > _s) _my_memmove_d_gt_s(_d, _s, _l);
103  else _my_memmove_d_lt_s(_d, _s, _l);
104}
105
106#undef memmove
107#define memmove(d,s,l) _my_memmove(d, s, l)
108#endif
109
110static poly redMora (poly h,int maxIndex,kStrategy strat);
111static poly redBba (poly h,int maxIndex,kStrategy strat);
112
113#ifdef HAVE_RINGS
114#define pDivComp_EQUAL 2
115#define pDivComp_LESS 1
116#define pDivComp_GREATER -1
117#define pDivComp_INCOMP 0
118/* Checks the relation of LM(p) and LM(q)
119     LM(p) = LM(q) => return pDivComp_EQUAL
120     LM(p) | LM(q) => return pDivComp_LESS
121     LM(q) | LM(p) => return pDivComp_GREATER
122     else return pDivComp_INCOMP */
123static inline int pDivCompRing(poly p, poly q)
124{
125  if (pGetComp(p) == pGetComp(q))
126  {
127    BOOLEAN a=FALSE, b=FALSE;
128    int i;
129    unsigned long la, lb;
130    unsigned long divmask = currRing->divmask;
131    for (i=0; i<currRing->VarL_Size; i++)
132    {
133      la = p->exp[currRing->VarL_Offset[i]];
134      lb = q->exp[currRing->VarL_Offset[i]];
135      if (la != lb)
136      {
137        if (la < lb)
138        {
139          if (b) return pDivComp_INCOMP;
140          if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
141            return pDivComp_INCOMP;
142          a = TRUE;
143        }
144        else
145        {
146          if (a) return pDivComp_INCOMP;
147          if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
148            return pDivComp_INCOMP;
149          b = TRUE;
150        }
151      }
152    }
153    if (a) return pDivComp_LESS;
154    if (b) return pDivComp_GREATER;
155    if (!a & !b) return pDivComp_EQUAL;
156  }
157  return 0;
158}
159#endif
160
161static inline int pDivComp(poly p, poly q)
162{
163  if (pGetComp(p) == pGetComp(q))
164  {
165#ifdef HAVE_RATGRING
166    if (rIsRatGRing(currRing))
167    {
168      if (_p_LmDivisibleByPart(p,currRing,
169                           q,currRing,
170                           currRing->real_var_start, currRing->real_var_end))
171        return 0;
172      return pLmCmp(q,p); // ONLY FOR GLOBAL ORDER!
173    }
174#endif
175    BOOLEAN a=FALSE, b=FALSE;
176    int i;
177    unsigned long la, lb;
178    unsigned long divmask = currRing->divmask;
179    for (i=0; i<currRing->VarL_Size; i++)
180    {
181      la = p->exp[currRing->VarL_Offset[i]];
182      lb = q->exp[currRing->VarL_Offset[i]];
183      if (la != lb)
184      {
185        if (la < lb)
186        {
187          if (b) return 0;
188          if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
189            return 0;
190          a = TRUE;
191        }
192        else
193        {
194          if (a) return 0;
195          if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
196            return 0;
197          b = TRUE;
198        }
199      }
200    }
201    if (a) { /*assume(pLmCmp(q,p)==1);*/ return 1; }
202    if (b) { /*assume(pLmCmp(q,p)==-1);*/return -1; }
203    /*assume(pLmCmp(q,p)==0);*/
204  }
205  return 0;
206}
207
208
209BITSET  test=(BITSET)0;
210int     HCord;
211int     Kstd1_deg;
212int     mu=32000;
213
214/*2
215*deletes higher monomial of p, re-compute ecart and length
216*works only for orderings with ecart =pFDeg(end)-pFDeg(start)
217*/
218void deleteHC(LObject *L, kStrategy strat, BOOLEAN fromNext)
219{
220  if (strat->kHEdgeFound)
221  {
222    kTest_L(L);
223    poly p1;
224    poly p = L->GetLmTailRing();
225    int l = 1;
226    kBucket_pt bucket = NULL;
227    if (L->bucket != NULL)
228    {
229      kBucketClear(L->bucket, &pNext(p), &L->pLength);
230      L->pLength++;
231      bucket = L->bucket;
232      L->bucket = NULL;
233      L->last = NULL;
234    }
235
236    if (!fromNext && p_Cmp(p,strat->kNoetherTail(), L->tailRing) == -1)
237    {
238      L->Delete();
239      L->Clear();
240      L->ecart = -1;
241      if (bucket != NULL) kBucketDestroy(&bucket);
242      return;
243    }
244    p1 = p;
245    while (pNext(p1)!=NULL)
246    {
247      if (p_LmCmp(pNext(p1), strat->kNoetherTail(), L->tailRing) == -1)
248      {
249        L->last = p1;
250        p_Delete(&pNext(p1), L->tailRing);
251        if (p1 == p)
252        {
253          if (L->t_p != NULL)
254          {
255            assume(L->p != NULL && p == L->t_p);
256            pNext(L->p) = NULL;
257          }
258          L->max  = NULL;
259        }
260        else if (fromNext)
261          L->max  = p_GetMaxExpP(pNext(L->p), L->tailRing ); // p1;
262        //if (L->pLength != 0)
263        L->pLength = l;
264        // Hmmm when called from updateT, then only
265        // reset ecart when cut
266        if (fromNext)
267          L->ecart = L->pLDeg() - L->GetpFDeg();
268        break;
269      }
270      l++;
271      pIter(p1);
272    }
273    if (! fromNext)
274    {
275      L->SetpFDeg();
276      L->ecart = L->pLDeg(strat->LDegLast) - L->GetpFDeg();
277    }
278    if (bucket != NULL)
279    {
280      if (L->pLength > 1)
281      {
282        kBucketInit(bucket, pNext(p), L->pLength - 1);
283        pNext(p) = NULL;
284        if (L->t_p != NULL) pNext(L->t_p) = NULL;
285        L->pLength = 0;
286        L->bucket = bucket;
287        L->last = NULL;
288      }
289      else
290        kBucketDestroy(&bucket);
291    }
292    kTest_L(L);
293  }
294}
295
296void deleteHC(poly* p, int* e, int* l,kStrategy strat)
297{
298  LObject L(*p, currRing, strat->tailRing);
299
300  deleteHC(&L, strat);
301  *p = L.p;
302  *e = L.ecart;
303  *l = L.length;
304  if (L.t_p != NULL) p_LmFree(L.t_p, strat->tailRing);
305}
306
307/*2
308*tests if p.p=monomial*unit and cancels the unit
309*/
310void cancelunit (LObject* L,BOOLEAN inNF)
311{
312  int  i;
313  poly h;
314
315  if(rHasGlobalOrdering_currRing()) return;
316  if(TEST_OPT_CANCELUNIT) return;
317
318  ring r = L->tailRing;
319  poly p = L->GetLmTailRing();
320
321#ifdef HAVE_RINGS_LOC
322  // Leading coef have to be a unit
323  if ( !(nIsUnit(p_GetCoeff(p, r))) ) return;
324#endif
325
326  if(p_GetComp(p, r) != 0 && !p_OneComp(p, r)) return;
327
328  if (L->ecart != 0)
329  {
330//    for(i=r->N;i>0;i--)
331//    {
332//      if ((p_GetExp(p,i,r)>0) && (rIsPolyVar(i, r)==TRUE)) return;
333//    }
334    h = pNext(p);
335    loop
336    {
337      if (h==NULL)
338      {
339        p_Delete(&pNext(p), r);
340        if (!inNF)
341        {
342          number eins=nInit(1);
343          if (L->p != NULL)  pSetCoeff(L->p,eins);
344          else if (L->t_p != NULL) nDelete(&pGetCoeff(L->t_p));
345          if (L->t_p != NULL) pSetCoeff0(L->t_p,eins);
346        }
347        L->ecart = 0;
348        L->length = 1;
349        //if (L->pLength > 0)
350        L->pLength = 1;
351        if (L->last != NULL) L->last = p;
352
353        if (L->t_p != NULL && pNext(L->t_p) != NULL)
354          pNext(L->t_p) = NULL;
355        if (L->p != NULL && pNext(L->p) != NULL)
356          pNext(L->p) = NULL;
357        return;
358      }
359      i = 0;
360      loop
361      {
362        i++;
363        if (p_GetExp(p,i,r) > p_GetExp(h,i,r)) return ; // does not divide
364        if (i == r->N) break; // does divide, try next monom
365      }
366      pIter(h);
367    }
368  }
369}
370
371/*2
372*pp is the new element in s
373*returns TRUE (in strat->kHEdgeFound) if
374*-HEcke is allowed
375*-we are in the last componente of the vector
376*-on all axis are monomials (all elements in NotUsedAxis are FALSE)
377*returns FALSE for pLexOrderings,
378*assumes in module case an ordering of type c* !!
379* HEckeTest is only called with strat->kHEdgeFound==FALSE !
380*/
381void HEckeTest (poly pp,kStrategy strat)
382{
383  int   j,k,p;
384
385  strat->kHEdgeFound=FALSE;
386  if (pLexOrder || currRing->MixedOrder)
387  {
388    return;
389  }
390  if (strat->ak > 1)           /*we are in the module case*/
391  {
392    return; // until ....
393    //if (!pVectorOut)     /*pVectorOut <=> order = c,* */
394    //  return FALSE;
395    //if (pGetComp(pp) < strat->ak) /* ak is the number of the last component */
396    //  return FALSE;
397  }
398  k = 0;
399  p=pIsPurePower(pp);
400  if (p!=0) strat->NotUsedAxis[p] = FALSE;
401  /*- the leading term of pp is a power of the p-th variable -*/
402  for (j=pVariables;j>0; j--)
403  {
404    if (strat->NotUsedAxis[j])
405    {
406      return;
407    }
408  }
409  strat->kHEdgeFound=TRUE;
410}
411
412/*2
413*utilities for TSet, LSet
414*/
415inline static intset initec (const int maxnr)
416{
417  return (intset)omAlloc(maxnr*sizeof(int));
418}
419
420inline static unsigned long* initsevS (const int maxnr)
421{
422  return (unsigned long*)omAlloc0(maxnr*sizeof(unsigned long));
423}
424inline static int* initS_2_R (const int maxnr)
425{
426  return (int*)omAlloc0(maxnr*sizeof(int));
427}
428
429static inline void enlargeT (TSet &T, TObject** &R, unsigned long* &sevT,
430                             int &length, const int incr)
431{
432  assume(T!=NULL);
433  assume(sevT!=NULL);
434  assume(R!=NULL);
435  assume((length+incr) > 0);
436
437  int i;
438  T = (TSet)omRealloc0Size(T, length*sizeof(TObject),
439                           (length+incr)*sizeof(TObject));
440
441  sevT = (unsigned long*) omReallocSize(sevT, length*sizeof(long*),
442                           (length+incr)*sizeof(long*));
443
444  R = (TObject**)omRealloc0Size(R,length*sizeof(TObject*),
445                                (length+incr)*sizeof(TObject*));
446  for (i=length-1;i>=0;i--) R[T[i].i_r] = &(T[i]);
447  length += incr;
448}
449
450void cleanT (kStrategy strat)
451{
452  int i,j;
453  poly  p;
454  assume(currRing == strat->tailRing || strat->tailRing != NULL);
455
456  pShallowCopyDeleteProc p_shallow_copy_delete =
457    (strat->tailRing != currRing ?
458     pGetShallowCopyDeleteProc(strat->tailRing, currRing) :
459     NULL);
460
461  for (j=0; j<=strat->tl; j++)
462  {
463    p = strat->T[j].p;
464    strat->T[j].p=NULL;
465    if (strat->T[j].max != NULL)
466    {
467      p_LmFree(strat->T[j].max, strat->tailRing);
468    }
469    i = -1;
470    loop
471    {
472      i++;
473      if (i>strat->sl)
474      {
475        if (strat->T[j].t_p != NULL)
476        {
477          p_Delete(&(strat->T[j].t_p), strat->tailRing);
478          p_LmFree(p, currRing);
479        }
480        else
481          pDelete(&p);
482        break;
483      }
484      if (p == strat->S[i])
485      {
486        if (strat->T[j].t_p != NULL)
487        {
488          assume(p_shallow_copy_delete != NULL);
489          pNext(p) = p_shallow_copy_delete(pNext(p),strat->tailRing,currRing,
490                                           currRing->PolyBin);
491          p_LmFree(strat->T[j].t_p, strat->tailRing);
492        }
493        break;
494      }
495    }
496  }
497  strat->tl=-1;
498}
499
500//LSet initL ()
501//{
502//  int i;
503//  LSet l = (LSet)omAlloc(setmaxL*sizeof(LObject));
504//  return l;
505//}
506
507static inline void enlargeL (LSet* L,int* length,const int incr)
508{
509  assume((*L)!=NULL);
510  assume((length+incr)>0);
511
512  *L = (LSet)omReallocSize((*L),(*length)*sizeof(LObject),
513                                   ((*length)+incr)*sizeof(LObject));
514  (*length) += incr;
515}
516
517void initPairtest(kStrategy strat)
518{
519  strat->pairtest = (BOOLEAN *)omAlloc0((strat->sl+2)*sizeof(BOOLEAN));
520}
521
522/*2
523*test whether (p1,p2) or (p2,p1) is in L up position length
524*it returns TRUE if yes and the position k
525*/
526BOOLEAN isInPairsetL(int length,poly p1,poly p2,int*  k,kStrategy strat)
527{
528  LObject *p=&(strat->L[length]);
529
530  *k = length;
531  loop
532  {
533    if ((*k) < 0) return FALSE;
534    if (((p1 == (*p).p1) && (p2 == (*p).p2))
535    ||  ((p1 == (*p).p2) && (p2 == (*p).p1)))
536      return TRUE;
537    (*k)--;
538    p--;
539  }
540}
541
542/*2
543*in B all pairs have the same element p on the right
544*it tests whether (q,p) is in B and returns TRUE if yes
545*and the position k
546*/
547BOOLEAN isInPairsetB(poly q,int*  k,kStrategy strat)
548{
549  LObject *p=&(strat->B[strat->Bl]);
550
551  *k = strat->Bl;
552  loop
553  {
554    if ((*k) < 0) return FALSE;
555    if (q == (*p).p1)
556      return TRUE;
557    (*k)--;
558    p--;
559  }
560}
561
562int kFindInT(poly p, TSet T, int tlength)
563{
564  int i;
565
566  for (i=0; i<=tlength; i++)
567  {
568    if (T[i].p == p) return i;
569  }
570  return -1;
571}
572
573int kFindInT(poly p, kStrategy strat)
574{
575  int i;
576  do
577  {
578    i = kFindInT(p, strat->T, strat->tl);
579    if (i >= 0) return i;
580    strat = strat->next;
581  }
582  while (strat != NULL);
583  return -1;
584}
585
586#ifdef KDEBUG
587
588void sTObject::wrp()
589{
590  if (t_p != NULL) p_wrp(t_p, tailRing);
591  else if (p != NULL) p_wrp(p, currRing, tailRing);
592  else ::wrp(NULL);
593}
594
595#define kFalseReturn(x) do { if (!x) return FALSE;} while (0)
596
597// check that Lm's of a poly from T are "equal"
598static const char* kTest_LmEqual(poly p, poly t_p, ring tailRing)
599{
600  int i;
601  for (i=1; i<=tailRing->N; i++)
602  {
603    if (p_GetExp(p, i, currRing) != p_GetExp(t_p, i, tailRing))
604      return "Lm[i] different";
605  }
606  if (p_GetComp(p, currRing) != p_GetComp(t_p, tailRing))
607    return "Lm[0] different";
608  if (pNext(p) != pNext(t_p))
609    return "Lm.next different";
610  if (pGetCoeff(p) != pGetCoeff(t_p))
611    return "Lm.coeff different";
612  return NULL;
613}
614
615static BOOLEAN sloppy_max = FALSE;
616BOOLEAN kTest_T(TObject * T, ring strat_tailRing, int i, char TN)
617{
618  ring tailRing = T->tailRing;
619  if (strat_tailRing == NULL) strat_tailRing = tailRing;
620  r_assume(strat_tailRing == tailRing);
621
622  poly p = T->p;
623  ring r = currRing;
624
625  if (T->p == NULL && T->t_p == NULL && i >= 0)
626    return dReportError("%c[%d].poly is NULL", TN, i);
627
628  if (T->tailRing != currRing)
629  {
630    if (T->t_p == NULL && i > 0)
631      return dReportError("%c[%d].t_p is NULL", TN, i);
632    pFalseReturn(p_Test(T->t_p, T->tailRing));
633    if (T->p != NULL) pFalseReturn(p_LmTest(T->p, currRing));
634    if (T->p != NULL && T->t_p != NULL)
635    {
636      const char* msg = kTest_LmEqual(T->p, T->t_p, T->tailRing);
637      if (msg != NULL)
638        return dReportError("%c[%d] %s", TN, i, msg);
639      r = T->tailRing;
640      p = T->t_p;
641    }
642    if (T->p == NULL)
643    {
644      p = T->t_p;
645      r = T->tailRing;
646    }
647    if (T->t_p != NULL && i >= 0 && TN == 'T')
648    {
649      if (pNext(T->t_p) == NULL)
650      {
651        if (T->max != NULL)
652          return dReportError("%c[%d].max is not NULL as it should be", TN, i);
653      }
654      else
655      {
656        if (T->max == NULL)
657          return dReportError("%c[%d].max is NULL", TN, i);
658        if (pNext(T->max) != NULL)
659          return dReportError("pNext(%c[%d].max) != NULL", TN, i);
660
661        pFalseReturn(p_CheckPolyRing(T->max, tailRing));
662        omCheckBinAddrSize(T->max, (tailRing->PolyBin->sizeW)*SIZEOF_LONG);
663#if KDEBUG > 0
664        if (! sloppy_max)
665        {
666          poly test_max = p_GetMaxExpP(pNext(T->t_p), tailRing);
667          p_Setm(T->max, tailRing);
668          p_Setm(test_max, tailRing);
669          BOOLEAN equal = p_ExpVectorEqual(T->max, test_max, tailRing);
670          if (! equal)
671            return dReportError("%c[%d].max out of sync", TN, i);
672          p_LmFree(test_max, tailRing);
673        }
674#endif
675      }
676    }
677  }
678  else
679  {
680    if (T->max != NULL)
681      return dReportError("%c[%d].max != NULL but tailRing == currRing",TN,i);
682    if (T->t_p != NULL)
683      return dReportError("%c[%d].t_p != NULL but tailRing == currRing",TN,i);
684    if (T->p == NULL && i > 0)
685      return dReportError("%c[%d].p is NULL", TN, i);
686    pFalseReturn(p_Test(T->p, currRing));
687  }
688
689  if (i >= 0 && T->pLength != 0 && T->pLength != pLength(p))
690  {
691    int l=T->pLength;
692    T->pLength=pLength(p);
693    return dReportError("%c[%d] pLength error: has %d, specified to have %d",
694                        TN, i , pLength(p), l);
695  }
696
697  // check FDeg,  for elements in L and T
698  if (i >= 0 && (TN == 'T' || TN == 'L'))
699  {
700    // FDeg has ir element from T of L set
701    if (T->FDeg  != T->pFDeg())
702    {
703      int d=T->FDeg;
704      T->FDeg=T->pFDeg();
705      return dReportError("%c[%d] FDeg error: has %d, specified to have %d",
706                          TN, i , T->pFDeg(), d);
707    }
708  }
709
710  // check is_normalized for elements in T
711  if (i >= 0 && TN == 'T')
712  {
713    if (T->is_normalized && ! nIsOne(pGetCoeff(p)))
714      return dReportError("T[%d] is_normalized error", i);
715
716  }
717  return TRUE;
718}
719
720BOOLEAN kTest_L(LObject *L, ring strat_tailRing,
721                BOOLEAN testp, int lpos, TSet T, int tlength)
722{
723  if (testp)
724  {
725    poly pn = NULL;
726    if (L->bucket != NULL)
727    {
728      kFalseReturn(kbTest(L->bucket));
729      r_assume(L->bucket->bucket_ring == L->tailRing);
730      if (L->p != NULL && pNext(L->p) != NULL)
731      {
732        pn = pNext(L->p);
733        pNext(L->p) = NULL;
734      }
735    }
736    kFalseReturn(kTest_T(L, strat_tailRing, lpos, 'L'));
737    if (pn != NULL)
738      pNext(L->p) = pn;
739
740    ring r;
741    poly p;
742    L->GetLm(p, r);
743    if (L->sev != 0 && p_GetShortExpVector(p, r) != L->sev)
744    {
745      return dReportError("L[%d] wrong sev: has %o, specified to have %o",
746                          lpos, p_GetShortExpVector(p, r), L->sev);
747    }
748    if (lpos > 0 && L->last != NULL && pLast(p) != L->last)
749    {
750      return dReportError("L[%d] last wrong: has %p specified to have %p",
751                          lpos, pLast(p), L->last);
752    }
753  }
754  if (L->p1 == NULL)
755  {
756    // L->p2 either NULL or "normal" poly
757    pFalseReturn(pp_Test(L->p2, currRing, L->tailRing));
758  }
759  else if (tlength > 0 && T != NULL && (lpos >=0))
760  {
761    // now p1 and p2 must be != NULL and must be contained in T
762    int i;
763    i = kFindInT(L->p1, T, tlength);
764    if (i < 0)
765      return dReportError("L[%d].p1 not in T",lpos);
766    i = kFindInT(L->p2, T, tlength);
767    if (i < 0)
768      return dReportError("L[%d].p2 not in T",lpos);
769  }
770  return TRUE;
771}
772
773BOOLEAN kTest (kStrategy strat)
774{
775  int i;
776
777  // test P
778  kFalseReturn(kTest_L(&(strat->P), strat->tailRing,
779                       (strat->P.p != NULL && pNext(strat->P.p)!=strat->tail),
780                       -1, strat->T, strat->tl));
781
782  // test T
783  if (strat->T != NULL)
784  {
785    for (i=0; i<=strat->tl; i++)
786    {
787      kFalseReturn(kTest_T(&(strat->T[i]), strat->tailRing, i, 'T'));
788      if (strat->sevT[i] != pGetShortExpVector(strat->T[i].p))
789        return dReportError("strat->sevT[%d] out of sync", i);
790    }
791  }
792
793  // test L
794  if (strat->L != NULL)
795  {
796    for (i=0; i<=strat->Ll; i++)
797    {
798      kFalseReturn(kTest_L(&(strat->L[i]), strat->tailRing,
799                           strat->L[i].Next() != strat->tail, i,
800                           strat->T, strat->tl));
801      if (strat->use_buckets && strat->L[i].Next() != strat->tail &&
802          strat->L[i].Next() != NULL && strat->L[i].p1 != NULL)
803      {
804        assume(strat->L[i].bucket != NULL);
805      }
806    }
807  }
808
809  // test S
810  if (strat->S != NULL)
811    kFalseReturn(kTest_S(strat));
812
813  return TRUE;
814}
815
816BOOLEAN kTest_S(kStrategy strat)
817{
818  int i;
819  BOOLEAN ret = TRUE;
820  for (i=0; i<=strat->sl; i++)
821  {
822    if (strat->S[i] != NULL &&
823        strat->sevS[i] != pGetShortExpVector(strat->S[i]))
824    {
825      return dReportError("S[%d] wrong sev: has %o, specified to have %o",
826                          i , pGetShortExpVector(strat->S[i]), strat->sevS[i]);
827    }
828  }
829  return ret;
830}
831
832
833
834BOOLEAN kTest_TS(kStrategy strat)
835{
836  int i, j;
837  BOOLEAN ret = TRUE;
838  kFalseReturn(kTest(strat));
839
840  // test strat->R, strat->T[i].i_r
841  for (i=0; i<=strat->tl; i++)
842  {
843    if (strat->T[i].i_r < 0 || strat->T[i].i_r > strat->tl)
844      return dReportError("strat->T[%d].i_r == %d out of bounds", i,
845                          strat->T[i].i_r);
846    if (strat->R[strat->T[i].i_r] != &(strat->T[i]))
847      return dReportError("T[%d].i_r with R out of sync", i);
848  }
849  // test containment of S inT
850  if (strat->S != NULL)
851  {
852    for (i=0; i<=strat->sl; i++)
853    {
854      j = kFindInT(strat->S[i], strat->T, strat->tl);
855      if (j < 0)
856        return dReportError("S[%d] not in T", i);
857      if (strat->S_2_R[i] != strat->T[j].i_r)
858        return dReportError("S_2_R[%d]=%d != T[%d].i_r=%d\n",
859                            i, strat->S_2_R[i], j, strat->T[j].i_r);
860    }
861  }
862  // test strat->L[i].i_r1
863  for (i=0; i<=strat->Ll; i++)
864  {
865    if (strat->L[i].p1 != NULL && strat->L[i].p2)
866    {
867      if (strat->L[i].i_r1 < 0 ||
868          strat->L[i].i_r1 > strat->tl ||
869          strat->L[i].T_1(strat)->p != strat->L[i].p1)
870        return dReportError("L[%d].i_r1 out of sync", i);
871      if (strat->L[i].i_r2 < 0 ||
872          strat->L[i].i_r2 > strat->tl ||
873          strat->L[i].T_2(strat)->p != strat->L[i].p2);
874    }
875    else
876    {
877      if (strat->L[i].i_r1 != -1)
878        return dReportError("L[%d].i_r1 out of sync", i);
879      if (strat->L[i].i_r2 != -1)
880        return dReportError("L[%d].i_r2 out of sync", i);
881    }
882    if (strat->L[i].i_r != -1)
883      return dReportError("L[%d].i_r out of sync", i);
884  }
885  return TRUE;
886}
887
888#endif // KDEBUG
889
890/*2
891*cancels the i-th polynomial in the standardbase s
892*/
893void deleteInS (int i,kStrategy strat)
894{
895#ifdef ENTER_USE_MEMMOVE
896  memmove(&(strat->S[i]), &(strat->S[i+1]), (strat->sl - i)*sizeof(poly));
897  memmove(&(strat->ecartS[i]),&(strat->ecartS[i+1]),(strat->sl - i)*sizeof(int));
898  memmove(&(strat->sevS[i]),&(strat->sevS[i+1]),(strat->sl - i)*sizeof(long));
899  memmove(&(strat->S_2_R[i]),&(strat->S_2_R[i+1]),(strat->sl - i)*sizeof(int));
900#else
901  int j;
902  for (j=i; j<strat->sl; j++)
903  {
904    strat->S[j] = strat->S[j+1];
905    strat->ecartS[j] = strat->ecartS[j+1];
906    strat->sevS[j] = strat->sevS[j+1];
907    strat->S_2_R[j] = strat->S_2_R[j+1];
908  }
909#endif
910  if (strat->lenS!=NULL)
911  {
912#ifdef ENTER_USE_MEMMOVE
913    memmove(&(strat->lenS[i]),&(strat->lenS[i+1]),(strat->sl - i)*sizeof(int));
914#else
915    for (j=i; j<strat->sl; j++) strat->lenS[j] = strat->lenS[j+1];
916#endif
917  }
918  if (strat->lenSw!=NULL)
919  {
920#ifdef ENTER_USE_MEMMOVE
921    memmove(&(strat->lenSw[i]),&(strat->lenSw[i+1]),(strat->sl - i)*sizeof(wlen_type));
922#else
923    for (j=i; j<strat->sl; j++) strat->lenSw[j] = strat->lenSw[j+1];
924#endif
925  }
926  if (strat->fromQ!=NULL)
927  {
928#ifdef ENTER_USE_MEMMOVE
929    memmove(&(strat->fromQ[i]),&(strat->fromQ[i+1]),(strat->sl - i)*sizeof(int));
930#else
931    for (j=i; j<strat->sl; j++)
932    {
933      strat->fromQ[j] = strat->fromQ[j+1];
934    }
935#endif
936  }
937  strat->S[strat->sl] = NULL;
938  strat->sl--;
939}
940
941/*2
942*cancels the j-th polynomial in the set
943*/
944void deleteInL (LSet set, int *length, int j,kStrategy strat)
945{
946  if (set[j].lcm!=NULL)
947  {
948#ifdef HAVE_RINGS
949    if (pGetCoeff(set[j].lcm) != NULL)
950      pLmDelete(set[j].lcm);
951    else
952#endif
953      pLmFree(set[j].lcm);
954  }
955  if (set[j].p!=NULL)
956  {
957    if (pNext(set[j].p) == strat->tail)
958    {
959#ifdef HAVE_RINGS
960      if (pGetCoeff(set[j].p) != NULL)
961        pLmDelete(set[j].p);
962      else
963#endif
964        pLmFree(set[j].p);
965      /*- tail belongs to several int spolys -*/
966    }
967    else
968    {
969      // search p in T, if it is there, do not delete it
970      if (pOrdSgn != -1 || kFindInT(set[j].p, strat) < 0)
971      {
972        // assure that for global orderings kFindInT fails
973        assume(pOrdSgn == -1 || kFindInT(set[j].p, strat) < 0);
974        set[j].Delete();
975      }
976    }
977  }
978  if (*length > 0 && j < *length)
979  {
980#ifdef ENTER_USE_MEMMOVE
981    memmove(&(set[j]), &(set[j+1]), (*length - j)*sizeof(LObject));
982#else
983    int i;
984    for (i=j; i < (*length); i++)
985      set[i] = set[i+1];
986#endif
987  }
988#ifdef KDEBUG
989  memset(&(set[*length]),0,sizeof(LObject));
990#endif
991  (*length)--;
992}
993
994/*2
995*enters p at position at in L
996*/
997void enterL (LSet *set,int *length, int *LSetmax, LObject p,int at)
998{
999#ifdef PDEBUG
1000  /*  zaehler++; */
1001#endif /*PDEBUG*/
1002  int i;
1003  // this should be corrected
1004  assume(p.FDeg == p.pFDeg());
1005
1006  if ((*length)>=0)
1007  {
1008    if ((*length) == (*LSetmax)-1) enlargeL(set,LSetmax,setmaxLinc);
1009    if (at <= (*length))
1010#ifdef ENTER_USE_MEMMOVE
1011      memmove(&((*set)[at+1]), &((*set)[at]), ((*length)-at+1)*sizeof(LObject));
1012#else
1013    for (i=(*length)+1; i>=at+1; i--) (*set)[i] = (*set)[i-1];
1014#endif
1015  }
1016  else at = 0;
1017  (*set)[at] = p;
1018  (*length)++;
1019}
1020
1021/*2
1022* computes the normal ecart;
1023* used in mora case and if pLexOrder & sugar in bba case
1024*/
1025void initEcartNormal (LObject* h)
1026{
1027  h->FDeg = h->pFDeg();
1028  h->ecart = h->pLDeg() - h->FDeg;
1029  // h->length is set by h->pLDeg
1030  h->length=h->pLength=pLength(h->p);
1031}
1032
1033void initEcartBBA (LObject* h)
1034{
1035  h->FDeg = h->pFDeg();
1036  (*h).ecart = 0;
1037  h->length=h->pLength=pLength(h->p);
1038}
1039
1040void initEcartPairBba (LObject* Lp,poly f,poly g,int ecartF,int ecartG)
1041{
1042  Lp->FDeg = Lp->pFDeg();
1043  (*Lp).ecart = 0;
1044  (*Lp).length = 0;
1045}
1046
1047void initEcartPairMora (LObject* Lp,poly f,poly g,int ecartF,int ecartG)
1048{
1049  Lp->FDeg = Lp->pFDeg();
1050  (*Lp).ecart = si_max(ecartF,ecartG);
1051  (*Lp).ecart = (*Lp).ecart- (Lp->FDeg -pFDeg((*Lp).lcm,currRing));
1052  (*Lp).length = 0;
1053}
1054
1055/*2
1056*if ecart1<=ecart2 it returns TRUE
1057*/
1058static inline BOOLEAN sugarDivisibleBy(int ecart1, int ecart2)
1059{
1060  return (ecart1 <= ecart2);
1061}
1062
1063#ifdef HAVE_RINGS
1064/*2
1065* put the pair (s[i],p)  into the set B, ecart=ecart(p) (ring case)
1066*/
1067void enterOnePairRing (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
1068{
1069  assume(i<=strat->sl);
1070  int      l,j,compare,compareCoeff;
1071  LObject  Lp;
1072
1073  if (strat->interred_flag) return;
1074#ifdef KDEBUG
1075  Lp.ecart=0; Lp.length=0;
1076#endif
1077  /*- computes the lcm(s[i],p) -*/
1078  Lp.lcm = pInit();
1079  pSetCoeff0(Lp.lcm, nLcm(pGetCoeff(p), pGetCoeff(strat->S[i]), currRing));
1080  // Lp.lcm == 0
1081  if (nIsZero(pGetCoeff(Lp.lcm)))
1082  {
1083#ifdef KDEBUG
1084      if (TEST_OPT_DEBUG)
1085      {
1086        PrintS("--- Lp.lcm == 0\n");
1087        PrintS("p:");
1088        wrp(p);
1089        Print("  strat->S[%d]:", i);
1090        wrp(strat->S[i]);
1091        PrintLn();
1092      }
1093#endif
1094      strat->cp++;
1095      pLmDelete(Lp.lcm);
1096      return;
1097  }
1098  // basic product criterion
1099  pLcm(p,strat->S[i],Lp.lcm);
1100  pSetm(Lp.lcm);
1101  assume(!strat->sugarCrit);
1102  if (pHasNotCF(p,strat->S[i]) && nIsUnit(pGetCoeff(p)) && nIsUnit(pGetCoeff(strat->S[i])))
1103  {
1104#ifdef KDEBUG
1105      if (TEST_OPT_DEBUG)
1106      {
1107        PrintS("--- product criterion func enterOnePairRing type 1\n");
1108        PrintS("p:");
1109        wrp(p);
1110        Print("  strat->S[%d]:", i);
1111        wrp(strat->S[i]);
1112        PrintLn();
1113      }
1114#endif
1115      strat->cp++;
1116      pLmDelete(Lp.lcm);
1117      return;
1118  }
1119  assume(!strat->fromT);
1120  /*
1121  *the set B collects the pairs of type (S[j],p)
1122  *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
1123  *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1124  *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1125  */
1126  for(j = strat->Bl;j>=0;j--)
1127  {
1128    compare=pDivCompRing(strat->B[j].lcm,Lp.lcm);
1129    compareCoeff = nDivComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(Lp.lcm));
1130    if (compareCoeff == 0 || compare == compareCoeff)
1131    {
1132      if (compare == 1)
1133      {
1134        strat->c3++;
1135#ifdef KDEBUG
1136        if (TEST_OPT_DEBUG)
1137        {
1138          PrintS("--- chain criterion type 1\n");
1139          PrintS("strat->B[j]:");
1140          wrp(strat->B[j].lcm);
1141          PrintS("  Lp.lcm:");
1142          wrp(Lp.lcm);
1143          PrintLn();
1144        }
1145#endif
1146        if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1147        {
1148          pLmDelete(Lp.lcm);
1149          return;
1150        }
1151        break;
1152      }
1153      else
1154      if (compare == -1)
1155      {
1156#ifdef KDEBUG
1157        if (TEST_OPT_DEBUG)
1158        {
1159          PrintS("--- chain criterion type 2\n");
1160          Print("strat->B[%d].lcm:",j);
1161          wrp(strat->B[j].lcm);
1162          PrintS("  Lp.lcm:");
1163          wrp(Lp.lcm);
1164          PrintLn();
1165        }
1166#endif
1167        deleteInL(strat->B,&strat->Bl,j,strat);
1168        strat->c3++;
1169      }
1170    }
1171    if ((compare == pDivComp_EQUAL) && (compareCoeff != 2))
1172    {
1173      if (compareCoeff == pDivComp_LESS)
1174      {
1175#ifdef KDEBUG
1176        if (TEST_OPT_DEBUG)
1177        {
1178          PrintS("--- chain criterion type 3\n");
1179          Print("strat->B[%d].lcm:", j);
1180          wrp(strat->B[j].lcm);
1181          PrintS("  Lp.lcm:");
1182          wrp(Lp.lcm);
1183          PrintLn();
1184        }
1185#endif
1186        strat->c3++;
1187        if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1188        {
1189          pLmDelete(Lp.lcm);
1190          return;
1191        }
1192        break;
1193      }
1194      else
1195      // Add hint for same LM and LC (later) (TODO Oliver)
1196      // if (compareCoeff == pDivComp_GREATER)
1197      {
1198#ifdef KDEBUG
1199        if (TEST_OPT_DEBUG)
1200        {
1201          PrintS("--- chain criterion type 4\n");
1202          Print("strat->B[%d].lcm:", j);
1203          wrp(strat->B[j].lcm);
1204          PrintS("  Lp.lcm:");
1205          wrp(Lp.lcm);
1206          PrintLn();
1207        }
1208#endif
1209        deleteInL(strat->B,&strat->Bl,j,strat);
1210        strat->c3++;
1211      }
1212    }
1213  }
1214  /*
1215  *the pair (S[i],p) enters B if the spoly != 0
1216  */
1217  /*-  compute the short s-polynomial -*/
1218  if ((strat->S[i]==NULL) || (p==NULL)) {
1219#ifdef KDEBUG
1220    if (TEST_OPT_DEBUG)
1221    {
1222      PrintS("--- spoly = NULL\n");
1223    }
1224#endif
1225    pLmDelete(Lp.lcm);
1226    return;
1227  }
1228  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
1229  {
1230    // Is from a previous computed GB, therefore we know that spoly will
1231    // reduce to zero. Oliver.
1232    WarnS("Could we come here? 8738947389");
1233    Lp.p=NULL;
1234  }
1235  else
1236  {
1237    Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
1238  }
1239  if (Lp.p == NULL)
1240  {
1241#ifdef KDEBUG
1242    if (TEST_OPT_DEBUG)
1243    {
1244      PrintS("--- spoly = NULL\n");
1245    }
1246#endif
1247    /*- the case that the s-poly is 0 -*/
1248    if (strat->pairtest==NULL) initPairtest(strat);
1249    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
1250    strat->pairtest[strat->sl+1] = TRUE;
1251    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
1252    /*
1253    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
1254    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
1255    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
1256    *term of p devides the lcm(s,r)
1257    *(this canceling should be done here because
1258    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
1259    *the first case is handeled in chainCrit
1260    */
1261    pLmDelete(Lp.lcm);
1262  }
1263  else
1264  {
1265    /*- the pair (S[i],p) enters B -*/
1266    Lp.p1 = strat->S[i];
1267    Lp.p2 = p;
1268
1269    pNext(Lp.p) = strat->tail;
1270
1271    if (atR >= 0)
1272    {
1273      Lp.i_r2 = atR;
1274      Lp.i_r1 = strat->S_2_R[i];
1275    }
1276    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1277    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
1278    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
1279  }
1280}
1281
1282
1283/*2
1284* put the  lcm(s[i],p)  into the set B
1285*/
1286
1287BOOLEAN enterOneStrongPoly (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
1288{
1289  number d, s, t;
1290  assume(i<=strat->sl);
1291  assume(atR >= 0);
1292  poly m1, m2, gcd;
1293
1294  d = nExtGcd(pGetCoeff(p), pGetCoeff(strat->S[i]), &s, &t);
1295
1296  if (nIsZero(s) || nIsZero(t))  // evtl. durch divBy tests ersetzen
1297  {
1298    nDelete(&d);
1299    nDelete(&s);
1300    nDelete(&t);
1301    return FALSE;
1302  }
1303
1304  k_GetStrongLeadTerms(p, strat->S[i], currRing, m1, m2, gcd, strat->tailRing);
1305  while (! kCheckStrongCreation(atR, m1, i, m2, strat) )
1306  {
1307    memset(&(strat->P), 0, sizeof(strat->P));
1308    kStratChangeTailRing(strat);
1309    strat->P = *(strat->R[atR]);
1310    p_LmFree(m1, strat->tailRing);
1311    p_LmFree(m2, strat->tailRing);
1312    p_LmFree(gcd, currRing);
1313    k_GetStrongLeadTerms(p, strat->S[i], currRing, m1, m2, gcd, strat->tailRing);
1314  }
1315  pSetCoeff0(m1, s);
1316  pSetCoeff0(m2, t);
1317  pSetCoeff0(gcd, d);
1318
1319#ifdef KDEBUG
1320  if (TEST_OPT_DEBUG)
1321  {
1322    // Print("t = %d; s = %d; d = %d\n", nInt(t), nInt(s), nInt(d));
1323    PrintS("m1 = ");
1324    p_wrp(m1, strat->tailRing);
1325    PrintS(" ; m2 = ");
1326    p_wrp(m2, strat->tailRing);
1327    PrintS(" ; gcd = ");
1328    wrp(gcd);
1329    PrintS("\n--- create strong gcd poly: ");
1330    Print("\n p: ", i);
1331    wrp(p);
1332    Print("\n strat->S[%d]: ", i);
1333    wrp(strat->S[i]);
1334    PrintS(" ---> ");
1335  }
1336#endif
1337
1338  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);
1339  p_LmDelete(m1, strat->tailRing);
1340  p_LmDelete(m2, strat->tailRing);
1341
1342#ifdef KDEBUG
1343  if (TEST_OPT_DEBUG)
1344  {
1345    wrp(gcd);
1346    PrintLn();
1347  }
1348#endif
1349
1350  LObject h;
1351  h.p = gcd;
1352  h.tailRing = strat->tailRing;
1353  int posx;
1354  h.pCleardenom();
1355  strat->initEcart(&h);
1356  if (strat->Ll==-1)
1357    posx =0;
1358  else
1359    posx = strat->posInL(strat->L,strat->Ll,&h,strat);
1360  h.sev = pGetShortExpVector(h.p);
1361  if (currRing!=strat->tailRing)
1362    h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
1363  enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
1364  return TRUE;
1365}
1366#endif
1367
1368/*2
1369* put the pair (s[i],p)  into the set B, ecart=ecart(p)
1370*/
1371
1372void enterOnePairNormal (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
1373{
1374  assume(i<=strat->sl);
1375  if (strat->interred_flag) return;
1376
1377  int      l,j,compare;
1378  LObject  Lp;
1379  Lp.i_r = -1;
1380
1381#ifdef KDEBUG
1382  Lp.ecart=0; Lp.length=0;
1383#endif
1384  /*- computes the lcm(s[i],p) -*/
1385  Lp.lcm = pInit();
1386
1387#ifndef HAVE_RATGRING
1388  pLcm(p,strat->S[i],Lp.lcm);
1389#elif defined(HAVE_RATGRING)
1390  //  if (rIsRatGRing(currRing))
1391  pLcmRat(p,strat->S[i],Lp.lcm, currRing->real_var_start); // int rat_shift
1392#endif
1393  pSetm(Lp.lcm);
1394
1395#define MYTEST 0
1396
1397  if (strat->sugarCrit && ALLOW_PROD_CRIT(strat))
1398  {
1399    if((!((strat->ecartS[i]>0)&&(ecart>0)))
1400    && pHasNotCF(p,strat->S[i]))
1401    {
1402    /*
1403    *the product criterion has applied for (s,p),
1404    *i.e. lcm(s,p)=product of the leading terms of s and p.
1405    *Suppose (s,r) is in L and the leading term
1406    *of p divides lcm(s,r)
1407    *(==> the leading term of p divides the leading term of r)
1408    *but the leading term of s does not divide the leading term of r
1409    *(notice that tis condition is automatically satisfied if r is still
1410    *in S), then (s,r) can be cancelled.
1411    *This should be done here because the
1412    *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
1413    *
1414    *Moreover, skipping (s,r) holds also for the noncommutative case.
1415    */
1416      strat->cp++;
1417      pLmFree(Lp.lcm);
1418      Lp.lcm=NULL;
1419      return;
1420    }
1421    else
1422      Lp.ecart = si_max(ecart,strat->ecartS[i]);
1423    if (strat->fromT && (strat->ecartS[i]>ecart))
1424    {
1425      pLmFree(Lp.lcm);
1426      Lp.lcm=NULL;
1427      return;
1428      /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
1429    }
1430    /*
1431    *the set B collects the pairs of type (S[j],p)
1432    *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
1433    *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1434    *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1435    */
1436    {
1437      j = strat->Bl;
1438      loop
1439      {
1440        if (j < 0)  break;
1441        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
1442        if ((compare==1)
1443        &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
1444        {
1445          strat->c3++;
1446          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1447          {
1448            pLmFree(Lp.lcm);
1449            return;
1450          }
1451          break;
1452        }
1453        else
1454        if ((compare ==-1)
1455        && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
1456        {
1457          deleteInL(strat->B,&strat->Bl,j,strat);
1458          strat->c3++;
1459        }
1460        j--;
1461      }
1462    }
1463  }
1464  else /*sugarcrit*/
1465  {
1466    if (ALLOW_PROD_CRIT(strat))
1467    {
1468      // if currRing->nc_type!=quasi (or skew)
1469      // TODO: enable productCrit for super commutative algebras...
1470      if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
1471      pHasNotCF(p,strat->S[i]))
1472      {
1473      /*
1474      *the product criterion has applied for (s,p),
1475      *i.e. lcm(s,p)=product of the leading terms of s and p.
1476      *Suppose (s,r) is in L and the leading term
1477      *of p devides lcm(s,r)
1478      *(==> the leading term of p devides the leading term of r)
1479      *but the leading term of s does not devide the leading term of r
1480      *(notice that tis condition is automatically satisfied if r is still
1481      *in S), then (s,r) can be canceled.
1482      *This should be done here because the
1483      *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
1484      */
1485          strat->cp++;
1486          pLmFree(Lp.lcm);
1487          Lp.lcm=NULL;
1488          return;
1489      }
1490      if (strat->fromT && (strat->ecartS[i]>ecart))
1491      {
1492        pLmFree(Lp.lcm);
1493        Lp.lcm=NULL;
1494        return;
1495        /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
1496      }
1497      /*
1498      *the set B collects the pairs of type (S[j],p)
1499      *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
1500      *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1501      *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1502      */
1503      for(j = strat->Bl;j>=0;j--)
1504      {
1505        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
1506        if (compare==1)
1507        {
1508          strat->c3++;
1509          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1510          {
1511            pLmFree(Lp.lcm);
1512            return;
1513          }
1514          break;
1515        }
1516        else
1517        if (compare ==-1)
1518        {
1519          deleteInL(strat->B,&strat->Bl,j,strat);
1520          strat->c3++;
1521        }
1522      }
1523    }
1524  }
1525  /*
1526  *the pair (S[i],p) enters B if the spoly != 0
1527  */
1528  /*-  compute the short s-polynomial -*/
1529  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
1530    pNorm(p);
1531
1532  if ((strat->S[i]==NULL) || (p==NULL))
1533    return;
1534
1535  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
1536    Lp.p=NULL;
1537  else
1538  {
1539    #ifdef HAVE_PLURAL
1540    if ( rIsPluralRing(currRing) )
1541    {
1542      if(pHasNotCF(p, strat->S[i]))
1543      {
1544         if(ncRingType(currRing) == nc_lie)
1545         {
1546             // generalized prod-crit for lie-type
1547             strat->cp++;
1548             Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i]);
1549         }
1550         else
1551        if( ALLOW_PROD_CRIT(strat) )
1552        {
1553            // product criterion for homogeneous case in SCA
1554            strat->cp++;
1555            Lp.p = NULL;
1556        }
1557        else
1558        {
1559          Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
1560                nc_CreateShortSpoly(strat->S[i], p, currRing);
1561
1562          assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
1563          pNext(Lp.p) = strat->tail; // !!!
1564        }
1565      }
1566      else
1567      {
1568        Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
1569              nc_CreateShortSpoly(strat->S[i], p, currRing);
1570
1571        assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
1572        pNext(Lp.p) = strat->tail; // !!!
1573
1574      }
1575
1576
1577#if MYTEST
1578      if (TEST_OPT_DEBUG)
1579      {
1580        PrintS("strat->S[i]: "); pWrite(strat->S[i]);
1581        PrintS("p: "); pWrite(p);
1582        PrintS("SPoly: "); pWrite(Lp.p);
1583      }
1584#endif
1585
1586    }
1587    else
1588    #endif
1589    {
1590      assume(!rIsPluralRing(currRing));
1591      Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
1592#if MYTEST
1593      if (TEST_OPT_DEBUG)
1594      {
1595        PrintS("strat->S[i]: "); pWrite(strat->S[i]);
1596        PrintS("p: "); pWrite(p);
1597        PrintS("commutative SPoly: "); pWrite(Lp.p);
1598      }
1599#endif
1600
1601      }
1602  }
1603  if (Lp.p == NULL)
1604  {
1605    /*- the case that the s-poly is 0 -*/
1606    if (strat->pairtest==NULL) initPairtest(strat);
1607    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
1608    strat->pairtest[strat->sl+1] = TRUE;
1609    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
1610    /*
1611    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
1612    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
1613    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
1614    *term of p devides the lcm(s,r)
1615    *(this canceling should be done here because
1616    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
1617    *the first case is handeled in chainCrit
1618    */
1619    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
1620  }
1621  else
1622  {
1623    /*- the pair (S[i],p) enters B -*/
1624    Lp.p1 = strat->S[i];
1625    Lp.p2 = p;
1626
1627    if (
1628        (!rIsPluralRing(currRing))
1629//      ||  (rIsPluralRing(currRing) && (ncRingType(currRing) != nc_lie))
1630       )
1631    {
1632      assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
1633      pNext(Lp.p) = strat->tail; // !!!
1634    }
1635
1636    if (atR >= 0)
1637    {
1638      Lp.i_r1 = strat->S_2_R[i];
1639      Lp.i_r2 = atR;
1640    }
1641    else
1642    {
1643      Lp.i_r1 = -1;
1644      Lp.i_r2 = -1;
1645    }
1646    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1647
1648    if (TEST_OPT_INTSTRATEGY)
1649    {
1650      if (!rIsPluralRing(currRing))
1651        nDelete(&(Lp.p->coef));
1652    }
1653
1654    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
1655    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
1656  }
1657}
1658
1659/*2
1660* put the pair (s[i],p) into the set L, ecart=ecart(p)
1661* in the case that s forms a SB of (s)
1662*/
1663void enterOnePairSpecial (int i,poly p,int ecart,kStrategy strat, int atR = -1)
1664{
1665  //PrintS("try ");wrp(strat->S[i]);PrintS(" and ");wrp(p);PrintLn();
1666  if(pHasNotCF(p,strat->S[i]))
1667  {
1668    //PrintS("prod-crit\n");
1669    if(ALLOW_PROD_CRIT(strat))
1670    {
1671      //PrintS("prod-crit\n");
1672      strat->cp++;
1673      return;
1674    }
1675  }
1676
1677  int      l,j,compare;
1678  LObject  Lp;
1679  Lp.i_r = -1;
1680
1681  Lp.lcm = pInit();
1682  pLcm(p,strat->S[i],Lp.lcm);
1683  pSetm(Lp.lcm);
1684  for(j = strat->Ll;j>=0;j--)
1685  {
1686    compare=pDivComp(strat->L[j].lcm,Lp.lcm);
1687    if ((compare==1) || (pLmEqual(strat->L[j].lcm,Lp.lcm)))
1688    {
1689      //PrintS("c3-crit\n");
1690      strat->c3++;
1691      pLmFree(Lp.lcm);
1692      return;
1693    }
1694    else if (compare ==-1)
1695    {
1696      //Print("c3-crit with L[%d]\n",j);
1697      deleteInL(strat->L,&strat->Ll,j,strat);
1698      strat->c3++;
1699    }
1700  }
1701  /*-  compute the short s-polynomial -*/
1702
1703  #ifdef HAVE_PLURAL
1704  if (rIsPluralRing(currRing))
1705  {
1706    Lp.p = nc_CreateShortSpoly(strat->S[i],p); // ??? strat->tailRing?
1707  }
1708  else
1709  #endif
1710    Lp.p = ksCreateShortSpoly(strat->S[i],p,strat->tailRing);
1711
1712  if (Lp.p == NULL)
1713  {
1714     //PrintS("short spoly==NULL\n");
1715     pLmFree(Lp.lcm);
1716  }
1717  else
1718  {
1719    /*- the pair (S[i],p) enters L -*/
1720    Lp.p1 = strat->S[i];
1721    Lp.p2 = p;
1722    if (atR >= 0)
1723    {
1724      Lp.i_r1 = strat->S_2_R[i];
1725      Lp.i_r2 = atR;
1726    }
1727    else
1728    {
1729      Lp.i_r1 = -1;
1730      Lp.i_r2 = -1;
1731    }
1732    assume(pNext(Lp.p) == NULL);
1733    pNext(Lp.p) = strat->tail;
1734    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1735    if (TEST_OPT_INTSTRATEGY)
1736    {
1737      nDelete(&(Lp.p->coef));
1738    }
1739    l = strat->posInL(strat->L,strat->Ll,&Lp,strat);
1740    //Print("-> L[%d]\n",l);
1741    enterL(&strat->L,&strat->Ll,&strat->Lmax,Lp,l);
1742  }
1743}
1744
1745/*2
1746* merge set B into L
1747*/
1748void kMergeBintoL(kStrategy strat)
1749{
1750  int j=strat->Ll+strat->Bl+1;
1751  if (j>strat->Lmax)
1752  {
1753    j=((j+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
1754    strat->L = (LSet)omReallocSize(strat->L,strat->Lmax*sizeof(LObject),
1755                                 j*sizeof(LObject));
1756    strat->Lmax=j;
1757  }
1758  j = strat->Ll;
1759  int i;
1760  for (i=strat->Bl; i>=0; i--)
1761  {
1762    j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
1763    enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
1764  }
1765  strat->Bl = -1;
1766}
1767/*2
1768*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
1769*using the chain-criterion in B and L and enters B to L
1770*/
1771void chainCritNormal (poly p,int ecart,kStrategy strat)
1772{
1773  int i,j,l;
1774
1775  /*
1776  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
1777  *In this case all elements in B such
1778  *that their lcm is divisible by the leading term of S[i] can be canceled
1779  */
1780  if (strat->pairtest!=NULL)
1781  {
1782    {
1783      /*- i.e. there is an i with pairtest[i]==TRUE -*/
1784      for (j=0; j<=strat->sl; j++)
1785      {
1786        if (strat->pairtest[j])
1787        {
1788          for (i=strat->Bl; i>=0; i--)
1789          {
1790            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
1791            {
1792              deleteInL(strat->B,&strat->Bl,i,strat);
1793              strat->c3++;
1794            }
1795          }
1796        }
1797      }
1798    }
1799    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
1800    strat->pairtest=NULL;
1801  }
1802  if (strat->Gebauer || strat->fromT)
1803  {
1804    if (strat->sugarCrit)
1805    {
1806    /*
1807    *suppose L[j] == (s,r) and p/lcm(s,r)
1808    *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
1809    *and in case the sugar is o.k. then L[j] can be canceled
1810    */
1811      for (j=strat->Ll; j>=0; j--)
1812      {
1813        if (sugarDivisibleBy(ecart,strat->L[j].ecart)
1814        && ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
1815        && pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1816        {
1817          if (strat->L[j].p == strat->tail)
1818          {
1819              deleteInL(strat->L,&strat->Ll,j,strat);
1820              strat->c3++;
1821          }
1822        }
1823      }
1824      /*
1825      *this is GEBAUER-MOELLER:
1826      *in B all elements with the same lcm except the "best"
1827      *(i.e. the last one in B with this property) will be canceled
1828      */
1829      j = strat->Bl;
1830      loop /*cannot be changed into a for !!! */
1831      {
1832        if (j <= 0) break;
1833        i = j-1;
1834        loop
1835        {
1836          if (i <  0) break;
1837          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
1838          {
1839            strat->c3++;
1840            if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
1841            {
1842              deleteInL(strat->B,&strat->Bl,i,strat);
1843              j--;
1844            }
1845            else
1846            {
1847              deleteInL(strat->B,&strat->Bl,j,strat);
1848              break;
1849            }
1850          }
1851          i--;
1852        }
1853        j--;
1854      }
1855    }
1856    else /*sugarCrit*/
1857    {
1858      /*
1859      *suppose L[j] == (s,r) and p/lcm(s,r)
1860      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
1861      *and in case the sugar is o.k. then L[j] can be canceled
1862      */
1863      for (j=strat->Ll; j>=0; j--)
1864      {
1865        if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1866        {
1867          if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
1868          {
1869            deleteInL(strat->L,&strat->Ll,j,strat);
1870            strat->c3++;
1871          }
1872        }
1873      }
1874      /*
1875      *this is GEBAUER-MOELLER:
1876      *in B all elements with the same lcm except the "best"
1877      *(i.e. the last one in B with this property) will be canceled
1878      */
1879      j = strat->Bl;
1880      loop   /*cannot be changed into a for !!! */
1881      {
1882        if (j <= 0) break;
1883        for(i=j-1; i>=0; i--)
1884        {
1885          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
1886          {
1887            strat->c3++;
1888            deleteInL(strat->B,&strat->Bl,i,strat);
1889            j--;
1890          }
1891        }
1892        j--;
1893      }
1894    }
1895    /*
1896    *the elements of B enter L
1897    */
1898    kMergeBintoL(strat);
1899  }
1900  else
1901  {
1902    for (j=strat->Ll; j>=0; j--)
1903    {
1904      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1905      {
1906        if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
1907        {
1908          deleteInL(strat->L,&strat->Ll,j,strat);
1909          strat->c3++;
1910        }
1911      }
1912    }
1913    /*
1914    *this is our MODIFICATION of GEBAUER-MOELLER:
1915    *First the elements of B enter L,
1916    *then we fix a lcm and the "best" element in L
1917    *(i.e the last in L with this lcm and of type (s,p))
1918    *and cancel all the other elements of type (r,p) with this lcm
1919    *except the case the element (s,r) has also the same lcm
1920    *and is on the worst position with respect to (s,p) and (r,p)
1921    */
1922    /*
1923    *B enters to L/their order with respect to B is permutated for elements
1924    *B[i].p with the same leading term
1925    */
1926    kMergeBintoL(strat);
1927    j = strat->Ll;
1928    loop  /*cannot be changed into a for !!! */
1929    {
1930      if (j <= 0)
1931      {
1932        /*now L[0] cannot be canceled any more and the tail can be removed*/
1933        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
1934        break;
1935      }
1936      if (strat->L[j].p2 == p)
1937      {
1938        i = j-1;
1939        loop
1940        {
1941          if (i < 0)  break;
1942          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
1943          {
1944            /*L[i] could be canceled but we search for a better one to cancel*/
1945            strat->c3++;
1946            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
1947            && (pNext(strat->L[l].p) == strat->tail)
1948            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
1949            && pDivisibleBy(p,strat->L[l].lcm))
1950            {
1951              /*
1952              *"NOT equal(...)" because in case of "equal" the element L[l]
1953              *is "older" and has to be from theoretical point of view behind
1954              *L[i], but we do not want to reorder L
1955              */
1956              strat->L[i].p2 = strat->tail;
1957              /*
1958              *L[l] will be canceled, we cannot cancel L[i] later on,
1959              *so we mark it with "tail"
1960              */
1961              deleteInL(strat->L,&strat->Ll,l,strat);
1962              i--;
1963            }
1964            else
1965            {
1966              deleteInL(strat->L,&strat->Ll,i,strat);
1967            }
1968            j--;
1969          }
1970          i--;
1971        }
1972      }
1973      else if (strat->L[j].p2 == strat->tail)
1974      {
1975        /*now L[j] cannot be canceled any more and the tail can be removed*/
1976        strat->L[j].p2 = p;
1977      }
1978      j--;
1979    }
1980  }
1981}
1982#ifdef HAVE_RATGRING
1983void chainCritPart (poly p,int ecart,kStrategy strat)
1984{
1985  int i,j,l;
1986
1987  /*
1988  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
1989  *In this case all elements in B such
1990  *that their lcm is divisible by the leading term of S[i] can be canceled
1991  */
1992  if (strat->pairtest!=NULL)
1993  {
1994    {
1995      /*- i.e. there is an i with pairtest[i]==TRUE -*/
1996      for (j=0; j<=strat->sl; j++)
1997      {
1998        if (strat->pairtest[j])
1999        {
2000          for (i=strat->Bl; i>=0; i--)
2001          {
2002            if (_p_LmDivisibleByPart(strat->S[j],currRing,
2003               strat->B[i].lcm,currRing,
2004               currRing->real_var_start,currRing->real_var_end))
2005            {
2006              if(TEST_OPT_DEBUG)
2007              {
2008                 Print("chain-crit-part: S[%d]=",j);
2009                 p_wrp(strat->S[j],currRing);
2010                 Print(" divide B[%d].lcm=",i);
2011                 p_wrp(strat->B[i].lcm,currRing);
2012                 PrintLn();
2013              }
2014              deleteInL(strat->B,&strat->Bl,i,strat);
2015              strat->c3++;
2016            }
2017          }
2018        }
2019      }
2020    }
2021    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
2022    strat->pairtest=NULL;
2023  }
2024  if (strat->Gebauer || strat->fromT)
2025  {
2026    if (strat->sugarCrit)
2027    {
2028    /*
2029    *suppose L[j] == (s,r) and p/lcm(s,r)
2030    *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
2031    *and in case the sugar is o.k. then L[j] can be canceled
2032    */
2033      for (j=strat->Ll; j>=0; j--)
2034      {
2035        if (sugarDivisibleBy(ecart,strat->L[j].ecart)
2036        && ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
2037        && pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2038        {
2039          if (strat->L[j].p == strat->tail)
2040          {
2041              if(TEST_OPT_DEBUG)
2042              {
2043                 PrintS("chain-crit-part: pCompareChainPart p=");
2044                 p_wrp(p,currRing);
2045                 Print(" delete L[%d]",j);
2046                 p_wrp(strat->L[j].lcm,currRing);
2047                 PrintLn();
2048              }
2049              deleteInL(strat->L,&strat->Ll,j,strat);
2050              strat->c3++;
2051          }
2052        }
2053      }
2054      /*
2055      *this is GEBAUER-MOELLER:
2056      *in B all elements with the same lcm except the "best"
2057      *(i.e. the last one in B with this property) will be canceled
2058      */
2059      j = strat->Bl;
2060      loop /*cannot be changed into a for !!! */
2061      {
2062        if (j <= 0) break;
2063        i = j-1;
2064        loop
2065        {
2066          if (i <  0) break;
2067          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
2068          {
2069            strat->c3++;
2070            if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
2071            {
2072              if(TEST_OPT_DEBUG)
2073              {
2074                 Print("chain-crit-part: sugar B[%d].lcm=",j);
2075                 p_wrp(strat->B[j].lcm,currRing);
2076                 Print(" delete B[%d]",i);
2077                 p_wrp(strat->B[i].lcm,currRing);
2078                 PrintLn();
2079              }
2080              deleteInL(strat->B,&strat->Bl,i,strat);
2081              j--;
2082            }
2083            else
2084            {
2085              if(TEST_OPT_DEBUG)
2086              {
2087                 Print("chain-crit-part: sugar B[%d].lcm=",i);
2088                 p_wrp(strat->B[i].lcm,currRing);
2089                 Print(" delete B[%d]",j);
2090                 p_wrp(strat->B[j].lcm,currRing);
2091                 PrintLn();
2092              }
2093              deleteInL(strat->B,&strat->Bl,j,strat);
2094              break;
2095            }
2096          }
2097          i--;
2098        }
2099        j--;
2100      }
2101    }
2102    else /*sugarCrit*/
2103    {
2104      /*
2105      *suppose L[j] == (s,r) and p/lcm(s,r)
2106      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
2107      *and in case the sugar is o.k. then L[j] can be canceled
2108      */
2109      for (j=strat->Ll; j>=0; j--)
2110      {
2111        if (pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2112        {
2113          if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
2114          {
2115              if(TEST_OPT_DEBUG)
2116              {
2117                 PrintS("chain-crit-part: sugar:pCompareChainPart p=");
2118                 p_wrp(p,currRing);
2119                 Print(" delete L[%d]",j);
2120                 p_wrp(strat->L[j].lcm,currRing);
2121                 PrintLn();
2122              }
2123            deleteInL(strat->L,&strat->Ll,j,strat);
2124            strat->c3++;
2125          }
2126        }
2127      }
2128      /*
2129      *this is GEBAUER-MOELLER:
2130      *in B all elements with the same lcm except the "best"
2131      *(i.e. the last one in B with this property) will be canceled
2132      */
2133      j = strat->Bl;
2134      loop   /*cannot be changed into a for !!! */
2135      {
2136        if (j <= 0) break;
2137        for(i=j-1; i>=0; i--)
2138        {
2139          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
2140          {
2141              if(TEST_OPT_DEBUG)
2142              {
2143                 Print("chain-crit-part: equal lcm B[%d].lcm=",j);
2144                 p_wrp(strat->B[j].lcm,currRing);
2145                 Print(" delete B[%d]\n",i);
2146              }
2147            strat->c3++;
2148            deleteInL(strat->B,&strat->Bl,i,strat);
2149            j--;
2150          }
2151        }
2152        j--;
2153      }
2154    }
2155    /*
2156    *the elements of B enter L
2157    */
2158    kMergeBintoL(strat);
2159  }
2160  else
2161  {
2162    for (j=strat->Ll; j>=0; j--)
2163    {
2164      if (pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2165      {
2166        if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
2167        {
2168              if(TEST_OPT_DEBUG)
2169              {
2170                 PrintS("chain-crit-part: pCompareChainPart p=");
2171                 p_wrp(p,currRing);
2172                 Print(" delete L[%d]",j);
2173                 p_wrp(strat->L[j].lcm,currRing);
2174                 PrintLn();
2175              }
2176          deleteInL(strat->L,&strat->Ll,j,strat);
2177          strat->c3++;
2178        }
2179      }
2180    }
2181    /*
2182    *this is our MODIFICATION of GEBAUER-MOELLER:
2183    *First the elements of B enter L,
2184    *then we fix a lcm and the "best" element in L
2185    *(i.e the last in L with this lcm and of type (s,p))
2186    *and cancel all the other elements of type (r,p) with this lcm
2187    *except the case the element (s,r) has also the same lcm
2188    *and is on the worst position with respect to (s,p) and (r,p)
2189    */
2190    /*
2191    *B enters to L/their order with respect to B is permutated for elements
2192    *B[i].p with the same leading term
2193    */
2194    kMergeBintoL(strat);
2195    j = strat->Ll;
2196    loop  /*cannot be changed into a for !!! */
2197    {
2198      if (j <= 0)
2199      {
2200        /*now L[0] cannot be canceled any more and the tail can be removed*/
2201        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2202        break;
2203      }
2204      if (strat->L[j].p2 == p)
2205      {
2206        i = j-1;
2207        loop
2208        {
2209          if (i < 0)  break;
2210          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2211          {
2212            /*L[i] could be canceled but we search for a better one to cancel*/
2213            strat->c3++;
2214            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2215            && (pNext(strat->L[l].p) == strat->tail)
2216            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2217            && _p_LmDivisibleByPart(p,currRing,
2218                           strat->L[l].lcm,currRing,
2219                           currRing->real_var_start, currRing->real_var_end))
2220
2221            {
2222              /*
2223              *"NOT equal(...)" because in case of "equal" the element L[l]
2224              *is "older" and has to be from theoretical point of view behind
2225              *L[i], but we do not want to reorder L
2226              */
2227              strat->L[i].p2 = strat->tail;
2228              /*
2229              *L[l] will be canceled, we cannot cancel L[i] later on,
2230              *so we mark it with "tail"
2231              */
2232              if(TEST_OPT_DEBUG)
2233              {
2234                 PrintS("chain-crit-part: divisible_by p=");
2235                 p_wrp(p,currRing);
2236                 Print(" delete L[%d]",l);
2237                 p_wrp(strat->L[l].lcm,currRing);
2238                 PrintLn();
2239              }
2240              deleteInL(strat->L,&strat->Ll,l,strat);
2241              i--;
2242            }
2243            else
2244            {
2245              if(TEST_OPT_DEBUG)
2246              {
2247                 PrintS("chain-crit-part: divisible_by(2) p=");
2248                 p_wrp(p,currRing);
2249                 Print(" delete L[%d]",i);
2250                 p_wrp(strat->L[i].lcm,currRing);
2251                 PrintLn();
2252              }
2253              deleteInL(strat->L,&strat->Ll,i,strat);
2254            }
2255            j--;
2256          }
2257          i--;
2258        }
2259      }
2260      else if (strat->L[j].p2 == strat->tail)
2261      {
2262        /*now L[j] cannot be canceled any more and the tail can be removed*/
2263        strat->L[j].p2 = p;
2264      }
2265      j--;
2266    }
2267  }
2268}
2269#endif
2270
2271/*2
2272*(s[0],h),...,(s[k],h) will be put to the pairset L
2273*/
2274void initenterpairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2275{
2276
2277  if ((strat->syzComp==0)
2278  || (pGetComp(h)<=strat->syzComp))
2279  {
2280    int j;
2281    BOOLEAN new_pair=FALSE;
2282
2283    if (pGetComp(h)==0)
2284    {
2285      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
2286      if ((isFromQ)&&(strat->fromQ!=NULL))
2287      {
2288        for (j=0; j<=k; j++)
2289        {
2290          if (!strat->fromQ[j])
2291          {
2292            new_pair=TRUE;
2293            strat->enterOnePair(j,h,ecart,isFromQ,strat, atR);
2294          //Print("j:%d, Ll:%d\n",j,strat->Ll);
2295          }
2296        }
2297      }
2298      else
2299      {
2300        new_pair=TRUE;
2301        for (j=0; j<=k; j++)
2302        {
2303          strat->enterOnePair(j,h,ecart,isFromQ,strat, atR);
2304          //Print("j:%d, Ll:%d\n",j,strat->Ll);
2305        }
2306      }
2307    }
2308    else
2309    {
2310      for (j=0; j<=k; j++)
2311      {
2312        if ((pGetComp(h)==pGetComp(strat->S[j]))
2313        || (pGetComp(strat->S[j])==0))
2314        {
2315          new_pair=TRUE;
2316          strat->enterOnePair(j,h,ecart,isFromQ,strat, atR);
2317        //Print("j:%d, Ll:%d\n",j,strat->Ll);
2318        }
2319      }
2320    }
2321
2322    if (new_pair)
2323    {
2324#ifdef HAVE_RATGRING
2325      if (currRing->real_var_start>0)
2326        chainCritPart(h,ecart,strat);
2327      else
2328#endif
2329      strat->chainCrit(h,ecart,strat);
2330    }
2331  }
2332}
2333
2334#ifdef HAVE_RINGS
2335/*2
2336*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
2337*using the chain-criterion in B and L and enters B to L
2338*/
2339void chainCritRing (poly p,int ecart,kStrategy strat)
2340{
2341  int i,j,l;
2342  /*
2343  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
2344  *In this case all elements in B such
2345  *that their lcm is divisible by the leading term of S[i] can be canceled
2346  */
2347  if (strat->pairtest!=NULL)
2348  {
2349    {
2350      /*- i.e. there is an i with pairtest[i]==TRUE -*/
2351      for (j=0; j<=strat->sl; j++)
2352      {
2353        if (strat->pairtest[j])
2354        {
2355          for (i=strat->Bl; i>=0; i--)
2356          {
2357            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
2358            {
2359#ifdef KDEBUG
2360              if (TEST_OPT_DEBUG)
2361              {
2362                PrintS("--- chain criterion func chainCritRing type 1\n");
2363                PrintS("strat->S[j]:");
2364                wrp(strat->S[j]);
2365                PrintS("  strat->B[i].lcm:");
2366                wrp(strat->B[i].lcm);
2367                PrintLn();
2368              }
2369#endif
2370              deleteInL(strat->B,&strat->Bl,i,strat);
2371              strat->c3++;
2372            }
2373          }
2374        }
2375      }
2376    }
2377    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
2378    strat->pairtest=NULL;
2379  }
2380  assume(!(strat->Gebauer || strat->fromT));
2381  for (j=strat->Ll; j>=0; j--)
2382  {
2383    if (strat->L[j].lcm != NULL && nDivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(p)))
2384    {
2385      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2386      {
2387        if ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
2388        {
2389          deleteInL(strat->L,&strat->Ll,j,strat);
2390          strat->c3++;
2391#ifdef KDEBUG
2392              if (TEST_OPT_DEBUG)
2393              {
2394                PrintS("--- chain criterion func chainCritRing type 2\n");
2395                PrintS("strat->L[j].p:");
2396                wrp(strat->L[j].p);
2397                PrintS("  p:");
2398                wrp(p);
2399                PrintLn();
2400              }
2401#endif
2402        }
2403      }
2404    }
2405  }
2406  /*
2407  *this is our MODIFICATION of GEBAUER-MOELLER:
2408  *First the elements of B enter L,
2409  *then we fix a lcm and the "best" element in L
2410  *(i.e the last in L with this lcm and of type (s,p))
2411  *and cancel all the other elements of type (r,p) with this lcm
2412  *except the case the element (s,r) has also the same lcm
2413  *and is on the worst position with respect to (s,p) and (r,p)
2414  */
2415  /*
2416  *B enters to L/their order with respect to B is permutated for elements
2417  *B[i].p with the same leading term
2418  */
2419  kMergeBintoL(strat);
2420  j = strat->Ll;
2421  loop  /*cannot be changed into a for !!! */
2422  {
2423    if (j <= 0)
2424    {
2425      /*now L[0] cannot be canceled any more and the tail can be removed*/
2426      if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2427      break;
2428    }
2429    if (strat->L[j].p2 == p) // Was the element added from B?
2430    {
2431      i = j-1;
2432      loop
2433      {
2434        if (i < 0)  break;
2435        // Element is from B and has the same lcm as L[j]
2436        if ((strat->L[i].p2 == p) && nDivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(strat->L[i].lcm))
2437             && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2438        {
2439          /*L[i] could be canceled but we search for a better one to cancel*/
2440          strat->c3++;
2441#ifdef KDEBUG
2442          if (TEST_OPT_DEBUG)
2443          {
2444            PrintS("--- chain criterion func chainCritRing type 3\n");
2445            PrintS("strat->L[j].lcm:");
2446            wrp(strat->L[j].lcm);
2447            PrintS("  strat->L[i].lcm:");
2448            wrp(strat->L[i].lcm);
2449            PrintLn();
2450          }
2451#endif
2452          if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2453          && (pNext(strat->L[l].p) == strat->tail)
2454          && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2455          && pDivisibleBy(p,strat->L[l].lcm))
2456          {
2457            /*
2458            *"NOT equal(...)" because in case of "equal" the element L[l]
2459            *is "older" and has to be from theoretical point of view behind
2460            *L[i], but we do not want to reorder L
2461            */
2462            strat->L[i].p2 = strat->tail;
2463            /*
2464            *L[l] will be canceled, we cannot cancel L[i] later on,
2465            *so we mark it with "tail"
2466            */
2467            deleteInL(strat->L,&strat->Ll,l,strat);
2468            i--;
2469          }
2470          else
2471          {
2472            deleteInL(strat->L,&strat->Ll,i,strat);
2473          }
2474          j--;
2475        }
2476        i--;
2477      }
2478    }
2479    else if (strat->L[j].p2 == strat->tail)
2480    {
2481      /*now L[j] cannot be canceled any more and the tail can be removed*/
2482      strat->L[j].p2 = p;
2483    }
2484    j--;
2485  }
2486}
2487#endif
2488
2489#ifdef HAVE_RING2TOM
2490long ind2(long arg)
2491{
2492  long ind = 0;
2493  if (arg <= 0) return 0;
2494  while (arg%2 == 0)
2495  {
2496    arg = arg / 2;
2497    ind++;
2498  }
2499  return ind;
2500}
2501
2502long ind_fact_2(long arg)
2503{
2504  long ind = 0;
2505  if (arg <= 0) return 0;
2506  if (arg%2 == 1) { arg--; }
2507  while (arg > 0)
2508  {
2509    ind += ind2(arg);
2510    arg = arg - 2;
2511  }
2512  return ind;
2513}
2514#endif
2515
2516#ifdef HAVE_VANIDEAL
2517long twoPow(long arg)
2518{
2519  return 1L << arg;
2520}
2521
2522/*2
2523* put the pair (p, f) in B and f in T
2524*/
2525void enterOneZeroPairRing (poly f, poly t_p, poly p, int ecart, kStrategy strat, int atR = -1)
2526{
2527  int      l,j,compare,compareCoeff;
2528  LObject  Lp;
2529
2530  if (strat->interred_flag) return;
2531#ifdef KDEBUG
2532  Lp.ecart=0; Lp.length=0;
2533#endif
2534  /*- computes the lcm(s[i],p) -*/
2535  Lp.lcm = pInit();
2536
2537  pLcm(p,f,Lp.lcm);
2538  pSetm(Lp.lcm);
2539  pSetCoeff(Lp.lcm, nLcm(pGetCoeff(p), pGetCoeff(f), currRing));
2540  assume(!strat->sugarCrit);
2541  assume(!strat->fromT);
2542  /*
2543  *the set B collects the pairs of type (S[j],p)
2544  *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
2545  *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
2546  *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
2547  */
2548  for(j = strat->Bl;j>=0;j--)
2549  {
2550    compare=pDivCompRing(strat->B[j].lcm,Lp.lcm);
2551    compareCoeff = nDivComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(Lp.lcm));
2552    if (compareCoeff == 0 || compare == compareCoeff)
2553    {
2554      if (compare == 1)
2555      {
2556        strat->c3++;
2557        pLmDelete(Lp.lcm);
2558        return;
2559      }
2560      else
2561      if (compare == -1)
2562      {
2563        deleteInL(strat->B,&strat->Bl,j,strat);
2564        strat->c3++;
2565      }
2566    }
2567    if (compare == pDivComp_EQUAL)
2568    {
2569      // Add hint for same LM and direction of LC (later) (TODO Oliver)
2570      if (compareCoeff == 1)
2571      {
2572        strat->c3++;
2573        pLmDelete(Lp.lcm);
2574        return;
2575      }
2576      else
2577      if (compareCoeff == -1)
2578      {
2579        deleteInL(strat->B,&strat->Bl,j,strat);
2580        strat->c3++;
2581      }
2582    }
2583  }
2584  /*
2585  *the pair (S[i],p) enters B if the spoly != 0
2586  */
2587  /*-  compute the short s-polynomial -*/
2588  if ((f==NULL) || (p==NULL)) return;
2589  pNorm(p);
2590  {
2591    Lp.p = ksCreateShortSpoly(f, p, strat->tailRing);
2592  }
2593  if (Lp.p == NULL) //deactivated, as we are adding pairs with zeropoly and not from S
2594  {
2595    /*- the case that the s-poly is 0 -*/
2596//    if (strat->pairtest==NULL) initPairtest(strat);
2597//    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
2598//    strat->pairtest[strat->sl+1] = TRUE;
2599    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
2600    /*
2601    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
2602    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
2603    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
2604    *term of p devides the lcm(s,r)
2605    *(this canceling should be done here because
2606    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
2607    *the first case is handeled in chainCrit
2608    */
2609    if (Lp.lcm!=NULL) pLmDelete(Lp.lcm);
2610  }
2611  else
2612  {
2613    /*- the pair (S[i],p) enters B -*/
2614    Lp.p1 = f;
2615    Lp.p2 = p;
2616
2617    pNext(Lp.p) = strat->tail;
2618
2619    LObject tmp_h(f, currRing, strat->tailRing);
2620    tmp_h.SetShortExpVector();
2621    strat->initEcart(&tmp_h);
2622    tmp_h.sev = pGetShortExpVector(tmp_h.p);
2623    tmp_h.t_p = t_p;
2624
2625    enterT(tmp_h, strat, strat->tl + 1);
2626
2627    if (atR >= 0)
2628    {
2629      Lp.i_r2 = atR;
2630      Lp.i_r1 = strat->tl;
2631    }
2632
2633    strat->initEcartPair(&Lp,f,p,0/*strat->ecartS[i]*/,ecart);     // Attention: TODO: break ecart
2634    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
2635    enterL(&strat->B, &strat->Bl, &strat->Bmax, Lp, l);
2636  }
2637}
2638
2639/* Helper for kCreateZeroPoly
2640 * enumerating the exponents
2641ring r = 2^2, (a, b, c), lp; ideal G0 = system("createG0"); ideal G = interred(G0); ncols(G0); ncols(G);
2642 */
2643
2644int nextZeroSimplexExponent (long exp[], long ind[], long cexp[], long cind[], long* cabsind, long step[], long bound, long N)
2645/* gives the next exponent from the set H_1 */
2646{
2647  long add = ind2(cexp[1] + 2);
2648  if ((*cabsind < bound) && (*cabsind - step[1] + add < bound))
2649  {
2650    cexp[1] += 2;
2651    cind[1] += add;
2652    *cabsind += add;
2653  }
2654  else
2655  {
2656    // cabsind >= habsind
2657    if (N == 1) return 0;
2658    int i = 1;
2659    while (exp[i] == cexp[i] && i <= N) i++;
2660    cexp[i] = exp[i];
2661    *cabsind -= cind[i];
2662    cind[i] = ind[i];
2663    step[i] = 500000;
2664    *cabsind += cind[i];
2665    // Print("in: %d\n", *cabsind);
2666    i += 1;
2667    if (i > N) return 0;
2668    do
2669    {
2670      step[1] = 500000;
2671      for (int j = i + 1; j <= N; j++)
2672      {
2673        if (step[1] > step[j]) step[1] = step[j];
2674      }
2675      add = ind2(cexp[i] + 2);
2676      if (*cabsind - step[1] + add >= bound)
2677      {
2678        cexp[i] = exp[i];
2679        *cabsind -= cind[i];
2680        cind[i] = ind[i];
2681        *cabsind += cind[i];
2682        step[i] = 500000;
2683        i += 1;
2684        if (i > N) return 0;
2685      }
2686      else step[1] = -1;
2687    } while (step[1] != -1);
2688    step[1] = 500000;
2689    cexp[i] += 2;
2690    cind[i] += add;
2691    *cabsind += add;
2692    if (add < step[i]) step[i] = add;
2693    for (i = 2; i <= N; i++)
2694    {
2695      if (step[1] > step[i]) step[1] = step[i];
2696    }
2697  }
2698  return 1;
2699}
2700
2701/*
2702 * Creates the zero Polynomial on position exp
2703 * long exp[] : exponent of leading term
2704 * cabsind    : total 2-ind of exp (if -1 will be computed)
2705 * poly* t_p  : will hold the LT in tailRing
2706 * leadRing   : ring for the LT
2707 * tailRing   : ring for the tail
2708 */
2709
2710poly kCreateZeroPoly(long exp[], long cabsind, poly* t_p, ring leadRing, ring tailRing)
2711{
2712
2713  poly zeroPoly = NULL;
2714
2715  number tmp1;
2716  poly tmp2, tmp3;
2717
2718  if (cabsind == -1)
2719  {
2720    cabsind = 0;
2721    for (int i = 1; i <= leadRing->N; i++)
2722    {
2723      cabsind += ind_fact_2(exp[i]);
2724    }
2725//    Print("cabsind: %d\n", cabsind);
2726  }
2727  if (cabsind < leadRing->ch)
2728  {
2729    zeroPoly = p_ISet(twoPow(leadRing->ch - cabsind), tailRing);
2730  }
2731  else
2732  {
2733    zeroPoly = p_ISet(1, tailRing);
2734  }
2735  for (int i = 1; i <= leadRing->N; i++)
2736  {
2737    for (long j = 1; j <= exp[i]; j++)
2738    {
2739      tmp1 = nInit(j);
2740      tmp2 = p_ISet(1, tailRing);
2741      p_SetExp(tmp2, i, 1, tailRing);
2742      p_Setm(tmp2, tailRing);
2743      if (nIsZero(tmp1))
2744      { // should nowbe obsolet, test ! TODO OLIVER
2745        zeroPoly = p_Mult_q(zeroPoly, tmp2, tailRing);
2746      }
2747      else
2748      {
2749        tmp3 = p_NSet(nCopy(tmp1), tailRing);
2750        zeroPoly = p_Mult_q(zeroPoly, p_Add_q(tmp3, tmp2, tailRing), tailRing);
2751      }
2752    }
2753  }
2754  tmp2 = p_NSet(nCopy(pGetCoeff(zeroPoly)), leadRing);
2755  for (int i = 1; i <= leadRing->N; i++)
2756  {
2757    pSetExp(tmp2, i, p_GetExp(zeroPoly, i, tailRing));
2758  }
2759  p_Setm(tmp2, leadRing);
2760  *t_p = zeroPoly;
2761  zeroPoly = pNext(zeroPoly);
2762  pNext(*t_p) = NULL;
2763  pNext(tmp2) = zeroPoly;
2764  return tmp2;
2765}
2766
2767// #define OLI_DEBUG
2768
2769/*
2770 * Generate the s-polynomial for the virtual set of zero-polynomials
2771 */
2772
2773void initenterzeropairsRing (poly p, int ecart, kStrategy strat, int atR)
2774{
2775  // Initialize
2776  long exp[50];            // The exponent of \hat{X} (basepoint)
2777  long cexp[50];           // The current exponent for iterating over all
2778  long ind[50];            // The power of 2 in the i-th component of exp
2779  long cind[50];           // analog for cexp
2780  long mult[50];           // How to multiply the elements of G
2781  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
2782  long habsind = 0;        // The abs. index of the coefficient of h
2783  long step[50];           // The last increases
2784  for (int i = 1; i <= currRing->N; i++)
2785  {
2786    exp[i] = p_GetExp(p, i, currRing);
2787    if (exp[i] & 1 != 0)
2788    {
2789      exp[i] = exp[i] - 1;
2790      mult[i] = 1;
2791    }
2792    cexp[i] = exp[i];
2793    ind[i] = ind_fact_2(exp[i]);
2794    cabsind += ind[i];
2795    cind[i] = ind[i];
2796    step[i] = 500000;
2797  }
2798  step[1] = 500000;
2799  habsind = ind2((long) p_GetCoeff(p, currRing));
2800  long bound = currRing->ch - habsind;
2801#ifdef OLI_DEBUG
2802  PrintS("-------------\npoly  :");
2803  wrp(p);
2804  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
2805  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
2806  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
2807  Print("bound : %d\n", bound);
2808  Print("cind  : %d\n", cabsind);
2809#endif
2810  if (cabsind == 0)
2811  {
2812    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
2813    {
2814      return;
2815    }
2816  }
2817  // Now the whole simplex
2818  do
2819  {
2820    // Build s-polynomial
2821    // 2**ind-def * mult * g - exp-def * h
2822    poly t_p;
2823    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, strat->tailRing);
2824#ifdef OLI_DEBUG
2825    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
2826    Print("zPoly : ");
2827    wrp(zeroPoly);
2828    Print("\n");
2829#endif
2830    enterOneZeroPairRing(zeroPoly, t_p, p, ecart, strat, atR);
2831  }
2832  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
2833}
2834
2835/*
2836 * Create the Groebner basis of the vanishing polynomials.
2837 */
2838
2839ideal createG0()
2840{
2841  // Initialize
2842  long exp[50];            // The exponent of \hat{X} (basepoint)
2843  long cexp[50];           // The current exponent for iterating over all
2844  long ind[50];            // The power of 2 in the i-th component of exp
2845  long cind[50];           // analog for cexp
2846  long mult[50];           // How to multiply the elements of G
2847  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
2848  long habsind = 0;        // The abs. index of the coefficient of h
2849  long step[50];           // The last increases
2850  for (int i = 1; i <= currRing->N; i++)
2851  {
2852    exp[i] = 0;
2853    cexp[i] = exp[i];
2854    ind[i] = 0;
2855    step[i] = 500000;
2856    cind[i] = ind[i];
2857  }
2858  long bound = currRing->ch;
2859  step[1] = 500000;
2860#ifdef OLI_DEBUG
2861  PrintS("-------------\npoly  :");
2862//  wrp(p);
2863  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
2864  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
2865  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
2866  Print("bound : %d\n", bound);
2867  Print("cind  : %d\n", cabsind);
2868#endif
2869  if (cabsind == 0)
2870  {
2871    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
2872    {
2873      return idInit(1, 1);
2874    }
2875  }
2876  ideal G0 = idInit(1, 1);
2877  // Now the whole simplex
2878  do
2879  {
2880    // Build s-polynomial
2881    // 2**ind-def * mult * g - exp-def * h
2882    poly t_p;
2883    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, currRing);
2884#ifdef OLI_DEBUG
2885    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
2886    Print("zPoly : ");
2887    wrp(zeroPoly);
2888    Print("\n");
2889#endif
2890    // Add to ideal
2891    pEnlargeSet(&(G0->m), IDELEMS(G0), 1);
2892    IDELEMS(G0) += 1;
2893    G0->m[IDELEMS(G0) - 1] = zeroPoly;
2894  }
2895  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
2896  idSkipZeroes(G0);
2897  return G0;
2898}
2899#endif
2900
2901#ifdef HAVE_RINGS
2902/*2
2903*(s[0],h),...,(s[k],h) will be put to the pairset L
2904*/
2905void initenterstrongPairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2906{
2907
2908  if (!nIsOne(pGetCoeff(h)))
2909  {
2910    int j;
2911    BOOLEAN new_pair=FALSE;
2912
2913    for (j=0; j<=k; j++)
2914    {
2915      // Print("j:%d, Ll:%d\n",j,strat->Ll);
2916//      if (((unsigned long) pGetCoeff(h) % (unsigned long) pGetCoeff(strat->S[j]) != 0) &&
2917//         ((unsigned long) pGetCoeff(strat->S[j]) % (unsigned long) pGetCoeff(h) != 0))
2918      {
2919        if (enterOneStrongPoly(j,h,ecart,isFromQ,strat, atR))
2920          new_pair=TRUE;
2921      }
2922    }
2923  }
2924/*
2925ring r=256,(x,y,z),dp;
2926ideal I=12xz-133y, 2xy-z;
2927*/
2928
2929}
2930
2931/*2
2932* Generates spoly(0, h) if applicable. Assumes ring in Z/2^n.
2933*/
2934void enterExtendedSpoly(poly h,kStrategy strat)
2935{
2936  if (nIsOne(pGetCoeff(h))) return;
2937  number gcd;
2938  bool go = false;
2939  if (nDivBy((number) 0, pGetCoeff(h)))
2940  {
2941    gcd = nIntDiv((number) 0, pGetCoeff(h));
2942    go = true;
2943  }
2944  else
2945    gcd = nGcd((number) 0, pGetCoeff(h), strat->tailRing);
2946  if (go || !nIsOne(gcd))
2947  {
2948    poly p = h->next;
2949    if (!go)
2950    {
2951      number tmp = gcd;
2952      gcd = nIntDiv(0, gcd);
2953      nDelete(&tmp);
2954    }
2955    p = pp_Mult_nn(p, gcd, strat->tailRing);
2956    nDelete(&gcd);
2957
2958    if (p != NULL)
2959    {
2960      if (TEST_OPT_PROT)
2961      {
2962        PrintS("Z");
2963      }
2964#ifdef KDEBUG
2965      if (TEST_OPT_DEBUG)
2966      {
2967        PrintS("--- create zero spoly: ");
2968        wrp(h);
2969        PrintS(" ---> ");
2970      }
2971#endif
2972      poly tmp = pInit();
2973      pSetCoeff0(tmp, pGetCoeff(p));
2974      for (int i = 1; i <= currRing->N; i++)
2975      {
2976        pSetExp(tmp, i, p_GetExp(p, i, strat->tailRing));
2977      }
2978      if (rRing_has_Comp(currRing))
2979        p_SetComp(tmp, p_GetComp(p, strat->tailRing), currRing);
2980      p_Setm(tmp, currRing);
2981      p = p_LmFreeAndNext(p, strat->tailRing);
2982      pNext(tmp) = p;
2983      LObject h;
2984      h.p = tmp;
2985      h.tailRing = strat->tailRing;
2986      int posx;
2987      if (h.p!=NULL)
2988      {
2989        if (TEST_OPT_INTSTRATEGY)
2990        {
2991          //pContent(h.p);
2992          h.pCleardenom(); // also does a pContent
2993        }
2994        else
2995        {
2996          h.pNorm();
2997        }
2998        strat->initEcart(&h);
2999        if (strat->Ll==-1)
3000          posx =0;
3001        else
3002          posx = strat->posInL(strat->L,strat->Ll,&h,strat);
3003        h.sev = pGetShortExpVector(h.p);
3004        if (strat->tailRing != currRing)
3005          h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
3006        if (pNext(p) != NULL)
3007        {
3008          // What does this? (Oliver)
3009          // pShallowCopyDeleteProc p_shallow_copy_delete
3010          //      = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
3011          // pNext(p) = p_shallow_copy_delete(pNext(p),
3012          //              currRing, strat->tailRing, strat->tailRing->PolyBin);
3013        }
3014#ifdef KDEBUG
3015        if (TEST_OPT_DEBUG)
3016        {
3017          wrp(tmp);
3018          PrintLn();
3019        }
3020#endif
3021        enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
3022      }
3023    }
3024  }
3025  nDelete(&gcd);
3026}
3027
3028void clearSbatch (poly h,int k,int pos,kStrategy strat)
3029{
3030  int j = pos;
3031  if ( (!strat->fromT)
3032  && (1//(strat->syzComp==0)
3033    //||(pGetComp(h)<=strat->syzComp)))
3034  ))
3035  {
3036    // Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
3037    unsigned long h_sev = pGetShortExpVector(h);
3038    loop
3039    {
3040      if (j > k) break;
3041      clearS(h,h_sev, &j,&k,strat);
3042      j++;
3043    }
3044    // Print("end clearS sl=%d\n",strat->sl);
3045  }
3046}
3047
3048/*2
3049* Generates a sufficient set of spolys (maybe just a finite generating
3050* set of the syzygys)
3051*/
3052void superenterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
3053{
3054    assume (rField_is_Ring(currRing));
3055    // enter also zero divisor * poly, if this is non zero and of smaller degree
3056    if (!(rField_is_Domain(currRing))) enterExtendedSpoly(h, strat);
3057    initenterpairs(h, k, ecart, 0, strat, atR);
3058    initenterstrongPairs(h, k, ecart, 0, strat, atR);
3059    clearSbatch(h, k, pos, strat);
3060}
3061#endif
3062
3063/*2
3064*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
3065*superfluous elements in S will be deleted
3066*/
3067void enterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
3068{
3069  int j=pos;
3070
3071#ifdef HAVE_RINGS
3072  assume (!rField_is_Ring(currRing));
3073#endif
3074
3075  initenterpairs(h,k,ecart,0,strat, atR);
3076  if ( (!strat->fromT)
3077  && ((strat->syzComp==0)
3078    ||(pGetComp(h)<=strat->syzComp)))
3079  {
3080    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
3081    unsigned long h_sev = pGetShortExpVector(h);
3082    loop
3083    {
3084      if (j > k) break;
3085      clearS(h,h_sev, &j,&k,strat);
3086      j++;
3087    }
3088    //Print("end clearS sl=%d\n",strat->sl);
3089  }
3090 // PrintS("end enterpairs\n");
3091}
3092
3093/*2
3094*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
3095*superfluous elements in S will be deleted
3096*/
3097void enterpairsSpecial (poly h,int k,int ecart,int pos,kStrategy strat, int atR = -1)
3098{
3099  int j;
3100  const int iCompH = pGetComp(h);
3101
3102  for (j=0; j<=k; j++)
3103  {
3104    const int iCompSj = pGetComp(strat->S[j]);
3105    if ((iCompH==iCompSj)
3106        || (0==iCompH) // TODO: what about this case???
3107        || (0==iCompSj))
3108    {
3109      enterOnePairSpecial(j,h,ecart,strat, atR);
3110    }
3111  }
3112
3113  if (strat->noClearS) return;
3114
3115//   #ifdef HAVE_PLURAL
3116/*
3117  if (rIsPluralRing(currRing))
3118  {
3119    j=pos;
3120    loop
3121    {
3122      if (j > k) break;
3123
3124      if (pLmDivisibleBy(h, strat->S[j]))
3125      {
3126        deleteInS(j, strat);
3127        j--;
3128        k--;
3129      }
3130
3131      j++;
3132    }
3133  }
3134  else
3135*/
3136//   #endif // ??? Why was the following cancelation disabled for non-commutative rings?
3137  {
3138    j=pos;
3139    loop
3140    {
3141      unsigned long h_sev = pGetShortExpVector(h);
3142      if (j > k) break;
3143      clearS(h,h_sev,&j,&k,strat);
3144      j++;
3145    }
3146  }
3147}
3148
3149/*2
3150*reorders  s with respect to posInS,
3151*suc is the first changed index or zero
3152*/
3153
3154void reorderS (int* suc,kStrategy strat)
3155{
3156  int i,j,at,ecart, s2r;
3157  int fq=0;
3158  unsigned long sev;
3159  poly  p;
3160  int new_suc=strat->sl+1;
3161  i= *suc;
3162  if (i<0) i=0;
3163
3164  for (; i<=strat->sl; i++)
3165  {
3166    at = posInS(strat,i-1,strat->S[i],strat->ecartS[i]);
3167    if (at != i)
3168    {
3169      if (new_suc > at) new_suc = at;
3170      p = strat->S[i];
3171      ecart = strat->ecartS[i];
3172      sev = strat->sevS[i];
3173      s2r = strat->S_2_R[i];
3174      if (strat->fromQ!=NULL) fq=strat->fromQ[i];
3175      for (j=i; j>=at+1; j--)
3176      {
3177        strat->S[j] = strat->S[j-1];
3178        strat->ecartS[j] = strat->ecartS[j-1];
3179        strat->sevS[j] = strat->sevS[j-1];
3180        strat->S_2_R[j] = strat->S_2_R[j-1];
3181      }
3182      strat->S[at] = p;
3183      strat->ecartS[at] = ecart;
3184      strat->sevS[at] = sev;
3185      strat->S_2_R[at] = s2r;
3186      if (strat->fromQ!=NULL)
3187      {
3188        for (j=i; j>=at+1; j--)
3189        {
3190          strat->fromQ[j] = strat->fromQ[j-1];
3191        }
3192        strat->fromQ[at]=fq;
3193      }
3194    }
3195  }
3196  if (new_suc <= strat->sl) *suc=new_suc;
3197  else                      *suc=-1;
3198}
3199
3200
3201/*2
3202*looks up the position of p in set
3203*set[0] is the smallest with respect to the ordering-procedure deg/pComp
3204* Assumption: posInS only depends on the leading term
3205*             otherwise, bba has to be changed
3206*/
3207int posInS (const kStrategy strat, const int length,const poly p,
3208            const int ecart_p)
3209{
3210  if(length==-1) return 0;
3211  polyset set=strat->S;
3212  int i;
3213  int an = 0;
3214  int en = length;
3215  int cmp_int = pOrdSgn;
3216  int pc=pGetComp(p);
3217  if ((currRing->MixedOrder)
3218  && (currRing->real_var_start==0)
3219#if 0
3220  || ((strat->ak>0) && ((currRing->order[0]==ringorder_c)||((currRing->order[0]==ringorder_C))))
3221#endif
3222  )
3223  {
3224    int o=pWTotaldegree(p);
3225    int oo=pWTotaldegree(set[length]);
3226
3227    if ((oo<o)
3228    || ((o==oo) && (pLmCmp(set[length],p)!= cmp_int)))
3229      return length+1;
3230
3231    loop
3232    {
3233      if (an >= en-1)
3234      {
3235        if ((pWTotaldegree(set[an])>=o) && (pLmCmp(set[an],p) == cmp_int))
3236        {
3237          return an;
3238        }
3239        return en;
3240      }
3241      i=(an+en) / 2;
3242      if ((pWTotaldegree(set[i])>=o) && (pLmCmp(set[i],p) == cmp_int)) en=i;
3243      else                              an=i;
3244    }
3245  }
3246  else
3247  {
3248#ifdef HAVE_RINGS
3249    if (rField_is_Ring(currRing))
3250    {
3251      if (pLmCmp(set[length],p)== -cmp_int)
3252        return length+1;
3253      int cmp;
3254      loop
3255      {
3256        if (an >= en-1)
3257        {
3258          cmp = pLmCmp(set[an],p);
3259          if (cmp == cmp_int)  return an;
3260          if (cmp == -cmp_int) return en;
3261          if (nDivBy(pGetCoeff(p), pGetCoeff(set[an]))) return en;
3262          return an;
3263        }
3264        i = (an+en) / 2;
3265        cmp = pLmCmp(set[i],p);
3266        if (cmp == cmp_int)         en = i;
3267        else if (cmp == -cmp_int)   an = i;
3268        else
3269        {
3270          if (nDivBy(pGetCoeff(p), pGetCoeff(set[i]))) an = i;
3271          else en = i;
3272        }
3273      }
3274    }
3275    else
3276#endif
3277    if (pLmCmp(set[length],p)== -cmp_int)
3278      return length+1;
3279
3280    loop
3281    {
3282      if (an >= en-1)
3283      {
3284        if (pLmCmp(set[an],p) == cmp_int) return an;
3285        if (pLmCmp(set[an],p) == -cmp_int) return en;
3286        if ((cmp_int!=1)
3287        && ((strat->ecartS[an])>ecart_p))
3288          return an;
3289        return en;
3290      }
3291      i=(an+en) / 2;
3292      if (pLmCmp(set[i],p) == cmp_int) en=i;
3293      else if (pLmCmp(set[i],p) == -cmp_int) an=i;
3294      else
3295      {
3296        if ((cmp_int!=1)
3297        &&((strat->ecartS[i])<ecart_p))
3298          en=i;
3299        else
3300          an=i;
3301      }
3302    }
3303  }
3304}
3305
3306
3307/*2
3308* looks up the position of p in set
3309* the position is the last one
3310*/
3311int posInT0 (const TSet set,const int length,LObject &p)
3312{
3313  return (length+1);
3314}
3315
3316
3317/*2
3318* looks up the position of p in T
3319* set[0] is the smallest with respect to the ordering-procedure
3320* pComp
3321*/
3322int posInT1 (const TSet set,const int length,LObject &p)
3323{
3324  if (length==-1) return 0;
3325
3326  if (pLmCmp(set[length].p,p.p)!= pOrdSgn) return length+1;
3327
3328  int i;
3329  int an = 0;
3330  int en= length;
3331
3332  loop
3333  {
3334    if (an >= en-1)
3335    {
3336      if (pLmCmp(set[an].p,p.p) == pOrdSgn) return an;
3337      return en;
3338    }
3339    i=(an+en) / 2;
3340    if (pLmCmp(set[i].p,p.p) == pOrdSgn) en=i;
3341    else                                 an=i;
3342  }
3343}
3344
3345/*2
3346* looks up the position of p in T
3347* set[0] is the smallest with respect to the ordering-procedure
3348* length
3349*/
3350int posInT2 (const TSet set,const int length,LObject &p)
3351{
3352  if (length==-1)
3353    return 0;
3354  if (set[length].length<p.length)
3355    return length+1;
3356
3357  int i;
3358  int an = 0;
3359  int en= length;
3360
3361  loop
3362  {
3363    if (an >= en-1)
3364    {
3365      if (set[an].length>p.length) return an;
3366      return en;
3367    }
3368    i=(an+en) / 2;
3369    if (set[i].length>p.length) en=i;
3370    else                        an=i;
3371  }
3372}
3373
3374/*2
3375* looks up the position of p in T
3376* set[0] is the smallest with respect to the ordering-procedure
3377* totaldegree,pComp
3378*/
3379int posInT11 (const TSet set,const int length,LObject &p)
3380/*{
3381 * int j=0;
3382 * int o;
3383 *
3384 * o = p.GetpFDeg();
3385 * loop
3386 * {
3387 *   if ((pFDeg(set[j].p) > o)
3388 *   || ((pFDeg(set[j].p) == o) && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
3389 *   {
3390 *     return j;
3391 *   }
3392 *   j++;
3393 *   if (j > length) return j;
3394 * }
3395 *}
3396 */
3397{
3398  if (length==-1) return 0;
3399
3400  int o = p.GetpFDeg();
3401  int op = set[length].GetpFDeg();
3402
3403  if ((op < o)
3404  || ((op == o) && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3405    return length+1;
3406
3407  int i;
3408  int an = 0;
3409  int en= length;
3410
3411  loop
3412  {
3413    if (an >= en-1)
3414    {
3415      op= set[an].GetpFDeg();
3416      if ((op > o)
3417      || (( op == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3418        return an;
3419      return en;
3420    }
3421    i=(an+en) / 2;
3422    op = set[i].GetpFDeg();
3423    if (( op > o)
3424    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3425      en=i;
3426    else
3427      an=i;
3428  }
3429}
3430
3431/*2 Pos for rings T: Here I am
3432* looks up the position of p in T
3433* set[0] is the smallest with respect to the ordering-procedure
3434* totaldegree,pComp
3435*/
3436int posInTrg0 (const TSet set,const int length,LObject &p)
3437{
3438  if (length==-1) return 0;
3439  int o = p.GetpFDeg();
3440  int op = set[length].GetpFDeg();
3441  int i;
3442  int an = 0;
3443  int en = length;
3444  int cmp_int = pOrdSgn;
3445  if ((op < o) || (pLmCmp(set[length].p,p.p)== -cmp_int))
3446    return length+1;
3447  int cmp;
3448  loop
3449  {
3450    if (an >= en-1)
3451    {
3452      op = set[an].GetpFDeg();
3453      if (op > o) return an;
3454      if (op < 0) return en;
3455      cmp = pLmCmp(set[an].p,p.p);
3456      if (cmp == cmp_int)  return an;
3457      if (cmp == -cmp_int) return en;
3458      if (nGreater(pGetCoeff(p.p), pGetCoeff(set[an].p))) return en;
3459      return an;
3460    }
3461    i = (an + en) / 2;
3462    op = set[i].GetpFDeg();
3463    if (op > o)       en = i;
3464    else if (op < o)  an = i;
3465    else
3466    {
3467      cmp = pLmCmp(set[i].p,p.p);
3468      if (cmp == cmp_int)                                     en = i;
3469      else if (cmp == -cmp_int)                               an = i;
3470      else if (nGreater(pGetCoeff(p.p), pGetCoeff(set[i].p))) an = i;
3471      else                                                    en = i;
3472    }
3473  }
3474}
3475/*
3476  int o = p.GetpFDeg();
3477  int op = set[length].GetpFDeg();
3478
3479  if ((op < o)
3480  || ((op == o) && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3481    return length+1;
3482
3483  int i;
3484  int an = 0;
3485  int en= length;
3486
3487  loop
3488  {
3489    if (an >= en-1)
3490    {
3491      op= set[an].GetpFDeg();
3492      if ((op > o)
3493      || (( op == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3494        return an;
3495      return en;
3496    }
3497    i=(an+en) / 2;
3498    op = set[i].GetpFDeg();
3499    if (( op > o)
3500    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3501      en=i;
3502    else
3503      an=i;
3504  }
3505}
3506  */
3507/*2
3508* looks up the position of p in T
3509* set[0] is the smallest with respect to the ordering-procedure
3510* totaldegree,pComp
3511*/
3512int posInT110 (const TSet set,const int length,LObject &p)
3513{
3514  if (length==-1) return 0;
3515
3516  int o = p.GetpFDeg();
3517  int op = set[length].GetpFDeg();
3518
3519  if (( op < o)
3520  || (( op == o) && (set[length].length<p.length))
3521  || (( op == o) && (set[length].length == p.length)
3522     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3523    return length+1;
3524
3525  int i;
3526  int an = 0;
3527  int en= length;
3528  loop
3529  {
3530    if (an >= en-1)
3531    {
3532      op = set[an].GetpFDeg();
3533      if (( op > o)
3534      || (( op == o) && (set[an].length > p.length))
3535      || (( op == o) && (set[an].length == p.length)
3536         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3537        return an;
3538      return en;
3539    }
3540    i=(an+en) / 2;
3541    op = set[i].GetpFDeg();
3542    if (( op > o)
3543    || (( op == o) && (set[i].length > p.length))
3544    || (( op == o) && (set[i].length == p.length)
3545       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3546      en=i;
3547    else
3548      an=i;
3549  }
3550}
3551
3552/*2
3553* looks up the position of p in set
3554* set[0] is the smallest with respect to the ordering-procedure
3555* pFDeg
3556*/
3557int posInT13 (const TSet set,const int length,LObject &p)
3558{
3559  if (length==-1) return 0;
3560
3561  int o = p.GetpFDeg();
3562
3563  if (set[length].GetpFDeg() <= o)
3564    return length+1;
3565
3566  int i;
3567  int an = 0;
3568  int en= length;
3569  loop
3570  {
3571    if (an >= en-1)
3572    {
3573      if (set[an].GetpFDeg() > o)
3574        return an;
3575      return en;
3576    }
3577    i=(an+en) / 2;
3578    if (set[i].GetpFDeg() > o)
3579      en=i;
3580    else
3581      an=i;
3582  }
3583}
3584
3585// determines the position based on: 1.) Ecart 2.) pLength
3586int posInT_EcartpLength(const TSet set,const int length,LObject &p)
3587{
3588  if (length==-1) return 0;
3589
3590  int op=p.ecart;
3591  int ol = p.GetpLength();
3592
3593  int oo=set[length].ecart;
3594  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
3595    return length+1;
3596
3597  int i;
3598  int an = 0;
3599  int en= length;
3600  loop
3601    {
3602      if (an >= en-1)
3603      {
3604        int oo=set[an].ecart;
3605        if((oo > op)
3606           || ((oo==op) && (set[an].pLength > ol)))
3607          return an;
3608        return en;
3609      }
3610      i=(an+en) / 2;
3611      int oo=set[i].ecart;
3612      if ((oo > op)
3613          || ((oo == op) && (set[i].pLength > ol)))
3614        en=i;
3615      else
3616        an=i;
3617    }
3618}
3619
3620/*2
3621* looks up the position of p in set
3622* set[0] is the smallest with respect to the ordering-procedure
3623* maximaldegree, pComp
3624*/
3625int posInT15 (const TSet set,const int length,LObject &p)
3626/*{
3627 *int j=0;
3628 * int o;
3629 *
3630 * o = p.GetpFDeg()+p.ecart;
3631 * loop
3632 * {
3633 *   if ((set[j].GetpFDeg()+set[j].ecart > o)
3634 *   || ((set[j].GetpFDeg()+set[j].ecart == o)
3635 *     && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
3636 *   {
3637 *     return j;
3638 *   }
3639 *   j++;
3640 *   if (j > length) return j;
3641 * }
3642 *}
3643 */
3644{
3645  if (length==-1) return 0;
3646
3647  int o = p.GetpFDeg() + p.ecart;
3648  int op = set[length].GetpFDeg()+set[length].ecart;
3649
3650  if ((op < o)
3651  || ((op == o)
3652     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3653    return length+1;
3654
3655  int i;
3656  int an = 0;
3657  int en= length;
3658  loop
3659  {
3660    if (an >= en-1)
3661    {
3662      op = set[an].GetpFDeg()+set[an].ecart;
3663      if (( op > o)
3664      || (( op  == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3665        return an;
3666      return en;
3667    }
3668    i=(an+en) / 2;
3669    op = set[i].GetpFDeg()+set[i].ecart;
3670    if (( op > o)
3671    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3672      en=i;
3673    else
3674      an=i;
3675  }
3676}
3677
3678/*2
3679* looks up the position of p in set
3680* set[0] is the smallest with respect to the ordering-procedure
3681* pFDeg+ecart, ecart, pComp
3682*/
3683int posInT17 (const TSet set,const int length,LObject &p)
3684/*
3685*{
3686* int j=0;
3687* int  o;
3688*
3689*  o = p.GetpFDeg()+p.ecart;
3690*  loop
3691*  {
3692*    if ((pFDeg(set[j].p)+set[j].ecart > o)
3693*    || (((pFDeg(set[j].p)+set[j].ecart == o)
3694*      && (set[j].ecart < p.ecart)))
3695*    || ((pFDeg(set[j].p)+set[j].ecart == o)
3696*      && (set[j].ecart==p.ecart)
3697*      && (pLmCmp(set[j].p,p.p)==pOrdSgn)))
3698*      return j;
3699*    j++;
3700*    if (j > length) return j;
3701*  }
3702* }
3703*/
3704{
3705  if (length==-1) return 0;
3706
3707  int o = p.GetpFDeg() + p.ecart;
3708  int op = set[length].GetpFDeg()+set[length].ecart;
3709
3710  if ((op < o)
3711  || (( op == o) && (set[length].ecart > p.ecart))
3712  || (( op == o) && (set[length].ecart==p.ecart)
3713     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3714    return length+1;
3715
3716  int i;
3717  int an = 0;
3718  int en= length;
3719  loop
3720  {
3721    if (an >= en-1)
3722    {
3723      op = set[an].GetpFDeg()+set[an].ecart;
3724      if (( op > o)
3725      || (( op == o) && (set[an].ecart < p.ecart))
3726      || (( op  == o) && (set[an].ecart==p.ecart)
3727         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3728        return an;
3729      return en;
3730    }
3731    i=(an+en) / 2;
3732    op = set[i].GetpFDeg()+set[i].ecart;
3733    if ((op > o)
3734    || (( op == o) && (set[i].ecart < p.ecart))
3735    || (( op == o) && (set[i].ecart == p.ecart)
3736       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3737      en=i;
3738    else
3739      an=i;
3740  }
3741}
3742/*2
3743* looks up the position of p in set
3744* set[0] is the smallest with respect to the ordering-procedure
3745* pGetComp, pFDeg+ecart, ecart, pComp
3746*/
3747int posInT17_c (const TSet set,const int length,LObject &p)
3748{
3749  if (length==-1) return 0;
3750
3751  int cc = (-1+2*currRing->order[0]==ringorder_c);
3752  /* cc==1 for (c,..), cc==-1 for (C,..) */
3753  int o = p.GetpFDeg() + p.ecart;
3754  int c = pGetComp(p.p)*cc;
3755
3756  if (pGetComp(set[length].p)*cc < c)
3757    return length+1;
3758  if (pGetComp(set[length].p)*cc == c)
3759  {
3760    int op = set[length].GetpFDeg()+set[length].ecart;
3761    if ((op < o)
3762    || ((op == o) && (set[length].ecart > p.ecart))
3763    || ((op == o) && (set[length].ecart==p.ecart)
3764       && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3765      return length+1;
3766  }
3767
3768  int i;
3769  int an = 0;
3770  int en= length;
3771  loop
3772  {
3773    if (an >= en-1)
3774    {
3775      if (pGetComp(set[an].p)*cc < c)
3776        return en;
3777      if (pGetComp(set[an].p)*cc == c)
3778      {
3779        int op = set[an].GetpFDeg()+set[an].ecart;
3780        if ((op > o)
3781        || ((op == o) && (set[an].ecart < p.ecart))
3782        || ((op == o) && (set[an].ecart==p.ecart)
3783           && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3784          return an;
3785      }
3786      return en;
3787    }
3788    i=(an+en) / 2;
3789    if (pGetComp(set[i].p)*cc > c)
3790      en=i;
3791    else if (pGetComp(set[i].p)*cc == c)
3792    {
3793      int op = set[i].GetpFDeg()+set[i].ecart;
3794      if ((op > o)
3795      || ((op == o) && (set[i].ecart < p.ecart))
3796      || ((op == o) && (set[i].ecart == p.ecart)
3797         && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3798        en=i;
3799      else
3800        an=i;
3801    }
3802    else
3803      an=i;
3804  }
3805}
3806
3807/*2
3808* looks up the position of p in set
3809* set[0] is the smallest with respect to
3810* ecart, pFDeg, length
3811*/
3812int posInT19 (const TSet set,const int length,LObject &p)
3813{
3814  if (length==-1) return 0;
3815
3816  int o = p.ecart;
3817  int op=p.GetpFDeg();
3818
3819  if (set[length].ecart < o)
3820    return length+1;
3821  if (set[length].ecart == o)
3822  {
3823     int oo=set[length].GetpFDeg();
3824     if ((oo < op) || ((oo==op) && (set[length].length < p.length)))
3825       return length+1;
3826  }
3827
3828  int i;
3829  int an = 0;
3830  int en= length;
3831  loop
3832  {
3833    if (an >= en-1)
3834    {
3835      if (set[an].ecart > o)
3836        return an;
3837      if (set[an].ecart == o)
3838      {
3839         int oo=set[an].GetpFDeg();
3840         if((oo > op)
3841         || ((oo==op) && (set[an].length > p.length)))
3842           return an;
3843      }
3844      return en;
3845    }
3846    i=(an+en) / 2;
3847    if (set[i].ecart > o)
3848      en=i;
3849    else if (set[i].ecart == o)
3850    {
3851       int oo=set[i].GetpFDeg();
3852       if ((oo > op)
3853       || ((oo == op) && (set[i].length > p.length)))
3854         en=i;
3855       else
3856        an=i;
3857    }
3858    else
3859      an=i;
3860  }
3861}
3862
3863/*2
3864*looks up the position of polynomial p in set
3865*set[length] is the smallest element in set with respect
3866*to the ordering-procedure pComp
3867*/
3868int posInLSpecial (const LSet set, const int length,
3869                   LObject *p,const kStrategy strat)
3870{
3871  if (length<0) return 0;
3872
3873  int d=p->GetpFDeg();
3874  int op=set[length].GetpFDeg();
3875
3876  if ((op > d)
3877  || ((op == d) && (p->p1!=NULL)&&(set[length].p1==NULL))
3878  || (pLmCmp(set[length].p,p->p)== pOrdSgn))
3879     return length+1;
3880
3881  int i;
3882  int an = 0;
3883  int en= length;
3884  loop
3885  {
3886    if (an >= en-1)
3887    {
3888      op=set[an].GetpFDeg();
3889      if ((op > d)
3890      || ((op == d) && (p->p1!=NULL) && (set[an].p1==NULL))
3891      || (pLmCmp(set[an].p,p->p)== pOrdSgn))
3892         return en;
3893      return an;
3894    }
3895    i=(an+en) / 2;
3896    op=set[i].GetpFDeg();
3897    if ((op>d)
3898    || ((op==d) && (p->p1!=NULL) && (set[i].p1==NULL))
3899    || (pLmCmp(set[i].p,p->p) == pOrdSgn))
3900      an=i;
3901    else
3902      en=i;
3903  }
3904}
3905
3906/*2
3907*looks up the position of polynomial p in set
3908*set[length] is the smallest element in set with respect
3909*to the ordering-procedure pComp
3910*/
3911int posInL0 (const LSet set, const int length,
3912             LObject* p,const kStrategy strat)
3913{
3914  if (length<0) return 0;
3915
3916  if (pLmCmp(set[length].p,p->p)== pOrdSgn)
3917    return length+1;
3918
3919  int i;
3920  int an = 0;
3921  int en= length;
3922  loop
3923  {
3924    if (an >= en-1)
3925    {
3926      if (pLmCmp(set[an].p,p->p) == pOrdSgn) return en;
3927      return an;
3928    }
3929    i=(an+en) / 2;
3930    if (pLmCmp(set[i].p,p->p) == pOrdSgn) an=i;
3931    else                                 en=i;
3932    /*aend. fuer lazy == in !=- machen */
3933  }
3934}
3935
3936/*2
3937* looks up the position of polynomial p in set
3938* e is the ecart of p
3939* set[length] is the smallest element in set with respect
3940* to the ordering-procedure totaldegree,pComp
3941*/
3942int posInL11 (const LSet set, const int length,
3943              LObject* p,const kStrategy strat)
3944/*{
3945 * int j=0;
3946 * int o;
3947 *
3948 * o = p->GetpFDeg();
3949 * loop
3950 * {
3951 *   if (j > length)            return j;
3952 *   if ((set[j].GetpFDeg() < o)) return j;
3953 *   if ((set[j].GetpFDeg() == o) && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
3954 *   {
3955 *     return j;
3956 *   }
3957 *   j++;
3958 * }
3959 *}
3960 */
3961{
3962  if (length<0) return 0;
3963
3964  int o = p->GetpFDeg();
3965  int op = set[length].GetpFDeg();
3966
3967  if ((op > o)
3968  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
3969    return length+1;
3970  int i;
3971  int an = 0;
3972  int en= length;
3973  loop
3974  {
3975    if (an >= en-1)
3976    {
3977      op = set[an].GetpFDeg();
3978      if ((op > o)
3979      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
3980        return en;
3981      return an;
3982    }
3983    i=(an+en) / 2;
3984    op = set[i].GetpFDeg();
3985    if ((op > o)
3986    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
3987      an=i;
3988    else
3989      en=i;
3990  }
3991}
3992
3993/*2 Position for rings L: Here I am
3994* looks up the position of polynomial p in set
3995* e is the ecart of p
3996* set[length] is the smallest element in set with respect
3997* to the ordering-procedure totaldegree,pComp
3998*/
3999inline int getIndexRng(long coeff)
4000{
4001  if (coeff == 0) return -1;
4002  long tmp = coeff;
4003  int ind = 0;
4004  while (tmp % 2 == 0)
4005  {
4006    tmp = tmp / 2;
4007    ind++;
4008  }
4009  return ind;
4010}
4011
4012int posInLrg0 (const LSet set, const int length,
4013              LObject* p,const kStrategy strat)
4014/*          if (nGreater(pGetCoeff(p), pGetCoeff(set[an]))) return en;
4015        if (pLmCmp(set[i],p) == cmp_int)         en = i;
4016        else if (pLmCmp(set[i],p) == -cmp_int)   an = i;
4017        else
4018        {
4019          if (nGreater(pGetCoeff(p), pGetCoeff(set[i]))) an = i;
4020          else en = i;
4021        }*/
4022{
4023  if (length < 0) return 0;
4024
4025  int o = p->GetpFDeg();
4026  int op = set[length].GetpFDeg();
4027
4028  if ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4029    return length + 1;
4030  int i;
4031  int an = 0;
4032  int en = length;
4033  loop
4034  {
4035    if (an >= en - 1)
4036    {
4037      op = set[an].GetpFDeg();
4038      if ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4039        return en;
4040      return an;
4041    }
4042    i = (an+en) / 2;
4043    op = set[i].GetpFDeg();
4044    if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4045      an = i;
4046    else
4047      en = i;
4048  }
4049}
4050
4051/*{
4052  if (length < 0) return 0;
4053
4054  int o = p->GetpFDeg();
4055  int op = set[length].GetpFDeg();
4056
4057  int inde = getIndexRng((unsigned long) pGetCoeff(set[length].p));
4058  int indp = getIndexRng((unsigned long) pGetCoeff(p->p));
4059  int inda;
4060  int indi;
4061
4062  if ((inda > indp) || ((inda == inde) && ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))))
4063    return length + 1;
4064  int i;
4065  int an = 0;
4066  inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
4067  int en = length;
4068  loop
4069  {
4070    if (an >= en-1)
4071    {
4072      op = set[an].GetpFDeg();
4073      if ((indp > inda) || ((indp == inda) && ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))))
4074        return en;
4075      return an;
4076    }
4077    i = (an + en) / 2;
4078    indi = getIndexRng((unsigned long) pGetCoeff(set[i].p));
4079    op = set[i].GetpFDeg();
4080    if ((indi > indp) || ((indi == indp) && ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))))
4081    // if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4082    {
4083      an = i;
4084      inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
4085    }
4086    else
4087      en = i;
4088  }
4089} */
4090
4091/*2
4092* looks up the position of polynomial p in set
4093* set[length] is the smallest element in set with respect
4094* to the ordering-procedure totaldegree,pLength0
4095*/
4096int posInL110 (const LSet set, const int length,
4097               LObject* p,const kStrategy strat)
4098{
4099  if (length<0) return 0;
4100
4101  int o = p->GetpFDeg();
4102  int op = set[length].GetpFDeg();
4103
4104  if ((op > o)
4105  || ((op == o) && (set[length].length >p->length))
4106  || ((op == o) && (set[length].length <= p->length)
4107     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4108    return length+1;
4109  int i;
4110  int an = 0;
4111  int en= length;
4112  loop
4113  {
4114    if (an >= en-1)
4115    {
4116      op = set[an].GetpFDeg();
4117      if ((op > o)
4118      || ((op == o) && (set[an].length >p->length))
4119      || ((op == o) && (set[an].length <=p->length)
4120         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4121        return en;
4122      return an;
4123    }
4124    i=(an+en) / 2;
4125    op = set[i].GetpFDeg();
4126    if ((op > o)
4127    || ((op == o) && (set[i].length > p->length))
4128    || ((op == o) && (set[i].length <= p->length)
4129       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4130      an=i;
4131    else
4132      en=i;
4133  }
4134}
4135
4136/*2
4137* looks up the position of polynomial p in set
4138* e is the ecart of p
4139* set[length] is the smallest element in set with respect
4140* to the ordering-procedure totaldegree
4141*/
4142int posInL13 (const LSet set, const int length,
4143              LObject* p,const kStrategy strat)
4144{
4145  if (length<0) return 0;
4146
4147  int o = p->GetpFDeg();
4148
4149  if (set[length].GetpFDeg() > o)
4150    return length+1;
4151
4152  int i;
4153  int an = 0;
4154  int en= length;
4155  loop
4156  {
4157    if (an >= en-1)
4158    {
4159      if (set[an].GetpFDeg() >= o)
4160        return en;
4161      return an;
4162    }
4163    i=(an+en) / 2;
4164    if (set[i].GetpFDeg() >= o)
4165      an=i;
4166    else
4167      en=i;
4168  }
4169}
4170
4171/*2
4172* looks up the position of polynomial p in set
4173* e is the ecart of p
4174* set[length] is the smallest element in set with respect
4175* to the ordering-procedure maximaldegree,pComp
4176*/
4177int posInL15 (const LSet set, const int length,
4178              LObject* p,const kStrategy strat)
4179/*{
4180 * int j=0;
4181 * int o;
4182 *
4183 * o = p->ecart+p->GetpFDeg();
4184 * loop
4185 * {
4186 *   if (j > length)                       return j;
4187 *   if (set[j].GetpFDeg()+set[j].ecart < o) return j;
4188 *   if ((set[j].GetpFDeg()+set[j].ecart == o)
4189 *   && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
4190 *   {
4191 *     return j;
4192 *   }
4193 *   j++;
4194 * }
4195 *}
4196 */
4197{
4198  if (length<0) return 0;
4199
4200  int o = p->GetpFDeg() + p->ecart;
4201  int op = set[length].GetpFDeg() + set[length].ecart;
4202
4203  if ((op > o)
4204  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4205    return length+1;
4206  int i;
4207  int an = 0;
4208  int en= length;
4209  loop
4210  {
4211    if (an >= en-1)
4212    {
4213      op = set[an].GetpFDeg() + set[an].ecart;
4214      if ((op > o)
4215      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4216        return en;
4217      return an;
4218    }
4219    i=(an+en) / 2;
4220    op = set[i].GetpFDeg() + set[i].ecart;
4221    if ((op > o)
4222    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4223      an=i;
4224    else
4225      en=i;
4226  }
4227}
4228
4229/*2
4230* looks up the position of polynomial p in set
4231* e is the ecart of p
4232* set[length] is the smallest element in set with respect
4233* to the ordering-procedure totaldegree
4234*/
4235int posInL17 (const LSet set, const int length,
4236              LObject* p,const kStrategy strat)
4237{
4238  if (length<0) return 0;
4239
4240  int o = p->GetpFDeg() + p->ecart;
4241
4242  if ((set[length].GetpFDeg() + set[length].ecart > o)
4243  || ((set[length].GetpFDeg() + set[length].ecart == o)
4244     && (set[length].ecart > p->ecart))
4245  || ((set[length].GetpFDeg() + set[length].ecart == o)
4246     && (set[length].ecart == p->ecart)
4247     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4248    return length+1;
4249  int i;
4250  int an = 0;
4251  int en= length;
4252  loop
4253  {
4254    if (an >= en-1)
4255    {
4256      if ((set[an].GetpFDeg() + set[an].ecart > o)
4257      || ((set[an].GetpFDeg() + set[an].ecart == o)
4258         && (set[an].ecart > p->ecart))
4259      || ((set[an].GetpFDeg() + set[an].ecart == o)
4260         && (set[an].ecart == p->ecart)
4261         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4262        return en;
4263      return an;
4264    }
4265    i=(an+en) / 2;
4266    if ((set[i].GetpFDeg() + set[i].ecart > o)
4267    || ((set[i].GetpFDeg() + set[i].ecart == o)
4268       && (set[i].ecart > p->ecart))
4269    || ((set[i].GetpFDeg() +set[i].ecart == o)
4270       && (set[i].ecart == p->ecart)
4271       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4272      an=i;
4273    else
4274      en=i;
4275  }
4276}
4277/*2
4278* looks up the position of polynomial p in set
4279* e is the ecart of p
4280* set[length] is the smallest element in set with respect
4281* to the ordering-procedure pComp
4282*/
4283int posInL17_c (const LSet set, const int length,
4284                LObject* p,const kStrategy strat)
4285{
4286  if (length<0) return 0;
4287
4288  int cc = (-1+2*currRing->order[0]==ringorder_c);
4289  /* cc==1 for (c,..), cc==-1 for (C,..) */
4290  int c = pGetComp(p->p)*cc;
4291  int o = p->GetpFDeg() + p->ecart;
4292
4293  if (pGetComp(set[length].p)*cc > c)
4294    return length+1;
4295  if (pGetComp(set[length].p)*cc == c)
4296  {
4297    if ((set[length].GetpFDeg() + set[length].ecart > o)
4298    || ((set[length].GetpFDeg() + set[length].ecart == o)
4299       && (set[length].ecart > p->ecart))
4300    || ((set[length].GetpFDeg() + set[length].ecart == o)
4301       && (set[length].ecart == p->ecart)
4302       && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4303      return length+1;
4304  }
4305  int i;
4306  int an = 0;
4307  int en= length;
4308  loop
4309  {
4310    if (an >= en-1)
4311    {
4312      if (pGetComp(set[an].p)*cc > c)
4313        return en;
4314      if (pGetComp(set[an].p)*cc == c)
4315      {
4316        if ((set[an].GetpFDeg() + set[an].ecart > o)
4317        || ((set[an].GetpFDeg() + set[an].ecart == o)
4318           && (set[an].ecart > p->ecart))
4319        || ((set[an].GetpFDeg() + set[an].ecart == o)
4320           && (set[an].ecart == p->ecart)
4321           && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4322          return en;
4323      }
4324      return an;
4325    }
4326    i=(an+en) / 2;
4327    if (pGetComp(set[i].p)*cc > c)
4328      an=i;
4329    else if (pGetComp(set[i].p)*cc == c)
4330    {
4331      if ((set[i].GetpFDeg() + set[i].ecart > o)
4332      || ((set[i].GetpFDeg() + set[i].ecart == o)
4333         && (set[i].ecart > p->ecart))
4334      || ((set[i].GetpFDeg() +set[i].ecart == o)
4335         && (set[i].ecart == p->ecart)
4336         && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4337        an=i;
4338      else
4339        en=i;
4340    }
4341    else
4342      en=i;
4343  }
4344}
4345
4346/***************************************************************
4347 *
4348 * Tail reductions
4349 *
4350 ***************************************************************/
4351TObject*
4352kFindDivisibleByInS(kStrategy strat, int pos, LObject* L, TObject *T,
4353                    long ecart)
4354{
4355  int j = 0;
4356  const unsigned long not_sev = ~L->sev;
4357  const unsigned long* sev = strat->sevS;
4358  poly p;
4359  ring r;
4360  L->GetLm(p, r);
4361
4362  assume(~not_sev == p_GetShortExpVector(p, r));
4363
4364  if (r == currRing)
4365  {
4366    loop
4367    {
4368      if (j > pos) return NULL;
4369#if defined(PDEBUG) || defined(PDIV_DEBUG)
4370      if (p_LmShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
4371          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4372        break;
4373#else
4374      if (!(sev[j] & not_sev) &&
4375          (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
4376          p_LmDivisibleBy(strat->S[j], p, r))
4377        break;
4378
4379#endif
4380      j++;
4381    }
4382    // if called from NF, T objects do not exist:
4383    if (strat->tl < 0 || strat->S_2_R[j] == -1)
4384    {
4385      T->Set(strat->S[j], r, strat->tailRing);
4386      return T;
4387    }
4388    else
4389    {
4390/////      assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL
4391/////      && strat->S_2_T(j)->p == strat->S[j]); // wrong?
4392//      assume (j >= 0 && j <= strat->sl && strat->S_2_T(j) != NULL && strat->S_2_T(j)->p == strat->S[j]);
4393      return strat->S_2_T(j);
4394    }
4395  }
4396  else
4397  {
4398    TObject* t;
4399    loop
4400    {
4401      if (j > pos) return NULL;
4402      assume(strat->S_2_R[j] != -1);
4403#if defined(PDEBUG) || defined(PDIV_DEBUG)
4404      t = strat->S_2_T(j);
4405      assume(t != NULL && t->t_p != NULL && t->tailRing == r);
4406      if (p_LmShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
4407          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4408        return t;
4409#else
4410      if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4411      {
4412        t = strat->S_2_T(j);
4413        assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
4414        if (p_LmDivisibleBy(t->t_p, p, r)) return t;
4415      }
4416#endif
4417      j++;
4418    }
4419  }
4420}
4421
4422poly redtail (LObject* L, int pos, kStrategy strat)
4423{
4424  poly h, hn;
4425  int j;
4426  unsigned long not_sev;
4427  strat->redTailChange=FALSE;
4428
4429  poly p = L->p;
4430  if (strat->noTailReduction || pNext(p) == NULL)
4431    return p;
4432
4433  LObject Ln(strat->tailRing);
4434  TObject* With;
4435  // placeholder in case strat->tl < 0
4436  TObject  With_s(strat->tailRing);
4437  h = p;
4438  hn = pNext(h);
4439  long op = strat->tailRing->pFDeg(hn, strat->tailRing);
4440  long e;
4441  int l;
4442  BOOLEAN save_HE=strat->kHEdgeFound;
4443  strat->kHEdgeFound |=
4444    ((Kstd1_deg>0) && (op<=Kstd1_deg)) || TEST_OPT_INFREDTAIL;
4445
4446  while(hn != NULL)
4447  {
4448    op = strat->tailRing->pFDeg(hn, strat->tailRing);
4449    if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
4450    e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
4451    loop
4452    {
4453      Ln.Set(hn, strat->tailRing);
4454      Ln.sev = p_GetShortExpVector(hn, strat->tailRing);
4455      if (strat->kHEdgeFound)
4456        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
4457      else
4458        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s, e);
4459      if (With == NULL) break;
4460      With->length=0;
4461      With->pLength=0;
4462      strat->redTailChange=TRUE;
4463      if (ksReducePolyTail(L, With, h, strat->kNoetherTail()))
4464      {
4465        // reducing the tail would violate the exp bound
4466        if (kStratChangeTailRing(strat, L))
4467        {
4468          strat->kHEdgeFound = save_HE;
4469          return redtail(L, pos, strat);
4470        }
4471        else
4472          return NULL;
4473      }
4474      hn = pNext(h);
4475      if (hn == NULL) goto all_done;
4476      op = strat->tailRing->pFDeg(hn, strat->tailRing);
4477      if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
4478      e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
4479    }
4480    h = hn;
4481    hn = pNext(h);
4482  }
4483
4484  all_done:
4485  if (strat->redTailChange)
4486  {
4487    L->last = 0;
4488    L->pLength = 0;
4489  }
4490  strat->kHEdgeFound = save_HE;
4491  return p;
4492}
4493
4494poly redtail (poly p, int pos, kStrategy strat)
4495{
4496  LObject L(p, currRing);
4497  return redtail(&L, pos, strat);
4498}
4499
4500poly redtailBba (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
4501{
4502#define REDTAIL_CANONICALIZE 100
4503  strat->redTailChange=FALSE;
4504  if (strat->noTailReduction) return L->GetLmCurrRing();
4505  poly h, p;
4506  p = h = L->GetLmTailRing();
4507  if ((h==NULL) || (pNext(h)==NULL))
4508    return L->GetLmCurrRing();
4509
4510  TObject* With;
4511  // placeholder in case strat->tl < 0
4512  TObject  With_s(strat->tailRing);
4513
4514  LObject Ln(pNext(h), strat->tailRing);
4515  Ln.pLength = L->GetpLength() - 1;
4516
4517  pNext(h) = NULL;
4518  if (L->p != NULL) pNext(L->p) = NULL;
4519  L->pLength = 1;
4520
4521  Ln.PrepareRed(strat->use_buckets);
4522
4523  int cnt=REDTAIL_CANONICALIZE;
4524  while(!Ln.IsNull())
4525  {
4526    loop
4527    {
4528      Ln.SetShortExpVector();
4529      if (withT)
4530      {
4531        int j;
4532        j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
4533        if (j < 0) break;
4534        With = &(strat->T[j]);
4535      }
4536      else
4537      {
4538        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
4539        if (With == NULL) break;
4540      }
4541      cnt--;
4542      if (cnt==0)
4543      {
4544        cnt=REDTAIL_CANONICALIZE;
4545        poly tmp=Ln.CanonicalizeP();
4546        if (normalize)
4547        {
4548          Ln.Normalize();
4549          //pNormalize(tmp);
4550          //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
4551        }
4552      }
4553      if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
4554      {
4555        With->pNorm();
4556      }
4557      strat->redTailChange=TRUE;
4558      if (ksReducePolyTail(L, With, &Ln))
4559      {
4560        // reducing the tail would violate the exp bound
4561        //  set a flag and hope for a retry (in bba)
4562        strat->completeReduce_retry=TRUE;
4563        do
4564        {
4565          pNext(h) = Ln.LmExtractAndIter();
4566          pIter(h);
4567          L->pLength++;
4568        } while (!Ln.IsNull());
4569        goto all_done;
4570      }
4571      if (Ln.IsNull()) goto all_done;
4572      if (! withT) With_s.Init(currRing);
4573    }
4574    pNext(h) = Ln.LmExtractAndIter();
4575    pIter(h);
4576    pNormalize(h);
4577    L->pLength++;
4578  }
4579
4580  all_done:
4581  Ln.Delete();
4582  if (L->p != NULL) pNext(L->p) = pNext(p);
4583
4584  if (strat->redTailChange)
4585  {
4586    L->last = NULL;
4587    L->length = 0;
4588  }
4589
4590  //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
4591  //L->Normalize(); // HANNES: should have a test
4592  kTest_L(L);
4593  return L->GetLmCurrRing();
4594}
4595
4596/*2
4597*checks the change degree and write progress report
4598*/
4599void message (int i,int* reduc,int* olddeg,kStrategy strat, int red_result)
4600{
4601  if (i != *olddeg)
4602  {
4603    Print("%d",i);
4604    *olddeg = i;
4605  }
4606  if (K_TEST_OPT_OLDSTD)
4607  {
4608    if (strat->Ll != *reduc)
4609    {
4610      if (strat->Ll != *reduc-1)
4611        Print("(%d)",strat->Ll+1);
4612      else
4613        PrintS("-");
4614      *reduc = strat->Ll;
4615    }
4616    else
4617      PrintS(".");
4618    mflush();
4619  }
4620  else
4621  {
4622    if (red_result == 0)
4623      PrintS("-");
4624    else if (red_result < 0)
4625      PrintS(".");
4626    if ((red_result > 0) || ((strat->Ll % 100)==99))
4627    {
4628      if (strat->Ll != *reduc && strat->Ll > 0)
4629      {
4630        Print("(%d)",strat->Ll+1);
4631        *reduc = strat->Ll;
4632      }
4633    }
4634  }
4635}
4636
4637/*2
4638*statistics
4639*/
4640void messageStat (int srmax,int lrmax,int hilbcount,kStrategy strat)
4641{
4642  //PrintS("\nUsage/Allocation of temporary storage:\n");
4643  //Print("%d/%d polynomials in standard base\n",srmax,IDELEMS(Shdl));
4644  //Print("%d/%d polynomials in set L (for lazy alg.)",lrmax+1,strat->Lmax);
4645  Print("product criterion:%d chain criterion:%d\n",strat->cp,strat->c3);
4646  if (hilbcount!=0) Print("hilbert series criterion:%d\n",hilbcount);
4647  /* in usual case strat->cv is 0, it gets changed only in shift routines */
4648  if (strat->cv!=0) Print("shift V criterion:%d\n",strat->cv);
4649  /*mflush();*/
4650}
4651
4652#ifdef KDEBUG
4653/*2
4654*debugging output: all internal sets, if changed
4655*for testing purpuse only/has to be changed for later use
4656*/
4657void messageSets (kStrategy strat)
4658{
4659  int i;
4660  if (strat->news)
4661  {
4662    PrintS("set S");
4663    for (i=0; i<=strat->sl; i++)
4664    {
4665      Print("\n  %d:",i);
4666      p_wrp(strat->S[i], currRing, strat->tailRing);
4667    }
4668    strat->news = FALSE;
4669  }
4670  if (strat->newt)
4671  {
4672    PrintS("\nset T");
4673    for (i=0; i<=strat->tl; i++)
4674    {
4675      Print("\n  %d:",i);
4676      strat->T[i].wrp();
4677      Print(" o:%d e:%d l:%d",
4678        strat->T[i].pFDeg(),strat->T[i].ecart,strat->T[i].length);
4679    }
4680    strat->newt = FALSE;
4681  }
4682  PrintS("\nset L");
4683  for (i=strat->Ll; i>=0; i--)
4684  {
4685    Print("\n%d:",i);
4686    p_wrp(strat->L[i].p1, currRing, strat->tailRing);
4687    PrintS("  ");
4688    p_wrp(strat->L[i].p2, currRing, strat->tailRing);
4689    PrintS(" lcm: ");p_wrp(strat->L[i].lcm, currRing);
4690    PrintS("\n  p : ");
4691    strat->L[i].wrp();
4692    Print("  o:%d e:%d l:%d",
4693          strat->L[i].pFDeg(),strat->L[i].ecart,strat->L[i].length);
4694  }
4695  PrintLn();
4696}
4697
4698#endif
4699
4700
4701/*2
4702*construct the set s from F
4703*/
4704void initS (ideal F, ideal Q, kStrategy strat)
4705{
4706  int   i,pos;
4707
4708  if (Q!=NULL) i=((IDELEMS(F)+IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4709  else         i=((IDELEMS(F)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4710  strat->ecartS=initec(i);
4711  strat->sevS=initsevS(i);
4712  strat->S_2_R=initS_2_R(i);
4713  strat->fromQ=NULL;
4714  strat->Shdl=idInit(i,F->rank);
4715  strat->S=strat->Shdl->m;
4716  /*- put polys into S -*/
4717  if (Q!=NULL)
4718  {
4719    strat->fromQ=initec(i);
4720    memset(strat->fromQ,0,i*sizeof(int));
4721    for (i=0; i<IDELEMS(Q); i++)
4722    {
4723      if (Q->m[i]!=NULL)
4724      {
4725        LObject h;
4726        h.p = pCopy(Q->m[i]);
4727        if (TEST_OPT_INTSTRATEGY)
4728        {
4729          //pContent(h.p);
4730          h.pCleardenom(); // also does a pContent
4731        }
4732        else
4733        {
4734          h.pNorm();
4735        }
4736        if (pOrdSgn==-1)
4737        {
4738          deleteHC(&h, strat);
4739        }
4740        if (h.p!=NULL)
4741        {
4742          strat->initEcart(&h);
4743          if (strat->sl==-1)
4744            pos =0;
4745          else
4746          {
4747            pos = posInS(strat,strat->sl,h.p,h.ecart);
4748          }
4749          h.sev = pGetShortExpVector(h.p);
4750          strat->enterS(h,pos,strat,-1);
4751          strat->fromQ[pos]=1;
4752        }
4753      }
4754    }
4755  }
4756  for (i=0; i<IDELEMS(F); i++)
4757  {
4758    if (F->m[i]!=NULL)
4759    {
4760      LObject h;
4761      h.p = pCopy(F->m[i]);
4762      if (pOrdSgn==-1)
4763      {
4764        cancelunit(&h);  /*- tries to cancel a unit -*/
4765        deleteHC(&h, strat);
4766      }
4767      if (h.p!=NULL)
4768      // do not rely on the input being a SB!
4769      {
4770        if (TEST_OPT_INTSTRATEGY)
4771        {
4772          //pContent(h.p);
4773          h.pCleardenom(); // also does a pContent
4774        }
4775        else
4776        {
4777          h.pNorm();
4778        }
4779        strat->initEcart(&h);
4780        if (strat->sl==-1)
4781          pos =0;
4782        else
4783          pos = posInS(strat,strat->sl,h.p,h.ecart);
4784        h.sev = pGetShortExpVector(h.p);
4785        strat->enterS(h,pos,strat,-1);
4786      }
4787    }
4788  }
4789  /*- test, if a unit is in F -*/
4790  if ((strat->sl>=0)
4791#ifdef HAVE_RINGS
4792       && nIsUnit(pGetCoeff(strat->S[0]))
4793#endif
4794       && pIsConstant(strat->S[0]))
4795  {
4796    while (strat->sl>0) deleteInS(strat->sl,strat);
4797  }
4798}
4799
4800void initSL (ideal F, ideal Q,kStrategy strat)
4801{
4802  int   i,pos;
4803
4804  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4805  else i=setmaxT;
4806  strat->ecartS=initec(i);
4807  strat->sevS=initsevS(i);
4808  strat->S_2_R=initS_2_R(i);
4809  strat->fromQ=NULL;
4810  strat->Shdl=idInit(i,F->rank);
4811  strat->S=strat->Shdl->m;
4812  /*- put polys into S -*/
4813  if (Q!=NULL)
4814  {
4815    strat->fromQ=initec(i);
4816    memset(strat->fromQ,0,i*sizeof(int));
4817    for (i=0; i<IDELEMS(Q); i++)
4818    {
4819      if (Q->m[i]!=NULL)
4820      {
4821        LObject h;
4822        h.p = pCopy(Q->m[i]);
4823        if (pOrdSgn==-1)
4824        {
4825          deleteHC(&h,strat);
4826        }
4827        if (TEST_OPT_INTSTRATEGY)
4828        {
4829          //pContent(h.p);
4830          h.pCleardenom(); // also does a pContent
4831        }
4832        else
4833        {
4834          h.pNorm();
4835        }
4836        if (h.p!=NULL)
4837        {
4838          strat->initEcart(&h);
4839          if (strat->sl==-1)
4840            pos =0;
4841          else
4842          {
4843            pos = posInS(strat,strat->sl,h.p,h.ecart);
4844          }
4845          h.sev = pGetShortExpVector(h.p);
4846          strat->enterS(h,pos,strat,-1);
4847          strat->fromQ[pos]=1;
4848        }
4849      }
4850    }
4851  }
4852  for (i=0; i<IDELEMS(F); i++)
4853  {
4854    if (F->m[i]!=NULL)
4855    {
4856      LObject h;
4857      h.p = pCopy(F->m[i]);
4858      if (h.p!=NULL)
4859      {
4860        if (pOrdSgn==-1)
4861        {
4862          cancelunit(&h);  /*- tries to cancel a unit -*/
4863          deleteHC(&h, strat);
4864        }
4865        if (h.p!=NULL)
4866        {
4867          if (TEST_OPT_INTSTRATEGY)
4868          {
4869            //pContent(h.p);
4870            h.pCleardenom(); // also does a pContent
4871          }
4872          else
4873          {
4874            h.pNorm();
4875          }
4876          strat->initEcart(&h);
4877          if (strat->Ll==-1)
4878            pos =0;
4879          else
4880            pos = strat->posInL(strat->L,strat->Ll,&h,strat);
4881          h.sev = pGetShortExpVector(h.p);
4882          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
4883        }
4884      }
4885    }
4886  }
4887  /*- test, if a unit is in F -*/
4888
4889  if ((strat->Ll>=0)
4890#ifdef HAVE_RINGS
4891       && nIsUnit(pGetCoeff(strat->L[strat->Ll].p))
4892#endif
4893       && pIsConstant(strat->L[strat->Ll].p))
4894  {
4895    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
4896  }
4897}
4898
4899
4900/*2
4901*construct the set s from F and {P}
4902*/
4903void initSSpecial (ideal F, ideal Q, ideal P,kStrategy strat)
4904{
4905  int   i,pos;
4906
4907  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4908  else i=setmaxT;
4909  i=((i+IDELEMS(F)+IDELEMS(P)+15)/16)*16;
4910  strat->ecartS=initec(i);
4911  strat->sevS=initsevS(i);
4912  strat->S_2_R=initS_2_R(i);
4913  strat->fromQ=NULL;
4914  strat->Shdl=idInit(i,F->rank);
4915  strat->S=strat->Shdl->m;
4916
4917  /*- put polys into S -*/
4918  if (Q!=NULL)
4919  {
4920    strat->fromQ=initec(i);
4921    memset(strat->fromQ,0,i*sizeof(int));
4922    for (i=0; i<IDELEMS(Q); i++)
4923    {
4924      if (Q->m[i]!=NULL)
4925      {
4926        LObject h;
4927        h.p = pCopy(Q->m[i]);
4928        //if (TEST_OPT_INTSTRATEGY)
4929        //{
4930        //  //pContent(h.p);
4931        //  h.pCleardenom(); // also does a pContent
4932        //}
4933        //else
4934        //{
4935        //  h.pNorm();
4936        //}
4937        if (pOrdSgn==-1)
4938        {
4939          deleteHC(&h,strat);
4940        }
4941        if (h.p!=NULL)
4942        {
4943          strat->initEcart(&h);
4944          if (strat->sl==-1)
4945            pos =0;
4946          else
4947          {
4948            pos = posInS(strat,strat->sl,h.p,h.ecart);
4949          }
4950          h.sev = pGetShortExpVector(h.p);
4951          strat->enterS(h,pos,strat, strat->tl+1);
4952          enterT(h, strat);
4953          strat->fromQ[pos]=1;
4954        }
4955      }
4956    }
4957  }
4958  /*- put polys into S -*/
4959  for (i=0; i<IDELEMS(F); i++)
4960  {
4961    if (F->m[i]!=NULL)
4962    {
4963      LObject h;
4964      h.p = pCopy(F->m[i]);
4965      if (pOrdSgn==-1)
4966      {
4967        deleteHC(&h,strat);
4968      }
4969      else
4970      {
4971        h.p=redtailBba(h.p,strat->sl,strat);
4972      }
4973      if (h.p!=NULL)
4974      {
4975        strat->initEcart(&h);
4976        if (strat->sl==-1)
4977          pos =0;
4978        else
4979          pos = posInS(strat,strat->sl,h.p,h.ecart);
4980        h.sev = pGetShortExpVector(h.p);
4981        strat->enterS(h,pos,strat, strat->tl+1);
4982        enterT(h,strat);
4983      }
4984    }
4985  }
4986  for (i=0; i<IDELEMS(P); i++)
4987  {
4988    if (P->m[i]!=NULL)
4989    {
4990      LObject h;
4991      h.p=pCopy(P->m[i]);
4992      if (TEST_OPT_INTSTRATEGY)
4993      {
4994        h.pCleardenom();
4995      }
4996      else
4997      {
4998        h.pNorm();
4999      }
5000      if(strat->sl>=0)
5001      {
5002        if (pOrdSgn==1)
5003        {
5004          h.p=redBba(h.p,strat->sl,strat);
5005          if (h.p!=NULL)
5006          {
5007            h.p=redtailBba(h.p,strat->sl,strat);
5008          }
5009        }
5010        else
5011        {
5012          h.p=redMora(h.p,strat->sl,strat);
5013        }
5014        if(h.p!=NULL)
5015        {
5016          strat->initEcart(&h);
5017          if (TEST_OPT_INTSTRATEGY)
5018          {
5019            h.pCleardenom();
5020          }
5021          else
5022          {
5023            h.is_normalized = 0;
5024            h.pNorm();
5025          }
5026          h.sev = pGetShortExpVector(h.p);
5027          h.SetpFDeg();
5028          pos = posInS(strat,strat->sl,h.p,h.ecart);
5029          enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
5030          strat->enterS(h,pos,strat, strat->tl+1);
5031          enterT(h,strat);
5032        }
5033      }
5034      else
5035      {
5036        h.sev = pGetShortExpVector(h.p);
5037        strat->initEcart(&h);
5038        strat->enterS(h,0,strat, strat->tl+1);
5039        enterT(h,strat);
5040      }
5041    }
5042  }
5043}
5044/*2
5045* reduces h using the set S
5046* procedure used in cancelunit1
5047*/
5048static poly redBba1 (poly h,int maxIndex,kStrategy strat)
5049{
5050  int j = 0;
5051  unsigned long not_sev = ~ pGetShortExpVector(h);
5052
5053  while (j <= maxIndex)
5054  {
5055    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j],h, not_sev))
5056       return ksOldSpolyRedNew(strat->S[j],h,strat->kNoetherTail());
5057    else j++;
5058  }
5059  return h;
5060}
5061
5062/*2
5063*tests if p.p=monomial*unit and cancels the unit
5064*/
5065void cancelunit1 (LObject* p,int *suc, int index,kStrategy strat )
5066{
5067  int k;
5068  poly r,h,h1,q;
5069
5070  if (!pIsVector((*p).p) && ((*p).ecart != 0))
5071  {
5072#ifdef HAVE_RINGS_LOC
5073    // Leading coef have to be a unit
5074    if ( !(nIsUnit(p_GetCoeff((*p).p, r))) ) return;
5075#endif
5076    k = 0;
5077    h1 = r = pCopy((*p).p);
5078    h =pNext(r);
5079    loop
5080    {
5081      if (h==NULL)
5082      {
5083        pDelete(&r);
5084        pDelete(&(pNext((*p).p)));
5085        (*p).ecart = 0;
5086        (*p).length = 1;
5087#ifdef HAVE_RINGS_LOC
5088        (*p).pLength = 1;  // Why wasn't this set already?
5089#endif
5090        (*suc)=0;
5091        return;
5092      }
5093      if (!pDivisibleBy(r,h))
5094      {
5095        q=redBba1(h,index ,strat);
5096        if (q != h)
5097        {
5098          k++;
5099          pDelete(&h);
5100          pNext(h1) = h = q;
5101        }
5102        else
5103        {
5104          pDelete(&r);
5105          return;
5106        }
5107      }
5108      else
5109      {
5110        h1 = h;
5111        pIter(h);
5112      }
5113      if (k > 10)
5114      {
5115        pDelete(&r);
5116        return;
5117      }
5118    }
5119  }
5120}
5121
5122#if 0
5123/*2
5124* reduces h using the elements from Q in the set S
5125* procedure used in updateS
5126* must not be used for elements of Q or elements of an ideal !
5127*/
5128static poly redQ (poly h, int j, kStrategy strat)
5129{
5130  int start;
5131  unsigned long not_sev = ~ pGetShortExpVector(h);
5132  while ((j <= strat->sl) && (pGetComp(strat->S[j])!=0)) j++;
5133  start=j;
5134  while (j<=strat->sl)
5135  {
5136    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
5137    {
5138      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
5139      if (h==NULL) return NULL;
5140      j = start;
5141      not_sev = ~ pGetShortExpVector(h);
5142    }
5143    else j++;
5144  }
5145  return h;
5146}
5147#endif
5148
5149/*2
5150* reduces h using the set S
5151* procedure used in updateS
5152*/
5153static poly redBba (poly h,int maxIndex,kStrategy strat)
5154{
5155  int j = 0;
5156  unsigned long not_sev = ~ pGetShortExpVector(h);
5157
5158  while (j <= maxIndex)
5159  {
5160    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
5161    {
5162      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
5163      if (h==NULL) return NULL;
5164      j = 0;
5165      not_sev = ~ pGetShortExpVector(h);    }
5166    else j++;
5167  }
5168  return h;
5169}
5170
5171/*2
5172* reduces h using the set S
5173*e is the ecart of h
5174*procedure used in updateS
5175*/
5176static poly redMora (poly h,int maxIndex,kStrategy strat)
5177{
5178  int  j=0;
5179  int  e,l;
5180  unsigned long not_sev = ~ pGetShortExpVector(h);
5181
5182  if (maxIndex >= 0)
5183  {
5184    e = pLDeg(h,&l,currRing)-pFDeg(h,currRing);
5185    do
5186    {
5187      if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev)
5188      && ((e >= strat->ecartS[j]) || strat->kHEdgeFound))
5189      {
5190#ifdef KDEBUG
5191        if (TEST_OPT_DEBUG)
5192          {PrintS("reduce ");wrp(h);Print(" with S[%d] (",j);wrp(strat->S[j]);}
5193#endif
5194        h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
5195#ifdef KDEBUG
5196        if(TEST_OPT_DEBUG)
5197          {PrintS(")\nto "); wrp(h); PrintLn();}
5198#endif
5199        // pDelete(&h);
5200        if (h == NULL) return NULL;
5201        e = pLDeg(h,&l,currRing)-pFDeg(h,currRing);
5202        j = 0;
5203        not_sev = ~ pGetShortExpVector(h);
5204      }
5205      else j++;
5206    }
5207    while (j <= maxIndex);
5208  }
5209  return h;
5210}
5211
5212/*2
5213*updates S:
5214*the result is a set of polynomials which are in
5215*normalform with respect to S
5216*/
5217void updateS(BOOLEAN toT,kStrategy strat)
5218{
5219  LObject h;
5220  int i, suc=0;
5221  poly redSi=NULL;
5222  BOOLEAN change,any_change;
5223//  Print("nach initS: updateS start mit sl=%d\n",(strat->sl));
5224//  for (i=0; i<=(strat->sl); i++)
5225//  {
5226//    Print("s%d:",i);
5227//    if (strat->fromQ!=NULL) Print("(Q:%d) ",strat->fromQ[i]);
5228//    pWrite(strat->S[i]);
5229//  }
5230//  Print("pOrdSgn=%d\n", pOrdSgn);
5231  any_change=FALSE;
5232  if (pOrdSgn==1)
5233  {
5234    while (suc != -1)
5235    {
5236      i=suc+1;
5237      while (i<=strat->sl)
5238      {
5239        change=FALSE;
5240        if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
5241        {
5242          redSi = pHead(strat->S[i]);
5243          strat->S[i] = redBba(strat->S[i],i-1,strat);
5244          //if ((strat->ak!=0)&&(strat->S[i]!=NULL))
5245          //  strat->S[i]=redQ(strat->S[i],i+1,strat); /*reduce S[i] mod Q*/
5246          if (pCmp(redSi,strat->S[i])!=0)
5247          {
5248            change=TRUE;
5249            any_change=TRUE;
5250            #ifdef KDEBUG
5251            if (TEST_OPT_DEBUG)
5252            {
5253              PrintS("reduce:");
5254              wrp(redSi);PrintS(" to ");p_wrp(strat->S[i], currRing, strat->tailRing);PrintLn();
5255            }
5256            #endif
5257            if (TEST_OPT_PROT)
5258            {
5259              if (strat->S[i]==NULL)
5260                PrintS("V");
5261              else
5262                PrintS("v");
5263              mflush();
5264            }
5265          }
5266          pDeleteLm(&redSi);
5267          if (strat->S[i]==NULL)
5268          {
5269            deleteInS(i,strat);
5270            i--;
5271          }
5272          else if (change)
5273          {
5274            if (TEST_OPT_INTSTRATEGY)
5275            {
5276              //pContent(strat->S[i]);
5277              strat->S[i]=pCleardenom(strat->S[i]);// also does a pContent
5278            }
5279            else
5280            {
5281              pNorm(strat->S[i]);
5282            }
5283            strat->sevS[i] = pGetShortExpVector(strat->S[i]);
5284          }
5285        }
5286        i++;
5287      }
5288      if (any_change) reorderS(&suc,strat);
5289      else break;
5290    }
5291    if (toT)
5292    {
5293      for (i=0; i<=strat->sl; i++)
5294      {
5295        if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
5296        {
5297          h.p = redtailBba(strat->S[i],i-1,strat);
5298          if (TEST_OPT_INTSTRATEGY)
5299          {
5300            h.pCleardenom();// also does a pContent
5301          }
5302        }
5303        else
5304        {
5305          h.p = strat->S[i];
5306        }
5307        strat->initEcart(&h);
5308        if (strat->honey)
5309        {
5310          strat->ecartS[i] = h.ecart;
5311        }
5312        if (strat->sevS[i] == 0) {strat->sevS[i] = pGetShortExpVector(h.p);}
5313        else assume(strat->sevS[i] == pGetShortExpVector(h.p));
5314        h.sev = strat->sevS[i];
5315        /*puts the elements of S also to T*/
5316        enterT(h,strat);
5317        strat->S_2_R[i] = strat->tl;
5318      }
5319    }
5320  }
5321  else
5322  {
5323    while (suc != -1)
5324    {
5325      i=suc;
5326      while (i<=strat->sl)
5327      {
5328        change=FALSE;
5329        if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
5330        {
5331          redSi=pHead((strat->S)[i]);
5332          (strat->S)[i] = redMora((strat->S)[i],i-1,strat);
5333          if ((strat->S)[i]==NULL)
5334          {
5335            deleteInS(i,strat);
5336            i--;
5337          }
5338          else if (pCmp((strat->S)[i],redSi)!=0)
5339          {
5340            any_change=TRUE;
5341            h.p = strat->S[i];
5342            strat->initEcart(&h);
5343            strat->ecartS[i] = h.ecart;
5344            if (TEST_OPT_INTSTRATEGY)
5345            {
5346              strat->S[i]=pCleardenom(strat->S[i]);// also does a pContent
5347            }
5348            else
5349            {
5350              pNorm(strat->S[i]); // == h.p
5351            }
5352            h.sev =  pGetShortExpVector(h.p);
5353            strat->sevS[i] = h.sev;
5354          }
5355          pDeleteLm(&redSi);
5356          kTest(strat);
5357        }
5358        i++;
5359      }
5360#ifdef KDEBUG
5361      kTest(strat);
5362#endif
5363      if (any_change) reorderS(&suc,strat);
5364      else { suc=-1; break; }
5365      if (h.p!=NULL)
5366      {
5367        if (!strat->kHEdgeFound)
5368        {
5369          /*strat->kHEdgeFound =*/ HEckeTest(h.p,strat);
5370        }
5371        if (strat->kHEdgeFound)
5372          newHEdge(strat->S,strat);
5373      }
5374    }
5375    for (i=0; i<=strat->sl; i++)
5376    {
5377      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
5378      {
5379        strat->S[i] = h.p = redtail(strat->S[i],strat->sl,strat);
5380        strat->initEcart(&h);
5381        strat->ecartS[i] = h.ecart;
5382        h.sev = pGetShortExpVector(h.p);
5383        strat->sevS[i] = h.sev;
5384      }
5385      else
5386      {
5387        h.p = strat->S[i];
5388        h.ecart=strat->ecartS[i];
5389        h.sev = strat->sevS[i];
5390        h.length = h.pLength = pLength(h.p);
5391      }
5392      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
5393        cancelunit1(&h,&suc,strat->sl,strat);
5394      h.SetpFDeg();
5395      /*puts the elements of S also to T*/
5396      enterT(h,strat);
5397      strat->S_2_R[i] = strat->tl;
5398    }
5399    if (suc!= -1) updateS(toT,strat);
5400  }
5401#ifdef KDEBUG
5402  kTest(strat);
5403#endif
5404}
5405
5406
5407/*2
5408* -puts p to the standardbasis s at position at
5409* -saves the result in S
5410*/
5411void enterSBba (LObject p,int atS,kStrategy strat, int atR)
5412{
5413  int i;
5414  strat->news = TRUE;
5415  /*- puts p to the standardbasis s at position at -*/
5416  if (strat->sl == IDELEMS(strat->Shdl)-1)
5417  {
5418    strat->sevS = (unsigned long*) omRealloc0Size(strat->sevS,
5419                                    IDELEMS(strat->Shdl)*sizeof(unsigned long),
5420                                    (IDELEMS(strat->Shdl)+setmaxTinc)
5421                                                  *sizeof(unsigned long));
5422    strat->ecartS = (intset)omReallocSize(strat->ecartS,
5423                                          IDELEMS(strat->Shdl)*sizeof(int),
5424                                          (IDELEMS(strat->Shdl)+setmaxTinc)
5425                                                  *sizeof(int));
5426    strat->S_2_R = (int*) omRealloc0Size(strat->S_2_R,
5427                                         IDELEMS(strat->Shdl)*sizeof(int),
5428                                         (IDELEMS(strat->Shdl)+setmaxTinc)
5429                                                  *sizeof(int));
5430    if (strat->lenS!=NULL)
5431      strat->lenS=(int*)omRealloc0Size(strat->lenS,
5432                                       IDELEMS(strat->Shdl)*sizeof(int),
5433                                       (IDELEMS(strat->Shdl)+setmaxTinc)
5434                                                 *sizeof(int));
5435    if (strat->lenSw!=NULL)
5436      strat->lenSw=(wlen_type*)omRealloc0Size(strat->lenSw,
5437                                       IDELEMS(strat->Shdl)*sizeof(wlen_type),
5438                                       (IDELEMS(strat->Shdl)+setmaxTinc)
5439                                                 *sizeof(wlen_type));
5440    if (strat->fromQ!=NULL)
5441    {
5442      strat->fromQ = (intset)omReallocSize(strat->fromQ,
5443                                    IDELEMS(strat->Shdl)*sizeof(int),
5444                                    (IDELEMS(strat->Shdl)+setmaxTinc)*sizeof(int));
5445    }
5446    pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmaxTinc);
5447    IDELEMS(strat->Shdl)+=setmaxTinc;
5448    strat->Shdl->m=strat->S;
5449  }
5450  if (atS <= strat->sl)
5451  {
5452#ifdef ENTER_USE_MEMMOVE
5453// #if 0
5454    memmove(&(strat->S[atS+1]), &(strat->S[atS]),
5455            (strat->sl - atS + 1)*sizeof(poly));
5456    memmove(&(strat->ecartS[atS+1]), &(strat->ecartS[atS]),
5457            (strat->sl - atS + 1)*sizeof(int));
5458    memmove(&(strat->sevS[atS+1]), &(strat->sevS[atS]),
5459            (strat->sl - atS + 1)*sizeof(unsigned long));
5460    memmove(&(strat->S_2_R[atS+1]), &(strat->S_2_R[atS]),
5461            (strat->sl - atS + 1)*sizeof(int));
5462    if (strat->lenS!=NULL)
5463    memmove(&(strat->lenS[atS+1]), &(strat->lenS[atS]),
5464            (strat->sl - atS + 1)*sizeof(int));
5465    if (strat->lenSw!=NULL)
5466    memmove(&(strat->lenSw[atS+1]), &(strat->lenSw[atS]),
5467            (strat->sl - atS + 1)*sizeof(wlen_type));
5468#else
5469    for (i=strat->sl+1; i>=atS+1; i--)
5470    {
5471      strat->S[i] = strat->S[i-1];
5472      strat->ecartS[i] = strat->ecartS[i-1];
5473      strat->sevS[i] = strat->sevS[i-1];
5474      strat->S_2_R[i] = strat->S_2_R[i-1];
5475    }
5476    if (strat->lenS!=NULL)
5477    for (i=strat->sl+1; i>=atS+1; i--)
5478      strat->lenS[i] = strat->lenS[i-1];
5479    if (strat->lenSw!=NULL)
5480    for (i=strat->sl+1; i>=atS+1; i--)
5481      strat->lenSw[i] = strat->lenSw[i-1];
5482#endif
5483  }
5484  if (strat->fromQ!=NULL)
5485  {
5486#ifdef ENTER_USE_MEMMOVE
5487    memmove(&(strat->fromQ[atS+1]), &(strat->fromQ[atS]),
5488                  (strat->sl - atS + 1)*sizeof(int));
5489#else
5490    for (i=strat->sl+1; i>=atS+1; i--)
5491    {
5492      strat->fromQ[i] = strat->fromQ[i-1];
5493    }
5494#endif
5495    strat->fromQ[atS]=0;
5496  }
5497
5498  /*- save result -*/
5499  strat->S[atS] = p.p;
5500  if (strat->honey) strat->ecartS[atS] = p.ecart;
5501  if (p.sev == 0)
5502    p.sev = pGetShortExpVector(p.p);
5503  else
5504    assume(p.sev == pGetShortExpVector(p.p));
5505  strat->sevS[atS] = p.sev;
5506  strat->ecartS[atS] = p.ecart;
5507  strat->S_2_R[atS] = atR;
5508  strat->sl++;
5509}
5510
5511/*2
5512* puts p to the set T at position atT
5513*/
5514void enterT(LObject p, kStrategy strat, int atT)
5515{
5516  int i;
5517
5518  pp_Test(p.p, currRing, p.tailRing);
5519  assume(strat->tailRing == p.tailRing);
5520  // redMoraNF complains about this -- but, we don't really
5521  // neeed this so far
5522  assume(p.pLength == 0 || pLength(p.p) == p.pLength);
5523  assume(p.FDeg == p.pFDeg());
5524  assume(!p.is_normalized || nIsOne(pGetCoeff(p.p)));
5525
5526#ifdef KDEBUG
5527  // do not put an LObject twice into T:
5528  for(i=strat->tl;i>=0;i--)
5529  {
5530    if (p.p==strat->T[i].p)
5531    {
5532      printf("already in T at pos %d of %d, atT=%d\n",i,strat->tl,atT);
5533      return;
5534    }
5535  }
5536#endif
5537  strat->newt = TRUE;
5538  if (atT < 0)
5539    atT = strat->posInT(strat->T, strat->tl, p);
5540  if (strat->tl == strat->tmax-1)
5541    enlargeT(strat->T,strat->R,strat->sevT,strat->tmax,setmaxTinc);
5542  if (atT <= strat->tl)
5543  {
5544#ifdef ENTER_USE_MEMMOVE
5545    memmove(&(strat->T[atT+1]), &(strat->T[atT]),
5546            (strat->tl-atT+1)*sizeof(TObject));
5547    memmove(&(strat->sevT[atT+1]), &(strat->sevT[atT]),
5548            (strat->tl-atT+1)*sizeof(unsigned long));
5549#endif
5550    for (i=strat->tl+1; i>=atT+1; i--)
5551    {
5552#ifndef ENTER_USE_MEMMOVE
5553      strat->T[i] = strat->T[i-1];
5554      strat->sevT[i] = strat->sevT[i-1];
5555#endif
5556      strat->R[strat->T[i].i_r] = &(strat->T[i]);
5557    }
5558  }
5559
5560  if (strat->tailBin != NULL && (pNext(p.p) != NULL))
5561  {
5562    pNext(p.p)=p_ShallowCopyDelete(pNext(p.p),
5563                                   (strat->tailRing != NULL ?
5564                                    strat->tailRing : currRing),
5565                                   strat->tailBin);
5566    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
5567  }
5568  strat->T[atT] = (TObject) p;
5569
5570  if (strat->tailRing != currRing && pNext(p.p) != NULL)
5571    strat->T[atT].max = p_GetMaxExpP(pNext(p.p), strat->tailRing);
5572  else
5573    strat->T[atT].max = NULL;
5574
5575  strat->tl++;
5576  strat->R[strat->tl] = &(strat->T[atT]);
5577  strat->T[atT].i_r = strat->tl;
5578  assume(p.sev == 0 || pGetShortExpVector(p.p) == p.sev);
5579  strat->sevT[atT] = (p.sev == 0 ? pGetShortExpVector(p.p) : p.sev);
5580  kTest_T(&(strat->T[atT]));
5581}
5582
5583void initHilbCrit(ideal F, ideal Q, intvec **hilb,kStrategy strat)
5584{
5585  if (strat->homog!=isHomog)
5586  {
5587    *hilb=NULL;
5588  }
5589}
5590
5591void initBuchMoraCrit(kStrategy strat)
5592{
5593  strat->enterOnePair=enterOnePairNormal;
5594  strat->chainCrit=chainCritNormal;
5595#ifdef HAVE_RINGS
5596  if (rField_is_Ring(currRing))
5597  {
5598    strat->enterOnePair=enterOnePairRing;
5599    strat->chainCrit=chainCritRing;
5600  }
5601#endif
5602#ifdef HAVE_RATGRING
5603  if (rIsRatGRing(currRing))
5604  {
5605     strat->chainCrit=chainCritPart;
5606     /* enterOnePairNormal get rational part in it */
5607  }
5608#endif
5609
5610  strat->sugarCrit =        TEST_OPT_SUGARCRIT;
5611  // obachman: Hmm.. I need BTEST1(2) for notBuckets ..
5612  //  strat->Gebauer =          BTEST1(2) || strat->homog || strat->sugarCrit;
5613  strat->Gebauer =          strat->homog || strat->sugarCrit;
5614  strat->honey =            !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
5615  if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
5616  strat->pairtest = NULL;
5617  /* alway use tailreduction, except:
5618  * - in local rings, - in lex order case, -in ring over extensions */
5619  strat->noTailReduction = !TEST_OPT_REDTAIL;
5620
5621#ifdef HAVE_PLURAL
5622  // and r is plural_ring
5623  //  hence this holds for r a rational_plural_ring
5624  if( rIsPluralRing(currRing) || (rIsSCA(currRing) && !strat->z2homog) )
5625  {    //or it has non-quasi-comm type... later
5626    strat->sugarCrit = FALSE;
5627    strat->Gebauer = FALSE;
5628    strat->honey = FALSE;
5629  }
5630#endif
5631
5632#ifdef HAVE_RINGS
5633  // Coefficient ring?
5634  if (rField_is_Ring(currRing))
5635  {
5636    strat->sugarCrit = FALSE;
5637    strat->Gebauer = FALSE ;
5638    strat->honey = FALSE;
5639  }
5640#endif
5641  #ifdef KDEBUG
5642  if (TEST_OPT_DEBUG)
5643  {
5644    if (strat->homog) PrintS("ideal/module is homogeneous\n");
5645    else              PrintS("ideal/module is not homogeneous\n");
5646  }
5647  #endif
5648}
5649
5650BOOLEAN kPosInLDependsOnLength(int (*pos_in_l)
5651                               (const LSet set, const int length,
5652                                LObject* L,const kStrategy strat))
5653{
5654  if (pos_in_l == posInL110 ||
5655      pos_in_l == posInL10)
5656    return TRUE;
5657
5658  return FALSE;
5659}
5660
5661void initBuchMoraPos (kStrategy strat)
5662{
5663  if (pOrdSgn==1)
5664  {
5665    if (strat->honey)
5666    {
5667      strat->posInL = posInL15;
5668      // ok -- here is the deal: from my experiments for Singular-2-0
5669      // I conclude that that posInT_EcartpLength is the best of
5670      // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
5671      // see the table at the end of this file
5672      if (K_TEST_OPT_OLDSTD)
5673        strat->posInT = posInT15;
5674      else
5675        strat->posInT = posInT_EcartpLength;
5676    }
5677    else if (pLexOrder && !TEST_OPT_INTSTRATEGY)
5678    {
5679      strat->posInL = posInL11;
5680      strat->posInT = posInT11;
5681    }
5682    else if (TEST_OPT_INTSTRATEGY)
5683    {
5684      strat->posInL = posInL11;
5685      strat->posInT = posInT11;
5686    }
5687    else
5688    {
5689      strat->posInL = posInL0;
5690      strat->posInT = posInT0;
5691    }
5692    //if (strat->minim>0) strat->posInL =posInLSpecial;
5693    if (strat->homog)
5694    {
5695       strat->posInL = posInL110;
5696       strat->posInT = posInT110;
5697    }
5698  }
5699  else
5700  {
5701    if (strat->homog)
5702    {
5703      strat->posInL = posInL11;
5704      strat->posInT = posInT11;
5705    }
5706    else
5707    {
5708      if ((currRing->order[0]==ringorder_c)
5709      ||(currRing->order[0]==ringorder_C))
5710      {
5711        strat->posInL = posInL17_c;
5712        strat->posInT = posInT17_c;
5713      }
5714      else
5715      {
5716        strat->posInL = posInL17;
5717        strat->posInT = posInT17;
5718      }
5719    }
5720  }
5721  if (strat->minim>0) strat->posInL =posInLSpecial;
5722  // for further tests only
5723  if ((BTEST1(11)) || (BTEST1(12)))
5724    strat->posInL = posInL11;
5725  else if ((BTEST1(13)) || (BTEST1(14)))
5726    strat->posInL = posInL13;
5727  else if ((BTEST1(15)) || (BTEST1(16)))
5728    strat->posInL = posInL15;
5729  else if ((BTEST1(17)) || (BTEST1(18)))
5730    strat->posInL = posInL17;
5731  if (BTEST1(11))
5732    strat->posInT = posInT11;
5733  else if (BTEST1(13))
5734    strat->posInT = posInT13;
5735  else if (BTEST1(15))
5736    strat->posInT = posInT15;
5737  else if ((BTEST1(17)))
5738    strat->posInT = posInT17;
5739  else if ((BTEST1(19)))
5740    strat->posInT = posInT19;
5741  else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
5742    strat->posInT = posInT1;
5743#ifdef HAVE_RINGS
5744  if (rField_is_Ring(currRing))
5745  {
5746    strat->posInL = posInL11;
5747    strat->posInT = posInT11;
5748  }
5749#endif
5750  strat->posInLDependsOnLength = kPosInLDependsOnLength(strat->posInL);
5751}
5752
5753void initBuchMora (ideal F,ideal Q,kStrategy strat)
5754{
5755  strat->interpt = BTEST1(OPT_INTERRUPT);
5756  strat->kHEdge=NULL;
5757  if (pOrdSgn==1) strat->kHEdgeFound=FALSE;
5758  /*- creating temp data structures------------------- -*/
5759  strat->cp = 0;
5760  strat->c3 = 0;
5761  strat->tail = pInit();
5762  /*- set s -*/
5763  strat->sl = -1;
5764  /*- set L -*/
5765  strat->Lmax = ((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
5766  strat->Ll = -1;
5767  strat->L = initL(((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc);
5768  /*- set B -*/
5769  strat->Bmax = setmaxL;
5770  strat->Bl = -1;
5771  strat->B = initL();
5772  /*- set T -*/
5773  strat->tl = -1;
5774  strat->tmax = setmaxT;
5775  strat->T = initT();
5776  strat->R = initR();
5777  strat->sevT = initsevT();
5778  /*- init local data struct.---------------------------------------- -*/
5779  strat->P.ecart=0;
5780  strat->P.length=0;
5781  if (pOrdSgn==-1)
5782  {
5783    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
5784    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
5785  }
5786  if(TEST_OPT_SB_1)
5787  {
5788    int i;
5789    ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
5790    for (i=strat->newIdeal;i<IDELEMS(F);i++)
5791    {
5792      P->m[i-strat->newIdeal] = F->m[i];
5793      F->m[i] = NULL;
5794    }
5795    initSSpecial(F,Q,P,strat);
5796    for (i=strat->newIdeal;i<IDELEMS(F);i++)
5797    {
5798      F->m[i] = P->m[i-strat->newIdeal];
5799      P->m[i-strat->newIdeal] = NULL;
5800    }
5801    idDelete(&P);
5802  }
5803  else
5804  {
5805    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
5806    // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
5807  }
5808  strat->kIdeal = NULL;
5809  strat->fromT = FALSE;
5810  strat->noTailReduction = !TEST_OPT_REDTAIL;
5811  if (!TEST_OPT_SB_1)
5812  {
5813    updateS(TRUE,strat);
5814  }
5815  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
5816  strat->fromQ=NULL;
5817}
5818
5819void exitBuchMora (kStrategy strat)
5820{
5821  /*- release temp data -*/
5822  cleanT(strat);
5823  omFreeSize(strat->T,(strat->tmax)*sizeof(TObject));
5824  omFreeSize(strat->R,(strat->tmax)*sizeof(TObject*));
5825  omFreeSize(strat->sevT, (strat->tmax)*sizeof(unsigned long));
5826  omFreeSize(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
5827  omFreeSize(strat->sevS,IDELEMS(strat->Shdl)*sizeof(int));
5828  omFreeSize(strat->S_2_R,IDELEMS(strat->Shdl)*sizeof(int));
5829  /*- set L: should be empty -*/
5830  omFreeSize(strat->L,(strat->Lmax)*sizeof(LObject));
5831  /*- set B: should be empty -*/
5832  omFreeSize(strat->B,(strat->Bmax)*sizeof(LObject));
5833  pDeleteLm(&strat->tail);
5834  strat->syzComp=0;
5835  if (strat->kIdeal!=NULL)
5836  {
5837    omFreeBin(strat->kIdeal, sleftv_bin);
5838    strat->kIdeal=NULL;
5839  }
5840}
5841
5842/*2
5843* in the case of a standardbase of a module over a qring:
5844* replace polynomials in i by ak vectors,
5845* (the polynomial * unit vectors gen(1)..gen(ak)
5846* in every case (also for ideals:)
5847* deletes divisible vectors/polynomials
5848*/
5849void updateResult(ideal r,ideal Q, kStrategy strat)
5850{
5851  int l;
5852  if (strat->ak>0)
5853  {
5854    for (l=IDELEMS(r)-1;l>=0;l--)
5855    {
5856      if ((r->m[l]!=NULL) && (pGetComp(r->m[l])==0))
5857      {
5858        pDelete(&r->m[l]); // and set it to NULL
5859      }
5860    }
5861    int q;
5862    poly p;
5863    for (l=IDELEMS(r)-1;l>=0;l--)
5864    {
5865      if ((r->m[l]!=NULL)
5866      && (strat->syzComp>0)
5867      && (pGetComp(r->m[l])<=strat->syzComp))
5868      {
5869        for(q=IDELEMS(Q)-1; q>=0;q--)
5870        {
5871          if ((Q->m[q]!=NULL)
5872          &&(pLmDivisibleBy(Q->m[q],r->m[l])))
5873          {
5874            if (TEST_OPT_REDSB)
5875            {
5876              p=r->m[l];
5877              r->m[l]=kNF(Q,NULL,p);
5878              pDelete(&p);
5879            }
5880            else
5881            {
5882              pDelete(&r->m[l]); // and set it to NULL
5883            }
5884            break;
5885          }
5886        }
5887      }
5888    }
5889  }
5890  else
5891  {
5892    int q;
5893    poly p;
5894    BOOLEAN reduction_found=FALSE;
5895    for (l=IDELEMS(r)-1;l>=0;l--)
5896    {
5897      if (r->m[l]!=NULL)
5898      {
5899        for(q=IDELEMS(Q)-1; q>=0;q--)
5900        {
5901          if ((Q->m[q]!=NULL)
5902          &&(pLmEqual(r->m[l],Q->m[q])))
5903          {
5904            if (TEST_OPT_REDSB)
5905            {
5906              p=r->m[l];
5907              r->m[l]=kNF(Q,NULL,p);
5908              pDelete(&p);
5909              reduction_found=TRUE;
5910            }
5911            else
5912            {
5913              pDelete(&r->m[l]); // and set it to NULL
5914            }
5915            break;
5916          }
5917        }
5918      }
5919    }
5920    if (/*TEST_OPT_REDSB &&*/ reduction_found)
5921    {
5922      for (l=IDELEMS(r)-1;l>=0;l--)
5923      {
5924        if (r->m[l]!=NULL)
5925        {
5926          for(q=IDELEMS(r)-1;q>=0;q--)
5927          {
5928            if ((l!=q)
5929            && (r->m[q]!=NULL)
5930            &&(pLmDivisibleBy(r->m[l],r->m[q])))
5931            {
5932              pDelete(&r->m[q]);
5933            }
5934          }
5935        }
5936      }
5937    }
5938  }
5939  idSkipZeroes(r);
5940}
5941
5942void completeReduce (kStrategy strat, BOOLEAN withT)
5943{
5944  int i;
5945  int low = (((pOrdSgn==1) && (strat->ak==0)) ? 1 : 0);
5946  LObject L;
5947
5948#ifdef KDEBUG
5949  // need to set this: during tailreductions of T[i], T[i].max is out of
5950  // sync
5951  sloppy_max = TRUE;
5952#endif
5953
5954  strat->noTailReduction = FALSE;
5955  if (TEST_OPT_PROT)
5956  {
5957    PrintLn();
5958    if (timerv) writeTime("standard base computed:");
5959  }
5960  if (TEST_OPT_PROT)
5961  {
5962    Print("(S:%d)",strat->sl);mflush();
5963  }
5964  for (i=strat->sl; i>=low; i--)
5965  {
5966    int end_pos=strat->sl;
5967    if ((strat->fromQ!=NULL) && (strat->fromQ[i])) continue; // do not reduce Q_i
5968    if (strat->ak==0) end_pos=i-1;
5969    TObject* T_j = strat->s_2_t(i);
5970    if (T_j != NULL)
5971    {
5972      L = *T_j;
5973      poly p;
5974      if (pOrdSgn == 1)
5975        strat->S[i] = redtailBba(&L, end_pos, strat, withT);
5976      else
5977        strat->S[i] = redtail(&L, strat->sl, strat);
5978
5979      if (strat->redTailChange && strat->tailRing != currRing)
5980      {
5981        if (T_j->max != NULL) p_LmFree(T_j->max, strat->tailRing);
5982        if (pNext(T_j->p) != NULL)
5983          T_j->max = p_GetMaxExpP(pNext(T_j->p), strat->tailRing);
5984        else
5985          T_j->max = NULL;
5986      }
5987      if (TEST_OPT_INTSTRATEGY)
5988        T_j->pCleardenom();
5989    }
5990    else
5991    {
5992      assume(currRing == strat->tailRing);
5993      if (pOrdSgn == 1)
5994        strat->S[i] = redtailBba(strat->S[i], end_pos, strat, withT);
5995      else
5996        strat->S[i] = redtail(strat->S[i], strat->sl, strat);
5997      if (TEST_OPT_INTSTRATEGY)
5998        strat->S[i]=pCleardenom(strat->S[i]);
5999    }
6000    if (TEST_OPT_PROT)
6001      PrintS("-");
6002  }
6003  if (TEST_OPT_PROT) PrintLn();
6004#ifdef KDEBUG
6005  sloppy_max = FALSE;
6006#endif
6007}
6008
6009
6010/*2
6011* computes the new strat->kHEdge and the new pNoether,
6012* returns TRUE, if pNoether has changed
6013*/
6014BOOLEAN newHEdge(polyset S, kStrategy strat)
6015{
6016  int i,j;
6017  poly newNoether;
6018
6019#if 0
6020  if (currRing->weight_all_1)
6021    scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
6022  else
6023    scComputeHCw(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
6024#else
6025  scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
6026#endif
6027  if (strat->t_kHEdge != NULL) p_LmFree(strat->t_kHEdge, strat->tailRing);
6028  if (strat->tailRing != currRing)
6029    strat->t_kHEdge = k_LmInit_currRing_2_tailRing(strat->kHEdge, strat->tailRing);
6030  /* compare old and new noether*/
6031  newNoether = pLmInit(strat->kHEdge);
6032  j = pFDeg(newNoether,currRing);
6033  for (i=1; i<=pVariables; i++)
6034  {
6035    if (pGetExp(newNoether, i) > 0) pDecrExp(newNoether,i);
6036  }
6037  pSetm(newNoether);
6038  if (j < strat->HCord) /*- statistics -*/
6039  {
6040    if (TEST_OPT_PROT)
6041    {
6042      Print("H(%d)",j);
6043      mflush();
6044    }
6045    strat->HCord=j;
6046    #ifdef KDEBUG
6047    if (TEST_OPT_DEBUG)
6048    {
6049      Print("H(%d):",j);
6050      wrp(strat->kHEdge);
6051      PrintLn();
6052    }
6053    #endif
6054  }
6055  if (pCmp(strat->kNoether,newNoether)!=1)
6056  {
6057    pDelete(&strat->kNoether);
6058    strat->kNoether=newNoether;
6059    if (strat->t_kNoether != NULL) p_LmFree(strat->t_kNoether, strat->tailRing);
6060    if (strat->tailRing != currRing)
6061      strat->t_kNoether = k_LmInit_currRing_2_tailRing(strat->kNoether, strat->tailRing);
6062
6063    return TRUE;
6064  }
6065  pLmFree(newNoether);
6066  return FALSE;
6067}
6068
6069/***************************************************************
6070 *
6071 * Routines related for ring changes during std computations
6072 *
6073 ***************************************************************/
6074BOOLEAN kCheckSpolyCreation(LObject *L, kStrategy strat, poly &m1, poly &m2)
6075{
6076  assume(L->p1 != NULL && L->p2 != NULL);
6077  // shift changes: from 0 to -1
6078  assume(L->i_r1 >= -1 && L->i_r1 <= strat->tl);
6079  assume(L->i_r2 >= -1 && L->i_r2 <= strat->tl);
6080  assume(strat->tailRing != currRing);
6081
6082  if (! k_GetLeadTerms(L->p1, L->p2, currRing, m1, m2, strat->tailRing))
6083    return FALSE;
6084  // shift changes: extra case inserted
6085  if ((L->i_r1 == -1) || (L->i_r2 == -1) )
6086  {
6087    return TRUE;
6088  }
6089  poly p1_max = (strat->R[L->i_r1])->max;
6090  poly p2_max = (strat->R[L->i_r2])->max;
6091
6092  if ((p1_max != NULL && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
6093      (p2_max != NULL && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
6094  {
6095    p_LmFree(m1, strat->tailRing);
6096    p_LmFree(m2, strat->tailRing);
6097    m1 = NULL;
6098    m2 = NULL;
6099    return FALSE;
6100  }
6101  return TRUE;
6102}
6103
6104#ifdef HAVE_RINGS
6105/***************************************************************
6106 *
6107 * Checks, if we can compute the gcd poly / strong pair
6108 * gcd-poly = m1 * R[atR] + m2 * S[atS]
6109 *
6110 ***************************************************************/
6111BOOLEAN kCheckStrongCreation(int atR, poly m1, int atS, poly m2, kStrategy strat)
6112{
6113  assume(strat->S_2_R[atS] >= -1 && strat->S_2_R[atS] <= strat->tl);
6114  //assume(strat->tailRing != currRing);
6115
6116  poly p1_max = (strat->R[atR])->max;
6117  poly p2_max = (strat->R[strat->S_2_R[atS]])->max;
6118
6119  if ((p1_max != NULL && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
6120      (p2_max != NULL && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
6121  {
6122    return FALSE;
6123  }
6124  return TRUE;
6125}
6126#endif
6127
6128BOOLEAN kStratChangeTailRing(kStrategy strat, LObject *L, TObject* T, unsigned long expbound)
6129{
6130  if (expbound == 0) expbound = strat->tailRing->bitmask << 1;
6131  if (expbound >= currRing->bitmask) return FALSE;
6132  ring new_tailRing = rModifyRing(currRing,
6133                                  // Hmmm .. the condition pFDeg == pDeg
6134                                  // might be too strong
6135#ifdef HAVE_RINGS
6136                                  (strat->homog && pFDeg == pDeg && !(rField_is_Ring(currRing))), // TODO Oliver
6137#else
6138                                  (strat->homog && pFDeg == pDeg),
6139#endif
6140                                  !strat->ak,
6141                                  expbound);
6142  if (new_tailRing == currRing) return TRUE;
6143
6144  strat->pOrigFDeg_TailRing = new_tailRing->pFDeg;
6145  strat->pOrigLDeg_TailRing = new_tailRing->pLDeg;
6146
6147  if (currRing->pFDeg != currRing->pFDegOrig)
6148  {
6149    new_tailRing->pFDeg = currRing->pFDeg;
6150    new_tailRing->pLDeg = currRing->pLDeg;
6151  }
6152
6153  if (TEST_OPT_PROT)
6154    Print("[%lu:%d", (unsigned long) new_tailRing->bitmask, new_tailRing->ExpL_Size);
6155  kTest_TS(strat);
6156  assume(new_tailRing != strat->tailRing);
6157  pShallowCopyDeleteProc p_shallow_copy_delete
6158    = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
6159
6160  omBin new_tailBin = omGetStickyBinOfBin(new_tailRing->PolyBin);
6161
6162  int i;
6163  for (i=0; i<=strat->tl; i++)
6164  {
6165    strat->T[i].ShallowCopyDelete(new_tailRing, new_tailBin,
6166                                  p_shallow_copy_delete);
6167  }
6168  for (i=0; i<=strat->Ll; i++)
6169  {
6170    assume(strat->L[i].p != NULL);
6171    if (pNext(strat->L[i].p) != strat->tail)
6172      strat->L[i].ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
6173  }
6174  if (strat->P.t_p != NULL ||
6175      (strat->P.p != NULL && pNext(strat->P.p) != strat->tail))
6176    strat->P.ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
6177
6178  if (L != NULL && L->tailRing != new_tailRing)
6179  {
6180    if (L->i_r < 0)
6181      L->ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
6182    else
6183    {
6184      assume(L->i_r <= strat->tl);
6185      TObject* t_l = strat->R[L->i_r];
6186      assume(t_l != NULL);
6187      L->tailRing = new_tailRing;
6188      L->p = t_l->p;
6189      L->t_p = t_l->t_p;
6190      L->max = t_l->max;
6191    }
6192  }
6193
6194  if (T != NULL && T->tailRing != new_tailRing && T->i_r < 0)
6195    T->ShallowCopyDelete(new_tailRing, new_tailBin, p_shallow_copy_delete);
6196
6197  omMergeStickyBinIntoBin(strat->tailBin, strat->tailRing->PolyBin);
6198  if (strat->tailRing != currRing)
6199    rKillModifiedRing(strat->tailRing);
6200
6201  strat->tailRing = new_tailRing;
6202  strat->tailBin = new_tailBin;
6203  strat->p_shallow_copy_delete
6204    = pGetShallowCopyDeleteProc(currRing, new_tailRing);
6205
6206  if (strat->kHEdge != NULL)
6207  {
6208    if (strat->t_kHEdge != NULL)
6209      p_LmFree(strat->t_kHEdge, strat->tailRing);
6210    strat->t_kHEdge=k_LmInit_currRing_2_tailRing(strat->kHEdge, new_tailRing);
6211  }
6212
6213  if (strat->kNoether != NULL)
6214  {
6215    if (strat->t_kNoether != NULL)
6216      p_LmFree(strat->t_kNoether, strat->tailRing);
6217    strat->t_kNoether=k_LmInit_currRing_2_tailRing(strat->kNoether,
6218                                                   new_tailRing);
6219  }
6220  kTest_TS(strat);
6221  if (TEST_OPT_PROT)
6222    PrintS("]");
6223  return TRUE;
6224}
6225
6226void kStratInitChangeTailRing(kStrategy strat)
6227{
6228  unsigned long l = 0;
6229  int i;
6230  Exponent_t e;
6231  ring new_tailRing;
6232
6233  assume(strat->tailRing == currRing);
6234
6235  for (i=0; i<= strat->Ll; i++)
6236  {
6237    l = p_GetMaxExpL(strat->L[i].p, currRing, l);
6238  }
6239  for (i=0; i<=strat->tl; i++)
6240  {
6241    // Hmm ... this we could do in one Step
6242    l = p_GetMaxExpL(strat->T[i].p, currRing, l);
6243  }
6244  if (rField_is_Ring(currRing))
6245  {
6246    l *= 2;
6247  }
6248  e = p_GetMaxExp(l, currRing);
6249  if (e <= 1) e = 2;
6250
6251  kStratChangeTailRing(strat, NULL, NULL, e);
6252}
6253
6254skStrategy::skStrategy()
6255{
6256  memset(this, 0, sizeof(skStrategy));
6257#ifndef NDEBUG
6258  strat_nr++;
6259  nr=strat_nr;
6260  if (strat_fac_debug) Print("s(%d) created\n",nr);
6261#endif
6262  tailRing = currRing;
6263  P.tailRing = currRing;
6264  tl = -1;
6265  sl = -1;
6266#ifdef HAVE_LM_BIN
6267  lmBin = omGetStickyBinOfBin(currRing->PolyBin);
6268#endif
6269#ifdef HAVE_TAIL_BIN
6270  tailBin = omGetStickyBinOfBin(currRing->PolyBin);
6271#endif
6272  pOrigFDeg = pFDeg;
6273  pOrigLDeg = pLDeg;
6274}
6275
6276
6277skStrategy::~skStrategy()
6278{
6279  if (lmBin != NULL)
6280    omMergeStickyBinIntoBin(lmBin, currRing->PolyBin);
6281  if (tailBin != NULL)
6282    omMergeStickyBinIntoBin(tailBin,
6283                            (tailRing != NULL ? tailRing->PolyBin:
6284                             currRing->PolyBin));
6285  if (t_kHEdge != NULL)
6286    p_LmFree(t_kHEdge, tailRing);
6287  if (t_kNoether != NULL)
6288    p_LmFree(t_kNoether, tailRing);
6289
6290  if (currRing != tailRing)
6291    rKillModifiedRing(tailRing);
6292  pRestoreDegProcs(pOrigFDeg, pOrigLDeg);
6293}
6294
6295#if 0
6296Timings for the different possibilities of posInT:
6297            T15           EDL         DL          EL            L         1-2-3
6298Gonnet      43.26       42.30       38.34       41.98       38.40      100.04
6299Hairer_2_1   1.11        1.15        1.04        1.22        1.08        4.7
6300Twomat3      1.62        1.69        1.70        1.65        1.54       11.32
6301ahml         4.48        4.03        4.03        4.38        4.96       26.50
6302c7          15.02       13.98       15.16       13.24       17.31       47.89
6303c8         505.09      407.46      852.76      413.21      499.19        n/a
6304f855        12.65        9.27       14.97        8.78       14.23       33.12
6305gametwo6    11.47       11.35       14.57       11.20       12.02       35.07
6306gerhard_3    2.73        2.83        2.93        2.64        3.12        6.24
6307ilias13     22.89       22.46       24.62       20.60       23.34       53.86
6308noon8       40.68       37.02       37.99       36.82       35.59      877.16
6309rcyclic_19  48.22       42.29       43.99       45.35       51.51      204.29
6310rkat9       82.37       79.46       77.20       77.63       82.54      267.92
6311schwarz_11  16.46       16.81       16.76       16.81       16.72       35.56
6312test016     16.39       14.17       14.40       13.50       14.26       34.07
6313test017     34.70       36.01       33.16       35.48       32.75       71.45
6314test042     10.76       10.99       10.27       11.57       10.45       23.04
6315test058      6.78        6.75        6.51        6.95        6.22        9.47
6316test066     10.71       10.94       10.76       10.61       10.56       19.06
6317test073     10.75       11.11       10.17       10.79        8.63       58.10
6318test086     12.23       11.81       12.88       12.24       13.37       66.68
6319test103      5.05        4.80        5.47        4.64        4.89       11.90
6320test154     12.96       11.64       13.51       12.46       14.61       36.35
6321test162     65.27       64.01       67.35       59.79       67.54      196.46
6322test164      7.50        6.50        7.68        6.70        7.96       17.13
6323virasoro     3.39        3.50        3.35        3.47        3.70        7.66
6324#endif
6325
6326
6327#ifdef HAVE_MORE_POS_IN_T
6328// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
6329int posInT_EcartFDegpLength(const TSet set,const int length,LObject &p)
6330{
6331
6332  if (length==-1) return 0;
6333
6334  int o = p.ecart;
6335  int op=p.GetpFDeg();
6336  int ol = p.GetpLength();
6337
6338  if (set[length].ecart < o)
6339    return length+1;
6340  if (set[length].ecart == o)
6341  {
6342     int oo=set[length].GetpFDeg();
6343     if ((oo < op) || ((oo==op) && (set[length].length < ol)))
6344       return length+1;
6345  }
6346
6347  int i;
6348  int an = 0;
6349  int en= length;
6350  loop
6351  {
6352    if (an >= en-1)
6353    {
6354      if (set[an].ecart > o)
6355        return an;
6356      if (set[an].ecart == o)
6357      {
6358         int oo=set[an].GetpFDeg();
6359         if((oo > op)
6360         || ((oo==op) && (set[an].pLength > ol)))
6361           return an;
6362      }
6363      return en;
6364    }
6365    i=(an+en) / 2;
6366    if (set[i].ecart > o)
6367      en=i;
6368    else if (set[i].ecart == o)
6369    {
6370       int oo=set[i].GetpFDeg();
6371       if ((oo > op)
6372       || ((oo == op) && (set[i].pLength > ol)))
6373         en=i;
6374       else
6375        an=i;
6376    }
6377    else
6378      an=i;
6379  }
6380}
6381
6382// determines the position based on: 1.) FDeg 2.) pLength
6383int posInT_FDegpLength(const TSet set,const int length,LObject &p)
6384{
6385
6386  if (length==-1) return 0;
6387
6388  int op=p.GetpFDeg();
6389  int ol = p.GetpLength();
6390
6391  int oo=set[length].GetpFDeg();
6392  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
6393    return length+1;
6394
6395  int i;
6396  int an = 0;
6397  int en= length;
6398  loop
6399    {
6400      if (an >= en-1)
6401      {
6402        int oo=set[an].GetpFDeg();
6403        if((oo > op)
6404           || ((oo==op) && (set[an].pLength > ol)))
6405          return an;
6406        return en;
6407      }
6408      i=(an+en) / 2;
6409      int oo=set[i].GetpFDeg();
6410      if ((oo > op)
6411          || ((oo == op) && (set[i].pLength > ol)))
6412        en=i;
6413      else
6414        an=i;
6415    }
6416}
6417
6418
6419// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
6420int posInT_pLength(const TSet set,const int length,LObject &p)
6421{
6422  if (length==-1)
6423    return 0;
6424  if (set[length].length<p.length)
6425    return length+1;
6426
6427  int i;
6428  int an = 0;
6429  int en= length;
6430  int ol = p.GetpLength();
6431
6432  loop
6433  {
6434    if (an >= en-1)
6435    {
6436      if (set[an].pLength>ol) return an;
6437      return en;
6438    }
6439    i=(an+en) / 2;
6440    if (set[i].pLength>ol) en=i;
6441    else                        an=i;
6442  }
6443}
6444#endif
6445
6446// kstd1.cc:
6447int redFirst (LObject* h,kStrategy strat);
6448int redEcart (LObject* h,kStrategy strat);
6449void enterSMora (LObject p,int atS,kStrategy strat, int atR=-1);
6450void enterSMoraNF (LObject p,int atS,kStrategy strat, int atR=-1);
6451// ../Singular/misc.cc:
6452char *  showOption();
6453
6454void kDebugPrint(kStrategy strat)
6455{
6456  PrintS("red: ");
6457    if (strat->red==redFirst) PrintS("redFirst\n");
6458    else if (strat->red==redHoney) PrintS("redHoney\n");
6459    else if (strat->red==redEcart) PrintS("redEcart\n");
6460    else if (strat->red==redHomog) PrintS("redHomog\n");
6461    else  Print("%x\n",strat->red);
6462  PrintS("posInT: ");
6463    if (strat->posInT==posInT0) PrintS("posInT0\n");
6464    else if (strat->posInT==posInT0) PrintS("posInT0\n");
6465    else if (strat->posInT==posInT1) PrintS("posInT1\n");
6466    else if (strat->posInT==posInT11) PrintS("posInT11\n");
6467    else if (strat->posInT==posInT110) PrintS("posInT110\n");
6468    else if (strat->posInT==posInT13) PrintS("posInT13\n");
6469    else if (strat->posInT==posInT15) PrintS("posInT15\n");
6470    else if (strat->posInT==posInT17) PrintS("posInT17\n");
6471    else if (strat->posInT==posInT17_c) PrintS("posInT17_c\n");
6472    else if (strat->posInT==posInT19) PrintS("posInT19\n");
6473    else if (strat->posInT==posInT2) PrintS("posInT2\n");
6474#ifdef HAVE_MORE_POS_IN_T
6475    else if (strat->posInT==posInT_EcartFDegpLength) PrintS("posInT_EcartFDegpLength\n");
6476    else if (strat->posInT==posInT_FDegpLength) PrintS("posInT_FDegpLength\n");
6477    else if (strat->posInT==posInT_pLength) PrintS("posInT_pLength\n");
6478#endif
6479    else if (strat->posInT==posInT_EcartpLength) PrintS("posInT_EcartpLength\n");
6480    else if (strat->posInT==posInTrg0) PrintS("posInTrg0\n");
6481    else  Print("%x\n",strat->posInT);
6482  PrintS("posInL: ");
6483    if (strat->posInL==posInL0) PrintS("posInL0\n");
6484    else if (strat->posInL==posInL10) PrintS("posInL10\n");
6485    else if (strat->posInL==posInL11) PrintS("posInL11\n");
6486    else if (strat->posInL==posInL110) PrintS("posInL110\n");
6487    else if (strat->posInL==posInL13) PrintS("posInL13\n");
6488    else if (strat->posInL==posInL15) PrintS("posInL15\n");
6489    else if (strat->posInL==posInL17) PrintS("posInL17\n");
6490    else if (strat->posInL==posInL17_c) PrintS("posInL17\n");
6491    else if (strat->posInL==posInLSpecial) PrintS("posInLSpecial\n");
6492    else if (strat->posInL==posInLrg0) PrintS("posInLrg0\n");
6493    else  Print("%x\n",strat->posInL);
6494  PrintS("enterS: ");
6495    if (strat->enterS==enterSBba) PrintS("enterSBba\n");
6496    else if (strat->enterS==enterSMora) PrintS("enterSMora\n");
6497    else if (strat->enterS==enterSMoraNF) PrintS("enterSMoraNF\n");
6498    else  Print("%x\n",strat->enterS);
6499  PrintS("initEcart: ");
6500    if (strat->initEcart==initEcartBBA) PrintS("initEcartBBA\n");
6501    else if (strat->initEcart==initEcartNormal) PrintS("initEcartNormal\n");
6502    else  Print("%x\n",strat->initEcart);
6503  PrintS("initEcartPair: ");
6504    if (strat->initEcartPair==initEcartPairBba) PrintS("initEcartPairBba\n");
6505    else if (strat->initEcartPair==initEcartPairMora) PrintS("initEcartPairMora\n");
6506    else  Print("%x\n",strat->initEcartPair);
6507  Print("homog=%d, LazyDegree=%d, LazyPass=%d, ak=%d,\n",
6508         strat->homog, strat->LazyDegree,strat->LazyPass, strat->ak);
6509  Print("honey=%d, sugarCrit=%d, Gebauer=%d, noTailReduction=%d\n",
6510         strat->honey,strat->sugarCrit,strat->Gebauer,strat->noTailReduction,strat->use_buckets);
6511  Print("posInLDependsOnLength=%d, use_buckets=%d\n",
6512         strat->posInLDependsOnLength,strat->use_buckets);
6513   PrintS(showOption());PrintLn();
6514}
6515
6516
6517#ifdef HAVE_SHIFTBBA
6518poly pMove2CurrTail(poly p, kStrategy strat)
6519{
6520  /* assume: p is completely in currRing */
6521  /* produces an object with LM in curring
6522     and TAIL in tailring */
6523  if (pNext(p)!=NULL)
6524  {
6525    pNext(p) = prMoveR(pNext(p), /* src */ currRing, /* dest */ strat->tailRing);
6526  }
6527  return(p);
6528}
6529#endif
6530
6531#ifdef HAVE_SHIFTBBA
6532poly pMoveCurrTail2poly(poly p, kStrategy strat)
6533{
6534  /* assume: p has  LM in curring and TAIL in tailring */
6535  /* convert it to complete currRing */
6536
6537  /* check that LM is in currRing */
6538  assume(p_LmCheckIsFromRing(p, currRing));
6539
6540  if (pNext(p)!=NULL)
6541  {
6542    pNext(p) = prMoveR(pNext(p), /* src */ strat->tailRing, /* dest */currRing);
6543  }
6544  return(p);
6545}
6546#endif
6547
6548#ifdef HAVE_SHIFTBBA
6549poly pCopyL2p(LObject H, kStrategy strat)
6550{
6551    /* restores a poly in currRing from LObject */
6552    LObject h = H;
6553    h.Copy();
6554    poly p;
6555    if (h.p == NULL)
6556    {
6557      if (h.t_p != NULL)
6558      {
6559         p = prMoveR(h.t_p, /* source ring: */ strat->tailRing, /* dest. ring: */ currRing);
6560        return(p);
6561      }
6562      else
6563      {
6564        /* h.tp == NULL -> the object is NULL */
6565        return(NULL);
6566      }
6567    }
6568    /* we're here if h.p != NULL */
6569    if (h.t_p == NULL)
6570    {
6571       /* then h.p is the whole poly in currRing */
6572       p = h.p;
6573      return(p);
6574    }
6575    /* we're here if h.p != NULL and h.t_p != NULL */
6576    // clean h.p, get poly from t_p
6577     pNext(h.p)=NULL;
6578     pDelete(&h.p);
6579     p = prMoveR(h.t_p, /* source ring: */ strat->tailRing,
6580                         /* dest. ring: */ currRing);
6581     // no need to clean h: we re-used the polys
6582    return(p);
6583}
6584#endif
6585
6586//LObject pCopyp2L(poly p, kStrategy strat)
6587//{
6588    /* creates LObject from the poly in currRing */
6589  /* actually put p into L.p and make L.t_p=NULL : does not work */
6590
6591//}
6592
6593// poly pCopyL2p(LObject H, kStrategy strat)
6594// {
6595//   /* restores a poly in currRing from LObject */
6596//   LObject h = H;
6597//   h.Copy();
6598//   poly p;
6599//   if (h.p == NULL)
6600//   {
6601//     if (h.t_p != NULL)
6602//     {
6603//       p = p_ShallowCopyDelete(h.t_p, (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
6604//       return(p);
6605//     }
6606//     else
6607//     {
6608//       /* h.tp == NULL -> the object is NULL */
6609//       return(NULL);
6610//     }
6611//   }
6612//   /* we're here if h.p != NULL */
6613
6614//   if (h.t_p == NULL)
6615//   {
6616//     /* then h.p is the whole poly in tailRing */
6617//     if (strat->tailBin != NULL && (pNext(h.p) != NULL))
6618//     {
6619//       p = p_ShallowCopyDelete(h.p, (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
6620//     }
6621//     return(p);
6622//   }
6623//   /* we're here if h.p != NULL and h.t_p != NULL */
6624//   p = pCopy(pHead(h.p)); // in currRing
6625//   if (strat->tailBin != NULL && (pNext(h.p) != NULL))
6626//   {
6627//     //    pNext(p) = p_ShallowCopyDelete(pNext(h.t_p), (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
6628//     poly pp = p_Copy(pNext(h.p), strat->tailRing);
6629//     //    poly p3 = p_Copy(pNext(h.p), currRing); // error
6630//       // p_ShallowCopyDelete(pNext(h.p), currRing, strat->tailBin); // the same as pp
6631//     poly p5 = p_ShallowCopyDelete(pNext(h.p), strat->tailRing, strat->tailBin);
6632//     pNext(p) = p_ShallowCopyDelete(h.t_p, strat->tailRing, strat->tailBin);
6633//     poly p4 = p_Copy(h.t_p, strat->tailRing);
6634//     //    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
6635//   }
6636//   //  pTest(p);
6637//   return(p);
6638// }
6639
6640#ifdef HAVE_SHIFTBBA
6641/* including the self pairs */
6642void updateSShift(kStrategy strat,int uptodeg,int lV)
6643{
6644  /* to use after updateS(toT=FALSE,strat) */
6645  /* fills T with shifted elt's of S */
6646  int i;
6647  LObject h;
6648  int atT = -1; // or figure out smth better
6649  strat->tl = -1; // init
6650  for (i=0; i<=strat->sl; i++)
6651  {
6652    memset(&h,0,sizeof(h));
6653    h.p =  strat->S[i]; // lm in currRing, tail in TR
6654    strat->initEcart(&h);
6655    h.sev = strat->sevS[i];
6656    h.t_p = NULL;
6657    h.GetTP(); // creates correct t_p
6658    /*puts the elements of S with their shifts to T*/
6659    //    int atT, int uptodeg, int lV)
6660    strat->S_2_R[i] = strat->tl + 1; // the el't with shift 0 will be inserted first
6661    // need a small check for above; we insert >=1 elements
6662    // insert this check into kTest_TS ?
6663    enterTShift(h,strat,atT,uptodeg,lV);
6664  }
6665  /* what about setting strat->tl? */
6666}
6667#endif
6668
6669#ifdef HAVE_SHIFTBBA
6670void initBuchMoraShift (ideal F,ideal Q,kStrategy strat)
6671{
6672  strat->interpt = BTEST1(OPT_INTERRUPT);
6673  strat->kHEdge=NULL;
6674  if (pOrdSgn==1) strat->kHEdgeFound=FALSE;
6675  /*- creating temp data structures------------------- -*/
6676  strat->cp = 0;
6677  strat->c3 = 0;
6678  strat->cv = 0;
6679  strat->tail = pInit();
6680  /*- set s -*/
6681  strat->sl = -1;
6682  /*- set L -*/
6683  strat->Lmax = setmaxL;
6684  strat->Ll = -1;
6685  strat->L = initL();
6686  /*- set B -*/
6687  strat->Bmax = setmaxL;
6688  strat->Bl = -1;
6689  strat->B = initL();
6690  /*- set T -*/
6691  strat->tl = -1;
6692  strat->tmax = setmaxT;
6693  strat->T = initT();
6694  strat->R = initR();
6695  strat->sevT = initsevT();
6696  /*- init local data struct.---------------------------------------- -*/
6697  strat->P.ecart=0;
6698  strat->P.length=0;
6699  if (pOrdSgn==-1)
6700  {
6701    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
6702    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
6703  }
6704  if(TEST_OPT_SB_1)
6705  {
6706    int i;
6707    ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
6708    for (i=strat->newIdeal;i<IDELEMS(F);i++)
6709    {
6710      P->m[i-strat->newIdeal] = F->m[i];
6711      F->m[i] = NULL;
6712    }
6713    initSSpecial(F,Q,P,strat);
6714    for (i=strat->newIdeal;i<IDELEMS(F);i++)
6715    {
6716      F->m[i] = P->m[i-strat->newIdeal];
6717      P->m[i-strat->newIdeal] = NULL;
6718    }
6719    idDelete(&P);
6720  }
6721  else
6722  {
6723    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
6724    // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
6725  }
6726  strat->kIdeal = NULL;
6727  strat->fromT = FALSE;
6728  strat->noTailReduction = !TEST_OPT_REDTAIL;
6729  if (!TEST_OPT_SB_1)
6730  {
6731    /* the only change: we do not fill the set T*/
6732    updateS(FALSE,strat);
6733  }
6734  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
6735  strat->fromQ=NULL;
6736  /* more changes: fill the set T with all the shifts of elts of S*/
6737  /* is done by other procedure */
6738}
6739#endif
6740
6741#ifdef HAVE_SHIFTBBA
6742/*1
6743* put the pairs (sh \dot s[i],p)  into the set B, ecart=ecart(p)
6744*/
6745void enterOnePairManyShifts (int i, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int uptodeg, int lV)
6746{
6747  /* p comes from strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
6748
6749  assume(p_LmCheckIsFromRing(p,currRing));
6750  assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
6751
6752  /* cycles through all shifts of s[i] until uptodeg - lastVblock(s[i]) */
6753  /* that is create the pairs (f, s \dot g)  */
6754
6755  poly qq = strat->S[i]; //  lm in currRing, tail in tailRing
6756
6757  //  poly q = pCopy(pHead(strat->S[i])); // lm in currRing
6758  //  pNext(q) = prCopyR(pNext(strat->S[i]),strat->tailRing,currRing); // zero shift
6759
6760 /* determine how many elements we have to insert for a given s[i] */
6761  /* x(0)y(1)z(2) : lastVblock-1=2, to add until lastVblock=uptodeg-1 */
6762  /* hence, a total number of elt's to add is: */
6763  /*  int toInsert = 1 + (uptodeg-1) - (pLastVblock(p.p, lV) -1);  */
6764  int toInsert =  itoInsert(qq, uptodeg,  lV, strat->tailRing);
6765
6766#ifdef KDEBUG
6767    if (TEST_OPT_DEBUG)
6768    {
6769      //      Print("entered ManyShifts: with toInsert=%d",toInsert); PrintLn();
6770    }
6771#endif
6772
6773  assume(i<=strat->sl); // from OnePair
6774  if (strat->interred_flag) return; // ?
6775
6776  /* these vars hold for all shifts of s[i] */
6777  int ecartq = 0; //Hans says it's ok; we're in the homog case, no ecart
6778
6779  int qfromQ;
6780  if (strat->fromQ != NULL)
6781  {
6782    qfromQ = strat->fromQ[i];
6783  }
6784  else
6785  {
6786    qfromQ = -1;
6787  }
6788
6789  int j;
6790
6791  poly q, s;
6792
6793  // for the 0th shift: insert the orig. pair
6794  enterOnePairShift(qq, p, ecart, isFromQ, strat, -1, ecartq, qfromQ, j, i, uptodeg, lV);
6795
6796  for (j=1; j<= toInsert; j++)
6797  {
6798    //    q = pLPshift(strat->S[i],j,uptodeg,lV);
6799    q = p_LPshiftT(qq, j, uptodeg, lV, strat, currRing);
6800    //    q = p_mLPshift(qq,j,uptodeg,lV,currRing); // lm in currRing, shift this monomial
6801    //    s = p_LPshift(pNext(qq), j, uptodeg, lV, strat->tailRing); // from tailRing
6802    //    pNext(q) = s; // in tailRing
6803    /* here we need to call enterOnePair with two polys ... */
6804
6805#ifdef KDEBUG
6806    if (TEST_OPT_DEBUG)
6807    {
6808      //      PrintS("ManyShifts: calling enterOnePairShift(q,p)");      PrintLn();
6809    }
6810#endif
6811    enterOnePairShift(q, p, ecart, isFromQ, strat, -1, ecartq, qfromQ, j, i, uptodeg, lV);
6812  }
6813}
6814#endif
6815
6816#ifdef HAVE_SHIFTBBA
6817/*1
6818* put the pairs (sh \dot qq,p)  into the set B, ecart=ecart(p)
6819* despite the name, not only self shifts
6820*/
6821void enterOnePairSelfShifts (poly qq, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int uptodeg, int lV)
6822{
6823
6824  /* format: p,qq are in LObject form: lm in CR, tail in TR */
6825  /* for true self pairs qq ==p  */
6826  /* we test both qq and p */
6827  assume(p_LmCheckIsFromRing(qq,currRing));
6828  assume(p_CheckIsFromRing(pNext(qq),strat->tailRing));
6829  assume(p_LmCheckIsFromRing(p,currRing));
6830  assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
6831
6832  /* since this proc is applied twice for (h, s*g) and (g,s*h), init j with 1 only */
6833
6834  //  int j = 0;
6835  int j = 1;
6836
6837  /* for such self pairs start with 1, not with 0 */
6838  if (qq == p) j=1;
6839
6840  /* should cycle through all shifts of q until uptodeg - lastVblock(q) */
6841  /* that is create the pairs (f, s \dot g)  */
6842
6843  int toInsert =  itoInsert(qq, uptodeg,  lV, strat->tailRing);
6844
6845#ifdef KDEBUG
6846    if (TEST_OPT_DEBUG)
6847    {
6848      //      Print("entered SelfShifts: with toInsert=%d",toInsert); PrintLn();
6849    }
6850#endif
6851
6852  poly q, s;
6853
6854  if (strat->interred_flag) return; // ?
6855
6856  /* these vars hold for all shifts of s[i] */
6857  int ecartq = 0; //Hans says it's ok; we're in the homog case, no ecart
6858  int qfromQ = 0; // strat->fromQ[i];
6859
6860  for (; j<= toInsert; j++)
6861  {
6862    //    q = pLPshift(strat->S[i],j,uptodeg,lV);
6863    /* we increase shifts by one; must delete q there*/
6864    //    q = qq; q = pMoveCurrTail2poly(q,strat);
6865    //    q = pLPshift(q,j,uptodeg,lV); //,currRing);
6866    q = p_LPshiftT(qq, j, uptodeg, lV, strat, currRing);
6867    //    q = p_mLPshift(qq,j,uptodeg,lV,currRing); // lm in currRing, shift this monomial
6868    //    s = p_LPshift(pNext(qq), j, uptodeg, lV, strat->tailRing); // from tailRing
6869    //    pNext(q) = s; // in tailRing
6870    /* here we need to call enterOnePair with two polys ... */
6871#ifdef KDEBUG
6872    if (TEST_OPT_DEBUG)
6873    {
6874      //      PrintS("SelfShifts: calling enterOnePairShift(q,p)");      PrintLn();
6875    }
6876#endif
6877    enterOnePairShift(q, p, ecart, isFromQ, strat, -1, ecartq, qfromQ, j, -1, uptodeg, lV);
6878  }
6879}
6880#endif
6881
6882#ifdef HAVE_SHIFTBBA
6883/*2
6884* put the pair (q,p)  into the set B, ecart=ecart(p), q is the shift of some s[i]
6885*/
6886void 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)
6887{
6888
6889  /* Format: q and p are like strat->P.p, so lm in CR, tail in TR */
6890
6891  /* check this Formats: */
6892  assume(p_LmCheckIsFromRing(q,currRing));
6893  assume(p_CheckIsFromRing(pNext(q),strat->tailRing));
6894  assume(p_LmCheckIsFromRing(p,currRing));
6895  assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
6896
6897#ifdef KDEBUG
6898    if (TEST_OPT_DEBUG)
6899    {
6900//       PrintS("enterOnePairShift(q,p) invoked with q = ");
6901//       wrp(q); //      wrp(pHead(q));
6902//       PrintS(", p = ");
6903//       wrp(p); //wrp(pHead(p));
6904//       PrintLn();
6905    }
6906#endif
6907
6908  /* poly q stays for s[i], ecartq = ecart(q), qisFromQ = applies to q */
6909
6910  int qfromQ = qisFromQ;
6911
6912  /* need additionally: int up_to_degree, poly V0 with the variables in (0)  or just the number lV = the length of the first block */
6913
6914  if (strat->interred_flag) return;
6915
6916  int      l,j,compare;
6917  LObject  Lp;
6918  Lp.i_r = -1;
6919
6920#ifdef KDEBUG
6921  Lp.ecart=0; Lp.length=0;
6922#endif
6923  /*- computes the lcm(s[i],p) -*/
6924  Lp.lcm = pInit();
6925
6926  pLcm(p,q, Lp.lcm); // q is what was strat->S[i], so a poly in LM/TR presentation
6927  pSetm(Lp.lcm);
6928
6929  /* apply the V criterion */
6930  if (!isInV(Lp.lcm, lV))
6931  {
6932#ifdef KDEBUG
6933    if (TEST_OPT_DEBUG)
6934    {
6935      PrintS("V crit applied to q = ");
6936      wrp(q); //      wrp(pHead(q));
6937      PrintS(", p = ");
6938      wrp(p); //wrp(pHead(p));
6939      PrintLn();
6940    }
6941#endif
6942    pLmFree(Lp.lcm);
6943    Lp.lcm=NULL;
6944    /* + counter for applying the V criterion */
6945    strat->cv++;
6946    return;
6947  }
6948
6949  if (strat->sugarCrit && ALLOW_PROD_CRIT(strat))
6950  {
6951    if((!((ecartq>0)&&(ecart>0)))
6952    && pHasNotCF(p,q))
6953    {
6954    /*
6955    *the product criterion has applied for (s,p),
6956    *i.e. lcm(s,p)=product of the leading terms of s and p.
6957    *Suppose (s,r) is in L and the leading term
6958    *of p divides lcm(s,r)
6959    *(==> the leading term of p divides the leading term of r)
6960    *but the leading term of s does not divide the leading term of r
6961    *(notice that this condition is automatically satisfied if r is still
6962    *in S), then (s,r) can be cancelled.
6963    *This should be done here because the
6964    *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
6965    *
6966    *Moreover, skipping (s,r) holds also for the noncommutative case.
6967    */
6968      strat->cp++;
6969      pLmFree(Lp.lcm);
6970      Lp.lcm=NULL;
6971      return;
6972    }
6973    else
6974      Lp.ecart = si_max(ecart,ecartq);
6975    if (strat->fromT && (ecartq>ecart))
6976    {
6977      pLmFree(Lp.lcm);
6978      Lp.lcm=NULL;
6979      return;
6980      /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
6981    }
6982    /*
6983    *the set B collects the pairs of type (S[j],p)
6984    *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
6985    *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
6986    *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
6987    */
6988    {
6989      j = strat->Bl;
6990      loop
6991      {
6992        if (j < 0)  break;
6993        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
6994        if ((compare==1)
6995        &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
6996        {
6997          strat->c3++;
6998          if ((strat->fromQ==NULL) || (isFromQ==0) || (qfromQ==0))
6999          {
7000            pLmFree(Lp.lcm);
7001            return;
7002          }
7003          break;
7004        }
7005        else
7006        if ((compare ==-1)
7007        && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
7008        {
7009          deleteInL(strat->B,&strat->Bl,j,strat);
7010          strat->c3++;
7011        }
7012        j--;
7013      }
7014    }
7015  }
7016  else /*sugarcrit*/
7017  {
7018    if (ALLOW_PROD_CRIT(strat))
7019    {
7020      // if currRing->nc_type!=quasi (or skew)
7021      // TODO: enable productCrit for super commutative algebras...
7022      if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
7023      pHasNotCF(p,q))
7024      {
7025      /*
7026      *the product criterion has applied for (s,p),
7027      *i.e. lcm(s,p)=product of the leading terms of s and p.
7028      *Suppose (s,r) is in L and the leading term
7029      *of p devides lcm(s,r)
7030      *(==> the leading term of p devides the leading term of r)
7031      *but the leading term of s does not devide the leading term of r
7032      *(notice that tis condition is automatically satisfied if r is still
7033      *in S), then (s,r) can be canceled.
7034      *This should be done here because the
7035      *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
7036      */
7037          strat->cp++;
7038          pLmFree(Lp.lcm);
7039          Lp.lcm=NULL;
7040          return;
7041      }
7042      if (strat->fromT && (ecartq>ecart))
7043      {
7044        pLmFree(Lp.lcm);
7045        Lp.lcm=NULL;
7046        return;
7047        /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
7048      }
7049      /*
7050      *the set B collects the pairs of type (S[j],p)
7051      *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
7052      *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
7053      *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
7054      */
7055      for(j = strat->Bl;j>=0;j--)
7056      {
7057        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
7058        if (compare==1)
7059        {
7060          strat->c3++;
7061          if ((strat->fromQ==NULL) || (isFromQ==0) || (qfromQ==0))
7062          {
7063            pLmFree(Lp.lcm);
7064            return;
7065          }
7066          break;
7067        }
7068        else
7069        if (compare ==-1)
7070        {
7071          deleteInL(strat->B,&strat->Bl,j,strat);
7072          strat->c3++;
7073        }
7074      }
7075    }
7076  }
7077  /*
7078  *the pair (S[i],p) enters B if the spoly != 0
7079  */
7080  /*-  compute the short s-polynomial -*/
7081  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
7082    pNorm(p);
7083  if ((q==NULL) || (p==NULL))
7084    return;
7085  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (qfromQ!=0))
7086    Lp.p=NULL;
7087  else
7088  {
7089//     if ( rIsPluralRing(currRing) )
7090//     {
7091//       if(pHasNotCF(p, q))
7092//       {
7093//         if(ncRingType(currRing) == nc_lie)
7094//         {
7095//             // generalized prod-crit for lie-type
7096//             strat->cp++;
7097//             Lp.p = nc_p_Bracket_qq(pCopy(p),q);
7098//         }
7099//         else
7100//         if( ALLOW_PROD_CRIT(strat) )
7101//         {
7102//             // product criterion for homogeneous case in SCA
7103//             strat->cp++;
7104//             Lp.p = NULL;
7105//         }
7106//         else
7107//           Lp.p = nc_CreateSpoly(q,p,currRing); // ?
7108//       }
7109//       else  Lp.p = nc_CreateSpoly(q,p,currRing);
7110//     }
7111//     else
7112//     {
7113
7114    /* ksCreateShortSpoly needs two Lobject-kind presentations */
7115    /* p is already in this form, so convert q */
7116    //    q = pMove2CurrTail(q, strat);
7117    Lp.p = ksCreateShortSpoly(q, p, strat->tailRing);
7118      //  }
7119  }
7120  if (Lp.p == NULL)
7121  {
7122    /*- the case that the s-poly is 0 -*/
7123    /* TEMPORARILY DISABLED FOR SHIFTS because there is no i*/
7124//      if (strat->pairtest==NULL) initPairtest(strat);
7125//      strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
7126//      strat->pairtest[strat->sl+1] = TRUE;
7127    /* END _ TEMPORARILY DISABLED FOR SHIFTS */
7128    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
7129    /*
7130    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
7131    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
7132    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
7133    *term of p devides the lcm(s,r)
7134    *(this canceling should be done here because
7135    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
7136    *the first case is handeled in chainCrit
7137    */
7138    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
7139  }
7140  else
7141  {
7142    /*- the pair (S[i],p) enters B -*/
7143    /* both of them should have their LM in currRing and TAIL in tailring */
7144    Lp.p1 = q;  // already in the needed form
7145    Lp.p2 = p; // already in the needed form
7146
7147    if ( !rIsPluralRing(currRing) )
7148      pNext(Lp.p) = strat->tail;
7149
7150    /* TEMPORARILY DISABLED FOR SHIFTS because there's no i*/
7151    /* at the beginning we DO NOT set atR = -1 ANYMORE*/
7152    if ( (atR >= 0) && (shiftcount==0) && (ifromS >=0) )
7153    {
7154      Lp.i_r1 = kFindInT(Lp.p1,strat); //strat->S_2_R[ifromS];
7155      Lp.i_r2 = atR;
7156    }
7157    else
7158    {
7159      /* END _ TEMPORARILY DISABLED FOR SHIFTS */
7160      Lp.i_r1 = -1;
7161      Lp.i_r2 = -1;
7162     }
7163    strat->initEcartPair(&Lp,q,p,ecartq,ecart);
7164
7165    if (TEST_OPT_INTSTRATEGY)
7166    {
7167      if (!rIsPluralRing(currRing))
7168        nDelete(&(Lp.p->coef));
7169    }
7170
7171    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
7172    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
7173  }
7174}
7175#endif
7176
7177#ifdef HAVE_SHIFTBBA
7178/*2
7179*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
7180*superfluous elements in S will be deleted
7181*/
7182void enterpairsShift (poly h,int k,int ecart,int pos,kStrategy strat, int atR,int uptodeg, int lV)
7183{
7184  /* h is strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
7185  /* Q: what is exactly the strat->fromT ? A: a local case trick; don't need it yet*/
7186  int j=pos;
7187
7188#ifdef HAVE_RINGS
7189  assume (!rField_is_Ring(currRing));
7190#endif
7191  initenterpairsShift(h,k,ecart,0,strat, atR,uptodeg,lV);
7192  if ( (!strat->fromT)
7193  && ((strat->syzComp==0)
7194    ||(pGetComp(h)<=strat->syzComp)))
7195  {
7196    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
7197    unsigned long h_sev = pGetShortExpVector(h);
7198    loop
7199    {
7200      if (j > k) break;
7201      clearS(h,h_sev, &j,&k,strat);
7202      j++;
7203    }
7204    //Print("end clearS sl=%d\n",strat->sl);
7205  }
7206 // PrintS("end enterpairs\n");
7207}
7208#endif
7209
7210#ifdef HAVE_SHIFTBBA
7211/*3
7212*(s[0], s \dot h),...,(s[k],s \dot h) will be put to the pairset L
7213* also the pairs (h, s\dot s[0]), ..., (h, s\dot s[k]) enter L
7214* additionally we put the pairs (h, s \sdot h) for s>=1 to L
7215*/
7216void initenterpairsShift (poly h,int k,int ecart,int isFromQ, kStrategy strat, int atR, int uptodeg, int lV)
7217{
7218  /* h comes from strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
7219  //  atR = -1;
7220  if ((strat->syzComp==0)
7221  || (pGetComp(h)<=strat->syzComp))
7222  {
7223    int j;
7224    BOOLEAN new_pair=FALSE;
7225
7226    if (pGetComp(h)==0)
7227    {
7228      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
7229      if ((isFromQ)&&(strat->fromQ!=NULL))
7230      {
7231        for (j=0; j<=k; j++)
7232        {
7233          if (!strat->fromQ[j])
7234          {
7235            new_pair=TRUE;
7236            enterOnePairManyShifts(j,h,ecart,isFromQ,strat, atR,uptodeg,lV);
7237            // other side pairs:
7238            enterOnePairSelfShifts(h,strat->S[j],ecart,isFromQ,strat, atR,uptodeg,lV);
7239          //Print("j:%d, Ll:%d\n",j,strat->Ll);
7240          }
7241        }
7242      }
7243      else
7244      {
7245        new_pair=TRUE;
7246        for (j=0; j<=k; j++)
7247        {
7248          enterOnePairManyShifts(j,h,ecart,isFromQ,strat, atR,uptodeg,lV);
7249          // other side pairs
7250          enterOnePairSelfShifts(h,strat->S[j],ecart,isFromQ,strat, atR,uptodeg,lV);
7251        }
7252        /* HERE we put (h, s*h) pairs */
7253       /* enterOnePairSelfShifts (poly qq, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int uptodeg, int lV); */
7254       enterOnePairSelfShifts (h, h, ecart, isFromQ, strat, atR, uptodeg, lV);
7255      }
7256    }
7257    else
7258    {
7259      for (j=0; j<=k; j++)
7260      {
7261        if ((pGetComp(h)==pGetComp(strat->S[j]))
7262        || (pGetComp(strat->S[j])==0))
7263        {
7264          new_pair=TRUE;
7265          enterOnePairManyShifts(j,h,ecart,isFromQ,strat, atR, uptodeg, lV);
7266          // other side pairs
7267          enterOnePairSelfShifts(h,strat->S[j],ecart,isFromQ,strat, atR,uptodeg,lV);
7268        //Print("j:%d, Ll:%d\n",j,strat->Ll);
7269        }
7270      }
7271      /* HERE we put (h, s*h) pairs */
7272      enterOnePairSelfShifts (h, h, ecart, isFromQ, strat, atR, uptodeg, lV);
7273    }
7274
7275    if (new_pair)
7276    {
7277      strat->chainCrit(h,ecart,strat);
7278    }
7279
7280  }
7281}
7282#endif
7283
7284#ifdef HAVE_SHIFTBBA
7285/*2
7286* puts p to the set T, starting with the at position atT
7287* and inserts all admissible shifts of p
7288*/
7289void enterTShift(LObject p, kStrategy strat, int atT, int uptodeg, int lV)
7290{
7291  /* determine how many elements we have to insert */
7292  /* x(0)y(1)z(2) : lastVblock-1=2, to add until lastVblock=uptodeg-1 */
7293  /* hence, a total number of elt's to add is: */
7294  /*  int toInsert = 1 + (uptodeg-1) - (pLastVblock(p.p, lV) -1);  */
7295
7296  int toInsert =  itoInsert(p.p, uptodeg,  lV, strat->tailRing);
7297
7298#ifdef PDEBUG
7299  //  Print("enterTShift uses toInsert: %d", toInsert);  PrintLn();
7300#endif
7301  int i;
7302
7303  if (atT < 0)
7304    atT = strat->posInT(strat->T, strat->tl, p);
7305
7306  /* can call enterT in a sequence, e.g. */
7307
7308  /* shift0 = it's our model for further shifts */
7309  enterT(p,strat,atT);
7310  LObject qq;
7311  for (i=1; i<=toInsert; i++) // toIns - 1?
7312  {
7313    qq      = p; //qq.Copy();
7314    qq.p    = NULL;
7315    qq.max  = NULL;
7316    qq.t_p = p_LPshift(p_Copy(p.t_p,strat->tailRing), i, uptodeg, lV, strat->tailRing); // direct shift
7317    qq.GetP();
7318    // update q.sev
7319    qq.sev = pGetShortExpVector(qq.p);
7320    /* enter it into T, first el't is with the shift 0 */
7321    // compute the position for qq
7322    atT = strat->posInT(strat->T, strat->tl, qq);
7323    enterT(qq,strat,atT);
7324  }
7325/* Q: what to do with this one in the orig enterT ? */
7326/*  strat->R[strat->tl] = &(strat->T[atT]); */
7327/* Solution: it is done by enterT each time separately */
7328}
7329#endif
7330
7331#ifdef HAVE_SHIFTBBA
7332poly redtailBbaShift (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
7333{
7334  /* for the shift case need to run it with withT = TRUE */
7335  strat->redTailChange=FALSE;
7336  if (strat->noTailReduction) return L->GetLmCurrRing();
7337  poly h, p;
7338  p = h = L->GetLmTailRing();
7339  if ((h==NULL) || (pNext(h)==NULL))
7340    return L->GetLmCurrRing();
7341
7342  TObject* With;
7343  // placeholder in case strat->tl < 0
7344  TObject  With_s(strat->tailRing);
7345
7346  LObject Ln(pNext(h), strat->tailRing);
7347  Ln.pLength = L->GetpLength() - 1;
7348
7349  pNext(h) = NULL;
7350  if (L->p != NULL) pNext(L->p) = NULL;
7351  L->pLength = 1;
7352
7353  Ln.PrepareRed(strat->use_buckets);
7354
7355  while(!Ln.IsNull())
7356  {
7357    loop
7358    {
7359      Ln.SetShortExpVector();
7360      if (withT)
7361      {
7362        int j;
7363        j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
7364        if (j < 0) break;
7365        With = &(strat->T[j]);
7366      }
7367      else
7368      {
7369        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
7370        if (With == NULL) break;
7371      }
7372      if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
7373      {
7374        With->pNorm();
7375        //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
7376      }
7377      strat->redTailChange=TRUE;
7378      if (ksReducePolyTail(L, With, &Ln))
7379      {
7380        // reducing the tail would violate the exp bound
7381        //  set a flag and hope for a retry (in bba)
7382        strat->completeReduce_retry=TRUE;
7383        do
7384        {
7385          pNext(h) = Ln.LmExtractAndIter();
7386          pIter(h);
7387          L->pLength++;
7388        } while (!Ln.IsNull());
7389        goto all_done;
7390      }
7391      if (Ln.IsNull()) goto all_done;
7392      if (! withT) With_s.Init(currRing);
7393    }
7394    pNext(h) = Ln.LmExtractAndIter();
7395    pIter(h);
7396    L->pLength++;
7397  }
7398
7399  all_done:
7400  Ln.Delete();
7401  if (L->p != NULL) pNext(L->p) = pNext(p);
7402
7403  if (strat->redTailChange)
7404  {
7405    L->last = NULL;
7406    L->length = 0;
7407  }
7408  L->Normalize(); // HANNES: should have a test
7409  kTest_L(L);
7410  return L->GetLmCurrRing();
7411}
7412#endif
Note: See TracBrowser for help on using the repository browser.