source: git/kernel/kutil.cc @ f92547

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