source: git/kernel/kutil.cc @ 93047e

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