source: git/kernel/kutil.cc @ 356960

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