source: git/kernel/kutil.cc @ a13cae

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