source: git/kernel/kutil.cc @ 3504d7

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