source: git/kernel/kutil.cc @ e6cbed

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