source: git/Singular/kutil.cc @ 32f320

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