source: git/kernel/kutil.cc @ 5865957

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