source: git/kernel/GBEngine/kstd1.cc @ 353a42

spielwiese
Last change on this file since 353a42 was 353a42, checked in by Hans Schoenemann <hannes@…>, 5 years ago
chg: nCoeff_si_Ring_Z/rField_is_Ring_Z -> nCoeff_is_Z/rField_is_Z
  • Property mode set to 100644
File size: 87.9 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT:
6*/
7
8// TODO: why the following is here instead of mod2.h???
9
10
11// define if buckets should be used
12#define MORA_USE_BUCKETS
13
14#define PRE_INTEGER_CHECK 0
15
16#include "kernel/mod2.h"
17
18#include "omalloc/omalloc.h"
19
20#include "misc/options.h"
21#include "misc/intvec.h"
22
23#include "polys/weight.h"
24#include "kernel/polys.h"
25
26#include "kernel/GBEngine/kutil.h"
27#include "kernel/GBEngine/kstd1.h"
28#include "kernel/GBEngine/khstd.h"
29#include "kernel/combinatorics/stairc.h"
30#include "kernel/ideals.h"
31
32//#include "ipprint.h"
33
34#ifdef HAVE_PLURAL
35#include "polys/nc/nc.h"
36#include "polys/nc/sca.h"
37#include "kernel/GBEngine/nc.h"
38#endif
39
40#include "kernel/GBEngine/kInline.h"
41
42
43/* the list of all options which give a warning by test */
44BITSET kOptions=Sy_bit(OPT_PROT)           /*  0 */
45                |Sy_bit(OPT_REDSB)         /*  1 */
46                |Sy_bit(OPT_NOT_SUGAR)     /*  3 */
47                |Sy_bit(OPT_INTERRUPT)     /*  4 */
48                |Sy_bit(OPT_SUGARCRIT)     /*  5 */
49                |Sy_bit(OPT_REDTHROUGH)
50                |Sy_bit(OPT_OLDSTD)
51                |Sy_bit(OPT_FASTHC)        /* 10 */
52                |Sy_bit(OPT_INTSTRATEGY)   /* 26 */
53                |Sy_bit(OPT_INFREDTAIL)    /* 28 */
54                |Sy_bit(OPT_NOTREGULARITY) /* 30 */
55                |Sy_bit(OPT_WEIGHTM);      /* 31 */
56
57/* the list of all options which may be used by option and test */
58/* defintion of ALL options: libpolys/misc/options.h */
59BITSET validOpts=Sy_bit(0)
60                |Sy_bit(1)
61                |Sy_bit(2) // obachman 10/00: replaced by notBucket
62                |Sy_bit(3)
63                |Sy_bit(4)
64                |Sy_bit(5)
65                |Sy_bit(6)
66//                |Sy_bit(7) obachman 11/00 tossed: 12/00 used for redThrough
67                |Sy_bit(7) // OPT_REDTHROUGH
68                |Sy_bit(8) // obachman 11/00 tossed -> motsak 2011 experimental: OPT_NO_SYZ_MINIM
69                |Sy_bit(9)
70                |Sy_bit(10)
71                |Sy_bit(11)
72                |Sy_bit(12)
73                |Sy_bit(13)
74                |Sy_bit(14)
75                |Sy_bit(15)
76                |Sy_bit(16)
77                |Sy_bit(17)
78                |Sy_bit(18)
79                |Sy_bit(19)
80//                |Sy_bit(20) obachman 11/00 tossed: 12/00 used for redOldStd
81                |Sy_bit(OPT_OLDSTD)
82                |Sy_bit(21)
83                |Sy_bit(22)
84                /*|Sy_bit(23)*/
85                /*|Sy_bit(24)*/
86                |Sy_bit(OPT_REDTAIL)
87                |Sy_bit(OPT_INTSTRATEGY)
88                |Sy_bit(27)
89                |Sy_bit(28)
90                |Sy_bit(29)
91                |Sy_bit(30)
92                |Sy_bit(31);
93
94//static BOOLEAN posInLOldFlag;
95           /*FALSE, if posInL == posInL10*/
96// returns TRUE if mora should use buckets, false otherwise
97static BOOLEAN kMoraUseBucket(kStrategy strat);
98
99static void kOptimizeLDeg(pLDegProc ldeg, kStrategy strat)
100{
101//  if (strat->ak == 0 && !rIsSyzIndexRing(currRing))
102    strat->length_pLength = TRUE;
103//  else
104//    strat->length_pLength = FALSE;
105
106  if ((ldeg == pLDeg0c /*&& !rIsSyzIndexRing(currRing)*/) ||
107      (ldeg == pLDeg0 && strat->ak == 0))
108  {
109    strat->LDegLast = TRUE;
110  }
111  else
112  {
113    strat->LDegLast = FALSE;
114  }
115}
116
117
118static int doRed (LObject* h, TObject* with,BOOLEAN intoT,kStrategy strat, bool redMoraNF)
119{
120  int ret;
121#if KDEBUG > 0
122  kTest_L(h);
123  kTest_T(with);
124#endif
125  // Hmmm ... why do we do this -- polys from T should already be normalized
126  if (!TEST_OPT_INTSTRATEGY)
127    with->pNorm();
128#ifdef KDEBUG
129  if (TEST_OPT_DEBUG)
130  {
131    PrintS("reduce ");h->wrp();PrintS(" with ");with->wrp();PrintLn();
132  }
133#endif
134  if (intoT)
135  {
136    // need to do it exacly like this: otherwise
137    // we might get errors
138    LObject L= *h;
139    L.Copy();
140    h->GetP();
141    h->length=h->pLength=pLength(h->p);
142    ret = ksReducePoly(&L, with, strat->kNoetherTail(), NULL, strat);
143    if (ret)
144    {
145      if (ret < 0) return ret;
146      if (h->tailRing != strat->tailRing)
147        h->ShallowCopyDelete(strat->tailRing,
148                             pGetShallowCopyDeleteProc(h->tailRing,
149                                                       strat->tailRing));
150    }
151    if(redMoraNF && (rField_is_Ring(currRing)))
152      enterT_strong(*h,strat);
153    else
154      enterT(*h,strat);
155    *h = L;
156  }
157  else
158    ret = ksReducePoly(h, with, strat->kNoetherTail(), NULL, strat);
159#ifdef KDEBUG
160  if (TEST_OPT_DEBUG)
161  {
162    PrintS("to ");h->wrp();PrintLn();
163  }
164#endif
165  return ret;
166}
167
168int redEcart (LObject* h,kStrategy strat)
169{
170  int i,at,ei,li,ii;
171  int j = 0;
172  int pass = 0;
173  long d,reddeg;
174
175  d = h->GetpFDeg()+ h->ecart;
176  reddeg = strat->LazyDegree+d;
177  h->SetShortExpVector();
178  loop
179  {
180    j = kFindDivisibleByInT(strat, h);
181    if (j < 0)
182    {
183      if (strat->honey) h->SetLength(strat->length_pLength);
184      return 1;
185    }
186
187    ei = strat->T[j].ecart;
188    ii = j;
189
190    if (ei > h->ecart && ii < strat->tl)
191    {
192      li = strat->T[j].length;
193      // the polynomial to reduce with (up to the moment) is;
194      // pi with ecart ei and length li
195      // look for one with smaller ecart
196      i = j;
197      loop
198      {
199        /*- takes the first possible with respect to ecart -*/
200        i++;
201#if 1
202        if (i > strat->tl) break;
203        if ((strat->T[i].ecart < ei || (strat->T[i].ecart == ei &&
204                                        strat->T[i].length < li))
205            &&
206            p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i], h->GetLmTailRing(), ~h->sev, strat->tailRing))
207#else
208          j = kFindDivisibleByInT(strat, h, i);
209        if (j < 0) break;
210        i = j;
211        if (strat->T[i].ecart < ei || (strat->T[i].ecart == ei &&
212                                        strat->T[i].length < li))
213#endif
214        {
215          // the polynomial to reduce with is now
216          ii = i;
217          ei = strat->T[i].ecart;
218          if (ei <= h->ecart) break;
219          li = strat->T[i].length;
220        }
221      }
222    }
223
224    // end of search: have to reduce with pi
225    if (ei > h->ecart)
226    {
227      // It is not possible to reduce h with smaller ecart;
228      // if possible h goes to the lazy-set L,i.e
229      // if its position in L would be not the last one
230      strat->fromT = TRUE;
231      if (!TEST_OPT_REDTHROUGH && strat->Ll >= 0) /*- L is not empty -*/
232      {
233        h->SetLmCurrRing();
234        if (strat->honey && strat->posInLDependsOnLength)
235          h->SetLength(strat->length_pLength);
236        assume(h->FDeg == h->pFDeg());
237        at = strat->posInL(strat->L,strat->Ll,h,strat);
238        if (at <= strat->Ll)
239        {
240          /*- h will not become the next element to reduce -*/
241          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
242#ifdef KDEBUG
243          if (TEST_OPT_DEBUG) Print(" ecart too big; -> L%d\n",at);
244#endif
245          h->Clear();
246          strat->fromT = FALSE;
247          return -1;
248        }
249      }
250    }
251
252    // now we finally can reduce
253    doRed(h,&(strat->T[ii]),strat->fromT,strat,FALSE);
254    strat->fromT=FALSE;
255
256    // are we done ???
257    if (h->IsNull())
258    {
259      assume(!rField_is_Ring(currRing));
260      kDeleteLcm(h);
261      h->Clear();
262      return 0;
263    }
264
265    // NO!
266    h->SetShortExpVector();
267    h->SetpFDeg();
268    if (strat->honey)
269    {
270      if (ei <= h->ecart)
271        h->ecart = d-h->GetpFDeg();
272      else
273        h->ecart = d-h->GetpFDeg()+ei-h->ecart;
274    }
275    else
276      // this has the side effect of setting h->length
277      h->ecart = h->pLDeg(strat->LDegLast) - h->GetpFDeg();
278#if 0
279    if (strat->syzComp!=0)
280    {
281      if ((strat->syzComp>0) && (h->Comp() > strat->syzComp))
282      {
283        assume(h->MinComp() > strat->syzComp);
284        if (strat->honey) h->SetLength();
285#ifdef KDEBUG
286        if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
287#endif
288        return -2;
289      }
290    }
291#endif
292    /*- try to reduce the s-polynomial -*/
293    pass++;
294    d = h->GetpFDeg()+h->ecart;
295    /*
296     *test whether the polynomial should go to the lazyset L
297     *-if the degree jumps
298     *-if the number of pre-defined reductions jumps
299     */
300    if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
301        && ((d >= reddeg) || (pass > strat->LazyPass)))
302    {
303      h->SetLmCurrRing();
304      if (strat->honey && strat->posInLDependsOnLength)
305        h->SetLength(strat->length_pLength);
306      assume(h->FDeg == h->pFDeg());
307      at = strat->posInL(strat->L,strat->Ll,h,strat);
308      if (at <= strat->Ll)
309      {
310        int dummy=strat->sl;
311        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
312        {
313          if (strat->honey && !strat->posInLDependsOnLength)
314            h->SetLength(strat->length_pLength);
315          return 1;
316        }
317        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
318#ifdef KDEBUG
319        if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
320#endif
321        h->Clear();
322        return -1;
323      }
324    }
325    else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
326    {
327      Print(".%ld",d);mflush();
328      reddeg = d+1;
329      if (h->pTotalDeg()+h->ecart >= (int)strat->tailRing->bitmask)
330      {
331        strat->overflow=TRUE;
332        //Print("OVERFLOW in redEcart d=%ld, max=%ld",d,strat->tailRing->bitmask);
333        h->GetP();
334        at = strat->posInL(strat->L,strat->Ll,h,strat);
335        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
336        h->Clear();
337        return -1;
338      }
339    }
340  }
341}
342
343#ifdef HAVE_RINGS
344int redRiloc (LObject* h,kStrategy strat)
345{
346  int i,at,ei,li,ii;
347  int j = 0;
348  int pass = 0;
349  long d,reddeg;
350
351  d = h->GetpFDeg()+ h->ecart;
352  reddeg = strat->LazyDegree+d;
353  h->SetShortExpVector();
354  loop
355  {
356    j = kFindDivisibleByInT(strat, h);
357    if (j < 0)
358    {
359      // over ZZ: cleanup coefficients by complete reduction with monomials
360      postReduceByMon(h, strat);
361      if(h->p == NULL)
362      {
363        kDeleteLcm(h);
364        h->Clear();
365        return 0;
366      }
367      if (strat->honey) h->SetLength(strat->length_pLength);
368      if(strat->tl >= 0)
369          h->i_r1 = strat->tl;
370      else
371          h->i_r1 = -1;
372      if (h->GetLmTailRing() == NULL)
373      {
374        kDeleteLcm(h);
375        h->Clear();
376        return 0;
377      }
378      return 1;
379    }
380
381    ei = strat->T[j].ecart;
382    ii = j;
383    if (ei > h->ecart && ii < strat->tl)
384    {
385      li = strat->T[j].length;
386      // the polynomial to reduce with (up to the moment) is;
387      // pi with ecart ei and length li
388      // look for one with smaller ecart
389      i = j;
390      loop
391      {
392        /*- takes the first possible with respect to ecart -*/
393        i++;
394#if 1
395        if (i > strat->tl) break;
396        if ((strat->T[i].ecart < ei || (strat->T[i].ecart == ei &&
397                                        strat->T[i].length < li))
398            &&
399            p_LmShortDivisibleBy(strat->T[i].GetLmTailRing(), strat->sevT[i], h->GetLmTailRing(), ~h->sev, strat->tailRing)
400            &&
401            n_DivBy(h->p->coef,strat->T[i].p->coef,strat->tailRing->cf))
402#else
403          j = kFindDivisibleByInT(strat, h, i);
404        if (j < 0) break;
405        i = j;
406        if (strat->T[i].ecart < ei || (strat->T[i].ecart == ei &&
407                                        strat->T[i].length < li))
408#endif
409        {
410          // the polynomial to reduce with is now
411          ii = i;
412          ei = strat->T[i].ecart;
413          if (ei <= h->ecart) break;
414          li = strat->T[i].length;
415        }
416      }
417    }
418
419    // end of search: have to reduce with pi
420    if (ei > h->ecart)
421    {
422      // It is not possible to reduce h with smaller ecart;
423      // if possible h goes to the lazy-set L,i.e
424      // if its position in L would be not the last one
425      strat->fromT = TRUE;
426      if (!TEST_OPT_REDTHROUGH && strat->Ll >= 0) /*- L is not empty -*/
427      {
428        h->SetLmCurrRing();
429        if (strat->honey && strat->posInLDependsOnLength)
430          h->SetLength(strat->length_pLength);
431        assume(h->FDeg == h->pFDeg());
432        at = strat->posInL(strat->L,strat->Ll,h,strat);
433        if (at <= strat->Ll && pLmCmp(h->p, strat->L[strat->Ll].p) != 0 && !nEqual(h->p->coef, strat->L[strat->Ll].p->coef))
434        {
435          /*- h will not become the next element to reduce -*/
436          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
437          #ifdef KDEBUG
438          if (TEST_OPT_DEBUG) Print(" ecart too big; -> L%d\n",at);
439          #endif
440          h->Clear();
441          strat->fromT = FALSE;
442          return -1;
443        }
444      }
445      doRed(h,&(strat->T[ii]),strat->fromT,strat,TRUE);
446    }
447    else
448    {
449      // now we finally can reduce
450      doRed(h,&(strat->T[ii]),strat->fromT,strat,FALSE);
451    }
452    strat->fromT=FALSE;
453    // are we done ???
454    if (h->IsNull())
455    {
456      kDeleteLcm(h);
457      h->Clear();
458      return 0;
459    }
460
461    // NO!
462    h->SetShortExpVector();
463    h->SetpFDeg();
464    if (strat->honey)
465    {
466      if (ei <= h->ecart)
467        h->ecart = d-h->GetpFDeg();
468      else
469        h->ecart = d-h->GetpFDeg()+ei-h->ecart;
470    }
471    else
472      // this has the side effect of setting h->length
473      h->ecart = h->pLDeg(strat->LDegLast) - h->GetpFDeg();
474    /*- try to reduce the s-polynomial -*/
475    pass++;
476    d = h->GetpFDeg()+h->ecart;
477    /*
478     *test whether the polynomial should go to the lazyset L
479     *-if the degree jumps
480     *-if the number of pre-defined reductions jumps
481     */
482    if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
483        && ((d >= reddeg) || (pass > strat->LazyPass)))
484    {
485      h->SetLmCurrRing();
486      if (strat->honey && strat->posInLDependsOnLength)
487        h->SetLength(strat->length_pLength);
488      assume(h->FDeg == h->pFDeg());
489      at = strat->posInL(strat->L,strat->Ll,h,strat);
490      if (at <= strat->Ll)
491      {
492        int dummy=strat->sl;
493        if (kFindDivisibleByInS(strat, &dummy, h) < 0)
494        {
495          if (strat->honey && !strat->posInLDependsOnLength)
496            h->SetLength(strat->length_pLength);
497          return 1;
498        }
499        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
500#ifdef KDEBUG
501        if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
502#endif
503        h->Clear();
504        return -1;
505      }
506    }
507    else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
508    {
509      Print(".%ld",d);mflush();
510      reddeg = d+1;
511      if (h->pTotalDeg()+h->ecart >= (int)strat->tailRing->bitmask)
512      {
513        strat->overflow=TRUE;
514        //Print("OVERFLOW in redEcart d=%ld, max=%ld",d,strat->tailRing->bitmask);
515        h->GetP();
516        at = strat->posInL(strat->L,strat->Ll,h,strat);
517        enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
518        h->Clear();
519        return -1;
520      }
521    }
522  }
523}
524#endif
525
526/*2
527*reduces h with elements from T choosing  the first possible
528* element in t with respect to the given pDivisibleBy
529*/
530int redFirst (LObject* h,kStrategy strat)
531{
532  if (h->IsNull()) return 0;
533
534  int at;
535  long reddeg,d;
536  int pass = 0;
537  int j = 0;
538
539  if (! strat->homog)
540  {
541    d = h->GetpFDeg() + h->ecart;
542    reddeg = strat->LazyDegree+d;
543  }
544  h->SetShortExpVector();
545  loop
546  {
547    j = kFindDivisibleByInT(strat, h);
548    if (j < 0)
549    {
550      h->SetDegStuffReturnLDeg(strat->LDegLast);
551      return 1;
552    }
553
554    if (!TEST_OPT_INTSTRATEGY)
555      strat->T[j].pNorm();
556#ifdef KDEBUG
557    if (TEST_OPT_DEBUG)
558    {
559      PrintS("reduce ");
560      h->wrp();
561      PrintS(" with ");
562      strat->T[j].wrp();
563    }
564#endif
565    ksReducePoly(h, &(strat->T[j]), strat->kNoetherTail(), NULL, strat);
566#ifdef KDEBUG
567    if (TEST_OPT_DEBUG)
568    {
569      PrintS(" to ");
570      wrp(h->p);
571      PrintLn();
572    }
573#endif
574    if (h->IsNull())
575    {
576      assume(!rField_is_Ring(currRing));
577      kDeleteLcm(h);
578      h->Clear();
579      return 0;
580    }
581    h->SetShortExpVector();
582
583#if 0
584    if ((strat->syzComp!=0) && !strat->honey)
585    {
586      if ((strat->syzComp>0) &&
587          (h->Comp() > strat->syzComp))
588      {
589        assume(h->MinComp() > strat->syzComp);
590#ifdef KDEBUG
591        if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
592#endif
593        if (strat->homog)
594          h->SetDegStuffReturnLDeg(strat->LDegLast);
595        return -2;
596      }
597    }
598#endif
599    if (!strat->homog)
600    {
601      if (!TEST_OPT_OLDSTD && strat->honey)
602      {
603        h->SetpFDeg();
604        if (strat->T[j].ecart <= h->ecart)
605          h->ecart = d - h->GetpFDeg();
606        else
607          h->ecart = d - h->GetpFDeg() + strat->T[j].ecart - h->ecart;
608
609        d = h->GetpFDeg() + h->ecart;
610      }
611      else
612        d = h->SetDegStuffReturnLDeg(strat->LDegLast);
613      /*- try to reduce the s-polynomial -*/
614      pass++;
615      /*
616       *test whether the polynomial should go to the lazyset L
617       *-if the degree jumps
618       *-if the number of pre-defined reductions jumps
619       */
620      if (!TEST_OPT_REDTHROUGH && (strat->Ll >= 0)
621          && ((d >= reddeg) || (pass > strat->LazyPass)))
622      {
623        h->SetLmCurrRing();
624        if (strat->posInLDependsOnLength)
625          h->SetLength(strat->length_pLength);
626        at = strat->posInL(strat->L,strat->Ll,h,strat);
627        if (at <= strat->Ll)
628        {
629          int dummy=strat->sl;
630          if (kFindDivisibleByInS(strat,&dummy, h) < 0)
631            return 1;
632          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
633#ifdef KDEBUG
634          if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
635#endif
636          h->Clear();
637          return -1;
638        }
639      }
640      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
641      {
642        reddeg = d+1;
643        Print(".%ld",d);mflush();
644        if (h->pTotalDeg()+h->ecart >= (int)strat->tailRing->bitmask)
645        {
646          strat->overflow=TRUE;
647          //Print("OVERFLOW in redFirst d=%ld, max=%ld",d,strat->tailRing->bitmask);
648          h->GetP();
649          at = strat->posInL(strat->L,strat->Ll,h,strat);
650          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
651          h->Clear();
652          return -1;
653        }
654      }
655    }
656  }
657}
658
659/*2
660* reduces h with elements from T choosing first possible
661* element in T with respect to the given ecart
662* used for computing normal forms outside kStd
663*/
664static poly redMoraNF (poly h,kStrategy strat, int flag)
665{
666  LObject H;
667  H.p = h;
668  int j = 0;
669  int z = 10;
670  int o = H.SetpFDeg();
671  H.ecart = currRing->pLDeg(H.p,&H.length,currRing)-o;
672  if ((flag & 2) == 0) cancelunit(&H,TRUE);
673  H.sev = pGetShortExpVector(H.p);
674  unsigned long not_sev = ~ H.sev;
675  loop
676  {
677    if (j > strat->tl)
678    {
679      return H.p;
680    }
681    if (TEST_V_DEG_STOP)
682    {
683      if (kModDeg(H.p)>Kstd1_deg) pLmDelete(&H.p);
684      if (H.p==NULL) return NULL;
685    }
686    if (p_LmShortDivisibleBy(strat->T[j].GetLmTailRing(), strat->sevT[j], H.GetLmTailRing(), not_sev, strat->tailRing)
687        )
688    {
689      /*- remember the found T-poly -*/
690      // poly pi = strat->T[j].p;
691      int ei = strat->T[j].ecart;
692      int li = strat->T[j].length;
693      int ii = j;
694      /*
695      * the polynomial to reduce with (up to the moment) is;
696      * pi with ecart ei and length li
697      */
698      loop
699      {
700        /*- look for a better one with respect to ecart -*/
701        /*- stop, if the ecart is small enough (<=ecart(H)) -*/
702        j++;
703        if (j > strat->tl) break;
704        if (ei <= H.ecart) break;
705        if (((strat->T[j].ecart < ei)
706          || ((strat->T[j].ecart == ei)
707        && (strat->T[j].length < li)))
708        && pLmShortDivisibleBy(strat->T[j].p,strat->sevT[j], H.p, not_sev)
709        )
710        {
711          /*
712          * the polynomial to reduce with is now;
713          */
714          // pi = strat->T[j].p;
715          ei = strat->T[j].ecart;
716          li = strat->T[j].length;
717          ii = j;
718        }
719      }
720      /*
721      * end of search: have to reduce with pi
722      */
723      z++;
724      if (z>10)
725      {
726        pNormalize(H.p);
727        z=0;
728      }
729      if ((ei > H.ecart) && (!strat->kHEdgeFound))
730      {
731        /*
732        * It is not possible to reduce h with smaller ecart;
733        * we have to reduce with bad ecart: H has to enter in T
734        */
735        doRed(&H,&(strat->T[ii]),TRUE,strat,TRUE);
736        if (H.p == NULL)
737          return NULL;
738      }
739      else
740      {
741        /*
742        * we reduce with good ecart, h need not to be put to T
743        */
744        doRed(&H,&(strat->T[ii]),FALSE,strat,TRUE);
745        if (H.p == NULL)
746          return NULL;
747      }
748      /*- try to reduce the s-polynomial -*/
749      o = H.SetpFDeg();
750      if ((flag &2 ) == 0) cancelunit(&H,TRUE);
751      H.ecart = currRing->pLDeg(H.p,&(H.length),currRing)-o;
752      j = 0;
753      H.sev = pGetShortExpVector(H.p);
754      not_sev = ~ H.sev;
755    }
756    else
757    {
758      j++;
759    }
760  }
761}
762
763#ifdef HAVE_RINGS
764static poly redMoraNFRing (poly h,kStrategy strat, int flag)
765{
766  LObject H;
767  H.p = h;
768  int j = 0;
769  int z = 10;
770  int o = H.SetpFDeg();
771  H.ecart = currRing->pLDeg(H.p,&H.length,currRing)-o;
772  if ((flag & 2) == 0) cancelunit(&H,TRUE);
773  H.sev = pGetShortExpVector(H.p);
774  unsigned long not_sev = ~ H.sev;
775  loop
776  {
777    if (j > strat->tl)
778    {
779      return H.p;
780    }
781    if (TEST_V_DEG_STOP)
782    {
783      if (kModDeg(H.p)>Kstd1_deg) pLmDelete(&H.p);
784      if (H.p==NULL) return NULL;
785    }
786    if (p_LmShortDivisibleBy(strat->T[j].GetLmTailRing(), strat->sevT[j], H.GetLmTailRing(), not_sev, strat->tailRing)
787        && (n_DivBy(H.p->coef, strat->T[j].p->coef,strat->tailRing->cf))
788        )
789    {
790      /*- remember the found T-poly -*/
791      // poly pi = strat->T[j].p;
792      int ei = strat->T[j].ecart;
793      int li = strat->T[j].length;
794      int ii = j;
795      /*
796      * the polynomial to reduce with (up to the moment) is;
797      * pi with ecart ei and length li
798      */
799      loop
800      {
801        /*- look for a better one with respect to ecart -*/
802        /*- stop, if the ecart is small enough (<=ecart(H)) -*/
803        j++;
804        if (j > strat->tl) break;
805        if (ei <= H.ecart) break;
806        if (((strat->T[j].ecart < ei)
807          || ((strat->T[j].ecart == ei)
808        && (strat->T[j].length < li)))
809        && pLmShortDivisibleBy(strat->T[j].p,strat->sevT[j], H.p, not_sev)
810        && (n_DivBy(H.p->coef, strat->T[j].p->coef,strat->tailRing->cf))
811        )
812        {
813          /*
814          * the polynomial to reduce with is now;
815          */
816          // pi = strat->T[j].p;
817          ei = strat->T[j].ecart;
818          li = strat->T[j].length;
819          ii = j;
820        }
821      }
822      /*
823      * end of search: have to reduce with pi
824      */
825      z++;
826      if (z>10)
827      {
828        pNormalize(H.p);
829        z=0;
830      }
831      if ((ei > H.ecart) && (!strat->kHEdgeFound))
832      {
833        /*
834        * It is not possible to reduce h with smaller ecart;
835        * we have to reduce with bad ecart: H has to enter in T
836        */
837        doRed(&H,&(strat->T[ii]),TRUE,strat,TRUE);
838        if (H.p == NULL)
839          return NULL;
840      }
841      else
842      {
843        /*
844        * we reduce with good ecart, h need not to be put to T
845        */
846        doRed(&H,&(strat->T[ii]),FALSE,strat,TRUE);
847        if (H.p == NULL)
848          return NULL;
849      }
850      /*- try to reduce the s-polynomial -*/
851      o = H.SetpFDeg();
852      if ((flag &2 ) == 0) cancelunit(&H,TRUE);
853      H.ecart = currRing->pLDeg(H.p,&(H.length),currRing)-o;
854      j = 0;
855      H.sev = pGetShortExpVector(H.p);
856      not_sev = ~ H.sev;
857    }
858    else
859    {
860      j++;
861    }
862  }
863}
864#endif
865
866/*2
867*reorders  L with respect to posInL
868*/
869void reorderL(kStrategy strat)
870{
871  int i,j,at;
872  LObject p;
873
874  for (i=1; i<=strat->Ll; i++)
875  {
876    at = strat->posInL(strat->L,i-1,&(strat->L[i]),strat);
877    if (at != i)
878    {
879      p = strat->L[i];
880      for (j=i-1; j>=at; j--) strat->L[j+1] = strat->L[j];
881      strat->L[at] = p;
882    }
883  }
884}
885
886/*2
887*reorders  T with respect to length
888*/
889void reorderT(kStrategy strat)
890{
891  int i,j,at;
892  TObject p;
893  unsigned long sev;
894
895
896  for (i=1; i<=strat->tl; i++)
897  {
898    if (strat->T[i-1].length > strat->T[i].length)
899    {
900      p = strat->T[i];
901      sev = strat->sevT[i];
902      at = i-1;
903      loop
904      {
905        at--;
906        if (at < 0) break;
907        if (strat->T[i].length > strat->T[at].length) break;
908      }
909      for (j = i-1; j>at; j--)
910      {
911        strat->T[j+1]=strat->T[j];
912        strat->sevT[j+1]=strat->sevT[j];
913        strat->R[strat->T[j+1].i_r] = &(strat->T[j+1]);
914      }
915      strat->T[at+1]=p;
916      strat->sevT[at+1] = sev;
917      strat->R[p.i_r] = &(strat->T[at+1]);
918    }
919  }
920}
921
922/*2
923*looks whether exactly (currRing->N)-1 axis are used
924*returns last != 0 in this case
925*last is the (first) unused axis
926*/
927void missingAxis (int* last,kStrategy strat)
928{
929  int   i = 0;
930  int   k = 0;
931
932  *last = 0;
933  if (!rHasMixedOrdering(currRing))
934  {
935    loop
936    {
937      i++;
938      if (i > (currRing->N)) break;
939      if (strat->NotUsedAxis[i])
940      {
941        *last = i;
942        k++;
943      }
944      if (k>1)
945      {
946        *last = 0;
947        break;
948      }
949    }
950  }
951}
952
953/*2
954*last is the only non used axis, it looks
955*for a monomial in p being a pure power of this
956*variable and returns TRUE in this case
957*(*length) gives the length between the pure power and the leading term
958*(should be minimal)
959*/
960BOOLEAN hasPurePower (const poly p,int last, int *length,kStrategy strat)
961{
962  poly h;
963  int i;
964
965  if (pNext(p) == strat->tail)
966    return FALSE;
967  pp_Test(p, currRing, strat->tailRing);
968  if (strat->ak <= 0 || p_MinComp(p, currRing, strat->tailRing) == strat->ak)
969  {
970    i = p_IsPurePower(p, currRing);
971    if (rField_is_Ring(currRing) && (!n_IsUnit(pGetCoeff(p), currRing->cf))) i=0;
972    if (i == last)
973    {
974      *length = 0;
975      return TRUE;
976    }
977    *length = 1;
978    h = pNext(p);
979    while (h != NULL)
980    {
981      i = p_IsPurePower(h, strat->tailRing);
982      if (rField_is_Ring(currRing) && (!n_IsUnit(pGetCoeff(h), currRing->cf))) i=0;
983      if (i==last) return TRUE;
984      (*length)++;
985      pIter(h);
986    }
987  }
988  return FALSE;
989}
990
991BOOLEAN hasPurePower (LObject *L,int last, int *length,kStrategy strat)
992{
993  if (L->bucket != NULL)
994  {
995    poly p = L->GetP();
996    return hasPurePower(p, last, length, strat);
997  }
998  else
999  {
1000    return hasPurePower(L->p, last, length, strat);
1001  }
1002}
1003
1004/*2
1005* looks up the position of polynomial p in L
1006* in the case of looking for the pure powers
1007*/
1008int posInL10 (const LSet set,const int length, LObject* p,const kStrategy strat)
1009{
1010  int j,dp,dL;
1011
1012  if (length<0) return 0;
1013  if (hasPurePower(p,strat->lastAxis,&dp,strat))
1014  {
1015    int op= p->GetpFDeg() +p->ecart;
1016    for (j=length; j>=0; j--)
1017    {
1018      if (!hasPurePower(&(set[j]),strat->lastAxis,&dL,strat))
1019        return j+1;
1020      if (dp < dL)
1021        return j+1;
1022      if ((dp == dL)
1023          && (set[j].GetpFDeg()+set[j].ecart >= op))
1024        return j+1;
1025    }
1026  }
1027  j=length;
1028  loop
1029  {
1030    if (j<0) break;
1031    if (!hasPurePower(&(set[j]),strat->lastAxis,&dL,strat)) break;
1032    j--;
1033  }
1034  return strat->posInLOld(set,j,p,strat);
1035}
1036
1037
1038/*2
1039* computes the s-polynomials L[ ].p in L
1040*/
1041void updateL(kStrategy strat)
1042{
1043  LObject p;
1044  int dL;
1045  int j=strat->Ll;
1046  loop
1047  {
1048    if (j<0) break;
1049    if (hasPurePower(&(strat->L[j]),strat->lastAxis,&dL,strat))
1050    {
1051      p=strat->L[strat->Ll];
1052      strat->L[strat->Ll]=strat->L[j];
1053      strat->L[j]=p;
1054      break;
1055    }
1056    j--;
1057  }
1058  if (j<0)
1059  {
1060    j=strat->Ll;
1061    loop
1062    {
1063      if (j<0) break;
1064      if (pNext(strat->L[j].p) == strat->tail)
1065      {
1066        if (rField_is_Ring(currRing))
1067          pLmDelete(strat->L[j].p);    /*deletes the short spoly and computes*/
1068        else
1069          pLmFree(strat->L[j].p);    /*deletes the short spoly and computes*/
1070        strat->L[j].p = NULL;
1071        poly m1 = NULL, m2 = NULL;
1072        // check that spoly creation is ok
1073        while (strat->tailRing != currRing &&
1074               !kCheckSpolyCreation(&(strat->L[j]), strat, m1, m2))
1075        {
1076          assume(m1 == NULL && m2 == NULL);
1077          // if not, change to a ring where exponents are at least
1078          // large enough
1079          kStratChangeTailRing(strat);
1080        }
1081        /* create the real one */
1082        ksCreateSpoly(&(strat->L[j]), strat->kNoetherTail(), FALSE,
1083                      strat->tailRing, m1, m2, strat->R);
1084
1085        strat->L[j].SetLmCurrRing();
1086        if (!strat->honey)
1087          strat->initEcart(&strat->L[j]);
1088        else
1089          strat->L[j].SetLength(strat->length_pLength);
1090
1091        BOOLEAN pp = hasPurePower(&(strat->L[j]),strat->lastAxis,&dL,strat);
1092
1093        if (strat->use_buckets) strat->L[j].PrepareRed(TRUE);
1094
1095        if (pp)
1096        {
1097          p=strat->L[strat->Ll];
1098          strat->L[strat->Ll]=strat->L[j];
1099          strat->L[j]=p;
1100          break;
1101        }
1102      }
1103      j--;
1104    }
1105  }
1106}
1107
1108/*2
1109* computes the s-polynomials L[ ].p in L and
1110* cuts elements in L above noether
1111*/
1112void updateLHC(kStrategy strat)
1113{
1114
1115  int i = 0;
1116  kTest_TS(strat);
1117  while (i <= strat->Ll)
1118  {
1119    if (pNext(strat->L[i].p) == strat->tail)
1120    {
1121       /*- deletes the int spoly and computes -*/
1122      if (pLmCmp(strat->L[i].p,strat->kNoether) == -1)
1123      {
1124        if (rField_is_Ring(currRing))
1125          pLmDelete(strat->L[i].p);
1126        else
1127          pLmFree(strat->L[i].p);
1128        strat->L[i].p = NULL;
1129      }
1130      else
1131      {
1132        if (rField_is_Ring(currRing))
1133          pLmDelete(strat->L[i].p);
1134        else
1135          pLmFree(strat->L[i].p);
1136        strat->L[i].p = NULL;
1137        poly m1 = NULL, m2 = NULL;
1138        // check that spoly creation is ok
1139        while (strat->tailRing != currRing &&
1140               !kCheckSpolyCreation(&(strat->L[i]), strat, m1, m2))
1141        {
1142          assume(m1 == NULL && m2 == NULL);
1143          // if not, change to a ring where exponents are at least
1144          // large enough
1145          kStratChangeTailRing(strat);
1146        }
1147        /* create the real one */
1148        ksCreateSpoly(&(strat->L[i]), strat->kNoetherTail(), FALSE,
1149                      strat->tailRing, m1, m2, strat->R);
1150        if (! strat->L[i].IsNull())
1151        {
1152          strat->L[i].SetLmCurrRing();
1153          strat->L[i].SetpFDeg();
1154          strat->L[i].ecart
1155            = strat->L[i].pLDeg(strat->LDegLast) - strat->L[i].GetpFDeg();
1156          if (strat->use_buckets) strat->L[i].PrepareRed(TRUE);
1157        }
1158      }
1159    }
1160    else
1161      deleteHC(&(strat->L[i]), strat);
1162    if (strat->L[i].IsNull())
1163      deleteInL(strat->L,&strat->Ll,i,strat);
1164    else
1165    {
1166#ifdef KDEBUG
1167      kTest_L(&(strat->L[i]), strat->tailRing, TRUE, i, strat->T, strat->tl);
1168#endif
1169      i++;
1170    }
1171  }
1172  kTest_TS(strat);
1173}
1174
1175/*2
1176* cuts in T above strat->kNoether and tries to cancel a unit
1177* changes also S as S is a subset of T
1178*/
1179void updateT(kStrategy strat)
1180{
1181  int i = 0;
1182  LObject p;
1183
1184  while (i <= strat->tl)
1185  {
1186    p = strat->T[i];
1187    deleteHC(&p,strat, TRUE);
1188    /*- tries to cancel a unit: -*/
1189    cancelunit(&p);
1190    if (TEST_OPT_INTSTRATEGY) /* deleteHC and/or cancelunit may have changed p*/
1191      p.pCleardenom();
1192    if (p.p != strat->T[i].p)
1193    {
1194      strat->sevT[i] = pGetShortExpVector(p.p);
1195      p.SetpFDeg();
1196    }
1197    strat->T[i] = p;
1198    i++;
1199  }
1200}
1201
1202/*2
1203* arranges red, pos and T if strat->kHEdgeFound (first time)
1204*/
1205void firstUpdate(kStrategy strat)
1206{
1207  if (strat->update)
1208  {
1209    kTest_TS(strat);
1210    strat->update = (strat->tl == -1);
1211    if (TEST_OPT_WEIGHTM)
1212    {
1213      pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
1214      if (strat->tailRing != currRing)
1215      {
1216        strat->tailRing->pFDeg = strat->pOrigFDeg_TailRing;
1217        strat->tailRing->pLDeg = strat->pOrigLDeg_TailRing;
1218      }
1219      int i;
1220      for (i=strat->Ll; i>=0; i--)
1221      {
1222        strat->L[i].SetpFDeg();
1223      }
1224      for (i=strat->tl; i>=0; i--)
1225      {
1226        strat->T[i].SetpFDeg();
1227      }
1228      if (ecartWeights)
1229      {
1230        omFreeSize((ADDRESS)ecartWeights,(rVar(currRing)+1)*sizeof(short));
1231        ecartWeights=NULL;
1232      }
1233    }
1234    if (TEST_OPT_FASTHC)
1235    {
1236      strat->posInL = strat->posInLOld;
1237      strat->lastAxis = 0;
1238    }
1239    if (TEST_OPT_FINDET)
1240      return;
1241
1242    if ( (!rField_is_Ring(currRing)) || (rHasGlobalOrdering(currRing)))
1243    {
1244      strat->red = redFirst;
1245      strat->use_buckets = kMoraUseBucket(strat);
1246    }
1247    updateT(strat);
1248
1249    if ( (!rField_is_Ring(currRing)) || (rHasGlobalOrdering(currRing)))
1250    {
1251      strat->posInT = posInT2;
1252      reorderT(strat);
1253    }
1254  }
1255  kTest_TS(strat);
1256}
1257
1258/*2
1259*-puts p to the standardbasis s at position at
1260*-reduces the tail of p if TEST_OPT_REDTAIL
1261*-tries to cancel a unit
1262*-HEckeTest
1263*  if TRUE
1264*  - decides about reduction-strategies
1265*  - computes noether
1266*  - stops computation if TEST_OPT_FINDET
1267*  - cuts the tails of the polynomials
1268*    in s,t and the elements in L above noether
1269*    and cancels units if possible
1270*  - reorders s,L
1271*/
1272void enterSMora (LObject &p,int atS,kStrategy strat, int atR = -1)
1273{
1274  enterSBba(p, atS, strat, atR);
1275  #ifdef KDEBUG
1276  if (TEST_OPT_DEBUG)
1277  {
1278    Print("new s%d:",atS);
1279    p_wrp(p.p,currRing,strat->tailRing);
1280    PrintLn();
1281  }
1282  #endif
1283  if ((!strat->kHEdgeFound) || (strat->kNoether!=NULL)) HEckeTest(p.p,strat);
1284  if (strat->kHEdgeFound)
1285  {
1286    if (newHEdge(strat))
1287    {
1288      firstUpdate(strat);
1289      if (TEST_OPT_FINDET)
1290        return;
1291
1292      /*- cuts elements in L above noether and reorders L -*/
1293      updateLHC(strat);
1294      /*- reorders L with respect to posInL -*/
1295      reorderL(strat);
1296    }
1297  }
1298  else if (strat->kNoether!=NULL)
1299    strat->kHEdgeFound = TRUE;
1300  else if (TEST_OPT_FASTHC)
1301  {
1302    if (strat->posInLOldFlag)
1303    {
1304      missingAxis(&strat->lastAxis,strat);
1305      if (strat->lastAxis)
1306      {
1307        strat->posInLOld = strat->posInL;
1308        strat->posInLOldFlag = FALSE;
1309        strat->posInL = posInL10;
1310        strat->posInLDependsOnLength = TRUE;
1311        updateL(strat);
1312        reorderL(strat);
1313      }
1314    }
1315    else if (strat->lastAxis)
1316      updateL(strat);
1317  }
1318}
1319
1320/*2
1321*-puts p to the standardbasis s at position at
1322*-HEckeTest
1323*  if TRUE
1324*  - computes noether
1325*/
1326void enterSMoraNF (LObject &p, int atS,kStrategy strat, int atR = -1)
1327{
1328  enterSBba(p, atS, strat, atR);
1329  if ((!strat->kHEdgeFound) || (strat->kNoether!=NULL)) HEckeTest(p.p,strat);
1330  if (strat->kHEdgeFound)
1331    newHEdge(strat);
1332  else if (strat->kNoether!=NULL)
1333    strat->kHEdgeFound = TRUE;
1334}
1335
1336void initBba(kStrategy strat)
1337{
1338 /* setting global variables ------------------- */
1339  strat->enterS = enterSBba;
1340    strat->red = redHoney;
1341  if (strat->honey)
1342    strat->red = redHoney;
1343  else if (currRing->pLexOrder && !strat->homog)
1344    strat->red = redLazy;
1345  else
1346  {
1347    strat->LazyPass *=4;
1348    strat->red = redHomog;
1349  }
1350  if (rField_is_Ring(currRing))
1351  {
1352    strat->red = redRing;
1353  }
1354  if (currRing->pLexOrder && strat->honey)
1355    strat->initEcart = initEcartNormal;
1356  else
1357    strat->initEcart = initEcartBBA;
1358  if (strat->honey)
1359    strat->initEcartPair = initEcartPairMora;
1360  else
1361    strat->initEcartPair = initEcartPairBba;
1362//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1363//  {
1364//    //interred  machen   Aenderung
1365//    strat->pOrigFDeg=pFDeg;
1366//    strat->pOrigLDeg=pLDeg;
1367//    //h=ggetid("ecart");
1368//    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
1369//    //{
1370//    //  ecartWeights=iv2array(IDINTVEC(h));
1371//    //}
1372//    //else
1373//    {
1374//      ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
1375//      /*uses automatic computation of the ecartWeights to set them*/
1376//      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
1377//    }
1378//    pRestoreDegProcs(currRing,totaldegreeWecart, maxdegreeWecart);
1379//    if (TEST_OPT_PROT)
1380//    {
1381//      for(i=1; i<=(currRing->N); i++)
1382//        Print(" %d",ecartWeights[i]);
1383//      PrintLn();
1384//      mflush();
1385//    }
1386//  }
1387}
1388
1389void initSba(ideal F,kStrategy strat)
1390{
1391  int i;
1392  //idhdl h;
1393 /* setting global variables ------------------- */
1394  strat->enterS = enterSSba;
1395    strat->red2 = redHoney;
1396  if (strat->honey)
1397    strat->red2 = redHoney;
1398  else if (currRing->pLexOrder && !strat->homog)
1399    strat->red2 = redLazy;
1400  else
1401  {
1402    strat->LazyPass *=4;
1403    strat->red2 = redHomog;
1404  }
1405  if (rField_is_Ring(currRing))
1406  {
1407    if(rHasLocalOrMixedOrdering(currRing))
1408      {strat->red2 = redRiloc;}
1409    else
1410      {strat->red2 = redRing;}
1411  }
1412  if (currRing->pLexOrder && strat->honey)
1413    strat->initEcart = initEcartNormal;
1414  else
1415    strat->initEcart = initEcartBBA;
1416  if (strat->honey)
1417    strat->initEcartPair = initEcartPairMora;
1418  else
1419    strat->initEcartPair = initEcartPairBba;
1420  //strat->kIdeal = NULL;
1421  //if (strat->ak==0) strat->kIdeal->rtyp=IDEAL_CMD;
1422  //else              strat->kIdeal->rtyp=MODUL_CMD;
1423  //strat->kIdeal->data=(void *)strat->Shdl;
1424  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1425  {
1426    //interred  machen   Aenderung
1427    strat->pOrigFDeg  = currRing->pFDeg;
1428    strat->pOrigLDeg  = currRing->pLDeg;
1429    //h=ggetid("ecart");
1430    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
1431    //{
1432    //  ecartWeights=iv2array(IDINTVEC(h));
1433    //}
1434    //else
1435    {
1436      ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
1437      /*uses automatic computation of the ecartWeights to set them*/
1438      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights, currRing);
1439    }
1440    pRestoreDegProcs(currRing, totaldegreeWecart, maxdegreeWecart);
1441    if (TEST_OPT_PROT)
1442    {
1443      for(i=1; i<=(currRing->N); i++)
1444        Print(" %d",ecartWeights[i]);
1445      PrintLn();
1446      mflush();
1447    }
1448  }
1449  // for sig-safe reductions in signature-based
1450  // standard basis computations
1451  if(rField_is_Ring(currRing))
1452    strat->red = redSigRing;
1453  else
1454    strat->red        = redSig;
1455  //strat->sbaOrder  = 1;
1456  strat->currIdx      = 1;
1457}
1458
1459void initMora(ideal F,kStrategy strat)
1460{
1461  int i,j;
1462
1463  strat->NotUsedAxis = (BOOLEAN *)omAlloc(((currRing->N)+1)*sizeof(BOOLEAN));
1464  for (j=(currRing->N); j>0; j--) strat->NotUsedAxis[j] = TRUE;
1465  strat->enterS = enterSMora;
1466  strat->initEcartPair = initEcartPairMora; /*- ecart approximation -*/
1467  strat->posInLOld = strat->posInL;
1468  strat->posInLOldFlag = TRUE;
1469  strat->initEcart = initEcartNormal;
1470  strat->kHEdgeFound = (currRing->ppNoether) != NULL;
1471  if ( strat->kHEdgeFound )
1472     strat->kNoether = pCopy((currRing->ppNoether));
1473  else if (strat->kHEdgeFound || strat->homog)
1474    strat->red = redFirst;  /*take the first possible in T*/
1475  else
1476    strat->red = redEcart;/*take the first possible in under ecart-restriction*/
1477  if (strat->kHEdgeFound)
1478  {
1479    strat->HCord = currRing->pFDeg((currRing->ppNoether),currRing)+1;
1480    strat->posInT = posInT2;
1481  }
1482  else
1483  {
1484    strat->HCord = 32000;/*- very large -*/
1485  }
1486
1487  if (rField_is_Ring(currRing))
1488    strat->red = redRiloc;
1489
1490  /*reads the ecartWeights used for Graebes method from the
1491   *intvec ecart and set ecartWeights
1492   */
1493  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1494  {
1495    //interred  machen   Aenderung
1496    strat->pOrigFDeg=currRing->pFDeg;
1497    strat->pOrigLDeg=currRing->pLDeg;
1498    ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
1499    /*uses automatic computation of the ecartWeights to set them*/
1500    kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights,currRing);
1501
1502    pSetDegProcs(currRing,totaldegreeWecart, maxdegreeWecart);
1503    if (TEST_OPT_PROT)
1504    {
1505      for(i=1; i<=(currRing->N); i++)
1506        Print(" %d",ecartWeights[i]);
1507      PrintLn();
1508      mflush();
1509    }
1510  }
1511  kOptimizeLDeg(currRing->pLDeg, strat);
1512}
1513
1514void kDebugPrint(kStrategy strat);
1515
1516ideal mora (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1517{
1518  int olddeg = 0;
1519  int reduc = 0;
1520  int red_result = 1;
1521  int hilbeledeg=1,hilbcount=0;
1522  BITSET save1;
1523  SI_SAVE_OPT1(save1);
1524  if (rHasMixedOrdering(currRing))
1525  {
1526    si_opt_1 &= ~Sy_bit(OPT_REDSB);
1527    si_opt_1 &= ~Sy_bit(OPT_REDTAIL);
1528  }
1529
1530  strat->update = TRUE;
1531  /*- setting global variables ------------------- -*/
1532  initBuchMoraCrit(strat);
1533  initHilbCrit(F,Q,&hilb,strat);
1534  initMora(F,strat);
1535  if(rField_is_Ring(currRing))
1536    initBuchMoraPosRing(strat);
1537  else
1538    initBuchMoraPos(strat);
1539  /*Shdl=*/initBuchMora(F,Q,strat);
1540  if (TEST_OPT_FASTHC) missingAxis(&strat->lastAxis,strat);
1541  /*updateS in initBuchMora has Hecketest
1542  * and could have put strat->kHEdgdeFound FALSE*/
1543  if ((currRing->ppNoether)!=NULL)
1544  {
1545    strat->kHEdgeFound = TRUE;
1546  }
1547  if (strat->kHEdgeFound && strat->update)
1548  {
1549    firstUpdate(strat);
1550    updateLHC(strat);
1551    reorderL(strat);
1552  }
1553  if (TEST_OPT_FASTHC && (strat->lastAxis) && strat->posInLOldFlag)
1554  {
1555    strat->posInLOld = strat->posInL;
1556    strat->posInLOldFlag = FALSE;
1557    strat->posInL = posInL10;
1558    updateL(strat);
1559    reorderL(strat);
1560  }
1561  kTest_TS(strat);
1562  strat->use_buckets = kMoraUseBucket(strat);
1563
1564#ifdef HAVE_TAIL_RING
1565  if (strat->homog && strat->red == redFirst)
1566    if(!idIs0(F) &&(!rField_is_Ring(currRing)))
1567      kStratInitChangeTailRing(strat);
1568#endif
1569
1570  if (BVERBOSE(23))
1571  {
1572    kDebugPrint(strat);
1573  }
1574//deleteInL(strat->L,&strat->Ll,1,strat);
1575//deleteInL(strat->L,&strat->Ll,0,strat);
1576
1577  /*- compute-------------------------------------------*/
1578  while (strat->Ll >= 0)
1579  {
1580    #ifdef KDEBUG
1581    if (TEST_OPT_DEBUG) messageSets(strat);
1582    #endif
1583    if (siCntrlc)
1584    {
1585      while (strat->Ll >= 0)
1586        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1587      strat->noClearS=TRUE;
1588    }
1589    if (TEST_OPT_DEGBOUND
1590    && (strat->L[strat->Ll].ecart+strat->L[strat->Ll].GetpFDeg()> Kstd1_deg))
1591    {
1592      /*
1593      * stops computation if
1594      * - 24 (degBound)
1595      *   && upper degree is bigger than Kstd1_deg
1596      */
1597      while ((strat->Ll >= 0)
1598        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1599        && (strat->L[strat->Ll].ecart+strat->L[strat->Ll].GetpFDeg()> Kstd1_deg)
1600      )
1601      {
1602        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1603        //if (TEST_OPT_PROT)
1604        //{
1605        //   PrintS("D"); mflush();
1606        //}
1607      }
1608      if (strat->Ll<0) break;
1609      else strat->noClearS=TRUE;
1610    }
1611    strat->P = strat->L[strat->Ll];/*- picks the last element from the lazyset L -*/
1612    if (strat->Ll==0) strat->interpt=TRUE;
1613    strat->Ll--;
1614    // create the real Spoly
1615    if (pNext(strat->P.p) == strat->tail)
1616    {
1617      /*- deletes the short spoly and computes -*/
1618      if (rField_is_Ring(currRing))
1619        pLmDelete(strat->P.p);
1620      else
1621        pLmFree(strat->P.p);
1622      strat->P.p = NULL;
1623      poly m1 = NULL, m2 = NULL;
1624      // check that spoly creation is ok
1625      while (strat->tailRing != currRing &&
1626             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1627      {
1628        assume(m1 == NULL && m2 == NULL);
1629        // if not, change to a ring where exponents are large enough
1630        kStratChangeTailRing(strat);
1631      }
1632      /* create the real one */
1633      ksCreateSpoly(&(strat->P), strat->kNoetherTail(), strat->use_buckets,
1634                    strat->tailRing, m1, m2, strat->R);
1635      if (!strat->use_buckets)
1636        strat->P.SetLength(strat->length_pLength);
1637    }
1638    else if (strat->P.p1 == NULL)
1639    {
1640      // for input polys, prepare reduction (buckets !)
1641      strat->P.SetLength(strat->length_pLength);
1642      strat->P.PrepareRed(strat->use_buckets);
1643    }
1644
1645    // the s-poly
1646    if (!strat->P.IsNull())
1647    {
1648      // might be NULL from noether !!!
1649      if (TEST_OPT_PROT)
1650        message(strat->P.ecart+strat->P.GetpFDeg(),&olddeg,&reduc,strat, red_result);
1651      // reduce
1652      red_result = strat->red(&strat->P,strat);
1653    }
1654
1655    // the reduced s-poly
1656    if (! strat->P.IsNull())
1657    {
1658      strat->P.GetP();
1659      // statistics
1660      if (TEST_OPT_PROT) PrintS("s");
1661      // normalization
1662      if (TEST_OPT_INTSTRATEGY)
1663        strat->P.pCleardenom();
1664      else
1665        strat->P.pNorm();
1666      // tailreduction
1667      strat->P.p = redtail(&(strat->P),strat->sl,strat);
1668      if (strat->P.p==NULL)
1669      {
1670        WerrorS("expoent overflow - wrong ordering");
1671        return(idInit(1,1));
1672      }
1673      // set ecart -- might have changed because of tail reductions
1674      if ((!strat->noTailReduction) && (!strat->honey))
1675        strat->initEcart(&strat->P);
1676      // cancel unit
1677      cancelunit(&strat->P);
1678      // for char 0, clear denominators
1679      if ((strat->P.p->next==NULL) /* i.e. cancelunit did something*/
1680      && TEST_OPT_INTSTRATEGY)
1681        strat->P.pCleardenom();
1682
1683      enterT(strat->P,strat);
1684      // build new pairs
1685      if (rField_is_Ring(currRing))
1686        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,0,strat, strat->tl);
1687      else
1688        enterpairs(strat->P.p,strat->sl,strat->P.ecart,0,strat, strat->tl);
1689      // put in S
1690      strat->enterS(strat->P,
1691                    posInS(strat,strat->sl,strat->P.p, strat->P.ecart),
1692                    strat, strat->tl);
1693      // apply hilbert criterion
1694      if (hilb!=NULL)
1695      {
1696        if (strat->homog==isHomog)
1697          khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1698        else
1699          khCheckLocInhom(Q,w,hilb,hilbcount,strat);
1700      }
1701
1702      // clear strat->P
1703      kDeleteLcm(&strat->P);
1704
1705#ifdef KDEBUG
1706      // make sure kTest_TS does not complain about strat->P
1707      memset(&strat->P,0,sizeof(strat->P));
1708#endif
1709    }
1710    if (strat->kHEdgeFound)
1711    {
1712      if ((TEST_OPT_FINDET)
1713      || ((TEST_OPT_MULTBOUND) && (scMult0Int(strat->Shdl,NULL,strat->tailRing) < Kstd1_mu)))
1714      {
1715        // obachman: is this still used ???
1716        /*
1717        * stops computation if strat->kHEdgeFound and
1718        * - 27 (finiteDeterminacyTest)
1719        * or
1720        * - 23
1721        *   (multBound)
1722        *   && multiplicity of the ideal is smaller then a predefined number mu
1723        */
1724        while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1725      }
1726    }
1727    kTest_TS(strat);
1728  }
1729  /*- complete reduction of the standard basis------------------------ -*/
1730  if (TEST_OPT_REDSB) completeReduce(strat);
1731  else if (TEST_OPT_PROT) PrintLn();
1732  /*- release temp data------------------------------- -*/
1733  exitBuchMora(strat);
1734  /*- polynomials used for HECKE: HC, noether -*/
1735  if (TEST_OPT_FINDET)
1736  {
1737    if (strat->kHEdge!=NULL)
1738      Kstd1_mu=currRing->pFDeg(strat->kHEdge,currRing);
1739    else
1740      Kstd1_mu=-1;
1741  }
1742  if (strat->kHEdge!=NULL) pLmFree(&strat->kHEdge);
1743  strat->update = TRUE; //???
1744  strat->lastAxis = 0; //???
1745  if (strat->kNoether!=NULL) pLmDelete(&strat->kNoether);
1746  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
1747  if ((TEST_OPT_PROT)||(TEST_OPT_DEBUG))  messageStat(hilbcount,strat);
1748//  if (TEST_OPT_WEIGHTM)
1749//  {
1750//    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
1751//    if (ecartWeights)
1752//    {
1753//      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
1754//      ecartWeights=NULL;
1755//    }
1756//  }
1757  if(nCoeff_is_Z(currRing->cf))
1758    finalReduceByMon(strat);
1759  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1760  SI_RESTORE_OPT1(save1);
1761  idTest(strat->Shdl);
1762  return (strat->Shdl);
1763}
1764
1765poly kNF1 (ideal F,ideal Q,poly q, kStrategy strat, int lazyReduce)
1766{
1767  assume(q!=NULL);
1768  assume(!(idIs0(F)&&(Q==NULL)));
1769
1770// lazy_reduce flags: can be combined by |
1771//#define KSTD_NF_LAZY   1
1772  // do only a reduction of the leading term
1773//#define KSTD_NF_ECART  2
1774  // only local: recude even with bad ecart
1775  poly   p;
1776  int   i;
1777  int   j;
1778  int   o;
1779  LObject   h;
1780  BITSET save1;
1781  SI_SAVE_OPT1(save1);
1782
1783  //if ((idIs0(F))&&(Q==NULL))
1784  //  return pCopy(q); /*F=0*/
1785  //strat->ak = si_max(idRankFreeModule(F),pMaxComp(q));
1786  /*- creating temp data structures------------------- -*/
1787  strat->kHEdgeFound = (currRing->ppNoether) != NULL;
1788  strat->kNoether    = pCopy((currRing->ppNoether));
1789  si_opt_1|=Sy_bit(OPT_REDTAIL);
1790  si_opt_1&=~Sy_bit(OPT_INTSTRATEGY);
1791  if (TEST_OPT_STAIRCASEBOUND
1792  && (! TEST_V_DEG_STOP)
1793  && (0<Kstd1_deg)
1794  && ((!strat->kHEdgeFound)
1795    ||(TEST_OPT_DEGBOUND && (pWTotaldegree(strat->kNoether)<Kstd1_deg))))
1796  {
1797    pLmDelete(&strat->kNoether);
1798    strat->kNoether=pOne();
1799    pSetExp(strat->kNoether,1, Kstd1_deg+1);
1800    pSetm(strat->kNoether);
1801    strat->kHEdgeFound=TRUE;
1802  }
1803  initBuchMoraCrit(strat);
1804  if(rField_is_Ring(currRing))
1805    initBuchMoraPosRing(strat);
1806  else
1807    initBuchMoraPos(strat);
1808  initMora(F,strat);
1809  strat->enterS = enterSMoraNF;
1810  /*- set T -*/
1811  strat->tl = -1;
1812  strat->tmax = setmaxT;
1813  strat->T = initT();
1814  strat->R = initR();
1815  strat->sevT = initsevT();
1816  /*- set S -*/
1817  strat->sl = -1;
1818  /*- init local data struct.-------------------------- -*/
1819  /*Shdl=*/initS(F,Q,strat);
1820  if ((strat->ak!=0)
1821  && (strat->kHEdgeFound))
1822  {
1823    if (strat->ak!=1)
1824    {
1825      pSetComp(strat->kNoether,1);
1826      pSetmComp(strat->kNoether);
1827      poly p=pHead(strat->kNoether);
1828      pSetComp(p,strat->ak);
1829      pSetmComp(p);
1830      p=pAdd(strat->kNoether,p);
1831      strat->kNoether=pNext(p);
1832      p_LmDelete(p,currRing);
1833    }
1834  }
1835  if ((lazyReduce & KSTD_NF_LAZY)==0)
1836  {
1837    for (i=strat->sl; i>=0; i--)
1838      pNorm(strat->S[i]);
1839  }
1840  /*- puts the elements of S also to T -*/
1841  for (i=0; i<=strat->sl; i++)
1842  {
1843    h.p = strat->S[i];
1844    h.ecart = strat->ecartS[i];
1845    if (strat->sevS[i] == 0) strat->sevS[i] = pGetShortExpVector(h.p);
1846    else assume(strat->sevS[i] == pGetShortExpVector(h.p));
1847    h.length = pLength(h.p);
1848    h.sev = strat->sevS[i];
1849    h.SetpFDeg();
1850    enterT(h,strat);
1851  }
1852#ifdef KDEBUG
1853//  kDebugPrint(strat);
1854#endif
1855  /*- compute------------------------------------------- -*/
1856  p = pCopy(q);
1857  deleteHC(&p,&o,&j,strat);
1858  kTest(strat);
1859  if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
1860  if (BVERBOSE(23)) kDebugPrint(strat);
1861  if(rField_is_Ring(currRing))
1862  {
1863    if (p!=NULL) p = redMoraNFRing(p,strat, lazyReduce & KSTD_NF_ECART);
1864  }
1865  else
1866  {
1867    if (p!=NULL) p = redMoraNF(p,strat, lazyReduce & KSTD_NF_ECART);
1868  }
1869  if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
1870  {
1871    if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
1872    p = redtail(p,strat->sl,strat);
1873  }
1874  /*- release temp data------------------------------- -*/
1875  cleanT(strat);
1876  assume(strat->L==NULL); /*strat->L unsed */
1877  assume(strat->B==NULL); /*strat->B unused */
1878  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
1879  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
1880  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
1881  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
1882  omFree(strat->sevT);
1883  omFree(strat->S_2_R);
1884  omFree(strat->R);
1885
1886  if ((Q!=NULL)&&(strat->fromQ!=NULL))
1887  {
1888    i=((IDELEMS(Q)+IDELEMS(F)+15)/16)*16;
1889    omFreeSize((ADDRESS)strat->fromQ,i*sizeof(int));
1890    strat->fromQ=NULL;
1891  }
1892  if (strat->kHEdge!=NULL) pLmFree(&strat->kHEdge);
1893  if (strat->kNoether!=NULL) pLmDelete(&strat->kNoether);
1894//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1895//  {
1896//    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
1897//    if (ecartWeights)
1898//    {
1899//      omFreeSize((ADDRESS *)&ecartWeights,((currRing->N)+1)*sizeof(short));
1900//      ecartWeights=NULL;
1901//    }
1902//  }
1903  idDelete(&strat->Shdl);
1904  SI_RESTORE_OPT1(save1);
1905  if (TEST_OPT_PROT) PrintLn();
1906  return p;
1907}
1908
1909ideal kNF1 (ideal F,ideal Q,ideal q, kStrategy strat, int lazyReduce)
1910{
1911  assume(!idIs0(q));
1912  assume(!(idIs0(F)&&(Q==NULL)));
1913
1914// lazy_reduce flags: can be combined by |
1915//#define KSTD_NF_LAZY   1
1916  // do only a reduction of the leading term
1917//#define KSTD_NF_ECART  2
1918  // only local: recude even with bad ecart
1919  poly   p;
1920  int   i;
1921  int   j;
1922  int   o;
1923  LObject   h;
1924  ideal res;
1925  BITSET save1;
1926  SI_SAVE_OPT1(save1);
1927
1928  //if (idIs0(q)) return idInit(IDELEMS(q),si_max(q->rank,F->rank));
1929  //if ((idIs0(F))&&(Q==NULL))
1930  //  return idCopy(q); /*F=0*/
1931  //strat->ak = si_max(idRankFreeModule(F),idRankFreeModule(q));
1932  /*- creating temp data structures------------------- -*/
1933  strat->kHEdgeFound = (currRing->ppNoether) != NULL;
1934  strat->kNoether=pCopy((currRing->ppNoether));
1935  si_opt_1|=Sy_bit(OPT_REDTAIL);
1936  if (TEST_OPT_STAIRCASEBOUND
1937  && (0<Kstd1_deg)
1938  && ((!strat->kHEdgeFound)
1939    ||(TEST_OPT_DEGBOUND && (pWTotaldegree(strat->kNoether)<Kstd1_deg))))
1940  {
1941    pLmDelete(&strat->kNoether);
1942    strat->kNoether=pOne();
1943    pSetExp(strat->kNoether,1, Kstd1_deg+1);
1944    pSetm(strat->kNoether);
1945    strat->kHEdgeFound=TRUE;
1946  }
1947  initBuchMoraCrit(strat);
1948  if(rField_is_Ring(currRing))
1949    initBuchMoraPosRing(strat);
1950  else
1951    initBuchMoraPos(strat);
1952  initMora(F,strat);
1953  strat->enterS = enterSMoraNF;
1954  /*- set T -*/
1955  strat->tl = -1;
1956  strat->tmax = setmaxT;
1957  strat->T = initT();
1958  strat->R = initR();
1959  strat->sevT = initsevT();
1960  /*- set S -*/
1961  strat->sl = -1;
1962  /*- init local data struct.-------------------------- -*/
1963  /*Shdl=*/initS(F,Q,strat);
1964  if ((strat->ak!=0)
1965  && (strat->kHEdgeFound))
1966  {
1967    if (strat->ak!=1)
1968    {
1969      pSetComp(strat->kNoether,1);
1970      pSetmComp(strat->kNoether);
1971      poly p=pHead(strat->kNoether);
1972      pSetComp(p,strat->ak);
1973      pSetmComp(p);
1974      p=pAdd(strat->kNoether,p);
1975      strat->kNoether=pNext(p);
1976      p_LmDelete(p,currRing);
1977    }
1978  }
1979  if (TEST_OPT_INTSTRATEGY && ((lazyReduce & KSTD_NF_LAZY)==0))
1980  {
1981    for (i=strat->sl; i>=0; i--)
1982      pNorm(strat->S[i]);
1983  }
1984  /*- compute------------------------------------------- -*/
1985  res=idInit(IDELEMS(q),strat->ak);
1986  for (i=0; i<IDELEMS(q); i++)
1987  {
1988    if (q->m[i]!=NULL)
1989    {
1990      p = pCopy(q->m[i]);
1991      deleteHC(&p,&o,&j,strat);
1992      if (p!=NULL)
1993      {
1994        /*- puts the elements of S also to T -*/
1995        for (j=0; j<=strat->sl; j++)
1996        {
1997          h.p = strat->S[j];
1998          h.ecart = strat->ecartS[j];
1999          h.pLength = h.length = pLength(h.p);
2000          if (strat->sevS[j] == 0) strat->sevS[j] = pGetShortExpVector(h.p);
2001          else assume(strat->sevS[j] == pGetShortExpVector(h.p));
2002          h.sev = strat->sevS[j];
2003          h.SetpFDeg();
2004          if(rField_is_Ring(currRing) && rHasLocalOrMixedOrdering(currRing))
2005            enterT_strong(h,strat);
2006          else
2007            enterT(h,strat);
2008        }
2009        if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
2010        if(rField_is_Ring(currRing))
2011        {
2012          p = redMoraNFRing(p,strat, lazyReduce & KSTD_NF_ECART);
2013        }
2014        else
2015          p = redMoraNF(p,strat, lazyReduce & KSTD_NF_ECART);
2016        if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
2017        {
2018          if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
2019          p = redtail(p,strat->sl,strat);
2020        }
2021        cleanT(strat);
2022      }
2023      res->m[i]=p;
2024    }
2025    //else
2026    //  res->m[i]=NULL;
2027  }
2028  /*- release temp data------------------------------- -*/
2029  assume(strat->L==NULL); /*strat->L unsed */
2030  assume(strat->B==NULL); /*strat->B unused */
2031  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
2032  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
2033  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
2034  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
2035  omFree(strat->sevT);
2036  omFree(strat->S_2_R);
2037  omFree(strat->R);
2038  if ((Q!=NULL)&&(strat->fromQ!=NULL))
2039  {
2040    i=((IDELEMS(F)+IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
2041    omFreeSize((ADDRESS)strat->fromQ,i*sizeof(int));
2042    strat->fromQ=NULL;
2043  }
2044  if (strat->kHEdge!=NULL) pLmFree(&strat->kHEdge);
2045  if (strat->kNoether!=NULL) pLmDelete(&strat->kNoether);
2046//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
2047//  {
2048//    pFDeg=strat->pOrigFDeg;
2049//    pLDeg=strat->pOrigLDeg;
2050//    if (ecartWeights)
2051//    {
2052//      omFreeSize((ADDRESS *)&ecartWeights,((currRing->N)+1)*sizeof(short));
2053//      ecartWeights=NULL;
2054//    }
2055//  }
2056  idDelete(&strat->Shdl);
2057  SI_RESTORE_OPT1(save1);
2058  if (TEST_OPT_PROT) PrintLn();
2059  return res;
2060}
2061
2062intvec * kModW, * kHomW;
2063
2064long kModDeg(poly p, ring r)
2065{
2066  long o=p_WDegree(p, r);
2067  long i=__p_GetComp(p, r);
2068  if (i==0) return o;
2069  //assume((i>0) && (i<=kModW->length()));
2070  if (i<=kModW->length())
2071    return o+(*kModW)[i-1];
2072  return o;
2073}
2074long kHomModDeg(poly p, ring r)
2075{
2076  int i;
2077  long j=0;
2078
2079  for (i=r->N;i>0;i--)
2080    j+=p_GetExp(p,i,r)*(*kHomW)[i-1];
2081  if (kModW == NULL) return j;
2082  i = __p_GetComp(p,r);
2083  if (i==0) return j;
2084  return j+(*kModW)[i-1];
2085}
2086
2087ideal kStd(ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
2088          int newIdeal, intvec *vw, s_poly_proc_t sp)
2089{
2090  if(idIs0(F))
2091    return idInit(1,F->rank);
2092
2093  ideal r;
2094  BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2095  BOOLEAN delete_w=(w==NULL);
2096  kStrategy strat=new skStrategy;
2097
2098  strat->s_poly=sp;
2099  if(!TEST_OPT_RETURN_SB)
2100    strat->syzComp = syzComp;
2101  if (TEST_OPT_SB_1
2102    &&(!rField_is_Ring(currRing))
2103    )
2104    strat->newIdeal = newIdeal;
2105  if (rField_has_simple_inverse(currRing))
2106    strat->LazyPass=20;
2107  else
2108    strat->LazyPass=2;
2109  strat->LazyDegree = 1;
2110  strat->ak = id_RankFreeModule(F,currRing);
2111  strat->kModW=kModW=NULL;
2112  strat->kHomW=kHomW=NULL;
2113  if (vw != NULL)
2114  {
2115    currRing->pLexOrder=FALSE;
2116    strat->kHomW=kHomW=vw;
2117    strat->pOrigFDeg = currRing->pFDeg;
2118    strat->pOrigLDeg = currRing->pLDeg;
2119    pSetDegProcs(currRing,kHomModDeg);
2120    toReset = TRUE;
2121  }
2122  if (h==testHomog)
2123  {
2124    if (strat->ak == 0)
2125    {
2126      h = (tHomog)idHomIdeal(F,Q);
2127      w=NULL;
2128    }
2129    else if (!TEST_OPT_DEGBOUND)
2130    {
2131      if (w!=NULL)
2132        h = (tHomog)idHomModule(F,Q,w);
2133      else
2134        h = (tHomog)idHomIdeal(F,Q);
2135    }
2136  }
2137  currRing->pLexOrder=b;
2138  if (h==isHomog)
2139  {
2140    if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2141    {
2142      strat->kModW = kModW = *w;
2143      if (vw == NULL)
2144      {
2145        strat->pOrigFDeg = currRing->pFDeg;
2146        strat->pOrigLDeg = currRing->pLDeg;
2147        pSetDegProcs(currRing,kModDeg);
2148        toReset = TRUE;
2149      }
2150    }
2151    currRing->pLexOrder = TRUE;
2152    if (hilb==NULL) strat->LazyPass*=2;
2153  }
2154  strat->homog=h;
2155#ifdef KDEBUG
2156  idTest(F);
2157  if (Q!=NULL) idTest(Q);
2158#endif
2159#ifdef HAVE_PLURAL
2160  if (rIsPluralRing(currRing))
2161  {
2162    const BOOLEAN bIsSCA  = rIsSCA(currRing) && strat->z2homog; // for Z_2 prod-crit
2163    strat->no_prod_crit   = ! bIsSCA;
2164    if (w!=NULL)
2165      r = nc_GB(F, Q, *w, hilb, strat, currRing);
2166    else
2167      r = nc_GB(F, Q, NULL, hilb, strat, currRing);
2168  }
2169  else
2170#endif
2171  {
2172    #if PRE_INTEGER_CHECK
2173    //the preinteger check strategy is not for modules
2174    if(nCoeff_is_Z(currRing->cf) && strat->ak <= 0)
2175    {
2176      ideal FCopy = idCopy(F);
2177      poly pFmon = preIntegerCheck(FCopy, Q);
2178      if(pFmon != NULL)
2179      {
2180        idInsertPoly(FCopy, pFmon);
2181        strat->kModW=kModW=NULL;
2182        if (h==testHomog)
2183        {
2184            if (strat->ak == 0)
2185            {
2186              h = (tHomog)idHomIdeal(FCopy,Q);
2187              w=NULL;
2188            }
2189            else if (!TEST_OPT_DEGBOUND)
2190            {
2191              if (w!=NULL)
2192                h = (tHomog)idHomModule(FCopy,Q,w);
2193              else
2194                h = (tHomog)idHomIdeal(FCopy,Q);
2195            }
2196        }
2197        currRing->pLexOrder=b;
2198        if (h==isHomog)
2199        {
2200          if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2201          {
2202            strat->kModW = kModW = *w;
2203            if (vw == NULL)
2204            {
2205              strat->pOrigFDeg = currRing->pFDeg;
2206              strat->pOrigLDeg = currRing->pLDeg;
2207              pSetDegProcs(currRing,kModDeg);
2208              toReset = TRUE;
2209            }
2210          }
2211          currRing->pLexOrder = TRUE;
2212          if (hilb==NULL) strat->LazyPass*=2;
2213        }
2214        strat->homog=h;
2215      }
2216      omTestMemory(1);
2217      if(w == NULL)
2218      {
2219        if(rHasLocalOrMixedOrdering(currRing))
2220            r=mora(FCopy,Q,NULL,hilb,strat);
2221        else
2222            r=bba(FCopy,Q,NULL,hilb,strat);
2223      }
2224      else
2225      {
2226        if(rHasLocalOrMixedOrdering(currRing))
2227            r=mora(FCopy,Q,*w,hilb,strat);
2228        else
2229            r=bba(FCopy,Q,*w,hilb,strat);
2230      }
2231      idDelete(&FCopy);
2232    }
2233    else
2234    #endif
2235    {
2236      if(w==NULL)
2237      {
2238        if(rHasLocalOrMixedOrdering(currRing))
2239          r=mora(F,Q,NULL,hilb,strat);
2240        else
2241          r=bba(F,Q,NULL,hilb,strat);
2242      }
2243      else
2244      {
2245        if(rHasLocalOrMixedOrdering(currRing))
2246          r=mora(F,Q,*w,hilb,strat);
2247        else
2248          r=bba(F,Q,*w,hilb,strat);
2249      }
2250    }
2251  }
2252#ifdef KDEBUG
2253  idTest(r);
2254#endif
2255  if (toReset)
2256  {
2257    kModW = NULL;
2258    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2259  }
2260  currRing->pLexOrder = b;
2261//Print("%d reductions canceled \n",strat->cel);
2262  HCord=strat->HCord;
2263  delete(strat);
2264  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
2265  return r;
2266}
2267
2268ideal kSba(ideal F, ideal Q, tHomog h,intvec ** w, int sbaOrder, int arri, intvec *hilb,int syzComp,
2269          int newIdeal, intvec *vw)
2270{
2271  if(idIs0(F))
2272    return idInit(1,F->rank);
2273  if(!rField_is_Ring(currRing))
2274  {
2275    ideal r;
2276    BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2277    BOOLEAN delete_w=(w==NULL);
2278    kStrategy strat=new skStrategy;
2279    strat->sbaOrder = sbaOrder;
2280    if (arri!=0)
2281    {
2282      strat->rewCrit1 = arriRewDummy;
2283      strat->rewCrit2 = arriRewCriterion;
2284      strat->rewCrit3 = arriRewCriterionPre;
2285    }
2286    else
2287    {
2288      strat->rewCrit1 = faugereRewCriterion;
2289      strat->rewCrit2 = faugereRewCriterion;
2290      strat->rewCrit3 = faugereRewCriterion;
2291    }
2292
2293    if(!TEST_OPT_RETURN_SB)
2294      strat->syzComp = syzComp;
2295    if (TEST_OPT_SB_1)
2296      //if(!rField_is_Ring(currRing)) // always true here
2297        strat->newIdeal = newIdeal;
2298    if (rField_has_simple_inverse(currRing))
2299      strat->LazyPass=20;
2300    else
2301      strat->LazyPass=2;
2302    strat->LazyDegree = 1;
2303    strat->enterOnePair=enterOnePairNormal;
2304    strat->chainCrit=chainCritNormal;
2305    if (TEST_OPT_SB_1) strat->chainCrit=chainCritOpt_1;
2306    strat->ak = id_RankFreeModule(F,currRing);
2307    strat->kModW=kModW=NULL;
2308    strat->kHomW=kHomW=NULL;
2309    if (vw != NULL)
2310    {
2311      currRing->pLexOrder=FALSE;
2312      strat->kHomW=kHomW=vw;
2313      strat->pOrigFDeg = currRing->pFDeg;
2314      strat->pOrigLDeg = currRing->pLDeg;
2315      pSetDegProcs(currRing,kHomModDeg);
2316      toReset = TRUE;
2317    }
2318    if (h==testHomog)
2319    {
2320      if (strat->ak == 0)
2321      {
2322        h = (tHomog)idHomIdeal(F,Q);
2323        w=NULL;
2324      }
2325      else if (!TEST_OPT_DEGBOUND)
2326      {
2327        if (w!=NULL)
2328          h = (tHomog)idHomModule(F,Q,w);
2329        else
2330          h = (tHomog)idHomIdeal(F,Q);
2331      }
2332    }
2333    currRing->pLexOrder=b;
2334    if (h==isHomog)
2335    {
2336      if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2337      {
2338        strat->kModW = kModW = *w;
2339        if (vw == NULL)
2340        {
2341          strat->pOrigFDeg = currRing->pFDeg;
2342          strat->pOrigLDeg = currRing->pLDeg;
2343          pSetDegProcs(currRing,kModDeg);
2344          toReset = TRUE;
2345        }
2346      }
2347      currRing->pLexOrder = TRUE;
2348      if (hilb==NULL) strat->LazyPass*=2;
2349    }
2350    strat->homog=h;
2351  #ifdef KDEBUG
2352    idTest(F);
2353    if(Q != NULL)
2354      idTest(Q);
2355  #endif
2356  #ifdef HAVE_PLURAL
2357    if (rIsPluralRing(currRing))
2358    {
2359      const BOOLEAN bIsSCA  = rIsSCA(currRing) && strat->z2homog; // for Z_2 prod-crit
2360      strat->no_prod_crit   = ! bIsSCA;
2361      if (w!=NULL)
2362        r = nc_GB(F, Q, *w, hilb, strat, currRing);
2363      else
2364        r = nc_GB(F, Q, NULL, hilb, strat, currRing);
2365    }
2366    else
2367  #endif
2368    {
2369      if (rHasLocalOrMixedOrdering(currRing))
2370      {
2371        if (w!=NULL)
2372          r=mora(F,Q,*w,hilb,strat);
2373        else
2374          r=mora(F,Q,NULL,hilb,strat);
2375      }
2376      else
2377      {
2378        strat->sigdrop = FALSE;
2379        if (w!=NULL)
2380          r=sba(F,Q,*w,hilb,strat);
2381        else
2382          r=sba(F,Q,NULL,hilb,strat);
2383      }
2384    }
2385  #ifdef KDEBUG
2386    idTest(r);
2387  #endif
2388    if (toReset)
2389    {
2390      kModW = NULL;
2391      pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2392    }
2393    currRing->pLexOrder = b;
2394  //Print("%d reductions canceled \n",strat->cel);
2395    HCord=strat->HCord;
2396    //delete(strat);
2397    if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
2398    return r;
2399  }
2400  else
2401  {
2402    //--------------------------RING CASE-------------------------
2403    assume(sbaOrder == 1);
2404    assume(arri == 0);
2405    ideal r;
2406    r = idCopy(F);
2407    int sbaEnterS = -1;
2408    bool sigdrop = TRUE;
2409    //This is how we set the SBA algorithm;
2410    int totalsbaruns = 1,blockedreductions = 20,blockred = 0,loops = 0;
2411    while(sigdrop && (loops < totalsbaruns || totalsbaruns == -1)
2412                  && (blockred <= blockedreductions))
2413    {
2414      loops++;
2415      if(loops == 1)
2416        sigdrop = FALSE;
2417      BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2418      BOOLEAN delete_w=(w==NULL);
2419      kStrategy strat=new skStrategy;
2420      strat->sbaEnterS = sbaEnterS;
2421      strat->sigdrop = sigdrop;
2422      #if 0
2423      strat->blockred = blockred;
2424      #else
2425      strat->blockred = 0;
2426      #endif
2427      strat->blockredmax = blockedreductions;
2428      //printf("\nsbaEnterS beginning = %i\n",strat->sbaEnterS);
2429      //printf("\nsigdrop beginning = %i\n",strat->sigdrop);
2430      strat->sbaOrder = sbaOrder;
2431      if (arri!=0)
2432      {
2433        strat->rewCrit1 = arriRewDummy;
2434        strat->rewCrit2 = arriRewCriterion;
2435        strat->rewCrit3 = arriRewCriterionPre;
2436      }
2437      else
2438      {
2439        strat->rewCrit1 = faugereRewCriterion;
2440        strat->rewCrit2 = faugereRewCriterion;
2441        strat->rewCrit3 = faugereRewCriterion;
2442      }
2443
2444      if(!TEST_OPT_RETURN_SB)
2445        strat->syzComp = syzComp;
2446      if (TEST_OPT_SB_1)
2447        if(!rField_is_Ring(currRing))
2448          strat->newIdeal = newIdeal;
2449      if (rField_has_simple_inverse(currRing))
2450        strat->LazyPass=20;
2451      else
2452        strat->LazyPass=2;
2453      strat->LazyDegree = 1;
2454      strat->enterOnePair=enterOnePairNormal;
2455      strat->chainCrit=chainCritNormal;
2456      if (TEST_OPT_SB_1) strat->chainCrit=chainCritOpt_1;
2457      strat->ak = id_RankFreeModule(F,currRing);
2458      strat->kModW=kModW=NULL;
2459      strat->kHomW=kHomW=NULL;
2460      if (vw != NULL)
2461      {
2462        currRing->pLexOrder=FALSE;
2463        strat->kHomW=kHomW=vw;
2464        strat->pOrigFDeg = currRing->pFDeg;
2465        strat->pOrigLDeg = currRing->pLDeg;
2466        pSetDegProcs(currRing,kHomModDeg);
2467        toReset = TRUE;
2468      }
2469      if (h==testHomog)
2470      {
2471        if (strat->ak == 0)
2472        {
2473          h = (tHomog)idHomIdeal(F,Q);
2474          w=NULL;
2475        }
2476        else if (!TEST_OPT_DEGBOUND)
2477        {
2478          if (w!=NULL)
2479            h = (tHomog)idHomModule(F,Q,w);
2480          else
2481            h = (tHomog)idHomIdeal(F,Q);
2482        }
2483      }
2484      currRing->pLexOrder=b;
2485      if (h==isHomog)
2486      {
2487        if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2488        {
2489          strat->kModW = kModW = *w;
2490          if (vw == NULL)
2491          {
2492            strat->pOrigFDeg = currRing->pFDeg;
2493            strat->pOrigLDeg = currRing->pLDeg;
2494            pSetDegProcs(currRing,kModDeg);
2495            toReset = TRUE;
2496          }
2497        }
2498        currRing->pLexOrder = TRUE;
2499        if (hilb==NULL) strat->LazyPass*=2;
2500      }
2501      strat->homog=h;
2502    #ifdef KDEBUG
2503      idTest(F);
2504      if(Q != NULL)
2505        idTest(Q);
2506    #endif
2507    #ifdef HAVE_PLURAL
2508      if (rIsPluralRing(currRing))
2509      {
2510        const BOOLEAN bIsSCA  = rIsSCA(currRing) && strat->z2homog; // for Z_2 prod-crit
2511        strat->no_prod_crit   = ! bIsSCA;
2512        if (w!=NULL)
2513          r = nc_GB(F, Q, *w, hilb, strat, currRing);
2514        else
2515          r = nc_GB(F, Q, NULL, hilb, strat, currRing);
2516      }
2517      else
2518    #endif
2519      {
2520        if (rHasLocalOrMixedOrdering(currRing))
2521        {
2522          if (w!=NULL)
2523            r=mora(F,Q,*w,hilb,strat);
2524          else
2525            r=mora(F,Q,NULL,hilb,strat);
2526        }
2527        else
2528        {
2529          if (w!=NULL)
2530            r=sba(r,Q,*w,hilb,strat);
2531          else
2532          {
2533            r=sba(r,Q,NULL,hilb,strat);
2534          }
2535        }
2536      }
2537    #ifdef KDEBUG
2538      idTest(r);
2539    #endif
2540      if (toReset)
2541      {
2542        kModW = NULL;
2543        pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2544      }
2545      currRing->pLexOrder = b;
2546    //Print("%d reductions canceled \n",strat->cel);
2547      HCord=strat->HCord;
2548      sigdrop = strat->sigdrop;
2549      sbaEnterS = strat->sbaEnterS;
2550      blockred = strat->blockred;
2551      delete(strat);
2552      if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
2553    }
2554    // Go to std
2555    if(sigdrop || blockred > blockedreductions)
2556    {
2557      r = kStd(r, Q, h, w, hilb, syzComp, newIdeal, vw);
2558    }
2559    return r;
2560  }
2561}
2562
2563#ifdef HAVE_SHIFTBBA
2564ideal kStdShift(ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
2565                int newIdeal, intvec *vw, int uptodeg, int lV)
2566{
2567  ideal r;
2568  BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2569  BOOLEAN delete_w=(w==NULL);
2570  kStrategy strat=new skStrategy;
2571  intvec* temp_w=NULL;
2572
2573  if(!TEST_OPT_RETURN_SB)
2574    strat->syzComp = syzComp;
2575  if (TEST_OPT_SB_1)
2576    if(!rField_is_Ring(currRing))
2577      strat->newIdeal = newIdeal;
2578  if (rField_has_simple_inverse(currRing))
2579    strat->LazyPass=20;
2580  else
2581    strat->LazyPass=2;
2582  strat->LazyDegree = 1;
2583  strat->ak = id_RankFreeModule(F,currRing);
2584  strat->kModW=kModW=NULL;
2585  strat->kHomW=kHomW=NULL;
2586  if (vw != NULL)
2587  {
2588    currRing->pLexOrder=FALSE;
2589    strat->kHomW=kHomW=vw;
2590    strat->pOrigFDeg = currRing->pFDeg;
2591    strat->pOrigLDeg = currRing->pLDeg;
2592    pSetDegProcs(currRing,kHomModDeg);
2593    toReset = TRUE;
2594  }
2595  if (h==testHomog)
2596  {
2597    if (delete_w)
2598    {
2599      temp_w=new intvec((strat->ak)+1);
2600      w = &temp_w;
2601    }
2602    if (strat->ak == 0)
2603    {
2604      h = (tHomog)idHomIdeal(F,Q);
2605      w=NULL;
2606    }
2607    else if (!TEST_OPT_DEGBOUND)
2608    {
2609      if (w!=NULL)
2610        h = (tHomog)idHomModule(F,Q,w);
2611      else
2612        h = (tHomog)idHomIdeal(F,Q);
2613    }
2614  }
2615  currRing->pLexOrder=b;
2616  if (h==isHomog)
2617  {
2618    if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2619    {
2620      strat->kModW = kModW = *w;
2621      if (vw == NULL)
2622      {
2623        strat->pOrigFDeg = currRing->pFDeg;
2624        strat->pOrigLDeg = currRing->pLDeg;
2625        pSetDegProcs(currRing,kModDeg);
2626        toReset = TRUE;
2627      }
2628    }
2629    currRing->pLexOrder = TRUE;
2630    if (hilb==NULL) strat->LazyPass*=2;
2631  }
2632  strat->homog=h;
2633#ifdef KDEBUG
2634  idTest(F);
2635#endif
2636  if (rHasLocalOrMixedOrdering(currRing))
2637  {
2638    /* error: no local ord yet with shifts */
2639    WerrorS("No local ordering possible for shift algebra");
2640    return(NULL);
2641  }
2642  else
2643  {
2644    /* global ordering */
2645    if (w!=NULL)
2646      r=bbaShift(F,Q,*w,hilb,strat,uptodeg,lV);
2647    else
2648      r=bbaShift(F,Q,NULL,hilb,strat,uptodeg,lV);
2649  }
2650#ifdef KDEBUG
2651  idTest(r);
2652#endif
2653  if (toReset)
2654  {
2655    kModW = NULL;
2656    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2657  }
2658  currRing->pLexOrder = b;
2659//Print("%d reductions canceled \n",strat->cel);
2660  HCord=strat->HCord;
2661  delete(strat);
2662  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
2663  return r;
2664}
2665#endif
2666
2667//##############################################################
2668//##############################################################
2669//##############################################################
2670//##############################################################
2671//##############################################################
2672
2673ideal kMin_std(ideal F, ideal Q, tHomog h,intvec ** w, ideal &M, intvec *hilb,
2674              int syzComp, int reduced)
2675{
2676  if(idIs0(F))
2677  {
2678    M=idInit(1,F->rank);
2679    return idInit(1,F->rank);
2680  }
2681  if(rField_is_Ring(currRing))
2682  {
2683    ideal sb;
2684    sb = kStd(F, Q, h, w, hilb);
2685    idSkipZeroes(sb);
2686    if(IDELEMS(sb) <= IDELEMS(F))
2687    {
2688        M = idCopy(sb);
2689        idSkipZeroes(M);
2690        return(sb);
2691    }
2692    else
2693    {
2694        M = idCopy(F);
2695        idSkipZeroes(M);
2696        return(sb);
2697    }
2698  }
2699  ideal r=NULL;
2700  int Kstd1_OldDeg = Kstd1_deg,i;
2701  intvec* temp_w=NULL;
2702  BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2703  BOOLEAN delete_w=(w==NULL);
2704  BOOLEAN oldDegBound=TEST_OPT_DEGBOUND;
2705  kStrategy strat=new skStrategy;
2706
2707  if(!TEST_OPT_RETURN_SB)
2708     strat->syzComp = syzComp;
2709  if (rField_has_simple_inverse(currRing))
2710    strat->LazyPass=20;
2711  else
2712    strat->LazyPass=2;
2713  strat->LazyDegree = 1;
2714  strat->minim=(reduced % 2)+1;
2715  strat->ak = id_RankFreeModule(F,currRing);
2716  if (delete_w)
2717  {
2718    temp_w=new intvec((strat->ak)+1);
2719    w = &temp_w;
2720  }
2721  if (h==testHomog)
2722  {
2723    if (strat->ak == 0)
2724    {
2725      h = (tHomog)idHomIdeal(F,Q);
2726      w=NULL;
2727    }
2728    else
2729    {
2730      h = (tHomog)idHomModule(F,Q,w);
2731    }
2732  }
2733  if (h==isHomog)
2734  {
2735    if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2736    {
2737      kModW = *w;
2738      strat->kModW = *w;
2739      assume(currRing->pFDeg != NULL && currRing->pLDeg != NULL);
2740      strat->pOrigFDeg = currRing->pFDeg;
2741      strat->pOrigLDeg = currRing->pLDeg;
2742      pSetDegProcs(currRing,kModDeg);
2743
2744      toReset = TRUE;
2745      if (reduced>1)
2746      {
2747        Kstd1_OldDeg=Kstd1_deg;
2748        Kstd1_deg = -1;
2749        for (i=IDELEMS(F)-1;i>=0;i--)
2750        {
2751          if ((F->m[i]!=NULL) && (currRing->pFDeg(F->m[i],currRing)>=Kstd1_deg))
2752            Kstd1_deg = currRing->pFDeg(F->m[i],currRing)+1;
2753        }
2754      }
2755    }
2756    currRing->pLexOrder = TRUE;
2757    strat->LazyPass*=2;
2758  }
2759  strat->homog=h;
2760  if (rHasLocalOrMixedOrdering(currRing))
2761  {
2762    if (w!=NULL)
2763      r=mora(F,Q,*w,hilb,strat);
2764    else
2765      r=mora(F,Q,NULL,hilb,strat);
2766  }
2767  else
2768  {
2769    if (w!=NULL)
2770      r=bba(F,Q,*w,hilb,strat);
2771    else
2772      r=bba(F,Q,NULL,hilb,strat);
2773  }
2774#ifdef KDEBUG
2775  {
2776    int i;
2777    for (i=IDELEMS(r)-1; i>=0; i--) pTest(r->m[i]);
2778  }
2779#endif
2780  idSkipZeroes(r);
2781  if (toReset)
2782  {
2783    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2784    kModW = NULL;
2785  }
2786  currRing->pLexOrder = b;
2787  HCord=strat->HCord;
2788  if ((delete_w)&&(temp_w!=NULL)) delete temp_w;
2789  if ((IDELEMS(r)==1) && (r->m[0]!=NULL) && pIsConstant(r->m[0]) && (strat->ak==0))
2790  {
2791    M=idInit(1,F->rank);
2792    M->m[0]=pOne();
2793    //if (strat->ak!=0) { pSetComp(M->m[0],strat->ak); pSetmComp(M->m[0]); }
2794    if (strat->M!=NULL) idDelete(&strat->M);
2795  }
2796  else if (strat->M==NULL)
2797  {
2798    M=idInit(1,F->rank);
2799    WarnS("no minimal generating set computed");
2800  }
2801  else
2802  {
2803    idSkipZeroes(strat->M);
2804    M=strat->M;
2805  }
2806  delete(strat);
2807  if (reduced>2)
2808  {
2809    Kstd1_deg=Kstd1_OldDeg;
2810    if (!oldDegBound)
2811      si_opt_1 &= ~Sy_bit(OPT_DEGBOUND);
2812  }
2813  else
2814  {
2815    if (IDELEMS(M)>IDELEMS(r)) {
2816       idDelete(&M);
2817       M=idCopy(r); }
2818  }
2819  return r;
2820}
2821
2822poly kNF(ideal F, ideal Q, poly p,int syzComp, int lazyReduce)
2823{
2824  if (p==NULL)
2825     return NULL;
2826
2827  poly pp = p;
2828
2829#ifdef HAVE_PLURAL
2830  if(rIsSCA(currRing))
2831  {
2832    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
2833    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
2834    pp = p_KillSquares(pp, m_iFirstAltVar, m_iLastAltVar, currRing);
2835
2836    if(Q == currRing->qideal)
2837      Q = SCAQuotient(currRing);
2838  }
2839#endif
2840
2841  if ((idIs0(F))&&(Q==NULL))
2842  {
2843#ifdef HAVE_PLURAL
2844    if(p != pp)
2845      return pp;
2846#endif
2847    return pCopy(p); /*F+Q=0*/
2848  }
2849
2850  kStrategy strat=new skStrategy;
2851  strat->syzComp = syzComp;
2852  strat->ak = si_max(id_RankFreeModule(F,currRing),pMaxComp(p));
2853  poly res;
2854
2855  if (rHasLocalOrMixedOrdering(currRing))
2856    res=kNF1(F,Q,pp,strat,lazyReduce);
2857  else
2858    res=kNF2(F,Q,pp,strat,lazyReduce);
2859  delete(strat);
2860
2861#ifdef HAVE_PLURAL
2862  if(pp != p)
2863    p_Delete(&pp, currRing);
2864#endif
2865  return res;
2866}
2867
2868poly kNFBound(ideal F, ideal Q, poly p,int bound,int syzComp, int lazyReduce)
2869{
2870  if (p==NULL)
2871     return NULL;
2872
2873  poly pp = p;
2874
2875#ifdef HAVE_PLURAL
2876  if(rIsSCA(currRing))
2877  {
2878    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
2879    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
2880    pp = p_KillSquares(pp, m_iFirstAltVar, m_iLastAltVar, currRing);
2881
2882    if(Q == currRing->qideal)
2883      Q = SCAQuotient(currRing);
2884  }
2885#endif
2886
2887  if ((idIs0(F))&&(Q==NULL))
2888  {
2889#ifdef HAVE_PLURAL
2890    if(p != pp)
2891      return pp;
2892#endif
2893    return pCopy(p); /*F+Q=0*/
2894  }
2895
2896  kStrategy strat=new skStrategy;
2897  strat->syzComp = syzComp;
2898  strat->ak = si_max(id_RankFreeModule(F,currRing),pMaxComp(p));
2899  poly res;
2900  res=kNF2Bound(F,Q,pp,bound,strat,lazyReduce);
2901  delete(strat);
2902
2903#ifdef HAVE_PLURAL
2904  if(pp != p)
2905    p_Delete(&pp, currRing);
2906#endif
2907  return res;
2908}
2909
2910ideal kNF(ideal F, ideal Q, ideal p,int syzComp,int lazyReduce)
2911{
2912  ideal res;
2913  if (TEST_OPT_PROT)
2914  {
2915    Print("(S:%d)",IDELEMS(p));mflush();
2916  }
2917  if (idIs0(p))
2918    return idInit(IDELEMS(p),si_max(p->rank,F->rank));
2919
2920  ideal pp = p;
2921#ifdef HAVE_PLURAL
2922  if(rIsSCA(currRing))
2923  {
2924    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
2925    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
2926    pp = id_KillSquares(pp, m_iFirstAltVar, m_iLastAltVar, currRing, false);
2927
2928    if(Q == currRing->qideal)
2929      Q = SCAQuotient(currRing);
2930  }
2931#endif
2932
2933  if ((idIs0(F))&&(Q==NULL))
2934  {
2935#ifdef HAVE_PLURAL
2936    if(p != pp)
2937      return pp;
2938#endif
2939    return idCopy(p); /*F+Q=0*/
2940  }
2941
2942  kStrategy strat=new skStrategy;
2943  strat->syzComp = syzComp;
2944  strat->ak = si_max(id_RankFreeModule(F,currRing),id_RankFreeModule(p,currRing));
2945  if (strat->ak>0) // only for module case, see Tst/Short/bug_reduce.tst
2946  {
2947    strat->ak = si_max(strat->ak,(int)F->rank);
2948  }
2949
2950  if (rHasLocalOrMixedOrdering(currRing))
2951    res=kNF1(F,Q,pp,strat,lazyReduce);
2952  else
2953    res=kNF2(F,Q,pp,strat,lazyReduce);
2954  delete(strat);
2955
2956#ifdef HAVE_PLURAL
2957  if(pp != p)
2958    id_Delete(&pp, currRing);
2959#endif
2960
2961  return res;
2962}
2963
2964ideal kNFBound(ideal F, ideal Q, ideal p,int bound,int syzComp,int lazyReduce)
2965{
2966  ideal res;
2967  if (TEST_OPT_PROT)
2968  {
2969    Print("(S:%d)",IDELEMS(p));mflush();
2970  }
2971  if (idIs0(p))
2972    return idInit(IDELEMS(p),si_max(p->rank,F->rank));
2973
2974  ideal pp = p;
2975#ifdef HAVE_PLURAL
2976  if(rIsSCA(currRing))
2977  {
2978    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
2979    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
2980    pp = id_KillSquares(pp, m_iFirstAltVar, m_iLastAltVar, currRing, false);
2981
2982    if(Q == currRing->qideal)
2983      Q = SCAQuotient(currRing);
2984  }
2985#endif
2986
2987  if ((idIs0(F))&&(Q==NULL))
2988  {
2989#ifdef HAVE_PLURAL
2990    if(p != pp)
2991      return pp;
2992#endif
2993    return idCopy(p); /*F+Q=0*/
2994  }
2995
2996  kStrategy strat=new skStrategy;
2997  strat->syzComp = syzComp;
2998  strat->ak = si_max(id_RankFreeModule(F,currRing),id_RankFreeModule(p,currRing));
2999  if (strat->ak>0) // only for module case, see Tst/Short/bug_reduce.tst
3000  {
3001    strat->ak = si_max(strat->ak,(int)F->rank);
3002  }
3003
3004  res=kNF2Bound(F,Q,pp,bound,strat,lazyReduce);
3005  delete(strat);
3006
3007#ifdef HAVE_PLURAL
3008  if(pp != p)
3009    id_Delete(&pp, currRing);
3010#endif
3011
3012  return res;
3013}
3014
3015poly k_NF (ideal F, ideal Q, poly p,int syzComp, int lazyReduce, const ring _currRing)
3016{
3017  const ring save = currRing;
3018  if( currRing != _currRing ) rChangeCurrRing(_currRing);
3019  poly ret = kNF(F, Q, p, syzComp, lazyReduce);
3020  if( currRing != save )     rChangeCurrRing(save);
3021  return ret;
3022}
3023
3024/*2
3025*interreduces F
3026*/
3027// old version
3028ideal kInterRedOld (ideal F, ideal Q)
3029{
3030  int j;
3031  kStrategy strat = new skStrategy;
3032
3033  ideal tempF = F;
3034  ideal tempQ = Q;
3035
3036#ifdef HAVE_PLURAL
3037  if(rIsSCA(currRing))
3038  {
3039    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
3040    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
3041    tempF = id_KillSquares(F, m_iFirstAltVar, m_iLastAltVar, currRing);
3042
3043    // this should be done on the upper level!!! :
3044    //    tempQ = SCAQuotient(currRing);
3045
3046    if(Q == currRing->qideal)
3047      tempQ = SCAQuotient(currRing);
3048  }
3049#endif
3050
3051//  if (TEST_OPT_PROT)
3052//  {
3053//    writeTime("start InterRed:");
3054//    mflush();
3055//  }
3056  //strat->syzComp     = 0;
3057  strat->kHEdgeFound = (currRing->ppNoether) != NULL;
3058  strat->kNoether=pCopy((currRing->ppNoether));
3059  strat->ak = id_RankFreeModule(tempF,currRing);
3060  initBuchMoraCrit(strat);
3061  strat->NotUsedAxis = (BOOLEAN *)omAlloc(((currRing->N)+1)*sizeof(BOOLEAN));
3062  for (j=(currRing->N); j>0; j--) strat->NotUsedAxis[j] = TRUE;
3063  strat->enterS      = enterSBba;
3064  strat->posInT      = posInT17;
3065  strat->initEcart   = initEcartNormal;
3066  strat->sl   = -1;
3067  strat->tl          = -1;
3068  strat->tmax        = setmaxT;
3069  strat->T           = initT();
3070  strat->R           = initR();
3071  strat->sevT        = initsevT();
3072  if (rHasLocalOrMixedOrdering(currRing))   strat->honey = TRUE;
3073  initS(tempF, tempQ, strat);
3074  if (TEST_OPT_REDSB)
3075    strat->noTailReduction=FALSE;
3076  updateS(TRUE,strat);
3077  if (TEST_OPT_REDSB && TEST_OPT_INTSTRATEGY)
3078    completeReduce(strat);
3079  //else if (TEST_OPT_PROT) PrintLn();
3080  cleanT(strat);
3081  if (strat->kHEdge!=NULL) pLmFree(&strat->kHEdge);
3082  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
3083  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
3084  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
3085  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
3086  omfree(strat->sevT);
3087  omfree(strat->S_2_R);
3088  omfree(strat->R);
3089
3090  if (strat->fromQ)
3091  {
3092    for (j=IDELEMS(strat->Shdl)-1;j>=0;j--)
3093    {
3094      if(strat->fromQ[j]) pDelete(&strat->Shdl->m[j]);
3095    }
3096    omFreeSize((ADDRESS)strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
3097  }
3098//  if (TEST_OPT_PROT)
3099//  {
3100//    writeTime("end Interred:");
3101//    mflush();
3102//  }
3103  ideal shdl=strat->Shdl;
3104  idSkipZeroes(shdl);
3105  if (strat->fromQ)
3106  {
3107    strat->fromQ=NULL;
3108    ideal res=kInterRed(shdl,NULL);
3109    idDelete(&shdl);
3110    shdl=res;
3111  }
3112  delete(strat);
3113#ifdef HAVE_PLURAL
3114  if( tempF != F )
3115    id_Delete( &tempF, currRing);
3116#endif
3117  return shdl;
3118}
3119// new version
3120ideal kInterRedBba (ideal F, ideal Q, int &need_retry)
3121{
3122  need_retry=0;
3123  int   red_result = 1;
3124  int   olddeg,reduc;
3125  BOOLEAN withT = FALSE;
3126  // BOOLEAN toReset=FALSE;
3127  kStrategy strat=new skStrategy;
3128  tHomog h;
3129
3130  if (rField_has_simple_inverse(currRing))
3131    strat->LazyPass=20;
3132  else
3133    strat->LazyPass=2;
3134  strat->LazyDegree = 1;
3135  strat->ak = id_RankFreeModule(F,currRing);
3136  strat->syzComp = strat->ak;
3137  strat->kModW=kModW=NULL;
3138  strat->kHomW=kHomW=NULL;
3139  if (strat->ak == 0)
3140  {
3141    h = (tHomog)idHomIdeal(F,Q);
3142  }
3143  else if (!TEST_OPT_DEGBOUND)
3144  {
3145    h = (tHomog)idHomIdeal(F,Q);
3146  }
3147  else
3148    h = isNotHomog;
3149  if (h==isHomog)
3150  {
3151    strat->LazyPass*=2;
3152  }
3153  strat->homog=h;
3154#ifdef KDEBUG
3155  idTest(F);
3156#endif
3157
3158  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
3159  if(rField_is_Ring(currRing))
3160    initBuchMoraPosRing(strat);
3161  else
3162    initBuchMoraPos(strat);
3163  initBba(strat);
3164  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
3165  strat->posInL=posInL0; /* ord according pComp */
3166
3167  /*Shdl=*/initBuchMora(F, Q, strat);
3168  reduc = olddeg = 0;
3169
3170#ifndef NO_BUCKETS
3171  if (!TEST_OPT_NOT_BUCKETS)
3172    strat->use_buckets = 1;
3173#endif
3174
3175  // redtailBBa against T for inhomogenous input
3176  if (!TEST_OPT_OLDSTD)
3177    withT = ! strat->homog;
3178
3179  // strat->posInT = posInT_pLength;
3180  kTest_TS(strat);
3181
3182#ifdef HAVE_TAIL_RING
3183  kStratInitChangeTailRing(strat);
3184#endif
3185
3186  /* compute------------------------------------------------------- */
3187  while (strat->Ll >= 0)
3188  {
3189    #ifdef KDEBUG
3190      if (TEST_OPT_DEBUG) messageSets(strat);
3191    #endif
3192    if (strat->Ll== 0) strat->interpt=TRUE;
3193    /* picks the last element from the lazyset L */
3194    strat->P = strat->L[strat->Ll];
3195    strat->Ll--;
3196
3197    if (strat->P.p1 == NULL)
3198    {
3199      // for input polys, prepare reduction
3200      strat->P.PrepareRed(strat->use_buckets);
3201    }
3202
3203    if (strat->P.p == NULL && strat->P.t_p == NULL)
3204    {
3205      red_result = 0;
3206    }
3207    else
3208    {
3209      if (TEST_OPT_PROT)
3210        message(strat->P.pFDeg(),
3211                &olddeg,&reduc,strat, red_result);
3212
3213      /* reduction of the element chosen from L */
3214      red_result = strat->red(&strat->P,strat);
3215    }
3216
3217    // reduction to non-zero new poly
3218    if (red_result == 1)
3219    {
3220      /* statistic */
3221      if (TEST_OPT_PROT) PrintS("s");
3222
3223      // get the polynomial (canonicalize bucket, make sure P.p is set)
3224      strat->P.GetP(strat->lmBin);
3225
3226      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
3227
3228      // reduce the tail and normalize poly
3229      // in the ring case we cannot expect LC(f) = 1,
3230      // therefore we call pCleardenom instead of pNorm
3231      if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
3232      {
3233        strat->P.pCleardenom();
3234        if (0)
3235        //if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
3236        {
3237          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
3238          strat->P.pCleardenom();
3239        }
3240      }
3241      else
3242      {
3243        strat->P.pNorm();
3244        if (0)
3245        //if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
3246          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
3247      }
3248
3249#ifdef KDEBUG
3250      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
3251#endif
3252
3253      // enter into S, L, and T
3254      if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
3255      {
3256        enterT(strat->P, strat);
3257        // posInS only depends on the leading term
3258        strat->enterS(strat->P, pos, strat, strat->tl);
3259
3260        if (pos<strat->sl)
3261        {
3262          need_retry++;
3263          // move all "larger" elements fromS to L
3264          // remove them from T
3265          int ii=pos+1;
3266          for(;ii<=strat->sl;ii++)
3267          {
3268            LObject h;
3269            memset(&h,0,sizeof(h));
3270            h.tailRing=strat->tailRing;
3271            h.p=strat->S[ii]; strat->S[ii]=NULL;
3272            strat->initEcart(&h);
3273            h.sev=strat->sevS[ii];
3274            int jj=strat->tl;
3275            while (jj>=0)
3276            {
3277              if (strat->T[jj].p==h.p)
3278              {
3279                strat->T[jj].p=NULL;
3280                if (jj<strat->tl)
3281                {
3282                  memmove(&(strat->T[jj]),&(strat->T[jj+1]),
3283                          (strat->tl-jj)*sizeof(strat->T[jj]));
3284                  memmove(&(strat->sevT[jj]),&(strat->sevT[jj+1]),
3285                          (strat->tl-jj)*sizeof(strat->sevT[jj]));
3286                }
3287                strat->tl--;
3288                break;
3289              }
3290              jj--;
3291            }
3292            int lpos=strat->posInL(strat->L,strat->Ll,&h,strat);
3293            enterL(&strat->L,&strat->Ll,&strat->Lmax,h,lpos);
3294            #ifdef KDEBUG
3295            if (TEST_OPT_DEBUG)
3296            {
3297              Print("move S[%d] -> L[%d]: ",ii,pos);
3298              p_wrp(h.p,currRing, strat->tailRing);
3299              PrintLn();
3300            }
3301            #endif
3302          }
3303          if (strat->fromQ!=NULL)
3304          {
3305            for(ii=pos+1;ii<=strat->sl;ii++) strat->fromQ[ii]=0;
3306          }
3307          strat->sl=pos;
3308        }
3309      }
3310      else
3311      {
3312        // clean P
3313      }
3314      kDeleteLcm(&strat->P);
3315    }
3316
3317#ifdef KDEBUG
3318    if (TEST_OPT_DEBUG)
3319    {
3320      messageSets(strat);
3321    }
3322    memset(&(strat->P), 0, sizeof(strat->P));
3323#endif
3324    //kTest_TS(strat);: i_r out of sync in kInterRedBba, but not used!
3325  }
3326#ifdef KDEBUG
3327  //if (TEST_OPT_DEBUG) messageSets(strat);
3328#endif
3329  /* complete reduction of the standard basis--------- */
3330
3331  if((need_retry<=0) && (TEST_OPT_REDSB))
3332  {
3333    completeReduce(strat);
3334    if (strat->completeReduce_retry)
3335    {
3336      // completeReduce needed larger exponents, retry
3337      // hopefully: kStratChangeTailRing already provided a larger tailRing
3338      //    (otherwise: it will fail again)
3339      strat->completeReduce_retry=FALSE;
3340      completeReduce(strat);
3341      if (strat->completeReduce_retry)
3342      {
3343#ifdef HAVE_TAIL_RING
3344        if(currRing->bitmask>strat->tailRing->bitmask)
3345        {
3346          // retry without T
3347          strat->completeReduce_retry=FALSE;
3348          cleanT(strat);strat->tailRing=currRing;
3349          int i;
3350          for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
3351          completeReduce(strat);
3352        }
3353        if (strat->completeReduce_retry)
3354#endif
3355          Werror("exponent bound is %ld",currRing->bitmask);
3356      }
3357    }
3358  }
3359  else if (TEST_OPT_PROT) PrintLn();
3360
3361
3362  /* release temp data-------------------------------- */
3363  exitBuchMora(strat);
3364//  if (TEST_OPT_WEIGHTM)
3365//  {
3366//    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
3367//    if (ecartWeights)
3368//    {
3369//      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
3370//      ecartWeights=NULL;
3371//    }
3372//  }
3373  //if (TEST_OPT_PROT) messageStat(0/*hilbcount*/,strat);
3374  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
3375  ideal res=strat->Shdl;
3376  strat->Shdl=NULL;
3377  delete strat;
3378  return res;
3379}
3380ideal kInterRed (ideal F, ideal Q)
3381{
3382#ifdef HAVE_PLURAL
3383  if(rIsPluralRing(currRing)) return kInterRedOld(F,Q);
3384#endif
3385  if ((rHasLocalOrMixedOrdering(currRing))|| (rField_is_numeric(currRing))
3386  ||(rField_is_Ring(currRing))
3387  )
3388    return kInterRedOld(F,Q);
3389
3390    //return kInterRedOld(F,Q);
3391
3392  BITSET save1;
3393  SI_SAVE_OPT1(save1);
3394  //si_opt_1|=Sy_bit(OPT_NOT_SUGAR);
3395  si_opt_1|=Sy_bit(OPT_REDTHROUGH);
3396  //si_opt_1&= ~Sy_bit(OPT_REDTAIL);
3397  //si_opt_1&= ~Sy_bit(OPT_REDSB);
3398  //extern char * showOption() ;
3399  //Print("%s\n",showOption());
3400
3401  int need_retry;
3402  int counter=3;
3403  ideal res, res1;
3404  int elems;
3405  ideal null=NULL;
3406  if ((Q==NULL) || (!TEST_OPT_REDSB))
3407  {
3408    elems=idElem(F);
3409    res=kInterRedBba(F,Q,need_retry);
3410  }
3411  else
3412  {
3413    ideal FF=idSimpleAdd(F,Q);
3414    res=kInterRedBba(FF,NULL,need_retry);
3415    idDelete(&FF);
3416    null=idInit(1,1);
3417    if (need_retry)
3418      res1=kNF(null,Q,res,0,KSTD_NF_LAZY);
3419    else
3420      res1=kNF(null,Q,res);
3421    idDelete(&res);
3422    res=res1;
3423    need_retry=1;
3424  }
3425  if (idElem(res)<=1) need_retry=0;
3426  while (need_retry && (counter>0))
3427  {
3428    #ifdef KDEBUG
3429    if (TEST_OPT_DEBUG) { Print("retry counter %d\n",counter); }
3430    #endif
3431    res1=kInterRedBba(res,Q,need_retry);
3432    int new_elems=idElem(res1);
3433    counter -= (new_elems >= elems);
3434    elems = new_elems;
3435    idDelete(&res);
3436    if (idElem(res1)<=1) need_retry=0;
3437    if ((Q!=NULL) && (TEST_OPT_REDSB))
3438    {
3439      if (need_retry)
3440        res=kNF(null,Q,res1,0,KSTD_NF_LAZY);
3441      else
3442        res=kNF(null,Q,res1);
3443      idDelete(&res1);
3444    }
3445    else
3446      res = res1;
3447    if (idElem(res)<=1) need_retry=0;
3448  }
3449  if (null!=NULL) idDelete(&null);
3450  SI_RESTORE_OPT1(save1);
3451  idSkipZeroes(res);
3452  return res;
3453}
3454
3455// returns TRUE if mora should use buckets, false otherwise
3456static BOOLEAN kMoraUseBucket(kStrategy strat)
3457{
3458#ifdef MORA_USE_BUCKETS
3459  if (TEST_OPT_NOT_BUCKETS)
3460    return FALSE;
3461  if (strat->red == redFirst)
3462  {
3463#ifdef NO_LDEG
3464    if (strat->syzComp==0)
3465      return TRUE;
3466#else
3467    if ((strat->homog || strat->honey) && (strat->syzComp==0))
3468      return TRUE;
3469#endif
3470  }
3471  else
3472  {
3473    #ifdef HAVE_RINGS
3474    assume(strat->red == redEcart || strat->red == redRiloc);
3475    #else
3476    assume(strat->red == redEcart);
3477    #endif
3478    if (strat->honey && (strat->syzComp==0))
3479      return TRUE;
3480  }
3481#endif
3482  return FALSE;
3483}
Note: See TracBrowser for help on using the repository browser.