source: git/kernel/kutil.cc @ 68f5f1a

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