source: git/kernel/kutil.cc @ e371bf

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