source: git/kernel/kutil.cc @ 356960

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