source: git/kernel/GBEngine/kstd1.cc @ 036a5e

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