source: git/kernel/kutil.cc @ bad294

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