source: git/kernel/kutil.cc @ 977f94

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