source: git/kernel/kutil.cc @ f2b1ce6

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