source: git/kernel/GBEngine/kstd1.cc @ 32c4829

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