source: git/kernel/kutil.cc @ 59c445

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