source: git/Singular/kutil.cc @ 5ecf042

spielwiese
Last change on this file since 5ecf042 was 5ecf042, checked in by Olaf Bachmann <obachman@…>, 23 years ago
* LIB: some categoy changes * libparse: added -c option * reimplementation of reing dpenendent options (put to ring->options) git-svn-id: file:///usr/local/Singular/svn/trunk@4952 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 102.2 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kutil.cc,v 1.87 2000-12-19 18:31:41 obachman Exp $ */
5/*
6* ABSTRACT: kernel: utils for kStd
7*/
8
9#ifndef KUTIL_CC
10#define KUTIL_CC
11
12// #define PDEBUG 2
13// #define PDIV_DEBUG
14#include <limits.h>
15#include <stdlib.h>
16#include <string.h>
17#include "mod2.h"
18#ifdef KDEBUG
19#undef KDEBUG
20#define KDEBUG 2
21#endif
22
23// define if enterL, enterT should use memmove instead of doing it manually
24// on topgun, this is slightly faster (see monodromy_l.tst, homog_gonnet.sing)
25#define ENTER_USE_MEMMOVE
26
27// define, if the my_memmove inlines should be used instead of
28// system memmove -- it does not seem to pay off, though
29// #define ENTER_USE_MYMEMMOVE
30
31#include "tok.h"
32#include "kutil.h"
33#include "febase.h"
34#include "omalloc.h"
35#include "numbers.h"
36#include "polys.h"
37#include "ring.h"
38#include "ideals.h"
39#include "timer.h"
40#include "cntrlc.h"
41#include "stairc.h"
42#include "subexpr.h"
43#include "kstd1.h"
44#include "pShallowCopyDelete.h"
45
46#ifdef KDEBUG
47#undef KDEBUG
48#define KDEBUG 2
49#endif
50
51#ifdef ENTER_USE_MYMEMMOVE
52inline void _my_memmove_d_gt_s(unsigned long* d, unsigned long* s, long l)
53{
54  register unsigned long* _dl = (unsigned long*) d;
55  register unsigned long* _sl = (unsigned long*) s;
56  register long _i = l - 1;
57
58  do
59  {
60    _dl[_i] = _sl[_i];
61    _i--;
62  }
63  while (_i >= 0);
64}
65
66inline void _my_memmove_d_lt_s(unsigned long* d, unsigned long* s, long l)
67{
68  register long _ll = l;
69  register unsigned long* _dl = (unsigned long*) d;
70  register unsigned long* _sl = (unsigned long*) s;
71  register long _i = 0;
72
73  do
74  {
75    _dl[_i] = _sl[_i];
76    _i++;
77  }
78  while (_i < _ll);
79}
80
81inline void _my_memmove(void* d, void* s, long l)
82{
83  unsigned long _d = (unsigned long) d;
84  unsigned long _s = (unsigned long) s;
85  unsigned long _l = ((l) + SIZEOF_LONG - 1) >> LOG_SIZEOF_LONG;
86
87  if (_d > _s) _my_memmove_d_gt_s(_d, _s, _l);
88  else _my_memmove_d_lt_s(_d, _s, _l);
89}
90
91#undef memmove
92#define memmove(d,s,l) _my_memmove(d, s, l)
93#endif
94
95
96static poly redMora (poly h,int maxIndex,kStrategy strat);
97static poly redBba (poly h,int maxIndex,kStrategy strat);
98
99static inline int pDivComp(poly p, poly q)
100{
101  if (pGetComp(p) == pGetComp(q))
102  {
103    BOOLEAN a=FALSE, b=FALSE;
104    int i;
105    unsigned long la, lb;
106    unsigned long divmask = currRing->divmask;
107    for (i=0; i<currRing->VarL_Size; i++)
108    {
109      la = p->exp[currRing->VarL_Offset[i]];
110      lb = q->exp[currRing->VarL_Offset[i]];
111      if (la != lb)
112      {
113        if (la < lb)
114        {
115          if (b) return 0;
116          if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
117            return 0;
118          a = TRUE;
119        }
120        else
121        {
122          if (a) return 0;
123          if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
124            return 0;
125          b = TRUE;
126        }
127      }
128    }
129    if (a) return 1;
130    if (b) return -1;
131  }
132  return 0;
133}
134
135
136BITSET  test=(BITSET)0;
137int     HCord;
138int     Kstd1_deg;
139int     mu=32000;
140
141/*2
142*deletes higher monomial of p, re-compute ecart and length
143*works only for orderings with ecart =pFDeg(end)-pFDeg(start)
144*/
145void deleteHC(LObject *L, kStrategy strat, BOOLEAN fromNext)
146{
147  if (strat->kHEdgeFound)
148  {
149    kTest_L(L);
150    poly p1;
151    poly p = L->GetLmTailRing();
152    int l = 1;
153    kBucket_pt bucket = NULL;
154    if (L->bucket != NULL)
155    {
156      kBucketClear(L->bucket, &pNext(p), &L->pLength);
157      L->pLength++;
158      bucket = L->bucket;
159      L->bucket = NULL;
160      L->last = NULL;
161    }
162
163    if (!fromNext && p_Cmp(p,strat->kNoether, L->tailRing) == -1)
164    {
165      L->Delete();
166      L->Clear();
167      L->ecart = -1;
168      if (bucket != NULL) kBucketDestroy(&bucket);
169      return;
170    }
171    p1 = p;
172    while (pNext(p1)!=NULL)
173    { 
174      if (p_LmCmp(pNext(p1), strat->kNoether, L->tailRing) == -1)
175      {
176        L->last = p1;
177        p_Delete(&pNext(p1), L->tailRing);
178        if (p1 == p)
179        {
180          if (L->t_p != NULL)
181          {
182            assume(L->p != NULL && p == L->t_p);
183            pNext(L->p) = NULL;
184          }
185        }
186        if (L->pLength != 0) L->pLength = l;
187        // Hmmm when called from updateT, then only
188        // reset ecart when cut
189        if (fromNext)
190          L->ecart = L->pLDeg() - L->GetpFDeg();
191        break;
192      }
193      l++;
194      pIter(p1);
195    }
196    if (! fromNext)
197    {
198      L->SetpFDeg();
199      L->ecart = L->pLDeg(strat->LDegLast) - L->GetpFDeg();
200    }
201    if (bucket != NULL)
202    {
203      if (L->pLength > 1) 
204      {
205        kBucketInit(bucket, pNext(p), L->pLength - 1);
206        pNext(p) = NULL;
207        if (L->t_p != NULL) pNext(L->t_p) = NULL;
208        L->pLength = 0;
209        L->bucket = bucket;
210        L->last = NULL;
211      }
212      else
213        kBucketDestroy(&bucket);
214    }
215    kTest_L(L);
216  }
217}
218
219void deleteHC(poly* p, int* e, int* l,kStrategy strat)
220{
221  LObject L(*p, currRing, strat->tailRing);
222
223  deleteHC(&L, strat);
224  *p = L.p;
225  *e = L.ecart;
226  *l = L.length;
227  if (L.t_p != NULL) p_LmFree(L.t_p, strat->tailRing);
228}
229
230/*2
231*tests if p.p=monomial*unit and cancels the unit
232*/
233void cancelunit (LObject* L)
234{
235  int  i;
236  poly h;
237  ring r = L->tailRing;
238  poly p = L->GetLmTailRing();
239
240  if(p_GetComp(p, r) != 0 && !p_OneComp(p, r)) return;
241
242  if (L->ecart != 0)
243  {
244    for(i=1;i<=r->N;i++)
245    {
246      if ((p_GetExp(p,i,r)>0) && (rIsPolyVar(i, r)==TRUE)) return;
247    }
248    h = pNext(p);
249    loop
250    {
251      if (h==NULL)
252      {
253        p_Delete(&pNext(p), r);
254        L->ecart = 0;
255        L->length = 1;
256        if (L->pLength > 0) L->pLength = 1;
257        if (L->last != NULL) L->last = p;
258
259        if (L->t_p != NULL && pNext(L->t_p) != NULL)
260          pNext(L->t_p) = NULL;
261        if (L->p != NULL && pNext(L->p) != NULL)
262          pNext(L->p) = NULL;
263        return;
264      }
265      i = 0;
266      loop
267      {
268        i++;
269        if (p_GetExp(p,i,r) > p_GetExp(h,i,r)) return ;
270        if (i == r->N) break;
271      }
272      pIter(h);
273    }
274  }
275}
276
277/*2
278*pp is the new element in s
279*returns TRUE (in strat->kHEdgeFound) if
280*-HEcke is allowed
281*-we are in the last componente of the vector
282*-on all axis are monomials (all elements in NotUsedAxis are FALSE)
283*returns FALSE for pLexOrderings,
284*assumes in module case an ordering of type c* !!
285* HEckeTest is only called with strat->kHEdgeFound==FALSE !
286*/
287void HEckeTest (poly pp,kStrategy strat)
288{
289  int   j,k,p;
290
291  strat->kHEdgeFound=FALSE;
292  if (pLexOrder)
293  {
294    return;
295  }
296  if (strat->ak > 1)           /*we are in the module case*/
297  {
298    return; // until ....
299    //if (!pVectorOut)     /*pVectorOut <=> order = c,* */
300    //  return FALSE;
301    //if (pGetComp(pp) < strat->ak) /* ak is the number of the last component */
302    //  return FALSE;
303  }
304  k = 0;
305  p=pIsPurePower(pp);
306  if (p!=0) strat->NotUsedAxis[p] = FALSE;
307  /*- the leading term of pp is a power of the p-th variable -*/
308  for (j=pVariables;j>0; j--)
309  {
310    if (strat->NotUsedAxis[j])
311    {
312      return;
313    }
314  }
315  strat->kHEdgeFound=TRUE;
316}
317
318/*2
319*utilities for TSet, LSet
320*/
321inline static intset initec (int maxnr)
322{
323  return (intset)omAlloc(maxnr*sizeof(int));
324}
325
326inline static unsigned long* initsevS (int maxnr)
327{
328  return (unsigned long*)omAlloc0(maxnr*sizeof(unsigned long));
329}
330inline static int* initS_2_R (int maxnr)
331{
332  return (int*)omAlloc0(maxnr*sizeof(int));
333}
334
335static inline void enlargeT (TSet &T, TObject** &R, unsigned long* &sevT,
336                             int &length, int incr)
337{
338  int i;
339  T = (TSet)omrealloc0Size(T, length*sizeof(TObject), 
340                           (length+incr)*sizeof(TObject));
341
342  sevT = (unsigned long*) omreallocSize(sevT, length*sizeof(long*), 
343                           (length+incr)*sizeof(long*));
344
345  R = (TObject**)omrealloc0Size(R,length*sizeof(TObject*),
346                                (length+incr)*sizeof(TObject*));
347  for (i=0;i<length;i++) R[T[i].i_r] = &(T[i]);
348  length += incr;
349}
350
351void cleanT (kStrategy strat)
352{
353  int i,j;
354  poly  p;
355  assume(currRing == strat->tailRing || strat->tailRing != NULL);
356
357  pShallowCopyDeleteProc p_shallow_copy_delete = 
358    (strat->tailRing != currRing ? 
359     pGetShallowCopyDeleteProc(strat->tailRing, currRing) :
360     NULL);
361
362  for (j=0; j<=strat->tl; j++)
363  {
364    p = strat->T[j].p;
365    strat->T[j].p=NULL;
366    if (strat->T[j].max != NULL) 
367      p_LmFree(strat->T[j].max, strat->tailRing);
368    i = -1;
369    loop
370    {
371      i++;
372      if (i>strat->sl)
373      {
374        if (strat->T[j].t_p != NULL)
375        {
376          p_Delete(&(strat->T[j].t_p), strat->tailRing);
377          p_LmFree(p, currRing);
378        }
379        else
380          pDelete(&p);
381        break;
382      }
383      if (p == strat->S[i])
384      {
385        if (strat->T[j].t_p != NULL)
386        {
387          assume(p_shallow_copy_delete != NULL);
388          pNext(p) = p_shallow_copy_delete(pNext(p),strat->tailRing,currRing, 
389                                           currRing->PolyBin);
390          p_LmFree(strat->T[j].t_p, strat->tailRing);
391        }
392        break;
393      }
394    }
395  }
396  strat->tl=-1;
397}
398
399LSet initL ()
400{
401  int i;
402  LSet l = (LSet)omAlloc(setmax*sizeof(LObject));
403  for (i=0;i<setmax;i++)
404  {
405    l[i].tailRing = currRing;
406    l[i].i_r1 = -1;
407    l[i].i_r2 = -1;
408    l[i].i_r = -1;
409  }
410  return l;
411}
412
413static inline void enlargeL (LSet* L,int* length,int incr)
414{
415  LSet h;
416
417  *L = (LSet)omReallocSize((*L),(*length)*sizeof(LObject),
418                                   ((*length)+incr)*sizeof(LObject));
419  (*length) += incr;
420}
421
422void initPairtest(kStrategy strat)
423{
424  strat->pairtest = (BOOLEAN *)omAlloc0((strat->sl+2)*sizeof(BOOLEAN));
425}
426
427/*2
428*test whether (p1,p2) or (p2,p1) is in L up position length
429*it returns TRUE if yes and the position k
430*/
431BOOLEAN isInPairsetL(int length,poly p1,poly p2,int*  k,kStrategy strat)
432{
433  LObject *p=&(strat->L[length]);
434
435  *k = length;
436  loop
437  {
438    if ((*k) < 0) return FALSE;
439    if (((p1 == (*p).p1) && (p2 == (*p).p2))
440    ||  ((p1 == (*p).p2) && (p2 == (*p).p1)))
441      return TRUE;
442    (*k)--;
443    p--;
444  }
445}
446
447/*2
448*in B all pairs have the same element p on the right
449*it tests whether (q,p) is in B and returns TRUE if yes
450*and the position k
451*/
452BOOLEAN isInPairsetB(poly q,int*  k,kStrategy strat)
453{
454  LObject *p=&(strat->B[strat->Bl]);
455
456  *k = strat->Bl;
457  loop
458  {
459    if ((*k) < 0) return FALSE;
460    if (q == (*p).p1)
461      return TRUE;
462    (*k)--;
463    p--;
464  }
465}
466
467int kFindInT(poly p, TSet T, int tlength)
468{
469  int i;
470
471  for (i=0; i<=tlength; i++)
472  {
473    if (T[i].p == p) return i;
474  }
475  return -1;
476}
477
478int kFindInT(poly p, kStrategy strat)
479{
480  int i;
481  do
482  {
483    i = kFindInT(p, strat->T, strat->tl);
484    if (i >= 0) return i;
485    strat = strat->next;
486  }
487  while (strat != NULL);
488  return -1;
489}
490 
491#ifdef KDEBUG
492
493void sTObject::wrp()
494{
495  if (t_p != NULL) p_wrp(t_p, tailRing);
496  else if (p != NULL) p_wrp(p, currRing, tailRing);
497  else ::wrp(NULL);
498}
499
500#define kFalseReturn(x) do { if (!x) return FALSE;} while (0)
501
502// check that Lm's of a poly from T are "equal"
503static const char* kTest_LmEqual(poly p, poly t_p, ring tailRing)
504{
505  int i;
506  for (i=1; i<=tailRing->N; i++)
507  {
508    if (p_GetExp(p, i, currRing) != p_GetExp(t_p, i, tailRing))
509      return "Lm[i] different";
510  }
511  if (p_GetComp(p, currRing) != p_GetComp(t_p, tailRing))
512    return "Lm[0] different";
513  if (pNext(p) != pNext(t_p))
514    return "Lm.next different";
515  if (pGetCoeff(p) != pGetCoeff(t_p))
516    return "Lm.coeff different";
517  return NULL;
518}
519
520BOOLEAN kTest_T(TObject * T, ring strat_tailRing, int i, char TN)
521{
522  ring tailRing = T->tailRing;
523  if (strat_tailRing == NULL) strat_tailRing = tailRing;
524  r_assume(strat_tailRing == tailRing);
525
526  poly p = T->p;
527  ring r = currRing;
528 
529  if (T->p == NULL && T->t_p == NULL && i >= 0)
530    return dReportError("%c[%d].poly is NULL", TN, i);
531
532  if (T->tailRing != currRing)
533  {
534    if (T->t_p == NULL && i > 0)
535      return dReportError("%c[%d].t_p is NULL", TN, i);
536    pFalseReturn(p_Test(T->t_p, T->tailRing));
537    if (T->p != NULL) pFalseReturn(p_LmTest(T->p, currRing));
538    if (T->p != NULL && T->t_p != NULL)
539    {
540      const char* msg = kTest_LmEqual(T->p, T->t_p, T->tailRing);
541      if (msg != NULL)
542        return dReportError("%c[%d] %s", TN, i, msg);
543      r = T->tailRing;
544      p = T->t_p;
545    }
546    if (T->p == NULL)
547    {
548      p = T->t_p;
549      r = T->tailRing;
550    }
551    if (T->t_p != NULL && i >= 0 && TN == 'T')
552    {
553      if (pNext(T->t_p) == NULL)
554      {
555        if (T->max != NULL)
556          return dReportError("%c[%d].max is not NULL as it should be", TN, i);
557      }
558      else
559      {
560        if (T->max == NULL)
561          return dReportError("%c[%d].max is NULL", TN, i);
562        if (pNext(T->max) != NULL)
563          return dReportError("pNext(%c[%d].max) != NULL", TN, i);
564       
565        pFalseReturn(p_CheckPolyRing(T->max, tailRing));
566        omCheckBinAddrSize(T->max, (tailRing->PolyBin->sizeW)*SIZEOF_LONG);
567#if KDEBUG > 0
568        poly test_max = p_GetMaxExpP(pNext(T->t_p), tailRing);
569        p_Setm(T->max, tailRing);
570        p_Setm(test_max, tailRing);
571        BOOLEAN equal = p_ExpVectorEqual(T->max, test_max, tailRing);
572        if (! equal)
573          return dReportError("%c[%d].max out of sync", TN, i);
574        p_LmFree(test_max, tailRing);
575#endif
576      }
577    }
578  }
579  else
580  {
581    if (T->max != NULL) 
582      return dReportError("%c[%d].max != NULL but tailRing == currRing",TN,i);
583    if (T->t_p != NULL)
584      return dReportError("%c[%d].t_p != NULL but tailRing == currRing",TN,i);
585    if (T->p == NULL && i > 0)
586      return dReportError("%c[%d].p is NULL", TN, i);
587    pFalseReturn(p_Test(T->p, currRing));
588  }
589
590  if (i >= 0 && T->pLength != 0 && T->pLength != pLength(p))
591  {
592    return dReportError("%c[%d] pLength error: has %d, specified to have %d",
593                        TN, i , pLength(p), T->pLength);
594  }
595
596  // check FDeg,  for elements in L and T
597  if (i >= 0 && (TN == 'T' || TN == 'L'))
598  {
599    // FDeg has ir element from T of L set
600    if (T->FDeg  != T->pFDeg())
601      return dReportError("%c[%d] FDeg error: has %d, specified to have %d",
602                          TN, i , T->pFDeg(), T->FDeg);
603  }
604
605  // check is_normalized for elements in T
606  if (i >= 0 && TN == 'T')
607  {
608    if (T->is_normalized && ! nIsOne(pGetCoeff(p)))
609      return dReportError("T[%d] is_normalized error", i);
610
611  }
612  return TRUE;
613}
614
615BOOLEAN kTest_L(LObject *L, ring strat_tailRing, 
616                BOOLEAN testp, int lpos, TSet T, int tlength)
617{
618  if (testp)
619  {
620    poly pn = NULL;
621    if (L->bucket != NULL)
622    {
623      kFalseReturn(kbTest(L->bucket));
624      r_assume(L->bucket->bucket_ring == L->tailRing);
625      if (L->p != NULL && pNext(L->p) != NULL)
626      {
627        pn = pNext(L->p);
628        pNext(L->p) = NULL;
629      }
630    }
631    kFalseReturn(kTest_T(L, strat_tailRing, lpos, 'L'));
632    if (pn != NULL)
633      pNext(L->p) = pn;
634
635    ring r;
636    poly p;
637    L->GetLm(p, r);
638    if (L->sev != 0 && p_GetShortExpVector(p, r) != L->sev)
639    {
640      return dReportError("L[%d] wrong sev: has %o, specified to have %o",
641                          lpos, p_GetShortExpVector(p, r), L->sev);
642    }
643    if (lpos > 0 && L->last != NULL && pLast(p) != L->last)
644    {
645      return dReportError("L[%d] last wrong: has %p specified to have %p",
646                          lpos, pLast(p), L->last);
647    }
648  }
649  if (L->p1 == NULL)
650  {
651    // L->p2 either NULL or "normal" poly
652    pFalseReturn(pp_Test(L->p2, currRing, L->tailRing));
653  }
654  else if (tlength > 0 && T != NULL)
655  {
656    // now p1 and p2 must be != NULL and must be contained in T
657    int i;
658    i = kFindInT(L->p1, T, tlength);
659    if (i < 0)
660      return dReportError("L[%d].p1 not in T",lpos);
661    i = kFindInT(L->p2, T, tlength);
662    if (i < 0)
663      return dReportError("L[%d].p2 not in T",lpos);
664  }
665  return TRUE;
666}
667
668BOOLEAN kTest (kStrategy strat)
669{
670  int i;
671
672  // test P
673  kFalseReturn(kTest_L(&(strat->P), strat->tailRing,
674                       (strat->P.p != NULL && pNext(strat->P.p)!=strat->tail),
675                       -1, strat->T, strat->tl));
676
677  // test T
678  if (strat->T != NULL)
679  {
680    for (i=0; i<=strat->tl; i++)
681    {
682      kFalseReturn(kTest_T(&(strat->T[i]), strat->tailRing, i, 'T'));
683      if (strat->sevT[i] != pGetShortExpVector(strat->T[i].p))
684        return dReportError("strat->sevT[%d] out of sync", i);
685    }
686  }
687 
688  // test L
689  if (strat->L != NULL)
690  {
691    for (i=0; i<=strat->Ll; i++)
692    {
693      kFalseReturn(kTest_L(&(strat->L[i]), strat->tailRing,
694                           (pNext(strat->L[i].p) != strat->tail), i,
695                           strat->T, strat->tl));
696      if (strat->use_buckets && pNext(strat->L[i].p) != strat->tail && 
697          strat->L[i].p1 != NULL)
698      {
699        assume(strat->L[i].bucket != NULL);
700      }
701    }
702  }
703 
704  // test S
705  if (strat->S != NULL)
706    kFalseReturn(kTest_S(strat));
707
708  return TRUE;
709}
710
711BOOLEAN kTest_S(kStrategy strat)
712{
713  int i;
714  BOOLEAN ret = TRUE;
715  for (i=0; i<=strat->sl; i++)
716  {
717    if (strat->S[i] != NULL && 
718        strat->sevS[i] != pGetShortExpVector(strat->S[i]))
719    {
720      return dReportError("S[%d] wrong sev: has %o, specified to have %o",
721                          i , pGetShortExpVector(strat->S[i]), strat->sevS[i]);
722    }
723  }
724  return ret;
725}
726
727
728
729BOOLEAN kTest_TS(kStrategy strat)
730{
731  int i, j;
732  BOOLEAN ret = TRUE;
733  kFalseReturn(kTest(strat));
734
735  // test strat->R, strat->T[i].i_r
736  for (i=0; i<=strat->tl; i++)
737  {
738    if (strat->T[i].i_r < 0 || strat->T[i].i_r > strat->tl)
739      return dReportError("strat->T[%d].i_r == %d out of bounds", i, 
740                          strat->T[i].i_r);
741    if (strat->R[strat->T[i].i_r] != &(strat->T[i]))
742      return dReportError("T[%d].i_r with R out of sync", i);
743  }   
744  // test containment of S inT
745  if (strat->S != NULL)
746  {
747    for (i=0; i<=strat->sl; i++)
748    {
749      j = kFindInT(strat->S[i], strat->T, strat->tl);
750      if (j < 0)
751        return dReportError("S[%d] not in T", i);
752      if (strat->S_2_R[i] != strat->T[j].i_r)
753        return dReportError("S_2_R[%d]=%d != T[%d].i_r=%d\n",
754                            i, strat->S_2_R[i], j, strat->T[j].i_r);
755    }
756  }
757  // test strat->L[i].i_r1
758  for (i=0; i<=strat->Ll; i++)
759  {
760    if (strat->L[i].p1 != NULL && strat->L[i].p2)
761    {
762      if (strat->L[i].i_r1 < 0 ||
763          strat->L[i].i_r1 > strat->tl ||
764          strat->L[i].T_1(strat)->p != strat->L[i].p1)
765        return dReportError("L[%d].i_r1 out of sync", i);
766      if (strat->L[i].i_r2 < 0 ||
767          strat->L[i].i_r2 > strat->tl ||
768          strat->L[i].T_2(strat)->p != strat->L[i].p2);
769    }
770    else
771    {
772      if (strat->L[i].i_r1 != -1)
773        return dReportError("L[%d].i_r1 out of sync", i);
774      if (strat->L[i].i_r2 != -1)
775        return dReportError("L[%d].i_r2 out of sync", i);
776    }
777    if (strat->L[i].i_r != -1)
778      return dReportError("L[%d].i_r out of sync", i);
779  }
780  return TRUE;
781}
782
783#endif // KDEBUG
784
785/*2
786*cancels the i-th polynomial in the standardbase s
787*/
788void deleteInS (int i,kStrategy strat)
789{
790  int j;
791
792  for (j=i; j<strat->sl; j++)
793  {
794    strat->S[j] = strat->S[j+1];
795    strat->ecartS[j] = strat->ecartS[j+1];
796    strat->sevS[j] = strat->sevS[j+1];
797    strat->S_2_R[j] = strat->S_2_R[j+1];
798  }
799  if (strat->fromQ!=NULL)
800  {
801    for (j=i; j<strat->sl; j++)
802    {
803      strat->fromQ[j] = strat->fromQ[j+1];
804    }
805  }
806  strat->S[strat->sl] = NULL;
807  strat->sl--;
808}
809
810/*2
811*cancels the j-th polynomial in the set
812*/
813void deleteInL (LSet set, int *length, int j,kStrategy strat)
814{
815  if (set[j].lcm!=NULL)
816    pLmFree(set[j].lcm);
817  if (set[j].p!=NULL)
818  {
819    if (pNext(set[j].p) == strat->tail)
820    {
821      pLmFree(set[j].p);
822      /*- tail belongs to several int spolys -*/
823    }
824    else
825    {
826      // search p in T, if it is there, do not delete it
827      if (pOrdSgn != -1 || kFindInT(set[j].p, strat) < 0)
828      {
829        // assure that for global ordereings kFindInT fails
830        assume(pOrdSgn == -1 || kFindInT(set[j].p, strat) < 0);
831        set[j].Delete();
832      }
833    }
834  }
835  if (*length > 0 && j < *length)
836  {
837#ifdef ENTER_USE_MEMMOVE
838    memmove(&(set[j]), &(set[j+1]), (*length - j)*sizeof(LObject));
839#else   
840    int i;
841    for (i=j; i < (*length); i++)
842      set[i] = set[i+1];
843#endif
844  }
845#ifdef KDEBUG
846  memset(&(set[*length]),0,sizeof(LObject));
847#endif
848  (*length)--;
849}
850
851/*2
852*is used after updating the pairset,if the leading term of p
853*devides the leading term of some S[i] it will be canceled
854*/
855inline void clearS (poly p, unsigned long p_sev, int* at, int* k,
856                    kStrategy strat)
857{
858  assume(p_sev == pGetShortExpVector(p));
859  if (!pLmShortDivisibleBy(p,p_sev, strat->S[*at], ~ strat->sevS[*at])) return;
860  deleteInS((*at),strat);
861  (*at)--;
862  (*k)--;
863}
864
865/*2
866*enters p at position at in L
867*/
868void enterL (LSet *set,int *length, int *LSetmax, LObject p,int at)
869{
870  int i;
871  // this should be corrected
872  assume(p.FDeg == p.pFDeg());
873  if ((*length)>=0)
874  {
875    if ((*length) == (*LSetmax)-1) enlargeL(set,LSetmax,setmax);
876    if (at <= (*length))
877#ifdef ENTER_USE_MEMMOVE
878      memmove(&((*set)[at+1]), &((*set)[at]), ((*length)-at+1)*sizeof(LObject));
879#else
880    for (i=(*length)+1; i>=at+1; i--) (*set)[i] = (*set)[i-1];
881#endif
882  }
883  else at = 0;
884  (*set)[at] = p;
885  (*length)++;
886}
887
888/*2
889* computes the normal ecart;
890* used in mora case and if pLexOrder & sugar in bba case
891*/
892void initEcartNormal (LObject* h)
893{
894  h->FDeg = h->pFDeg();
895  h->ecart = h->pLDeg() - h->FDeg;
896}
897
898void initEcartBBA (LObject* h)
899{
900  h->FDeg = h->pFDeg();
901  (*h).ecart = 0;
902  (*h).length = 0;
903}
904
905void initEcartPairBba (LObject* Lp,poly f,poly g,int ecartF,int ecartG)
906{
907  Lp->FDeg = Lp->pFDeg();
908  (*Lp).ecart = 0;
909  (*Lp).length = 0;
910}
911
912void initEcartPairMora (LObject* Lp,poly f,poly g,int ecartF,int ecartG)
913{
914  Lp->FDeg = Lp->pFDeg();
915  (*Lp).ecart = max(ecartF,ecartG);
916  (*Lp).ecart = (*Lp).ecart- (Lp->FDeg -pFDeg((*Lp).lcm));
917  (*Lp).length = 0;
918}
919
920/*2
921*if ecart1<=ecart2 it returns TRUE
922*/
923BOOLEAN sugarDivisibleBy(int ecart1, int ecart2)
924{
925  return (ecart1 <= ecart2);
926}
927
928/*2
929* put the pair (s[i],p)  into the set B, ecart=ecart(p)
930*/
931void enterOnePair (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
932{
933  assume(i<=strat->sl);
934
935  int      l,j,compare;
936  LObject  Lp;
937
938#ifdef KDEBUG
939  Lp.ecart=0; Lp.length=0;
940#endif
941  /*- computes the lcm(s[i],p) -*/
942  Lp.lcm = pInit();
943
944  pLcm(p,strat->S[i],Lp.lcm);
945  pSetm(Lp.lcm);
946  if (strat->sugarCrit)
947  {
948    if(
949    (!((strat->ecartS[i]>0)&&(ecart>0)))
950    && pHasNotCF(p,strat->S[i]))
951    {
952    /*
953    *the product criterion has applied for (s,p),
954    *i.e. lcm(s,p)=product of the leading terms of s and p.
955    *Suppose (s,r) is in L and the leading term
956    *of p devides lcm(s,r)
957    *(==> the leading term of p devides the leading term of r)
958    *but the leading term of s does not devide the leading term of r
959    *(notice that tis condition is automatically satisfied if r is still
960    *in S), then (s,r) can be canceled.
961    *This should be done here because the
962    *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
963    */
964      strat->cp++;
965      pLmFree(Lp.lcm);
966      Lp.lcm=NULL;
967      return;
968    }
969    else
970      Lp.ecart = max(ecart,strat->ecartS[i]);
971    if (strat->fromT && (strat->ecartS[i]>ecart))
972    {
973      pLmFree(Lp.lcm);
974      Lp.lcm=NULL;
975      return;
976      /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
977    }
978    /*
979    *the set B collects the pairs of type (S[j],p)
980    *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
981    *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
982    *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
983    */
984    {
985      j = strat->Bl;
986      loop
987      {
988        if (j < 0)  break;
989        compare=pDivComp(strat->B[j].lcm,Lp.lcm);
990        if ((compare==1)
991        &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
992        {
993          strat->c3++;
994          if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
995          {
996            pLmFree(Lp.lcm);
997            return;
998          }
999          break;
1000        }
1001        else
1002        if ((compare ==-1)
1003        && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
1004        {
1005          deleteInL(strat->B,&strat->Bl,j,strat);
1006          strat->c3++;
1007        }
1008        j--;
1009      }
1010    }
1011  }
1012  else /*sugarcrit*/
1013  {
1014    if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
1015    pHasNotCF(p,strat->S[i]))
1016    {
1017    /*
1018    *the product criterion has applied for (s,p),
1019    *i.e. lcm(s,p)=product of the leading terms of s and p.
1020    *Suppose (s,r) is in L and the leading term
1021    *of p devides lcm(s,r)
1022    *(==> the leading term of p devides the leading term of r)
1023    *but the leading term of s does not devide the leading term of r
1024    *(notice that tis condition is automatically satisfied if r is still
1025    *in S), then (s,r) can be canceled.
1026    *This should be done here because the
1027    *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
1028    */
1029      strat->cp++;
1030      pLmFree(Lp.lcm);
1031      Lp.lcm=NULL;
1032      return;
1033    }
1034    if (strat->fromT && (strat->ecartS[i]>ecart))
1035    {
1036      pLmFree(Lp.lcm);
1037      Lp.lcm=NULL;
1038      return;
1039      /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
1040    }
1041    /*
1042    *the set B collects the pairs of type (S[j],p)
1043    *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
1044    *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
1045    *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
1046    */
1047    for(j = strat->Bl;j>=0;j--)
1048    {
1049      compare=pDivComp(strat->B[j].lcm,Lp.lcm);
1050      if (compare==1)
1051      {
1052        strat->c3++;
1053        if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1054        {
1055          pLmFree(Lp.lcm);
1056          return;
1057        }
1058        break;
1059      }
1060      else
1061      if (compare ==-1)
1062      {
1063        deleteInL(strat->B,&strat->Bl,j,strat);
1064        strat->c3++;
1065      }
1066    }
1067  }
1068  /*
1069  *the pair (S[i],p) enters B if the spoly != 0
1070  */
1071  /*-  compute the short s-polynomial -*/
1072  if (strat->fromT && !TEST_OPT_INTSTRATEGY)
1073    pNorm(p);
1074  if ((strat->S[i]==NULL) || (p==NULL))
1075    return;
1076  if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
1077    Lp.p=NULL;
1078  else
1079  {
1080    Lp.p = ksCreateShortSpoly(strat->S[i],p, strat->tailRing);
1081  }
1082  if (Lp.p == NULL)
1083  {
1084    /*- the case that the s-poly is 0 -*/
1085    if (strat->pairtest==NULL) initPairtest(strat);
1086    strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
1087    strat->pairtest[strat->sl+1] = TRUE;
1088    /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
1089    /*
1090    *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
1091    *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
1092    *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
1093    *term of p devides the lcm(s,r)
1094    *(this canceling should be done here because
1095    *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
1096    *the first case is handeled in chainCrit
1097    */
1098    if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
1099  }
1100  else
1101  {
1102    /*- the pair (S[i],p) enters B -*/
1103    Lp.p1 = strat->S[i];
1104    Lp.p2 = p;
1105    pNext(Lp.p) = strat->tail;
1106    if (atR >= 0)
1107    {
1108      Lp.i_r2 = atR;
1109      Lp.i_r1 = strat->S_2_R[i];
1110    }
1111    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1112    if (TEST_OPT_INTSTRATEGY)
1113    {
1114      nDelete(&(Lp.p->coef));
1115    }
1116    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
1117    enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
1118  }
1119}
1120
1121/*2
1122* put the pair (s[i],p) into the set L, ecart=ecart(p)
1123* in the case that s forms a SB of (s)
1124*/
1125void enterOnePairSpecial (int i,poly p,int ecart,kStrategy strat, int atR = -1)
1126{
1127  int      l,j,compare;
1128  LObject  Lp;
1129
1130  Lp.lcm = pInit();
1131  pLcm(p,strat->S[i],Lp.lcm);
1132  pSetm(Lp.lcm);
1133  if(pHasNotCF(p,strat->S[i]))
1134  {
1135    strat->cp++;
1136    pLmFree(Lp.lcm);
1137    Lp.lcm=NULL;
1138    return;
1139  }
1140  for(j = strat->Ll;j>=0;j--)
1141  {
1142    compare=pDivComp(strat->L[j].lcm,Lp.lcm);
1143    if ((compare==1) || (pLmEqual(strat->L[j].lcm,Lp.lcm)))
1144    {
1145      strat->c3++;
1146      pLmFree(Lp.lcm);
1147      return;
1148    }
1149    else if (compare ==-1)
1150    {
1151      deleteInL(strat->L,&strat->Ll,j,strat);
1152      strat->c3++;
1153    }
1154  }
1155  /*-  compute the short s-polynomial -*/
1156
1157  Lp.p = ksCreateShortSpoly(strat->S[i],p,strat->tailRing);
1158  if (Lp.p == NULL)
1159  {
1160     pLmFree(Lp.lcm);
1161  }
1162  else
1163  {
1164    /*- the pair (S[i],p) enters B -*/
1165    Lp.p1 = strat->S[i];
1166    Lp.p2 = p;
1167    if (atR >= 0)
1168    {
1169      Lp.i_r1 = strat->S_2_R[i];
1170      Lp.i_r2 = atR;
1171    }
1172    pNext(Lp.p) = strat->tail;
1173    strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
1174    if (TEST_OPT_INTSTRATEGY)
1175    {
1176      nDelete(&(Lp.p->coef));
1177    }
1178    l = strat->posInL(strat->L,strat->Ll,&Lp,strat);
1179    enterL(&strat->L,&strat->Ll,&strat->Lmax,Lp,l);
1180  }
1181}
1182
1183/*2
1184*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
1185*using the chain-criterion in B and L and enters B to L
1186*/
1187void chainCrit (poly p,int ecart,kStrategy strat)
1188{
1189  int i,j,l;
1190
1191  /*
1192  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
1193  *In this case all elements in B such
1194  *that their lcm is divisible by the leading term of S[i] can be canceled
1195  */
1196  if (strat->pairtest!=NULL)
1197  {
1198    {
1199      /*- i.e. there is an i with pairtest[i]==TRUE -*/
1200      for (j=0; j<=strat->sl; j++)
1201      {
1202        if (strat->pairtest[j])
1203        {
1204          for (i=strat->Bl; i>=0; i--)
1205          {
1206            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
1207            {
1208              deleteInL(strat->B,&strat->Bl,i,strat);
1209              strat->c3++;
1210            }
1211          }
1212        }
1213      }
1214    }
1215    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
1216    strat->pairtest=NULL;
1217  }
1218  if (strat->Gebauer || strat->fromT)
1219  {
1220    if (strat->sugarCrit)
1221    {
1222    /*
1223    *suppose L[j] == (s,r) and p/lcm(s,r)
1224    *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
1225    *and in case the sugar is o.k. then L[j] can be canceled
1226    */
1227      for (j=strat->Ll; j>=0; j--)
1228      {
1229        if (sugarDivisibleBy(ecart,strat->L[j].ecart)
1230        && ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
1231        && pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1232        {
1233          if (strat->L[j].p == strat->tail)
1234          {
1235            deleteInL(strat->L,&strat->Ll,j,strat);
1236            strat->c3++;
1237          }
1238        }
1239      }
1240      /*
1241      *this is GEBAUER-MOELLER:
1242      *in B all elements with the same lcm except the "best"
1243      *(i.e. the last one in B with this property) will be canceled
1244      */
1245      j = strat->Bl;
1246      loop /*cannot be changed into a for !!! */
1247      {
1248        if (j <= 0) break;
1249        i = j-1;
1250        loop
1251        {
1252          if (i <  0) break;
1253          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
1254          {
1255            strat->c3++;
1256            if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
1257            {
1258              deleteInL(strat->B,&strat->Bl,i,strat);
1259              j--;
1260            }
1261            else
1262            {
1263              deleteInL(strat->B,&strat->Bl,j,strat);
1264              break;
1265            }
1266          }
1267          i--;
1268        }
1269        j--;
1270      }
1271    }
1272    else /*sugarCrit*/
1273    {
1274      /*
1275      *suppose L[j] == (s,r) and p/lcm(s,r)
1276      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
1277      *and in case the sugar is o.k. then L[j] can be canceled
1278      */
1279      for (j=strat->Ll; j>=0; j--)
1280      {
1281        if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1282        {
1283          if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
1284          {
1285            deleteInL(strat->L,&strat->Ll,j,strat);
1286            strat->c3++;
1287          }
1288        }
1289      }
1290      /*
1291      *this is GEBAUER-MOELLER:
1292      *in B all elements with the same lcm except the "best"
1293      *(i.e. the last one in B with this property) will be canceled
1294      */
1295      j = strat->Bl;
1296      loop   /*cannot be changed into a for !!! */
1297      {
1298        if (j <= 0) break;
1299        for(i=j-1; i>=0; i--)
1300        {
1301          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
1302          {
1303            strat->c3++;
1304            deleteInL(strat->B,&strat->Bl,i,strat);
1305            j--;
1306          }
1307        }
1308        j--;
1309      }
1310    }
1311    /*
1312    *the elements of B enter L/their order with respect to B is kept
1313    *j = posInL(L,j,B[i]) would permutate the order
1314    *if once B is ordered different from L
1315    *then one should use j = posInL(L,Ll,B[i])
1316    */
1317    j = strat->Ll+1;
1318    for (i=strat->Bl; i>=0; i--)
1319    {
1320      j = strat->posInL(strat->L,j-1,&(strat->B[i]),strat);
1321      enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
1322    }
1323    strat->Bl = -1;
1324  }
1325  else
1326  {
1327    for (j=strat->Ll; j>=0; j--)
1328    {
1329      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
1330      {
1331        if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
1332        {
1333          deleteInL(strat->L,&strat->Ll,j,strat);
1334          strat->c3++;
1335        }
1336      }
1337    }
1338    /*
1339    *this is our MODIFICATION of GEBAUER-MOELLER:
1340    *First the elements of B enter L,
1341    *then we fix a lcm and the "best" element in L
1342    *(i.e the last in L with this lcm and of type (s,p))
1343    *and cancel all the other elements of type (r,p) with this lcm
1344    *except the case the element (s,r) has also the same lcm
1345    *and is on the worst position with respect to (s,p) and (r,p)
1346    */
1347    /*
1348    *B enters to L/their order with respect to B is permutated for elements
1349    *B[i].p with the same leading term
1350    */
1351    j = strat->Ll;
1352    for (i=strat->Bl; i>=0; i--)
1353    {
1354      j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
1355      enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
1356    }
1357    strat->Bl = -1;
1358    j = strat->Ll;
1359    loop  /*cannot be changed into a for !!! */
1360    {
1361      if (j <= 0)
1362      {
1363        /*now L[0] cannot be canceled any more and the tail can be removed*/
1364        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
1365        break;
1366      }
1367      if (strat->L[j].p2 == p)
1368      {
1369        i = j-1;
1370        loop
1371        {
1372          if (i < 0)  break;
1373          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
1374          {
1375            /*L[i] could be canceled but we search for a better one to cancel*/
1376            strat->c3++;
1377            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
1378            && (pNext(strat->L[l].p) == strat->tail)
1379            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
1380            && pDivisibleBy(p,strat->L[l].lcm))
1381            {
1382              /*
1383              *"NOT equal(...)" because in case of "equal" the element L[l]
1384              *is "older" and has to be from theoretical point of view behind
1385              *L[i], but we do not want to reorder L
1386              */
1387              strat->L[i].p2 = strat->tail;
1388              /*
1389              *L[l] will be canceled, we cannot cancel L[i] later on,
1390              *so we mark it with "tail"
1391              */
1392              deleteInL(strat->L,&strat->Ll,l,strat);
1393              i--;
1394            }
1395            else
1396            {
1397              deleteInL(strat->L,&strat->Ll,i,strat);
1398            }
1399            j--;
1400          }
1401          i--;
1402        }
1403      }
1404      else if (strat->L[j].p2 == strat->tail)
1405      {
1406        /*now L[j] cannot be canceled any more and the tail can be removed*/
1407        strat->L[j].p2 = p;
1408      }
1409      j--;
1410    }
1411  }
1412}
1413
1414/*2
1415*(s[0],h),...,(s[k],h) will be put to the pairset L
1416*/
1417void initenterpairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
1418{
1419
1420  if ((strat->syzComp==0)
1421  || (pGetComp(h)<=strat->syzComp))
1422  {
1423    int j;
1424    BOOLEAN new_pair=FALSE;
1425
1426    if (pGetComp(h)==0)
1427    {
1428      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
1429      if ((isFromQ)&&(strat->fromQ!=NULL))
1430      {
1431        for (j=0; j<=k; j++)
1432        {
1433          if (!strat->fromQ[j])
1434          {
1435            new_pair=TRUE;
1436            enterOnePair(j,h,ecart,isFromQ,strat, atR);
1437          //Print("j:%d, Ll:%d\n",j,strat->Ll);
1438          }
1439        }
1440      }
1441      else
1442      {
1443        new_pair=TRUE;
1444        for (j=0; j<=k; j++)
1445        {
1446          enterOnePair(j,h,ecart,isFromQ,strat, atR);
1447          //Print("j:%d, Ll:%d\n",j,strat->Ll);
1448        }
1449      }
1450    }
1451    else
1452    {
1453      for (j=0; j<=k; j++)
1454      {
1455        if ((pGetComp(h)==pGetComp(strat->S[j]))
1456        || (pGetComp(strat->S[j])==0))
1457        {
1458          new_pair=TRUE;
1459          enterOnePair(j,h,ecart,isFromQ,strat, atR);
1460        //Print("j:%d, Ll:%d\n",j,strat->Ll);
1461        }
1462      }
1463    }
1464    if (new_pair) chainCrit(h,ecart,strat);
1465  }
1466}
1467
1468/*2
1469*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
1470*superfluous elements in S will be deleted
1471*/
1472void enterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR = -1)
1473{
1474  int j=pos;
1475
1476  initenterpairs(h,k,ecart,0,strat, atR);
1477  if ((!strat->fromT)
1478  && ((strat->syzComp==0)
1479    ||(pGetComp(h)<=strat->syzComp)))
1480  {
1481    //Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
1482    unsigned long h_sev = pGetShortExpVector(h);
1483    loop
1484    {
1485      if (j > k) break;
1486      clearS(h,h_sev, &j,&k,strat);
1487      j++;
1488    }
1489    //Print("end clearS sl=%d\n",strat->sl);
1490  }
1491 // PrintS("end enterpairs\n");
1492}
1493
1494/*2
1495*(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
1496*superfluous elements in S will be deleted
1497*/
1498void enterpairsSpecial (poly h,int k,int ecart,int pos,kStrategy strat, int atR = -1)
1499{
1500  int j;
1501
1502  for (j=0; j<=k; j++)
1503  {
1504    if ((pGetComp(h)==pGetComp(strat->S[j]))
1505    || (0==pGetComp(strat->S[j])))
1506    {
1507      enterOnePairSpecial(j,h,ecart,strat, atR);
1508    }
1509  }
1510  j=pos;
1511  loop
1512  {
1513    unsigned long h_sev = pGetShortExpVector(h);
1514    if (j > k) break;
1515    clearS(h,h_sev,&j,&k,strat);
1516    j++;
1517  }
1518}
1519
1520/*2
1521*constructs the pairset at the beginning
1522*of the buchberger/mora algorithm
1523*/
1524void pairs (kStrategy strat)
1525{
1526  int j,i;
1527//  Print("pairs:sl=%d\n",strat->sl);
1528//  for (i=0; i<=strat->sl; i++)
1529//  {
1530//    Print("s%d:",i);pWrite(strat->S[i]);
1531//  }
1532  if (strat->fromQ!=NULL)
1533  {
1534    for (i=1; i<=strat->sl; i++)
1535    {
1536      initenterpairs(strat->S[i],i-1,strat->ecartS[i],strat->fromQ[i],strat);
1537    }
1538  }
1539  else
1540  {
1541    for (i=1; i<=strat->sl; i++)
1542    {
1543      initenterpairs(strat->S[i],i-1,strat->ecartS[i],0,strat);
1544    }
1545  }
1546  /*deletes superfluous elements in S*/
1547  i = -1;
1548  loop
1549  {
1550    i++;
1551    if (i >= strat->sl) break;
1552    if ((strat->syzComp==0) || (pGetComp(strat->S[i])<=strat->syzComp))
1553    {
1554      j=i;
1555      loop
1556      {
1557        j++;
1558        if (j > strat->sl) break;
1559        if (pLmShortDivisibleBy(strat->S[i], strat->sevS[i],
1560                              strat->S[j], ~ strat->sevS[j]))
1561        {
1562        //  Print("delete %d=",j);
1563        //  wrp(strat->S[j]);
1564        //  Print(" wegen %d=",i);
1565        //  wrp(strat->S[i]);
1566        //  Print("( fromQ=%d)\n", (strat->fromQ) ? strat->fromQ[j]:0);
1567          if ((strat->fromQ==NULL) || (strat->fromQ[j]==0))
1568          {
1569            deleteInS(j,strat);
1570            j--;
1571          }
1572        }
1573      }
1574    }
1575  }
1576}
1577
1578/*2
1579*reorders  s with respect to posInS,
1580*suc is the first changed index or zero
1581*/
1582void reorderS (int* suc,kStrategy strat)
1583{
1584  int i,j,at,ecart, s2r;
1585  int fq=0;
1586  unsigned long sev;
1587  poly  p;
1588
1589  *suc = -1;
1590  for (i=1; i<=strat->sl; i++)
1591  {
1592    at = posInS(strat->S,i-1,strat->S[i]);
1593    if (at != i)
1594    {
1595      if ((*suc > at) || (*suc == -1)) *suc = at;
1596      p = strat->S[i];
1597      ecart = strat->ecartS[i];
1598      sev = strat->sevS[i];
1599      s2r = strat->S_2_R[i];
1600      if (strat->fromQ!=NULL) fq=strat->fromQ[i];
1601      for (j=i; j>=at+1; j--)
1602      {
1603        strat->S[j] = strat->S[j-1];
1604        strat->ecartS[j] = strat->ecartS[j-1];
1605        strat->sevS[j] = strat->sevS[j-1];
1606        strat->S_2_R[j] = strat->S_2_R[j-1];
1607      }
1608      strat->S[at] = p;
1609      strat->ecartS[at] = ecart;
1610      strat->sevS[at] = sev;
1611      strat->S_2_R[at] = s2r;
1612      if (strat->fromQ!=NULL)
1613      {
1614        for (j=i; j>=at+1; j--)
1615        {
1616          strat->fromQ[j] = strat->fromQ[j-1];
1617        }
1618        strat->fromQ[at]=fq;
1619      }
1620    }
1621  }
1622}
1623
1624
1625/*2
1626*looks up the position of p in set
1627*set[0] is the smallest with respect to the ordering-procedure
1628*pComp
1629* Assumption: posInS only depends on the leading term
1630*             otherwise, bba has to be changed
1631*/
1632int posInS (polyset set,int length,poly p)
1633{
1634  if(length==-1) return 0;
1635  int i;
1636  int an = 0;
1637  int en= length;
1638  if (currRing->MixedOrder)
1639  {
1640    int cmp_int=pOrdSgn;
1641    int o=pWTotaldegree(p);
1642    int oo=pWTotaldegree(set[length]);
1643
1644    if ((oo<o)
1645    || ((o==oo) && (pLmCmp(set[length],p)!= cmp_int)))
1646      return length+1;
1647
1648    loop
1649    {
1650      if (an >= en-1)
1651      {
1652        if ((pWTotaldegree(set[an])>=o) && (pLmCmp(set[an],p) == cmp_int))
1653        {
1654          return an;
1655        }
1656        return en;
1657      }
1658      i=(an+en) / 2;
1659      if ((pWTotaldegree(set[an])>=o)
1660      && (pLmCmp(set[i],p) == cmp_int)) en=i;
1661      else                              an=i;
1662    }
1663  }
1664  else
1665  {
1666    if (pLmCmp(set[length],p)!= pOrdSgn)
1667      return length+1;
1668
1669    loop
1670    {
1671      if (an >= en-1)
1672      {
1673        if (pLmCmp(set[an],p) == pOrdSgn) return an;
1674        return en;
1675      }
1676      i=(an+en) / 2;
1677      if (pLmCmp(set[i],p) == pOrdSgn) en=i;
1678      else                             an=i;
1679    }
1680  }
1681}
1682
1683
1684/*2
1685* looks up the position of p in set
1686* the position is the last one
1687*/
1688int posInT0 (const TSet set,const int length,LObject &p)
1689{
1690  return (length+1);
1691}
1692
1693
1694/*2
1695* looks up the position of p in T
1696* set[0] is the smallest with respect to the ordering-procedure
1697* pComp
1698*/
1699int posInT1 (const TSet set,const int length,LObject &p)
1700{
1701  if (length==-1) return 0;
1702
1703  if (pLmCmp(set[length].p,p.p)!= pOrdSgn) return length+1;
1704
1705  int i;
1706  int an = 0;
1707  int en= length;
1708
1709  loop
1710  {
1711    if (an >= en-1)
1712    {
1713      if (pLmCmp(set[an].p,p.p) == pOrdSgn) return an;
1714      return en;
1715    }
1716    i=(an+en) / 2;
1717    if (pLmCmp(set[i].p,p.p) == pOrdSgn) en=i;
1718    else                                 an=i;
1719  }
1720}
1721
1722/*2
1723* looks up the position of p in T
1724* set[0] is the smallest with respect to the ordering-procedure
1725* length
1726*/
1727int posInT2 (const TSet set,const int length,LObject &p)
1728{
1729  if (length==-1)
1730    return 0;
1731  if (set[length].length<p.length)
1732    return length+1;
1733
1734  int i;
1735  int an = 0;
1736  int en= length;
1737
1738  loop
1739  {
1740    if (an >= en-1)
1741    {
1742      if (set[an].length>p.length) return an;
1743      return en;
1744    }
1745    i=(an+en) / 2;
1746    if (set[i].length>p.length) en=i;
1747    else                        an=i;
1748  }
1749}
1750
1751/*2
1752* looks up the position of p in T
1753* set[0] is the smallest with respect to the ordering-procedure
1754* totaldegree,pComp
1755*/
1756int posInT11 (const TSet set,const int length,LObject &p)
1757/*{
1758 * int j=0;
1759 * int o;
1760 *
1761 * o = p.GetpFDeg();
1762 * loop
1763 * {
1764 *   if ((pFDeg(set[j].p) > o)
1765 *   || ((pFDeg(set[j].p) == o) && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
1766 *   {
1767 *     return j;
1768 *   }
1769 *   j++;
1770 *   if (j > length) return j;
1771 * }
1772 *}
1773 */
1774{
1775  if (length==-1) return 0;
1776
1777  int o = p.GetpFDeg();
1778  int op = set[length].GetpFDeg();
1779
1780  if ((op < o)
1781  || ((op == o) && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
1782    return length+1;
1783
1784  int i;
1785  int an = 0;
1786  int en= length;
1787
1788  loop
1789  {
1790    if (an >= en-1)
1791    {
1792      op= set[an].GetpFDeg();
1793      if ((op > o)
1794      || (( op == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
1795        return an;
1796      return en;
1797    }
1798    i=(an+en) / 2;
1799    op = set[i].GetpFDeg();
1800    if (( op > o)
1801    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
1802      en=i;
1803    else
1804      an=i;
1805  }
1806}
1807
1808/*2
1809* looks up the position of p in T
1810* set[0] is the smallest with respect to the ordering-procedure
1811* totaldegree,pComp
1812*/
1813int posInT110 (const TSet set,const int length,LObject &p)
1814{
1815  if (length==-1) return 0;
1816
1817  int o = p.GetpFDeg();
1818  int op = set[length].GetpFDeg();
1819
1820  if (( op < o)
1821  || (( op == o) && (set[length].length<p.length))
1822  || (( op == o) && (set[length].length == p.length)
1823     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
1824    return length+1;
1825
1826  int i;
1827  int an = 0;
1828  int en= length;
1829  loop
1830  {
1831    if (an >= en-1)
1832    {
1833      op = set[an].GetpFDeg();
1834      if (( op > o)
1835      || (( op == o) && (set[an].length > p.length))
1836      || (( op == o) && (set[an].length == p.length)
1837         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
1838        return an;
1839      return en;
1840    }
1841    i=(an+en) / 2;
1842    op = set[i].GetpFDeg();
1843    if (( op > o)
1844    || (( op == o) && (set[i].length > p.length))
1845    || (( op == o) && (set[i].length == p.length)
1846       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
1847      en=i;
1848    else
1849      an=i;
1850  }
1851}
1852
1853/*2
1854* looks up the position of p in set
1855* set[0] is the smallest with respect to the ordering-procedure
1856* pFDeg
1857*/
1858int posInT13 (const TSet set,const int length,LObject &p)
1859{
1860  if (length==-1) return 0;
1861
1862  int o = p.GetpFDeg();
1863
1864  if (set[length].GetpFDeg() <= o)
1865    return length+1;
1866
1867  int i;
1868  int an = 0;
1869  int en= length;
1870  loop
1871  {
1872    if (an >= en-1)
1873    {
1874      if (set[an].GetpFDeg() > o)
1875        return an;
1876      return en;
1877    }
1878    i=(an+en) / 2;
1879    if (set[i].GetpFDeg() > o)
1880      en=i;
1881    else
1882      an=i;
1883  }
1884}
1885
1886// determines the position based on: 1.) Ecart 2.) pLength
1887int posInT_EcartpLength(const TSet set,const int length,LObject &p)
1888{
1889  if (length==-1) return 0;
1890
1891  int op=p.ecart;
1892  int ol = p.GetpLength();
1893
1894  int oo=set[length].ecart;
1895  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
1896    return length+1;
1897
1898  int i;
1899  int an = 0;
1900  int en= length;
1901  loop
1902    {
1903      if (an >= en-1)
1904      {
1905        int oo=set[an].ecart;
1906        if((oo > op)
1907           || ((oo==op) && (set[an].pLength > ol)))
1908          return an;
1909        return en;
1910      }
1911      i=(an+en) / 2;
1912      int oo=set[i].ecart;
1913      if ((oo > op)
1914          || ((oo == op) && (set[i].pLength > ol)))
1915        en=i;
1916      else
1917        an=i;
1918    }
1919}
1920 
1921/*2
1922* looks up the position of p in set
1923* set[0] is the smallest with respect to the ordering-procedure
1924* maximaldegree, pComp
1925*/
1926int posInT15 (const TSet set,const int length,LObject &p)
1927/*{
1928 *int j=0;
1929 * int o;
1930 *
1931 * o = p.GetpFDeg()+p.ecart;
1932 * loop
1933 * {
1934 *   if ((set[j].GetpFDeg()+set[j].ecart > o)
1935 *   || ((set[j].GetpFDeg()+set[j].ecart == o)
1936 *     && (pLmCmp(set[j].p,p.p) == pOrdSgn)))
1937 *   {
1938 *     return j;
1939 *   }
1940 *   j++;
1941 *   if (j > length) return j;
1942 * }
1943 *}
1944 */
1945{
1946  if (length==-1) return 0;
1947
1948  int o = p.GetpFDeg() + p.ecart;
1949  int op = set[length].GetpFDeg()+set[length].ecart;
1950
1951  if ((op < o)
1952  || ((op == o)
1953     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
1954    return length+1;
1955
1956  int i;
1957  int an = 0;
1958  int en= length;
1959  loop
1960  {
1961    if (an >= en-1)
1962    {
1963      op = set[an].GetpFDeg()+set[an].ecart;
1964      if (( op > o)
1965      || (( op  == o) && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
1966        return an;
1967      return en;
1968    }
1969    i=(an+en) / 2;
1970    op = set[i].GetpFDeg()+set[i].ecart;
1971    if (( op > o)
1972    || (( op == o) && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
1973      en=i;
1974    else
1975      an=i;
1976  }
1977}
1978
1979/*2
1980* looks up the position of p in set
1981* set[0] is the smallest with respect to the ordering-procedure
1982* pFDeg+ecart, ecart, pComp
1983*/
1984int posInT17 (const TSet set,const int length,LObject &p)
1985/*
1986*{
1987* int j=0;
1988* int  o;
1989*
1990*  o = p.GetpFDeg()+p.ecart;
1991*  loop
1992*  {
1993*    if ((pFDeg(set[j].p)+set[j].ecart > o)
1994*    || (((pFDeg(set[j].p)+set[j].ecart == o)
1995*      && (set[j].ecart < p.ecart)))
1996*    || ((pFDeg(set[j].p)+set[j].ecart == o)
1997*      && (set[j].ecart==p.ecart)
1998*      && (pLmCmp(set[j].p,p.p)==pOrdSgn)))
1999*      return j;
2000*    j++;
2001*    if (j > length) return j;
2002*  }
2003* }
2004*/
2005{
2006  if (length==-1) return 0;
2007
2008  int o = p.GetpFDeg() + p.ecart;
2009  int op = set[length].GetpFDeg()+set[length].ecart;
2010
2011  if ((op < o)
2012  || (( op == o) && (set[length].ecart > p.ecart))
2013  || (( op == o) && (set[length].ecart==p.ecart)
2014     && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
2015    return length+1;
2016
2017  int i;
2018  int an = 0;
2019  int en= length;
2020  loop
2021  {
2022    if (an >= en-1)
2023    {
2024      op = set[an].GetpFDeg()+set[an].ecart;
2025      if (( op > o)
2026      || (( op == o) && (set[an].ecart < p.ecart))
2027      || (( op  == o) && (set[an].ecart==p.ecart)
2028         && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
2029        return an;
2030      return en;
2031    }
2032    i=(an+en) / 2;
2033    op = set[i].GetpFDeg()+set[i].ecart;
2034    if ((op > o)
2035    || (( op == o) && (set[i].ecart < p.ecart))
2036    || (( op == o) && (set[i].ecart == p.ecart)
2037       && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
2038      en=i;
2039    else
2040      an=i;
2041  }
2042}
2043/*2
2044* looks up the position of p in set
2045* set[0] is the smallest with respect to the ordering-procedure
2046* pGetComp, pFDeg+ecart, ecart, pComp
2047*/
2048int posInT17_c (const TSet set,const int length,LObject &p)
2049{
2050  if (length==-1) return 0;
2051
2052  int cc = (-1+2*currRing->order[0]==ringorder_c);
2053  /* cc==1 for (c,..), cc==-1 for (C,..) */
2054  int o = p.GetpFDeg() + p.ecart;
2055  int c = pGetComp(p.p)*cc;
2056
2057  if (pGetComp(set[length].p)*cc < c)
2058    return length+1;
2059  if (pGetComp(set[length].p)*cc == c)
2060  {
2061    int op = set[length].GetpFDeg()+set[length].ecart;
2062    if ((op < o)
2063    || ((op == o) && (set[length].ecart > p.ecart))
2064    || ((op == o) && (set[length].ecart==p.ecart)
2065       && (pLmCmp(set[length].p,p.p) != pOrdSgn)))
2066      return length+1;
2067  }
2068
2069  int i;
2070  int an = 0;
2071  int en= length;
2072  loop
2073  {
2074    if (an >= en-1)
2075    {
2076      if (pGetComp(set[an].p)*cc < c)
2077        return en;
2078      if (pGetComp(set[an].p)*cc == c)
2079      {
2080        int op = set[an].GetpFDeg()+set[an].ecart;
2081        if ((op > o)
2082        || ((op == o) && (set[an].ecart < p.ecart))
2083        || ((op == o) && (set[an].ecart==p.ecart)
2084           && (pLmCmp(set[an].p,p.p) == pOrdSgn)))
2085          return an;
2086      }
2087      return en;
2088    }
2089    i=(an+en) / 2;
2090    if (pGetComp(set[i].p)*cc > c)
2091      en=i;
2092    else if (pGetComp(set[i].p)*cc == c)
2093    {
2094      int op = set[i].GetpFDeg()+set[i].ecart;
2095      if ((op > o)
2096      || ((op == o) && (set[i].ecart < p.ecart))
2097      || ((op == o) && (set[i].ecart == p.ecart)
2098         && (pLmCmp(set[i].p,p.p) == pOrdSgn)))
2099        en=i;
2100      else
2101        an=i;
2102    }
2103    else
2104      an=i;
2105  }
2106}
2107
2108/*2
2109* looks up the position of p in set
2110* set[0] is the smallest with respect to
2111* ecart, pFDeg, length
2112*/
2113int posInT19 (const TSet set,const int length,LObject &p)
2114{
2115  if (length==-1) return 0;
2116
2117  int o = p.ecart;
2118  int op=p.GetpFDeg();
2119
2120  if (set[length].ecart < o)
2121    return length+1;
2122  if (set[length].ecart == o)
2123  {
2124     int oo=set[length].GetpFDeg();
2125     if ((oo < op) || ((oo==op) && (set[length].length < p.length)))
2126       return length+1;
2127  }
2128
2129  int i;
2130  int an = 0;
2131  int en= length;
2132  loop
2133  {
2134    if (an >= en-1)
2135    {
2136      if (set[an].ecart > o)
2137        return an;
2138      if (set[an].ecart == o)
2139      {
2140         int oo=set[an].GetpFDeg();
2141         if((oo > op)
2142         || ((oo==op) && (set[an].length > p.length)))
2143           return an;
2144      }
2145      return en;
2146    }
2147    i=(an+en) / 2;
2148    if (set[i].ecart > o)
2149      en=i;
2150    else if (set[i].ecart == o)
2151    {
2152       int oo=set[i].GetpFDeg();
2153       if ((oo > op)
2154       || ((oo == op) && (set[i].length > p.length)))
2155         en=i;
2156       else
2157        an=i;
2158    }
2159    else
2160      an=i;
2161  }
2162}
2163
2164/*2
2165*looks up the position of polynomial p in set
2166*set[length] is the smallest element in set with respect
2167*to the ordering-procedure pComp
2168*/
2169int posInLSpecial (const LSet set, const int length,
2170                   LObject *p,const kStrategy strat)
2171{
2172  if (length<0) return 0;
2173
2174  int d=p->GetpFDeg();
2175  int op=set[length].GetpFDeg();
2176
2177  if ((op > d)
2178  || ((op == d) && (p->p1!=NULL)&&(set[length].p1==NULL))
2179  || (pLmCmp(set[length].p,p->p)== pOrdSgn))
2180     return length+1;
2181
2182  int i;
2183  int an = 0;
2184  int en= length;
2185  loop
2186  {
2187    if (an >= en-1)
2188    {
2189      op=set[an].GetpFDeg();
2190      if ((op > d)
2191      || ((op == d) && (p->p1!=NULL) && (set[an].p1==NULL))
2192      || (pLmCmp(set[an].p,p->p)== pOrdSgn))
2193         return en;
2194      return an;
2195    }
2196    i=(an+en) / 2;
2197    op=set[i].GetpFDeg();
2198    if ((op>d)
2199    || ((op==d) && (p->p1!=NULL) && (set[i].p1==NULL))
2200    || (pLmCmp(set[i].p,p->p) == pOrdSgn))
2201      an=i;
2202    else
2203      en=i;
2204  }
2205}
2206
2207/*2
2208*looks up the position of polynomial p in set
2209*set[length] is the smallest element in set with respect
2210*to the ordering-procedure pComp
2211*/
2212int posInL0 (const LSet set, const int length,
2213             LObject* p,const kStrategy strat)
2214{
2215  if (length<0) return 0;
2216
2217  if (pLmCmp(set[length].p,p->p)== pOrdSgn)
2218    return length+1;
2219
2220  int i;
2221  int an = 0;
2222  int en= length;
2223  loop
2224  {
2225    if (an >= en-1)
2226    {
2227      if (pLmCmp(set[an].p,p->p) == pOrdSgn) return en;
2228      return an;
2229    }
2230    i=(an+en) / 2;
2231    if (pLmCmp(set[i].p,p->p) == pOrdSgn) an=i;
2232    else                                 en=i;
2233    /*aend. fuer lazy == in !=- machen */
2234  }
2235}
2236
2237/*2
2238* looks up the position of polynomial p in set
2239* e is the ecart of p
2240* set[length] is the smallest element in set with respect
2241* to the ordering-procedure totaldegree,pComp
2242*/
2243int posInL11 (const LSet set, const int length,
2244              LObject* p,const kStrategy strat)
2245/*{
2246 * int j=0;
2247 * int o;
2248 *
2249 * o = p->GetpFDeg();
2250 * loop
2251 * {
2252 *   if (j > length)            return j;
2253 *   if ((set[j].GetpFDeg() < o)) return j;
2254 *   if ((set[j].GetpFDeg() == o) && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
2255 *   {
2256 *     return j;
2257 *   }
2258 *   j++;
2259 * }
2260 *}
2261 */
2262{
2263  if (length<0) return 0;
2264
2265  int o = p->GetpFDeg();
2266  int op = set[length].GetpFDeg();
2267
2268  if ((op > o)
2269  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
2270    return length+1;
2271  int i;
2272  int an = 0;
2273  int en= length;
2274  loop
2275  {
2276    if (an >= en-1)
2277    {
2278      op = set[an].GetpFDeg();
2279      if ((op > o)
2280      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
2281        return en;
2282      return an;
2283    }
2284    i=(an+en) / 2;
2285    op = set[i].GetpFDeg();
2286    if ((op > o)
2287    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
2288      an=i;
2289    else
2290      en=i;
2291  }
2292}
2293
2294/*2
2295* looks up the position of polynomial p in set
2296* set[length] is the smallest element in set with respect
2297* to the ordering-procedure totaldegree,pLength0
2298*/
2299int posInL110 (const LSet set, const int length,
2300               LObject* p,const kStrategy strat)
2301{
2302  if (length<0) return 0;
2303
2304  int o = p->GetpFDeg();
2305  int op = set[length].GetpFDeg();
2306
2307  if ((op > o)
2308  || ((op == o) && (set[length].length >2*p->length))
2309  || ((op == o) && (set[length].length <= 2*p->length)
2310     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
2311    return length+1;
2312  int i;
2313  int an = 0;
2314  int en= length;
2315  loop
2316  {
2317    if (an >= en-1)
2318    {
2319      op = set[an].GetpFDeg();
2320      if ((op > o)
2321      || ((op == o) && (set[an].length >2*p->length))
2322      || ((op == o) && (set[an].length <=2*p->length)
2323         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
2324        return en;
2325      return an;
2326    }
2327    i=(an+en) / 2;
2328    op = set[i].GetpFDeg();
2329    if ((op > o)
2330    || ((op == o) && (set[i].length > 2*p->length))
2331    || ((op == o) && (set[i].length <= 2*p->length)
2332       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
2333      an=i;
2334    else
2335      en=i;
2336  }
2337}
2338
2339/*2
2340* looks up the position of polynomial p in set
2341* e is the ecart of p
2342* set[length] is the smallest element in set with respect
2343* to the ordering-procedure totaldegree
2344*/
2345int posInL13 (const LSet set, const int length,
2346              LObject* p,const kStrategy strat)
2347{
2348  if (length<0) return 0;
2349
2350  int o = p->GetpFDeg();
2351
2352  if (set[length].GetpFDeg() > o)
2353    return length+1;
2354
2355  int i;
2356  int an = 0;
2357  int en= length;
2358  loop
2359  {
2360    if (an >= en-1)
2361    {
2362      if (set[an].GetpFDeg() >= o)
2363        return en;
2364      return an;
2365    }
2366    i=(an+en) / 2;
2367    if (set[i].GetpFDeg() >= o)
2368      an=i;
2369    else
2370      en=i;
2371  }
2372}
2373
2374/*2
2375* looks up the position of polynomial p in set
2376* e is the ecart of p
2377* set[length] is the smallest element in set with respect
2378* to the ordering-procedure maximaldegree,pComp
2379*/
2380int posInL15 (const LSet set, const int length,
2381              LObject* p,const kStrategy strat)
2382/*{
2383 * int j=0;
2384 * int o;
2385 *
2386 * o = p->ecart+p->GetpFDeg();
2387 * loop
2388 * {
2389 *   if (j > length)                       return j;
2390 *   if (set[j].GetpFDeg()+set[j].ecart < o) return j;
2391 *   if ((set[j].GetpFDeg()+set[j].ecart == o)
2392 *   && (pLmCmp(set[j].p,p->p) == -pOrdSgn))
2393 *   {
2394 *     return j;
2395 *   }
2396 *   j++;
2397 * }
2398 *}
2399 */
2400{
2401  if (length<0) return 0;
2402
2403  int o = p->GetpFDeg() + p->ecart;
2404  int op = set[length].GetpFDeg() + set[length].ecart;
2405
2406  if ((op > o)
2407  || ((op == o) && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
2408    return length+1;
2409  int i;
2410  int an = 0;
2411  int en= length;
2412  loop
2413  {
2414    if (an >= en-1)
2415    {
2416      op = set[an].GetpFDeg() + set[an].ecart;
2417      if ((op > o)
2418      || ((op == o) && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
2419        return en;
2420      return an;
2421    }
2422    i=(an+en) / 2;
2423    op = set[i].GetpFDeg() + set[i].ecart;
2424    if ((op > o)
2425    || ((op == o) && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
2426      an=i;
2427    else
2428      en=i;
2429  }
2430}
2431
2432/*2
2433* looks up the position of polynomial p in set
2434* e is the ecart of p
2435* set[length] is the smallest element in set with respect
2436* to the ordering-procedure totaldegree
2437*/
2438int posInL17 (const LSet set, const int length,
2439              LObject* p,const kStrategy strat)
2440{
2441  if (length<0) return 0;
2442
2443  int o = p->GetpFDeg() + p->ecart;
2444
2445  if ((set[length].GetpFDeg() + set[length].ecart > o)
2446  || ((set[length].GetpFDeg() + set[length].ecart == o)
2447     && (set[length].ecart > p->ecart))
2448  || ((set[length].GetpFDeg() + set[length].ecart == o)
2449     && (set[length].ecart == p->ecart)
2450     && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
2451    return length+1;
2452  int i;
2453  int an = 0;
2454  int en= length;
2455  loop
2456  {
2457    if (an >= en-1)
2458    {
2459      if ((set[an].GetpFDeg() + set[an].ecart > o)
2460      || ((set[an].GetpFDeg() + set[an].ecart == o)
2461         && (set[an].ecart > p->ecart))
2462      || ((set[an].GetpFDeg() + set[an].ecart == o)
2463         && (set[an].ecart == p->ecart)
2464         && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
2465        return en;
2466      return an;
2467    }
2468    i=(an+en) / 2;
2469    if ((set[i].GetpFDeg() + set[i].ecart > o)
2470    || ((set[i].GetpFDeg() + set[i].ecart == o)
2471       && (set[i].ecart > p->ecart))
2472    || ((set[i].GetpFDeg() +set[i].ecart == o)
2473       && (set[i].ecart == p->ecart)
2474       && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
2475      an=i;
2476    else
2477      en=i;
2478  }
2479}
2480/*2
2481* looks up the position of polynomial p in set
2482* e is the ecart of p
2483* set[length] is the smallest element in set with respect
2484* to the ordering-procedure pComp
2485*/
2486int posInL17_c (const LSet set, const int length,
2487                LObject* p,const kStrategy strat)
2488{
2489  if (length<0) return 0;
2490
2491  int cc = (-1+2*currRing->order[0]==ringorder_c);
2492  /* cc==1 for (c,..), cc==-1 for (C,..) */
2493  int c = pGetComp(p->p)*cc;
2494  int o = p->GetpFDeg() + p->ecart;
2495
2496  if (pGetComp(set[length].p)*cc > c)
2497    return length+1;
2498  if (pGetComp(set[length].p)*cc == c)
2499  {
2500    if ((set[length].GetpFDeg() + set[length].ecart > o)
2501    || ((set[length].GetpFDeg() + set[length].ecart == o)
2502       && (set[length].ecart > p->ecart))
2503    || ((set[length].GetpFDeg() + set[length].ecart == o)
2504       && (set[length].ecart == p->ecart)
2505       && (pLmCmp(set[length].p,p->p) != -pOrdSgn)))
2506      return length+1;
2507  }
2508  int i;
2509  int an = 0;
2510  int en= length;
2511  loop
2512  {
2513    if (an >= en-1)
2514    {
2515      if (pGetComp(set[an].p)*cc > c)
2516        return en;
2517      if (pGetComp(set[an].p)*cc == c)
2518      {
2519        if ((set[an].GetpFDeg() + set[an].ecart > o)
2520        || ((set[an].GetpFDeg() + set[an].ecart == o)
2521           && (set[an].ecart > p->ecart))
2522        || ((set[an].GetpFDeg() + set[an].ecart == o)
2523           && (set[an].ecart == p->ecart)
2524           && (pLmCmp(set[an].p,p->p) != -pOrdSgn)))
2525          return en;
2526      }
2527      return an;
2528    }
2529    i=(an+en) / 2;
2530    if (pGetComp(set[i].p)*cc > c)
2531      an=i;
2532    else if (pGetComp(set[i].p)*cc == c)
2533    {
2534      if ((set[i].GetpFDeg() + set[i].ecart > o)
2535      || ((set[i].GetpFDeg() + set[i].ecart == o)
2536         && (set[i].ecart > p->ecart))
2537      || ((set[i].GetpFDeg() +set[i].ecart == o)
2538         && (set[i].ecart == p->ecart)
2539         && (pLmCmp(set[i].p,p->p) != -pOrdSgn)))
2540        an=i;
2541      else
2542        en=i;
2543    }
2544    else
2545      en=i;
2546  }
2547}
2548
2549/***************************************************************
2550 *
2551 * Tail reductions
2552 *
2553 ***************************************************************/
2554static TObject* 
2555kFindDivisibleByInS(kStrategy strat, int pos, LObject* L, TObject *T, 
2556                    long ecart = LONG_MAX)
2557{
2558  int j = 0;
2559  const unsigned long not_sev = ~L->sev;
2560  const unsigned long* sev = strat->sevS;
2561  poly p;
2562  ring r;
2563  L->GetLm(p, r);
2564 
2565  assume(~not_sev == p_GetShortExpVector(p, r));
2566
2567  if (r == currRing)
2568  {
2569    while (1)
2570    {
2571      if (j > pos) return NULL;
2572#if defined(PDEBUG) || defined(PDIV_DEBUG)
2573      if (p_LmShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
2574          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
2575        break;
2576#else
2577      if (!(sev[j] & not_sev) &&
2578          (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
2579          p_LmDivisibleBy(strat->S[j], p, r))
2580        break;
2581     
2582#endif
2583      j++;
2584    }
2585    // if called from NF, T objects do not exist:
2586    if (strat->tl < 0 || strat->S_2_R[j] == -1)
2587    {
2588      T->Set(strat->S[j], r, strat->tailRing);
2589      return T;
2590    }
2591    else
2592    {
2593      assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL && 
2594              strat->S_2_T(j)->p == strat->S[j]);
2595      return strat->S_2_T(j);
2596    }
2597  }
2598  else
2599  {
2600    TObject* t;
2601    while (1)
2602    {
2603      if (j > pos) return NULL;
2604      assume(strat->S_2_R[j] != -1);
2605#if defined(PDEBUG) || defined(PDIV_DEBUG)
2606      t = strat->S_2_T(j);
2607      assume(t != NULL && t->t_p != NULL && t->tailRing == r);
2608      if (p_LmShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) && 
2609          (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
2610        return t;
2611#else     
2612      if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
2613      {
2614        t = strat->S_2_T(j);
2615        assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
2616        if (p_LmDivisibleBy(t->t_p, p, r)) return t;
2617      }
2618#endif
2619      j++;
2620    }
2621  }
2622}
2623
2624
2625poly redtail (LObject* L, int pos, kStrategy strat)
2626{
2627  poly h, hn;
2628  int j;
2629  unsigned long not_sev;
2630  strat->redTailChange=FALSE;
2631
2632  poly p = L->p;
2633  if (strat->noTailReduction || pNext(p) == NULL)
2634    return p;
2635
2636  LObject Ln(strat->tailRing);
2637  TObject* With;
2638  // placeholder in case strat->tl < 0
2639  TObject  With_s(strat->tailRing);
2640  h = p;
2641  hn = pNext(h);
2642  long op = pFDeg(hn, strat->tailRing);
2643  long e;
2644  int l;
2645  BOOLEAN save_HE=strat->kHEdgeFound;
2646  strat->kHEdgeFound |= 
2647    ((Kstd1_deg>0) && (op<=Kstd1_deg)) || TEST_OPT_INFREDTAIL;
2648
2649  while(hn != NULL)
2650  {
2651    op = pFDeg(hn, strat->tailRing);
2652    if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
2653    e = pLDeg(hn, &l, strat->tailRing) - op;
2654    while (1)
2655    {
2656      Ln.Set(hn, strat->tailRing);
2657      Ln.sev = p_GetShortExpVector(hn, strat->tailRing);
2658      if (strat->kHEdgeFound)
2659        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
2660      else
2661        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s, e);
2662      if (With == NULL) break;
2663      strat->redTailChange=TRUE;
2664      if (ksReducePolyTail(L, With, h, strat->kNoether))
2665      {
2666        // reducing the tail would violate the exp bound
2667        if (kStratChangeTailRing(strat, L))
2668        {
2669          strat->kHEdgeFound = save_HE;
2670          return redtail(L, pos, strat);
2671        }
2672        else
2673          return NULL;
2674      }
2675      hn = pNext(h);
2676      if (hn == NULL) goto all_done;
2677      op = pFDeg(hn, strat->tailRing);
2678      if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
2679      e = pLDeg(hn, &l) - op;
2680    }
2681    h = hn;
2682    hn = pNext(h);
2683  }
2684 
2685  all_done:
2686  if (strat->redTailChange)
2687  {
2688    L->last = 0;
2689    L->pLength = 0;
2690  }
2691  strat->kHEdgeFound = save_HE;
2692  return p;
2693}
2694
2695poly redtail (poly p, int pos, kStrategy strat)
2696{
2697  LObject L(p, currRing);
2698  return redtail(&L, pos, strat);
2699}
2700
2701
2702poly redtailBba (LObject* L, int pos, kStrategy strat, BOOLEAN withT)
2703{
2704  strat->redTailChange=FALSE;
2705  if (strat->noTailReduction) return L->GetLmCurrRing();
2706  poly h, p;
2707
2708  TObject* With;
2709  // placeholder in case strat->tl < 0
2710  TObject  With_s(strat->tailRing);
2711 
2712  h = L->GetLmTailRing();
2713  p = h;
2714  LObject Ln(pNext(h), strat->tailRing);
2715  Ln.pLength = L->GetpLength() - 1;
2716
2717  pNext(h) = NULL;
2718  if (L->p != NULL) pNext(L->p) = NULL;
2719  L->pLength = 1;
2720
2721  Ln.PrepareRed(strat->use_buckets);
2722
2723  while(!Ln.IsNull())
2724  {
2725    while (1)
2726    {
2727      Ln.SetShortExpVector();
2728      if (! withT)
2729      {
2730        With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
2731        if (With == NULL) break;
2732      }
2733      else
2734      {
2735        int j = kFindDivisibleByInT(strat->T, strat->sevT, strat->tl, &Ln);
2736        if (j < 0) break;
2737        With = &(strat->T[j]);
2738      }
2739      if (ksReducePolyTail(L, With, &Ln))
2740      {
2741        // reducing the tail would violate the exp bound
2742        pNext(h) = Ln.GetTP();
2743        L->pLength += Ln.GetpLength();
2744        if (L->p != NULL) pNext(L->p) = pNext(p);
2745        if (kStratChangeTailRing(strat, L))
2746          return redtailBba(L, pos, strat, withT);
2747        else
2748        { // should never get here -- need to fix this
2749          assume(0);
2750          return NULL;
2751        }
2752      }
2753      strat->redTailChange=TRUE;
2754      if (Ln.IsNull()) goto all_done;
2755    }
2756    pNext(h) = Ln.LmExtractAndIter();
2757    pIter(h);
2758    L->pLength++;
2759  }
2760
2761  all_done:
2762  if (L->p != NULL) pNext(L->p) = pNext(p);
2763  assume(pLength(L->p != NULL ? L->p : L->t_p) == L->pLength);
2764
2765  if (strat->redTailChange)
2766  {
2767    L->last = NULL;
2768    L->length = 0;
2769  }
2770  kTest_L(L);
2771  return L->GetLmCurrRing();
2772}
2773
2774/*2
2775*checks the change degree and write progress report
2776*/
2777void message (int i,int* reduc,int* olddeg,kStrategy strat, int red_result)
2778{
2779  if (i != *olddeg)
2780  {
2781    Print("%d",i);
2782    *olddeg = i;
2783  }
2784  if (K_TEST_OPT_OLDSTD)
2785  {
2786    if (strat->Ll != *reduc)
2787    {
2788      if (strat->Ll != *reduc-1)
2789        Print("(%d)",strat->Ll+1);
2790      else
2791        PrintS("-");
2792      *reduc = strat->Ll;
2793    }
2794    else
2795      PrintS(".");
2796    mflush();
2797  }
2798  else
2799  {
2800    if (red_result == 0)
2801      PrintS("-");
2802    else if (red_result < 0)
2803      PrintS(".");
2804    else
2805    {
2806      if (strat->Ll != *reduc && strat->Ll > 0)
2807      {
2808        Print("(%d)",strat->Ll+1);
2809        *reduc = strat->Ll;
2810      }
2811    }
2812  }
2813}
2814
2815/*2
2816*statistics
2817*/
2818void messageStat (int srmax,int lrmax,int hilbcount,kStrategy strat)
2819{
2820  //PrintS("\nUsage/Allocation of temporary storage:\n");
2821  //Print("%d/%d polynomials in standard base\n",srmax,IDELEMS(Shdl));
2822  //Print("%d/%d polynomials in set L (for lazy alg.)",lrmax+1,strat->Lmax);
2823  Print("\nproduct criterion:%d chain criterion:%d\n",strat->cp,strat->c3);
2824  if (hilbcount!=0) Print("hilbert series criterion:%d\n",hilbcount);
2825  /*mflush();*/
2826}
2827
2828#ifdef KDEBUG
2829/*2
2830*debugging output: all internal sets, if changed
2831*for testing purpuse only/has to be changed for later use
2832*/
2833void messageSets (kStrategy strat)
2834{
2835  int i;
2836  if (strat->news)
2837  {
2838    PrintS("set S");
2839    for (i=0; i<=strat->sl; i++)
2840    {
2841      Print("\n  %d:",i);
2842      p_wrp(strat->S[i], currRing, strat->tailRing);
2843    }
2844    strat->news = FALSE;
2845  }
2846  if (strat->newt)
2847  {
2848    PrintS("\nset T");
2849    for (i=0; i<=strat->tl; i++)
2850    {
2851      Print("\n  %d:",i);
2852      strat->T[i].wrp();
2853      Print(" o:%d e:%d l:%d",
2854        strat->T[i].pFDeg(),strat->T[i].ecart,strat->T[i].length);
2855    }
2856    strat->newt = FALSE;
2857  }
2858  PrintS("\nset L");
2859  for (i=strat->Ll; i>=0; i--)
2860  {
2861    Print("\n%d:",i);
2862    p_wrp(strat->L[i].p1, currRing, strat->tailRing);
2863    PrintS("  ");
2864    p_wrp(strat->L[i].p2, currRing, strat->tailRing);
2865    PrintS(" lcm: ");p_wrp(strat->L[i].lcm, currRing);
2866    PrintS("\n  p : ");
2867    strat->L[i].wrp();
2868    Print("  o:%d e:%d l:%d",
2869          strat->L[i].pFDeg(),strat->L[i].ecart,strat->L[i].length);
2870  }
2871  PrintLn();
2872}
2873
2874#endif
2875
2876
2877/*2
2878*construct the set s from F
2879*/
2880void initS (ideal F, ideal Q,kStrategy strat)
2881{
2882  int   i,pos;
2883
2884  if (Q!=NULL) i=IDELEMS(Q);
2885  else i=0;
2886  i=((i+IDELEMS(F)+15)/16)*16;
2887  strat->ecartS=initec(i);
2888  strat->sevS=initsevS(i);
2889  strat->S_2_R=initS_2_R(i);
2890  strat->fromQ=NULL;
2891  strat->Shdl=idInit(i,F->rank);
2892  strat->S=strat->Shdl->m;
2893  /*- put polys into S -*/
2894  if (Q!=NULL)
2895  {
2896    strat->fromQ=initec(i);
2897    memset(strat->fromQ,0,i*sizeof(int));
2898    for (i=0; i<IDELEMS(Q); i++)
2899    {
2900      if (Q->m[i]!=NULL)
2901      {
2902        LObject h;
2903        h.p = pCopy(Q->m[i]);
2904        if (TEST_OPT_INTSTRATEGY)
2905        {
2906          //pContent(h.p);
2907          h.pCleardenom(); // also does a pContent
2908        }
2909        else
2910        {
2911          h.pNorm();
2912        }
2913        strat->initEcart(&h);
2914        if (pOrdSgn==-1)
2915        {
2916          deleteHC(&h, strat);
2917        }
2918        if (h.p!=NULL)
2919        {
2920          if (strat->sl==-1)
2921            pos =0;
2922          else
2923          {
2924            pos = posInS(strat->S,strat->sl,h.p);
2925          }
2926          h.sev = pGetShortExpVector(h.p);
2927          strat->enterS(h,pos,strat);
2928          strat->fromQ[pos]=1;
2929        }
2930      }
2931    }
2932  }
2933  for (i=0; i<IDELEMS(F); i++)
2934  {
2935    if (F->m[i]!=NULL)
2936    {
2937      LObject h;
2938      h.p = pCopy(F->m[i]);
2939      if (TEST_OPT_INTSTRATEGY)
2940      {
2941        //pContent(h.p);
2942        h.pCleardenom(); // also does a pContent
2943      }
2944      else
2945      {
2946        h.pNorm();
2947      }
2948      strat->initEcart(&h);
2949      if (pOrdSgn==-1)
2950      {
2951        cancelunit(&h);  /*- tries to cancel a unit -*/
2952        deleteHC(&h, strat);
2953      }
2954      if (TEST_OPT_DEGBOUND
2955          && (((strat->honey) && (h.ecart+pFDeg(h.p)>Kstd1_deg))
2956              || ((!(strat->honey)) && (pFDeg(h.p)>Kstd1_deg))))
2957        pDelete(&h.p);
2958      else
2959        if (h.p!=NULL)
2960        {
2961          if (strat->sl==-1)
2962            pos =0;
2963          else
2964          {
2965            pos = posInS(strat->S,strat->sl,h.p);
2966          }
2967          h.sev = pGetShortExpVector(h.p);
2968          strat->enterS(h,pos,strat);
2969        }
2970    }
2971  }
2972  /*- test, if a unit is in F -*/
2973  if ((strat->sl>=0) && pIsConstant(strat->S[0]))
2974  {
2975    while (strat->sl>0) deleteInS(strat->sl,strat);
2976  }
2977}
2978
2979void initSL (ideal F, ideal Q,kStrategy strat)
2980{
2981  int   i,pos;
2982
2983  if (Q!=NULL) i=IDELEMS(Q);
2984  else i=0;
2985  i=((i+16)/16)*16;
2986  strat->ecartS=initec(i);
2987  strat->sevS=initsevS(i);
2988  strat->S_2_R=initS_2_R(i);
2989  strat->fromQ=NULL;
2990  strat->Shdl=idInit(i,F->rank);
2991  strat->S=strat->Shdl->m;
2992  /*- put polys into S -*/
2993  if (Q!=NULL)
2994  {
2995    strat->fromQ=initec(i);
2996    memset(strat->fromQ,0,i*sizeof(int));
2997    for (i=0; i<IDELEMS(Q); i++)
2998    {
2999      if (Q->m[i]!=NULL)
3000      {
3001        LObject h;
3002        h.p = pCopy(Q->m[i]);
3003        if (TEST_OPT_INTSTRATEGY)
3004        {
3005          //pContent(h.p);
3006          h.pCleardenom(); // also does a pContent
3007        }
3008        else
3009        {
3010          h.pNorm();
3011        }
3012        strat->initEcart(&h);
3013        if (pOrdSgn==-1)
3014        {
3015          deleteHC(&h,strat);
3016        }
3017        if (h.p!=NULL)
3018        {
3019          if (strat->sl==-1)
3020            pos =0;
3021          else
3022          {
3023            pos = posInS(strat->S,strat->sl,h.p);
3024          }
3025          h.sev = pGetShortExpVector(h.p);
3026          strat->enterS(h,pos,strat);
3027          strat->fromQ[pos]=1;
3028        }
3029      }
3030    }
3031  }
3032  for (i=0; i<IDELEMS(F); i++)
3033  {
3034    if (F->m[i]!=NULL)
3035    {
3036      LObject h;
3037      h.p = pCopy(F->m[i]);
3038      if (TEST_OPT_INTSTRATEGY)
3039      {
3040        //pContent(h.p);
3041        h.pCleardenom(); // also does a pContent
3042      }
3043      else
3044      {
3045        h.pNorm();
3046      }
3047      strat->initEcart(&h);
3048      if (pOrdSgn==-1)
3049      {
3050        cancelunit(&h);  /*- tries to cancel a unit -*/
3051        deleteHC(&h, strat);
3052      }
3053      if (TEST_OPT_DEGBOUND
3054          && (((strat->honey) && (h.ecart+pFDeg(h.p)>Kstd1_deg))
3055              || ((!(strat->honey)) && (pFDeg(h.p)>Kstd1_deg))))
3056        pDelete(&h.p);
3057      else
3058        if (h.p!=NULL)
3059        {
3060          if (strat->Ll==-1)
3061            pos =0;
3062          else
3063          {
3064            pos = strat->posInL(strat->L,strat->Ll,&h,strat);
3065          }
3066          h.sev = pGetShortExpVector(h.p);
3067          enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
3068        }
3069    }
3070  }
3071  /*- test, if a unit is in F -*/
3072  if ((strat->Ll>=0) && pIsConstant(strat->L[strat->Ll].p))
3073  {
3074    while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
3075  }
3076}
3077
3078
3079/*2
3080*construct the set s from F u {P}
3081*/
3082void initSSpecial (ideal F, ideal Q, ideal P,kStrategy strat)
3083{
3084  int   i,pos;
3085
3086  if (Q!=NULL) i=IDELEMS(Q);
3087  else i=0;
3088  i=((i+IDELEMS(F)+15)/16)*16;
3089  strat->ecartS=initec(i);
3090  strat->sevS=initsevS(i);
3091  strat->S_2_R=initS_2_R(i);
3092  strat->fromQ=NULL;
3093  strat->Shdl=idInit(i,F->rank);
3094  strat->S=strat->Shdl->m;
3095
3096  /*- put polys into S -*/
3097  if (Q!=NULL)
3098  {
3099    strat->fromQ=initec(i);
3100    memset(strat->fromQ,0,i*sizeof(int));
3101    for (i=0; i<IDELEMS(Q); i++)
3102    {
3103      if (Q->m[i]!=NULL)
3104      {
3105        LObject h;
3106        h.p = pCopy(Q->m[i]);
3107        //if (TEST_OPT_INTSTRATEGY)
3108        //{
3109        //  //pContent(h.p);
3110        //  h.pCleardenom(); // also does a pContent
3111        //}
3112        //else
3113        //{
3114        //  h.pNorm();
3115        //}
3116        strat->initEcart(&h);
3117        if (pOrdSgn==-1)
3118        {
3119          deleteHC(&h,strat);
3120        }
3121        if (h.p!=NULL)
3122        {
3123          if (strat->sl==-1)
3124            pos =0;
3125          else
3126          {
3127            pos = posInS(strat->S,strat->sl,h.p);
3128          }
3129          h.sev = pGetShortExpVector(h.p);
3130          h.SetpFDeg();
3131          strat->enterS(h,pos,strat, strat->tl+1);
3132          enterT(h, strat);
3133          strat->fromQ[pos]=1;
3134        }
3135      }
3136    }
3137  }
3138  /*- put polys into S -*/
3139  for (i=0; i<IDELEMS(F); i++)
3140  {
3141    if (F->m[i]!=NULL)
3142    {
3143      LObject h;
3144      h.p = pCopy(F->m[i]);
3145      if (pOrdSgn==1)
3146      {
3147        h.p=redtailBba(h.p,strat->sl,strat);
3148      }
3149      strat->initEcart(&h);
3150      if (pOrdSgn==-1)
3151      {
3152        deleteHC(&h,strat);
3153      }
3154      if (TEST_OPT_DEGBOUND
3155      && (((strat->honey) && (h.ecart+pFDeg(h.p)>Kstd1_deg))
3156        || ((!(strat->honey)) && (pFDeg(h.p)>Kstd1_deg))))
3157        pDelete(&h.p);
3158      else
3159      if (h.p!=NULL)
3160      {
3161        if (strat->sl==-1)
3162          pos =0;
3163        else
3164        {
3165          pos = posInS(strat->S,strat->sl,h.p);
3166        }
3167        h.sev = pGetShortExpVector(h.p);
3168        strat->enterS(h,pos,strat, strat->tl+1);
3169        h.length = pLength(h.p);
3170        h.SetpFDeg();
3171        enterT(h,strat);
3172      }
3173    }
3174  }
3175  for (i=0; i<IDELEMS(P); i++)
3176  {
3177    if (P->m[i]!=NULL)
3178    {
3179      LObject h;
3180      h.p=pCopy(P->m[i]);
3181      strat->initEcart(&h);
3182      h.length = pLength(h.p);
3183      if (TEST_OPT_INTSTRATEGY)
3184      {
3185        h.pCleardenom();
3186      }
3187      else
3188      {
3189        h.pNorm();
3190      }
3191      if(strat->sl>=0)
3192      {
3193        if (pOrdSgn==1)
3194        {
3195          h.p=redBba(h.p,strat->sl,strat);
3196          if (h.p!=NULL)
3197            h.p=redtailBba(h.p,strat->sl,strat);
3198        }
3199        else
3200        {
3201          h.p=redMora(h.p,strat->sl,strat);
3202          strat->initEcart(&h);
3203        }
3204        if(h.p!=NULL)
3205        {
3206          if (TEST_OPT_INTSTRATEGY)
3207          {
3208            h.pCleardenom();
3209          }
3210          else
3211          {
3212            h.is_normalized = 0;
3213            h.pNorm();
3214          }
3215          h.sev = pGetShortExpVector(h.p);
3216          h.SetpFDeg();
3217          pos = posInS(strat->S,strat->sl,h.p);
3218          enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
3219          strat->enterS(h,pos,strat, strat->tl+1);
3220          enterT(h,strat);
3221        }
3222      }
3223      else
3224      {
3225        h.sev = pGetShortExpVector(h.p);
3226        h.SetpFDeg();
3227        strat->enterS(h,0,strat, strat->tl+1);
3228        enterT(h,strat);
3229      }
3230    }
3231  }
3232}
3233/*2
3234* reduces h using the set S
3235* procedure used in cancelunit1
3236*/
3237static poly redBba1 (poly h,int maxIndex,kStrategy strat)
3238{
3239  int j = 0;
3240  unsigned long not_sev = ~ pGetShortExpVector(h);
3241
3242  while (j <= maxIndex)
3243  {
3244    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j],h, not_sev))
3245       return ksOldSpolyRedNew(strat->S[j],h,strat->kNoether);
3246    else j++;
3247  }
3248  return h;
3249}
3250
3251/*2
3252*tests if p.p=monomial*unit and cancels the unit
3253*/
3254void cancelunit1 (LObject* p,int index,kStrategy strat )
3255{
3256  int k;
3257  poly r,h,h1,q;
3258
3259  if (!pIsVector((*p).p) && ((*p).ecart != 0))
3260  {
3261    k = 0;
3262    h1 = r = pCopy((*p).p);
3263    h =pNext(r);
3264    loop
3265    {
3266      if (h==NULL)
3267      {
3268        pDelete(&r);
3269        pDelete(&(pNext((*p).p)));
3270        (*p).ecart = 0;
3271        (*p).length = 1;
3272        return;
3273      }
3274      if (!pDivisibleBy(r,h))
3275      {
3276        q=redBba1(h,index ,strat);
3277        if (q != h)
3278        {
3279          k++;
3280          pDelete(&h);
3281          pNext(h1) = h = q;
3282        }
3283        else
3284        {
3285          pDelete(&r);
3286          return;
3287        }
3288      }
3289      else
3290      {
3291        h1 = h;
3292        pIter(h);
3293      }
3294      if (k > 10)
3295      {
3296        pDelete(&r);
3297        return;
3298      }
3299    }
3300  }
3301}
3302
3303/*2
3304* reduces h using the elements from Q in the set S
3305* procedure used in updateS
3306* must not be used for elements of Q or elements of an ideal !
3307*/
3308static poly redQ (poly h, int j, kStrategy strat)
3309{
3310  int start;
3311  unsigned long not_sev = ~ pGetShortExpVector(h);
3312  while ((j <= strat->sl) && (pGetComp(strat->S[j])!=0)) j++;
3313  start=j;
3314  while (j<=strat->sl)
3315  {
3316    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
3317    {
3318      h = ksOldSpolyRed(strat->S[j],h,strat->kNoether);
3319      if (h==NULL) return NULL;
3320      j = start;
3321      not_sev = ~ pGetShortExpVector(h);
3322    }
3323    else j++;
3324  }
3325  return h;
3326}
3327
3328/*2
3329* reduces h using the set S
3330* procedure used in updateS
3331*/
3332static poly redBba (poly h,int maxIndex,kStrategy strat)
3333{
3334  int j = 0;
3335  unsigned long not_sev = ~ pGetShortExpVector(h);
3336
3337  while (j <= maxIndex)
3338  {
3339    if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
3340    {
3341      h = ksOldSpolyRed(strat->S[j],h,strat->kNoether);
3342      if (h==NULL) return NULL;
3343      j = 0;
3344      not_sev = ~ pGetShortExpVector(h);    }
3345    else j++;
3346  }
3347  return h;
3348}
3349
3350/*2
3351* reduces h using the set S
3352*e is the ecart of h
3353*procedure used in updateS
3354*/
3355static poly redMora (poly h,int maxIndex,kStrategy strat)
3356{
3357  int  j=0;
3358  int  e,l;
3359  unsigned long not_sev = ~ pGetShortExpVector(h);
3360
3361  if (maxIndex >= 0)
3362  {
3363    e = pLDeg(h,&l)-pFDeg(h);
3364    do
3365    {
3366      if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev)
3367      && ((e >= strat->ecartS[j]) || strat->kHEdgeFound))
3368      {
3369#ifdef KDEBUG
3370        if (TEST_OPT_DEBUG)
3371          {PrintS("reduce ");wrp(h);Print(" with S[%d] (",j);wrp(strat->S[j]);}
3372       
3373#endif         
3374        h = ksOldSpolyRed(strat->S[j],h,strat->kNoether);
3375#ifdef KDEBUG
3376        if(TEST_OPT_DEBUG)
3377          {PrintS(")\nto "); wrp(h); PrintLn();}
3378       
3379#endif
3380        // pDelete(&h);
3381        if (h == NULL) return NULL;
3382        e = pLDeg(h,&l)-pFDeg(h);
3383        j = 0;
3384        not_sev = ~ pGetShortExpVector(h);
3385      }
3386      else j++;
3387    }
3388    while (j <= maxIndex);
3389  }
3390  return h;
3391}
3392
3393/*2
3394*updates S:
3395*the result is a set of polynomials which are in
3396*normalform with respect to S
3397*/
3398void updateS(BOOLEAN toT,kStrategy strat)
3399{
3400  LObject h;
3401  int i, suc=0;
3402  poly redSi=NULL;
3403//Print("nach initS: updateS start mit sl=%d\n",(strat->sl));
3404//  for (i=0; i<=(strat->sl); i++)
3405//  {
3406//    Print("s%d:",i);
3407//    if (strat->fromQ!=NULL) Print("(Q:%d) ",strat->fromQ[i]);
3408//    pWrite(strat->S[i]);
3409//  }
3410  if (pOrdSgn==1)
3411  {
3412    while (suc != -1)
3413    {
3414      i=suc+1;
3415      while (i<=strat->sl)
3416      {
3417        if (((strat->syzComp==0) || (pGetComp(strat->S[i])<=strat->syzComp))
3418        && ((strat->fromQ==NULL) || (strat->fromQ[i]==0)))
3419        {
3420          pDelete(&redSi);
3421          redSi = pHead(strat->S[i]);
3422          strat->S[i] = redBba(strat->S[i],i-1,strat);
3423          if ((strat->ak!=0)&&(strat->S[i]!=NULL))
3424            strat->S[i]=redQ(strat->S[i],i+1,strat); /*reduce S[i] mod Q*/
3425          if (TEST_OPT_DEBUG && (pCmp(redSi,strat->S[i])!=0))
3426          {
3427            PrintS("reduce:");
3428            wrp(redSi);PrintS(" to ");p_wrp(strat->S[i], currRing, strat->tailRing);PrintLn();
3429          }
3430          if (TEST_OPT_PROT && (pCmp(redSi,strat->S[i])!=0))
3431          {
3432            if (strat->S[i]==NULL)
3433              PrintS("V");
3434            else
3435              PrintS("v");
3436            mflush();
3437          }
3438          if (strat->S[i]==NULL)
3439          {
3440            pDelete(&redSi);
3441            deleteInS(i,strat);
3442            i--;
3443          }
3444          else
3445          {
3446            pDelete(&redSi);
3447            if (TEST_OPT_INTSTRATEGY)
3448            {
3449              //pContent(strat->S[i]);
3450              pCleardenom(strat->S[i]);// also does a pContent
3451            }
3452            else
3453            {
3454              pNorm(strat->S[i]);
3455            }
3456            strat->sevS[i] = pGetShortExpVector(strat->S[i]);
3457          }
3458        }
3459        i++;
3460      }
3461      reorderS(&suc,strat);
3462    }
3463    if (toT)
3464    {
3465      for (i=0; i<=strat->sl; i++)
3466      {
3467        if (((strat->fromQ==NULL) || (strat->fromQ[i]==0))
3468        )
3469          h.p = redtailBba(strat->S[i],i-1,strat);
3470        else
3471        {
3472          h.p = strat->S[i];
3473        }
3474        if (strat->honey)
3475        {
3476          strat->initEcart(&h);
3477          strat->ecartS[i] = h.ecart;
3478        }
3479        if (strat->sevS[i] == 0) {strat->sevS[i] = pGetShortExpVector(h.p);}
3480        else assume(strat->sevS[i] == pGetShortExpVector(h.p));
3481        h.sev = strat->sevS[i];
3482        h.SetpFDeg();
3483        /*puts the elements of S also to T*/
3484        enterT(h,strat);
3485        strat->S_2_R[i] = strat->tl;
3486      }
3487    }
3488  }
3489  else
3490  {
3491    while (suc != -1)
3492    {
3493      i=suc+1;
3494      while (i<=strat->sl)
3495      {
3496        if (((strat->syzComp==0) || (pGetComp(strat->S[i])<=strat->syzComp))
3497        && ((strat->fromQ==NULL) || (strat->fromQ[i]==0)))
3498        {
3499          pDelete(&redSi);
3500          redSi=pHead((strat->S)[i]);
3501          (strat->S)[i] = redMora((strat->S)[i],i-1,strat);
3502          if ((strat->S)[i]==NULL)
3503          {
3504            deleteInS(i,strat);
3505            i--;
3506          }
3507          else
3508          {
3509            if (TEST_OPT_INTSTRATEGY)
3510            {
3511              pDelete(&redSi);
3512              pCleardenom(strat->S[i]);// also does a pContent
3513              h.p = strat->S[i];
3514              strat->initEcart(&h);
3515              strat->ecartS[i] = h.ecart;
3516            }
3517            else
3518            {
3519              pDelete(&redSi);
3520              pNorm(strat->S[i]);
3521              h.p = strat->S[i];
3522              strat->initEcart(&h);
3523              strat->ecartS[i] = h.ecart;
3524            }
3525            h.sev =  pGetShortExpVector(h.p);
3526            strat->sevS[i] = h.sev;
3527          }
3528          kTest(strat);
3529        }
3530        i++;
3531      }
3532#ifdef KDEBUG
3533      kTest(strat);
3534#endif
3535      reorderS(&suc,strat);
3536      if (h.p!=NULL)
3537      {
3538        if (!strat->kHEdgeFound)
3539        {
3540          /*strat->kHEdgeFound =*/ HEckeTest(h.p,strat);
3541        }
3542        if (strat->kHEdgeFound)
3543          newHEdge(strat->S,strat->ak,strat);
3544      }
3545    }
3546    for (i=0; i<=strat->sl; i++)
3547    {
3548      if (((strat->fromQ==NULL) || (strat->fromQ[i]==0))
3549      )
3550      {
3551        strat->S[i] = h.p = redtail(strat->S[i],strat->sl,strat);
3552        strat->initEcart(&h);
3553        strat->ecartS[i] = h.ecart;
3554        h.sev = pGetShortExpVector(h.p);
3555        strat->sevS[i] = h.sev;
3556      }
3557      else
3558      {
3559        h.p = strat->S[i];
3560        h.ecart=strat->ecartS[i];
3561        h.sev = strat->sevS[i];
3562      }
3563      if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
3564        cancelunit1(&h,strat->sl,strat);
3565      h.length = pLength(h.p);
3566      h.SetpFDeg();
3567      /*puts the elements of S also to T*/
3568      enterT(h,strat);
3569      strat->S_2_R[i] = strat->tl;
3570    }
3571  }
3572  if (redSi!=NULL) pDeleteLm(&redSi);
3573#ifdef KDEBUG
3574  kTest(strat);
3575#endif
3576}
3577
3578
3579/*2
3580* -puts p to the standardbasis s at position at
3581* -saves the result in S
3582*/
3583void enterSBba (LObject p,int atS,kStrategy strat, int atR)
3584{
3585  int i;
3586  strat->news = TRUE;
3587  /*- puts p to the standardbasis s at position at -*/
3588  if (strat->sl == IDELEMS(strat->Shdl)-1)
3589  {
3590    strat->sevS = (unsigned long*) omRealloc0Size(strat->sevS,
3591                                    IDELEMS(strat->Shdl)*sizeof(unsigned long),
3592                                    (IDELEMS(strat->Shdl)+setmax)
3593                                                  *sizeof(unsigned long));
3594    strat->ecartS = (intset)omReallocSize(strat->ecartS,
3595                                          IDELEMS(strat->Shdl)*sizeof(int),
3596                                          (IDELEMS(strat->Shdl)+setmax)*sizeof(int));
3597    strat->S_2_R = (int*) omRealloc0Size(strat->S_2_R, 
3598                                         IDELEMS(strat->Shdl)*sizeof(int),
3599                                         (IDELEMS(strat->Shdl)+setmax)
3600                                                  *sizeof(int));
3601    if (strat->fromQ!=NULL)
3602    {
3603      strat->fromQ = (intset)omReallocSize(strat->fromQ,
3604                                    IDELEMS(strat->Shdl)*sizeof(int),
3605                                    (IDELEMS(strat->Shdl)+setmax)*sizeof(int));
3606    }
3607    pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmax);
3608    IDELEMS(strat->Shdl)+=setmax;
3609    strat->Shdl->m=strat->S;
3610  }
3611  if (atS <= strat->sl)
3612  {
3613#ifdef ENTER_USE_MEMMOVE
3614// #if 0
3615    memmove(&(strat->S[atS+1]), &(strat->S[atS]), 
3616            (strat->sl - atS + 1)*sizeof(poly));
3617    memmove(&(strat->ecartS[atS+1]), &(strat->ecartS[atS]), 
3618            (strat->sl - atS + 1)*sizeof(int));
3619    memmove(&(strat->sevS[atS+1]), &(strat->sevS[atS]), 
3620            (strat->sl - atS + 1)*sizeof(unsigned long));
3621    memmove(&(strat->S_2_R[atS+1]), &(strat->S_2_R[atS]), 
3622            (strat->sl - atS + 1)*sizeof(int));
3623#else   
3624    for (i=strat->sl+1; i>=atS+1; i--)
3625    {
3626      strat->S[i] = strat->S[i-1];
3627      strat->ecartS[i] = strat->ecartS[i-1];
3628      strat->sevS[i] = strat->sevS[i-1];
3629      strat->S_2_R[i] = strat->S_2_R[i-1];
3630    }
3631#endif
3632  }
3633  if (strat->fromQ!=NULL)
3634  {
3635    for (i=strat->sl+1; i>=atS+1; i--)
3636    {
3637      strat->fromQ[i] = strat->fromQ[i-1];
3638    }
3639    strat->fromQ[atS]=0;
3640  }
3641
3642  /*- save result -*/
3643  strat->S[atS] = p.p;
3644  if (strat->honey) strat->ecartS[atS] = p.ecart;
3645  if (p.sev == 0)
3646    p.sev = pGetShortExpVector(p.p);
3647  else
3648    assume(p.sev == pGetShortExpVector(p.p));
3649  strat->sevS[atS] = p.sev;
3650  strat->ecartS[atS] = p.ecart;
3651  strat->S_2_R[atS] = atR;
3652  strat->sl++;
3653}
3654
3655/*2
3656* puts p to the set T at position atT
3657*/
3658void enterT(LObject p, kStrategy strat, int atT = -1)
3659{
3660  int i;
3661
3662  pp_Test(p.p, currRing, p.tailRing);
3663  assume(strat->tailRing == p.tailRing);
3664  // redMoraNF complains about this -- but, we don't really
3665  // neeed this so far
3666  // assume(p.pLength == 0 || pLength(p.p) == p.pLength);
3667  assume(p.FDeg == p.pFDeg());
3668  assume(!p.is_normalized || nIsOne(pGetCoeff(p.p)));
3669
3670  strat->newt = TRUE;
3671  if (atT < 0)
3672    atT = strat->posInT(strat->T, strat->tl, p);
3673  if (strat->tl == strat->tmax-1) 
3674    enlargeT(strat->T,strat->R,strat->sevT,strat->tmax,setmax);
3675  if (atT <= strat->tl)
3676  {
3677#ifdef ENTER_USE_MEMMOVE
3678    memmove(&(strat->T[atT+1]), &(strat->T[atT]), 
3679            (strat->tl-atT+1)*sizeof(TObject));
3680    memmove(&(strat->sevT[atT+1]), &(strat->sevT[atT]), 
3681            (strat->tl-atT+1)*sizeof(unsigned long));
3682#endif
3683    for (i=strat->tl+1; i>=atT+1; i--)
3684    {
3685#ifndef ENTER_USE_MEMMOVE
3686      strat->T[i] = strat->T[i-1];
3687      strat->sevT[i] = strat->sevT[i-1];
3688#endif
3689      strat->R[strat->T[i].i_r] = &(strat->T[i]);
3690    }
3691  }
3692
3693  if (strat->tailBin != NULL && (pNext(p.p) != NULL))
3694  {
3695    pNext(p.p)=p_ShallowCopyDelete(pNext(p.p),
3696                                   (strat->tailRing != NULL ? 
3697                                    strat->tailRing : currRing),
3698                                   strat->tailBin);
3699    if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
3700  }
3701  strat->T[atT] = (TObject) p;
3702
3703  if (strat->tailRing != currRing && pNext(p.p) != NULL)
3704    strat->T[atT].max = p_GetMaxExpP(pNext(p.p), strat->tailRing);
3705  else
3706    strat->T[atT].max = NULL;
3707
3708  strat->tl++;
3709  strat->R[strat->tl] = &(strat->T[atT]);
3710  strat->T[atT].i_r = strat->tl;
3711  assume(p.sev == 0 || pGetShortExpVector(p.p) == p.sev);
3712  strat->sevT[atT] = (p.sev == 0 ? pGetShortExpVector(p.p) : p.sev);
3713  kTest_T(&(strat->T[atT]));
3714}
3715
3716void initHilbCrit(ideal F, ideal Q, intvec **hilb,kStrategy strat)
3717{
3718  if (strat->homog!=isHomog)
3719  {
3720    *hilb=NULL;
3721  }
3722}
3723
3724void initBuchMoraCrit(kStrategy strat)
3725{
3726  strat->sugarCrit =        TEST_OPT_SUGARCRIT;
3727  // obachman: Hmm.. I need BTEST1(2) for notBuckets ..
3728  //  strat->Gebauer =          BTEST1(2) || strat->homog || strat->sugarCrit;
3729  strat->Gebauer =          strat->homog || strat->sugarCrit;
3730  strat->honey =            !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
3731  if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
3732  strat->pairtest = NULL;
3733  /* alway use tailreduction, except:
3734  * - in local rings, - in lex order case, -in ring over extensions */
3735  strat->noTailReduction = !TEST_OPT_REDTAIL;
3736  if (TEST_OPT_DEBUG)
3737  {
3738    if (strat->homog) PrintS("ideal/module is homogeneous\n");
3739    else              PrintS("ideal/module is not homogeneous\n");
3740  }
3741}
3742
3743BOOLEAN kPosInLDependsOnLength(int (*pos_in_l)
3744                               (const LSet set, const int length,
3745                                LObject* L,const kStrategy strat))
3746{
3747  if (pos_in_l == posInL110 ||
3748      pos_in_l == posInL10) 
3749    return TRUE;
3750
3751  return FALSE;
3752}
3753
3754void initBuchMoraPos (kStrategy strat)
3755{
3756  if (pOrdSgn==1)
3757  {
3758    if (strat->honey)
3759    {
3760      strat->posInL = posInL15;
3761      // ok -- here is the deal: from my experiments for Singular-2-0
3762      // I conclude that that posInT_EcartpLength is the best of
3763      // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
3764      // see the table at the end of this file
3765      if (K_TEST_OPT_OLDSTD)
3766        strat->posInT = posInT15;
3767      else
3768        strat->posInT = posInT_EcartpLength;
3769    }
3770    else if (pLexOrder && !TEST_OPT_INTSTRATEGY)
3771    {
3772      strat->posInL = posInL11;
3773      strat->posInT = posInT11;
3774    }
3775    else if (TEST_OPT_INTSTRATEGY)
3776    {
3777      strat->posInL = posInL11;
3778      strat->posInT = posInT11;
3779    }
3780    else
3781    {
3782      strat->posInL = posInL0;
3783      strat->posInT = posInT0;
3784    }
3785    //if (strat->minim>0) strat->posInL =posInLSpecial;
3786  }
3787  else
3788  {
3789    if (strat->homog)
3790    {
3791      strat->posInL = posInL11;
3792      strat->posInT = posInT11;
3793    }
3794    else
3795    {
3796      if ((currRing->order[0]==ringorder_c)
3797      ||(currRing->order[0]==ringorder_C))
3798      {
3799        strat->posInL = posInL17_c;
3800        strat->posInT = posInT17_c;
3801      }
3802      else
3803      {
3804        strat->posInL = posInL17;
3805        strat->posInT = posInT17;
3806      }
3807    }
3808  }
3809  if (strat->minim>0) strat->posInL =posInLSpecial;
3810  // for further tests only
3811  if ((BTEST1(11)) || (BTEST1(12)))
3812    strat->posInL = posInL11;
3813  else if ((BTEST1(13)) || (BTEST1(14)))
3814    strat->posInL = posInL13;
3815  else if ((BTEST1(15)) || (BTEST1(16)))
3816    strat->posInL = posInL15;
3817  else if ((BTEST1(17)) || (BTEST1(18)))
3818    strat->posInL = posInL17;
3819  if (BTEST1(11))
3820    strat->posInT = posInT11;
3821  else if (BTEST1(13))
3822    strat->posInT = posInT13;
3823  else if (BTEST1(15))
3824    strat->posInT = posInT15;
3825  else if ((BTEST1(17)))
3826    strat->posInT = posInT17;
3827  else if ((BTEST1(19)))
3828    strat->posInT = posInT19;
3829  else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
3830    strat->posInT = posInT1;
3831  strat->posInLDependsOnLength = kPosInLDependsOnLength(strat->posInL);
3832}
3833
3834void initBuchMora (ideal F,ideal Q,kStrategy strat)
3835{
3836  strat->interpt = BTEST1(OPT_INTERRUPT);
3837  strat->kHEdge=NULL;
3838  if (pOrdSgn==1) strat->kHEdgeFound=FALSE;
3839  /*- creating temp data structures------------------- -*/
3840  strat->cp = 0;
3841  strat->c3 = 0;
3842  strat->tail = pInit();
3843  /*- set s -*/
3844  strat->sl = -1;
3845  /*- set L -*/
3846  strat->Lmax = setmax;
3847  strat->Ll = -1;
3848  strat->L = initL();
3849  /*- set B -*/
3850  strat->Bmax = setmax;
3851  strat->Bl = -1;
3852  strat->B = initL();
3853  /*- set T -*/
3854  strat->tl = -1;
3855  strat->tmax = setmax;
3856  strat->T = initT();
3857  strat->R = initR();
3858  strat->sevT = initsevT();
3859  /*- init local data struct.---------------------------------------- -*/
3860  strat->P.ecart=0;
3861  strat->P.length=0;
3862  if (pOrdSgn==-1)
3863  {
3864    if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
3865    if (strat->kNoether!=NULL) pSetComp(strat->kNoether, strat->ak);
3866  }
3867  if(TEST_OPT_SB_1)
3868  {
3869    int i;
3870    ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
3871    for (i=strat->newIdeal;i<IDELEMS(F);i++)
3872    {
3873      P->m[i-strat->newIdeal] = F->m[i];
3874      F->m[i] = NULL;
3875    }
3876    initSSpecial(F,Q,P,strat);
3877    for (i=strat->newIdeal;i<IDELEMS(F);i++)
3878    {
3879      F->m[i] = P->m[i-strat->newIdeal];
3880      P->m[i-strat->newIdeal] = NULL;
3881    }
3882    idDelete(&P);
3883  }
3884  else
3885  {
3886    /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
3887    // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
3888  }
3889  strat->kIdeal = NULL;
3890  strat->fromT = FALSE;
3891  strat->noTailReduction = !TEST_OPT_REDTAIL;
3892  if(!TEST_OPT_SB_1)
3893  {
3894    updateS(TRUE,strat);
3895    pairs(strat);
3896  }
3897  if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
3898  strat->fromQ=NULL;
3899}
3900
3901void exitBuchMora (kStrategy strat)
3902{
3903  /*- release temp data -*/
3904  cleanT(strat);
3905  omFreeSize(strat->T,(strat->tmax)*sizeof(TObject));
3906  omFreeSize(strat->R,(strat->tmax)*sizeof(TObject*));
3907  omFreeSize(strat->sevT, (strat->tmax)*sizeof(unsigned long));
3908  omFreeSize(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
3909  omFreeSize(strat->sevS,IDELEMS(strat->Shdl)*sizeof(int));
3910  omFreeSize(strat->S_2_R,IDELEMS(strat->Shdl)*sizeof(int));
3911  /*- set L: should be empty -*/
3912  omFreeSize(strat->L,(strat->Lmax)*sizeof(LObject));
3913  /*- set B: should be empty -*/
3914  omFreeSize(strat->B,(strat->Bmax)*sizeof(LObject));
3915  pDeleteLm(&strat->tail);
3916  strat->syzComp=0;
3917  if (strat->kIdeal!=NULL)
3918  {
3919    omFreeBin(strat->kIdeal, sleftv_bin);
3920    strat->kIdeal=NULL;
3921  }
3922}
3923
3924/*2
3925* in the case of a standardbase of a module over a qring:
3926* replace polynomials in i by ak vectors,
3927* (the polynomial * unit vectors gen(1)..gen(ak)
3928* in every case (also for ideals:)
3929* deletes divisible vectors/polynomials
3930*/
3931void updateResult(ideal r,ideal Q,kStrategy strat)
3932{
3933  int l;
3934  if (strat->ak>0)
3935  {
3936    for (l=IDELEMS(r)-1;l>=0;l--)
3937    {
3938      if ((r->m[l]!=NULL) && (pGetComp(r->m[l])==0))
3939      {
3940        pDelete(&r->m[l]); // and set it to NULL
3941      }
3942    }
3943  }
3944  else
3945  {
3946    int q;
3947    poly p;
3948    for (l=IDELEMS(r)-1;l>=0;l--)
3949    {
3950      if (r->m[l]!=NULL)
3951      {
3952        for(q=IDELEMS(Q)-1; q>=0;q--)
3953        {
3954          if ((Q->m[q]!=NULL)
3955          &&(pLmEqual(r->m[l],Q->m[q])))
3956          {
3957            if (TEST_OPT_REDSB)
3958            {
3959              p=r->m[l];
3960              r->m[l]=kNF(Q,NULL,p);
3961              pDelete(&p);
3962            }
3963            else
3964            {
3965              pDelete(&r->m[l]); // and set it to NULL
3966            }
3967            break;
3968          }
3969        }
3970      }
3971    }
3972  }
3973  idSkipZeroes(r);
3974}
3975
3976void completeReduce (kStrategy strat)
3977{
3978  int i;
3979
3980  strat->noTailReduction = FALSE;
3981  if (TEST_OPT_PROT)
3982  {
3983    PrintLn();
3984    if (timerv) writeTime("standard base computed:");
3985  }
3986  if (TEST_OPT_PROT)
3987  {
3988    Print("(S:%d)",strat->sl);mflush();
3989  }
3990  if(pOrdSgn==1)
3991  {
3992    for (i=strat->sl; i>0; i--)
3993    {
3994      TObject* T_j = strat->s_2_t(i);
3995      if (T_j != NULL)
3996      {
3997        assume(strat->S[i] == T_j->p);
3998        strat->S[i] = redtailBba(T_j, i-1, strat);
3999        assume(strat->S[i] == T_j->p);
4000        if (strat->redTailChange && strat->tailRing != currRing)
4001        {
4002          if (T_j->max != NULL) p_LmFree(T_j->max, strat->tailRing);
4003          if (pNext(T_j->p) != NULL) 
4004            T_j->max = p_GetMaxExpP(pNext(T_j->p), strat->tailRing);
4005          else
4006            T_j->max = NULL;
4007        }
4008      }
4009      else
4010        strat->S[i] = redtailBba(strat->S[i],i-1,strat);
4011
4012      if (TEST_OPT_INTSTRATEGY)
4013      {
4014        //if (strat->redTailChange)
4015          pCleardenom(strat->S[i]);
4016      }
4017      if (TEST_OPT_PROT)
4018      {
4019        PrintS("-");mflush();
4020      }
4021    }
4022  }
4023  else
4024  {
4025    for (i=strat->sl; i>=0; i--)
4026    {
4027      strat->S[i] = redtail(strat->S[i],strat->sl,strat);
4028      // Hmm .. this might also change strat->T[i]
4029      // but, we don't need it any more
4030      if (TEST_OPT_INTSTRATEGY)
4031        pCleardenom(strat->S[i]);
4032      if (TEST_OPT_PROT)
4033        PrintS("-");
4034    }
4035  }
4036}
4037
4038
4039/*2
4040* computes the new strat->kHEdge and the new pNoether,
4041* returns TRUE, if pNoether has changed
4042*/
4043BOOLEAN newHEdge(polyset S, int ak,kStrategy strat)
4044{
4045  int i,j;
4046  poly newNoether;
4047
4048  scComputeHC(strat->Shdl,ak,strat->kHEdge);
4049  /* compare old and new noether*/
4050  newNoether = pLmInit(strat->kHEdge);
4051  j = pFDeg(newNoether);
4052  for (i=1; i<=pVariables; i++)
4053  {
4054    if (pGetExp(newNoether, i) > 0) pDecrExp(newNoether,i);
4055  }
4056  pSetm(newNoether);
4057  if (j < strat->HCord) /*- statistics -*/
4058  {
4059    if (TEST_OPT_PROT)
4060    {
4061      Print("H(%d)",j);
4062      mflush();
4063    }
4064    strat->HCord=j;
4065    if (TEST_OPT_DEBUG)
4066    {
4067      Print("H(%d):",j);
4068      wrp(strat->kHEdge);
4069      PrintLn();
4070    }
4071  }
4072  if (pCmp(strat->kNoether,newNoether)!=1)
4073  {
4074    pDelete(&strat->kNoether);
4075    strat->kNoether=newNoether;
4076    return TRUE;
4077  }
4078  pLmFree(newNoether);
4079  return FALSE;
4080}
4081
4082/***************************************************************
4083 *
4084 * Routines related for ring changes during std computations
4085 *
4086 ***************************************************************/
4087BOOLEAN kCheckSpolyCreation(LObject *L, kStrategy strat, poly &m1, poly &m2)
4088{
4089  assume(L->p1 != NULL && L->p2 != NULL);
4090  assume(L->i_r1 >= 0 && L->i_r1 <= strat->tl);
4091  assume(L->i_r2 >= 0 && L->i_r2 <= strat->tl);
4092  assume(strat->tailRing != currRing);
4093 
4094  if (! k_GetLeadTerms(L->p1, L->p2, currRing, m1, m2, strat->tailRing))
4095    return FALSE;
4096  poly p1_max = (strat->R[L->i_r1])->max;
4097  poly p2_max = (strat->R[L->i_r2])->max;
4098 
4099  if ((p1_max != NULL && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
4100      (p2_max != NULL && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
4101  {
4102    p_LmFree(m1, strat->tailRing);
4103    p_LmFree(m2, strat->tailRing);
4104    m1 = NULL;
4105    m2 = NULL;
4106    return FALSE;
4107  }
4108  return TRUE;
4109}
4110                       
4111BOOLEAN kStratChangeTailRing(kStrategy strat, LObject *L, TObject* T, unsigned long expbound)
4112{
4113  if (expbound == 0) expbound = strat->tailRing->bitmask << 1;
4114  if (expbound >= currRing->bitmask) return FALSE;
4115  ring new_tailRing = rModifyRing(currRing,
4116                                  // Hmmm .. the condition pFDeg == pDeg
4117                                  // might be too strong
4118                                  (strat->homog && pFDeg == pDeg && pOrdSgn == 1), 
4119                                  !strat->ak, 
4120                                  expbound);
4121
4122  if (new_tailRing == currRing) return TRUE;
4123  if (TEST_OPT_PROT)
4124    Print("[%d:%d", (long) new_tailRing->bitmask, new_tailRing->ExpL_Size);
4125  kTest_TS(strat);
4126  assume(new_tailRing != strat->tailRing);
4127  pShallowCopyDeleteProc p_shallow_copy_delete
4128    = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
4129 
4130  omBin new_tailBin = omGetStickyBinOfBin(new_tailRing->PolyBin);
4131 
4132  int i;
4133  for (i=0; i<=strat->tl; i++)
4134  {
4135    strat->T[i].ShallowCopyDelete(new_tailRing, new_tailBin, 
4136                                  p_shallow_copy_delete);
4137  }
4138  for (i=0; i<=strat->Ll; i++)
4139  {
4140    assume(strat->L[i].p != NULL);
4141    if (pNext(strat->L[i].p) != strat->tail)
4142      strat->L[i].ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
4143  }
4144  if (strat->P.t_p != NULL || 
4145      (strat->P.p != NULL && pNext(strat->P.p) != strat->tail))
4146    strat->P.ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
4147 
4148  if (L != NULL && L->tailRing != new_tailRing)
4149  {
4150    if (L->i_r < 0)   
4151      L->ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
4152    else
4153    {
4154      assume(L->i_r <= strat->tl);
4155      TObject* t_l = strat->R[L->i_r];
4156      assume(t_l != NULL);
4157      L->tailRing = new_tailRing;
4158      L->p = t_l->p;
4159      L->t_p = t_l->t_p;
4160      L->max = t_l->max;
4161    }
4162  }
4163     
4164  if (T != NULL && T->tailRing != new_tailRing && T->i_r < 0)
4165    T->ShallowCopyDelete(new_tailRing, new_tailBin, p_shallow_copy_delete);
4166   
4167  omMergeStickyBinIntoBin(strat->tailBin, strat->tailRing->PolyBin);
4168  if (strat->tailRing != currRing)
4169    rKillModifiedRing(strat->tailRing);
4170 
4171  strat->tailRing = new_tailRing;
4172  strat->tailBin = new_tailBin;
4173  strat->p_shallow_copy_delete
4174    = pGetShallowCopyDeleteProc(currRing, new_tailRing);
4175  kTest_TS(strat);
4176  if (TEST_OPT_PROT)
4177    PrintS("]");
4178  return TRUE;
4179}
4180
4181void kStratInitChangeTailRing(kStrategy strat)
4182{
4183  unsigned long l = 0;
4184  int i;
4185  Exponent_t e;
4186  ring new_tailRing;
4187 
4188  assume(strat->tailRing == currRing);
4189
4190  for (i=0; i<= strat->Ll; i++)
4191  {
4192    l = p_GetMaxExpL(strat->L[i].p, currRing, l);
4193  }
4194  for (i=0; i<=strat->tl; i++)
4195  {
4196    // Hmm ... this we could do in one Step
4197    l = p_GetMaxExpL(strat->T[i].p, currRing, l);
4198  }
4199  e = p_GetMaxExp(l, currRing);
4200  if (e <= 1) e = 2;
4201 
4202  kStratChangeTailRing(strat, NULL, NULL, e);
4203}
4204
4205
4206#if 0
4207Timings for the different possibilities of posInT:
4208            T15     EDL     DL      EL      L       1-2-3
4209Gonnet          43.26   42.30   38.34   41.98   38.40   100.04
4210Hairer_2_1      1.11    1.15    1.04    1.22    1.08    4.7
4211Twomat3         1.62    1.69    1.70    1.65    1.54    11.32
4212ahml            4.48    4.03    4.03    4.38    4.96    26.50
4213c7                  15.02       13.98   15.16   13.24   17.31   47.89
4214c8                  505.09      407.46  852.76  413.21  499.19  n/a
4215f855            12.65   9.27    14.97   8.78    14.23   33.12
4216gametwo6        11.47   11.35   14.57   11.20   12.02   35.07
4217gerhard_3       2.73    2.83    2.93    2.64    3.12    6.24
4218ilias13         22.89   22.46   24.62   20.60   23.34   53.86
4219noon8           40.68   37.02   37.99   36.82   35.59   877.16
4220rcyclic_19      48.22   42.29   43.99   45.35   51.51   204.29
4221rkat9           82.37   79.46   77.20   77.63   82.54   267.92
4222schwarz_11      16.46   16.81   16.76   16.81   16.72   35.56
4223test016         16.39   14.17   14.40   13.50   14.26   34.07
4224test017         34.70   36.01   33.16   35.48   32.75   71.45
4225test042         10.76   10.99   10.27   11.57   10.45   23.04
4226test058         6.78    6.75    6.51    6.95    6.22    9.47
4227test066         10.71   10.94   10.76   10.61   10.56   19.06
4228test073         10.75   11.11   10.17   10.79   8.63    58.10
4229test086         12.23   11.81   12.88   12.24   13.37   66.68
4230test103         5.05    4.80    5.47    4.64    4.89    11.90
4231test154         12.96   11.64   13.51   12.46   14.61   36.35
4232test162         65.27   64.01   67.35   59.79   67.54   196.46
4233test164         7.50    6.50    7.68    6.70    7.96    17.13
4234virasoro        3.39    3.50    3.35    3.47    3.70    7.66
4235#endif
4236
4237
4238#ifdef HAVE_MORE_POS_IN_T
4239// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
4240int posInT_EcartFDegpLength(const TSet set,const int length,LObject &p)
4241{
4242
4243  if (length==-1) return 0;
4244
4245  int o = p.ecart;
4246  int op=p.GetpFDeg();
4247  int ol = p.GetpLength();
4248
4249  if (set[length].ecart < o)
4250    return length+1;
4251  if (set[length].ecart == o)
4252  {
4253     int oo=set[length].GetpFDeg();
4254     if ((oo < op) || ((oo==op) && (set[length].length < ol)))
4255       return length+1;
4256  }
4257
4258  int i;
4259  int an = 0;
4260  int en= length;
4261  loop
4262  {
4263    if (an >= en-1)
4264    {
4265      if (set[an].ecart > o)
4266        return an;
4267      if (set[an].ecart == o)
4268      {
4269         int oo=set[an].GetpFDeg();
4270         if((oo > op)
4271         || ((oo==op) && (set[an].pLength > ol)))
4272           return an;
4273      }
4274      return en;
4275    }
4276    i=(an+en) / 2;
4277    if (set[i].ecart > o)
4278      en=i;
4279    else if (set[i].ecart == o)
4280    {
4281       int oo=set[i].GetpFDeg();
4282       if ((oo > op)
4283       || ((oo == op) && (set[i].pLength > ol)))
4284         en=i;
4285       else
4286        an=i;
4287    }
4288    else
4289      an=i;
4290  }
4291}
4292
4293// determines the position based on: 1.) FDeg 2.) pLength
4294int posInT_FDegpLength(const TSet set,const int length,LObject &p)
4295{
4296
4297  if (length==-1) return 0;
4298
4299  int op=p.GetpFDeg();
4300  int ol = p.GetpLength();
4301
4302  int oo=set[length].GetpFDeg();
4303  if ((oo < op) || ((oo==op) && (set[length].length < ol)))
4304    return length+1;
4305
4306  int i;
4307  int an = 0;
4308  int en= length;
4309  loop
4310    {
4311      if (an >= en-1)
4312      {
4313        int oo=set[an].GetpFDeg();
4314        if((oo > op)
4315           || ((oo==op) && (set[an].pLength > ol)))
4316          return an;
4317        return en;
4318      }
4319      i=(an+en) / 2;
4320      int oo=set[i].GetpFDeg();
4321      if ((oo > op)
4322          || ((oo == op) && (set[i].pLength > ol)))
4323        en=i;
4324      else
4325        an=i;
4326    }
4327}
4328
4329
4330// determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
4331int posInT_pLength(const TSet set,const int length,LObject &p)
4332{
4333  if (length==-1)
4334    return 0;
4335  if (set[length].length<p.length)
4336    return length+1;
4337
4338  int i;
4339  int an = 0;
4340  int en= length;
4341  int ol = p.GetpLength();
4342
4343  loop
4344  {
4345    if (an >= en-1)
4346    {
4347      if (set[an].pLength>ol) return an;
4348      return en;
4349    }
4350    i=(an+en) / 2;
4351    if (set[i].pLength>ol) en=i;
4352    else                        an=i;
4353  }
4354}
4355
4356#endif
4357
4358#endif // KUTIL_CC
Note: See TracBrowser for help on using the repository browser.