source: git/kernel/kutil.cc @ af378f7

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