source: git/kernel/kutil.cc @ 5a9e7b

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