source: git/kernel/kutil.cc @ cf218e8

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