source: git/kernel/kutil.cc @ 1a0b30c

spielwiese
Last change on this file since 1a0b30c was 1a0b30c, checked in by Hans Schönemann <hannes@…>, 15 years ago
*hannes: kMergeBintoL git-svn-id: file:///usr/local/Singular/svn/trunk@11084 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 182.1 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kutil.cc,v 1.109 2008-09-26 08:09:09 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* merge set B into L
1731*/
1732void kMergeBintoL(kStrategy strat)
1733{
1734  int j=strat->Ll+strat->Bl+1;
1735  if (j>strat->Lmax)
1736  {
1737    j=((j+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
1738    strat->L = (LSet)omReallocSize(strat->L,strat->Lmax*sizeof(LObject),
1739                                 j*sizeof(LObject));
1740    strat->Lmax=j;
1741  }
1742  j = strat->Ll;
1743  int i;
1744  for (i=strat->Bl; i>=0; i--)
1745  {
1746    j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
1747    enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
1748  }
1749  strat->Bl = -1;
1750}
1751/*2
1752*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
1753*using the chain-criterion in B and L and enters B to L
1754*/
1755void chainCrit (poly p,int ecart,kStrategy strat)
1756{
1757  int i,j,l;
1758
1759  /*
1760  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
1761  *In this case all elements in B such
1762  *that their lcm is divisible by the leading term of S[i] can be canceled
1763  */
1764  if (strat->pairtest!=NULL)
1765  {
1766    {
1767      /*- i.e. there is an i with pairtest[i]==TRUE -*/
1768      for (j=0; j<=strat->sl; j++)
1769      {
1770        if (strat->pairtest[j])
1771        {
1772          for (i=strat->Bl; i>=0; i--)
1773          {
1774            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
1775            {
1776              deleteInL(strat->B,&strat->Bl,i,strat);
1777              strat->c3++;
1778            }
1779          }
1780        }
1781      }
1782    }
1783    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
1784    strat->pairtest=NULL;
1785  }
1786  if (strat->Gebauer || strat->fromT)
1787  {
1788    if (strat->sugarCrit)
1789    {
1790    /*
1791    *suppose L[j] == (s,r) and p/lcm(s,r)
1792    *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
1793    *and in case the sugar is o.k. then L[j] can be canceled
1794    */
1795      for (j=strat->Ll; j>=0; j--)
1796      {
1797        if (sugarDivisibleBy(ecart,strat->L[j].ecart)
1798        && ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
1799        && pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1800        {
1801          if (strat->L[j].p == strat->tail)
1802          {
1803              deleteInL(strat->L,&strat->Ll,j,strat);
1804              strat->c3++;
1805          }
1806        }
1807      }
1808      /*
1809      *this is GEBAUER-MOELLER:
1810      *in B all elements with the same lcm except the "best"
1811      *(i.e. the last one in B with this property) will be canceled
1812      */
1813      j = strat->Bl;
1814      loop /*cannot be changed into a for !!! */
1815      {
1816        if (j <= 0) break;
1817        i = j-1;
1818        loop
1819        {
1820          if (i <  0) break;
1821          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
1822          {
1823            strat->c3++;
1824            if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
1825            {
1826              deleteInL(strat->B,&strat->Bl,i,strat);
1827              j--;
1828            }
1829            else
1830            {
1831              deleteInL(strat->B,&strat->Bl,j,strat);
1832              break;
1833            }
1834          }
1835          i--;
1836        }
1837        j--;
1838      }
1839    }
1840    else /*sugarCrit*/
1841    {
1842      /*
1843      *suppose L[j] == (s,r) and p/lcm(s,r)
1844      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
1845      *and in case the sugar is o.k. then L[j] can be canceled
1846      */
1847      for (j=strat->Ll; j>=0; j--)
1848      {
1849        if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1850        {
1851          if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
1852          {
1853            deleteInL(strat->L,&strat->Ll,j,strat);
1854            strat->c3++;
1855          }
1856        }
1857      }
1858      /*
1859      *this is GEBAUER-MOELLER:
1860      *in B all elements with the same lcm except the "best"
1861      *(i.e. the last one in B with this property) will be canceled
1862      */
1863      j = strat->Bl;
1864      loop   /*cannot be changed into a for !!! */
1865      {
1866        if (j <= 0) break;
1867        for(i=j-1; i>=0; i--)
1868        {
1869          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
1870          {
1871            strat->c3++;
1872            deleteInL(strat->B,&strat->Bl,i,strat);
1873            j--;
1874          }
1875        }
1876        j--;
1877      }
1878    }
1879    /*
1880    *the elements of B enter L
1881    */
1882    kMergeBintoL(strat);
1883  }
1884  else
1885  {
1886    for (j=strat->Ll; j>=0; j--)
1887    {
1888      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1889      {
1890        if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
1891        {
1892          deleteInL(strat->L,&strat->Ll,j,strat);
1893          strat->c3++;
1894        }
1895      }
1896    }
1897    /*
1898    *this is our MODIFICATION of GEBAUER-MOELLER:
1899    *First the elements of B enter L,
1900    *then we fix a lcm and the "best" element in L
1901    *(i.e the last in L with this lcm and of type (s,p))
1902    *and cancel all the other elements of type (r,p) with this lcm
1903    *except the case the element (s,r) has also the same lcm
1904    *and is on the worst position with respect to (s,p) and (r,p)
1905    */
1906    /*
1907    *B enters to L/their order with respect to B is permutated for elements
1908    *B[i].p with the same leading term
1909    */
1910    kMergeBintoL(strat);
1911    j = strat->Ll;
1912    loop  /*cannot be changed into a for !!! */
1913    {
1914      if (j <= 0)
1915      {
1916        /*now L[0] cannot be canceled any more and the tail can be removed*/
1917        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
1918        break;
1919      }
1920      if (strat->L[j].p2 == p)
1921      {
1922        i = j-1;
1923        loop
1924        {
1925          if (i < 0)  break;
1926          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
1927          {
1928            /*L[i] could be canceled but we search for a better one to cancel*/
1929            strat->c3++;
1930            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
1931            && (pNext(strat->L[l].p) == strat->tail)
1932            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
1933            && pDivisibleBy(p,strat->L[l].lcm))
1934            {
1935              /*
1936              *"NOT equal(...)" because in case of "equal" the element L[l]
1937              *is "older" and has to be from theoretical point of view behind
1938              *L[i], but we do not want to reorder L
1939              */
1940              strat->L[i].p2 = strat->tail;
1941              /*
1942              *L[l] will be canceled, we cannot cancel L[i] later on,
1943              *so we mark it with "tail"
1944              */
1945              deleteInL(strat->L,&strat->Ll,l,strat);
1946              i--;
1947            }
1948            else
1949            {
1950              deleteInL(strat->L,&strat->Ll,i,strat);
1951            }
1952            j--;
1953          }
1954          i--;
1955        }
1956      }
1957      else if (strat->L[j].p2 == strat->tail)
1958      {
1959        /*now L[j] cannot be canceled any more and the tail can be removed*/
1960        strat->L[j].p2 = p;
1961      }
1962      j--;
1963    }
1964  }
1965}
1966void chainCritPart (poly p,int ecart,kStrategy strat)
1967{
1968  int i,j,l;
1969
1970  /*
1971  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
1972  *In this case all elements in B such
1973  *that their lcm is divisible by the leading term of S[i] can be canceled
1974  */
1975  if (strat->pairtest!=NULL)
1976  {
1977    {
1978      /*- i.e. there is an i with pairtest[i]==TRUE -*/
1979      for (j=0; j<=strat->sl; j++)
1980      {
1981        if (strat->pairtest[j])
1982        {
1983          for (i=strat->Bl; i>=0; i--)
1984          {
1985            if (_p_LmDivisibleByPart(strat->S[j],currRing,
1986               strat->B[i].lcm,currRing,
1987               currRing->real_var_start,currRing->real_var_end))
1988            {
1989              if(TEST_OPT_DEBUG)
1990              {
1991                 Print("chain-crit-part: S[%d]=",j); 
1992                 p_wrp(strat->S[j],currRing);
1993                 Print(" divide B[%d].lcm=",i);
1994                 p_wrp(strat->B[i].lcm,currRing);
1995                 PrintLn();
1996              }
1997              deleteInL(strat->B,&strat->Bl,i,strat);
1998              strat->c3++;
1999            }
2000          }
2001        }
2002      }
2003    }
2004    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
2005    strat->pairtest=NULL;
2006  }
2007  if (strat->Gebauer || strat->fromT)
2008  {
2009    if (strat->sugarCrit)
2010    {
2011    /*
2012    *suppose L[j] == (s,r) and p/lcm(s,r)
2013    *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
2014    *and in case the sugar is o.k. then L[j] can be canceled
2015    */
2016      for (j=strat->Ll; j>=0; j--)
2017      {
2018        if (sugarDivisibleBy(ecart,strat->L[j].ecart)
2019        && ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
2020        && pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2021        {
2022          if (strat->L[j].p == strat->tail)
2023          {
2024              if(TEST_OPT_DEBUG)
2025              {
2026                 PrintS("chain-crit-part: pCompareChainPart p="); 
2027                 p_wrp(p,currRing);
2028                 Print(" delete L[%d]",j);
2029                 p_wrp(strat->L[j].lcm,currRing);
2030                 PrintLn();
2031              }
2032              deleteInL(strat->L,&strat->Ll,j,strat);
2033              strat->c3++;
2034          }
2035        }
2036      }
2037      /*
2038      *this is GEBAUER-MOELLER:
2039      *in B all elements with the same lcm except the "best"
2040      *(i.e. the last one in B with this property) will be canceled
2041      */
2042      j = strat->Bl;
2043      loop /*cannot be changed into a for !!! */
2044      {
2045        if (j <= 0) break;
2046        i = j-1;
2047        loop
2048        {
2049          if (i <  0) break;
2050          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
2051          {
2052            strat->c3++;
2053            if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
2054            {
2055              if(TEST_OPT_DEBUG)
2056              {
2057                 Print("chain-crit-part: sugar B[%d].lcm=",j); 
2058                 p_wrp(strat->B[j].lcm,currRing);
2059                 Print(" delete B[%d]",i);
2060                 p_wrp(strat->B[i].lcm,currRing);
2061                 PrintLn();
2062              }
2063              deleteInL(strat->B,&strat->Bl,i,strat);
2064              j--;
2065            }
2066            else
2067            {
2068              if(TEST_OPT_DEBUG)
2069              {
2070                 Print("chain-crit-part: sugar B[%d].lcm=",i); 
2071                 p_wrp(strat->B[i].lcm,currRing);
2072                 Print(" delete B[%d]",j);
2073                 p_wrp(strat->B[j].lcm,currRing);
2074                 PrintLn();
2075              }
2076              deleteInL(strat->B,&strat->Bl,j,strat);
2077              break;
2078            }
2079          }
2080          i--;
2081        }
2082        j--;
2083      }
2084    }
2085    else /*sugarCrit*/
2086    {
2087      /*
2088      *suppose L[j] == (s,r) and p/lcm(s,r)
2089      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
2090      *and in case the sugar is o.k. then L[j] can be canceled
2091      */
2092      for (j=strat->Ll; j>=0; j--)
2093      {
2094        if (pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2095        {
2096          if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
2097          {
2098              if(TEST_OPT_DEBUG)
2099              {
2100                 PrintS("chain-crit-part: sugar:pCompareChainPart p="); 
2101                 p_wrp(p,currRing);
2102                 Print(" delete L[%d]",j);
2103                 p_wrp(strat->L[j].lcm,currRing);
2104                 PrintLn();
2105              }
2106            deleteInL(strat->L,&strat->Ll,j,strat);
2107            strat->c3++;
2108          }
2109        }
2110      }
2111      /*
2112      *this is GEBAUER-MOELLER:
2113      *in B all elements with the same lcm except the "best"
2114      *(i.e. the last one in B with this property) will be canceled
2115      */
2116      j = strat->Bl;
2117      loop   /*cannot be changed into a for !!! */
2118      {
2119        if (j <= 0) break;
2120        for(i=j-1; i>=0; i--)
2121        {
2122          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
2123          {
2124              if(TEST_OPT_DEBUG)
2125              {
2126                 Print("chain-crit-part: equal lcm B[%d].lcm=",j); 
2127                 p_wrp(strat->B[j].lcm,currRing);
2128                 Print(" delete B[%d]\n",i);
2129              }
2130            strat->c3++;
2131            deleteInL(strat->B,&strat->Bl,i,strat);
2132            j--;
2133          }
2134        }
2135        j--;
2136      }
2137    }
2138    /*
2139    *the elements of B enter L
2140    */
2141    kMergeBintoL(strat);
2142  }
2143  else
2144  {
2145    for (j=strat->Ll; j>=0; j--)
2146    {
2147      if (pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2148      {
2149        if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
2150        {
2151              if(TEST_OPT_DEBUG)
2152              {
2153                 PrintS("chain-crit-part: pCompareChainPart p="); 
2154                 p_wrp(p,currRing);
2155                 Print(" delete L[%d]",j);
2156                 p_wrp(strat->L[j].lcm,currRing);
2157                 PrintLn();
2158              }
2159          deleteInL(strat->L,&strat->Ll,j,strat);
2160          strat->c3++;
2161        }
2162      }
2163    }
2164    /*
2165    *this is our MODIFICATION of GEBAUER-MOELLER:
2166    *First the elements of B enter L,
2167    *then we fix a lcm and the "best" element in L
2168    *(i.e the last in L with this lcm and of type (s,p))
2169    *and cancel all the other elements of type (r,p) with this lcm
2170    *except the case the element (s,r) has also the same lcm
2171    *and is on the worst position with respect to (s,p) and (r,p)
2172    */
2173    /*
2174    *B enters to L/their order with respect to B is permutated for elements
2175    *B[i].p with the same leading term
2176    */
2177    kMergeBintoL(strat);
2178    j = strat->Ll;
2179    loop  /*cannot be changed into a for !!! */
2180    {
2181      if (j <= 0)
2182      {
2183        /*now L[0] cannot be canceled any more and the tail can be removed*/
2184        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2185        break;
2186      }
2187      if (strat->L[j].p2 == p)
2188      {
2189        i = j-1;
2190        loop
2191        {
2192          if (i < 0)  break;
2193          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2194          {
2195            /*L[i] could be canceled but we search for a better one to cancel*/
2196            strat->c3++;
2197            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2198            && (pNext(strat->L[l].p) == strat->tail)
2199            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2200            && _p_LmDivisibleByPart(p,currRing,
2201                           strat->L[l].lcm,currRing,
2202                           currRing->real_var_start, currRing->real_var_end))
2203
2204            {
2205              /*
2206              *"NOT equal(...)" because in case of "equal" the element L[l]
2207              *is "older" and has to be from theoretical point of view behind
2208              *L[i], but we do not want to reorder L
2209              */
2210              strat->L[i].p2 = strat->tail;
2211              /*
2212              *L[l] will be canceled, we cannot cancel L[i] later on,
2213              *so we mark it with "tail"
2214              */
2215              if(TEST_OPT_DEBUG)
2216              {
2217                 PrintS("chain-crit-part: divisible_by p="); 
2218                 p_wrp(p,currRing);
2219                 Print(" delete L[%d]",l);
2220                 p_wrp(strat->L[l].lcm,currRing);
2221                 PrintLn();
2222              }
2223              deleteInL(strat->L,&strat->Ll,l,strat);
2224              i--;
2225            }
2226            else
2227            {
2228              if(TEST_OPT_DEBUG)
2229              {
2230                 PrintS("chain-crit-part: divisible_by(2) p="); 
2231                 p_wrp(p,currRing);
2232                 Print(" delete L[%d]",i);
2233                 p_wrp(strat->L[i].lcm,currRing);
2234                 PrintLn();
2235              }
2236              deleteInL(strat->L,&strat->Ll,i,strat);
2237            }
2238            j--;
2239          }
2240          i--;
2241        }
2242      }
2243      else if (strat->L[j].p2 == strat->tail)
2244      {
2245        /*now L[j] cannot be canceled any more and the tail can be removed*/
2246        strat->L[j].p2 = p;
2247      }
2248      j--;
2249    }
2250  }
2251}
2252
2253/*2
2254*(s[0],h),...,(s[k],h) will be put to the pairset L
2255*/
2256void initenterpairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2257{
2258
2259  if ((strat->syzComp==0)
2260  || (pGetComp(h)<=strat->syzComp))
2261  {
2262    int j;
2263    BOOLEAN new_pair=FALSE;
2264
2265    if (pGetComp(h)==0)
2266    {
2267      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
2268      if ((isFromQ)&&(strat->fromQ!=NULL))
2269      {
2270        for (j=0; j<=k; j++)
2271        {
2272          if (!strat->fromQ[j])
2273          {
2274            new_pair=TRUE;
2275            enterOnePair(j,h,ecart,isFromQ,strat, atR);
2276          //Print("j:%d, Ll:%d\n",j,strat->Ll);
2277          }
2278        }
2279      }
2280      else
2281      {
2282        new_pair=TRUE;
2283        for (j=0; j<=k; j++)
2284        {
2285          enterOnePair(j,h,ecart,isFromQ,strat, atR);
2286          //Print("j:%d, Ll:%d\n",j,strat->Ll);
2287        }
2288      }
2289    }
2290    else
2291    {
2292      for (j=0; j<=k; j++)
2293      {
2294        if ((pGetComp(h)==pGetComp(strat->S[j]))
2295        || (pGetComp(strat->S[j])==0))
2296        {
2297          new_pair=TRUE;
2298          enterOnePair(j,h,ecart,isFromQ,strat, atR);
2299        //Print("j:%d, Ll:%d\n",j,strat->Ll);
2300        }
2301      }
2302    }
2303
2304    if (new_pair) 
2305    {
2306#ifdef HAVE_PLURAL
2307      if (currRing->real_var_start>0)
2308        chainCritPart(h,ecart,strat);
2309      else
2310#endif
2311      chainCrit(h,ecart,strat);
2312    }
2313  }
2314}
2315
2316#ifdef HAVE_RINGS
2317/*2
2318*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
2319*using the chain-criterion in B and L and enters B to L
2320*/
2321void chainCritRing (poly p,int ecart,kStrategy strat)
2322{
2323  int i,j,l;
2324  /*
2325  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
2326  *In this case all elements in B such
2327  *that their lcm is divisible by the leading term of S[i] can be canceled
2328  */
2329  if (strat->pairtest!=NULL)
2330  {
2331    {
2332      /*- i.e. there is an i with pairtest[i]==TRUE -*/
2333      for (j=0; j<=strat->sl; j++)
2334      {
2335        if (strat->pairtest[j])
2336        {
2337          for (i=strat->Bl; i>=0; i--)
2338          {
2339            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
2340            {
2341#ifdef KDEBUG
2342              if (TEST_OPT_DEBUG)
2343              {
2344                PrintS("--- chain criterion func chainCritRing type 1\n");
2345                PrintS("strat->S[j]:");
2346                wrp(strat->S[j]);
2347                PrintS("  strat->B[i].lcm:");
2348                wrp(strat->B[i].lcm);
2349                PrintLn();
2350              }
2351#endif
2352              deleteInL(strat->B,&strat->Bl,i,strat);
2353              strat->c3++;
2354            }
2355          }
2356        }
2357      }
2358    }
2359    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
2360    strat->pairtest=NULL;
2361  }
2362  assume(!(strat->Gebauer || strat->fromT));
2363  for (j=strat->Ll; j>=0; j--)
2364  {
2365    if (strat->L[j].lcm != NULL && nDivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(p)))
2366    {
2367      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2368      {
2369        if ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
2370        {
2371          deleteInL(strat->L,&strat->Ll,j,strat);
2372          strat->c3++;
2373#ifdef KDEBUG
2374              if (TEST_OPT_DEBUG)
2375              {
2376                PrintS("--- chain criterion func chainCritRing type 2\n");
2377                PrintS("strat->L[j].p:");
2378                wrp(strat->L[j].p);
2379                PrintS("  p:");
2380                wrp(p);
2381                PrintLn();
2382              }
2383#endif
2384        }
2385      }
2386    }
2387  }
2388  /*
2389  *this is our MODIFICATION of GEBAUER-MOELLER:
2390  *First the elements of B enter L,
2391  *then we fix a lcm and the "best" element in L
2392  *(i.e the last in L with this lcm and of type (s,p))
2393  *and cancel all the other elements of type (r,p) with this lcm
2394  *except the case the element (s,r) has also the same lcm
2395  *and is on the worst position with respect to (s,p) and (r,p)
2396  */
2397  /*
2398  *B enters to L/their order with respect to B is permutated for elements
2399  *B[i].p with the same leading term
2400  */
2401  kMergeBintoL(strat);
2402  j = strat->Ll;
2403  loop  /*cannot be changed into a for !!! */
2404  {
2405    if (j <= 0)
2406    {
2407      /*now L[0] cannot be canceled any more and the tail can be removed*/
2408      if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2409      break;
2410    }
2411    if (strat->L[j].p2 == p) // Was the element added from B?
2412    {
2413      i = j-1;
2414      loop
2415      {
2416        if (i < 0)  break;
2417        // Element is from B and has the same lcm as L[j]
2418        if ((strat->L[i].p2 == p) && nDivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(strat->L[i].lcm))
2419             && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2420        {
2421          /*L[i] could be canceled but we search for a better one to cancel*/
2422          strat->c3++;
2423#ifdef KDEBUG
2424          if (TEST_OPT_DEBUG)
2425          {
2426            PrintS("--- chain criterion func chainCritRing type 3\n");
2427            PrintS("strat->L[j].lcm:");
2428            wrp(strat->L[j].lcm);
2429            PrintS("  strat->L[i].lcm:");
2430            wrp(strat->L[i].lcm);
2431            PrintLn();
2432          }
2433#endif
2434          if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2435          && (pNext(strat->L[l].p) == strat->tail)
2436          && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2437          && pDivisibleBy(p,strat->L[l].lcm))
2438          {
2439            /*
2440            *"NOT equal(...)" because in case of "equal" the element L[l]
2441            *is "older" and has to be from theoretical point of view behind
2442            *L[i], but we do not want to reorder L
2443            */
2444            strat->L[i].p2 = strat->tail;
2445            /*
2446            *L[l] will be canceled, we cannot cancel L[i] later on,
2447            *so we mark it with "tail"
2448            */
2449            deleteInL(strat->L,&strat->Ll,l,strat);
2450            i--;
2451          }
2452          else
2453          {
2454            deleteInL(strat->L,&strat->Ll,i,strat);
2455          }
2456          j--;
2457        }
2458        i--;
2459      }
2460    }
2461    else if (strat->L[j].p2 == strat->tail)
2462    {
2463      /*now L[j] cannot be canceled any more and the tail can be removed*/
2464      strat->L[j].p2 = p;
2465    }
2466    j--;
2467  }
2468}
2469#endif
2470
2471#ifdef HAVE_RING2TOM
2472long ind2(long arg)
2473{
2474  long ind = 0;
2475  if (arg <= 0) return 0;
2476  while (arg%2 == 0)
2477  {
2478    arg = arg / 2;
2479    ind++;
2480  }
2481  return ind;
2482}
2483
2484long ind_fact_2(long arg)
2485{
2486  long ind = 0;
2487  if (arg <= 0) return 0;
2488  if (arg%2 == 1) { arg--; }
2489  while (arg > 0)
2490  {
2491    ind += ind2(arg);
2492    arg = arg - 2;
2493  }
2494  return ind;
2495}
2496#endif
2497
2498#ifdef HAVE_VANIDEAL
2499long twoPow(long arg)
2500{
2501  return 1L << arg;
2502}
2503
2504/*2
2505* put the pair (p, f) in B and f in T
2506*/
2507void enterOneZeroPairRing (poly f, poly t_p, poly p, int ecart, kStrategy strat, int atR = -1)
2508{
2509  int      l,j,compare,compareCoeff;
2510  LObject  Lp;
2511
2512  if (strat->interred_flag) return;
2513#ifdef KDEBUG
2514  Lp.ecart=0; Lp.length=0;
2515#endif
2516  /*- computes the lcm(s[i],p) -*/
2517  Lp.lcm = pInit();
2518
2519  pLcm(p,f,Lp.lcm);
2520  pSetm(Lp.lcm);
2521  pSetCoeff(Lp.lcm, nLcm(pGetCoeff(p), pGetCoeff(f), currRing));
2522  assume(!strat->sugarCrit);
2523  assume(!strat->fromT);
2524  /*
2525  *the set B collects the pairs of type (S[j],p)
2526  *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
2527  *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
2528  *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
2529  */
2530  for(j = strat->Bl;j>=0;j--)
2531  {
2532    compare=pDivCompRing(strat->B[j].lcm,Lp.lcm);
2533    compareCoeff = nDivComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(Lp.lcm));
2534    if (compareCoeff == 0 || compare == compareCoeff)
2535    {
2536      if (compare == 1)
2537      {
2538        strat->c3++;
2539        pLmDelete(Lp.lcm);
2540        return;
2541      }
2542      else
2543      if (compare == -1)
2544      {
2545        deleteInL(strat->B,&strat->Bl,j,strat);
2546        strat->c3++;
2547      }
2548    }
2549    if (compare == pDivComp_EQUAL)
2550    {
2551      // Add hint for same LM and direction of LC (later) (TODO Oliver)
2552      if (compareCoeff == 1)
2553      {
2554        strat->c3++;
2555        pLmDelete(Lp.lcm);
2556        return;
2557      }
2558      else
2559      if (compareCoeff == -1)
2560      {
2561        deleteInL(strat->B,&strat->Bl,j,strat);
2562        strat->c3++;
2563      }
2564    }
2565  }
2566  /*
2567  *the pair (S[i],p) enters B if the spoly != 0
2568  */
2569  /*-  compute the short s-polynomial -*/
2570  if ((f==NULL) || (p==NULL)) return;
2571  pNorm(p);
2572  {
2573    Lp.p = ksCreateShortSpoly(f, p, strat->tailRing);
2574  }
2575  if (Lp.p == NULL) //deactivated, as we are adding pairs with zeropoly and not from S
2576  {
2577    /*- the case that the s-poly is 0 -*/
2578//    if (strat->pairtest==NULL) initPairtest(strat);
2579//    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
2580//    strat->pairtest[strat->sl+1] = TRUE;
2581    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
2582    /*
2583    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
2584    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
2585    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
2586    *term of p devides the lcm(s,r)
2587    *(this canceling should be done here because
2588    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
2589    *the first case is handeled in chainCrit
2590    */
2591    if (Lp.lcm!=NULL) pLmDelete(Lp.lcm);
2592  }
2593  else
2594  {
2595    /*- the pair (S[i],p) enters B -*/
2596    Lp.p1 = f;
2597    Lp.p2 = p;
2598
2599    pNext(Lp.p) = strat->tail;
2600
2601    LObject tmp_h(f, currRing, strat->tailRing);
2602    tmp_h.SetShortExpVector();
2603    strat->initEcart(&tmp_h);
2604    tmp_h.sev = pGetShortExpVector(tmp_h.p);
2605    tmp_h.t_p = t_p;
2606
2607    enterT(tmp_h, strat, strat->tl + 1);
2608
2609    if (atR >= 0)
2610    {
2611      Lp.i_r2 = atR;
2612      Lp.i_r1 = strat->tl;
2613    }
2614
2615    strat->initEcartPair(&Lp,f,p,0/*strat->ecartS[i]*/,ecart);     // Attention: TODO: break ecart
2616    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
2617    enterL(&strat->B, &strat->Bl, &strat->Bmax, Lp, l);
2618  }
2619}
2620
2621/* Helper for kCreateZeroPoly
2622 * enumerating the exponents
2623ring r = 2^2, (a, b, c), lp; ideal G0 = system("createG0"); ideal G = interred(G0); ncols(G0); ncols(G);
2624 */
2625
2626int nextZeroSimplexExponent (long exp[], long ind[], long cexp[], long cind[], long* cabsind, long step[], long bound, long N)
2627/* gives the next exponent from the set H_1 */
2628{
2629  long add = ind2(cexp[1] + 2);
2630  if ((*cabsind < bound) && (*cabsind - step[1] + add < bound))
2631  {
2632    cexp[1] += 2;
2633    cind[1] += add;
2634    *cabsind += add;
2635  }
2636  else
2637  {
2638    // cabsind >= habsind
2639    if (N == 1) return 0;
2640    int i = 1;
2641    while (exp[i] == cexp[i] && i <= N) i++;
2642    cexp[i] = exp[i];
2643    *cabsind -= cind[i];
2644    cind[i] = ind[i];
2645    step[i] = 500000;
2646    *cabsind += cind[i];
2647    // Print("in: %d\n", *cabsind);
2648    i += 1;
2649    if (i > N) return 0;
2650    do
2651    {
2652      step[1] = 500000;
2653      for (int j = i + 1; j <= N; j++)
2654      {
2655        if (step[1] > step[j]) step[1] = step[j];
2656      }
2657      add = ind2(cexp[i] + 2);
2658      if (*cabsind - step[1] + add >= bound)
2659      {
2660        cexp[i] = exp[i];
2661        *cabsind -= cind[i];
2662        cind[i] = ind[i];
2663        *cabsind += cind[i];
2664        step[i] = 500000;
2665        i += 1;
2666        if (i > N) return 0;
2667      }
2668      else step[1] = -1;
2669    } while (step[1] != -1);
2670    step[1] = 500000;
2671    cexp[i] += 2;
2672    cind[i] += add;
2673    *cabsind += add;
2674    if (add < step[i]) step[i] = add;
2675    for (i = 2; i <= N; i++)
2676    {
2677      if (step[1] > step[i]) step[1] = step[i];
2678    }
2679  }
2680  return 1;
2681}
2682
2683/*
2684 * Creates the zero Polynomial on position exp
2685 * long exp[] : exponent of leading term
2686 * cabsind    : total 2-ind of exp (if -1 will be computed)
2687 * poly* t_p  : will hold the LT in tailRing
2688 * leadRing   : ring for the LT
2689 * tailRing   : ring for the tail
2690 */
2691
2692poly kCreateZeroPoly(long exp[], long cabsind, poly* t_p, ring leadRing, ring tailRing)
2693{
2694
2695  poly zeroPoly = NULL;
2696
2697  number tmp1;
2698  poly tmp2, tmp3;
2699
2700  if (cabsind == -1)
2701  {
2702    cabsind = 0;
2703    for (int i = 1; i <= leadRing->N; i++)
2704    {
2705      cabsind += ind_fact_2(exp[i]);
2706    }
2707//    Print("cabsind: %d\n", cabsind);
2708  }
2709  if (cabsind < leadRing->ch)
2710  {
2711    zeroPoly = p_ISet(twoPow(leadRing->ch - cabsind), tailRing);
2712  }
2713  else
2714  {
2715    zeroPoly = p_ISet(1, tailRing);
2716  }
2717  for (int i = 1; i <= leadRing->N; i++)
2718  {
2719    for (long j = 1; j <= exp[i]; j++)
2720    {
2721      tmp1 = nInit(j);
2722      tmp2 = p_ISet(1, tailRing);
2723      p_SetExp(tmp2, i, 1, tailRing);
2724      p_Setm(tmp2, tailRing);
2725      if (nIsZero(tmp1))
2726      { // should nowbe obsolet, test ! TODO OLIVER
2727        zeroPoly = p_Mult_q(zeroPoly, tmp2, tailRing);
2728      }
2729      else
2730      {
2731        tmp3 = p_NSet(nCopy(tmp1), tailRing);
2732        zeroPoly = p_Mult_q(zeroPoly, p_Add_q(tmp3, tmp2, tailRing), tailRing);
2733      }
2734    }
2735  }
2736  tmp2 = p_NSet(nCopy(pGetCoeff(zeroPoly)), leadRing);
2737  for (int i = 1; i <= leadRing->N; i++)
2738  {
2739    pSetExp(tmp2, i, p_GetExp(zeroPoly, i, tailRing));
2740  }
2741  p_Setm(tmp2, leadRing);
2742  *t_p = zeroPoly;
2743  zeroPoly = pNext(zeroPoly);
2744  pNext(*t_p) = NULL;
2745  pNext(tmp2) = zeroPoly;
2746  return tmp2;
2747}
2748
2749// #define OLI_DEBUG
2750
2751/*
2752 * Generate the s-polynomial for the virtual set of zero-polynomials
2753 */
2754
2755void initenterzeropairsRing (poly p, int ecart, kStrategy strat, int atR)
2756{
2757  // Initialize
2758  long exp[50];            // The exponent of \hat{X} (basepoint)
2759  long cexp[50];           // The current exponent for iterating over all
2760  long ind[50];            // The power of 2 in the i-th component of exp
2761  long cind[50];           // analog for cexp
2762  long mult[50];           // How to multiply the elements of G
2763  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
2764  long habsind = 0;        // The abs. index of the coefficient of h
2765  long step[50];           // The last increases
2766  for (int i = 1; i <= currRing->N; i++)
2767  {
2768    exp[i] = p_GetExp(p, i, currRing);
2769    if (exp[i] & 1 != 0)
2770    {
2771      exp[i] = exp[i] - 1;
2772      mult[i] = 1;
2773    }
2774    cexp[i] = exp[i];
2775    ind[i] = ind_fact_2(exp[i]);
2776    cabsind += ind[i];
2777    cind[i] = ind[i];
2778    step[i] = 500000;
2779  }
2780  step[1] = 500000;
2781  habsind = ind2((long) p_GetCoeff(p, currRing));
2782  long bound = currRing->ch - habsind;
2783#ifdef OLI_DEBUG
2784  PrintS("-------------\npoly  :");
2785  wrp(p);
2786  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
2787  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
2788  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
2789  Print("bound : %d\n", bound);
2790  Print("cind  : %d\n", cabsind);
2791#endif
2792  if (cabsind == 0)
2793  {
2794    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
2795    {
2796      return;
2797    }
2798  }
2799  // Now the whole simplex
2800  do
2801  {
2802    // Build s-polynomial
2803    // 2**ind-def * mult * g - exp-def * h
2804    poly t_p;
2805    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, strat->tailRing);
2806#ifdef OLI_DEBUG
2807    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
2808    Print("zPoly : ");
2809    wrp(zeroPoly);
2810    Print("\n");
2811#endif
2812    enterOneZeroPairRing(zeroPoly, t_p, p, ecart, strat, atR);
2813  }
2814  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
2815}
2816
2817/*
2818 * Create the Groebner basis of the vanishing polynomials.
2819 */
2820
2821ideal createG0()
2822{
2823  // Initialize
2824  long exp[50];            // The exponent of \hat{X} (basepoint)
2825  long cexp[50];           // The current exponent for iterating over all
2826  long ind[50];            // The power of 2 in the i-th component of exp
2827  long cind[50];           // analog for cexp
2828  long mult[50];           // How to multiply the elements of G
2829  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
2830  long habsind = 0;        // The abs. index of the coefficient of h
2831  long step[50];           // The last increases
2832  for (int i = 1; i <= currRing->N; i++)
2833  {
2834    exp[i] = 0;
2835    cexp[i] = exp[i];
2836    ind[i] = 0;
2837    step[i] = 500000;
2838    cind[i] = ind[i];
2839  }
2840  long bound = currRing->ch;
2841  step[1] = 500000;
2842#ifdef OLI_DEBUG
2843  PrintS("-------------\npoly  :");
2844//  wrp(p);
2845  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
2846  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
2847  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
2848  Print("bound : %d\n", bound);
2849  Print("cind  : %d\n", cabsind);
2850#endif
2851  if (cabsind == 0)
2852  {
2853    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
2854    {
2855      return idInit(1, 1);
2856    }
2857  }
2858  ideal G0 = idInit(1, 1);
2859  // Now the whole simplex
2860  do
2861  {
2862    // Build s-polynomial
2863    // 2**ind-def * mult * g - exp-def * h
2864    poly t_p;
2865    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, currRing);
2866#ifdef OLI_DEBUG
2867    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
2868    Print("zPoly : ");
2869    wrp(zeroPoly);
2870    Print("\n");
2871#endif
2872    // Add to ideal
2873    pEnlargeSet(&(G0->m), IDELEMS(G0), 1);
2874    IDELEMS(G0) += 1;
2875    G0->m[IDELEMS(G0) - 1] = zeroPoly;
2876  }
2877  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
2878  idSkipZeroes(G0);
2879  return G0;
2880}
2881#endif
2882
2883#ifdef HAVE_RINGS
2884/*2
2885*(s[0],h),...,(s[k],h) will be put to the pairset L
2886*/
2887void initenterpairsRing (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2888{
2889
2890  if ((strat->syzComp==0) || (pGetComp(h)<=strat->syzComp))
2891  {
2892    int j;
2893    BOOLEAN new_pair=FALSE;
2894
2895    if (pGetComp(h)==0)
2896    {
2897      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
2898      if ((isFromQ)&&(strat->fromQ!=NULL))
2899      {
2900        for (j=0; j<=k; j++)
2901        {
2902          if (!strat->fromQ[j])
2903          {
2904            new_pair=TRUE;
2905            Print("TODO Oliver --- j:%d, Ll:%d\n",j,strat->Ll);
2906            enterOnePairRing(j,h,ecart,isFromQ,strat, atR);
2907          }
2908        }
2909      }
2910      else
2911      {
2912        new_pair=TRUE;
2913        for (j=0; j<=k; j++)
2914        {
2915          // Print("j:%d, Ll:%d\n",j,strat->Ll);
2916          enterOnePairRing(j,h,ecart,isFromQ,strat, atR);
2917        }
2918      }
2919    }
2920    else
2921    {
2922      for (j=0; j<=k; j++)
2923      {
2924        if ((pGetComp(h)==pGetComp(strat->S[j])) || (pGetComp(strat->S[j])==0))
2925        {
2926          new_pair=TRUE;
2927          Print("TODO Oliver --- j:%d, Ll:%d\n",j,strat->Ll);
2928          enterOnePairRing(j,h,ecart,isFromQ,strat, atR);
2929        }
2930      }
2931    }
2932
2933    if (new_pair) chainCritRing(h,ecart,strat);
2934
2935  }
2936/*
2937ring r=256,(x,y,z),dp;
2938ideal I=12xz-133y, 2xy-z;
2939*/
2940
2941}
2942
2943/*2
2944*(s[0],h),...,(s[k],h) will be put to the pairset L
2945*/
2946void initenterstrongPairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2947{
2948
2949  if (!nIsOne(pGetCoeff(h)))
2950  {
2951    int j;
2952    BOOLEAN new_pair=FALSE;
2953
2954    for (j=0; j<=k; j++)
2955    {
2956      // Print("j:%d, Ll:%d\n",j,strat->Ll);
2957//      if (((unsigned long) pGetCoeff(h) % (unsigned long) pGetCoeff(strat->S[j]) != 0) &&
2958//         ((unsigned long) pGetCoeff(strat->S[j]) % (unsigned long) pGetCoeff(h) != 0))
2959      {
2960        if (enterOneStrongPoly(j,h,ecart,isFromQ,strat, atR))
2961          new_pair=TRUE;
2962      }
2963    }
2964  }
2965/*
2966ring r=256,(x,y,z),dp;
2967ideal I=12xz-133y, 2xy-z;
2968*/
2969
2970}
2971
2972/*2
2973* Generates spoly(0, h) if applicable. Assumes ring in Z/2^n.
2974*/
2975void enterExtendedSpoly(poly h,kStrategy strat)
2976{
2977  if (nIsOne(pGetCoeff(h))) return;
2978  number gcd;
2979  bool go = false;
2980  if (nDivBy((number) 0, pGetCoeff(h)))
2981  {
2982    gcd = nIntDiv((number) 0, pGetCoeff(h));
2983    go = true;
2984  }
2985  else
2986    gcd = nGcd((number) 0, pGetCoeff(h), strat->tailRing);
2987  if (go || !nIsOne(gcd))
2988  {
2989    poly p = h->next;
2990    if (!go)
2991    {
2992      number tmp = gcd;
2993      gcd = nIntDiv(0, gcd);
2994      nDelete(&tmp);
2995    }
2996    p = pp_Mult_nn(p, gcd, strat->tailRing);
2997    nDelete(&gcd);
2998
2999    if (p != NULL)
3000    {
3001      if (TEST_OPT_PROT)
3002      {
3003        PrintS("Z");
3004      }
3005#ifdef KDEBUG
3006      if (TEST_OPT_DEBUG)
3007      {
3008        PrintS("--- create zero spoly: ");
3009        wrp(h);
3010        PrintS(" ---> ");
3011      }
3012#endif
3013      poly tmp = pInit();
3014      pSetCoeff0(tmp, pGetCoeff(p));
3015      for (int i = 1; i <= currRing->N; i++)
3016      {
3017        pSetExp(tmp, i, p_GetExp(p, i, strat->tailRing));
3018      }
3019      p_Setm(tmp, currRing);
3020      p = p_LmFreeAndNext(p, strat->tailRing);
3021      pNext(tmp) = p;
3022      LObject h;
3023      h.p = tmp;
3024      h.tailRing = strat->tailRing;
3025      int posx;
3026      if (h.p!=NULL)
3027      {
3028        if (TEST_OPT_INTSTRATEGY)
3029        {
3030          //pContent(h.p);
3031          h.pCleardenom(); // also does a pContent
3032        }
3033        else
3034        {
3035          h.pNorm();
3036        }
3037        strat->initEcart(&h);
3038        if (strat->Ll==-1)
3039          posx =0;
3040        else
3041          posx = strat->posInL(strat->L,strat->Ll,&h,strat);
3042        h.sev = pGetShortExpVector(h.p);
3043        h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
3044        if (pNext(p) != NULL)
3045        {
3046          // What does this? (Oliver)
3047          // pShallowCopyDeleteProc p_shallow_copy_delete
3048          //      = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
3049          // pNext(p) = p_shallow_copy_delete(pNext(p),
3050          //              currRing, strat->tailRing, strat->tailRing->PolyBin);
3051        }
3052#ifdef KDEBUG
3053        if (TEST_OPT_DEBUG)
3054        {
3055          wrp(tmp);
3056          PrintLn();
3057        }
3058#endif
3059        enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
3060      }
3061    }
3062  }
3063  nDelete(&gcd);
3064}
3065
3066void clearSbatch (poly h,int k,int pos,kStrategy strat)
3067{
3068  int j = pos;
3069  if ( (!strat->fromT)
3070  && (1//(strat->syzComp==0)
3071    //||(pGetComp(h)<=strat->syzComp)))
3072  ))
3073  {
3074    // Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
3075    unsigned long h_sev = pGetShortExpVector(h);
3076    loop
3077    {
3078      if (j > k) break;
3079      clearS(h,h_sev, &j,&k,strat);
3080      j++;
3081    }
3082    // Print("end clearS sl=%d\n",strat->sl);
3083  }
3084}
3085
3086/*2
3087* Generates a sufficient set of spolys (maybe just a finite generating
3088* set of the syzygys)
3089*/
3090void superenterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
3091{
3092    assume (rField_is_Ring(currRing));
3093    // enter also zero divisor * poly, if this is non zero and of smaller degree
3094    if (!(rField_is_Domain(currRing))) enterExtendedSpoly(h, strat);
3095    initenterpairsRing(h, k, ecart, 0, strat, atR);
3096    initenterstrongPairs(h, k, ecart, 0, strat, atR);
3097    clearSbatch(h, k, pos, strat);
3098}
3099#endif
3100
3101/*2
3102*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
3103*superfluous elements in S will be deleted
3104*/
3105void enterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
3106{
3107  int j=pos;
3108
3109#ifdef HAVE_RINGS
3110  assume (!rField_is_Ring(currRing));
3111#endif
3112
3113  initenterpairs(h,k,ecart,0,strat, atR);
3114  if ( (!strat->fromT)
3115  && ((strat->syzComp==0)
3116    ||(pGetComp(h)<=strat->syzComp)))
3117  {
3118    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
3119    unsigned long h_sev = pGetShortExpVector(h);
3120    loop
3121    {
3122      if (j > k) break;
3123      clearS(h,h_sev, &j,&k,strat);
3124      j++;
3125    }
3126    //Print("end clearS sl=%d\n",strat->sl);
3127  }
3128 // PrintS("end enterpairs\n");
3129}
3130
3131/*2
3132*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
3133*superfluous elements in S will be deleted
3134*/
3135void enterpairsSpecial (poly h,int k,int ecart,int pos,kStrategy strat, int atR = -1)
3136{
3137  int j;
3138
3139  for (j=0; j<=k; j++)
3140  {
3141    if ((pGetComp(h)==pGetComp(strat->S[j]))
3142    || (0==pGetComp(strat->S[j])))
3143    {
3144      enterOnePairSpecial(j,h,ecart,strat, atR);
3145    }
3146  }
3147//   #ifdef HAVE_PLURAL
3148  if (!rIsPluralRing(currRing))
3149//   #endif
3150  {
3151    j=pos;
3152    loop
3153    {
3154      unsigned long h_sev = pGetShortExpVector(h);
3155      if (j > k) break;
3156      clearS(h,h_sev,&j,&k,strat);
3157      j++;
3158    }
3159  }
3160}
3161
3162/*2
3163*reorders  s with respect to posInS,
3164*suc is the first changed index or zero
3165*/
3166
3167void reorderS (int* suc,kStrategy strat)
3168{
3169  int i,j,at,ecart, s2r;
3170  int fq=0;
3171  unsigned long sev;
3172  poly  p;
3173  int new_suc=strat->sl+1;
3174  i= *suc;
3175  if (i<0) i=0;
3176
3177  for (; i<=strat->sl; i++)
3178  {
3179    at = posInS(strat,i-1,strat->S[i],strat->ecartS[i]);
3180    if (at != i)
3181    {
3182      if (new_suc > at) new_suc = at;
3183      p = strat->S[i];
3184      ecart = strat->ecartS[i];
3185      sev = strat->sevS[i];
3186      s2r = strat->S_2_R[i];
3187      if (strat->fromQ!=NULL) fq=strat->fromQ[i];
3188      for (j=i; j>=at+1; j--)
3189      {
3190        strat->S[j] = strat->S[j-1];
3191        strat->ecartS[j] = strat->ecartS[j-1];
3192        strat->sevS[j] = strat->sevS[j-1];
3193        strat->S_2_R[j] = strat->S_2_R[j-1];
3194      }
3195      strat->S[at] = p;
3196      strat->ecartS[at] = ecart;
3197      strat->sevS[at] = sev;
3198      strat->S_2_R[at] = s2r;
3199      if (strat->fromQ!=NULL)
3200      {
3201        for (j=i; j>=at+1; j--)
3202        {
3203          strat->fromQ[j] = strat->fromQ[j-1];
3204        }
3205        strat->fromQ[at]=fq;
3206      }
3207    }
3208  }
3209  if (new_suc <= strat->sl) *suc=new_suc;
3210  else                      *suc=-1;
3211}
3212
3213
3214/*2
3215*looks up the position of p in set
3216*set[0] is the smallest with respect to the ordering-procedure deg/pComp
3217* Assumption: posInS only depends on the leading term
3218*             otherwise, bba has to be changed
3219*/
3220int posInS (const kStrategy strat, const int length,const poly p,
3221            const int ecart_p)
3222{
3223  if(length==-1) return 0;
3224  polyset set=strat->S;
3225  int i;
3226  int an = 0;
3227  int en = length;
3228  int cmp_int = pOrdSgn;
3229  int pc=pGetComp(p);
3230  if ((currRing->MixedOrder)
3231  && (currRing->real_var_start==0)
3232#if 0
3233  || ((strat->ak>0) && ((currRing->order[0]==ringorder_c)||((currRing->order[0]==ringorder_C))))
3234#endif
3235  )
3236  {
3237    int o=pWTotaldegree(p);
3238    int oo=pWTotaldegree(set[length]);
3239
3240    if ((oo<o)
3241    || ((o==oo) && (pLmCmp(set[length],p)!= cmp_int)))
3242      return length+1;
3243
3244    loop
3245    {
3246      if (an >= en-1)
3247      {
3248        if ((pWTotaldegree(set[an])>=o) && (pLmCmp(set[an],p) == cmp_int))
3249        {
3250          return an;
3251        }
3252        return en;
3253      }
3254      i=(an+en) / 2;
3255      if ((pWTotaldegree(set[i])>=o) && (pLmCmp(set[i],p) == cmp_int)) en=i;
3256      else                              an=i;
3257    }
3258  }
3259  else
3260  {
3261#ifdef HAVE_RINGS
3262    if (rField_is_Ring(currRing))
3263    {
3264      if (pLmCmp(set[length],p)== -cmp_int)
3265        return length+1;
3266      int cmp;
3267      loop
3268      {
3269        if (an >= en-1)
3270        {
3271          cmp = pLmCmp(set[an],p);
3272          if (cmp == cmp_int)  return an;
3273          if (cmp == -cmp_int) return en;
3274          if (nDivBy(pGetCoeff(p), pGetCoeff(set[an]))) return en;
3275          return an;
3276        }
3277        i = (an+en) / 2;
3278        cmp = pLmCmp(set[i],p);
3279        if (cmp == cmp_int)         en = i;
3280        else if (cmp == -cmp_int)   an = i;
3281        else
3282        {
3283          if (nDivBy(pGetCoeff(p), pGetCoeff(set[i]))) an = i;
3284          else en = i;
3285        }
3286      }
3287    }
3288    else
3289#endif
3290    if (pLmCmp(set[length],p)== -cmp_int)
3291      return length+1;
3292
3293    loop
3294    {
3295      if (an >= en-1)
3296      {
3297        if (pLmCmp(set[an],p) == cmp_int) return an;
3298        if (pLmCmp(set[an],p) == -cmp_int) return en;
3299        if ((cmp_int!=1)
3300        && ((strat->ecartS[an])>ecart_p))
3301          return an;
3302        return en;
3303      }
3304      i=(an+en) / 2;
3305      if (pLmCmp(set[i],p) == cmp_int) en=i;
3306      else if (pLmCmp(set[i],p) == -cmp_int) an=i;
3307      else
3308      {
3309        if ((cmp_int!=1)
3310        &&((strat->ecartS[i])<ecart_p))
3311          en=i;
3312        else
3313          an=i;
3314      }
3315    }
3316  }
3317}
3318
3319
3320/*2
3321* looks up the position of p in set
3322* the position is the last one
3323*/
3324int posInT0 (const TSet set,const int length,LObject &p)
3325{
3326  return (length+1);
3327}
3328
3329
3330/*2
3331* looks up the position of p in T
3332* set[0] is the smallest with respect to the ordering-procedure
3333* pComp
3334*/
3335int posInT1 (const TSet set,const int length,LObject &p)
3336{
3337  if (length==-1) return 0;
3338
3339  if (pLmCmp(set[length].p,p.p)!= pOrdSgn) return length+1;
3340
3341  int i;
3342  int an = 0;
3343  int en= length;
3344
3345  loop
3346  {
3347    if (an >= en-1)
3348    {
3349      if (pLmCmp(set[an].p,p.p) == pOrdSgn) return an;
3350      return en;
3351    }
3352    i=(an+en) / 2;
3353    if (pLmCmp(set[i].p,p.p) == pOrdSgn) en=i;
3354    else                                 an=i;
3355  }
3356}
3357
3358/*2
3359* looks up the position of p in T
3360* set[0] is the smallest with respect to the ordering-procedure
3361* length
3362*/
3363int posInT2 (const TSet set,const int length,LObject &p)
3364{
3365  if (length==-1)
3366    return 0;
3367  if (set[length].length<p.length)
3368    return length+1;
3369
3370  int i;
3371  int an = 0;
3372  int en= length;
3373
3374  loop
3375  {
3376    if (an >= en-1)
3377    {
3378      if (set[an].length>p.length) return an;
3379      return en;
3380    }
3381    i=(an+en) / 2;
3382    if (set[i].length>p.length) en=i;
3383    else                        an=i;
3384  }
3385}
3386
3387/*2
3388* looks up the position of p in T
3389* set[0] is the smallest with respect to the ordering-procedure
3390* totaldegree,pComp
3391*/
3392int posInT11 (const TSet set,const int length,LObject &p)
3393/*{
3394 * int j=0;
3395 * int o;
3396 *
3397 * o = p.GetpFDeg();
3398 * loop
3399 * {
3400 *   if ((pFDeg(set[j].p) > o)
3401 *   || ((pFDeg(set[j].p) == o) && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
3402 *   {
3403 *     return j;
3404 *   }
3405 *   j++;
3406 *   if (j > length) return j;
3407 * }
3408 *}
3409 */
3410{
3411  if (length==-1) return 0;
3412
3413  int o = p.GetpFDeg();
3414  int op = set[length].GetpFDeg();
3415
3416  if ((op < o)
3417  || ((op == o) && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3418    return length+1;
3419
3420  int i;
3421  int an = 0;
3422  int en= length;
3423
3424  loop
3425  {
3426    if (an >= en-1)
3427    {
3428      op= set[an].GetpFDeg();
3429      if ((op > o)
3430      || (( op == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3431        return an;
3432      return en;
3433    }
3434    i=(an+en) / 2;
3435    op = set[i].GetpFDeg();
3436    if (( op > o)
3437    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3438      en=i;
3439    else
3440      an=i;
3441  }
3442}
3443
3444/*2 Pos for rings T: Here I am
3445* looks up the position of p in T
3446* set[0] is the smallest with respect to the ordering-procedure
3447* totaldegree,pComp
3448*/
3449int posInTrg0 (const TSet set,const int length,LObject &p)
3450{
3451  if (length==-1) return 0;
3452  int o = p.GetpFDeg();
3453  int op = set[length].GetpFDeg();
3454  int i;
3455  int an = 0;
3456  int en = length;
3457  int cmp_int = pOrdSgn;
3458  if ((op < o) || (pLmCmp(set[length].p,p.p)== -cmp_int))
3459    return length+1;
3460  int cmp;
3461  loop
3462  {
3463    if (an >= en-1)
3464    {
3465      op = set[an].GetpFDeg();
3466      if (op > o) return an;
3467      if (op < 0) return en;
3468      cmp = pLmCmp(set[an].p,p.p);
3469      if (cmp == cmp_int)  return an;
3470      if (cmp == -cmp_int) return en;
3471      if (nGreater(pGetCoeff(p.p), pGetCoeff(set[an].p))) return en;
3472      return an;
3473    }
3474    i = (an + en) / 2;
3475    op = set[i].GetpFDeg();
3476    if (op > o)       en = i;
3477    else if (op < o)  an = i;
3478    else
3479    {
3480      cmp = pLmCmp(set[i].p,p.p);
3481      if (cmp == cmp_int)                                     en = i;
3482      else if (cmp == -cmp_int)                               an = i;
3483      else if (nGreater(pGetCoeff(p.p), pGetCoeff(set[i].p))) an = i;
3484      else                                                    en = i;
3485    }
3486  }
3487}
3488/*
3489  int o = p.GetpFDeg();
3490  int op = set[length].GetpFDeg();
3491
3492  if ((op < o)
3493  || ((op == o) && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3494    return length+1;
3495
3496  int i;
3497  int an = 0;
3498  int en= length;
3499
3500  loop
3501  {
3502    if (an >= en-1)
3503    {
3504      op= set[an].GetpFDeg();
3505      if ((op > o)
3506      || (( op == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3507        return an;
3508      return en;
3509    }
3510    i=(an+en) / 2;
3511    op = set[i].GetpFDeg();
3512    if (( op > o)
3513    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3514      en=i;
3515    else
3516      an=i;
3517  }
3518}
3519  */
3520/*2
3521* looks up the position of p in T
3522* set[0] is the smallest with respect to the ordering-procedure
3523* totaldegree,pComp
3524*/
3525int posInT110 (const TSet set,const int length,LObject &p)
3526{
3527  if (length==-1) return 0;
3528
3529  int o = p.GetpFDeg();
3530  int op = set[length].GetpFDeg();
3531
3532  if (( op < o)
3533  || (( op == o) && (set[length].length<p.length))
3534  || (( op == o) && (set[length].length == p.length)
3535     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3536    return length+1;
3537
3538  int i;
3539  int an = 0;
3540  int en= length;
3541  loop
3542  {
3543    if (an >= en-1)
3544    {
3545      op = set[an].GetpFDeg();
3546      if (( op > o)
3547      || (( op == o) && (set[an].length > p.length))
3548      || (( op == o) && (set[an].length == p.length)
3549         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3550        return an;
3551      return en;
3552    }
3553    i=(an+en) / 2;
3554    op = set[i].GetpFDeg();
3555    if (( op > o)
3556    || (( op == o) && (set[i].length > p.length))
3557    || (( op == o) && (set[i].length == p.length)
3558       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3559      en=i;
3560    else
3561      an=i;
3562  }
3563}
3564
3565/*2
3566* looks up the position of p in set
3567* set[0] is the smallest with respect to the ordering-procedure
3568* pFDeg
3569*/
3570int posInT13 (const TSet set,const int length,LObject &p)
3571{
3572  if (length==-1) return 0;
3573
3574  int o = p.GetpFDeg();
3575
3576  if (set[length].GetpFDeg() <= o)
3577    return length+1;
3578
3579  int i;
3580  int an = 0;
3581  int en= length;
3582  loop
3583  {
3584    if (an >= en-1)
3585    {
3586      if (set[an].GetpFDeg() > o)
3587        return an;
3588      return en;
3589    }
3590    i=(an+en) / 2;
3591    if (set[i].GetpFDeg() > o)
3592      en=i;
3593    else
3594      an=i;
3595  }
3596}
3597
3598// determines the position based on: 1.) Ecart 2.) pLength
3599int posInT_EcartpLength(const TSet set,const int length,LObject &p)
3600{
3601  if (length==-1) return 0;
3602
3603  int op=p.ecart;
3604  int ol = p.GetpLength();
3605
3606  int oo=set[length].ecart;
3607  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
3608    return length+1;
3609
3610  int i;
3611  int an = 0;
3612  int en= length;
3613  loop
3614    {
3615      if (an >= en-1)
3616      {
3617        int oo=set[an].ecart;
3618        if((oo > op)
3619           || ((oo==op) && (set[an].pLength > ol)))
3620          return an;
3621        return en;
3622      }
3623      i=(an+en) / 2;
3624      int oo=set[i].ecart;
3625      if ((oo > op)
3626          || ((oo == op) && (set[i].pLength > ol)))
3627        en=i;
3628      else
3629        an=i;
3630    }
3631}
3632
3633/*2
3634* looks up the position of p in set
3635* set[0] is the smallest with respect to the ordering-procedure
3636* maximaldegree, pComp
3637*/
3638int posInT15 (const TSet set,const int length,LObject &p)
3639/*{
3640 *int j=0;
3641 * int o;
3642 *
3643 * o = p.GetpFDeg()+p.ecart;
3644 * loop
3645 * {
3646 *   if ((set[j].GetpFDeg()+set[j].ecart > o)
3647 *   || ((set[j].GetpFDeg()+set[j].ecart == o)
3648 *     && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
3649 *   {
3650 *     return j;
3651 *   }
3652 *   j++;
3653 *   if (j > length) return j;
3654 * }
3655 *}
3656 */
3657{
3658  if (length==-1) return 0;
3659
3660  int o = p.GetpFDeg() + p.ecart;
3661  int op = set[length].GetpFDeg()+set[length].ecart;
3662
3663  if ((op < o)
3664  || ((op == o)
3665     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3666    return length+1;
3667
3668  int i;
3669  int an = 0;
3670  int en= length;
3671  loop
3672  {
3673    if (an >= en-1)
3674    {
3675      op = set[an].GetpFDeg()+set[an].ecart;
3676      if (( op > o)
3677      || (( op  == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3678        return an;
3679      return en;
3680    }
3681    i=(an+en) / 2;
3682    op = set[i].GetpFDeg()+set[i].ecart;
3683    if (( op > o)
3684    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3685      en=i;
3686    else
3687      an=i;
3688  }
3689}
3690
3691/*2
3692* looks up the position of p in set
3693* set[0] is the smallest with respect to the ordering-procedure
3694* pFDeg+ecart, ecart, pComp
3695*/
3696int posInT17 (const TSet set,const int length,LObject &p)
3697/*
3698*{
3699* int j=0;
3700* int  o;
3701*
3702*  o = p.GetpFDeg()+p.ecart;
3703*  loop
3704*  {
3705*    if ((pFDeg(set[j].p)+set[j].ecart > o)
3706*    || (((pFDeg(set[j].p)+set[j].ecart == o)
3707*      && (set[j].ecart < p.ecart)))
3708*    || ((pFDeg(set[j].p)+set[j].ecart == o)
3709*      && (set[j].ecart==p.ecart)
3710*      && (pLmCmp(set[j].p,p.p)==pOrdSgn)))
3711*      return j;
3712*    j++;
3713*    if (j > length) return j;
3714*  }
3715* }
3716*/
3717{
3718  if (length==-1) return 0;
3719
3720  int o = p.GetpFDeg() + p.ecart;
3721  int op = set[length].GetpFDeg()+set[length].ecart;
3722
3723  if ((op < o)
3724  || (( op == o) && (set[length].ecart > p.ecart))
3725  || (( op == o) && (set[length].ecart==p.ecart)
3726     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3727    return length+1;
3728
3729  int i;
3730  int an = 0;
3731  int en= length;
3732  loop
3733  {
3734    if (an >= en-1)
3735    {
3736      op = set[an].GetpFDeg()+set[an].ecart;
3737      if (( op > o)
3738      || (( op == o) && (set[an].ecart < p.ecart))
3739      || (( op  == o) && (set[an].ecart==p.ecart)
3740         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3741        return an;
3742      return en;
3743    }
3744    i=(an+en) / 2;
3745    op = set[i].GetpFDeg()+set[i].ecart;
3746    if ((op > o)
3747    || (( op == o) && (set[i].ecart < p.ecart))
3748    || (( op == o) && (set[i].ecart == p.ecart)
3749       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3750      en=i;
3751    else
3752      an=i;
3753  }
3754}
3755/*2
3756* looks up the position of p in set
3757* set[0] is the smallest with respect to the ordering-procedure
3758* pGetComp, pFDeg+ecart, ecart, pComp
3759*/
3760int posInT17_c (const TSet set,const int length,LObject &p)
3761{
3762  if (length==-1) return 0;
3763
3764  int cc = (-1+2*currRing->order[0]==ringorder_c);
3765  /* cc==1 for (c,..), cc==-1 for (C,..) */
3766  int o = p.GetpFDeg() + p.ecart;
3767  int c = pGetComp(p.p)*cc;
3768
3769  if (pGetComp(set[length].p)*cc < c)
3770    return length+1;
3771  if (pGetComp(set[length].p)*cc == c)
3772  {
3773    int op = set[length].GetpFDeg()+set[length].ecart;
3774    if ((op < o)
3775    || ((op == o) && (set[length].ecart > p.ecart))
3776    || ((op == o) && (set[length].ecart==p.ecart)
3777       && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3778      return length+1;
3779  }
3780
3781  int i;
3782  int an = 0;
3783  int en= length;
3784  loop
3785  {
3786    if (an >= en-1)
3787    {
3788      if (pGetComp(set[an].p)*cc < c)
3789        return en;
3790      if (pGetComp(set[an].p)*cc == c)
3791      {
3792        int op = set[an].GetpFDeg()+set[an].ecart;
3793        if ((op > o)
3794        || ((op == o) && (set[an].ecart < p.ecart))
3795        || ((op == o) && (set[an].ecart==p.ecart)
3796           && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3797          return an;
3798      }
3799      return en;
3800    }
3801    i=(an+en) / 2;
3802    if (pGetComp(set[i].p)*cc > c)
3803      en=i;
3804    else if (pGetComp(set[i].p)*cc == c)
3805    {
3806      int op = set[i].GetpFDeg()+set[i].ecart;
3807      if ((op > o)
3808      || ((op == o) && (set[i].ecart < p.ecart))
3809      || ((op == o) && (set[i].ecart == p.ecart)
3810         && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3811        en=i;
3812      else
3813        an=i;
3814    }
3815    else
3816      an=i;
3817  }
3818}
3819
3820/*2
3821* looks up the position of p in set
3822* set[0] is the smallest with respect to
3823* ecart, pFDeg, length
3824*/
3825int posInT19 (const TSet set,const int length,LObject &p)
3826{
3827  if (length==-1) return 0;
3828
3829  int o = p.ecart;
3830  int op=p.GetpFDeg();
3831
3832  if (set[length].ecart < o)
3833    return length+1;
3834  if (set[length].ecart == o)
3835  {
3836     int oo=set[length].GetpFDeg();
3837     if ((oo < op) || ((oo==op) && (set[length].length < p.length)))
3838       return length+1;
3839  }
3840
3841  int i;
3842  int an = 0;
3843  int en= length;
3844  loop
3845  {
3846    if (an >= en-1)
3847    {
3848      if (set[an].ecart > o)
3849        return an;
3850      if (set[an].ecart == o)
3851      {
3852         int oo=set[an].GetpFDeg();
3853         if((oo > op)
3854         || ((oo==op) && (set[an].length > p.length)))
3855           return an;
3856      }
3857      return en;
3858    }
3859    i=(an+en) / 2;
3860    if (set[i].ecart > o)
3861      en=i;
3862    else if (set[i].ecart == o)
3863    {
3864       int oo=set[i].GetpFDeg();
3865       if ((oo > op)
3866       || ((oo == op) && (set[i].length > p.length)))
3867         en=i;
3868       else
3869        an=i;
3870    }
3871    else
3872      an=i;
3873  }
3874}
3875
3876/*2
3877*looks up the position of polynomial p in set
3878*set[length] is the smallest element in set with respect
3879*to the ordering-procedure pComp
3880*/
3881int posInLSpecial (const LSet set, const int length,
3882                   LObject *p,const kStrategy strat)
3883{
3884  if (length<0) return 0;
3885
3886  int d=p->GetpFDeg();
3887  int op=set[length].GetpFDeg();
3888
3889  if ((op > d)
3890  || ((op == d) && (p->p1!=NULL)&&(set[length].p1==NULL))
3891  || (pLmCmp(set[length].p,p->p)== pOrdSgn))
3892     return length+1;
3893
3894  int i;
3895  int an = 0;
3896  int en= length;
3897  loop
3898  {
3899    if (an >= en-1)
3900    {
3901      op=set[an].GetpFDeg();
3902      if ((op > d)
3903      || ((op == d) && (p->p1!=NULL) && (set[an].p1==NULL))
3904      || (pLmCmp(set[an].p,p->p)== pOrdSgn))
3905         return en;
3906      return an;
3907    }
3908    i=(an+en) / 2;
3909    op=set[i].GetpFDeg();
3910    if ((op>d)
3911    || ((op==d) && (p->p1!=NULL) && (set[i].p1==NULL))
3912    || (pLmCmp(set[i].p,p->p) == pOrdSgn))
3913      an=i;
3914    else
3915      en=i;
3916  }
3917}
3918
3919/*2
3920*looks up the position of polynomial p in set
3921*set[length] is the smallest element in set with respect
3922*to the ordering-procedure pComp
3923*/
3924int posInL0 (const LSet set, const int length,
3925             LObject* p,const kStrategy strat)
3926{
3927  if (length<0) return 0;
3928
3929  if (pLmCmp(set[length].p,p->p)== pOrdSgn)
3930    return length+1;
3931
3932  int i;
3933  int an = 0;
3934  int en= length;
3935  loop
3936  {
3937    if (an >= en-1)
3938    {
3939      if (pLmCmp(set[an].p,p->p) == pOrdSgn) return en;
3940      return an;
3941    }
3942    i=(an+en) / 2;
3943    if (pLmCmp(set[i].p,p->p) == pOrdSgn) an=i;
3944    else                                 en=i;
3945    /*aend. fuer lazy == in !=- machen */
3946  }
3947}
3948
3949/*2
3950* looks up the position of polynomial p in set
3951* e is the ecart of p
3952* set[length] is the smallest element in set with respect
3953* to the ordering-procedure totaldegree,pComp
3954*/
3955int posInL11 (const LSet set, const int length,
3956              LObject* p,const kStrategy strat)
3957/*{
3958 * int j=0;
3959 * int o;
3960 *
3961 * o = p->GetpFDeg();
3962 * loop
3963 * {
3964 *   if (j > length)            return j;
3965 *   if ((set[j].GetpFDeg() < o)) return j;
3966 *   if ((set[j].GetpFDeg() == o) && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
3967 *   {
3968 *     return j;
3969 *   }
3970 *   j++;
3971 * }
3972 *}
3973 */
3974{
3975  if (length<0) return 0;
3976
3977  int o = p->GetpFDeg();
3978  int op = set[length].GetpFDeg();
3979
3980  if ((op > o)
3981  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
3982    return length+1;
3983  int i;
3984  int an = 0;
3985  int en= length;
3986  loop
3987  {
3988    if (an >= en-1)
3989    {
3990      op = set[an].GetpFDeg();
3991      if ((op > o)
3992      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
3993        return en;
3994      return an;
3995    }
3996    i=(an+en) / 2;
3997    op = set[i].GetpFDeg();
3998    if ((op > o)
3999    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4000      an=i;
4001    else
4002      en=i;
4003  }
4004}
4005
4006/*2 Position for rings L: Here I am
4007* looks up the position of polynomial p in set
4008* e is the ecart of p
4009* set[length] is the smallest element in set with respect
4010* to the ordering-procedure totaldegree,pComp
4011*/
4012inline int getIndexRng(long coeff)
4013{
4014  if (coeff == 0) return -1;
4015  long tmp = coeff;
4016  int ind = 0;
4017  while (tmp % 2 == 0)
4018  {
4019    tmp = tmp / 2;
4020    ind++;
4021  }
4022  return ind;
4023}
4024
4025int posInLrg0 (const LSet set, const int length,
4026              LObject* p,const kStrategy strat)
4027/*          if (nGreater(pGetCoeff(p), pGetCoeff(set[an]))) return en;
4028        if (pLmCmp(set[i],p) == cmp_int)         en = i;
4029        else if (pLmCmp(set[i],p) == -cmp_int)   an = i;
4030        else
4031        {
4032          if (nGreater(pGetCoeff(p), pGetCoeff(set[i]))) an = i;
4033          else en = i;
4034        }*/
4035{
4036  if (length < 0) return 0;
4037
4038  int o = p->GetpFDeg();
4039  int op = set[length].GetpFDeg();
4040
4041  if ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4042    return length + 1;
4043  int i;
4044  int an = 0;
4045  int en = length;
4046  loop
4047  {
4048    if (an >= en - 1)
4049    {
4050      op = set[an].GetpFDeg();
4051      if ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4052        return en;
4053      return an;
4054    }
4055    i = (an+en) / 2;
4056    op = set[i].GetpFDeg();
4057    if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4058      an = i;
4059    else
4060      en = i;
4061  }
4062}
4063
4064/*{
4065  if (length < 0) return 0;
4066
4067  int o = p->GetpFDeg();
4068  int op = set[length].GetpFDeg();
4069
4070  int inde = getIndexRng((unsigned long) pGetCoeff(set[length].p));
4071  int indp = getIndexRng((unsigned long) pGetCoeff(p->p));
4072  int inda;
4073  int indi;
4074
4075  if ((inda > indp) || ((inda == inde) && ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))))
4076    return length + 1;
4077  int i;
4078  int an = 0;
4079  inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
4080  int en = length;
4081  loop
4082  {
4083    if (an >= en-1)
4084    {
4085      op = set[an].GetpFDeg();
4086      if ((indp > inda) || ((indp == inda) && ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))))
4087        return en;
4088      return an;
4089    }
4090    i = (an + en) / 2;
4091    indi = getIndexRng((unsigned long) pGetCoeff(set[i].p));
4092    op = set[i].GetpFDeg();
4093    if ((indi > indp) || ((indi == indp) && ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))))
4094    // if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4095    {
4096      an = i;
4097      inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
4098    }
4099    else
4100      en = i;
4101  }
4102} */
4103
4104/*2
4105* looks up the position of polynomial p in set
4106* set[length] is the smallest element in set with respect
4107* to the ordering-procedure totaldegree,pLength0
4108*/
4109int posInL110 (const LSet set, const int length,
4110               LObject* p,const kStrategy strat)
4111{
4112  if (length<0) return 0;
4113
4114  int o = p->GetpFDeg();
4115  int op = set[length].GetpFDeg();
4116
4117  if ((op > o)
4118  || ((op == o) && (set[length].length >p->length))
4119  || ((op == o) && (set[length].length <= p->length)
4120     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4121    return length+1;
4122  int i;
4123  int an = 0;
4124  int en= length;
4125  loop
4126  {
4127    if (an >= en-1)
4128    {
4129      op = set[an].GetpFDeg();
4130      if ((op > o)
4131      || ((op == o) && (set[an].length >p->length))
4132      || ((op == o) && (set[an].length <=p->length)
4133         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4134        return en;
4135      return an;
4136    }
4137    i=(an+en) / 2;
4138    op = set[i].GetpFDeg();
4139    if ((op > o)
4140    || ((op == o) && (set[i].length > p->length))
4141    || ((op == o) && (set[i].length <= p->length)
4142       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4143      an=i;
4144    else
4145      en=i;
4146  }
4147}
4148
4149/*2
4150* looks up the position of polynomial p in set
4151* e is the ecart of p
4152* set[length] is the smallest element in set with respect
4153* to the ordering-procedure totaldegree
4154*/
4155int posInL13 (const LSet set, const int length,
4156              LObject* p,const kStrategy strat)
4157{
4158  if (length<0) return 0;
4159
4160  int o = p->GetpFDeg();
4161
4162  if (set[length].GetpFDeg() > o)
4163    return length+1;
4164
4165  int i;
4166  int an = 0;
4167  int en= length;
4168  loop
4169  {
4170    if (an >= en-1)
4171    {
4172      if (set[an].GetpFDeg() >= o)
4173        return en;
4174      return an;
4175    }
4176    i=(an+en) / 2;
4177    if (set[i].GetpFDeg() >= o)
4178      an=i;
4179    else
4180      en=i;
4181  }
4182}
4183
4184/*2
4185* looks up the position of polynomial p in set
4186* e is the ecart of p
4187* set[length] is the smallest element in set with respect
4188* to the ordering-procedure maximaldegree,pComp
4189*/
4190int posInL15 (const LSet set, const int length,
4191              LObject* p,const kStrategy strat)
4192/*{
4193 * int j=0;
4194 * int o;
4195 *
4196 * o = p->ecart+p->GetpFDeg();
4197 * loop
4198 * {
4199 *   if (j > length)                       return j;
4200 *   if (set[j].GetpFDeg()+set[j].ecart < o) return j;
4201 *   if ((set[j].GetpFDeg()+set[j].ecart == o)
4202 *   && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
4203 *   {
4204 *     return j;
4205 *   }
4206 *   j++;
4207 * }
4208 *}
4209 */
4210{
4211  if (length<0) return 0;
4212
4213  int o = p->GetpFDeg() + p->ecart;
4214  int op = set[length].GetpFDeg() + set[length].ecart;
4215
4216  if ((op > o)
4217  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4218    return length+1;
4219  int i;
4220  int an = 0;
4221  int en= length;
4222  loop
4223  {
4224    if (an >= en-1)
4225    {
4226      op = set[an].GetpFDeg() + set[an].ecart;
4227      if ((op > o)
4228      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4229        return en;
4230      return an;
4231    }
4232    i=(an+en) / 2;
4233    op = set[i].GetpFDeg() + set[i].ecart;
4234    if ((op > o)
4235    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4236      an=i;
4237    else
4238      en=i;
4239  }
4240}
4241
4242/*2
4243* looks up the position of polynomial p in set
4244* e is the ecart of p
4245* set[length] is the smallest element in set with respect
4246* to the ordering-procedure totaldegree
4247*/
4248int posInL17 (const LSet set, const int length,
4249              LObject* p,const kStrategy strat)
4250{
4251  if (length<0) return 0;
4252
4253  int o = p->GetpFDeg() + p->ecart;
4254
4255  if ((set[length].GetpFDeg() + set[length].ecart > o)
4256  || ((set[length].GetpFDeg() + set[length].ecart == o)
4257     && (set[length].ecart > p->ecart))
4258  || ((set[length].GetpFDeg() + set[length].ecart == o)
4259     && (set[length].ecart == p->ecart)
4260     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4261    return length+1;
4262  int i;
4263  int an = 0;
4264  int en= length;
4265  loop
4266  {
4267    if (an >= en-1)
4268    {
4269      if ((set[an].GetpFDeg() + set[an].ecart > o)
4270      || ((set[an].GetpFDeg() + set[an].ecart == o)
4271         && (set[an].ecart > p->ecart))
4272      || ((set[an].GetpFDeg() + set[an].ecart == o)
4273         && (set[an].ecart == p->ecart)
4274         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4275        return en;
4276      return an;
4277    }
4278    i=(an+en) / 2;
4279    if ((set[i].GetpFDeg() + set[i].ecart > o)
4280    || ((set[i].GetpFDeg() + set[i].ecart == o)
4281       && (set[i].ecart > p->ecart))
4282    || ((set[i].GetpFDeg() +set[i].ecart == o)
4283       && (set[i].ecart == p->ecart)
4284       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4285      an=i;
4286    else
4287      en=i;
4288  }
4289}
4290/*2
4291* looks up the position of polynomial p in set
4292* e is the ecart of p
4293* set[length] is the smallest element in set with respect
4294* to the ordering-procedure pComp
4295*/
4296int posInL17_c (const LSet set, const int length,
4297                LObject* p,const kStrategy strat)
4298{
4299  if (length<0) return 0;
4300
4301  int cc = (-1+2*currRing->order[0]==ringorder_c);
4302  /* cc==1 for (c,..), cc==-1 for (C,..) */
4303  int c = pGetComp(p->p)*cc;
4304  int o = p->GetpFDeg() + p->ecart;
4305
4306  if (pGetComp(set[length].p)*cc > c)
4307    return length+1;
4308  if (pGetComp(set[length].p)*cc == c)
4309  {
4310    if ((set[length].GetpFDeg() + set[length].ecart > o)
4311    || ((set[length].GetpFDeg() + set[length].ecart == o)
4312       && (set[length].ecart > p->ecart))
4313    || ((set[length].GetpFDeg() + set[length].ecart == o)
4314       && (set[length].ecart == p->ecart)
4315       && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4316      return length+1;
4317  }
4318  int i;
4319  int an = 0;
4320  int en= length;
4321  loop
4322  {
4323    if (an >= en-1)
4324    {
4325      if (pGetComp(set[an].p)*cc > c)
4326        return en;
4327      if (pGetComp(set[an].p)*cc == c)
4328      {
4329        if ((set[an].GetpFDeg() + set[an].ecart > o)
4330        || ((set[an].GetpFDeg() + set[an].ecart == o)
4331           && (set[an].ecart > p->ecart))
4332        || ((set[an].GetpFDeg() + set[an].ecart == o)
4333           && (set[an].ecart == p->ecart)
4334           && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4335          return en;
4336      }
4337      return an;
4338    }
4339    i=(an+en) / 2;
4340    if (pGetComp(set[i].p)*cc > c)
4341      an=i;
4342    else if (pGetComp(set[i].p)*cc == c)
4343    {
4344      if ((set[i].GetpFDeg() + set[i].ecart > o)
4345      || ((set[i].GetpFDeg() + set[i].ecart == o)
4346         && (set[i].ecart > p->ecart))
4347      || ((set[i].GetpFDeg() +set[i].ecart == o)
4348         && (set[i].ecart == p->ecart)
4349         && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4350        an=i;
4351      else
4352        en=i;
4353    }
4354    else
4355      en=i;
4356  }
4357}
4358
4359/***************************************************************
4360 *
4361 * Tail reductions
4362 *
4363 ***************************************************************/
4364TObject*
4365kFindDivisibleByInS(kStrategy strat, int pos, LObject* L, TObject *T,
4366                    long ecart)
4367{
4368  int j = 0;
4369  const unsigned long not_sev = ~L->sev;
4370  const unsigned long* sev = strat->sevS;
4371  poly p;
4372  ring r;
4373  L->GetLm(p, r);
4374
4375  assume(~not_sev == p_GetShortExpVector(p, r));
4376
4377  if (r == currRing)
4378  {
4379    loop
4380    {
4381      if (j > pos) return NULL;
4382#if defined(PDEBUG) || defined(PDIV_DEBUG)
4383      if (p_LmShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
4384          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4385        break;
4386#else
4387      if (!(sev[j] & not_sev) &&
4388          (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
4389          p_LmDivisibleBy(strat->S[j], p, r))
4390        break;
4391
4392#endif
4393      j++;
4394    }
4395    // if called from NF, T objects do not exist:
4396    if (strat->tl < 0 || strat->S_2_R[j] == -1)
4397    {
4398      T->Set(strat->S[j], r, strat->tailRing);
4399      return T;
4400    }
4401    else
4402    {
4403/////      assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL
4404/////      && strat->S_2_T(j)->p == strat->S[j]); // wrong?
4405//      assume (j >= 0 && j <= strat->sl && strat->S_2_T(j) != NULL && strat->S_2_T(j)->p == strat->S[j]);
4406      return strat->S_2_T(j);
4407    }
4408  }
4409  else
4410  {
4411    TObject* t;
4412    loop
4413    {
4414      if (j > pos) return NULL;
4415      assume(strat->S_2_R[j] != -1);
4416#if defined(PDEBUG) || defined(PDIV_DEBUG)
4417      t = strat->S_2_T(j);
4418      assume(t != NULL && t->t_p != NULL && t->tailRing == r);
4419      if (p_LmShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
4420          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4421        return t;
4422#else
4423      if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4424      {
4425        t = strat->S_2_T(j);
4426        assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
4427        if (p_LmDivisibleBy(t->t_p, p, r)) return t;
4428      }
4429#endif
4430      j++;
4431    }
4432  }
4433}
4434
4435poly redtail (LObject* L, int pos, kStrategy strat)
4436{
4437  poly h, hn;
4438  int j;
4439  unsigned long not_sev;
4440  strat->redTailChange=FALSE;
4441
4442  poly p = L->p;
4443  if (strat->noTailReduction || pNext(p) == NULL)
4444    return p;
4445
4446  LObject Ln(strat->tailRing);
4447  TObject* With;
4448  // placeholder in case strat->tl < 0
4449  TObject  With_s(strat->tailRing);
4450  h = p;
4451  hn = pNext(h);
4452  long op = strat->tailRing->pFDeg(hn, strat->tailRing);
4453  long e;
4454  int l;
4455  BOOLEAN save_HE=strat->kHEdgeFound;
4456  strat->kHEdgeFound |=
4457    ((Kstd1_deg>0) && (op<=Kstd1_deg)) || TEST_OPT_INFREDTAIL;
4458
4459  while(hn != NULL)
4460  {
4461    op = strat->tailRing->pFDeg(hn, strat->tailRing);
4462    if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
4463    e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
4464    loop
4465    {
4466      Ln.Set(hn, strat->tailRing);
4467      Ln.sev = p_GetShortExpVector(hn, strat->tailRing);
4468      if (strat->kHEdgeFound)
4469        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
4470      else
4471        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s, e);
4472      if (With == NULL) break;
4473      With->length=0;
4474      With->pLength=0;
4475      strat->redTailChange=TRUE;
4476      if (ksReducePolyTail(L, With, h, strat->kNoetherTail()))
4477      {
4478        // reducing the tail would violate the exp bound
4479        if (kStratChangeTailRing(strat, L))
4480        {
4481          strat->kHEdgeFound = save_HE;
4482          return redtail(L, pos, strat);
4483        }
4484        else
4485          return NULL;
4486      }
4487      hn = pNext(h);
4488      if (hn == NULL) goto all_done;
4489      op = strat->tailRing->pFDeg(hn, strat->tailRing);
4490      if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
4491      e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
4492    }
4493    h = hn;
4494    hn = pNext(h);
4495  }
4496
4497  all_done:
4498  if (strat->redTailChange)
4499  {
4500    L->last = 0;
4501    L->pLength = 0;
4502  }
4503  strat->kHEdgeFound = save_HE;
4504  return p;
4505}
4506
4507poly redtail (poly p, int pos, kStrategy strat)
4508{
4509  LObject L(p, currRing);
4510  return redtail(&L, pos, strat);
4511}
4512
4513poly redtailBba (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
4514{
4515#define REDTAIL_CANONICALIZE 100
4516  strat->redTailChange=FALSE;
4517  if (strat->noTailReduction) return L->GetLmCurrRing();
4518  poly h, p;
4519  p = h = L->GetLmTailRing();
4520  if ((h==NULL) || (pNext(h)==NULL))
4521    return L->GetLmCurrRing();
4522
4523  TObject* With;
4524  // placeholder in case strat->tl < 0
4525  TObject  With_s(strat->tailRing);
4526
4527  LObject Ln(pNext(h), strat->tailRing);
4528  Ln.pLength = L->GetpLength() - 1;
4529
4530  pNext(h) = NULL;
4531  if (L->p != NULL) pNext(L->p) = NULL;
4532  L->pLength = 1;
4533
4534  Ln.PrepareRed(strat->use_buckets);
4535
4536  int cnt=REDTAIL_CANONICALIZE;
4537  while(!Ln.IsNull())
4538  {
4539    loop
4540    {
4541      Ln.SetShortExpVector();
4542      if (withT)
4543      {
4544        int j;
4545        j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
4546        if (j < 0) break;
4547        With = &(strat->T[j]);
4548      }
4549      else
4550      {
4551        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
4552        if (With == NULL) break;
4553      }
4554      cnt--;
4555      if (cnt==0)
4556      {
4557        cnt=REDTAIL_CANONICALIZE; 
4558        poly tmp=Ln.CanonicalizeP(); 
4559        if (normalize) 
4560        {
4561          Ln.Normalize();
4562          //pNormalize(tmp);
4563          //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
4564        }
4565      }
4566      if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
4567      {
4568        With->pNorm();
4569      }
4570      strat->redTailChange=TRUE;
4571      if (ksReducePolyTail(L, With, &Ln))
4572      {
4573        // reducing the tail would violate the exp bound
4574        //  set a flag and hope for a retry (in bba)
4575        strat->completeReduce_retry=TRUE;
4576        do
4577        {
4578          pNext(h) = Ln.LmExtractAndIter();
4579          pIter(h);
4580          L->pLength++;
4581        } while (!Ln.IsNull());
4582        goto all_done;
4583      }
4584      if (Ln.IsNull()) goto all_done;
4585      if (! withT) With_s.Init(currRing);
4586    }
4587    pNext(h) = Ln.LmExtractAndIter();
4588    pIter(h);
4589    pNormalize(h);
4590    L->pLength++;
4591  }
4592
4593  all_done:
4594  Ln.Delete();
4595  if (L->p != NULL) pNext(L->p) = pNext(p);
4596
4597  if (strat->redTailChange)
4598  {
4599    L->last = NULL;
4600    L->length = 0;
4601  }
4602
4603  //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
4604  //L->Normalize(); // HANNES: should have a test
4605  kTest_L(L);
4606  return L->GetLmCurrRing();
4607}
4608
4609/*2
4610*checks the change degree and write progress report
4611*/
4612void message (int i,int* reduc,int* olddeg,kStrategy strat, int red_result)
4613{
4614  if (i != *olddeg)
4615  {
4616    Print("%d",i);
4617    *olddeg = i;
4618  }
4619  if (K_TEST_OPT_OLDSTD)
4620  {
4621    if (strat->Ll != *reduc)
4622    {
4623      if (strat->Ll != *reduc-1)
4624        Print("(%d)",strat->Ll+1);
4625      else
4626        PrintS("-");
4627      *reduc = strat->Ll;
4628    }
4629    else
4630      PrintS(".");
4631    mflush();
4632  }
4633  else
4634  {
4635    if (red_result == 0)
4636      PrintS("-");
4637    else if (red_result < 0)
4638      PrintS(".");
4639    if ((red_result > 0) || ((strat->Ll % 100)==99))
4640    {
4641      if (strat->Ll != *reduc && strat->Ll > 0)
4642      {
4643        Print("(%d)",strat->Ll+1);
4644        *reduc = strat->Ll;
4645      }
4646    }
4647  }
4648}
4649
4650/*2
4651*statistics
4652*/
4653void messageStat (int srmax,int lrmax,int hilbcount,kStrategy strat)
4654{
4655  //PrintS("\nUsage/Allocation of temporary storage:\n");
4656  //Print("%d/%d polynomials in standard base\n",srmax,IDELEMS(Shdl));
4657  //Print("%d/%d polynomials in set L (for lazy alg.)",lrmax+1,strat->Lmax);
4658  Print("product criterion:%d chain criterion:%d\n",strat->cp,strat->c3);
4659  if (hilbcount!=0) Print("hilbert series criterion:%d\n",hilbcount);
4660  /* in usual case strat->cv is 0, it gets changed only in shift routines */
4661  if (strat->cv!=0) Print("shift V criterion:%d\n",strat->cv);
4662  /*mflush();*/
4663}
4664
4665#ifdef KDEBUG
4666/*2
4667*debugging output: all internal sets, if changed
4668*for testing purpuse only/has to be changed for later use
4669*/
4670void messageSets (kStrategy strat)
4671{
4672  int i;
4673  if (strat->news)
4674  {
4675    PrintS("set S");
4676    for (i=0; i<=strat->sl; i++)
4677    {
4678      Print("\n  %d:",i);
4679      p_wrp(strat->S[i], currRing, strat->tailRing);
4680    }
4681    strat->news = FALSE;
4682  }
4683  if (strat->newt)
4684  {
4685    PrintS("\nset T");
4686    for (i=0; i<=strat->tl; i++)
4687    {
4688      Print("\n  %d:",i);
4689      strat->T[i].wrp();
4690      Print(" o:%d e:%d l:%d",
4691        strat->T[i].pFDeg(),strat->T[i].ecart,strat->T[i].length);
4692    }
4693    strat->newt = FALSE;
4694  }
4695  PrintS("\nset L");
4696  for (i=strat->Ll; i>=0; i--)
4697  {
4698    Print("\n%d:",i);
4699    p_wrp(strat->L[i].p1, currRing, strat->tailRing);
4700    PrintS("  ");
4701    p_wrp(strat->L[i].p2, currRing, strat->tailRing);
4702    PrintS(" lcm: ");p_wrp(strat->L[i].lcm, currRing);
4703    PrintS("\n  p : ");
4704    strat->L[i].wrp();
4705    Print("  o:%d e:%d l:%d",
4706          strat->L[i].pFDeg(),strat->L[i].ecart,strat->L[i].length);
4707  }
4708  PrintLn();
4709}
4710
4711#endif
4712
4713
4714/*2
4715*construct the set s from F
4716*/
4717void initS (ideal F, ideal Q, kStrategy strat)
4718{
4719  int   i,pos;
4720
4721  if (Q!=NULL) i=((IDELEMS(F)+IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4722  else         i=((IDELEMS(F)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4723  strat->ecartS=initec(i);
4724  strat->sevS=initsevS(i);
4725  strat->S_2_R=initS_2_R(i);
4726  strat->fromQ=NULL;
4727  strat->Shdl=idInit(i,F->rank);
4728  strat->S=strat->Shdl->m;
4729  /*- put polys into S -*/
4730  if (Q!=NULL)
4731  {
4732    strat->fromQ=initec(i);
4733    memset(strat->fromQ,0,i*sizeof(int));
4734    for (i=0; i<IDELEMS(Q); i++)
4735    {
4736      if (Q->m[i]!=NULL)
4737      {
4738        LObject h;
4739        h.p = pCopy(Q->m[i]);
4740        if (TEST_OPT_INTSTRATEGY)
4741        {
4742          //pContent(h.p);
4743          h.pCleardenom(); // also does a pContent
4744        }
4745        else
4746        {
4747          h.pNorm();
4748        }
4749        if (pOrdSgn==-1)
4750        {
4751          deleteHC(&h, strat);
4752        }
4753        if (h.p!=NULL)
4754        {
4755          strat->initEcart(&h);
4756          if (strat->sl==-1)
4757            pos =0;
4758          else
4759          {
4760            pos = posInS(strat,strat->sl,h.p,h.ecart);
4761          }
4762          h.sev = pGetShortExpVector(h.p);
4763          strat->enterS(h,pos,strat,-1);
4764          strat->fromQ[pos]=1;
4765        }
4766      }
4767    }
4768  }
4769  for (i=0; i<IDELEMS(F); i++)
4770  {
4771    if (F->m[i]!=NULL)
4772    {
4773      LObject h;
4774      h.p = pCopy(F->m[i]);
4775      if (pOrdSgn==-1)
4776      {
4777        cancelunit(&h);  /*- tries to cancel a unit -*/
4778        deleteHC(&h, strat);
4779      }
4780      if (TEST_OPT_INTSTRATEGY)
4781      {
4782        //pContent(h.p);
4783        h.pCleardenom(); // also does a pContent
4784      }
4785      else
4786      {
4787        h.pNorm();
4788      }
4789      if (h.p!=NULL)
4790      {
4791        strat->initEcart(&h);
4792        if (strat->sl==-1)
4793          pos =0;
4794        else
4795          pos = posInS(strat,strat->sl,h.p,h.ecart);
4796        h.sev = pGetShortExpVector(h.p);
4797        strat->enterS(h,pos,strat,-1);
4798      }
4799    }
4800  }
4801  /*- test, if a unit is in F -*/
4802  if ((strat->sl>=0)
4803#ifdef HAVE_RINGS
4804       && nIsUnit(pGetCoeff(strat->S[0]))
4805#endif
4806       && pIsConstant(strat->S[0]))
4807  {
4808    while (strat->sl>0) deleteInS(strat->sl,strat);
4809  }
4810}
4811
4812void initSL (ideal F, ideal Q,kStrategy strat)
4813{
4814  int   i,pos;
4815
4816  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4817  else i=setmaxT;
4818  strat->ecartS=initec(i);
4819  strat->sevS=initsevS(i);
4820  strat->S_2_R=initS_2_R(i);
4821  strat->fromQ=NULL;
4822  strat->Shdl=idInit(i,F->rank);
4823  strat->S=strat->Shdl->m;
4824  /*- put polys into S -*/
4825  if (Q!=NULL)
4826  {
4827    strat->fromQ=initec(i);
4828    memset(strat->fromQ,0,i*sizeof(int));
4829    for (i=0; i<IDELEMS(Q); i++)
4830    {
4831      if (Q->m[i]!=NULL)
4832      {
4833        LObject h;
4834        h.p = pCopy(Q->m[i]);
4835        if (pOrdSgn==-1)
4836        {
4837          deleteHC(&h,strat);
4838        }
4839        if (TEST_OPT_INTSTRATEGY)
4840        {
4841          //pContent(h.p);
4842          h.pCleardenom(); // also does a pContent
4843        }
4844        else
4845        {
4846          h.pNorm();
4847        }
4848        if (h.p!=NULL)
4849        {
4850          strat->initEcart(&h);
4851          if (strat->sl==-1)
4852            pos =0;
4853          else
4854          {
4855            pos = posInS(strat,strat->sl,h.p,h.ecart);
4856          }
4857          h.sev = pGetShortExpVector(h.p);
4858          strat->enterS(h,pos,strat,-1);
4859          strat->fromQ[pos]=1;
4860        }
4861      }
4862    }
4863  }
4864  for (i=0; i<IDELEMS(F); i++)
4865  {
4866    if (F->m[i]!=NULL)
4867    {
4868      LObject h;
4869      h.p = pCopy(F->m[i]);
4870      if (h.p!=NULL)
4871      {
4872        if (pOrdSgn==-1)
4873        {
4874          cancelunit(&h);  /*- tries to cancel a unit -*/
4875          deleteHC(&h, strat);
4876        }
4877        if (h.p!=NULL)
4878        {
4879          if (TEST_OPT_INTSTRATEGY)
4880          {
4881            //pContent(h.p);
4882            h.pCleardenom(); // also does a pContent
4883          }
4884          else
4885          {
4886            h.pNorm();
4887          }
4888          strat->initEcart(&h);
4889          if (strat->Ll==-1)
4890            pos =0;
4891          else
4892            pos = strat->posInL(strat->L,strat->Ll,&h,strat);
4893          h.sev = pGetShortExpVector(h.p);
4894          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
4895        }
4896      }
4897    }
4898  }
4899  /*- test, if a unit is in F -*/
4900
4901  if ((strat->Ll>=0) 
4902#ifdef HAVE_RINGS
4903       && nIsUnit(pGetCoeff(strat->L[strat->Ll].p))
4904#endif
4905       && pIsConstant(strat->L[strat->Ll].p))
4906  {
4907    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
4908  }
4909}
4910
4911
4912/*2
4913*construct the set s from F and {P}
4914*/
4915void initSSpecial (ideal F, ideal Q, ideal P,kStrategy strat)
4916{
4917  int   i,pos;
4918
4919  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4920  else i=setmaxT;
4921  i=((i+IDELEMS(F)+IDELEMS(P)+15)/16)*16;
4922  strat->ecartS=initec(i);
4923  strat->sevS=initsevS(i);
4924  strat->S_2_R=initS_2_R(i);
4925  strat->fromQ=NULL;
4926  strat->Shdl=idInit(i,F->rank);
4927  strat->S=strat->Shdl->m;
4928
4929  /*- put polys into S -*/
4930  if (Q!=NULL)
4931  {
4932    strat->fromQ=initec(i);
4933    memset(strat->fromQ,0,i*sizeof(int));
4934    for (i=0; i<IDELEMS(Q); i++)
4935    {
4936      if (Q->m[i]!=NULL)
4937      {
4938        LObject h;
4939        h.p = pCopy(Q->m[i]);
4940        //if (TEST_OPT_INTSTRATEGY)
4941        //{
4942        //  //pContent(h.p);
4943        //  h.pCleardenom(); // also does a pContent
4944        //}
4945        //else
4946        //{
4947        //  h.pNorm();
4948        //}
4949        if (pOrdSgn==-1)
4950        {
4951          deleteHC(&h,strat);
4952        }
4953        if (h.p!=NULL)
4954        {
4955          strat->initEcart(&h);
4956          if (strat->sl==-1)
4957            pos =0;
4958          else
4959          {
4960            pos = posInS(strat,strat->sl,h.p,h.ecart);
4961          }
4962          h.sev = pGetShortExpVector(h.p);
4963          strat->enterS(h,pos,strat, strat->tl+1);
4964          enterT(h, strat);
4965          strat->fromQ[pos]=1;
4966        }
4967      }
4968    }
4969  }
4970  /*- put polys into S -*/
4971  for (i=0; i<IDELEMS(F); i++)
4972  {
4973    if (F->m[i]!=NULL)
4974    {
4975      LObject h;
4976      h.p = pCopy(F->m[i]);
4977      if (pOrdSgn==-1)
4978      {
4979        deleteHC(&h,strat);
4980      }
4981      else
4982      {
4983        h.p=redtailBba(h.p,strat->sl,strat);
4984      }
4985      if (h.p!=NULL)
4986      {
4987        strat->initEcart(&h);
4988        if (strat->sl==-1)
4989          pos =0;
4990        else
4991          pos = posInS(strat,strat->sl,h.p,h.ecart);
4992        h.sev = pGetShortExpVector(h.p);
4993        strat->enterS(h,pos,strat, strat->tl+1);
4994        enterT(h,strat);
4995      }
4996    }
4997  }
4998  for (i=0; i<IDELEMS(P); i++)
4999  {
5000    if (P->m[i]!=NULL)
5001    {
5002      LObject h;
5003      h.p=pCopy(P->m[i]);
5004      if (TEST_OPT_INTSTRATEGY)
5005      {
5006        h.pCleardenom();
5007      }
5008      else
5009      {
5010        h.pNorm();
5011      }
5012      if(strat->sl>=0)
5013      {
5014        if (pOrdSgn==1)
5015        {
5016          h.p=redBba(h.p,strat->sl,strat);
5017          if (h.p!=NULL)
5018          {
5019            h.p=redtailBba(h.p,strat->sl,strat);
5020          }
5021        }
5022        else
5023        {
5024          h.p=redMora(h.p,strat->sl,strat);
5025        }
5026        if(h.p!=NULL)
5027        {
5028          strat->initEcart(&h);
5029          if (TEST_OPT_INTSTRATEGY)
5030          {
5031            h.pCleardenom();
5032          }
5033          else
5034          {
5035            h.is_normalized = 0;
5036            h.pNorm();
5037          }
5038          h.sev = pGetShortExpVector(h.p);
5039          h.SetpFDeg();
5040          pos = posInS(strat,strat->sl,h.p,h.ecart);
5041          enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
5042          strat->enterS(h,pos,strat, strat->tl+1);
5043          enterT(h,strat);
5044        }
5045      }
5046      else
5047      {
5048        h.sev = pGetShortExpVector(h.p);
5049        strat->initEcart(&h);
5050        strat->enterS(h,0,strat, strat->tl+1);
5051        enterT(h,strat);
5052      }
5053    }
5054  }
5055}
5056/*2
5057* reduces h using the set S
5058* procedure used in cancelunit1
5059*/
5060static poly redBba1 (poly h,int maxIndex,kStrategy strat)
5061{
5062  int j = 0;
5063  unsigned long not_sev = ~ pGetShortExpVector(h);
5064
5065  while (j <= maxIndex)
5066  {
5067    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j],h, not_sev))
5068       return ksOldSpolyRedNew(strat->S[j],h,strat->kNoetherTail());
5069    else j++;
5070  }
5071  return h;
5072}
5073
5074/*2
5075*tests if p.p=monomial*unit and cancels the unit
5076*/
5077void cancelunit1 (LObject* p,int *suc, int index,kStrategy strat )
5078{
5079  int k;
5080  poly r,h,h1,q;
5081
5082  if (!pIsVector((*p).p) && ((*p).ecart != 0))
5083  {
5084    k = 0;
5085    h1 = r = pCopy((*p).p);
5086    h =pNext(r);
5087    loop
5088    {
5089      if (h==NULL)
5090      {
5091        pDelete(&r);
5092        pDelete(&(pNext((*p).p)));
5093        (*p).ecart = 0;
5094        (*p).length = 1;
5095        (*suc)=0;
5096        return;
5097      }
5098      if (!pDivisibleBy(r,h))
5099      {
5100        q=redBba1(h,index ,strat);
5101        if (q != h)
5102        {
5103          k++;
5104          pDelete(&h);
5105          pNext(h1) = h = q;
5106        }
5107        else
5108        {
5109          pDelete(&r);
5110          return;
5111        }
5112      }
5113      else
5114      {
5115        h1 = h;
5116        pIter(h);
5117      }
5118      if (k > 10)
5119      {
5120        pDelete(&r);
5121        return;
5122      }
5123    }
5124  }
5125}
5126
5127#if 0
5128/*2
5129* reduces h using the elements from Q in the set S
5130* procedure used in updateS
5131* must not be used for elements of Q or elements of an ideal !
5132*/
5133static poly redQ (poly h, int j, kStrategy strat)
5134{
5135  int start;
5136  unsigned long not_sev = ~ pGetShortExpVector(h);
5137  while ((j <= strat->sl) && (pGetComp(strat->S[j])!=0)) j++;
5138  start=j;
5139  while (j<=strat->sl)
5140  {
5141    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
5142    {
5143      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
5144      if (h==NULL) return NULL;
5145      j = start;
5146      not_sev = ~ pGetShortExpVector(h);
5147    }
5148    else j++;
5149  }
5150  return h;
5151}
5152#endif
5153
5154/*2
5155* reduces h using the set S
5156* procedure used in updateS
5157*/
5158static poly redBba (poly h,int maxIndex,kStrategy strat)
5159{
5160  int j = 0;
5161  unsigned long not_sev = ~ pGetShortExpVector(h);
5162
5163  while (j <= maxIndex)
5164  {
5165    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
5166    {
5167      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
5168      if (h==NULL) return NULL;
5169      j = 0;
5170      not_sev = ~ pGetShortExpVector(h);    }
5171    else j++;
5172  }
5173  return h;
5174}
5175
5176/*2
5177* reduces h using the set S
5178*e is the ecart of h
5179*procedure used in updateS
5180*/
5181static poly redMora (poly h,int maxIndex,kStrategy strat)
5182{
5183  int  j=0;
5184  int  e,l;
5185  unsigned long not_sev = ~ pGetShortExpVector(h);
5186
5187  if (maxIndex >= 0)
5188  {
5189    e = pLDeg(h,&l,currRing)-pFDeg(h,currRing);
5190    do
5191    {
5192      if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev)
5193      && ((e >= strat->ecartS[j]) || strat->kHEdgeFound))
5194      {
5195#ifdef KDEBUG
5196        if (TEST_OPT_DEBUG)
5197          {PrintS("reduce ");wrp(h);Print(" with S[%d] (",j);wrp(strat->S[j]);}
5198#endif
5199        h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
5200#ifdef KDEBUG
5201        if(TEST_OPT_DEBUG)
5202          {PrintS(")\nto "); wrp(h); PrintLn();}
5203#endif
5204        // pDelete(&h);
5205        if (h == NULL) return NULL;
5206        e = pLDeg(h,&l,currRing)-pFDeg(h,currRing);
5207        j = 0;
5208        not_sev = ~ pGetShortExpVector(h);
5209      }
5210      else j++;
5211    }
5212    while (j <= maxIndex);
5213  }
5214  return h;
5215}
5216
5217/*2
5218*updates S:
5219*the result is a set of polynomials which are in
5220*normalform with respect to S
5221*/
5222void updateS(BOOLEAN toT,kStrategy strat)
5223{
5224  LObject h;
5225  int i, suc=0;
5226  poly redSi=NULL;
5227  BOOLEAN change,any_change;
5228//  Print("nach initS: updateS start mit sl=%d\n",(strat->sl));
5229//  for (i=0; i<=(strat->sl); i++)
5230//  {
5231//    Print("s%d:",i);
5232//    if (strat->fromQ!=NULL) Print("(Q:%d) ",strat->fromQ[i]);
5233//    pWrite(strat->S[i]);
5234//  }
5235//  Print("pOrdSgn=%d\n", pOrdSgn);
5236  any_change=FALSE;
5237  if (pOrdSgn==1)
5238  {
5239    while (suc != -1)
5240    {
5241      i=suc+1;
5242      while (i<=strat->sl)
5243      {
5244        change=FALSE;
5245        if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
5246        {
5247          redSi = pHead(strat->S[i]);
5248          strat->S[i] = redBba(strat->S[i],i-1,strat);
5249          //if ((strat->ak!=0)&&(strat->S[i]!=NULL))
5250          //  strat->S[i]=redQ(strat->S[i],i+1,strat); /*reduce S[i] mod Q*/
5251          if (pCmp(redSi,strat->S[i])!=0)
5252          {
5253            change=TRUE;
5254            any_change=TRUE;
5255            #ifdef KDEBUG
5256            if (TEST_OPT_DEBUG)
5257            {
5258              PrintS("reduce:");
5259              wrp(redSi);PrintS(" to ");p_wrp(strat->S[i], currRing, strat->tailRing);PrintLn();
5260            }
5261            #endif
5262            if (TEST_OPT_PROT)
5263            {
5264              if (strat->S[i]==NULL)
5265                PrintS("V");
5266              else
5267                PrintS("v");
5268              mflush();
5269            }
5270          }
5271          pDeleteLm(&redSi);
5272          if (strat->S[i]==NULL)
5273          {
5274            deleteInS(i,strat);
5275            i--;
5276          }
5277          else if (change)
5278          {
5279            if (TEST_OPT_INTSTRATEGY)
5280            {
5281              //pContent(strat->S[i]);
5282              pCleardenom(strat->S[i]);// also does a pContent
5283            }
5284            else
5285            {
5286              pNorm(strat->S[i]);
5287            }
5288            strat->sevS[i] = pGetShortExpVector(strat->S[i]);
5289          }
5290        }
5291        i++;
5292      }
5293      if (any_change) reorderS(&suc,strat);
5294      else break;
5295    }
5296    if (toT)
5297    {
5298      for (i=0; i<=strat->sl; i++)
5299      {
5300        if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
5301        {
5302          h.p = redtailBba(strat->S[i],i-1,strat);
5303          if (TEST_OPT_INTSTRATEGY)
5304          {
5305            pCleardenom(h.p);// also does a pContent
5306          }
5307        }
5308        else
5309        {
5310          h.p = strat->S[i];
5311        }
5312        strat->initEcart(&h);
5313        if (strat->honey)
5314        {
5315          strat->ecartS[i] = h.ecart;
5316        }
5317        if (strat->sevS[i] == 0) {strat->sevS[i] = pGetShortExpVector(h.p);}
5318        else assume(strat->sevS[i] == pGetShortExpVector(h.p));
5319        h.sev = strat->sevS[i];
5320        /*puts the elements of S also to T*/
5321        enterT(h,strat);
5322        strat->S_2_R[i] = strat->tl;
5323      }
5324    }
5325  }
5326  else
5327  {
5328    while (suc != -1)
5329    {
5330      i=suc;
5331      while (i<=strat->sl)
5332      {
5333        change=FALSE;
5334        if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
5335        {
5336          redSi=pHead((strat->S)[i]);
5337          (strat->S)[i] = redMora((strat->S)[i],i-1,strat);
5338          if ((strat->S)[i]==NULL)
5339          {
5340            deleteInS(i,strat);
5341            i--;
5342          }
5343          else if (pCmp((strat->S)[i],redSi)!=0)
5344          {
5345            any_change=TRUE;
5346            h.p = strat->S[i];
5347            strat->initEcart(&h);
5348            strat->ecartS[i] = h.ecart;
5349            if (TEST_OPT_INTSTRATEGY)
5350            {
5351              pCleardenom(strat->S[i]);// also does a pContent
5352            }
5353            else
5354            {
5355              pNorm(strat->S[i]); // == h.p
5356            }
5357            h.sev =  pGetShortExpVector(h.p);
5358            strat->sevS[i] = h.sev;
5359          }
5360          pDeleteLm(&redSi);
5361          kTest(strat);
5362        }
5363        i++;
5364      }
5365#ifdef KDEBUG
5366      kTest(strat);
5367#endif
5368      if (any_change) reorderS(&suc,strat);
5369      else { suc=-1; break; }
5370      if (h.p!=NULL)
5371      {
5372        if (!strat->kHEdgeFound)
5373        {
5374          /*strat->kHEdgeFound =*/ HEckeTest(h.p,strat);
5375        }
5376        if (strat->kHEdgeFound)
5377          newHEdge(strat->S,strat);
5378      }
5379    }
5380    for (i=0; i<=strat->sl; i++)
5381    {
5382      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
5383      {
5384        strat->S[i] = h.p = redtail(strat->S[i],strat->sl,strat);
5385        strat->initEcart(&h);
5386        strat->ecartS[i] = h.ecart;
5387        h.sev = pGetShortExpVector(h.p);
5388        strat->sevS[i] = h.sev;
5389      }
5390      else
5391      {
5392        h.p = strat->S[i];
5393        h.ecart=strat->ecartS[i];
5394        h.sev = strat->sevS[i];
5395        h.length = h.pLength = pLength(h.p);
5396      }
5397      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
5398        cancelunit1(&h,&suc,strat->sl,strat);
5399      h.SetpFDeg();
5400      /*puts the elements of S also to T*/
5401      enterT(h,strat);
5402      strat->S_2_R[i] = strat->tl;
5403    }
5404    if (suc!= -1) updateS(toT,strat);
5405  }
5406#ifdef KDEBUG
5407  kTest(strat);
5408#endif
5409}
5410
5411
5412/*2
5413* -puts p to the standardbasis s at position at
5414* -saves the result in S
5415*/
5416void enterSBba (LObject p,int atS,kStrategy strat, int atR)
5417{
5418  int i;
5419  strat->news = TRUE;
5420  /*- puts p to the standardbasis s at position at -*/
5421  if (strat->sl == IDELEMS(strat->Shdl)-1)
5422  {
5423    strat->sevS = (unsigned long*) omRealloc0Size(strat->sevS,
5424                                    IDELEMS(strat->Shdl)*sizeof(unsigned long),
5425                                    (IDELEMS(strat->Shdl)+setmaxTinc)
5426                                                  *sizeof(unsigned long));
5427    strat->ecartS = (intset)omReallocSize(strat->ecartS,
5428                                          IDELEMS(strat->Shdl)*sizeof(int),
5429                                          (IDELEMS(strat->Shdl)+setmaxTinc)
5430                                                  *sizeof(int));
5431    strat->S_2_R = (int*) omRealloc0Size(strat->S_2_R,
5432                                         IDELEMS(strat->Shdl)*sizeof(int),
5433                                         (IDELEMS(strat->Shdl)+setmaxTinc)
5434                                                  *sizeof(int));
5435    if (strat->lenS!=NULL)
5436      strat->lenS=(int*)omRealloc0Size(strat->lenS,
5437                                       IDELEMS(strat->Shdl)*sizeof(int),
5438                                       (IDELEMS(strat->Shdl)+setmaxTinc)
5439                                                 *sizeof(int));
5440    if (strat->lenSw!=NULL)
5441      strat->lenSw=(wlen_type*)omRealloc0Size(strat->lenSw,
5442                                       IDELEMS(strat->Shdl)*sizeof(wlen_type),
5443                                       (IDELEMS(strat->Shdl)+setmaxTinc)
5444                                                 *sizeof(wlen_type));
5445    if (strat->fromQ!=NULL)
5446    {
5447      strat->fromQ = (intset)omReallocSize(strat->fromQ,
5448                                    IDELEMS(strat->Shdl)*sizeof(int),
5449                                    (IDELEMS(strat->Shdl)+setmaxTinc)*sizeof(int));
5450    }
5451    pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmaxTinc);
5452    IDELEMS(strat->Shdl)+=setmaxTinc;
5453    strat->Shdl->m=strat->S;
5454  }
5455  if (atS <= strat->sl)
5456  {
5457#ifdef ENTER_USE_MEMMOVE
5458// #if 0
5459    memmove(&(strat->S[atS+1]), &(strat->S[atS]),
5460            (strat->sl - atS + 1)*sizeof(poly));
5461    memmove(&(strat->ecartS[atS+1]), &(strat->ecartS[atS]),
5462            (strat->sl - atS + 1)*sizeof(int));
5463    memmove(&(strat->sevS[atS+1]), &(strat->sevS[atS]),
5464            (strat->sl - atS + 1)*sizeof(unsigned long));
5465    memmove(&(strat->S_2_R[atS+1]), &(strat->S_2_R[atS]),
5466            (strat->sl - atS + 1)*sizeof(int));
5467    if (strat->lenS!=NULL)
5468    memmove(&(strat->lenS[atS+1]), &(strat->lenS[atS]),
5469            (strat->sl - atS + 1)*sizeof(int));
5470    if (strat->lenSw!=NULL)
5471    memmove(&(strat->lenSw[atS+1]), &(strat->lenSw[atS]),
5472            (strat->sl - atS + 1)*sizeof(wlen_type));
5473#else
5474    for (i=strat->sl+1; i>=atS+1; i--)
5475    {
5476      strat->S[i] = strat->S[i-1];
5477      strat->ecartS[i] = strat->ecartS[i-1];
5478      strat->sevS[i] = strat->sevS[i-1];
5479      strat->S_2_R[i] = strat->S_2_R[i-1];
5480    }
5481    if (strat->lenS!=NULL)
5482    for (i=strat->sl+1; i>=atS+1; i--)
5483      strat->lenS[i] = strat->lenS[i-1];
5484    if (strat->lenSw!=NULL)
5485    for (i=strat->sl+1; i>=atS+1; i--)
5486      strat->lenSw[i] = strat->lenSw[i-1];
5487#endif
5488  }
5489  if (strat->fromQ!=NULL)
5490  {
5491#ifdef ENTER_USE_MEMMOVE
5492    memmove(&(strat->fromQ[atS+1]), &(strat->fromQ[atS]),
5493                  (strat->sl - atS + 1)*sizeof(int));
5494#else
5495    for (i=strat->sl+1; i>=atS+1; i--)
5496    {
5497      strat->fromQ[i] = strat->fromQ[i-1];
5498    }
5499#endif
5500    strat->fromQ[atS]=0;
5501  }
5502
5503  /*- save result -*/
5504  strat->S[atS] = p.p;
5505  if (strat->honey) strat->ecartS[atS] = p.ecart;
5506  if (p.sev == 0)
5507    p.sev = pGetShortExpVector(p.p);
5508  else
5509    assume(p.sev == pGetShortExpVector(p.p));
5510  strat->sevS[atS] = p.sev;
5511  strat->ecartS[atS] = p.ecart;
5512  strat->S_2_R[atS] = atR;
5513  strat->sl++;
5514}
5515
5516/*2
5517* puts p to the set T at position atT
5518*/
5519void enterT(LObject p, kStrategy strat, int atT)
5520{
5521  int i;
5522
5523  pp_Test(p.p, currRing, p.tailRing);
5524  assume(strat->tailRing == p.tailRing);
5525  // redMoraNF complains about this -- but, we don't really
5526  // neeed this so far
5527  assume(p.pLength == 0 || pLength(p.p) == p.pLength);
5528  assume(p.FDeg == p.pFDeg());
5529  assume(!p.is_normalized || nIsOne(pGetCoeff(p.p)));
5530
5531#ifdef KDEBUG 
5532  // do not put an LObject twice into T:
5533  for(i=strat->tl;i>=0;i--)
5534  {
5535    if (p.p==strat->T[i].p) 
5536    {
5537      printf("already in T at pos %d of %d, atT=%d\n",i,strat->tl,atT);
5538      return;
5539    }
5540  }
5541#endif 
5542  strat->newt = TRUE;
5543  if (atT < 0)
5544    atT = strat->posInT(strat->T, strat->tl, p);
5545  if (strat->tl == strat->tmax-1)
5546    enlargeT(strat->T,strat->R,strat->sevT,strat->tmax,setmaxTinc);
5547  if (atT <= strat->tl)
5548  {
5549#ifdef ENTER_USE_MEMMOVE
5550    memmove(&(strat->T[atT+1]), &(strat->T[atT]),
5551            (strat->tl-atT+1)*sizeof(TObject));
5552    memmove(&(strat->sevT[atT+1]), &(strat->sevT[atT]),
5553            (strat->tl-atT+1)*sizeof(unsigned long));
5554#endif
5555    for (i=strat->tl+1; i>=atT+1; i--)
5556    {
5557#ifndef ENTER_USE_MEMMOVE
5558      strat->T[i] = strat->T[i-1];
5559      strat->sevT[i] = strat->sevT[i-1];
5560#endif
5561      strat->R[strat->T[i].i_r] = &(strat->T[i]);
5562    }
5563  }
5564
5565  if (strat->tailBin != NULL && (pNext(p.p) != NULL))
5566  {
5567    pNext(p.p)=p_ShallowCopyDelete(pNext(p.p),
5568                                   (strat->tailRing != NULL ?
5569                                    strat->tailRing : currRing),
5570                                   strat->tailBin);
5571    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
5572  }
5573  strat->T[atT] = (TObject) p;
5574
5575  if (strat->tailRing != currRing && pNext(p.p) != NULL)
5576    strat->T[atT].max = p_GetMaxExpP(pNext(p.p), strat->tailRing);
5577  else
5578    strat->T[atT].max = NULL;
5579
5580  strat->tl++;
5581  strat->R[strat->tl] = &(strat->T[atT]);
5582  strat->T[atT].i_r = strat->tl;
5583  assume(p.sev == 0 || pGetShortExpVector(p.p) == p.sev);
5584  strat->sevT[atT] = (p.sev == 0 ? pGetShortExpVector(p.p) : p.sev);
5585  kTest_T(&(strat->T[atT]));
5586}
5587
5588void initHilbCrit(ideal F, ideal Q, intvec **hilb,kStrategy strat)
5589{
5590  if (strat->homog!=isHomog)
5591  {
5592    *hilb=NULL;
5593  }
5594}
5595
5596void initBuchMoraCrit(kStrategy strat)
5597{
5598  strat->sugarCrit =        TEST_OPT_SUGARCRIT;
5599  // obachman: Hmm.. I need BTEST1(2) for notBuckets ..
5600  //  strat->Gebauer =          BTEST1(2) || strat->homog || strat->sugarCrit;
5601  strat->Gebauer =          strat->homog || strat->sugarCrit;
5602  strat->honey =            !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
5603  if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
5604  strat->pairtest = NULL;
5605  /* alway use tailreduction, except:
5606  * - in local rings, - in lex order case, -in ring over extensions */
5607  strat->noTailReduction = !TEST_OPT_REDTAIL;
5608
5609#ifdef HAVE_PLURAL
5610  // and r is plural_ring
5611  if( rIsPluralRing(currRing) || (rIsSCA(currRing) && !strat->z2homog) )
5612  {    //or it has non-quasi-comm type... later
5613    strat->sugarCrit = FALSE;
5614    strat->Gebauer = FALSE;
5615    strat->honey = FALSE;
5616  }
5617#endif
5618
5619#ifdef HAVE_RINGS
5620  // Coefficient ring?
5621  if (rField_is_Ring(currRing))
5622  {
5623    strat->sugarCrit = FALSE;
5624    strat->Gebauer = FALSE ;
5625    strat->honey = FALSE;
5626  }
5627#endif
5628  #ifdef KDEBUG
5629  if (TEST_OPT_DEBUG)
5630  {
5631    if (strat->homog) PrintS("ideal/module is homogeneous\n");
5632    else              PrintS("ideal/module is not homogeneous\n");
5633  }
5634  #endif
5635}
5636
5637BOOLEAN kPosInLDependsOnLength(int (*pos_in_l)
5638                               (const LSet set, const int length,
5639                                LObject* L,const kStrategy strat))
5640{
5641  if (pos_in_l == posInL110 ||
5642      pos_in_l == posInL10)
5643    return TRUE;
5644
5645  return FALSE;
5646}
5647
5648void initBuchMoraPos (kStrategy strat)
5649{
5650  if (pOrdSgn==1)
5651  {
5652    if (strat->honey)
5653    {
5654      strat->posInL = posInL15;
5655      // ok -- here is the deal: from my experiments for Singular-2-0
5656      // I conclude that that posInT_EcartpLength is the best of
5657      // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
5658      // see the table at the end of this file
5659      if (K_TEST_OPT_OLDSTD)
5660        strat->posInT = posInT15;
5661      else
5662        strat->posInT = posInT_EcartpLength;
5663    }
5664    else if (pLexOrder && !TEST_OPT_INTSTRATEGY)
5665    {
5666      strat->posInL = posInL11;
5667      strat->posInT = posInT11;
5668    }
5669    else if (TEST_OPT_INTSTRATEGY)
5670    {
5671      strat->posInL = posInL11;
5672      strat->posInT = posInT11;
5673    }
5674    else
5675    {
5676      strat->posInL = posInL0;
5677      strat->posInT = posInT0;
5678    }
5679    //if (strat->minim>0) strat->posInL =posInLSpecial;
5680    if (strat->homog)
5681    {
5682       strat->posInL = posInL110;
5683       strat->posInT = posInT110;
5684    }
5685  }
5686  else
5687  {
5688    if (strat->homog)
5689    {
5690      strat->posInL = posInL11;
5691      strat->posInT = posInT11;
5692    }
5693    else
5694    {
5695      if ((currRing->order[0]==ringorder_c)
5696      ||(currRing->order[0]==ringorder_C))
5697      {
5698        strat->posInL = posInL17_c;
5699        strat->posInT = posInT17_c;
5700      }
5701      else
5702      {
5703        strat->posInL = posInL17;
5704        strat->posInT = posInT17;
5705      }
5706    }
5707  }
5708  if (strat->minim>0) strat->posInL =posInLSpecial;
5709  // for further tests only
5710  if ((BTEST1(11)) || (BTEST1(12)))
5711    strat->posInL = posInL11;
5712  else if ((BTEST1(13)) || (BTEST1(14)))
5713    strat->posInL = posInL13;
5714  else if ((BTEST1(15)) || (BTEST1(16)))
5715    strat->posInL = posInL15;
5716  else if ((BTEST1(17)) || (BTEST1(18)))
5717    strat->posInL = posInL17;
5718  if (BTEST1(11))
5719    strat->posInT = posInT11;
5720  else if (BTEST1(13))
5721    strat->posInT = posInT13;
5722  else if (BTEST1(15))
5723    strat->posInT = posInT15;
5724  else if ((BTEST1(17)))
5725    strat->posInT = posInT17;
5726  else if ((BTEST1(19)))
5727    strat->posInT = posInT19;
5728  else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
5729    strat->posInT = posInT1;
5730#ifdef HAVE_RINGS
5731  if (rField_is_Ring(currRing))
5732  {
5733    strat->posInL = posInL11;
5734    strat->posInT = posInT11;
5735  }
5736#endif
5737  strat->posInLDependsOnLength = kPosInLDependsOnLength(strat->posInL);
5738}
5739
5740void initBuchMora (ideal F,ideal Q,kStrategy strat)
5741{
5742  strat->interpt = BTEST1(OPT_INTERRUPT);
5743  strat->kHEdge=NULL;
5744  if (pOrdSgn==1) strat->kHEdgeFound=FALSE;
5745  /*- creating temp data structures------------------- -*/
5746  strat->cp = 0;
5747  strat->c3 = 0;
5748  strat->tail = pInit();
5749  /*- set s -*/
5750  strat->sl = -1;
5751  /*- set L -*/
5752  strat->Lmax = ((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
5753  strat->Ll = -1;
5754  strat->L = initL(((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc);
5755  /*- set B -*/
5756  strat->Bmax = setmaxL;
5757  strat->Bl = -1;
5758  strat->B = initL();
5759  /*- set T -*/
5760  strat->tl = -1;
5761  strat->tmax = setmaxT;
5762  strat->T = initT();
5763  strat->R = initR();
5764  strat->sevT = initsevT();
5765  /*- init local data struct.---------------------------------------- -*/
5766  strat->P.ecart=0;
5767  strat->P.length=0;
5768  if (pOrdSgn==-1)
5769  {
5770    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
5771    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
5772  }
5773  if(TEST_OPT_SB_1)
5774  {
5775    int i;
5776    ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
5777    for (i=strat->newIdeal;i<IDELEMS(F);i++)
5778    {
5779      P->m[i-strat->newIdeal] = F->m[i];
5780      F->m[i] = NULL;
5781    }
5782    initSSpecial(F,Q,P,strat);
5783    for (i=strat->newIdeal;i<IDELEMS(F);i++)
5784    {
5785      F->m[i] = P->m[i-strat->newIdeal];
5786      P->m[i-strat->newIdeal] = NULL;
5787    }
5788    idDelete(&P);
5789  }
5790  else
5791  {
5792    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
5793    // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
5794  }
5795  strat->kIdeal = NULL;
5796  strat->fromT = FALSE;
5797  strat->noTailReduction = !TEST_OPT_REDTAIL;
5798  if (!TEST_OPT_SB_1)
5799  {
5800    updateS(TRUE,strat);
5801  }
5802  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
5803  strat->fromQ=NULL;
5804}
5805
5806void exitBuchMora (kStrategy strat)
5807{
5808  /*- release temp data -*/
5809  cleanT(strat);
5810  omFreeSize(strat->T,(strat->tmax)*sizeof(TObject));
5811  omFreeSize(strat->R,(strat->tmax)*sizeof(TObject*));
5812  omFreeSize(strat->sevT, (strat->tmax)*sizeof(unsigned long));
5813  omFreeSize(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
5814  omFreeSize(strat->sevS,IDELEMS(strat->Shdl)*sizeof(int));
5815  omFreeSize(strat->S_2_R,IDELEMS(strat->Shdl)*sizeof(int));
5816  /*- set L: should be empty -*/
5817  omFreeSize(strat->L,(strat->Lmax)*sizeof(LObject));
5818  /*- set B: should be empty -*/
5819  omFreeSize(strat->B,(strat->Bmax)*sizeof(LObject));
5820  pDeleteLm(&strat->tail);
5821  strat->syzComp=0;
5822  if (strat->kIdeal!=NULL)
5823  {
5824    omFreeBin(strat->kIdeal, sleftv_bin);
5825    strat->kIdeal=NULL;
5826  }
5827}
5828
5829/*2
5830* in the case of a standardbase of a module over a qring:
5831* replace polynomials in i by ak vectors,
5832* (the polynomial * unit vectors gen(1)..gen(ak)
5833* in every case (also for ideals:)
5834* deletes divisible vectors/polynomials
5835*/
5836void updateResult(ideal r,ideal Q, kStrategy strat)
5837{
5838  int l;
5839  if (strat->ak>0)
5840  {
5841    for (l=IDELEMS(r)-1;l>=0;l--)
5842    {
5843      if ((r->m[l]!=NULL) && (pGetComp(r->m[l])==0))
5844      {
5845        pDelete(&r->m[l]); // and set it to NULL
5846      }
5847    }
5848    int q;
5849    poly p;
5850    for (l=IDELEMS(r)-1;l>=0;l--)
5851    {
5852      if ((r->m[l]!=NULL)
5853      && (strat->syzComp>0)
5854      && (pGetComp(r->m[l])<=strat->syzComp))
5855      {
5856        for(q=IDELEMS(Q)-1; q>=0;q--)
5857        {
5858          if ((Q->m[q]!=NULL)
5859          &&(pLmDivisibleBy(Q->m[q],r->m[l])))
5860          {
5861            if (TEST_OPT_REDSB)
5862            {
5863              p=r->m[l];
5864              r->m[l]=kNF(Q,NULL,p);
5865              pDelete(&p);
5866            }
5867            else
5868            {
5869              pDelete(&r->m[l]); // and set it to NULL
5870            }
5871            break;
5872          }
5873        }
5874      }
5875    }
5876  }
5877  else
5878  {
5879    int q;
5880    poly p;
5881    for (l=IDELEMS(r)-1;l>=0;l--)
5882    {
5883      if (r->m[l]!=NULL)
5884      {
5885        for(q=IDELEMS(Q)-1; q>=0;q--)
5886        {
5887          if ((Q->m[q]!=NULL)
5888          &&(pLmEqual(r->m[l],Q->m[q])))
5889          {
5890            if (TEST_OPT_REDSB)
5891            {
5892              p=r->m[l];
5893              r->m[l]=kNF(Q,NULL,p);
5894              pDelete(&p);
5895            }
5896            else
5897            {
5898              pDelete(&r->m[l]); // and set it to NULL
5899            }
5900            break;
5901          }
5902        }
5903      }
5904    }
5905  }
5906  idSkipZeroes(r);
5907}
5908
5909void completeReduce (kStrategy strat, BOOLEAN withT)
5910{
5911  int i;
5912  int low = (pOrdSgn == 1 ? 1 : 0);
5913  LObject L;
5914
5915#ifdef KDEBUG
5916  // need to set this: during tailreductions of T[i], T[i].max is out of
5917  // sync
5918  sloppy_max = TRUE;
5919#endif
5920
5921  strat->noTailReduction = FALSE;
5922  if (TEST_OPT_PROT)
5923  {
5924    PrintLn();
5925    if (timerv) writeTime("standard base computed:");
5926  }
5927  if (TEST_OPT_PROT)
5928  {
5929    Print("(S:%d)",strat->sl);mflush();
5930  }
5931  for (i=strat->sl; i>=low; i--)
5932  {
5933    TObject* T_j = strat->s_2_t(i);
5934    if (T_j != NULL)
5935    {
5936      L = *T_j;
5937      poly p;
5938      if (pOrdSgn == 1)
5939        strat->S[i] = redtailBba(&L, i-1, strat, withT);
5940      else
5941        strat->S[i] = redtail(&L, strat->sl, strat);
5942
5943      if (strat->redTailChange && strat->tailRing != currRing)
5944      {
5945        if (T_j->max != NULL) p_LmFree(T_j->max, strat->tailRing);
5946        if (pNext(T_j->p) != NULL)
5947          T_j->max = p_GetMaxExpP(pNext(T_j->p), strat->tailRing);
5948        else
5949          T_j->max = NULL;
5950      }
5951      if (TEST_OPT_INTSTRATEGY)
5952        T_j->pCleardenom();
5953    }
5954    else
5955    {
5956      assume(currRing == strat->tailRing);
5957      if (pOrdSgn == 1)
5958        strat->S[i] = redtailBba(strat->S[i], i-1, strat, withT);
5959      else
5960        strat->S[i] = redtail(strat->S[i], strat->sl, strat);
5961      if (TEST_OPT_INTSTRATEGY)
5962        pCleardenom(strat->S[i]);
5963    }
5964    if (TEST_OPT_PROT)
5965      PrintS("-");
5966  }
5967  if (TEST_OPT_PROT) PrintLn();
5968#ifdef KDEBUG
5969  sloppy_max = FALSE;
5970#endif
5971}
5972
5973
5974/*2
5975* computes the new strat->kHEdge and the new pNoether,
5976* returns TRUE, if pNoether has changed
5977*/
5978BOOLEAN newHEdge(polyset S, kStrategy strat)
5979{
5980  int i,j;
5981  poly newNoether;
5982
5983#if 0
5984  if (currRing->weight_all_1)
5985    scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
5986  else
5987    scComputeHCw(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
5988#else   
5989  scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
5990#endif 
5991  if (strat->t_kHEdge != NULL) p_LmFree(strat->t_kHEdge, strat->tailRing);
5992  if (strat->tailRing != currRing)
5993    strat->t_kHEdge = k_LmInit_currRing_2_tailRing(strat->kHEdge, strat->tailRing);
5994  /* compare old and new noether*/
5995  newNoether = pLmInit(strat->kHEdge);
5996  j = pFDeg(newNoether,currRing);
5997  for (i=1; i<=pVariables; i++)
5998  {
5999    if (pGetExp(newNoether, i) > 0) pDecrExp(newNoether,i);
6000  }
6001  pSetm(newNoether);
6002  if (j < strat->HCord) /*- statistics -*/
6003  {
6004    if (TEST_OPT_PROT)
6005    {
6006      Print("H(%d)",j);
6007      mflush();
6008    }
6009    strat->HCord=j;
6010    #ifdef KDEBUG
6011    if (TEST_OPT_DEBUG)
6012    {
6013      Print("H(%d):",j);
6014      wrp(strat->kHEdge);
6015      PrintLn();
6016    }
6017    #endif
6018  }
6019  if (pCmp(strat->kNoether,newNoether)!=1)
6020  {
6021    pDelete(&strat->kNoether);
6022    strat->kNoether=newNoether;
6023    if (strat->t_kNoether != NULL) p_LmFree(strat->t_kNoether, strat->tailRing);
6024    if (strat->tailRing != currRing)
6025      strat->t_kNoether = k_LmInit_currRing_2_tailRing(strat->kNoether, strat->tailRing);
6026
6027    return TRUE;
6028  }
6029  pLmFree(newNoether);
6030  return FALSE;
6031}
6032
6033/***************************************************************
6034 *
6035 * Routines related for ring changes during std computations
6036 *
6037 ***************************************************************/
6038BOOLEAN kCheckSpolyCreation(LObject *L, kStrategy strat, poly &m1, poly &m2)
6039{
6040  assume(L->p1 != NULL && L->p2 != NULL);
6041  // shift changes: from 0 to -1
6042  assume(L->i_r1 >= -1 && L->i_r1 <= strat->tl);
6043  assume(L->i_r2 >= -1 && L->i_r2 <= strat->tl);
6044  assume(strat->tailRing != currRing);
6045
6046  if (! k_GetLeadTerms(L->p1, L->p2, currRing, m1, m2, strat->tailRing))
6047    return FALSE;
6048  // shift changes: extra case inserted