source: git/kernel/GBEngine/kstd1.cc @ 502859

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