source: git/kernel/kutil.cc @ e259fe

spielwiese
Last change on this file since e259fe was e259fe, checked in by Hans Schönemann <hannes@…>, 16 years ago
*hannes: initL git-svn-id: file:///usr/local/Singular/svn/trunk@11053 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 182.8 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kutil.cc,v 1.108 2008-09-16 12:33:18 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              if(TEST_OPT_DEBUG)
1983              {
1984                 Print("chain-crit-part: S[%d]=",j); 
1985                 p_wrp(strat->S[j],currRing);
1986                 Print(" divide B[%d].lcm=",i);
1987                 p_wrp(strat->B[i].lcm,currRing);
1988                 PrintLn();
1989              }
1990              deleteInL(strat->B,&strat->Bl,i,strat);
1991              strat->c3++;
1992            }
1993          }
1994        }
1995      }
1996    }
1997    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
1998    strat->pairtest=NULL;
1999  }
2000  if (strat->Gebauer || strat->fromT)
2001  {
2002    if (strat->sugarCrit)
2003    {
2004    /*
2005    *suppose L[j] == (s,r) and p/lcm(s,r)
2006    *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
2007    *and in case the sugar is o.k. then L[j] can be canceled
2008    */
2009      for (j=strat->Ll; j>=0; j--)
2010      {
2011        if (sugarDivisibleBy(ecart,strat->L[j].ecart)
2012        && ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
2013        && pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2014        {
2015          if (strat->L[j].p == strat->tail)
2016          {
2017              if(TEST_OPT_DEBUG)
2018              {
2019                 PrintS("chain-crit-part: pCompareChainPart p="); 
2020                 p_wrp(p,currRing);
2021                 Print(" delete L[%d]",j);
2022                 p_wrp(strat->L[j].lcm,currRing);
2023                 PrintLn();
2024              }
2025              deleteInL(strat->L,&strat->Ll,j,strat);
2026              strat->c3++;
2027          }
2028        }
2029      }
2030      /*
2031      *this is GEBAUER-MOELLER:
2032      *in B all elements with the same lcm except the "best"
2033      *(i.e. the last one in B with this property) will be canceled
2034      */
2035      j = strat->Bl;
2036      loop /*cannot be changed into a for !!! */
2037      {
2038        if (j <= 0) break;
2039        i = j-1;
2040        loop
2041        {
2042          if (i <  0) break;
2043          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
2044          {
2045            strat->c3++;
2046            if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
2047            {
2048              if(TEST_OPT_DEBUG)
2049              {
2050                 Print("chain-crit-part: sugar B[%d].lcm=",j); 
2051                 p_wrp(strat->B[j].lcm,currRing);
2052                 Print(" delete B[%d]",i);
2053                 p_wrp(strat->B[i].lcm,currRing);
2054                 PrintLn();
2055              }
2056              deleteInL(strat->B,&strat->Bl,i,strat);
2057              j--;
2058            }
2059            else
2060            {
2061              if(TEST_OPT_DEBUG)
2062              {
2063                 Print("chain-crit-part: sugar B[%d].lcm=",i); 
2064                 p_wrp(strat->B[i].lcm,currRing);
2065                 Print(" delete B[%d]",j);
2066                 p_wrp(strat->B[j].lcm,currRing);
2067                 PrintLn();
2068              }
2069              deleteInL(strat->B,&strat->Bl,j,strat);
2070              break;
2071            }
2072          }
2073          i--;
2074        }
2075        j--;
2076      }
2077    }
2078    else /*sugarCrit*/
2079    {
2080      /*
2081      *suppose L[j] == (s,r) and p/lcm(s,r)
2082      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
2083      *and in case the sugar is o.k. then L[j] can be canceled
2084      */
2085      for (j=strat->Ll; j>=0; j--)
2086      {
2087        if (pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2088        {
2089          if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
2090          {
2091              if(TEST_OPT_DEBUG)
2092              {
2093                 PrintS("chain-crit-part: sugar:pCompareChainPart p="); 
2094                 p_wrp(p,currRing);
2095                 Print(" delete L[%d]",j);
2096                 p_wrp(strat->L[j].lcm,currRing);
2097                 PrintLn();
2098              }
2099            deleteInL(strat->L,&strat->Ll,j,strat);
2100            strat->c3++;
2101          }
2102        }
2103      }
2104      /*
2105      *this is GEBAUER-MOELLER:
2106      *in B all elements with the same lcm except the "best"
2107      *(i.e. the last one in B with this property) will be canceled
2108      */
2109      j = strat->Bl;
2110      loop   /*cannot be changed into a for !!! */
2111      {
2112        if (j <= 0) break;
2113        for(i=j-1; i>=0; i--)
2114        {
2115          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
2116          {
2117              if(TEST_OPT_DEBUG)
2118              {
2119                 Print("chain-crit-part: equal lcm B[%d].lcm=",j); 
2120                 p_wrp(strat->B[j].lcm,currRing);
2121                 Print(" delete B[%d]\n",i);
2122              }
2123            strat->c3++;
2124            deleteInL(strat->B,&strat->Bl,i,strat);
2125            j--;
2126          }
2127        }
2128        j--;
2129      }
2130    }
2131    /*
2132    *the elements of B enter L/their order with respect to B is kept
2133    *j = posInL(L,j,B[i]) would permutate the order
2134    *if once B is ordered different from L
2135    *then one should use j = posInL(L,Ll,B[i])
2136    */
2137    j = strat->Ll+1;
2138    for (i=strat->Bl; i>=0; i--)
2139    {
2140      j = strat->posInL(strat->L,j-1,&(strat->B[i]),strat);
2141      enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
2142    }
2143    strat->Bl = -1;
2144  }
2145  else
2146  {
2147    for (j=strat->Ll; j>=0; j--)
2148    {
2149      if (pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2150      {
2151        if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
2152        {
2153              if(TEST_OPT_DEBUG)
2154              {
2155                 PrintS("chain-crit-part: pCompareChainPart p="); 
2156                 p_wrp(p,currRing);
2157                 Print(" delete L[%d]",j);
2158                 p_wrp(strat->L[j].lcm,currRing);
2159                 PrintLn();
2160              }
2161          deleteInL(strat->L,&strat->Ll,j,strat);
2162          strat->c3++;
2163        }
2164      }
2165    }
2166    /*
2167    *this is our MODIFICATION of GEBAUER-MOELLER:
2168    *First the elements of B enter L,
2169    *then we fix a lcm and the "best" element in L
2170    *(i.e the last in L with this lcm and of type (s,p))
2171    *and cancel all the other elements of type (r,p) with this lcm
2172    *except the case the element (s,r) has also the same lcm
2173    *and is on the worst position with respect to (s,p) and (r,p)
2174    */
2175    /*
2176    *B enters to L/their order with respect to B is permutated for elements
2177    *B[i].p with the same leading term
2178    */
2179    j = strat->Ll;
2180    for (i=strat->Bl; i>=0; i--)
2181    {
2182      j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
2183      enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
2184    }
2185    strat->Bl = -1;
2186    j = strat->Ll;
2187    loop  /*cannot be changed into a for !!! */
2188    {
2189      if (j <= 0)
2190      {
2191        /*now L[0] cannot be canceled any more and the tail can be removed*/
2192        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2193        break;
2194      }
2195      if (strat->L[j].p2 == p)
2196      {
2197        i = j-1;
2198        loop
2199        {
2200          if (i < 0)  break;
2201          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2202          {
2203            /*L[i] could be canceled but we search for a better one to cancel*/
2204            strat->c3++;
2205            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2206            && (pNext(strat->L[l].p) == strat->tail)
2207            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2208            && _p_LmDivisibleByPart(p,currRing,
2209                           strat->L[l].lcm,currRing,
2210                           currRing->real_var_start, currRing->real_var_end))
2211
2212            {
2213              /*
2214              *"NOT equal(...)" because in case of "equal" the element L[l]
2215              *is "older" and has to be from theoretical point of view behind
2216              *L[i], but we do not want to reorder L
2217              */
2218              strat->L[i].p2 = strat->tail;
2219              /*
2220              *L[l] will be canceled, we cannot cancel L[i] later on,
2221              *so we mark it with "tail"
2222              */
2223              if(TEST_OPT_DEBUG)
2224              {
2225                 PrintS("chain-crit-part: divisible_by p="); 
2226                 p_wrp(p,currRing);
2227                 Print(" delete L[%d]",l);
2228                 p_wrp(strat->L[l].lcm,currRing);
2229                 PrintLn();
2230              }
2231              deleteInL(strat->L,&strat->Ll,l,strat);
2232              i--;
2233            }
2234            else
2235            {
2236              if(TEST_OPT_DEBUG)
2237              {
2238                 PrintS("chain-crit-part: divisible_by(2) p="); 
2239                 p_wrp(p,currRing);
2240                 Print(" delete L[%d]",i);
2241                 p_wrp(strat->L[i].lcm,currRing);
2242                 PrintLn();
2243              }
2244              deleteInL(strat->L,&strat->Ll,i,strat);
2245            }
2246            j--;
2247          }
2248          i--;
2249        }
2250      }
2251      else if (strat->L[j].p2 == strat->tail)
2252      {
2253        /*now L[j] cannot be canceled any more and the tail can be removed*/
2254        strat->L[j].p2 = p;
2255      }
2256      j--;
2257    }
2258  }
2259}
2260
2261/*2
2262*(s[0],h),...,(s[k],h) will be put to the pairset L
2263*/
2264void initenterpairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2265{
2266
2267  if ((strat->syzComp==0)
2268  || (pGetComp(h)<=strat->syzComp))
2269  {
2270    int j;
2271    BOOLEAN new_pair=FALSE;
2272
2273    if (pGetComp(h)==0)
2274    {
2275      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
2276      if ((isFromQ)&&(strat->fromQ!=NULL))
2277      {
2278        for (j=0; j<=k; j++)
2279        {
2280          if (!strat->fromQ[j])
2281          {
2282            new_pair=TRUE;
2283            enterOnePair(j,h,ecart,isFromQ,strat, atR);
2284          //Print("j:%d, Ll:%d\n",j,strat->Ll);
2285          }
2286        }
2287      }
2288      else
2289      {
2290        new_pair=TRUE;
2291        for (j=0; j<=k; j++)
2292        {
2293          enterOnePair(j,h,ecart,isFromQ,strat, atR);
2294          //Print("j:%d, Ll:%d\n",j,strat->Ll);
2295        }
2296      }
2297    }
2298    else
2299    {
2300      for (j=0; j<=k; j++)
2301      {
2302        if ((pGetComp(h)==pGetComp(strat->S[j]))
2303        || (pGetComp(strat->S[j])==0))
2304        {
2305          new_pair=TRUE;
2306          enterOnePair(j,h,ecart,isFromQ,strat, atR);
2307        //Print("j:%d, Ll:%d\n",j,strat->Ll);
2308        }
2309      }
2310    }
2311
2312    if (new_pair) 
2313    {
2314#ifdef HAVE_PLURAL
2315      if (currRing->real_var_start>0)
2316        chainCritPart(h,ecart,strat);
2317      else
2318#endif
2319      chainCrit(h,ecart,strat);
2320    }
2321  }
2322}
2323
2324#ifdef HAVE_RINGS
2325/*2
2326*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
2327*using the chain-criterion in B and L and enters B to L
2328*/
2329void chainCritRing (poly p,int ecart,kStrategy strat)
2330{
2331  int i,j,l;
2332  /*
2333  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
2334  *In this case all elements in B such
2335  *that their lcm is divisible by the leading term of S[i] can be canceled
2336  */
2337  if (strat->pairtest!=NULL)
2338  {
2339    {
2340      /*- i.e. there is an i with pairtest[i]==TRUE -*/
2341      for (j=0; j<=strat->sl; j++)
2342      {
2343        if (strat->pairtest[j])
2344        {
2345          for (i=strat->Bl; i>=0; i--)
2346          {
2347            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
2348            {
2349#ifdef KDEBUG
2350              if (TEST_OPT_DEBUG)
2351              {
2352                PrintS("--- chain criterion func chainCritRing type 1\n");
2353                PrintS("strat->S[j]:");
2354                wrp(strat->S[j]);
2355                PrintS("  strat->B[i].lcm:");
2356                wrp(strat->B[i].lcm);
2357                PrintLn();
2358              }
2359#endif
2360              deleteInL(strat->B,&strat->Bl,i,strat);
2361              strat->c3++;
2362            }
2363          }
2364        }
2365      }
2366    }
2367    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
2368    strat->pairtest=NULL;
2369  }
2370  assume(!(strat->Gebauer || strat->fromT));
2371  for (j=strat->Ll; j>=0; j--)
2372  {
2373    if (strat->L[j].lcm != NULL && nDivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(p)))
2374    {
2375      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
2376      {
2377        if ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
2378        {
2379          deleteInL(strat->L,&strat->Ll,j,strat);
2380          strat->c3++;
2381#ifdef KDEBUG
2382              if (TEST_OPT_DEBUG)
2383              {
2384                PrintS("--- chain criterion func chainCritRing type 2\n");
2385                PrintS("strat->L[j].p:");
2386                wrp(strat->L[j].p);
2387                PrintS("  p:");
2388                wrp(p);
2389                PrintLn();
2390              }
2391#endif
2392        }
2393      }
2394    }
2395  }
2396  /*
2397  *this is our MODIFICATION of GEBAUER-MOELLER:
2398  *First the elements of B enter L,
2399  *then we fix a lcm and the "best" element in L
2400  *(i.e the last in L with this lcm and of type (s,p))
2401  *and cancel all the other elements of type (r,p) with this lcm
2402  *except the case the element (s,r) has also the same lcm
2403  *and is on the worst position with respect to (s,p) and (r,p)
2404  */
2405  /*
2406  *B enters to L/their order with respect to B is permutated for elements
2407  *B[i].p with the same leading term
2408  */
2409  j = strat->Ll;
2410  for (i=strat->Bl; i>=0; i--)
2411  {
2412    j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
2413    enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
2414  }
2415  strat->Bl = -1;
2416  j = strat->Ll;
2417  loop  /*cannot be changed into a for !!! */
2418  {
2419    if (j <= 0)
2420    {
2421      /*now L[0] cannot be canceled any more and the tail can be removed*/
2422      if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
2423      break;
2424    }
2425    if (strat->L[j].p2 == p) // Was the element added from B?
2426    {
2427      i = j-1;
2428      loop
2429      {
2430        if (i < 0)  break;
2431        // Element is from B and has the same lcm as L[j]
2432        if ((strat->L[i].p2 == p) && nDivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(strat->L[i].lcm))
2433             && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
2434        {
2435          /*L[i] could be canceled but we search for a better one to cancel*/
2436          strat->c3++;
2437#ifdef KDEBUG
2438          if (TEST_OPT_DEBUG)
2439          {
2440            PrintS("--- chain criterion func chainCritRing type 3\n");
2441            PrintS("strat->L[j].lcm:");
2442            wrp(strat->L[j].lcm);
2443            PrintS("  strat->L[i].lcm:");
2444            wrp(strat->L[i].lcm);
2445            PrintLn();
2446          }
2447#endif
2448          if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
2449          && (pNext(strat->L[l].p) == strat->tail)
2450          && (!pLmEqual(strat->L[i].p,strat->L[l].p))
2451          && pDivisibleBy(p,strat->L[l].lcm))
2452          {
2453            /*
2454            *"NOT equal(...)" because in case of "equal" the element L[l]
2455            *is "older" and has to be from theoretical point of view behind
2456            *L[i], but we do not want to reorder L
2457            */
2458            strat->L[i].p2 = strat->tail;
2459            /*
2460            *L[l] will be canceled, we cannot cancel L[i] later on,
2461            *so we mark it with "tail"
2462            */
2463            deleteInL(strat->L,&strat->Ll,l,strat);
2464            i--;
2465          }
2466          else
2467          {
2468            deleteInL(strat->L,&strat->Ll,i,strat);
2469          }
2470          j--;
2471        }
2472        i--;
2473      }
2474    }
2475    else if (strat->L[j].p2 == strat->tail)
2476    {
2477      /*now L[j] cannot be canceled any more and the tail can be removed*/
2478      strat->L[j].p2 = p;
2479    }
2480    j--;
2481  }
2482}
2483#endif
2484
2485#ifdef HAVE_RING2TOM
2486long ind2(long arg)
2487{
2488  long ind = 0;
2489  if (arg <= 0) return 0;
2490  while (arg%2 == 0)
2491  {
2492    arg = arg / 2;
2493    ind++;
2494  }
2495  return ind;
2496}
2497
2498long ind_fact_2(long arg)
2499{
2500  long ind = 0;
2501  if (arg <= 0) return 0;
2502  if (arg%2 == 1) { arg--; }
2503  while (arg > 0)
2504  {
2505    ind += ind2(arg);
2506    arg = arg - 2;
2507  }
2508  return ind;
2509}
2510#endif
2511
2512#ifdef HAVE_VANIDEAL
2513long twoPow(long arg)
2514{
2515  return 1L << arg;
2516}
2517
2518/*2
2519* put the pair (p, f) in B and f in T
2520*/
2521void enterOneZeroPairRing (poly f, poly t_p, poly p, int ecart, kStrategy strat, int atR = -1)
2522{
2523  int      l,j,compare,compareCoeff;
2524  LObject  Lp;
2525
2526  if (strat->interred_flag) return;
2527#ifdef KDEBUG
2528  Lp.ecart=0; Lp.length=0;
2529#endif
2530  /*- computes the lcm(s[i],p) -*/
2531  Lp.lcm = pInit();
2532
2533  pLcm(p,f,Lp.lcm);
2534  pSetm(Lp.lcm);
2535  pSetCoeff(Lp.lcm, nLcm(pGetCoeff(p), pGetCoeff(f), currRing));
2536  assume(!strat->sugarCrit);
2537  assume(!strat->fromT);
2538  /*
2539  *the set B collects the pairs of type (S[j],p)
2540  *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
2541  *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
2542  *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
2543  */
2544  for(j = strat->Bl;j>=0;j--)
2545  {
2546    compare=pDivCompRing(strat->B[j].lcm,Lp.lcm);
2547    compareCoeff = nDivComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(Lp.lcm));
2548    if (compareCoeff == 0 || compare == compareCoeff)
2549    {
2550      if (compare == 1)
2551      {
2552        strat->c3++;
2553        pLmDelete(Lp.lcm);
2554        return;
2555      }
2556      else
2557      if (compare == -1)
2558      {
2559        deleteInL(strat->B,&strat->Bl,j,strat);
2560        strat->c3++;
2561      }
2562    }
2563    if (compare == pDivComp_EQUAL)
2564    {
2565      // Add hint for same LM and direction of LC (later) (TODO Oliver)
2566      if (compareCoeff == 1)
2567      {
2568        strat->c3++;
2569        pLmDelete(Lp.lcm);
2570        return;
2571      }
2572      else
2573      if (compareCoeff == -1)
2574      {
2575        deleteInL(strat->B,&strat->Bl,j,strat);
2576        strat->c3++;
2577      }
2578    }
2579  }
2580  /*
2581  *the pair (S[i],p) enters B if the spoly != 0
2582  */
2583  /*-  compute the short s-polynomial -*/
2584  if ((f==NULL) || (p==NULL)) return;
2585  pNorm(p);
2586  {
2587    Lp.p = ksCreateShortSpoly(f, p, strat->tailRing);
2588  }
2589  if (Lp.p == NULL) //deactivated, as we are adding pairs with zeropoly and not from S
2590  {
2591    /*- the case that the s-poly is 0 -*/
2592//    if (strat->pairtest==NULL) initPairtest(strat);
2593//    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
2594//    strat->pairtest[strat->sl+1] = TRUE;
2595    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
2596    /*
2597    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
2598    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
2599    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
2600    *term of p devides the lcm(s,r)
2601    *(this canceling should be done here because
2602    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
2603    *the first case is handeled in chainCrit
2604    */
2605    if (Lp.lcm!=NULL) pLmDelete(Lp.lcm);
2606  }
2607  else
2608  {
2609    /*- the pair (S[i],p) enters B -*/
2610    Lp.p1 = f;
2611    Lp.p2 = p;
2612
2613    pNext(Lp.p) = strat->tail;
2614
2615    LObject tmp_h(f, currRing, strat->tailRing);
2616    tmp_h.SetShortExpVector();
2617    strat->initEcart(&tmp_h);
2618    tmp_h.sev = pGetShortExpVector(tmp_h.p);
2619    tmp_h.t_p = t_p;
2620
2621    enterT(tmp_h, strat, strat->tl + 1);
2622
2623    if (atR >= 0)
2624    {
2625      Lp.i_r2 = atR;
2626      Lp.i_r1 = strat->tl;
2627    }
2628
2629    strat->initEcartPair(&Lp,f,p,0/*strat->ecartS[i]*/,ecart);     // Attention: TODO: break ecart
2630    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
2631    enterL(&strat->B, &strat->Bl, &strat->Bmax, Lp, l);
2632  }
2633}
2634
2635/* Helper for kCreateZeroPoly
2636 * enumerating the exponents
2637ring r = 2^2, (a, b, c), lp; ideal G0 = system("createG0"); ideal G = interred(G0); ncols(G0); ncols(G);
2638 */
2639
2640int nextZeroSimplexExponent (long exp[], long ind[], long cexp[], long cind[], long* cabsind, long step[], long bound, long N)
2641/* gives the next exponent from the set H_1 */
2642{
2643  long add = ind2(cexp[1] + 2);
2644  if ((*cabsind < bound) && (*cabsind - step[1] + add < bound))
2645  {
2646    cexp[1] += 2;
2647    cind[1] += add;
2648    *cabsind += add;
2649  }
2650  else
2651  {
2652    // cabsind >= habsind
2653    if (N == 1) return 0;
2654    int i = 1;
2655    while (exp[i] == cexp[i] && i <= N) i++;
2656    cexp[i] = exp[i];
2657    *cabsind -= cind[i];
2658    cind[i] = ind[i];
2659    step[i] = 500000;
2660    *cabsind += cind[i];
2661    // Print("in: %d\n", *cabsind);
2662    i += 1;
2663    if (i > N) return 0;
2664    do
2665    {
2666      step[1] = 500000;
2667      for (int j = i + 1; j <= N; j++)
2668      {
2669        if (step[1] > step[j]) step[1] = step[j];
2670      }
2671      add = ind2(cexp[i] + 2);
2672      if (*cabsind - step[1] + add >= bound)
2673      {
2674        cexp[i] = exp[i];
2675        *cabsind -= cind[i];
2676        cind[i] = ind[i];
2677        *cabsind += cind[i];
2678        step[i] = 500000;
2679        i += 1;
2680        if (i > N) return 0;
2681      }
2682      else step[1] = -1;
2683    } while (step[1] != -1);
2684    step[1] = 500000;
2685    cexp[i] += 2;
2686    cind[i] += add;
2687    *cabsind += add;
2688    if (add < step[i]) step[i] = add;
2689    for (i = 2; i <= N; i++)
2690    {
2691      if (step[1] > step[i]) step[1] = step[i];
2692    }
2693  }
2694  return 1;
2695}
2696
2697/*
2698 * Creates the zero Polynomial on position exp
2699 * long exp[] : exponent of leading term
2700 * cabsind    : total 2-ind of exp (if -1 will be computed)
2701 * poly* t_p  : will hold the LT in tailRing
2702 * leadRing   : ring for the LT
2703 * tailRing   : ring for the tail
2704 */
2705
2706poly kCreateZeroPoly(long exp[], long cabsind, poly* t_p, ring leadRing, ring tailRing)
2707{
2708
2709  poly zeroPoly = NULL;
2710
2711  number tmp1;
2712  poly tmp2, tmp3;
2713
2714  if (cabsind == -1)
2715  {
2716    cabsind = 0;
2717    for (int i = 1; i <= leadRing->N; i++)
2718    {
2719      cabsind += ind_fact_2(exp[i]);
2720    }
2721//    Print("cabsind: %d\n", cabsind);
2722  }
2723  if (cabsind < leadRing->ch)
2724  {
2725    zeroPoly = p_ISet(twoPow(leadRing->ch - cabsind), tailRing);
2726  }
2727  else
2728  {
2729    zeroPoly = p_ISet(1, tailRing);
2730  }
2731  for (int i = 1; i <= leadRing->N; i++)
2732  {
2733    for (long j = 1; j <= exp[i]; j++)
2734    {
2735      tmp1 = nInit(j);
2736      tmp2 = p_ISet(1, tailRing);
2737      p_SetExp(tmp2, i, 1, tailRing);
2738      p_Setm(tmp2, tailRing);
2739      if (nIsZero(tmp1))
2740      { // should nowbe obsolet, test ! TODO OLIVER
2741        zeroPoly = p_Mult_q(zeroPoly, tmp2, tailRing);
2742      }
2743      else
2744      {
2745        tmp3 = p_NSet(nCopy(tmp1), tailRing);
2746        zeroPoly = p_Mult_q(zeroPoly, p_Add_q(tmp3, tmp2, tailRing), tailRing);
2747      }
2748    }
2749  }
2750  tmp2 = p_NSet(nCopy(pGetCoeff(zeroPoly)), leadRing);
2751  for (int i = 1; i <= leadRing->N; i++)
2752  {
2753    pSetExp(tmp2, i, p_GetExp(zeroPoly, i, tailRing));
2754  }
2755  p_Setm(tmp2, leadRing);
2756  *t_p = zeroPoly;
2757  zeroPoly = pNext(zeroPoly);
2758  pNext(*t_p) = NULL;
2759  pNext(tmp2) = zeroPoly;
2760  return tmp2;
2761}
2762
2763// #define OLI_DEBUG
2764
2765/*
2766 * Generate the s-polynomial for the virtual set of zero-polynomials
2767 */
2768
2769void initenterzeropairsRing (poly p, int ecart, kStrategy strat, int atR)
2770{
2771  // Initialize
2772  long exp[50];            // The exponent of \hat{X} (basepoint)
2773  long cexp[50];           // The current exponent for iterating over all
2774  long ind[50];            // The power of 2 in the i-th component of exp
2775  long cind[50];           // analog for cexp
2776  long mult[50];           // How to multiply the elements of G
2777  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
2778  long habsind = 0;        // The abs. index of the coefficient of h
2779  long step[50];           // The last increases
2780  for (int i = 1; i <= currRing->N; i++)
2781  {
2782    exp[i] = p_GetExp(p, i, currRing);
2783    if (exp[i] & 1 != 0)
2784    {
2785      exp[i] = exp[i] - 1;
2786      mult[i] = 1;
2787    }
2788    cexp[i] = exp[i];
2789    ind[i] = ind_fact_2(exp[i]);
2790    cabsind += ind[i];
2791    cind[i] = ind[i];
2792    step[i] = 500000;
2793  }
2794  step[1] = 500000;
2795  habsind = ind2((long) p_GetCoeff(p, currRing));
2796  long bound = currRing->ch - habsind;
2797#ifdef OLI_DEBUG
2798  PrintS("-------------\npoly  :");
2799  wrp(p);
2800  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
2801  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
2802  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
2803  Print("bound : %d\n", bound);
2804  Print("cind  : %d\n", cabsind);
2805#endif
2806  if (cabsind == 0)
2807  {
2808    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
2809    {
2810      return;
2811    }
2812  }
2813  // Now the whole simplex
2814  do
2815  {
2816    // Build s-polynomial
2817    // 2**ind-def * mult * g - exp-def * h
2818    poly t_p;
2819    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, strat->tailRing);
2820#ifdef OLI_DEBUG
2821    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
2822    Print("zPoly : ");
2823    wrp(zeroPoly);
2824    Print("\n");
2825#endif
2826    enterOneZeroPairRing(zeroPoly, t_p, p, ecart, strat, atR);
2827  }
2828  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
2829}
2830
2831/*
2832 * Create the Groebner basis of the vanishing polynomials.
2833 */
2834
2835ideal createG0()
2836{
2837  // Initialize
2838  long exp[50];            // The exponent of \hat{X} (basepoint)
2839  long cexp[50];           // The current exponent for iterating over all
2840  long ind[50];            // The power of 2 in the i-th component of exp
2841  long cind[50];           // analog for cexp
2842  long mult[50];           // How to multiply the elements of G
2843  long cabsind = 0;        // The abs. index of cexp, i.e. the sum of cind
2844  long habsind = 0;        // The abs. index of the coefficient of h
2845  long step[50];           // The last increases
2846  for (int i = 1; i <= currRing->N; i++)
2847  {
2848    exp[i] = 0;
2849    cexp[i] = exp[i];
2850    ind[i] = 0;
2851    step[i] = 500000;
2852    cind[i] = ind[i];
2853  }
2854  long bound = currRing->ch;
2855  step[1] = 500000;
2856#ifdef OLI_DEBUG
2857  PrintS("-------------\npoly  :");
2858//  wrp(p);
2859  Print("\nexp   : (%d, %d)\n", exp[1] + mult[1], exp[2] + mult[1]);
2860  Print("cexp  : (%d, %d)\n", cexp[1], cexp[2]);
2861  Print("cind  : (%d, %d)\n", cind[1], cind[2]);
2862  Print("bound : %d\n", bound);
2863  Print("cind  : %d\n", cabsind);
2864#endif
2865  if (cabsind == 0)
2866  {
2867    if (!(nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N)))
2868    {
2869      return idInit(1, 1);
2870    }
2871  }
2872  ideal G0 = idInit(1, 1);
2873  // Now the whole simplex
2874  do
2875  {
2876    // Build s-polynomial
2877    // 2**ind-def * mult * g - exp-def * h
2878    poly t_p;
2879    poly zeroPoly = kCreateZeroPoly(cexp, cabsind, &t_p, currRing, currRing);
2880#ifdef OLI_DEBUG
2881    Print("%d, (%d, %d), ind = (%d, %d)\n", cabsind, cexp[1], cexp[2], cind[1], cind[2]);
2882    Print("zPoly : ");
2883    wrp(zeroPoly);
2884    Print("\n");
2885#endif
2886    // Add to ideal
2887    pEnlargeSet(&(G0->m), IDELEMS(G0), 1);
2888    IDELEMS(G0) += 1;
2889    G0->m[IDELEMS(G0) - 1] = zeroPoly;
2890  }
2891  while ( nextZeroSimplexExponent(exp, ind, cexp, cind, &cabsind, step, bound, currRing->N) );
2892  idSkipZeroes(G0);
2893  return G0;
2894}
2895#endif
2896
2897#ifdef HAVE_RINGS
2898/*2
2899*(s[0],h),...,(s[k],h) will be put to the pairset L
2900*/
2901void initenterpairsRing (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2902{
2903
2904  if ((strat->syzComp==0) || (pGetComp(h)<=strat->syzComp))
2905  {
2906    int j;
2907    BOOLEAN new_pair=FALSE;
2908
2909    if (pGetComp(h)==0)
2910    {
2911      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
2912      if ((isFromQ)&&(strat->fromQ!=NULL))
2913      {
2914        for (j=0; j<=k; j++)
2915        {
2916          if (!strat->fromQ[j])
2917          {
2918            new_pair=TRUE;
2919            Print("TODO Oliver --- j:%d, Ll:%d\n",j,strat->Ll);
2920            enterOnePairRing(j,h,ecart,isFromQ,strat, atR);
2921          }
2922        }
2923      }
2924      else
2925      {
2926        new_pair=TRUE;
2927        for (j=0; j<=k; j++)
2928        {
2929          // Print("j:%d, Ll:%d\n",j,strat->Ll);
2930          enterOnePairRing(j,h,ecart,isFromQ,strat, atR);
2931        }
2932      }
2933    }
2934    else
2935    {
2936      for (j=0; j<=k; j++)
2937      {
2938        if ((pGetComp(h)==pGetComp(strat->S[j])) || (pGetComp(strat->S[j])==0))
2939        {
2940          new_pair=TRUE;
2941          Print("TODO Oliver --- j:%d, Ll:%d\n",j,strat->Ll);
2942          enterOnePairRing(j,h,ecart,isFromQ,strat, atR);
2943        }
2944      }
2945    }
2946
2947    if (new_pair) chainCritRing(h,ecart,strat);
2948
2949  }
2950/*
2951ring r=256,(x,y,z),dp;
2952ideal I=12xz-133y, 2xy-z;
2953*/
2954
2955}
2956
2957/*2
2958*(s[0],h),...,(s[k],h) will be put to the pairset L
2959*/
2960void initenterstrongPairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
2961{
2962
2963  if (!nIsOne(pGetCoeff(h)))
2964  {
2965    int j;
2966    BOOLEAN new_pair=FALSE;
2967
2968    for (j=0; j<=k; j++)
2969    {
2970      // Print("j:%d, Ll:%d\n",j,strat->Ll);
2971//      if (((unsigned long) pGetCoeff(h) % (unsigned long) pGetCoeff(strat->S[j]) != 0) &&
2972//         ((unsigned long) pGetCoeff(strat->S[j]) % (unsigned long) pGetCoeff(h) != 0))
2973      {
2974        if (enterOneStrongPoly(j,h,ecart,isFromQ,strat, atR))
2975          new_pair=TRUE;
2976      }
2977    }
2978  }
2979/*
2980ring r=256,(x,y,z),dp;
2981ideal I=12xz-133y, 2xy-z;
2982*/
2983
2984}
2985
2986/*2
2987* Generates spoly(0, h) if applicable. Assumes ring in Z/2^n.
2988*/
2989void enterExtendedSpoly(poly h,kStrategy strat)
2990{
2991  if (nIsOne(pGetCoeff(h))) return;
2992  number gcd;
2993  bool go = false;
2994  if (nDivBy((number) 0, pGetCoeff(h)))
2995  {
2996    gcd = nIntDiv((number) 0, pGetCoeff(h));
2997    go = true;
2998  }
2999  else
3000    gcd = nGcd((number) 0, pGetCoeff(h), strat->tailRing);
3001  if (go || !nIsOne(gcd))
3002  {
3003    poly p = h->next;
3004    if (!go)
3005    {
3006      number tmp = gcd;
3007      gcd = nIntDiv(0, gcd);
3008      nDelete(&tmp);
3009    }
3010    p = pp_Mult_nn(p, gcd, strat->tailRing);
3011    nDelete(&gcd);
3012
3013    if (p != NULL)
3014    {
3015      if (TEST_OPT_PROT)
3016      {
3017        PrintS("Z");
3018      }
3019#ifdef KDEBUG
3020      if (TEST_OPT_DEBUG)
3021      {
3022        PrintS("--- create zero spoly: ");
3023        wrp(h);
3024        PrintS(" ---> ");
3025      }
3026#endif
3027      poly tmp = pInit();
3028      pSetCoeff0(tmp, pGetCoeff(p));
3029      for (int i = 1; i <= currRing->N; i++)
3030      {
3031        pSetExp(tmp, i, p_GetExp(p, i, strat->tailRing));
3032      }
3033      p_Setm(tmp, currRing);
3034      p = p_LmFreeAndNext(p, strat->tailRing);
3035      pNext(tmp) = p;
3036      LObject h;
3037      h.p = tmp;
3038      h.tailRing = strat->tailRing;
3039      int posx;
3040      if (h.p!=NULL)
3041      {
3042        if (TEST_OPT_INTSTRATEGY)
3043        {
3044          //pContent(h.p);
3045          h.pCleardenom(); // also does a pContent
3046        }
3047        else
3048        {
3049          h.pNorm();
3050        }
3051        strat->initEcart(&h);
3052        if (strat->Ll==-1)
3053          posx =0;
3054        else
3055          posx = strat->posInL(strat->L,strat->Ll,&h,strat);
3056        h.sev = pGetShortExpVector(h.p);
3057        h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
3058        if (pNext(p) != NULL)
3059        {
3060          // What does this? (Oliver)
3061          // pShallowCopyDeleteProc p_shallow_copy_delete
3062          //      = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
3063          // pNext(p) = p_shallow_copy_delete(pNext(p),
3064          //              currRing, strat->tailRing, strat->tailRing->PolyBin);
3065        }
3066#ifdef KDEBUG
3067        if (TEST_OPT_DEBUG)
3068        {
3069          wrp(tmp);
3070          PrintLn();
3071        }
3072#endif
3073        enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
3074      }
3075    }
3076  }
3077  nDelete(&gcd);
3078}
3079
3080void clearSbatch (poly h,int k,int pos,kStrategy strat)
3081{
3082  int j = pos;
3083  if ( (!strat->fromT)
3084  && (1//(strat->syzComp==0)
3085    //||(pGetComp(h)<=strat->syzComp)))
3086  ))
3087  {
3088    // Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
3089    unsigned long h_sev = pGetShortExpVector(h);
3090    loop
3091    {
3092      if (j > k) break;
3093      clearS(h,h_sev, &j,&k,strat);
3094      j++;
3095    }
3096    // Print("end clearS sl=%d\n",strat->sl);
3097  }
3098}
3099
3100/*2
3101* Generates a sufficient set of spolys (maybe just a finite generating
3102* set of the syzygys)
3103*/
3104void superenterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
3105{
3106    assume (rField_is_Ring(currRing));
3107    // enter also zero divisor * poly, if this is non zero and of smaller degree
3108    if (!(rField_is_Domain(currRing))) enterExtendedSpoly(h, strat);
3109    initenterpairsRing(h, k, ecart, 0, strat, atR);
3110    initenterstrongPairs(h, k, ecart, 0, strat, atR);
3111    clearSbatch(h, k, pos, strat);
3112}
3113#endif
3114
3115/*2
3116*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
3117*superfluous elements in S will be deleted
3118*/
3119void enterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
3120{
3121  int j=pos;
3122
3123#ifdef HAVE_RINGS
3124  assume (!rField_is_Ring(currRing));
3125#endif
3126
3127  initenterpairs(h,k,ecart,0,strat, atR);
3128  if ( (!strat->fromT)
3129  && ((strat->syzComp==0)
3130    ||(pGetComp(h)<=strat->syzComp)))
3131  {
3132    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
3133    unsigned long h_sev = pGetShortExpVector(h);
3134    loop
3135    {
3136      if (j > k) break;
3137      clearS(h,h_sev, &j,&k,strat);
3138      j++;
3139    }
3140    //Print("end clearS sl=%d\n",strat->sl);
3141  }
3142 // PrintS("end enterpairs\n");
3143}
3144
3145/*2
3146*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
3147*superfluous elements in S will be deleted
3148*/
3149void enterpairsSpecial (poly h,int k,int ecart,int pos,kStrategy strat, int atR = -1)
3150{
3151  int j;
3152
3153  for (j=0; j<=k; j++)
3154  {
3155    if ((pGetComp(h)==pGetComp(strat->S[j]))
3156    || (0==pGetComp(strat->S[j])))
3157    {
3158      enterOnePairSpecial(j,h,ecart,strat, atR);
3159    }
3160  }
3161//   #ifdef HAVE_PLURAL
3162  if (!rIsPluralRing(currRing))
3163//   #endif
3164  {
3165    j=pos;
3166    loop
3167    {
3168      unsigned long h_sev = pGetShortExpVector(h);
3169      if (j > k) break;
3170      clearS(h,h_sev,&j,&k,strat);
3171      j++;
3172    }
3173  }
3174}
3175
3176/*2
3177*reorders  s with respect to posInS,
3178*suc is the first changed index or zero
3179*/
3180
3181void reorderS (int* suc,kStrategy strat)
3182{
3183  int i,j,at,ecart, s2r;
3184  int fq=0;
3185  unsigned long sev;
3186  poly  p;
3187  int new_suc=strat->sl+1;
3188  i= *suc;
3189  if (i<0) i=0;
3190
3191  for (; i<=strat->sl; i++)
3192  {
3193    at = posInS(strat,i-1,strat->S[i],strat->ecartS[i]);
3194    if (at != i)
3195    {
3196      if (new_suc > at) new_suc = at;
3197      p = strat->S[i];
3198      ecart = strat->ecartS[i];
3199      sev = strat->sevS[i];
3200      s2r = strat->S_2_R[i];
3201      if (strat->fromQ!=NULL) fq=strat->fromQ[i];
3202      for (j=i; j>=at+1; j--)
3203      {
3204        strat->S[j] = strat->S[j-1];
3205        strat->ecartS[j] = strat->ecartS[j-1];
3206        strat->sevS[j] = strat->sevS[j-1];
3207        strat->S_2_R[j] = strat->S_2_R[j-1];
3208      }
3209      strat->S[at] = p;
3210      strat->ecartS[at] = ecart;
3211      strat->sevS[at] = sev;
3212      strat->S_2_R[at] = s2r;
3213      if (strat->fromQ!=NULL)
3214      {
3215        for (j=i; j>=at+1; j--)
3216        {
3217          strat->fromQ[j] = strat->fromQ[j-1];
3218        }
3219        strat->fromQ[at]=fq;
3220      }
3221    }
3222  }
3223  if (new_suc <= strat->sl) *suc=new_suc;
3224  else                      *suc=-1;
3225}
3226
3227
3228/*2
3229*looks up the position of p in set
3230*set[0] is the smallest with respect to the ordering-procedure deg/pComp
3231* Assumption: posInS only depends on the leading term
3232*             otherwise, bba has to be changed
3233*/
3234int posInS (const kStrategy strat, const int length,const poly p,
3235            const int ecart_p)
3236{
3237  if(length==-1) return 0;
3238  polyset set=strat->S;
3239  int i;
3240  int an = 0;
3241  int en = length;
3242  int cmp_int = pOrdSgn;
3243  int pc=pGetComp(p);
3244  if ((currRing->MixedOrder)
3245  && (currRing->real_var_start==0)
3246#if 0
3247  || ((strat->ak>0) && ((currRing->order[0]==ringorder_c)||((currRing->order[0]==ringorder_C))))
3248#endif
3249  )
3250  {
3251    int o=pWTotaldegree(p);
3252    int oo=pWTotaldegree(set[length]);
3253
3254    if ((oo<o)
3255    || ((o==oo) && (pLmCmp(set[length],p)!= cmp_int)))
3256      return length+1;
3257
3258    loop
3259    {
3260      if (an >= en-1)
3261      {
3262        if ((pWTotaldegree(set[an])>=o) && (pLmCmp(set[an],p) == cmp_int))
3263        {
3264          return an;
3265        }
3266        return en;
3267      }
3268      i=(an+en) / 2;
3269      if ((pWTotaldegree(set[i])>=o) && (pLmCmp(set[i],p) == cmp_int)) en=i;
3270      else                              an=i;
3271    }
3272  }
3273  else
3274  {
3275#ifdef HAVE_RINGS
3276    if (rField_is_Ring(currRing))
3277    {
3278      if (pLmCmp(set[length],p)== -cmp_int)
3279        return length+1;
3280      int cmp;
3281      loop
3282      {
3283        if (an >= en-1)
3284        {
3285          cmp = pLmCmp(set[an],p);
3286          if (cmp == cmp_int)  return an;
3287          if (cmp == -cmp_int) return en;
3288          if (nDivBy(pGetCoeff(p), pGetCoeff(set[an]))) return en;
3289          return an;
3290        }
3291        i = (an+en) / 2;
3292        cmp = pLmCmp(set[i],p);
3293        if (cmp == cmp_int)         en = i;
3294        else if (cmp == -cmp_int)   an = i;
3295        else
3296        {
3297          if (nDivBy(pGetCoeff(p), pGetCoeff(set[i]))) an = i;
3298          else en = i;
3299        }
3300      }
3301    }
3302    else
3303#endif
3304    if (pLmCmp(set[length],p)== -cmp_int)
3305      return length+1;
3306
3307    loop
3308    {
3309      if (an >= en-1)
3310      {
3311        if (pLmCmp(set[an],p) == cmp_int) return an;
3312        if (pLmCmp(set[an],p) == -cmp_int) return en;
3313        if ((cmp_int!=1)
3314        && ((strat->ecartS[an])>ecart_p))
3315          return an;
3316        return en;
3317      }
3318      i=(an+en) / 2;
3319      if (pLmCmp(set[i],p) == cmp_int) en=i;
3320      else if (pLmCmp(set[i],p) == -cmp_int) an=i;
3321      else
3322      {
3323        if ((cmp_int!=1)
3324        &&((strat->ecartS[i])<ecart_p))
3325          en=i;
3326        else
3327          an=i;
3328      }
3329    }
3330  }
3331}
3332
3333
3334/*2
3335* looks up the position of p in set
3336* the position is the last one
3337*/
3338int posInT0 (const TSet set,const int length,LObject &p)
3339{
3340  return (length+1);
3341}
3342
3343
3344/*2
3345* looks up the position of p in T
3346* set[0] is the smallest with respect to the ordering-procedure
3347* pComp
3348*/
3349int posInT1 (const TSet set,const int length,LObject &p)
3350{
3351  if (length==-1) return 0;
3352
3353  if (pLmCmp(set[length].p,p.p)!= pOrdSgn) return length+1;
3354
3355  int i;
3356  int an = 0;
3357  int en= length;
3358
3359  loop
3360  {
3361    if (an >= en-1)
3362    {
3363      if (pLmCmp(set[an].p,p.p) == pOrdSgn) return an;
3364      return en;
3365    }
3366    i=(an+en) / 2;
3367    if (pLmCmp(set[i].p,p.p) == pOrdSgn) en=i;
3368    else                                 an=i;
3369  }
3370}
3371
3372/*2
3373* looks up the position of p in T
3374* set[0] is the smallest with respect to the ordering-procedure
3375* length
3376*/
3377int posInT2 (const TSet set,const int length,LObject &p)
3378{
3379  if (length==-1)
3380    return 0;
3381  if (set[length].length<p.length)
3382    return length+1;
3383
3384  int i;
3385  int an = 0;
3386  int en= length;
3387
3388  loop
3389  {
3390    if (an >= en-1)
3391    {
3392      if (set[an].length>p.length) return an;
3393      return en;
3394    }
3395    i=(an+en) / 2;
3396    if (set[i].length>p.length) en=i;
3397    else                        an=i;
3398  }
3399}
3400
3401/*2
3402* looks up the position of p in T
3403* set[0] is the smallest with respect to the ordering-procedure
3404* totaldegree,pComp
3405*/
3406int posInT11 (const TSet set,const int length,LObject &p)
3407/*{
3408 * int j=0;
3409 * int o;
3410 *
3411 * o = p.GetpFDeg();
3412 * loop
3413 * {
3414 *   if ((pFDeg(set[j].p) > o)
3415 *   || ((pFDeg(set[j].p) == o) && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
3416 *   {
3417 *     return j;
3418 *   }
3419 *   j++;
3420 *   if (j > length) return j;
3421 * }
3422 *}
3423 */
3424{
3425  if (length==-1) return 0;
3426
3427  int o = p.GetpFDeg();
3428  int op = set[length].GetpFDeg();
3429
3430  if ((op < o)
3431  || ((op == o) && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3432    return length+1;
3433
3434  int i;
3435  int an = 0;
3436  int en= length;
3437
3438  loop
3439  {
3440    if (an >= en-1)
3441    {
3442      op= set[an].GetpFDeg();
3443      if ((op > o)
3444      || (( op == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3445        return an;
3446      return en;
3447    }
3448    i=(an+en) / 2;
3449    op = set[i].GetpFDeg();
3450    if (( op > o)
3451    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3452      en=i;
3453    else
3454      an=i;
3455  }
3456}
3457
3458/*2 Pos for rings T: Here I am
3459* looks up the position of p in T
3460* set[0] is the smallest with respect to the ordering-procedure
3461* totaldegree,pComp
3462*/
3463int posInTrg0 (const TSet set,const int length,LObject &p)
3464{
3465  if (length==-1) return 0;
3466  int o = p.GetpFDeg();
3467  int op = set[length].GetpFDeg();
3468  int i;
3469  int an = 0;
3470  int en = length;
3471  int cmp_int = pOrdSgn;
3472  if ((op < o) || (pLmCmp(set[length].p,p.p)== -cmp_int))
3473    return length+1;
3474  int cmp;
3475  loop
3476  {
3477    if (an >= en-1)
3478    {
3479      op = set[an].GetpFDeg();
3480      if (op > o) return an;
3481      if (op < 0) return en;
3482      cmp = pLmCmp(set[an].p,p.p);
3483      if (cmp == cmp_int)  return an;
3484      if (cmp == -cmp_int) return en;
3485      if (nGreater(pGetCoeff(p.p), pGetCoeff(set[an].p))) return en;
3486      return an;
3487    }
3488    i = (an + en) / 2;
3489    op = set[i].GetpFDeg();
3490    if (op > o)       en = i;
3491    else if (op < o)  an = i;
3492    else
3493    {
3494      cmp = pLmCmp(set[i].p,p.p);
3495      if (cmp == cmp_int)                                     en = i;
3496      else if (cmp == -cmp_int)                               an = i;
3497      else if (nGreater(pGetCoeff(p.p), pGetCoeff(set[i].p))) an = i;
3498      else                                                    en = i;
3499    }
3500  }
3501}
3502/*
3503  int o = p.GetpFDeg();
3504  int op = set[length].GetpFDeg();
3505
3506  if ((op < o)
3507  || ((op == o) && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3508    return length+1;
3509
3510  int i;
3511  int an = 0;
3512  int en= length;
3513
3514  loop
3515  {
3516    if (an >= en-1)
3517    {
3518      op= set[an].GetpFDeg();
3519      if ((op > o)
3520      || (( op == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3521        return an;
3522      return en;
3523    }
3524    i=(an+en) / 2;
3525    op = set[i].GetpFDeg();
3526    if (( op > o)
3527    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3528      en=i;
3529    else
3530      an=i;
3531  }
3532}
3533  */
3534/*2
3535* looks up the position of p in T
3536* set[0] is the smallest with respect to the ordering-procedure
3537* totaldegree,pComp
3538*/
3539int posInT110 (const TSet set,const int length,LObject &p)
3540{
3541  if (length==-1) return 0;
3542
3543  int o = p.GetpFDeg();
3544  int op = set[length].GetpFDeg();
3545
3546  if (( op < o)
3547  || (( op == o) && (set[length].length<p.length))
3548  || (( op == o) && (set[length].length == p.length)
3549     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3550    return length+1;
3551
3552  int i;
3553  int an = 0;
3554  int en= length;
3555  loop
3556  {
3557    if (an >= en-1)
3558    {
3559      op = set[an].GetpFDeg();
3560      if (( op > o)
3561      || (( op == o) && (set[an].length > p.length))
3562      || (( op == o) && (set[an].length == p.length)
3563         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3564        return an;
3565      return en;
3566    }
3567    i=(an+en) / 2;
3568    op = set[i].GetpFDeg();
3569    if (( op > o)
3570    || (( op == o) && (set[i].length > p.length))
3571    || (( op == o) && (set[i].length == p.length)
3572       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3573      en=i;
3574    else
3575      an=i;
3576  }
3577}
3578
3579/*2
3580* looks up the position of p in set
3581* set[0] is the smallest with respect to the ordering-procedure
3582* pFDeg
3583*/
3584int posInT13 (const TSet set,const int length,LObject &p)
3585{
3586  if (length==-1) return 0;
3587
3588  int o = p.GetpFDeg();
3589
3590  if (set[length].GetpFDeg() <= o)
3591    return length+1;
3592
3593  int i;
3594  int an = 0;
3595  int en= length;
3596  loop
3597  {
3598    if (an >= en-1)
3599    {
3600      if (set[an].GetpFDeg() > o)
3601        return an;
3602      return en;
3603    }
3604    i=(an+en) / 2;
3605    if (set[i].GetpFDeg() > o)
3606      en=i;
3607    else
3608      an=i;
3609  }
3610}
3611
3612// determines the position based on: 1.) Ecart 2.) pLength
3613int posInT_EcartpLength(const TSet set,const int length,LObject &p)
3614{
3615  if (length==-1) return 0;
3616
3617  int op=p.ecart;
3618  int ol = p.GetpLength();
3619
3620  int oo=set[length].ecart;
3621  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
3622    return length+1;
3623
3624  int i;
3625  int an = 0;
3626  int en= length;
3627  loop
3628    {
3629      if (an >= en-1)
3630      {
3631        int oo=set[an].ecart;
3632        if((oo > op)
3633           || ((oo==op) && (set[an].pLength > ol)))
3634          return an;
3635        return en;
3636      }
3637      i=(an+en) / 2;
3638      int oo=set[i].ecart;
3639      if ((oo > op)
3640          || ((oo == op) && (set[i].pLength > ol)))
3641        en=i;
3642      else
3643        an=i;
3644    }
3645}
3646
3647/*2
3648* looks up the position of p in set
3649* set[0] is the smallest with respect to the ordering-procedure
3650* maximaldegree, pComp
3651*/
3652int posInT15 (const TSet set,const int length,LObject &p)
3653/*{
3654 *int j=0;
3655 * int o;
3656 *
3657 * o = p.GetpFDeg()+p.ecart;
3658 * loop
3659 * {
3660 *   if ((set[j].GetpFDeg()+set[j].ecart > o)
3661 *   || ((set[j].GetpFDeg()+set[j].ecart == o)
3662 *     && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
3663 *   {
3664 *     return j;
3665 *   }
3666 *   j++;
3667 *   if (j > length) return j;
3668 * }
3669 *}
3670 */
3671{
3672  if (length==-1) return 0;
3673
3674  int o = p.GetpFDeg() + p.ecart;
3675  int op = set[length].GetpFDeg()+set[length].ecart;
3676
3677  if ((op < o)
3678  || ((op == o)
3679     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3680    return length+1;
3681
3682  int i;
3683  int an = 0;
3684  int en= length;
3685  loop
3686  {
3687    if (an >= en-1)
3688    {
3689      op = set[an].GetpFDeg()+set[an].ecart;
3690      if (( op > o)
3691      || (( op  == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3692        return an;
3693      return en;
3694    }
3695    i=(an+en) / 2;
3696    op = set[i].GetpFDeg()+set[i].ecart;
3697    if (( op > o)
3698    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3699      en=i;
3700    else
3701      an=i;
3702  }
3703}
3704
3705/*2
3706* looks up the position of p in set
3707* set[0] is the smallest with respect to the ordering-procedure
3708* pFDeg+ecart, ecart, pComp
3709*/
3710int posInT17 (const TSet set,const int length,LObject &p)
3711/*
3712*{
3713* int j=0;
3714* int  o;
3715*
3716*  o = p.GetpFDeg()+p.ecart;
3717*  loop
3718*  {
3719*    if ((pFDeg(set[j].p)+set[j].ecart > o)
3720*    || (((pFDeg(set[j].p)+set[j].ecart == o)
3721*      && (set[j].ecart < p.ecart)))
3722*    || ((pFDeg(set[j].p)+set[j].ecart == o)
3723*      && (set[j].ecart==p.ecart)
3724*      && (pLmCmp(set[j].p,p.p)==pOrdSgn)))
3725*      return j;
3726*    j++;
3727*    if (j > length) return j;
3728*  }
3729* }
3730*/
3731{
3732  if (length==-1) return 0;
3733
3734  int o = p.GetpFDeg() + p.ecart;
3735  int op = set[length].GetpFDeg()+set[length].ecart;
3736
3737  if ((op < o)
3738  || (( op == o) && (set[length].ecart > p.ecart))
3739  || (( op == o) && (set[length].ecart==p.ecart)
3740     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3741    return length+1;
3742
3743  int i;
3744  int an = 0;
3745  int en= length;
3746  loop
3747  {
3748    if (an >= en-1)
3749    {
3750      op = set[an].GetpFDeg()+set[an].ecart;
3751      if (( op > o)
3752      || (( op == o) && (set[an].ecart < p.ecart))
3753      || (( op  == o) && (set[an].ecart==p.ecart)
3754         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3755        return an;
3756      return en;
3757    }
3758    i=(an+en) / 2;
3759    op = set[i].GetpFDeg()+set[i].ecart;
3760    if ((op > o)
3761    || (( op == o) && (set[i].ecart < p.ecart))
3762    || (( op == o) && (set[i].ecart == p.ecart)
3763       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3764      en=i;
3765    else
3766      an=i;
3767  }
3768}
3769/*2
3770* looks up the position of p in set
3771* set[0] is the smallest with respect to the ordering-procedure
3772* pGetComp, pFDeg+ecart, ecart, pComp
3773*/
3774int posInT17_c (const TSet set,const int length,LObject &p)
3775{
3776  if (length==-1) return 0;
3777
3778  int cc = (-1+2*currRing->order[0]==ringorder_c);
3779  /* cc==1 for (c,..), cc==-1 for (C,..) */
3780  int o = p.GetpFDeg() + p.ecart;
3781  int c = pGetComp(p.p)*cc;
3782
3783  if (pGetComp(set[length].p)*cc < c)
3784    return length+1;
3785  if (pGetComp(set[length].p)*cc == c)
3786  {
3787    int op = set[length].GetpFDeg()+set[length].ecart;
3788    if ((op < o)
3789    || ((op == o) && (set[length].ecart > p.ecart))
3790    || ((op == o) && (set[length].ecart==p.ecart)
3791       && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
3792      return length+1;
3793  }
3794
3795  int i;
3796  int an = 0;
3797  int en= length;
3798  loop
3799  {
3800    if (an >= en-1)
3801    {
3802      if (pGetComp(set[an].p)*cc < c)
3803        return en;
3804      if (pGetComp(set[an].p)*cc == c)
3805      {
3806        int op = set[an].GetpFDeg()+set[an].ecart;
3807        if ((op > o)
3808        || ((op == o) && (set[an].ecart < p.ecart))
3809        || ((op == o) && (set[an].ecart==p.ecart)
3810           && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
3811          return an;
3812      }
3813      return en;
3814    }
3815    i=(an+en) / 2;
3816    if (pGetComp(set[i].p)*cc > c)
3817      en=i;
3818    else if (pGetComp(set[i].p)*cc == c)
3819    {
3820      int op = set[i].GetpFDeg()+set[i].ecart;
3821      if ((op > o)
3822      || ((op == o) && (set[i].ecart < p.ecart))
3823      || ((op == o) && (set[i].ecart == p.ecart)
3824         && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
3825        en=i;
3826      else
3827        an=i;
3828    }
3829    else
3830      an=i;
3831  }
3832}
3833
3834/*2
3835* looks up the position of p in set
3836* set[0] is the smallest with respect to
3837* ecart, pFDeg, length
3838*/
3839int posInT19 (const TSet set,const int length,LObject &p)
3840{
3841  if (length==-1) return 0;
3842
3843  int o = p.ecart;
3844  int op=p.GetpFDeg();
3845
3846  if (set[length].ecart < o)
3847    return length+1;
3848  if (set[length].ecart == o)
3849  {
3850     int oo=set[length].GetpFDeg();
3851     if ((oo < op) || ((oo==op) && (set[length].length < p.length)))
3852       return length+1;
3853  }
3854
3855  int i;
3856  int an = 0;
3857  int en= length;
3858  loop
3859  {
3860    if (an >= en-1)
3861    {
3862      if (set[an].ecart > o)
3863        return an;
3864      if (set[an].ecart == o)
3865      {
3866         int oo=set[an].GetpFDeg();
3867         if((oo > op)
3868         || ((oo==op) && (set[an].length > p.length)))
3869           return an;
3870      }
3871      return en;
3872    }
3873    i=(an+en) / 2;
3874    if (set[i].ecart > o)
3875      en=i;
3876    else if (set[i].ecart == o)
3877    {
3878       int oo=set[i].GetpFDeg();
3879       if ((oo > op)
3880       || ((oo == op) && (set[i].length > p.length)))
3881         en=i;
3882       else
3883        an=i;
3884    }
3885    else
3886      an=i;
3887  }
3888}
3889
3890/*2
3891*looks up the position of polynomial p in set
3892*set[length] is the smallest element in set with respect
3893*to the ordering-procedure pComp
3894*/
3895int posInLSpecial (const LSet set, const int length,
3896                   LObject *p,const kStrategy strat)
3897{
3898  if (length<0) return 0;
3899
3900  int d=p->GetpFDeg();
3901  int op=set[length].GetpFDeg();
3902
3903  if ((op > d)
3904  || ((op == d) && (p->p1!=NULL)&&(set[length].p1==NULL))
3905  || (pLmCmp(set[length].p,p->p)== pOrdSgn))
3906     return length+1;
3907
3908  int i;
3909  int an = 0;
3910  int en= length;
3911  loop
3912  {
3913    if (an >= en-1)
3914    {
3915      op=set[an].GetpFDeg();
3916      if ((op > d)
3917      || ((op == d) && (p->p1!=NULL) && (set[an].p1==NULL))
3918      || (pLmCmp(set[an].p,p->p)== pOrdSgn))
3919         return en;
3920      return an;
3921    }
3922    i=(an+en) / 2;
3923    op=set[i].GetpFDeg();
3924    if ((op>d)
3925    || ((op==d) && (p->p1!=NULL) && (set[i].p1==NULL))
3926    || (pLmCmp(set[i].p,p->p) == pOrdSgn))
3927      an=i;
3928    else
3929      en=i;
3930  }
3931}
3932
3933/*2
3934*looks up the position of polynomial p in set
3935*set[length] is the smallest element in set with respect
3936*to the ordering-procedure pComp
3937*/
3938int posInL0 (const LSet set, const int length,
3939             LObject* p,const kStrategy strat)
3940{
3941  if (length<0) return 0;
3942
3943  if (pLmCmp(set[length].p,p->p)== pOrdSgn)
3944    return length+1;
3945
3946  int i;
3947  int an = 0;
3948  int en= length;
3949  loop
3950  {
3951    if (an >= en-1)
3952    {
3953      if (pLmCmp(set[an].p,p->p) == pOrdSgn) return en;
3954      return an;
3955    }
3956    i=(an+en) / 2;
3957    if (pLmCmp(set[i].p,p->p) == pOrdSgn) an=i;
3958    else                                 en=i;
3959    /*aend. fuer lazy == in !=- machen */
3960  }
3961}
3962
3963/*2
3964* looks up the position of polynomial p in set
3965* e is the ecart of p
3966* set[length] is the smallest element in set with respect
3967* to the ordering-procedure totaldegree,pComp
3968*/
3969int posInL11 (const LSet set, const int length,
3970              LObject* p,const kStrategy strat)
3971/*{
3972 * int j=0;
3973 * int o;
3974 *
3975 * o = p->GetpFDeg();
3976 * loop
3977 * {
3978 *   if (j > length)            return j;
3979 *   if ((set[j].GetpFDeg() < o)) return j;
3980 *   if ((set[j].GetpFDeg() == o) && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
3981 *   {
3982 *     return j;
3983 *   }
3984 *   j++;
3985 * }
3986 *}
3987 */
3988{
3989  if (length<0) return 0;
3990
3991  int o = p->GetpFDeg();
3992  int op = set[length].GetpFDeg();
3993
3994  if ((op > o)
3995  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
3996    return length+1;
3997  int i;
3998  int an = 0;
3999  int en= length;
4000  loop
4001  {
4002    if (an >= en-1)
4003    {
4004      op = set[an].GetpFDeg();
4005      if ((op > o)
4006      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4007        return en;
4008      return an;
4009    }
4010    i=(an+en) / 2;
4011    op = set[i].GetpFDeg();
4012    if ((op > o)
4013    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4014      an=i;
4015    else
4016      en=i;
4017  }
4018}
4019
4020/*2 Position for rings L: Here I am
4021* looks up the position of polynomial p in set
4022* e is the ecart of p
4023* set[length] is the smallest element in set with respect
4024* to the ordering-procedure totaldegree,pComp
4025*/
4026inline int getIndexRng(long coeff)
4027{
4028  if (coeff == 0) return -1;
4029  long tmp = coeff;
4030  int ind = 0;
4031  while (tmp % 2 == 0)
4032  {
4033    tmp = tmp / 2;
4034    ind++;
4035  }
4036  return ind;
4037}
4038
4039int posInLrg0 (const LSet set, const int length,
4040              LObject* p,const kStrategy strat)
4041/*          if (nGreater(pGetCoeff(p), pGetCoeff(set[an]))) return en;
4042        if (pLmCmp(set[i],p) == cmp_int)         en = i;
4043        else if (pLmCmp(set[i],p) == -cmp_int)   an = i;
4044        else
4045        {
4046          if (nGreater(pGetCoeff(p), pGetCoeff(set[i]))) an = i;
4047          else en = i;
4048        }*/
4049{
4050  if (length < 0) return 0;
4051
4052  int o = p->GetpFDeg();
4053  int op = set[length].GetpFDeg();
4054
4055  if ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4056    return length + 1;
4057  int i;
4058  int an = 0;
4059  int en = length;
4060  loop
4061  {
4062    if (an >= en - 1)
4063    {
4064      op = set[an].GetpFDeg();
4065      if ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4066        return en;
4067      return an;
4068    }
4069    i = (an+en) / 2;
4070    op = set[i].GetpFDeg();
4071    if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4072      an = i;
4073    else
4074      en = i;
4075  }
4076}
4077
4078/*{
4079  if (length < 0) return 0;
4080
4081  int o = p->GetpFDeg();
4082  int op = set[length].GetpFDeg();
4083
4084  int inde = getIndexRng((unsigned long) pGetCoeff(set[length].p));
4085  int indp = getIndexRng((unsigned long) pGetCoeff(p->p));
4086  int inda;
4087  int indi;
4088
4089  if ((inda > indp) || ((inda == inde) && ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))))
4090    return length + 1;
4091  int i;
4092  int an = 0;
4093  inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
4094  int en = length;
4095  loop
4096  {
4097    if (an >= en-1)
4098    {
4099      op = set[an].GetpFDeg();
4100      if ((indp > inda) || ((indp == inda) && ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))))
4101        return en;
4102      return an;
4103    }
4104    i = (an + en) / 2;
4105    indi = getIndexRng((unsigned long) pGetCoeff(set[i].p));
4106    op = set[i].GetpFDeg();
4107    if ((indi > indp) || ((indi == indp) && ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))))
4108    // if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4109    {
4110      an = i;
4111      inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
4112    }
4113    else
4114      en = i;
4115  }
4116} */
4117
4118/*2
4119* looks up the position of polynomial p in set
4120* set[length] is the smallest element in set with respect
4121* to the ordering-procedure totaldegree,pLength0
4122*/
4123int posInL110 (const LSet set, const int length,
4124               LObject* p,const kStrategy strat)
4125{
4126  if (length<0) return 0;
4127
4128  int o = p->GetpFDeg();
4129  int op = set[length].GetpFDeg();
4130
4131  if ((op > o)
4132  || ((op == o) && (set[length].length >p->length))
4133  || ((op == o) && (set[length].length <= p->length)
4134     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4135    return length+1;
4136  int i;
4137  int an = 0;
4138  int en= length;
4139  loop
4140  {
4141    if (an >= en-1)
4142    {
4143      op = set[an].GetpFDeg();
4144      if ((op > o)
4145      || ((op == o) && (set[an].length >p->length))
4146      || ((op == o) && (set[an].length <=p->length)
4147         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4148        return en;
4149      return an;
4150    }
4151    i=(an+en) / 2;
4152    op = set[i].GetpFDeg();
4153    if ((op > o)
4154    || ((op == o) && (set[i].length > p->length))
4155    || ((op == o) && (set[i].length <= p->length)
4156       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4157      an=i;
4158    else
4159      en=i;
4160  }
4161}
4162
4163/*2
4164* looks up the position of polynomial p in set
4165* e is the ecart of p
4166* set[length] is the smallest element in set with respect
4167* to the ordering-procedure totaldegree
4168*/
4169int posInL13 (const LSet set, const int length,
4170              LObject* p,const kStrategy strat)
4171{
4172  if (length<0) return 0;
4173
4174  int o = p->GetpFDeg();
4175
4176  if (set[length].GetpFDeg() > o)
4177    return length+1;
4178
4179  int i;
4180  int an = 0;
4181  int en= length;
4182  loop
4183  {
4184    if (an >= en-1)
4185    {
4186      if (set[an].GetpFDeg() >= o)
4187        return en;
4188      return an;
4189    }
4190    i=(an+en) / 2;
4191    if (set[i].GetpFDeg() >= o)
4192      an=i;
4193    else
4194      en=i;
4195  }
4196}
4197
4198/*2
4199* looks up the position of polynomial p in set
4200* e is the ecart of p
4201* set[length] is the smallest element in set with respect
4202* to the ordering-procedure maximaldegree,pComp
4203*/
4204int posInL15 (const LSet set, const int length,
4205              LObject* p,const kStrategy strat)
4206/*{
4207 * int j=0;
4208 * int o;
4209 *
4210 * o = p->ecart+p->GetpFDeg();
4211 * loop
4212 * {
4213 *   if (j > length)                       return j;
4214 *   if (set[j].GetpFDeg()+set[j].ecart < o) return j;
4215 *   if ((set[j].GetpFDeg()+set[j].ecart == o)
4216 *   && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
4217 *   {
4218 *     return j;
4219 *   }
4220 *   j++;
4221 * }
4222 *}
4223 */
4224{
4225  if (length<0) return 0;
4226
4227  int o = p->GetpFDeg() + p->ecart;
4228  int op = set[length].GetpFDeg() + set[length].ecart;
4229
4230  if ((op > o)
4231  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4232    return length+1;
4233  int i;
4234  int an = 0;
4235  int en= length;
4236  loop
4237  {
4238    if (an >= en-1)
4239    {
4240      op = set[an].GetpFDeg() + set[an].ecart;
4241      if ((op > o)
4242      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4243        return en;
4244      return an;
4245    }
4246    i=(an+en) / 2;
4247    op = set[i].GetpFDeg() + set[i].ecart;
4248    if ((op > o)
4249    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4250      an=i;
4251    else
4252      en=i;
4253  }
4254}
4255
4256/*2
4257* looks up the position of polynomial p in set
4258* e is the ecart of p
4259* set[length] is the smallest element in set with respect
4260* to the ordering-procedure totaldegree
4261*/
4262int posInL17 (const LSet set, const int length,
4263              LObject* p,const kStrategy strat)
4264{
4265  if (length<0) return 0;
4266
4267  int o = p->GetpFDeg() + p->ecart;
4268
4269  if ((set[length].GetpFDeg() + set[length].ecart > o)
4270  || ((set[length].GetpFDeg() + set[length].ecart == o)
4271     && (set[length].ecart > p->ecart))
4272  || ((set[length].GetpFDeg() + set[length].ecart == o)
4273     && (set[length].ecart == p->ecart)
4274     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4275    return length+1;
4276  int i;
4277  int an = 0;
4278  int en= length;
4279  loop
4280  {
4281    if (an >= en-1)
4282    {
4283      if ((set[an].GetpFDeg() + set[an].ecart > o)
4284      || ((set[an].GetpFDeg() + set[an].ecart == o)
4285         && (set[an].ecart > p->ecart))
4286      || ((set[an].GetpFDeg() + set[an].ecart == o)
4287         && (set[an].ecart == p->ecart)
4288         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4289        return en;
4290      return an;
4291    }
4292    i=(an+en) / 2;
4293    if ((set[i].GetpFDeg() + set[i].ecart > o)
4294    || ((set[i].GetpFDeg() + set[i].ecart == o)
4295       && (set[i].ecart > p->ecart))
4296    || ((set[i].GetpFDeg() +set[i].ecart == o)
4297       && (set[i].ecart == p->ecart)
4298       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4299      an=i;
4300    else
4301      en=i;
4302  }
4303}
4304/*2
4305* looks up the position of polynomial p in set
4306* e is the ecart of p
4307* set[length] is the smallest element in set with respect
4308* to the ordering-procedure pComp
4309*/
4310int posInL17_c (const LSet set, const int length,
4311                LObject* p,const kStrategy strat)
4312{
4313  if (length<0) return 0;
4314
4315  int cc = (-1+2*currRing->order[0]==ringorder_c);
4316  /* cc==1 for (c,..), cc==-1 for (C,..) */
4317  int c = pGetComp(p->p)*cc;
4318  int o = p->GetpFDeg() + p->ecart;
4319
4320  if (pGetComp(set[length].p)*cc > c)
4321    return length+1;
4322  if (pGetComp(set[length].p)*cc == c)
4323  {
4324    if ((set[length].GetpFDeg() + set[length].ecart > o)
4325    || ((set[length].GetpFDeg() + set[length].ecart == o)
4326       && (set[length].ecart > p->ecart))
4327    || ((set[length].GetpFDeg() + set[length].ecart == o)
4328       && (set[length].ecart == p->ecart)
4329       && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
4330      return length+1;
4331  }
4332  int i;
4333  int an = 0;
4334  int en= length;
4335  loop
4336  {
4337    if (an >= en-1)
4338    {
4339      if (pGetComp(set[an].p)*cc > c)
4340        return en;
4341      if (pGetComp(set[an].p)*cc == c)
4342      {
4343        if ((set[an].GetpFDeg() + set[an].ecart > o)
4344        || ((set[an].GetpFDeg() + set[an].ecart == o)
4345           && (set[an].ecart > p->ecart))
4346        || ((set[an].GetpFDeg() + set[an].ecart == o)
4347           && (set[an].ecart == p->ecart)
4348           && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
4349          return en;
4350      }
4351      return an;
4352    }
4353    i=(an+en) / 2;
4354    if (pGetComp(set[i].p)*cc > c)
4355      an=i;
4356    else if (pGetComp(set[i].p)*cc == c)
4357    {
4358      if ((set[i].GetpFDeg() + set[i].ecart > o)
4359      || ((set[i].GetpFDeg() + set[i].ecart == o)
4360         && (set[i].ecart > p->ecart))
4361      || ((set[i].GetpFDeg() +set[i].ecart == o)
4362         && (set[i].ecart == p->ecart)
4363         && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
4364        an=i;
4365      else
4366        en=i;
4367    }
4368    else
4369      en=i;
4370  }
4371}
4372
4373/***************************************************************
4374 *
4375 * Tail reductions
4376 *
4377 ***************************************************************/
4378TObject*
4379kFindDivisibleByInS(kStrategy strat, int pos, LObject* L, TObject *T,
4380                    long ecart)
4381{
4382  int j = 0;
4383  const unsigned long not_sev = ~L->sev;
4384  const unsigned long* sev = strat->sevS;
4385  poly p;
4386  ring r;
4387  L->GetLm(p, r);
4388
4389  assume(~not_sev == p_GetShortExpVector(p, r));
4390
4391  if (r == currRing)
4392  {
4393    loop
4394    {
4395      if (j > pos) return NULL;
4396#if defined(PDEBUG) || defined(PDIV_DEBUG)
4397      if (p_LmShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
4398          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4399        break;
4400#else
4401      if (!(sev[j] & not_sev) &&
4402          (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
4403          p_LmDivisibleBy(strat->S[j], p, r))
4404        break;
4405
4406#endif
4407      j++;
4408    }
4409    // if called from NF, T objects do not exist:
4410    if (strat->tl < 0 || strat->S_2_R[j] == -1)
4411    {
4412      T->Set(strat->S[j], r, strat->tailRing);
4413      return T;
4414    }
4415    else
4416    {
4417/////      assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL
4418/////      && strat->S_2_T(j)->p == strat->S[j]); // wrong?
4419//      assume (j >= 0 && j <= strat->sl && strat->S_2_T(j) != NULL && strat->S_2_T(j)->p == strat->S[j]);
4420      return strat->S_2_T(j);
4421    }
4422  }
4423  else
4424  {
4425    TObject* t;
4426    loop
4427    {
4428      if (j > pos) return NULL;
4429      assume(strat->S_2_R[j] != -1);
4430#if defined(PDEBUG) || defined(PDIV_DEBUG)
4431      t = strat->S_2_T(j);
4432      assume(t != NULL && t->t_p != NULL && t->tailRing == r);
4433      if (p_LmShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
4434          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4435        return t;
4436#else
4437      if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
4438      {
4439        t = strat->S_2_T(j);
4440        assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
4441        if (p_LmDivisibleBy(t->t_p, p, r)) return t;
4442      }
4443#endif
4444      j++;
4445    }
4446  }
4447}
4448
4449poly redtail (LObject* L, int pos, kStrategy strat)
4450{
4451  poly h, hn;
4452  int j;
4453  unsigned long not_sev;
4454  strat->redTailChange=FALSE;
4455
4456  poly p = L->p;
4457  if (strat->noTailReduction || pNext(p) == NULL)
4458    return p;
4459
4460  LObject Ln(strat->tailRing);
4461  TObject* With;
4462  // placeholder in case strat->tl < 0
4463  TObject  With_s(strat->tailRing);
4464  h = p;
4465  hn = pNext(h);
4466  long op = strat->tailRing->pFDeg(hn, strat->tailRing);
4467  long e;
4468  int l;
4469  BOOLEAN save_HE=strat->kHEdgeFound;
4470  strat->kHEdgeFound |=
4471    ((Kstd1_deg>0) && (op<=Kstd1_deg)) || TEST_OPT_INFREDTAIL;
4472
4473  while(hn != NULL)
4474  {
4475    op = strat->tailRing->pFDeg(hn, strat->tailRing);
4476    if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
4477    e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
4478    loop
4479    {
4480      Ln.Set(hn, strat->tailRing);
4481      Ln.sev = p_GetShortExpVector(hn, strat->tailRing);
4482      if (strat->kHEdgeFound)
4483        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
4484      else
4485        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s, e);
4486      if (With == NULL) break;
4487      With->length=0;
4488      With->pLength=0;
4489      strat->redTailChange=TRUE;
4490      if (ksReducePolyTail(L, With, h, strat->kNoetherTail()))
4491      {
4492        // reducing the tail would violate the exp bound
4493        if (kStratChangeTailRing(strat, L))
4494        {
4495          strat->kHEdgeFound = save_HE;
4496          return redtail(L, pos, strat);
4497        }
4498        else
4499          return NULL;
4500      }
4501      hn = pNext(h);
4502      if (hn == NULL) goto all_done;
4503      op = strat->tailRing->pFDeg(hn, strat->tailRing);
4504      if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
4505      e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
4506    }
4507    h = hn;
4508    hn = pNext(h);
4509  }
4510
4511  all_done:
4512  if (strat->redTailChange)
4513  {
4514    L->last = 0;
4515    L->pLength = 0;
4516  }
4517  strat->kHEdgeFound = save_HE;
4518  return p;
4519}
4520
4521poly redtail (poly p, int pos, kStrategy strat)
4522{
4523  LObject L(p, currRing);
4524  return redtail(&L, pos, strat);
4525}
4526
4527poly redtailBba (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
4528{
4529#define REDTAIL_CANONICALIZE 100
4530  strat->redTailChange=FALSE;
4531  if (strat->noTailReduction) return L->GetLmCurrRing();
4532  poly h, p;
4533  p = h = L->GetLmTailRing();
4534  if ((h==NULL) || (pNext(h)==NULL))
4535    return L->GetLmCurrRing();
4536
4537  TObject* With;
4538  // placeholder in case strat->tl < 0
4539  TObject  With_s(strat->tailRing);
4540
4541  LObject Ln(pNext(h), strat->tailRing);
4542  Ln.pLength = L->GetpLength() - 1;
4543
4544  pNext(h) = NULL;
4545  if (L->p != NULL) pNext(L->p) = NULL;
4546  L->pLength = 1;
4547
4548  Ln.PrepareRed(strat->use_buckets);
4549
4550  int cnt=REDTAIL_CANONICALIZE;
4551  while(!Ln.IsNull())
4552  {
4553    loop
4554    {
4555      Ln.SetShortExpVector();
4556      if (withT)
4557      {
4558        int j;
4559        j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
4560        if (j < 0) break;
4561        With = &(strat->T[j]);
4562      }
4563      else
4564      {
4565        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
4566        if (With == NULL) break;
4567      }
4568      cnt--;
4569      if (cnt==0)
4570      {
4571        cnt=REDTAIL_CANONICALIZE; 
4572        poly tmp=Ln.CanonicalizeP(); 
4573        if (normalize) 
4574        {
4575          Ln.Normalize();
4576          //pNormalize(tmp);
4577          //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
4578        }
4579      }
4580      if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
4581      {
4582        With->pNorm();
4583      }
4584      strat->redTailChange=TRUE;
4585      if (ksReducePolyTail(L, With, &Ln))
4586      {
4587        // reducing the tail would violate the exp bound
4588        //  set a flag and hope for a retry (in bba)
4589        strat->completeReduce_retry=TRUE;
4590        do
4591        {
4592          pNext(h) = Ln.LmExtractAndIter();
4593          pIter(h);
4594          L->pLength++;
4595        } while (!Ln.IsNull());
4596        goto all_done;
4597      }
4598      if (Ln.IsNull()) goto all_done;
4599      if (! withT) With_s.Init(currRing);
4600    }
4601    pNext(h) = Ln.LmExtractAndIter();
4602    pIter(h);
4603    pNormalize(h);
4604    L->pLength++;
4605  }
4606
4607  all_done:
4608  Ln.Delete();
4609  if (L->p != NULL) pNext(L->p) = pNext(p);
4610
4611  if (strat->redTailChange)
4612  {
4613    L->last = NULL;
4614    L->length = 0;
4615  }
4616
4617  //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
4618  //L->Normalize(); // HANNES: should have a test
4619  kTest_L(L);
4620  return L->GetLmCurrRing();
4621}
4622
4623/*2
4624*checks the change degree and write progress report
4625*/
4626void message (int i,int* reduc,int* olddeg,kStrategy strat, int red_result)
4627{
4628  if (i != *olddeg)
4629  {
4630    Print("%d",i);
4631    *olddeg = i;
4632  }
4633  if (K_TEST_OPT_OLDSTD)
4634  {
4635    if (strat->Ll != *reduc)
4636    {
4637      if (strat->Ll != *reduc-1)
4638        Print("(%d)",strat->Ll+1);
4639      else
4640        PrintS("-");
4641      *reduc = strat->Ll;
4642    }
4643    else
4644      PrintS(".");
4645    mflush();
4646  }
4647  else
4648  {
4649    if (red_result == 0)
4650      PrintS("-");
4651    else if (red_result < 0)
4652      PrintS(".");
4653    if ((red_result > 0) || ((strat->Ll % 100)==99))
4654    {
4655      if (strat->Ll != *reduc && strat->Ll > 0)
4656      {
4657        Print("(%d)",strat->Ll+1);
4658        *reduc = strat->Ll;
4659      }
4660    }
4661  }
4662}
4663
4664/*2
4665*statistics
4666*/
4667void messageStat (int srmax,int lrmax,int hilbcount,kStrategy strat)
4668{
4669  //PrintS("\nUsage/Allocation of temporary storage:\n");
4670  //Print("%d/%d polynomials in standard base\n",srmax,IDELEMS(Shdl));
4671  //Print("%d/%d polynomials in set L (for lazy alg.)",lrmax+1,strat->Lmax);
4672  Print("product criterion:%d chain criterion:%d\n",strat->cp,strat->c3);
4673  if (hilbcount!=0) Print("hilbert series criterion:%d\n",hilbcount);
4674  /* in usual case strat->cv is 0, it gets changed only in shift routines */
4675  if (strat->cv!=0) Print("shift V criterion:%d\n",strat->cv);
4676  /*mflush();*/
4677}
4678
4679#ifdef KDEBUG
4680/*2
4681*debugging output: all internal sets, if changed
4682*for testing purpuse only/has to be changed for later use
4683*/
4684void messageSets (kStrategy strat)
4685{
4686  int i;
4687  if (strat->news)
4688  {
4689    PrintS("set S");
4690    for (i=0; i<=strat->sl; i++)
4691    {
4692      Print("\n  %d:",i);
4693      p_wrp(strat->S[i], currRing, strat->tailRing);
4694    }
4695    strat->news = FALSE;
4696  }
4697  if (strat->newt)
4698  {
4699    PrintS("\nset T");
4700    for (i=0; i<=strat->tl; i++)
4701    {
4702      Print("\n  %d:",i);
4703      strat->T[i].wrp();
4704      Print(" o:%d e:%d l:%d",
4705        strat->T[i].pFDeg(),strat->T[i].ecart,strat->T[i].length);
4706    }
4707    strat->newt = FALSE;
4708  }
4709  PrintS("\nset L");
4710  for (i=strat->Ll; i>=0; i--)
4711  {
4712    Print("\n%d:",i);
4713    p_wrp(strat->L[i].p1, currRing, strat->tailRing);
4714    PrintS("  ");
4715    p_wrp(strat->L[i].p2, currRing, strat->tailRing);
4716    PrintS(" lcm: ");p_wrp(strat->L[i].lcm, currRing);
4717    PrintS("\n  p : ");
4718    strat->L[i].wrp();
4719    Print("  o:%d e:%d l:%d",
4720          strat->L[i].pFDeg(),strat->L[i].ecart,strat->L[i].length);
4721  }
4722  PrintLn();
4723}
4724
4725#endif
4726
4727
4728/*2
4729*construct the set s from F
4730*/
4731void initS (ideal F, ideal Q, kStrategy strat)
4732{
4733  int   i,pos;
4734
4735  if (Q!=NULL) i=((IDELEMS(F)+IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4736  else         i=((IDELEMS(F)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4737  strat->ecartS=initec(i);
4738  strat->sevS=initsevS(i);
4739  strat->S_2_R=initS_2_R(i);
4740  strat->fromQ=NULL;
4741  strat->Shdl=idInit(i,F->rank);
4742  strat->S=strat->Shdl->m;
4743  /*- put polys into S -*/
4744  if (Q!=NULL)
4745  {
4746    strat->fromQ=initec(i);
4747    memset(strat->fromQ,0,i*sizeof(int));
4748    for (i=0; i<IDELEMS(Q); i++)
4749    {
4750      if (Q->m[i]!=NULL)
4751      {
4752        LObject h;
4753        h.p = pCopy(Q->m[i]);
4754        if (TEST_OPT_INTSTRATEGY)
4755        {
4756          //pContent(h.p);
4757          h.pCleardenom(); // also does a pContent
4758        }
4759        else
4760        {
4761          h.pNorm();
4762        }
4763        if (pOrdSgn==-1)
4764        {
4765          deleteHC(&h, strat);
4766        }
4767        if (h.p!=NULL)
4768        {
4769          strat->initEcart(&h);
4770          if (strat->sl==-1)
4771            pos =0;
4772          else
4773          {
4774            pos = posInS(strat,strat->sl,h.p,h.ecart);
4775          }
4776          h.sev = pGetShortExpVector(h.p);
4777          strat->enterS(h,pos,strat,-1);
4778          strat->fromQ[pos]=1;
4779        }
4780      }
4781    }
4782  }
4783  for (i=0; i<IDELEMS(F); i++)
4784  {
4785    if (F->m[i]!=NULL)
4786    {
4787      LObject h;
4788      h.p = pCopy(F->m[i]);
4789      if (pOrdSgn==-1)
4790      {
4791        cancelunit(&h);  /*- tries to cancel a unit -*/
4792        deleteHC(&h, strat);
4793      }
4794      if (TEST_OPT_INTSTRATEGY)
4795      {
4796        //pContent(h.p);
4797        h.pCleardenom(); // also does a pContent
4798      }
4799      else
4800      {
4801        h.pNorm();
4802      }
4803      if (h.p!=NULL)
4804      {
4805        strat->initEcart(&h);
4806        if (strat->sl==-1)
4807          pos =0;
4808        else
4809          pos = posInS(strat,strat->sl,h.p,h.ecart);
4810        h.sev = pGetShortExpVector(h.p);
4811        strat->enterS(h,pos,strat,-1);
4812      }
4813    }
4814  }
4815  /*- test, if a unit is in F -*/
4816  if ((strat->sl>=0)
4817#ifdef HAVE_RINGS
4818       && nIsUnit(pGetCoeff(strat->S[0]))
4819#endif
4820       && pIsConstant(strat->S[0]))
4821  {
4822    while (strat->sl>0) deleteInS(strat->sl,strat);
4823  }
4824}
4825
4826void initSL (ideal F, ideal Q,kStrategy strat)
4827{
4828  int   i,pos;
4829
4830  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4831  else i=setmaxT;
4832  strat->ecartS=initec(i);
4833  strat->sevS=initsevS(i);
4834  strat->S_2_R=initS_2_R(i);
4835  strat->fromQ=NULL;
4836  strat->Shdl=idInit(i,F->rank);
4837  strat->S=strat->Shdl->m;
4838  /*- put polys into S -*/
4839  if (Q!=NULL)
4840  {
4841    strat->fromQ=initec(i);
4842    memset(strat->fromQ,0,i*sizeof(int));
4843    for (i=0; i<IDELEMS(Q); i++)
4844    {
4845      if (Q->m[i]!=NULL)
4846      {
4847        LObject h;
4848        h.p = pCopy(Q->m[i]);
4849        if (pOrdSgn==-1)
4850        {
4851          deleteHC(&h,strat);
4852        }
4853        if (TEST_OPT_INTSTRATEGY)
4854        {
4855          //pContent(h.p);
4856          h.pCleardenom(); // also does a pContent
4857        }
4858        else
4859        {
4860          h.pNorm();
4861        }
4862        if (h.p!=NULL)
4863        {
4864          strat->initEcart(&h);
4865          if (strat->sl==-1)
4866            pos =0;
4867          else
4868          {
4869            pos = posInS(strat,strat->sl,h.p,h.ecart);
4870          }
4871          h.sev = pGetShortExpVector(h.p);
4872          strat->enterS(h,pos,strat,-1);
4873          strat->fromQ[pos]=1;
4874        }
4875      }
4876    }
4877  }
4878  for (i=0; i<IDELEMS(F); i++)
4879  {
4880    if (F->m[i]!=NULL)
4881    {
4882      LObject h;
4883      h.p = pCopy(F->m[i]);
4884      if (h.p!=NULL)
4885      {
4886        if (pOrdSgn==-1)
4887        {
4888          cancelunit(&h);  /*- tries to cancel a unit -*/
4889          deleteHC(&h, strat);
4890        }
4891        if (h.p!=NULL)
4892        {
4893          if (TEST_OPT_INTSTRATEGY)
4894          {
4895            //pContent(h.p);
4896            h.pCleardenom(); // also does a pContent
4897          }
4898          else
4899          {
4900            h.pNorm();
4901          }
4902          strat->initEcart(&h);
4903          if (strat->Ll==-1)
4904            pos =0;
4905          else
4906            pos = strat->posInL(strat->L,strat->Ll,&h,strat);
4907          h.sev = pGetShortExpVector(h.p);
4908          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
4909        }
4910      }
4911    }
4912  }
4913  /*- test, if a unit is in F -*/
4914
4915  if ((strat->Ll>=0) 
4916#ifdef HAVE_RINGS
4917       && nIsUnit(pGetCoeff(strat->L[strat->Ll].p))
4918#endif
4919       && pIsConstant(strat->L[strat->Ll].p))
4920  {
4921    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
4922  }
4923}
4924
4925
4926/*2
4927*construct the set s from F and {P}
4928*/
4929void initSSpecial (ideal F, ideal Q, ideal P,kStrategy strat)
4930{
4931  int   i,pos;
4932
4933  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
4934  else i=setmaxT;
4935  i=((i+IDELEMS(F)+IDELEMS(P)+15)/16)*16;
4936  strat->ecartS=initec(i);
4937  strat->sevS=initsevS(i);
4938  strat->S_2_R=initS_2_R(i);
4939  strat->fromQ=NULL;
4940  strat->Shdl=idInit(i,F->rank);
4941  strat->S=strat->Shdl->m;
4942
4943  /*- put polys into S -*/
4944  if (Q!=NULL)
4945  {
4946    strat->fromQ=initec(i);
4947    memset(strat->fromQ,0,i*sizeof(int));
4948    for (i=0; i<IDELEMS(Q); i++)
4949    {
4950      if (Q->m[i]!=NULL)
4951      {
4952        LObject h;
4953        h.p = pCopy(Q->m[i]);
4954        //if (TEST_OPT_INTSTRATEGY)
4955        //{
4956        //  //pContent(h.p);
4957        //  h.pCleardenom(); // also does a pContent
4958        //}
4959        //else
4960        //{
4961        //  h.pNorm();
4962        //}
4963        if (pOrdSgn==-1)
4964        {
4965          deleteHC(&h,strat);
4966        }
4967        if (h.p!=NULL)
4968        {
4969          strat->initEcart(&h);
4970          if (strat->sl==-1)
4971            pos =0;
4972          else
4973          {
4974            pos = posInS(strat,strat->sl,h.p,h.ecart);
4975          }
4976          h.sev = pGetShortExpVector(h.p);
4977          strat->enterS(h,pos,strat, strat->tl+1);
4978          enterT(h, strat);
4979          strat->fromQ[pos]=1;
4980        }
4981      }
4982    }
4983  }
4984  /*- put polys into S -*/
4985  for (i=0; i<IDELEMS(F); i++)
4986  {
4987    if (F->m[i]!=NULL)
4988    {
4989      LObject h;
4990      h.p = pCopy(F->m[i]);
4991      if (pOrdSgn==-1)
4992      {
4993        deleteHC(&h,strat);
4994      }
4995      else
4996      {
4997        h.p=redtailBba(h.p,strat->sl,strat);
4998      }
4999      if (h.p!=NULL)
5000      {
5001        strat->initEcart(&h);
5002        if (strat->sl==-1)
5003          pos =0;
5004        else
5005          pos = posInS(strat,strat->sl,h.p,h.ecart);
5006        h.sev = pGetShortExpVector(h.p);
5007        strat->enterS(h,pos,strat, strat->tl+1);
5008        enterT(h,strat);
5009      }
5010    }
5011  }
5012  for (i=0; i<IDELEMS(P); i++)
5013  {
5014    if (P->m[i]!=NULL)
5015    {
5016      LObject h;
5017      h.p=pCopy(P->m[i]);
5018      if (TEST_OPT_INTSTRATEGY)
5019      {
5020        h.pCleardenom();
5021      }
5022      else
5023      {
5024        h.pNorm();
5025      }
5026      if(strat->sl>=0)
5027      {
5028        if (pOrdSgn==1)
5029        {
5030          h.p=redBba(h.p,strat->sl,strat);
5031          if (h.p!=NULL)
5032          {
5033            h.p=redtailBba(h.p,strat->sl,strat);
5034          }
5035        }
5036        else
5037        {
5038          h.p=redMora(h.p,strat->sl,strat);
5039        }
5040        if(h.p!=NULL)
5041        {
5042          strat->initEcart(&h);
5043          if (TEST_OPT_INTSTRATEGY)
5044          {
5045            h.pCleardenom();
5046          }
5047          else
5048          {
5049            h.is_normalized = 0;
5050            h.pNorm();
5051          }
5052          h.sev = pGetShortExpVector(h.p);
5053          h.SetpFDeg();
5054          pos = posInS(strat,strat->sl,h.p,h.ecart);
5055          enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
5056          strat->enterS(h,pos,strat, strat->tl+1);
5057          enterT(h,strat);
5058        }
5059      }
5060      else
5061      {
5062        h.sev = pGetShortExpVector(h.p);
5063        strat->initEcart(&h);
5064        strat->enterS(h,0,strat, strat->tl+1);
5065        enterT(h,strat);
5066      }
5067    }
5068  }
5069}
5070/*2
5071* reduces h using the set S
5072* procedure used in cancelunit1
5073*/
5074static poly redBba1 (poly h,int maxIndex,kStrategy strat)
5075{
5076  int j = 0;
5077  unsigned long not_sev = ~ pGetShortExpVector(h);
5078
5079  while (j <= maxIndex)
5080  {
5081    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j],h, not_sev))
5082       return ksOldSpolyRedNew(strat->S[j],h,strat->kNoetherTail());
5083    else j++;
5084  }
5085  return h;
5086}
5087
5088/*2
5089*tests if p.p=monomial*unit and cancels the unit
5090*/
5091void cancelunit1 (LObject* p,int *suc, int index,kStrategy strat )
5092{
5093  int k;
5094  poly r,h,h1,q;
5095
5096  if (!pIsVector((*p).p) && ((*p).ecart != 0))
5097  {
5098    k = 0;
5099    h1 = r = pCopy((*p).p);
5100    h =pNext(r);
5101    loop
5102    {
5103      if (h==NULL)
5104      {
5105        pDelete(&r);
5106        pDelete(&(pNext((*p).p)));
5107        (*p).ecart = 0;
5108        (*p).length = 1;
5109        (*suc)=0;
5110        return;
5111      }
5112      if (!pDivisibleBy(r,h))
5113      {
5114        q=redBba1(h,index ,strat);
5115        if (q != h)
5116        {
5117          k++;
5118          pDelete(&h);
5119          pNext(h1) = h = q;
5120        }
5121        else
5122        {
5123          pDelete(&r);
5124          return;
5125        }
5126      }
5127      else
5128      {
5129        h1 = h;
5130        pIter(h);
5131      }
5132      if (k > 10)
5133      {
5134        pDelete(&r);
5135        return;
5136      }
5137    }
5138  }
5139}
5140
5141#if 0
5142/*2
5143* reduces h using the elements from Q in the set S
5144* procedure used in updateS
5145* must not be used for elements of Q or elements of an ideal !
5146*/
5147static poly redQ (poly h, int j, kStrategy strat)
5148{
5149  int start;
5150  unsigned long not_sev = ~ pGetShortExpVector(h);
5151  while ((j <= strat->sl) && (pGetComp(strat->S[j])!=0)) j++;
5152  start=j;
5153  while (j<=strat->sl)
5154  {
5155    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
5156    {
5157      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
5158      if (h==NULL) return NULL;
5159      j = start;
5160      not_sev = ~ pGetShortExpVector(h);
5161    }
5162    else j++;
5163  }
5164  return h;
5165}
5166#endif
5167
5168/*2
5169* reduces h using the set S
5170* procedure used in updateS
5171*/
5172static poly redBba (poly h,int maxIndex,kStrategy strat)
5173{
5174  int j = 0;
5175  unsigned long not_sev = ~ pGetShortExpVector(h);
5176
5177  while (j <= maxIndex)
5178  {
5179    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
5180    {
5181      h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
5182      if (h==NULL) return NULL;
5183      j = 0;
5184      not_sev = ~ pGetShortExpVector(h);    }
5185    else j++;
5186  }
5187  return h;
5188}
5189
5190/*2
5191* reduces h using the set S
5192*e is the ecart of h
5193*procedure used in updateS
5194*/
5195static poly redMora (poly h,int maxIndex,kStrategy strat)
5196{
5197  int  j=0;
5198  int  e,l;
5199  unsigned long not_sev = ~ pGetShortExpVector(h);
5200
5201  if (maxIndex >= 0)
5202  {
5203    e = pLDeg(h,&l,currRing)-pFDeg(h,currRing);
5204    do
5205    {
5206      if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev)
5207      && ((e >= strat->ecartS[j]) || strat->kHEdgeFound))
5208      {
5209#ifdef KDEBUG
5210        if (TEST_OPT_DEBUG)
5211          {PrintS("reduce ");wrp(h);Print(" with S[%d] (",j);wrp(strat->S[j]);}
5212#endif
5213        h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
5214#ifdef KDEBUG
5215        if(TEST_OPT_DEBUG)
5216          {PrintS(")\nto "); wrp(h); PrintLn();}
5217#endif
5218        // pDelete(&h);
5219        if (h == NULL) return NULL;
5220        e = pLDeg(h,&l,currRing)-pFDeg(h,currRing);
5221        j = 0;
5222        not_sev = ~ pGetShortExpVector(h);
5223      }
5224      else j++;
5225    }
5226    while (j <= maxIndex);
5227  }
5228  return h;
5229}
5230
5231/*2
5232*updates S:
5233*the result is a set of polynomials which are in
5234*normalform with respect to S
5235*/
5236void updateS(BOOLEAN toT,kStrategy strat)
5237{
5238  LObject h;
5239  int i, suc=0;
5240  poly redSi=NULL;
5241  BOOLEAN change,any_change;
5242//  Print("nach initS: updateS start mit sl=%d\n",(strat->sl));
5243//  for (i=0; i<=(strat->sl); i++)
5244//  {
5245//    Print("s%d:",i);
5246//    if (strat->fromQ!=NULL) Print("(Q:%d) ",strat->fromQ[i]);
5247//    pWrite(strat->S[i]);
5248//  }
5249//  Print("pOrdSgn=%d\n", pOrdSgn);
5250  any_change=FALSE;
5251  if (pOrdSgn==1)
5252  {
5253    while (suc != -1)
5254    {
5255      i=suc+1;
5256      while (i<=strat->sl)
5257      {
5258        change=FALSE;
5259        if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
5260        {
5261          redSi = pHead(strat->S[i]);
5262          strat->S[i] = redBba(strat->S[i],i-1,strat);
5263          //if ((strat->ak!=0)&&(strat->S[i]!=NULL))
5264          //  strat->S[i]=redQ(strat->S[i],i+1,strat); /*reduce S[i] mod Q*/
5265          if (pCmp(redSi,strat->S[i])!=0)
5266          {
5267            change=TRUE;
5268            any_change=TRUE;
5269            #ifdef KDEBUG
5270            if (TEST_OPT_DEBUG)
5271            {
5272              PrintS("reduce:");
5273              wrp(redSi);PrintS(" to ");p_wrp(strat->S[i], currRing, strat->tailRing);PrintLn();
5274            }
5275            #endif
5276            if (TEST_OPT_PROT)
5277            {
5278              if (strat->S[i]==NULL)
5279                PrintS("V");
5280              else
5281                PrintS("v");
5282              mflush();
5283            }
5284          }
5285          pDeleteLm(&redSi);
5286          if (strat->S[i]==NULL)
5287          {
5288            deleteInS(i,strat);
5289            i--;
5290          }
5291          else if (change)
5292          {
5293            if (TEST_OPT_INTSTRATEGY)
5294            {
5295              //pContent(strat->S[i]);
5296              pCleardenom(strat->S[i]);// also does a pContent
5297            }
5298            else
5299            {
5300              pNorm(strat->S[i]);
5301            }
5302            strat->sevS[i] = pGetShortExpVector(strat->S[i]);
5303          }
5304        }
5305        i++;
5306      }
5307      if (any_change) reorderS(&suc,strat);
5308      else break;
5309    }
5310    if (toT)
5311    {
5312      for (i=0; i<=strat->sl; i++)
5313      {
5314        if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
5315        {
5316          h.p = redtailBba(strat->S[i],i-1,strat);
5317          if (TEST_OPT_INTSTRATEGY)
5318          {
5319            pCleardenom(h.p);// also does a pContent
5320          }
5321        }
5322        else
5323        {
5324          h.p = strat->S[i];
5325        }
5326        strat->initEcart(&h);
5327        if (strat->honey)
5328        {
5329          strat->ecartS[i] = h.ecart;
5330        }
5331        if (strat->sevS[i] == 0) {strat->sevS[i] = pGetShortExpVector(h.p);}
5332        else assume(strat->sevS[i] == pGetShortExpVector(h.p));
5333        h.sev = strat->sevS[i];
5334        /*puts the elements of S also to T*/
5335        enterT(h,strat);
5336        strat->S_2_R[i] = strat->tl;
5337      }
5338    }
5339  }
5340  else
5341  {
5342    while (suc != -1)
5343    {
5344      i=suc;
5345      while (i<=strat->sl)
5346      {
5347        change=FALSE;
5348        if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
5349        {
5350          redSi=pHead((strat->S)[i]);
5351          (strat->S)[i] = redMora((strat->S)[i],i-1,strat);
5352          if ((strat->S)[i]==NULL)
5353          {
5354            deleteInS(i,strat);
5355            i--;
5356          }
5357          else if (pCmp((strat->S)[i],redSi)!=0)
5358          {
5359            any_change=TRUE;
5360            h.p = strat->S[i];
5361            strat->initEcart(&h);
5362            strat->ecartS[i] = h.ecart;
5363            if (TEST_OPT_INTSTRATEGY)
5364            {
5365              pCleardenom(strat->S[i]);// also does a pContent
5366            }
5367            else
5368            {
5369              pNorm(strat->S[i]); // == h.p
5370            }
5371            h.sev =  pGetShortExpVector(h.p);
5372            strat->sevS[i] = h.sev;
5373          }
5374          pDeleteLm(&redSi);
5375          kTest(strat);
5376        }
5377        i++;
5378      }
5379#ifdef KDEBUG
5380      kTest(strat);
5381#endif
5382      if (any_change) reorderS(&suc,strat);
5383      else { suc=-1; break; }
5384      if (h.p!=NULL)
5385      {
5386        if (!strat->kHEdgeFound)
5387        {
5388          /*strat->kHEdgeFound =*/ HEckeTest(h.p,strat);
5389        }
5390        if (strat->kHEdgeFound)
5391          newHEdge(strat->S,strat);
5392      }
5393    }
5394    for (i=0; i<=strat->sl; i++)
5395    {
5396      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
5397      {
5398        strat->S[i] = h.p = redtail(strat->S[i],strat->sl,strat);
5399        strat->initEcart(&h);
5400        strat->ecartS[i] = h.ecart;
5401        h.sev = pGetShortExpVector(h.p);
5402        strat->sevS[i] = h.sev;
5403      }
5404      else
5405      {
5406        h.p = strat->S[i];
5407        h.ecart=strat->ecartS[i];
5408        h.sev = strat->sevS[i];
5409        h.length = h.pLength = pLength(h.p);
5410      }
5411      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
5412        cancelunit1(&h,&suc,strat->sl,strat);
5413      h.SetpFDeg();
5414      /*puts the elements of S also to T*/
5415      enterT(h,strat);
5416      strat->S_2_R[i] = strat->tl;
5417    }
5418    if (suc!= -1) updateS(toT,strat);
5419  }
5420#ifdef KDEBUG
5421  kTest(strat);
5422#endif
5423}
5424
5425
5426/*2
5427* -puts p to the standardbasis s at position at
5428* -saves the result in S
5429*/
5430void enterSBba (LObject p,int atS,kStrategy strat, int atR)
5431{
5432  int i;
5433  strat->news = TRUE;
5434  /*- puts p to the standardbasis s at position at -*/
5435  if (strat->sl == IDELEMS(strat->Shdl)-1)
5436  {
5437    strat->sevS = (unsigned long*) omRealloc0Size(strat->sevS,
5438                                    IDELEMS(strat->Shdl)*sizeof(unsigned long),
5439                                    (IDELEMS(strat->Shdl)+setmaxTinc)
5440                                                  *sizeof(unsigned long));
5441    strat->ecartS = (intset)omReallocSize(strat->ecartS,
5442                                          IDELEMS(strat->Shdl)*sizeof(int),
5443                                          (IDELEMS(strat->Shdl)+setmaxTinc)
5444                                                  *sizeof(int));
5445    strat->S_2_R = (int*) omRealloc0Size(strat->S_2_R,
5446                                         IDELEMS(strat->Shdl)*sizeof(int),
5447                                         (IDELEMS(strat->Shdl)+setmaxTinc)
5448                                                  *sizeof(int));
5449    if (strat->lenS!=NULL)
5450      strat->lenS=(int*)omRealloc0Size(strat->lenS,
5451                                       IDELEMS(strat->Shdl)*sizeof(int),
5452                                       (IDELEMS(strat->Shdl)+setmaxTinc)
5453                                                 *sizeof(int));
5454    if (strat->lenSw!=NULL)
5455      strat->lenSw=(wlen_type*)omRealloc0Size(strat->lenSw,
5456                                       IDELEMS(strat->Shdl)*sizeof(wlen_type),
5457                                       (IDELEMS(strat->Shdl)+setmaxTinc)
5458                                                 *sizeof(wlen_type));
5459    if (strat->fromQ!=NULL)
5460    {
5461      strat->fromQ = (intset)omReallocSize(strat->fromQ,
5462                                    IDELEMS(strat->Shdl)*sizeof(int),
5463                                    (IDELEMS(strat->Shdl)+setmaxTinc)*sizeof(int));
5464    }
5465    pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmaxTinc);
5466    IDELEMS(strat->Shdl)+=setmaxTinc;
5467    strat->Shdl->m=strat->S;
5468  }
5469  if (atS <= strat->sl)
5470  {
5471#ifdef ENTER_USE_MEMMOVE
5472// #if 0
5473    memmove(&(strat->S[atS+1]), &(strat->S[atS]),
5474            (strat->sl - atS + 1)*sizeof(poly));
5475    memmove(&(strat->ecartS[atS+1]), &(strat->ecartS[atS]),
5476            (strat->sl - atS + 1)*sizeof(int));
5477    memmove(&(strat->sevS[atS+1]), &(strat->sevS[atS]),
5478            (strat->sl - atS + 1)*sizeof(unsigned long));
5479    memmove(&(strat->S_2_R[atS+1]), &(strat->S_2_R[atS]),
5480            (strat->sl - atS + 1)*sizeof(int));
5481    if (strat->lenS!=NULL)
5482    memmove(&(strat->lenS[atS+1]), &(strat->lenS[atS]),
5483            (strat->sl - atS + 1)*sizeof(int));
5484    if (strat->lenSw!=NULL)
5485    memmove(&(strat->lenSw[atS+1]), &(strat->lenSw[atS]),
5486            (strat->sl - atS + 1)*sizeof(wlen_type));
5487#else
5488    for (i=strat->sl+1; i>=atS+1; i--)
5489    {
5490      strat->S[i] = strat->S[i-1];
5491      strat->ecartS[i] = strat->ecartS[i-1];
5492      strat->sevS[i] = strat->sevS[i-1];
5493      strat->S_2_R[i] = strat->S_2_R[i-1];
5494    }
5495    if (strat->lenS!=NULL)
5496    for (i=strat->sl+1; i>=atS+1; i--)
5497      strat->lenS[i] = strat->lenS[i-1];
5498    if (strat->lenSw!=NULL)
5499    for (i=strat->sl+1; i>=atS+1; i--)
5500      strat->lenSw[i] = strat->lenSw[i-1];
5501#endif
5502  }
5503  if (strat->fromQ!=NULL)
5504  {
5505#ifdef ENTER_USE_MEMMOVE
5506    memmove(&(strat->fromQ[atS+1]), &(strat->fromQ[atS]),
5507                  (strat->sl - atS + 1)*sizeof(int));
5508#else
5509    for (i=strat->sl+1; i>=atS+1; i--)
5510    {
5511      strat->fromQ[i] = strat->fromQ[i-1];
5512    }
5513#endif
5514    strat->fromQ[atS]=0;
5515  }
5516
5517  /*- save result -*/
5518  strat->S[atS] = p.p;
5519  if (strat->honey) strat->ecartS[atS] = p.ecart;
5520  if (p.sev == 0)
5521    p.sev = pGetShortExpVector(p.p);
5522  else
5523    assume(p.sev == pGetShortExpVector(p.p));
5524  strat->sevS[atS] = p.sev;
5525  strat->ecartS[atS] = p.ecart;
5526  strat->S_2_R[atS] = atR;
5527  strat->sl++;
5528}
5529
5530/*2
5531* puts p to the set T at position atT
5532*/
5533void enterT(LObject p, kStrategy strat, int atT)
5534{
5535  int i;
5536
5537  pp_Test(p.p, currRing, p.tailRing);
5538  assume(strat->tailRing == p.tailRing);
5539  // redMoraNF complains about this -- but, we don't really
5540  // neeed this so far
5541  assume(p.pLength == 0 || pLength(p.p) == p.pLength);
5542  assume(p.FDeg == p.pFDeg());
5543  assume(!p.is_normalized || nIsOne(pGetCoeff(p.p)));
5544
5545#ifdef KDEBUG 
5546  // do not put an LObject twice into T:
5547  for(i=strat->tl;i>=0;i--)
5548  {
5549    if (p.p==strat->T[i].p) 
5550    {
5551      printf("already in T at pos %d of %d, atT=%d\n",i,strat->tl,atT);
5552      return;
5553    }
5554  }
5555#endif 
5556  strat->newt = TRUE;
5557  if (atT < 0)
5558    atT = strat->posInT(strat->T, strat->tl, p);
5559  if (strat->tl == strat->tmax-1)
5560    enlargeT(strat->T,strat->R,strat->sevT,strat->tmax,setmaxTinc);
5561  if (atT <= strat->tl)
5562  {
5563#ifdef ENTER_USE_MEMMOVE
5564    memmove(&(strat->T[atT+1]), &(strat->T[atT]),
5565            (strat->tl-atT+1)*sizeof(TObject));
5566    memmove(&(strat->sevT[atT+1]), &(strat->sevT[atT]),
5567            (strat->tl-atT+1)*sizeof(unsigned long));
5568#endif
5569    for (i=strat->tl+1; i>=atT+1; i--)
5570    {
5571#ifndef ENTER_USE_MEMMOVE
5572      strat->T[i] = strat->T[i-1];
5573      strat->sevT[i] = strat->sevT[i-1];
5574#endif
5575      strat->R[strat->T[i].i_r] = &(strat->T[i]);
5576    }
5577  }
5578
5579  if (strat->tailBin != NULL && (pNext(p.p) != NULL))
5580  {
5581    pNext(p.p)=p_ShallowCopyDelete(pNext(p.p),
5582                                   (strat->tailRing != NULL ?
5583                                    strat->tailRing : currRing),
5584                                   strat->tailBin);
5585    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
5586  }
5587  strat->T[atT] = (TObject) p;
5588
5589  if (strat->tailRing != currRing && pNext(p.p) != NULL)
5590    strat->T[atT].max = p_GetMaxExpP(pNext(p.p), strat->tailRing);
5591  else
5592    strat->T[atT].max = NULL;
5593
5594  strat->tl++;
5595  strat->R[strat->tl] = &(strat->T[atT]);
5596  strat->T[atT].i_r = strat->tl;
5597  assume(p.sev == 0 || pGetShortExpVector(p.p) == p.sev);
5598  strat->sevT[atT] = (p.sev == 0 ? pGetShortExpVector(p.p) : p.sev);
5599  kTest_T(&(strat->T[atT]));
5600}
5601
5602void initHilbCrit(ideal F, ideal Q, intvec **hilb,kStrategy strat)
5603{
5604  if (strat->homog!=isHomog)
5605  {
5606    *hilb=NULL;
5607  }
5608}
5609
5610void initBuchMoraCrit(kStrategy strat)
5611{
5612  strat->sugarCrit =        TEST_OPT_SUGARCRIT;
5613  // obachman: Hmm.. I need BTEST1(2) for notBuckets ..
5614  //  strat->Gebauer =          BTEST1(2) || strat->homog || strat->sugarCrit;
5615  strat->Gebauer =          strat->homog || strat->sugarCrit;
5616  strat->honey =            !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
5617  if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
5618  strat->pairtest = NULL;
5619  /* alway use tailreduction, except:
5620  * - in local rings, - in lex order case, -in ring over extensions */
5621  strat->noTailReduction = !TEST_OPT_REDTAIL;
5622
5623#ifdef HAVE_PLURAL
5624  // and r is plural_ring
5625  if( rIsPluralRing(currRing) || (rIsSCA(currRing) && !strat->z2homog) )
5626  {    //or it has non-quasi-comm type... later
5627    strat->sugarCrit = FALSE;
5628    strat->Gebauer = FALSE;
5629    strat->honey = FALSE;
5630  }
5631#endif
5632
5633#ifdef HAVE_RINGS
5634  // Coefficient ring?
5635  if (rField_is_Ring(currRing))
5636  {
5637    strat->sugarCrit = FALSE;
5638    strat->Gebauer = FALSE ;
5639    strat->honey = FALSE;
5640  }
5641#endif
5642  #ifdef KDEBUG
5643  if (TEST_OPT_DEBUG)
5644  {
5645    if (strat->homog) PrintS("ideal/module is homogeneous\n");
5646    else              PrintS("ideal/module is not homogeneous\n");
5647  }
5648  #endif
5649}
5650
5651BOOLEAN kPosInLDependsOnLength(int (*pos_in_l)
5652                               (const LSet set, const int length,
5653                                LObject* L,const kStrategy strat))
5654{
5655  if (pos_in_l == posInL110 ||
5656      pos_in_l == posInL10)
5657    return TRUE;
5658
5659  return FALSE;
5660}
5661
5662void initBuchMoraPos (kStrategy strat)
5663{
5664  if (pOrdSgn==1)
5665  {
5666    if (strat->honey)
5667    {
5668      strat->posInL = posInL15;
5669      // ok -- here is the deal: from my experiments for Singular-2-0
5670      // I conclude that that posInT_EcartpLength is the best of
5671      // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
5672      // see the table at the end of this file
5673      if (K_TEST_OPT_OLDSTD)
5674        strat->posInT = posInT15;
5675      else
5676        strat->posInT = posInT_EcartpLength;
5677    }
5678    else if (pLexOrder && !TEST_OPT_INTSTRATEGY)
5679    {
5680      strat->posInL = posInL11;
5681      strat->posInT = posInT11;
5682    }
5683    else if (TEST_OPT_INTSTRATEGY)
5684    {
5685      strat->posInL = posInL11;
5686      strat->posInT = posInT11;
5687    }
5688    else
5689    {
5690      strat->posInL = posInL0;
5691      strat->posInT = posInT0;
5692    }
5693    //if (strat->minim>0) strat->posInL =posInLSpecial;
5694    if (strat->homog)
5695    {
5696       strat->posInL = posInL110;
5697       strat->posInT = posInT110;
5698    }
5699  }
5700  else
5701  {
5702    if (strat->homog)
5703    {
5704      strat->posInL = posInL11;
5705      strat->posInT = posInT11;
5706    }
5707    else
5708    {
5709      if ((currRing->order[0]==ringorder_c)
5710      ||(currRing->order[0]==ringorder_C))
5711      {
5712        strat->posInL = posInL17_c;
5713        strat->posInT = posInT17_c;
5714      }
5715      else
5716      {
5717        strat->posInL = posInL17;
5718        strat->posInT = posInT17;
5719      }
5720    }
5721  }
5722  if (strat->minim>0) strat->posInL =posInLSpecial;
5723  // for further tests only
5724  if ((BTEST1(11)) || (BTEST1(12)))
5725    strat->posInL = posInL11;
5726  else if ((BTEST1(13)) || (BTEST1(14)))
5727    strat->posInL = posInL13;
5728  else if ((BTEST1(15)) || (BTEST1(16)))
5729    strat->posInL = posInL15;
5730  else if ((BTEST1(17)) || (BTEST1(18)))
5731    strat->posInL = posInL17;
5732  if (BTEST1(11))
5733    strat->posInT = posInT11;
5734  else if (BTEST1(13))
5735    strat->posInT = posInT13;
5736  else if (BTEST1(15))
5737    strat->posInT = posInT15;
5738  else if ((BTEST1(17)))
5739    strat->posInT = posInT17;
5740  else if ((BTEST1(19)))
5741    strat->posInT = posInT19;
5742  else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
5743    strat->posInT = posInT1;
5744#ifdef HAVE_RINGS
5745  if (rField_is_Ring(currRing))
5746  {
5747    strat->posInL = posInL11;
5748    strat->posInT = posInT11;
5749  }
5750#endif
5751  strat->posInLDependsOnLength = kPosInLDependsOnLength(strat->posInL);
5752}
5753
5754void initBuchMora (ideal F,ideal Q,kStrategy strat)
5755{
5756  strat->interpt = BTEST1(OPT_INTERRUPT);
5757  strat->kHEdge=NULL;
5758  if (pOrdSgn==1) strat->kHEdgeFound=FALSE;
5759  /*- creating temp data structures------------------- -*/
5760  strat->cp = 0;
5761  strat->c3 = 0;
5762  strat->tail = pInit();
5763  /*- set s -*/
5764  strat->sl = -1;
5765  /*- set L -*/
5766  strat->Lmax = ((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
5767  strat->Ll = -1;
5768  strat->L = initL(((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc);
5769  /*- set B -*/
5770  strat->Bmax = setmaxL;
5771  strat->Bl = -1;
5772  strat->B = initL();
5773  /*- set T -*/
5774  strat->tl = -1;
5775  strat->tmax = setmaxT;
5776  strat->T = initT();
5777  strat->R = initR();
5778  strat->sevT = initsevT();
5779  /*- init local data struct.---------------------------------------- -*/
5780  strat->P.ecart=0;
5781  strat->P.length=0;
5782  if (pOrdSgn==-1)
5783  {
5784    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
5785    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
5786  }
5787  if(TEST_OPT_SB_1)
5788  {
5789    int i;
5790    ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
5791    for (i=strat->newIdeal;i<IDELEMS(F);i++)
5792    {
5793      P->m[i-strat->newIdeal] = F->m[i];
5794      F->m[i] = NULL;
5795    }
5796    initSSpecial(F,Q,P,strat);
5797    for (i=strat->newIdeal;i<IDELEMS(F);i++)
5798    {
5799      F->m[i] = P->m[i-strat->newIdeal];
5800      P->m[i-strat->newIdeal] = NULL;
5801    }
5802    idDelete(&P);
5803  }
5804  else
5805  {
5806    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
5807    // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
5808  }
5809  strat->kIdeal = NULL;
5810  strat->fromT = FALSE;
5811  strat->noTailReduction = !TEST_OPT_REDTAIL;
5812  if (!TEST_OPT_SB_1)
5813  {
5814    updateS(TRUE,strat);
5815  }
5816  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
5817  strat->fromQ=NULL;
5818}
5819
5820void exitBuchMora (kStrategy strat)
5821{
5822  /*- release temp data -*/
5823  cleanT(strat);
5824  omFreeSize(strat->T,(strat->tmax)*sizeof(TObject));
5825  omFreeSize(strat->R,(strat->tmax)*sizeof(TObject*));
5826  omFreeSize(strat->sevT, (strat->tmax)*sizeof(unsigned long));
5827  omFreeSize(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
5828  omFreeSize(strat->sevS,IDELEMS(strat->Shdl)*sizeof(int));
5829  omFreeSize(strat->S_2_R,IDELEMS(strat->Shdl)*sizeof(int));
5830  /*- set L: should be empty -*/
5831  omFreeSize(strat->L,(strat->Lmax)*sizeof(LObject));
5832  /*- set B: should be empty -*/
5833  omFreeSize(strat->B,(strat->Bmax)*sizeof(LObject));
5834  pDeleteLm(&strat->tail);
5835  strat->syzComp=0;
5836  if (strat->kIdeal!=NULL)
5837  {
5838    omFreeBin(strat->kIdeal, sleftv_bin);
5839    strat->kIdeal=NULL;
5840  }
5841}
5842
5843/*2
5844* in the case of a standardbase of a module over a qring:
5845* replace polynomials in i by ak vectors,
5846* (the polynomial * unit vectors gen(1)..gen(ak)
5847* in every case (also for ideals:)
5848* deletes divisible vectors/polynomials
5849*/
5850void updateResult(ideal r,ideal Q, kStrategy strat)
5851{
5852  int l;
5853  if (strat->ak>0)
5854  {
5855    for (l=IDELEMS(r)-1;l>=0;l--)
5856    {
5857      if ((r->m[l]!=NULL) && (pGetComp(r->m[l])==0))
5858      {
5859        pDelete(&r->m[l]); // and set it to NULL
5860      }
5861    }
5862    int q;
5863    poly p;
5864    for (l=IDELEMS(r)-1;l>=0;l--)
5865    {
5866      if ((r->m[l]!=NULL)
5867      && (strat->syzComp>0)
5868      && (pGetComp(r->m[l])<=strat->syzComp))
5869      {
5870        for(q=IDELEMS(Q)-1; q>=0;q--)
5871        {
5872          if ((Q->m[q]!=NULL)
5873          &&(pLmDivisibleBy(Q->m[q],r->m[l])))
5874          {
5875            if (TEST_OPT_REDSB)
5876            {
5877              p=r->m[l];
5878              r->m[l]=kNF(Q,NULL,p);
5879              pDelete(&p);
5880            }
5881            else
5882            {
5883              pDelete(&r->m[l]); // and set it to NULL
5884            }
5885            break;
5886          }
5887        }
5888      }
5889    }
5890  }
5891  else
5892  {
5893    int q;
5894    poly p;
5895    for (l=IDELEMS(r)-1;l>=0;l--)
5896    {
5897      if (r->m[l]!=NULL)
5898      {
5899        for(q=IDELEMS(Q)-1; q>=0;q--)
5900        {
5901          if ((Q->m[q]!=NULL)
5902          &&(pLmEqual(r->m[l],Q->m[q])))
5903          {
5904            if (TEST_OPT_REDSB)
5905            {
5906              p=r->m[l];
5907              r->m[l]=kNF(Q,NULL,p);
5908              pDelete(&p);
5909            }
5910            else
5911            {
5912              pDelete(&r->m[l]); // and set it to NULL
5913            }
5914            break;
5915          }
5916        }
5917      }
5918    }
5919  }
5920  idSkipZeroes(r);
5921}
5922
5923void completeReduce (kStrategy strat, BOOLEAN withT)
5924{
5925  int i;
5926  int low = (pOrdSgn == 1 ? 1 : 0);
5927  LObject L;
5928
5929#ifdef KDEBUG
5930  // need to set this: during tailreductions of T[i], T[i].max is out of
5931  // sync
5932  sloppy_max = TRUE;
5933#endif
5934
5935  strat->noTailReduction = FALSE;
5936  if (TEST_OPT_PROT)
5937  {
5938    PrintLn();
5939    if (timerv) writeTime("standard base computed:");
5940  }
5941  if (TEST_OPT_PROT)
5942  {
5943    Print("(S:%d)",strat->sl);mflush();
5944  }
5945  for (i=strat->sl; i>=low; i--)
5946  {
5947    TObject* T_j = strat->s_2_t(i);
5948    if (T_j != NULL)
5949    {
5950      L = *T_j;
5951      poly p;
5952      if (pOrdSgn == 1)
5953        strat->S[i] = redtailBba(&L, i-1, strat, withT);
5954      else
5955        strat->S[i] = redtail(&L, strat->sl, strat);
5956
5957      if (strat->redTailChange && strat->tailRing != currRing)
5958      {
5959        if (T_j->max != NULL) p_LmFree(T_j->max, strat->tailRing);
5960        if (pNext(T_j->p) != NULL)
5961          T_j->max = p_GetMaxExpP(pNext(T_j->p), strat->tailRing);
5962        else
5963          T_j->max = NULL;
5964      }
5965      if (TEST_OPT_INTSTRATEGY)
5966        T_j->pCleardenom();
5967    }
5968    else
5969    {
5970      assume(currRing == strat->tailRing);
5971      if (pOrdSgn == 1)
5972        strat->S[i] = redtailBba(strat->S[i], i-1, strat, withT);
5973      else
5974        strat->S[i] = redtail(strat->S[i], strat->sl, strat);
5975      if (TEST_OPT_INTSTRATEGY)
5976        pCleardenom(strat->S[i]);
5977    }
5978    if (TEST_OPT_PROT)
5979      PrintS("-");
5980  }
5981  if (TEST_OPT_PROT) PrintLn();
5982#ifdef KDEBUG
5983  sloppy_max = FALSE;
5984#endif
5985}
5986
5987
5988/*2
5989* computes the new strat->kHEdge and the new pNoether,
5990* returns TRUE, if pNoether has changed
5991*/
5992BOOLEAN newHEdge(polyset S, kStrategy strat)
5993{
5994  int i,j;
5995  poly newNoether;
5996
5997#if 0
5998  if (currRing->weight_all_1)
5999    scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
6000  else
6001    scComputeHCw(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
6002#else   
6003  scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
6004#endif 
6005  if (strat->t_kHEdge != NULL) p_LmFree(strat->t_kHEdge, strat->tailRing);
6006  if (strat->tailRing != currRing)
6007    strat->t_kHEdge = k_LmInit_currRing_2_tailRing(strat->kHEdge, strat->tailRing);
6008  /* compare old and new noether*/
6009  newNoether = pLmInit(strat->kHEdge);
6010  j = pFDeg(newNoether,currRing);
6011  for (i=1; i<=pVariables; i++)
6012  {
6013    if (pGetExp(newNoether, i) > 0) pDecrExp(newNoether,i);
6014  }
6015  pSetm(newNoether);
6016  if (j < strat->HCord) /*- statistics -*/
6017  {
6018    if (TEST_OPT_PROT)
6019    {
6020      Print("H(%d)",j);
6021      mflush();
6022    }
6023    strat->HCord=j;
6024    #ifdef KDEBUG
6025    if (TEST_OPT_DEBUG)
6026    {
6027      Print("H(%d):",j);
6028      wrp(strat->kHEdge);
6029      PrintLn();
6030    }
6031    #endif
6032  }
6033  if (pCmp(strat->kNoether,newNoether)!=1)
6034  {
6035    pDelete(&strat->kNoether);
6036    strat->kNoether=newNoether;
6037    if (strat->t_kNoether != NULL) p_LmFree(strat->t_kNoether, strat->tailRing);
6038    if (strat->tailRing != currRing)
6039      strat->t_kNoether = k_LmInit_currRing_2_tailRing(strat->kNoether, strat->tailRing);
6040
6041    return TRUE;
6042  }
6043  pLmFree(newNoether);
6044  return FALSE;
6045}
6046
6047/***************************************************************
6048 *
6049 * Routines related for ring changes during std computations
6050 *
6051 ***************************************************************/
6052BOOLEAN kCheckSpolyCreation(LObject *L, kStrategy strat, poly &m1, poly &m2)
6053{
6054  assume(L->p1 != NULL && L->p2 != NULL);
6055  // shift changes: from 0 to -1
6056  assume(L->i_r1 >= -1 && L->i_r1 <= strat->tl);
6057  assume(L->i_r2 >= -1 && L->i_r2 <= strat->tl);
6058  assume(strat->tailRing != currRing);
6059
6060  if (! k_GetLeadTerms(L->p1, L->p2, currRing, m1, m2, strat->tailRing))
6061    return FALSE;
6062  // shift changes: extra case inserted
6063  if ((L->i_r1 == -1) || (L->i_r2 == -1) )
6064  {
6065    return TRUE;
6066  }
6067  poly p1_max = (strat->R[L->i_r1])->max;
6068  poly p2_max = (strat->R[L->i_r2])->max;
6069
6070  if ((p1_max != NULL && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
6071      (p2_max != NULL && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
6072  {
6073    p_LmFree(m1, strat->tailRing);
6074    p_LmFree(m2, strat->tailRing);
6075    m1 = NULL;
6076    m2 = NULL;
6077    return FALSE;
6078  }
6079  return TRUE;
6080}
6081
6082#ifdef HAVE_RINGS
6083/***************************************************************
6084 *
6085 * Checks, if we can compute the gcd poly / strong pair
6086 * gcd-poly = m1 * R[atR] + m2 * S[atS]
6087 *
6088 ***************************************************************/
6089BOOLEAN kCheckStrongCreation(int atR, poly m1, int atS, poly m2, kStrategy strat)
6090{
6091  assume(strat->S_2_R[atS] >= -1 && strat->S_2_R[atS] <= strat->tl);
6092  assume(strat->tailRing != currRing);
6093
6094  poly p1_max = (strat->R[atR])->max;
6095  poly p2_max = (strat->R[strat->S_2_R[atS]])->max;
6096
6097  if ((p1_max != NULL && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
6098      (p2_max != NULL && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
6099  {
6100    return FALSE;
6101  }
6102  return TRUE;
6103}
6104#endif
6105
6106BOOLEAN kStratChangeTailRing(kStrategy strat, LObject *L, TObject* T, unsigned long expbound)
6107{
6108  if (expbound == 0) expbound = strat->tailRing->bitmask << 1;
6109  if (expbound >= currRing->bitmask) return FALSE;
6110  ring new_tailRing = rModifyRing(currRing,
6111                                  // Hmmm .. the condition pFDeg == pDeg
6112                                  // might be too strong
6113#ifdef HAVE_RINGS
6114                                  (strat->homog && pFDeg == pDeg && !(rField_is_Ring(currRing))), // TODO Oliver
6115#else
6116                                  (strat->homog && pFDeg == pDeg),
6117#endif
6118                                  !strat->ak,
6119                                  expbound);
6120  if (new_tailRing == currRing) return TRUE;
6121
6122  strat->pOrigFDeg_TailRing = new_tailRing->pFDeg;
6123  strat->pOrigLDeg_TailRing = new_tailRing->pLDeg;
6124
6125  if (currRing->pFDeg != currRing->pFDegOrig)
6126  {
6127    new_tailRing->pFDeg = currRing->pFDeg;
6128    new_tailRing->pLDeg = currRing->pLDeg;
6129  }
6130
6131  if (TEST_OPT_PROT)
6132    Print("[%lu:%d", (unsigned long) new_tailRing->bitmask, new_tailRing->ExpL_Size);
6133  kTest_TS(strat);
6134  assume(new_tailRing != strat->tailRing);
6135  pShallowCopyDeleteProc p_shallow_copy_delete
6136    = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
6137
6138  omBin new_tailBin = omGetStickyBinOfBin(new_tailRing->PolyBin);
6139
6140  int i;
6141  for (i=0; i<=strat->tl; i++)
6142  {
6143    strat->T[i].ShallowCopyDelete(new_tailRing, new_tailBin,
6144                                  p_shallow_copy_delete);
6145  }
6146  for (i=0; i<=strat->Ll; i++)
6147  {
6148    assume(strat->L[i].p != NULL);
6149    if (pNext(strat->L[i].p) != strat->tail)
6150      strat->L[i].ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
6151  }
6152  if (strat->P.t_p != NULL ||
6153      (strat->P.p != NULL && pNext(strat->P.p) != strat->tail))
6154    strat->P.ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
6155
6156  if (L != NULL && L->tailRing != new_tailRing)
6157  {
6158    if (L->i_r < 0)
6159      L->ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
6160    else
6161    {
6162      assume(L->i_r <= strat->tl);
6163      TObject* t_l = strat->R[L->i_r];
6164      assume(t_l != NULL);
6165      L->tailRing = new_tailRing;
6166      L->p = t_l->p;
6167      L->t_p = t_l->t_p;
6168      L->max = t_l->max;
6169    }
6170  }
6171
6172  if (T != NULL && T->tailRing != new_tailRing && T->i_r < 0)
6173    T->ShallowCopyDelete(new_tailRing, new_tailBin, p_shallow_copy_delete);
6174
6175  omMergeStickyBinIntoBin(strat->tailBin, strat->tailRing->PolyBin);
6176  if (strat->tailRing != currRing)
6177    rKillModifiedRing(strat->tailRing);
6178
6179  strat->tailRing = new_tailRing;
6180  strat->tailBin = new_tailBin;
6181  strat->p_shallow_copy_delete
6182    = pGetShallowCopyDeleteProc(currRing, new_tailRing);
6183
6184  if (strat->kHEdge != NULL)
6185  {
6186    if (strat->t_kHEdge != NULL)
6187      p_LmFree(strat->t_kHEdge, strat->tailRing);
6188    strat->t_kHEdge=k_LmInit_currRing_2_tailRing(strat->kHEdge, new_tailRing);
6189  }
6190
6191  if (strat->kNoether != NULL)
6192  {
6193    if (strat->t_kNoether != NULL)
6194      p_LmFree(strat->t_kNoether, strat->tailRing);
6195    strat->t_kNoether=k_LmInit_currRing_2_tailRing(strat->kNoether,
6196                                                   new_tailRing);
6197  }
6198  kTest_TS(strat);
6199  if (TEST_OPT_PROT)
6200    PrintS("]");
6201  return TRUE;
6202}
6203
6204void kStratInitChangeTailRing(kStrategy strat)
6205{
6206  unsigned long l = 0;
6207  int i;
6208  Exponent_t e;
6209  ring new_tailRing;
6210
6211  assume(strat->tailRing == currRing);
6212
6213  for (i=0; i<= strat->Ll; i++)
6214  {
6215    l = p_GetMaxExpL(strat->L[i].p, currRing, l);
6216  }
6217  for (i=0; i<=strat->tl; i++)
6218  {
6219    // Hmm ... this we could do in one Step
6220    l = p_GetMaxExpL(strat->T[i].p, currRing, l);
6221  }
6222  if (rField_is_Ring(currRing))
6223  {
6224    l *= 2;
6225  }
6226  e = p_GetMaxExp(l, currRing);
6227  if (e <= 1) e = 2;
6228
6229  kStratChangeTailRing(strat, NULL, NULL, e);
6230}
6231
6232skStrategy::skStrategy()
6233{
6234  memset(this, 0, sizeof(skStrategy));
6235#ifndef NDEBUG
6236  strat_nr++;
6237  nr=strat_nr;
6238  if (strat_fac_debug) Print("s(%d) created\n",nr);
6239#endif
6240  tailRing = currRing;
6241  P.tailRing = currRing;
6242  tl = -1;
6243  sl = -1;
6244#ifdef HAVE_LM_BIN
6245  lmBin = omGetStickyBinOfBin(currRing->PolyBin);
6246#endif
6247#ifdef HAVE_TAIL_BIN
6248  tailBin = omGetStickyBinOfBin(currRing->PolyBin);
6249#endif
6250  pOrigFDeg = pFDeg;
6251  pOrigLDeg = pLDeg;
6252}
6253
6254
6255skStrategy::~skStrategy()
6256{
6257  if (lmBin != NULL)
6258    omMergeStickyBinIntoBin(lmBin, currRing->PolyBin);
6259  if (tailBin != NULL)
6260    omMergeStickyBinIntoBin(tailBin,
6261                            (tailRing != NULL ? tailRing->PolyBin:
6262                             currRing->PolyBin));
6263  if (t_kHEdge != NULL)
6264    p_LmFree(t_kHEdge, tailRing);
6265  if (t_kNoether != NULL)
6266    p_LmFree(t_kNoether, tailRing);
6267
6268  if (currRing != tailRing)
6269    rKillModifiedRing(tailRing);
6270  pRestoreDegProcs(pOrigFDeg, pOrigLDeg);
6271}
6272
6273#if 0
6274Timings for the different possibilities of posInT:
6275            T15           EDL         DL          EL            L         1-2-3
6276Gonnet      43.26       42.30       38.34       41.98       38.40      100.04
6277Hairer_2_1   1.11        1.15        1.04        1.22        1.08        4.7
6278Twomat3      1.62        1.69        1.70        1.65        1.54       11.32
6279ahml         4.48        4.03        4.03        4.38        4.96       26.50
6280c7          15.02       13.98       15.16       13.24       17.31       47.89
6281c8         505.09      407.46      852.76      413.21      499.19        n/a
6282f855        12.65        9.27       14.97        8.78       14.23       33.12
6283gametwo6    11.47       11.35       14.57       11.20       12.02       35.07
6284gerhard_3    2.73        2.83        2.93        2.64        3.12        6.24
6285ilias13     22.89       22.46       24.62       20.60       23.34       53.86
6286noon8       40.68       37.02       37.99       36.82       35.59      877.16
6287rcyclic_19  48.22       42.29       43.99       45.35       51.51      204.29
6288rkat9       82.37       79.46       77.20       77.63       82.54      267.92
6289schwarz_11  16.46       16.81       16.76       16.81       16.72       35.56
6290test016     16.39       14.17       14.40       13.50       14.26       34.07
6291test017     34.70       36.01       33.16       35.48       32.75       71.45
6292test042     10.76       10.99       10.27       11.57       10.45       23.04
6293test058      6.78        6.75        6.51        6.95        6.22        9.47
6294test066     10.71       10.94       10.76       10.61       10.56       19.06
6295test073     10.75       11.11       10.17       10.79        8.63       58.10
6296test086     12.23       11.81       12.88       12.24       13.37       66.68
6297test103      5.05        4.80        5.47        4.64        4.89       11.90
6298test154     12.96       11.64       13.51       12.46       14.61       36.35
6299test162     65.27       64.01       67.35       59.79       67.54      196.46
6300test164      7.50        6.50        7.68        6.70        7.96       17.13
6301virasoro     3.39        3.50        3.35        3.47        3.70        7.66
6302#endif
6303
6304
6305#ifdef HAVE_MORE_POS_IN_T
6306// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
6307int posInT_EcartFDegpLength(const TSet set,const int length,LObject &p)
6308{
6309
6310  if (length==-1) return 0;
6311
6312  int o = p.ecart;
6313  int op=p.GetpFDeg();
6314  int ol = p.GetpLength();
6315
6316  if (set[length].ecart < o)
6317    return length+1;
6318  if (set[length].ecart == o)
6319  {
6320     int oo=set[length].GetpFDeg();
6321     if ((oo < op) || ((oo==op) && (set[length].length < ol)))
6322       return length+1;
6323  }
6324
6325  int i;
6326  int an = 0;
6327  int en= length;
6328  loop
6329  {
6330    if (an >= en-1)
6331    {
6332      if (set[an].ecart > o)
6333        return an;
6334      if (set[an].ecart == o)
6335      {
6336         int oo=set[an].GetpFDeg();
6337         if((oo > op)
6338         || ((oo==op) && (set[an].pLength > ol)))
6339           return an;
6340      }
6341      return en;
6342    }
6343    i=(an+en) / 2;
6344    if (set[i].ecart > o)
6345      en=i;
6346    else if (set[i].ecart == o)
6347    {
6348       int oo=set[i].GetpFDeg();
6349       if ((oo > op)
6350       || ((oo == op) && (set[i].pLength > ol)))
6351         en=i;
6352       else
6353        an=i;
6354    }
6355    else
6356      an=i;
6357  }
6358}
6359
6360// determines the position based on: 1.) FDeg 2.) pLength
6361int posInT_FDegpLength(const TSet set,const int length,LObject &p)
6362{
6363
6364  if (length==-1) return 0;
6365
6366  int op=p.GetpFDeg();
6367  int ol = p.GetpLength();
6368
6369  int oo=set[length].GetpFDeg();
6370  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
6371    return length+1;
6372
6373  int i;
6374  int an = 0;
6375  int en= length;
6376  loop
6377    {
6378      if (an >= en-1)
6379      {
6380        int oo=set[an].GetpFDeg();
6381        if((oo > op)
6382           || ((oo==op) && (set[an].pLength > ol)))
6383          return an;
6384        return en;
6385      }
6386      i=(an+en) / 2;
6387      int oo=set[i].GetpFDeg();
6388      if ((oo > op)
6389          || ((oo == op) && (set[i].pLength > ol)))
6390        en=i;
6391      else
6392        an=i;
6393    }
6394}
6395
6396
6397// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
6398int posInT_pLength(const TSet set,const int length,LObject &p)
6399{
6400  if (length==-1)
6401    return 0;
6402  if (set[length].length<p.length)
6403    return length+1;
6404
6405  int i;
6406  int an = 0;
6407  int en= length;
6408  int ol = p.GetpLength();
6409
6410  loop
6411  {
6412    if (an >= en-1)
6413    {
6414      if (set[an].pLength>ol) return an;
6415      return en;
6416    }
6417    i=(an+en) / 2;
6418    if (set[i].pLength>ol) en=i;
6419    else                        an=i;
6420  }
6421}
6422#endif
6423
6424#ifdef HAVE_SHIFTBBA
6425poly pMove2CurrTail(poly p, kStrategy strat)
6426{
6427  /* assume: p is completely in currRing */
6428  /* produces an object with LM in curring
6429     and TAIL in tailring */
6430  if (pNext(p)!=NULL)
6431  {
6432    pNext(p) = prMoveR(pNext(p), /* src */ currRing, /* dest */ strat->tailRing);
6433  }
6434  return(p);
6435}
6436#endif
6437
6438#ifdef HAVE_SHIFTBBA
6439poly pMoveCurrTail2poly(poly p, kStrategy strat)
6440{
6441  /* assume: p has  LM in curring and TAIL in tailring */
6442  /* convert it to complete currRing */
6443
6444  /* check that LM is in currRing */
6445  assume(p_LmCheckIsFromRing(p, currRing));
6446
6447  if (pNext(p)!=NULL)
6448  {
6449    pNext(p) = prMoveR(pNext(p), /* src */ strat->tailRing, /* dest */currRing);
6450  }
6451  return(p);
6452}
6453#endif
6454
6455#ifdef HAVE_SHIFTBBA
6456poly pCopyL2p(LObject H, kStrategy strat)
6457{
6458    /* restores a poly in currRing from LObject */
6459    LObject h = H;
6460    h.Copy();
6461    poly p;
6462    if (h.p == NULL)
6463    {
6464      if (h.t_p != NULL)
6465      {
6466         p = prMoveR(h.t_p, /* source ring: */ strat->tailRing, /* dest. ring: */ currRing);
6467        return(p);
6468      }
6469      else
6470      {
6471        /* h.tp == NULL -> the object is NULL */
6472        return(NULL);
6473      }
6474    }
6475    /* we're here if h.p != NULL */
6476    if (h.t_p == NULL)
6477    {
6478       /* then h.p is the whole poly in currRing */
6479       p = h.p;
6480      return(p);
6481    }
6482    /* we're here if h.p != NULL and h.t_p != NULL */
6483    // clean h.p, get poly from t_p
6484     pNext(h.p)=NULL;
6485     pDelete(&h.p);
6486     p = prMoveR(h.t_p, /* source ring: */ strat->tailRing,
6487                         /* dest. ring: */ currRing);
6488     // no need to clean h: we re-used the polys
6489    return(p);
6490}
6491#endif
6492
6493//LObject pCopyp2L(poly p, kStrategy strat)
6494//{
6495    /* creates LObject from the poly in currRing */
6496  /* actually put p into L.p and make L.t_p=NULL : does not work */
6497 
6498//}
6499
6500// poly pCopyL2p(LObject H, kStrategy strat)
6501// {
6502//   /* restores a poly in currRing from LObject */
6503//   LObject h = H;
6504//   h.Copy();
6505//   poly p;
6506//   if (h.p == NULL)
6507//   {
6508//     if (h.t_p != NULL)
6509//     {
6510//       p = p_ShallowCopyDelete(h.t_p, (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
6511//       return(p);
6512//     }
6513//     else
6514//     {
6515//       /* h.tp == NULL -> the object is NULL */
6516//       return(NULL);
6517//     }
6518//   }
6519//   /* we're here if h.p != NULL */
6520
6521//   if (h.t_p == NULL)
6522//   {
6523//     /* then h.p is the whole poly in tailRing */
6524//     if (strat->tailBin != NULL && (pNext(h.p) != NULL))
6525//     {
6526//       p = p_ShallowCopyDelete(h.p, (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
6527//     }
6528//     return(p);
6529//   }
6530//   /* we're here if h.p != NULL and h.t_p != NULL */
6531//   p = pCopy(pHead(h.p)); // in currRing
6532//   if (strat->tailBin != NULL && (pNext(h.p) != NULL))
6533//   {
6534//     //    pNext(p) = p_ShallowCopyDelete(pNext(h.t_p), (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
6535//     poly pp = p_Copy(pNext(h.p), strat->tailRing);
6536//     //    poly p3 = p_Copy(pNext(h.p), currRing); // error
6537//       // p_ShallowCopyDelete(pNext(h.p), currRing, strat->tailBin); // the same as pp
6538//     poly p5 = p_ShallowCopyDelete(pNext(h.p), strat->tailRing, strat->tailBin);
6539//     pNext(p) = p_ShallowCopyDelete(h.t_p, strat->tailRing, strat->tailBin);
6540//     poly p4 = p_Copy(h.t_p, strat->tailRing);
6541//     //    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
6542//   }
6543//   //  pTest(p);
6544//   return(p);
6545// }
6546
6547#ifdef HAVE_SHIFTBBA
6548/* including the self pairs */
6549void updateSShift(kStrategy strat,int uptodeg,int lV)
6550{
6551  /* to use after updateS(toT=FALSE,strat) */
6552  /* fills T with shifted elt's of S */
6553  int i;
6554  LObject h;
6555  int atT = -1; // or figure out smth better
6556  strat->tl = -1; // init
6557  for (i=0; i<=strat->sl; i++)
6558  {
6559    memset(&h,0,sizeof(h));
6560    h.p =  strat->S[i]; // lm in currRing, tail in TR
6561    strat->initEcart(&h);
6562    h.sev = strat->sevS[i];
6563    h.t_p = NULL;
6564    h.GetTP(); // creates correct t_p
6565    /*puts the elements of S with their shifts to T*/
6566    //    int atT, int uptodeg, int lV)
6567    strat->S_2_R[i] = strat->tl + 1; // the el't with shift 0 will be inserted first
6568    // need a small check for above; we insert >=1 elements
6569    // insert this check into kTest_TS ?
6570    enterTShift(h,strat,atT,uptodeg,lV);
6571  }
6572  /* what about setting strat->tl? */
6573}
6574#endif
6575
6576#ifdef HAVE_SHIFTBBA
6577void initBuchMoraShift (ideal F,ideal Q,kStrategy strat)
6578{
6579  strat->interpt = BTEST1(OPT_INTERRUPT);
6580  strat->kHEdge=NULL;
6581  if (pOrdSgn==1) strat->kHEdgeFound=FALSE;
6582  /*- creating temp data structures------------------- -*/
6583  strat->cp = 0;
6584  strat->c3 = 0;
6585  strat->cv = 0;
6586  strat->tail = pInit();
6587  /*- set s -*/
6588  strat->sl = -1;
6589  /*- set L -*/
6590  strat->Lmax = setmaxL;
6591  strat->Ll = -1;
6592  strat->L = initL();
6593  /*- set B -*/
6594  strat->Bmax = setmaxL;
6595  strat->Bl = -1;
6596  strat->B = initL();
6597  /*- set T -*/
6598  strat->tl = -1;
6599  strat->tmax = setmaxT;
6600  strat->T = initT();
6601  strat->R = initR();
6602  strat->sevT = initsevT();
6603  /*- init local data struct.---------------------------------------- -*/
6604  strat->P.ecart=0;
6605  strat->P.length=0;
6606  if (pOrdSgn==-1)
6607  {
6608    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
6609    if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
6610  }
6611  if(TEST_OPT_SB_1)
6612  {
6613    int i;
6614    ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
6615    for (i=strat->newIdeal;i<IDELEMS(F);i++)
6616    {
6617      P->m[i-strat->newIdeal] = F->m[i];
6618      F->m[i] = NULL;
6619    }
6620    initSSpecial(F,Q,P,strat);
6621    for (i=strat->newIdeal;i<IDELEMS(F);i++)
6622    {
6623      F->m[i] = P->m[i-strat->newIdeal];
6624      P->m[i-strat->newIdeal] = NULL;
6625    }
6626    idDelete(&P);
6627  }
6628  else
6629  {
6630    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
6631    // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
6632  }
6633  strat->kIdeal = NULL;
6634  strat->fromT = FALSE;
6635  strat->noTailReduction = !TEST_OPT_REDTAIL;
6636  if (!TEST_OPT_SB_1)
6637  {
6638    /* the only change: we do not fill the set T*/
6639    updateS(FALSE,strat);
6640  }
6641  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
6642  strat->fromQ=NULL;
6643  /* more changes: fill the set T with all the shifts of elts of S*/
6644  /* is done by other procedure */
6645}
6646#endif
6647
6648#ifdef HAVE_SHIFTBBA
6649/*1
6650* put the pairs (sh \dot s[i],p)  into the set B, ecart=ecart(p)
6651*/
6652void enterOnePairManyShifts (int i, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int uptodeg, int lV)
6653{
6654  /* p comes from strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
6655
6656  assume(p_LmCheckIsFromRing(p,currRing));
6657  assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
6658
6659  /* cycles through all shifts of s[i] until uptodeg - lastVblock(s[i]) */
6660  /* that is create the pairs (f, s \dot g)  */
6661
6662  poly qq = strat->S[i]; //  lm in currRing, tail in tailRing
6663
6664  //  poly q = pCopy(pHead(strat->S[i])); // lm in currRing
6665  //  pNext(q) = prCopyR(pNext(strat->S[i]),strat->tailRing,currRing); // zero shift
6666
6667 /* determine how many elements we have to insert for a given s[i] */
6668  /* x(0)y(1)z(2) : lastVblock-1=2, to add until lastVblock=uptodeg-1 */
6669  /* hence, a total number of elt's to add is: */
6670  /*  int toInsert = 1 + (uptodeg-1) - (pLastVblock(p.p, lV) -1);  */
6671  int toInsert =  itoInsert(qq, uptodeg,  lV, strat->tailRing);
6672
6673#ifdef KDEBUG
6674    if (TEST_OPT_DEBUG)
6675    {
6676      //      Print("entered ManyShifts: with toInsert=%d",toInsert); PrintLn();
6677    }
6678#endif
6679
6680  assume(i<=strat->sl); // from OnePair
6681  if (strat->interred_flag) return; // ?
6682
6683  /* these vars hold for all shifts of s[i] */
6684  int ecartq = 0; //Hans says it's ok; we're in the homog case, no ecart
6685 
6686  int qfromQ;
6687  if (strat->fromQ != NULL)
6688  {
6689    qfromQ = strat->fromQ[i]; 
6690  }
6691  else
6692  {
6693    qfromQ = -1;
6694  }
6695
6696  int j;
6697
6698  poly q, s;
6699
6700  // for the 0th shift: insert the orig. pair
6701  enterOnePairShift(qq, p, ecart, isFromQ, strat, -1, ecartq, qfromQ, j, i, uptodeg, lV);
6702
6703  for (j=1; j<= toInsert; j++) 
6704  {
6705    //    q = pLPshift(strat->S[i],j,uptodeg,lV);
6706    q = p_LPshiftT(qq, j, uptodeg, lV, strat, currRing); 
6707    //    q = p_mLPshift(qq,j,uptodeg,lV,currRing); // lm in currRing, shift this monomial
6708    //    s = p_LPshift(pNext(qq), j, uptodeg, lV, strat->tailRing); // from tailRing
6709    //    pNext(q) = s; // in tailRing
6710    /* here we need to call enterOnePair with two polys ... */
6711
6712#ifdef KDEBUG
6713    if (TEST_OPT_DEBUG)
6714    {
6715      //      PrintS("ManyShifts: calling enterOnePairShift(q,p)");      PrintLn();
6716    }
6717#endif
6718    enterOnePairShift(q, p, ecart, isFromQ, strat, -1, ecartq, qfromQ, j, i, uptodeg, lV);
6719  }
6720}
6721#endif
6722
6723#ifdef HAVE_SHIFTBBA
6724/*1
6725* put the pairs (sh \dot qq,p)  into the set B, ecart=ecart(p)
6726* despite the name, not only self shifts
6727*/
6728void enterOnePairSelfShifts (poly qq, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int uptodeg, int lV)
6729{
6730
6731  /* format: p,qq are in LObject form: lm in CR, tail in TR */
6732  /* for true self pairs qq ==p  */
6733  /* we test both qq and p */
6734  assume(p_LmCheckIsFromRing(qq,currRing));
6735  assume(p_CheckIsFromRing(pNext(qq),strat->tailRing));
6736  assume(p_LmCheckIsFromRing(p,currRing));
6737  assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
6738
6739  /* since this proc is applied twice for (h, s*g) and (g,s*h), init j with 1 only */
6740
6741  //  int j = 0;
6742  int j = 1;
6743
6744  /* for such self pairs start with 1, not with 0 */
6745  if (qq == p) j=1;
6746
6747  /* should cycle through all shifts of q until uptodeg - lastVblock(q) */
6748  /* that is create the pairs (f, s \dot g)  */
6749
6750  int toInsert =  itoInsert(qq, uptodeg,  lV, strat->tailRing);
6751
6752#ifdef KDEBUG
6753    if (TEST_OPT_DEBUG)
6754    {
6755      //      Print("entered SelfShifts: with toInsert=%d",toInsert); PrintLn();
6756    }
6757#endif
6758
6759  poly q, s;
6760
6761  if (strat->interred_flag) return; // ?
6762
6763  /* these vars hold for all shifts of s[i] */
6764  int ecartq = 0; //Hans says it's ok; we're in the homog case, no ecart
6765  int qfromQ = 0; // strat->fromQ[i];
6766
6767  for (; j<= toInsert; j++)
6768  {
6769    //    q = pLPshift(strat->S[i],j,uptodeg,lV);
6770    /* we increase shifts by one; must delete q there*/
6771    //    q = qq; q = pMoveCurrTail2poly(q,strat);
6772    //    q = pLPshift(q,j,uptodeg,lV); //,currRing);
6773    q = p_LPshiftT(qq, j, uptodeg, lV, strat, currRing);
6774    //    q = p_mLPshift(qq,j,uptodeg,lV,currRing); // lm in currRing, shift this monomial
6775    //    s = p_LPshift(pNext(qq), j, uptodeg, lV, strat->tailRing); // from tailRing
6776    //    pNext(q) = s; // in tailRing
6777    /* here we need to call enterOnePair with two polys ... */
6778#ifdef KDEBUG
6779    if (TEST_OPT_DEBUG)
6780    {
6781      //      PrintS("SelfShifts: calling enterOnePairShift(q,p)");      PrintLn();
6782    }
6783#endif
6784    enterOnePairShift(q, p, ecart, isFromQ, strat, -1, ecartq, qfromQ, j, -1, uptodeg, lV);
6785  }
6786}
6787#endif
6788
6789#ifdef HAVE_SHIFTBBA
6790/*2
6791* put the pair (q,p)  into the set B, ecart=ecart(p), q is the shift of some s[i]
6792*/
6793void 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)
6794{
6795
6796  /* Format: q and p are like strat->P.p, so lm in CR, tail in TR */
6797
6798  /* check this Formats: */
6799  assume(p_LmCheckIsFromRing(q,currRing));
6800  assume(p_CheckIsFromRing(pNext(q),strat->tailRing));
6801  assume(p_LmCheckIsFromRing(p,currRing));
6802  assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
6803
6804#ifdef KDEBUG
6805    if (TEST_OPT_DEBUG)
6806    {
6807//       PrintS("enterOnePairShift(q,p) invoked with q = ");
6808//       wrp(q); //      wrp(pHead(q));
6809//       PrintS(", p = ");
6810//       wrp(p); //wrp(pHead(p));
6811//       PrintLn();
6812    }
6813#endif
6814
6815  /* poly q stays for s[i], ecartq = ecart(q), qisFromQ = applies to q */
6816
6817  int qfromQ = qisFromQ;
6818
6819  /* need additionally: int up_to_degree, poly V0 with the variables in (0)  or just the number lV = the length of the first block */
6820
6821  if (strat->interred_flag) return;
6822
6823  int      l,j,compare;
6824  LObject  Lp;
6825  Lp.i_r = -1;
6826
6827#ifdef KDEBUG
6828  Lp.ecart=0; Lp.length=0;
6829#endif
6830  /*- computes the lcm(s[i],p) -*/
6831  Lp.lcm = pInit();
6832
6833  pLcm(p,q, Lp.lcm); // q is what was strat->S[i], so a poly in LM/TR presentation
6834  pSetm(Lp.lcm);
6835
6836  /* apply the V criterion */
6837  if (!isInV(Lp.lcm, lV))
6838  {
6839#ifdef KDEBUG
6840    if (TEST_OPT_DEBUG)
6841    {
6842      PrintS("V crit applied to q = ");
6843      wrp(q); //      wrp(pHead(q));
6844      PrintS(", p = ");
6845      wrp(p); //wrp(pHead(p));
6846      PrintLn();
6847    }
6848#endif
6849    pLmFree(Lp.lcm);
6850    Lp.lcm=NULL;
6851    /* + counter for applying the V criterion */
6852    strat->cv++;
6853    return;
6854  }
6855
6856  const BOOLEAN bIsPluralRing = rIsPluralRing(currRing);
6857  const BOOLEAN bIsSCA        = rIsSCA(currRing) && strat->z2homog; // for prod-crit
6858  const BOOLEAN bNCProdCrit   = ( !bIsPluralRing || bIsSCA ); // commutative or homogeneous SCA
6859
6860  if (strat->sugarCrit && bNCProdCrit)
6861  {
6862    if((!((ecartq>0)&&(ecart>0)))
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 divides lcm(s,r)
6870    *(==> the leading term of p divides the leading term of r)
6871    *but the leading term of s does not divide the leading term of r
6872    *(notice that this condition is automatically satisfied if r is still
6873    *in S), then (s,r) can be cancelled.
6874    *This should be done here because the
6875    *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
6876    *
6877    *Moreover, skipping (s,r) holds also for the noncommutative case.
6878    */
6879      strat->cp++;
6880      pLmFree(Lp.lcm);
6881      Lp.lcm=NULL;
6882      return;
6883    }
6884    else
6885      Lp.ecart = si_max(ecart,ecartq);
6886    if (strat->fromT && (ecartq>ecart))
6887    {
6888      pLmFree(Lp.lcm);
6889      Lp.lcm=NULL;
6890      return;
6891      /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
6892    }
6893    /*
6894    *the set B collects the pairs of type (S[j],p)
6895    *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
6896    *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
6897    *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
6898    */
6899    {
6900      j = strat->Bl;
6901      loop
6902      {
6903        if (j < 0)  break;
6904        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
6905        if ((compare==1)
6906        &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
6907        {
6908          strat->c3++;
6909          if ((strat->fromQ==NULL) || (isFromQ==0) || (qfromQ==0))
6910          {
6911            pLmFree(Lp.lcm);
6912            return;
6913          }
6914          break;
6915        }
6916        else
6917        if ((compare ==-1)
6918        && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
6919        {
6920          deleteInL(strat->B,&strat->Bl,j,strat);
6921          strat->c3++;
6922        }
6923        j--;
6924      }
6925    }
6926  }
6927  else /*sugarcrit*/
6928  {
6929    if (bNCProdCrit)
6930    {
6931      // if currRing->nc_type!=quasi (or skew)
6932      // TODO: enable productCrit for super commutative algebras...
6933      if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
6934      pHasNotCF(p,q))
6935      {
6936      /*
6937      *the product criterion has applied for (s,p),
6938      *i.e. lcm(s,p)=product of the leading terms of s and p.
6939      *Suppose (s,r) is in L and the leading term
6940      *of p devides lcm(s,r)
6941      *(==> the leading term of p devides the leading term of r)
6942      *but the leading term of s does not devide the leading term of r
6943      *(notice that tis condition is automatically satisfied if r is still
6944      *in S), then (s,r) can be canceled.
6945      *This should be done here because the
6946      *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
6947      */
6948          strat->cp++;
6949          pLmFree(Lp.lcm);
6950          Lp.lcm=NULL;
6951          return;
6952      }
6953      if (strat->fromT && (ecartq>ecart))
6954      {
6955        pLmFree(Lp.lcm);
6956        Lp.lcm=NULL;
6957        return;
6958        /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
6959      }
6960      /*
6961      *the set B collects the pairs of type (S[j],p)
6962      *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
6963      *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
6964      *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
6965      */
6966      for(j = strat->Bl;j>=0;j--)
6967      {
6968        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
6969        if (compare==1)
6970        {
6971          strat->c3++;
6972          if ((strat->fromQ==NULL) || (isFromQ==0) || (qfromQ==0))
6973          {
6974            pLmFree(Lp.lcm);
6975            return;
6976          }
6977          break;
6978        }
6979        else
6980        if (compare ==-1)
6981        {
6982          deleteInL(strat->B,&strat->Bl,j,strat);
6983          strat->c3++;
6984        }
6985      }
6986    }
6987  }
6988  /*
6989  *the pair (S[i],p) enters B if the spoly != 0
6990  */
6991  /*-  compute the short s-polynomial -*/
6992  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
6993    pNorm(p);
6994  if ((q==NULL) || (p==NULL))
6995    return;
6996  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (qfromQ!=0))
6997    Lp.p=NULL;
6998  else
6999  {
7000//     if ( bIsPluralRing )
7001//     {
7002//       if(pHasNotCF(p, q))
7003//       {
7004//         if(ncRingType(currRing) == nc_lie)
7005//         {
7006//             // generalized prod-crit for lie-type
7007//             strat->cp++;
7008//             Lp.p = nc_p_Bracket_qq(pCopy(p),q);
7009//         }
7010//         else
7011//         if( bIsSCA )
7012//         {
7013//             // product criterion for homogeneous case in SCA
7014//             strat->cp++;
7015//             Lp.p = NULL;
7016//         }
7017//         else
7018//           Lp.p = nc_CreateSpoly(q,p,currRing); // ?
7019//       }
7020//       else  Lp.p = nc_CreateSpoly(q,p,currRing);
7021//     }
7022//     else
7023//     {
7024   
7025    /* ksCreateShortSpoly needs two Lobject-kind presentations */
7026    /* p is already in this form, so convert q */
7027    //    q = pMove2CurrTail(q, strat);
7028    Lp.p = ksCreateShortSpoly(q, p, strat->tailRing);
7029      //  }
7030  }
7031  if (Lp.p == NULL)
7032  {
7033    /*- the case that the s-poly is 0 -*/
7034    /* TEMPORARILY DISABLED FOR SHIFTS because there is no i*/
7035//      if (strat->pairtest==NULL) initPairtest(strat);
7036//      strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
7037//      strat->pairtest[strat->sl+1] = TRUE;
7038    /* END _ TEMPORARILY DISABLED FOR SHIFTS */
7039    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
7040    /*
7041    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
7042    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
7043    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
7044    *term of p devides the lcm(s,r)
7045    *(this canceling should be done here because
7046    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
7047    *the first case is handeled in chainCrit
7048    */
7049    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
7050  }
7051  else
7052  {
7053    /*- the pair (S[i],p) enters B -*/
7054    /* both of them should have their LM in currRing and TAIL in tailring */
7055    Lp.p1 = q;  // already in the needed form
7056    Lp.p2 = p; // already in the needed form
7057
7058    if ( !bIsPluralRing )
7059      pNext(Lp.p) = strat->tail;
7060
7061    /* TEMPORARILY DISABLED FOR SHIFTS because there's no i*/
7062    /* at the beginning we DO NOT set atR = -1 ANYMORE*/
7063    if ( (atR >= 0) && (shiftcount==0) && (ifromS >=0) )
7064    {
7065      Lp.i_r1 = kFindInT(Lp.p1,strat); //strat->S_2_R[ifromS];
7066      Lp.i_r2 = atR;
7067    }
7068    else
7069    {
7070      /* END _ TEMPORARILY DISABLED FOR SHIFTS */
7071      Lp.i_r1 = -1;
7072      Lp.i_r2 = -1;
7073     }
7074    strat->initEcartPair(&Lp,q,p,ecartq,ecart);
7075
7076    if (TEST_OPT_INTSTRATEGY)
7077    {
7078      if (!bIsPluralRing)
7079        nDelete(&(Lp.p->coef));
7080    }
7081
7082    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
7083    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
7084  }
7085}
7086#endif
7087
7088#ifdef HAVE_SHIFTBBA
7089/*2
7090*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
7091*superfluous elements in S will be deleted
7092*/
7093void enterpairsShift (poly h,int k,int ecart,int pos,kStrategy strat, int atR,int uptodeg, int lV)
7094{
7095  /* h is strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
7096  /* Q: what is exactly the strat->fromT ? A: a local case trick; don't need it yet*/
7097  int j=pos;
7098
7099#ifdef HAVE_RINGS
7100  assume (!rField_is_Ring(currRing));
7101#endif
7102  initenterpairsShift(h,k,ecart,0,strat, atR,uptodeg,lV);
7103  if ( (!strat->fromT)
7104  && ((strat->syzComp==0)
7105    ||(pGetComp(h)<=strat->syzComp)))
7106  {
7107    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
7108    unsigned long h_sev = pGetShortExpVector(h);
7109    loop
7110    {
7111      if (j > k) break;
7112      clearS(h,h_sev, &j,&k,strat);
7113      j++;
7114    }
7115    //Print("end clearS sl=%d\n",strat->sl);
7116  }
7117 // PrintS("end enterpairs\n");
7118}
7119#endif
7120
7121#ifdef HAVE_SHIFTBBA
7122/*3
7123*(s[0], s \dot h),...,(s[k],s \dot h) will be put to the pairset L
7124* also the pairs (h, s\dot s[0]), ..., (h, s\dot s[k]) enter L
7125* additionally we put the pairs (h, s \sdot h) for s>=1 to L
7126*/
7127void initenterpairsShift (poly h,int k,int ecart,int isFromQ, kStrategy strat, int atR, int uptodeg, int lV)
7128{
7129  /* h comes from strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
7130  //  atR = -1;
7131  if ((strat->syzComp==0)
7132  || (pGetComp(h)<=strat->syzComp))
7133  {
7134    int j;
7135    BOOLEAN new_pair=FALSE;
7136
7137    if (pGetComp(h)==0)
7138    {
7139      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
7140      if ((isFromQ)&&(strat->fromQ!=NULL))
7141      {
7142        for (j=0; j<=k; j++)
7143        {
7144          if (!strat->fromQ[j])
7145          {
7146            new_pair=TRUE;
7147            enterOnePairManyShifts(j,h,ecart,isFromQ,strat, atR,uptodeg,lV);
7148            // other side pairs:
7149            enterOnePairSelfShifts(h,strat->S[j],ecart,isFromQ,strat, atR,uptodeg,lV);
7150          //Print("j:%d, Ll:%d\n",j,strat->Ll);
7151          }
7152        }
7153      }
7154      else
7155      {
7156        new_pair=TRUE;
7157        for (j=0; j<=k; j++)
7158        {
7159          enterOnePairManyShifts(j,h,ecart,isFromQ,strat, atR,uptodeg,lV);
7160          // other side pairs
7161          enterOnePairSelfShifts(h,strat->S[j],ecart,isFromQ,strat, atR,uptodeg,lV);
7162        }
7163        /* HERE we put (h, s*h) pairs */
7164       /* enterOnePairSelfShifts (poly qq, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int uptodeg, int lV); */
7165       enterOnePairSelfShifts (h, h, ecart, isFromQ, strat, atR, uptodeg, lV);
7166      }
7167    }
7168    else
7169    {
7170      for (j=0; j<=k; j++)
7171      {
7172        if ((pGetComp(h)==pGetComp(strat->S[j]))
7173        || (pGetComp(strat->S[j])==0))
7174        {
7175          new_pair=TRUE;
7176          enterOnePairManyShifts(j,h,ecart,isFromQ,strat, atR, uptodeg, lV);
7177          // other side pairs
7178          enterOnePairSelfShifts(h,strat->S[j],ecart,isFromQ,strat, atR,uptodeg,lV);
7179        //Print("j:%d, Ll:%d\n",j,strat->Ll);
7180        }
7181      }
7182      /* HERE we put (h, s*h) pairs */
7183      enterOnePairSelfShifts (h, h, ecart, isFromQ, strat, atR, uptodeg, lV);
7184    }
7185
7186    if (new_pair)
7187    {
7188#ifdef HAVE_PLURAL
7189      if (currRing->real_var_start>0)
7190        chainCritPart(h,ecart,strat);
7191      else
7192#endif
7193      chainCrit(h,ecart,strat);
7194    }
7195
7196  }
7197}
7198#endif
7199
7200#ifdef HAVE_SHIFTBBA
7201/*2
7202* puts p to the set T, starting with the at position atT
7203* and inserts all admissible shifts of p
7204*/
7205void enterTShift(LObject p, kStrategy strat, int atT, int uptodeg, int lV)
7206{
7207  /* determine how many elements we have to insert */
7208  /* x(0)y(1)z(2) : lastVblock-1=2, to add until lastVblock=uptodeg-1 */
7209  /* hence, a total number of elt's to add is: */
7210  /*  int toInsert = 1 + (uptodeg-1) - (pLastVblock(p.p, lV) -1);  */
7211
7212  int toInsert =  itoInsert(p.p, uptodeg,  lV, strat->tailRing);
7213
7214#ifdef PDEBUG
7215  //  Print("enterTShift uses toInsert: %d", toInsert);  PrintLn();
7216#endif
7217  int i;
7218
7219  if (atT < 0)
7220    atT = strat->posInT(strat->T, strat->tl, p);
7221 
7222  /* can call enterT in a sequence, e.g. */
7223
7224  /* shift0 = it's our model for further shifts */
7225  enterT(p,strat,atT);
7226  LObject qq;
7227  for (i=1; i<=toInsert; i++) // toIns - 1?
7228  {
7229    qq      = p; //qq.Copy();
7230    qq.p    = NULL; 
7231    qq.max  = NULL;
7232    qq.t_p = p_LPshift(p_Copy(p.t_p,strat->tailRing), i, uptodeg, lV, strat->tailRing); // direct shift
7233    qq.GetP();
7234    // update q.sev
7235    qq.sev = pGetShortExpVector(qq.p);
7236    /* enter it into T, first el't is with the shift 0 */
7237    // compute the position for qq
7238    atT = strat->posInT(strat->T, strat->tl, qq);
7239    enterT(qq,strat,atT);
7240  }
7241/* Q: what to do with this one in the orig enterT ? */
7242/*  strat->R[strat->tl] = &(strat->T[atT]); */
7243/* Solution: it is done by enterT each time separately */
7244}
7245#endif
7246
7247#ifdef HAVE_SHIFTBBA
7248poly redtailBbaShift (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
7249{
7250  /* for the shift case need to run it with withT = TRUE */
7251  strat->redTailChange=FALSE;
7252  if (strat->noTailReduction) return L->GetLmCurrRing();
7253  poly h, p;
7254  p = h = L->GetLmTailRing();
7255  if ((h==NULL) || (pNext(h)==NULL))
7256    return L->GetLmCurrRing();
7257
7258  TObject* With;
7259  // placeholder in case strat->tl < 0
7260  TObject  With_s(strat->tailRing);
7261
7262  LObject Ln(pNext(h), strat->tailRing);
7263  Ln.pLength = L->GetpLength() - 1;
7264
7265  pNext(h) = NULL;
7266  if (L->p != NULL) pNext(L->p) = NULL;
7267  L->pLength = 1;
7268
7269  Ln.PrepareRed(strat->use_buckets);
7270
7271  while(!Ln.IsNull())
7272  {
7273    loop
7274    {
7275      Ln.SetShortExpVector();
7276      if (withT)
7277      {
7278        int j;
7279        j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
7280        if (j < 0) break;
7281        With = &(strat->T[j]);
7282      }
7283      else
7284      {
7285        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
7286        if (With == NULL) break;
7287      }
7288      if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
7289      {
7290        With->pNorm();
7291        //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
7292      }
7293      strat->redTailChange=TRUE;
7294      if (ksReducePolyTail(L, With, &Ln))
7295      {
7296        // reducing the tail would violate the exp bound
7297        //  set a flag and hope for a retry (in bba)
7298        strat->completeReduce_retry=TRUE;
7299        do
7300        {
7301          pNext(h) = Ln.LmExtractAndIter();
7302          pIter(h);
7303          L->pLength++;
7304        } while (!Ln.IsNull());
7305        goto all_done;
7306      }
7307      if (Ln.IsNull()) goto all_done;
7308      if (! withT) With_s.Init(currRing);
7309    }
7310    pNext(h) = Ln.LmExtractAndIter();
7311    pIter(h);
7312    L->pLength++;
7313  }
7314
7315  all_done:
7316  Ln.Delete();
7317  if (L->p != NULL) pNext(L->p) = pNext(p);
7318
7319  if (strat->redTailChange)
7320  {
7321    L->last = NULL;
7322    L->length = 0;
7323  }
7324  L->Normalize(); // HANNES: should have a test
7325  kTest_L(L);
7326  return L->GetLmCurrRing();
7327}
7328#endif
Note: See TracBrowser for help on using the repository browser.