source: git/kernel/kutil.cc @ 75d084

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