source: git/kernel/kutil.cc @ d312f6

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