source: git/kernel/kutil.cc @ 79d3879

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