source: git/kernel/GBEngine/kstd1.cc @ 9b100cf

spielwiese
Last change on this file since 9b100cf was 9b100cf, checked in by Hans Schoenemann <hannes@…>, 2 months ago
ifix: typo
  • Property mode set to 100644
File size: 101.7 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  && (!rIsNCRing(currRing))
1712  && (!rField_is_Ring(currRing)))
1713    strat->red=redLiftstd;
1714  if (currRing->pLexOrder && strat->honey)
1715    strat->initEcart = initEcartNormal;
1716  else
1717    strat->initEcart = initEcartBBA;
1718  if (strat->honey)
1719    strat->initEcartPair = initEcartPairMora;
1720  else
1721    strat->initEcartPair = initEcartPairBba;
1722//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1723//  {
1724//    //interred  machen   Aenderung
1725//    strat->pOrigFDeg=pFDeg;
1726//    strat->pOrigLDeg=pLDeg;
1727//    //h=ggetid("ecart");
1728//    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
1729//    //{
1730//    //  ecartWeights=iv2array(IDINTVEC(h));
1731//    //}
1732//    //else
1733//    {
1734//      ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
1735//      /*uses automatic computation of the ecartWeights to set them*/
1736//      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
1737//    }
1738//    pRestoreDegProcs(currRing,totaldegreeWecart, maxdegreeWecart);
1739//    if (TEST_OPT_PROT)
1740//    {
1741//      for(i=1; i<=(currRing->N); i++)
1742//        Print(" %d",ecartWeights[i]);
1743//      PrintLn();
1744//      mflush();
1745//    }
1746//  }
1747}
1748
1749void initSba(ideal F,kStrategy strat)
1750{
1751  int i;
1752  //idhdl h;
1753 /* setting global variables ------------------- */
1754  strat->enterS = enterSSba;
1755  strat->red2 = redHoney;
1756  if (strat->honey)
1757    strat->red2 = redHoney;
1758  else if (currRing->pLexOrder && !strat->homog)
1759    strat->red2 = redLazy;
1760  else
1761  {
1762    strat->LazyPass *=4;
1763    strat->red2 = redHomog;
1764  }
1765  if (rField_is_Ring(currRing))
1766  {
1767    if(rHasLocalOrMixedOrdering(currRing))
1768      {strat->red2 = redRiloc;}
1769    else
1770      {strat->red2 = redRing;}
1771  }
1772  if (currRing->pLexOrder && strat->honey)
1773    strat->initEcart = initEcartNormal;
1774  else
1775    strat->initEcart = initEcartBBA;
1776  if (strat->honey)
1777    strat->initEcartPair = initEcartPairMora;
1778  else
1779    strat->initEcartPair = initEcartPairBba;
1780  //strat->kIdeal = NULL;
1781  //if (strat->ak==0) strat->kIdeal->rtyp=IDEAL_CMD;
1782  //else              strat->kIdeal->rtyp=MODUL_CMD;
1783  //strat->kIdeal->data=(void *)strat->Shdl;
1784  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1785  {
1786    //interred  machen   Aenderung
1787    strat->pOrigFDeg  = currRing->pFDeg;
1788    strat->pOrigLDeg  = currRing->pLDeg;
1789    //h=ggetid("ecart");
1790    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
1791    //{
1792    //  ecartWeights=iv2array(IDINTVEC(h));
1793    //}
1794    //else
1795    {
1796      ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
1797      /*uses automatic computation of the ecartWeights to set them*/
1798      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights, currRing);
1799    }
1800    pRestoreDegProcs(currRing, totaldegreeWecart, maxdegreeWecart);
1801    if (TEST_OPT_PROT)
1802    {
1803      for(i=1; i<=(currRing->N); i++)
1804        Print(" %d",ecartWeights[i]);
1805      PrintLn();
1806      mflush();
1807    }
1808  }
1809  // for sig-safe reductions in signature-based
1810  // standard basis computations
1811  if(rField_is_Ring(currRing))
1812    strat->red = redSigRing;
1813  else
1814    strat->red        = redSig;
1815  //strat->sbaOrder  = 1;
1816  strat->currIdx      = 1;
1817}
1818
1819void initMora(ideal F,kStrategy strat)
1820{
1821  int i,j;
1822
1823  strat->NotUsedAxis = (BOOLEAN *)omAlloc(((currRing->N)+1)*sizeof(BOOLEAN));
1824  for (j=(currRing->N); j>0; j--) strat->NotUsedAxis[j] = TRUE;
1825  strat->enterS = enterSMora;
1826  strat->initEcartPair = initEcartPairMora; /*- ecart approximation -*/
1827  strat->posInLOld = strat->posInL;
1828  strat->posInLOldFlag = TRUE;
1829  strat->initEcart = initEcartNormal;
1830  strat->kAllAxis = (currRing->ppNoether) != NULL; //!!
1831  if ( currRing->ppNoether != NULL )
1832  {
1833    strat->kNoether = pCopy((currRing->ppNoether));
1834    strat->red = redFirst;  /*take the first possible in T*/
1835    if (TEST_OPT_PROT)
1836    {
1837      Print("H(%ld)",p_FDeg(currRing->ppNoether,currRing)+1);
1838      mflush();
1839    }
1840  }
1841  else if (strat->homog)
1842    strat->red = redFirst;  /*take the first possible in T*/
1843  else
1844    strat->red = redEcart;/*take the first possible in under ecart-restriction*/
1845  if (currRing->ppNoether != NULL)
1846  {
1847    HCord = currRing->pFDeg((currRing->ppNoether),currRing)+1;
1848  }
1849  else
1850  {
1851    HCord = 32000;/*- very large -*/
1852  }
1853
1854  if (rField_is_Ring(currRing))
1855  {
1856    if (rField_is_Z(currRing))
1857      strat->red = redRiloc_Z;
1858    else
1859      strat->red = redRiloc;
1860  }
1861
1862  /*reads the ecartWeights used for Graebes method from the
1863   *intvec ecart and set ecartWeights
1864   */
1865  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1866  {
1867    //interred  machen   Aenderung
1868    strat->pOrigFDeg=currRing->pFDeg;
1869    strat->pOrigLDeg=currRing->pLDeg;
1870    ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
1871    /*uses automatic computation of the ecartWeights to set them*/
1872    kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights,currRing);
1873
1874    pSetDegProcs(currRing,totaldegreeWecart, maxdegreeWecart);
1875    if (TEST_OPT_PROT)
1876    {
1877      for(i=1; i<=(currRing->N); i++)
1878        Print(" %d",ecartWeights[i]);
1879      PrintLn();
1880      mflush();
1881    }
1882  }
1883  kOptimizeLDeg(currRing->pLDeg, strat);
1884}
1885
1886void kDebugPrint(kStrategy strat);
1887
1888ideal mora (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1889{
1890  int olddeg = 0;
1891  int reduc = 0;
1892  int red_result = 1;
1893  int hilbeledeg=1,hilbcount=0;
1894  BITSET save1;
1895  SI_SAVE_OPT1(save1);
1896  if (rHasMixedOrdering(currRing))
1897  {
1898    si_opt_1 &= ~Sy_bit(OPT_REDSB);
1899    si_opt_1 &= ~Sy_bit(OPT_REDTAIL);
1900  }
1901
1902  strat->update = TRUE;
1903  /*- setting global variables ------------------- -*/
1904  initBuchMoraCrit(strat);
1905  initHilbCrit(F,Q,&hilb,strat);
1906  initMora(F,strat);
1907  if(rField_is_Ring(currRing))
1908    initBuchMoraPosRing(strat);
1909  else
1910    initBuchMoraPos(strat);
1911  /*Shdl=*/initBuchMora(F,Q,strat);
1912  if (TEST_OPT_FASTHC) missingAxis(&strat->lastAxis,strat);
1913  /*updateS in initBuchMora has Hecketest
1914  * and could have put strat->kHEdgdeFound FALSE*/
1915  if (TEST_OPT_FASTHC && (strat->lastAxis) && strat->posInLOldFlag)
1916  {
1917    strat->posInLOld = strat->posInL;
1918    strat->posInLOldFlag = FALSE;
1919    strat->posInL = posInL10;
1920    updateL(strat);
1921    reorderL(strat);
1922  }
1923  kTest_TS(strat);
1924  strat->use_buckets = kMoraUseBucket(strat);
1925
1926#ifdef HAVE_TAIL_RING
1927  if (strat->homog && strat->red == redFirst)
1928    if(!idIs0(F) &&(!rField_is_Ring(currRing)))
1929      kStratInitChangeTailRing(strat);
1930#endif
1931
1932  if (BVERBOSE(23))
1933  {
1934    kDebugPrint(strat);
1935  }
1936//deleteInL(strat->L,&strat->Ll,1,strat);
1937//deleteInL(strat->L,&strat->Ll,0,strat);
1938
1939  /*- compute-------------------------------------------*/
1940  while (strat->Ll >= 0)
1941  {
1942    #ifdef KDEBUG
1943    if (TEST_OPT_DEBUG) messageSets(strat);
1944    #endif
1945    if (siCntrlc)
1946    {
1947      while (strat->Ll >= 0)
1948        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1949      strat->noClearS=TRUE;
1950    }
1951    if (TEST_OPT_DEGBOUND
1952    && (strat->L[strat->Ll].ecart+strat->L[strat->Ll].GetpFDeg()> Kstd1_deg))
1953    {
1954      /*
1955      * stops computation if
1956      * - 24 (degBound)
1957      *   && upper degree is bigger than Kstd1_deg
1958      */
1959      while ((strat->Ll >= 0)
1960        && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
1961        && (strat->L[strat->Ll].ecart+strat->L[strat->Ll].GetpFDeg()> Kstd1_deg)
1962      )
1963      {
1964        deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1965        //if (TEST_OPT_PROT)
1966        //{
1967        //   PrintS("D"); mflush();
1968        //}
1969      }
1970      if (strat->Ll<0) break;
1971      else strat->noClearS=TRUE;
1972    }
1973    strat->P = strat->L[strat->Ll];/*- picks the last element from the lazyset L -*/
1974    if (strat->Ll==0) strat->interpt=TRUE;
1975    strat->Ll--;
1976    // create the real Spoly
1977    if (pNext(strat->P.p) == strat->tail)
1978    {
1979      /*- deletes the short spoly and computes -*/
1980      if (rField_is_Ring(currRing))
1981        pLmDelete(strat->P.p);
1982      else
1983        pLmFree(strat->P.p);
1984      strat->P.p = NULL;
1985      poly m1 = NULL, m2 = NULL;
1986      // check that spoly creation is ok
1987      while (strat->tailRing != currRing &&
1988             !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
1989      {
1990        assume(m1 == NULL && m2 == NULL);
1991        // if not, change to a ring where exponents are large enough
1992        kStratChangeTailRing(strat);
1993      }
1994      /* create the real one */
1995      ksCreateSpoly(&(strat->P), strat->kNoetherTail(), strat->use_buckets,
1996                    strat->tailRing, m1, m2, strat->R);
1997      if (!strat->use_buckets)
1998        strat->P.SetLength(strat->length_pLength);
1999    }
2000    else if (strat->P.p1 == NULL)
2001    {
2002      // for input polys, prepare reduction (buckets !)
2003      strat->P.SetLength(strat->length_pLength);
2004      strat->P.PrepareRed(strat->use_buckets);
2005    }
2006
2007    // the s-poly
2008    if (!strat->P.IsNull())
2009    {
2010      // might be NULL from noether !!!
2011      if (TEST_OPT_PROT)
2012        message(strat->P.ecart+strat->P.GetpFDeg(),&olddeg,&reduc,strat, red_result);
2013      // reduce
2014      red_result = strat->red(&strat->P,strat);
2015    }
2016
2017    // the reduced s-poly
2018    if (! strat->P.IsNull())
2019    {
2020      strat->P.GetP();
2021      // statistics
2022      if (TEST_OPT_PROT) PrintS("s");
2023      // normalization
2024      if (TEST_OPT_INTSTRATEGY)
2025        strat->P.pCleardenom();
2026      else
2027        strat->P.pNorm();
2028      // tailreduction
2029      strat->P.p = redtail(&(strat->P),strat->sl,strat);
2030      if (strat->P.p==NULL)
2031      {
2032        WerrorS("exponent overflow - wrong ordering");
2033        return(idInit(1,1));
2034      }
2035      // set ecart -- might have changed because of tail reductions
2036      if ((!strat->noTailReduction) && (!strat->honey))
2037        strat->initEcart(&strat->P);
2038      // cancel unit
2039      cancelunit(&strat->P);
2040      // for char 0, clear denominators
2041      if ((strat->P.p->next==NULL) /* i.e. cancelunit did something*/
2042      && TEST_OPT_INTSTRATEGY)
2043        strat->P.pCleardenom();
2044
2045      strat->P.SetShortExpVector();
2046      enterT(strat->P,strat);
2047      // build new pairs
2048      if (rField_is_Ring(currRing))
2049        superenterpairs(strat->P.p,strat->sl,strat->P.ecart,0,strat, strat->tl);
2050      else
2051        enterpairs(strat->P.p,strat->sl,strat->P.ecart,0,strat, strat->tl);
2052      // put in S
2053      strat->enterS(strat->P,
2054                    posInS(strat,strat->sl,strat->P.p, strat->P.ecart),
2055                    strat, strat->tl);
2056      // apply hilbert criterion
2057      if (hilb!=NULL)
2058      {
2059        if (strat->homog==isHomog)
2060          khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
2061        else
2062          khCheckLocInhom(Q,w,hilb,hilbcount,strat);
2063      }
2064
2065      // clear strat->P
2066      kDeleteLcm(&strat->P);
2067
2068#ifdef KDEBUG
2069      // make sure kTest_TS does not complain about strat->P
2070      strat->P.Clear();
2071#endif
2072    }
2073    if (strat->kAllAxis)
2074    {
2075      if ((TEST_OPT_FINDET)
2076      || ((TEST_OPT_MULTBOUND) && (scMult0Int(strat->Shdl,NULL) < Kstd1_mu)))
2077      {
2078        // obachman: is this still used ???
2079        /*
2080        * stops computation if strat->kAllAxis and
2081        * - 27 (finiteDeterminacyTest)
2082        * or
2083        * - 23
2084        *   (multBound)
2085        *   && multiplicity of the ideal is smaller then a predefined number mu
2086        */
2087        while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
2088      }
2089    }
2090    kTest_TS(strat);
2091  }
2092  /*- complete reduction of the standard basis------------------------ -*/
2093  if (TEST_OPT_REDSB) completeReduce(strat);
2094  else if (TEST_OPT_PROT) PrintLn();
2095  /*- release temp data------------------------------- -*/
2096  exitBuchMora(strat);
2097  /*- polynomials used for HECKE: HC, noether -*/
2098  if (TEST_OPT_FINDET)
2099  {
2100    if (strat->kNoether!=NULL)
2101      Kstd1_mu=currRing->pFDeg(strat->kNoether,currRing);
2102    else
2103      Kstd1_mu=-1;
2104  }
2105  if (strat->kNoether!=NULL) pLmFree(&strat->kNoether);
2106  if (strat->kNoether!=NULL) pLmDelete(&strat->kNoether);
2107  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
2108  if ((TEST_OPT_PROT)||(TEST_OPT_DEBUG))  messageStat(hilbcount,strat);
2109//  if (TEST_OPT_WEIGHTM)
2110//  {
2111//    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2112//    if (ecartWeights)
2113//    {
2114//      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
2115//      ecartWeights=NULL;
2116//    }
2117//  }
2118  if(nCoeff_is_Z(currRing->cf))
2119    finalReduceByMon(strat);
2120  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
2121  SI_RESTORE_OPT1(save1);
2122  idTest(strat->Shdl);
2123  return (strat->Shdl);
2124}
2125
2126poly kNF1 (ideal F,ideal Q,poly q, kStrategy strat, int lazyReduce)
2127{
2128  assume(q!=NULL);
2129  assume(!(idIs0(F)&&(Q==NULL)));
2130
2131// lazy_reduce flags: can be combined by |
2132//#define KSTD_NF_LAZY   1
2133  // do only a reduction of the leading term
2134//#define KSTD_NF_ECART  2
2135  // only local: reduce even with bad ecart
2136  poly   p;
2137  int   i;
2138  int   j;
2139  int   o;
2140  LObject   h;
2141  BITSET save1;
2142  SI_SAVE_OPT1(save1);
2143
2144  //if ((idIs0(F))&&(Q==NULL))
2145  //  return pCopy(q); /*F=0*/
2146  //strat->ak = si_max(idRankFreeModule(F),pMaxComp(q));
2147  /*- creating temp data structures------------------- -*/
2148  //strat->kAllAxis = (currRing->ppNoether) != NULL;
2149  strat->kNoether    = pCopy((currRing->ppNoether));
2150  si_opt_1|=Sy_bit(OPT_REDTAIL);
2151  if (!rField_is_Ring(currRing))
2152    si_opt_1&=~Sy_bit(OPT_INTSTRATEGY);
2153  if (TEST_OPT_STAIRCASEBOUND
2154  && (! TEST_V_DEG_STOP)
2155  && (0<Kstd1_deg)
2156  && ((strat->kNoether==NULL)
2157    ||(TEST_OPT_DEGBOUND && (pWTotaldegree(strat->kNoether)<Kstd1_deg))))
2158  {
2159    pLmDelete(&strat->kNoether);
2160    strat->kNoether=pOne();
2161    pSetExp(strat->kNoether,1, Kstd1_deg+1);
2162    pSetm(strat->kNoether);
2163    // strat->kAllAxis=TRUE;
2164  }
2165  initBuchMoraCrit(strat);
2166  if(rField_is_Ring(currRing))
2167    initBuchMoraPosRing(strat);
2168  else
2169    initBuchMoraPos(strat);
2170  initMora(F,strat);
2171  strat->enterS = enterSMoraNF;
2172  /*- set T -*/
2173  strat->tl = -1;
2174  strat->tmax = setmaxT;
2175  strat->T = initT();
2176  strat->R = initR();
2177  strat->sevT = initsevT();
2178  /*- set S -*/
2179  strat->sl = -1;
2180  /*- init local data struct.-------------------------- -*/
2181  /*Shdl=*/initS(F,Q,strat);
2182  if ((strat->ak!=0)
2183  && (strat->kAllAxis)) /*never true for ring-cf*/
2184  {
2185    if (strat->ak!=1)
2186    {
2187      pSetComp(strat->kNoether,1);
2188      pSetmComp(strat->kNoether);
2189      poly p=pHead(strat->kNoether);
2190      pSetComp(p,strat->ak);
2191      pSetmComp(p);
2192      p=pAdd(strat->kNoether,p);
2193      strat->kNoether=pNext(p);
2194      p_LmDelete(p,currRing);
2195    }
2196  }
2197  if (((lazyReduce & KSTD_NF_LAZY)==0)
2198  && (!rField_is_Ring(currRing)))
2199  {
2200    for (i=strat->sl; i>=0; i--)
2201      pNorm(strat->S[i]);
2202  }
2203  /*- puts the elements of S also to T -*/
2204  for (i=0; i<=strat->sl; i++)
2205  {
2206    h.p = strat->S[i];
2207    h.ecart = strat->ecartS[i];
2208    if (strat->sevS[i] == 0) strat->sevS[i] = pGetShortExpVector(h.p);
2209    else assume(strat->sevS[i] == pGetShortExpVector(h.p));
2210    h.length = pLength(h.p);
2211    h.sev = strat->sevS[i];
2212    h.SetpFDeg();
2213    enterT(h,strat);
2214  }
2215#ifdef KDEBUG
2216//  kDebugPrint(strat);
2217#endif
2218  /*- compute------------------------------------------- -*/
2219  p = pCopy(q);
2220  deleteHC(&p,&o,&j,strat);
2221  kTest(strat);
2222  if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
2223  if (BVERBOSE(23)) kDebugPrint(strat);
2224  if(rField_is_Ring(currRing))
2225  {
2226    if (p!=NULL) p = redMoraNFRing(p,strat, lazyReduce & KSTD_NF_ECART);
2227  }
2228  else
2229  {
2230    if (p!=NULL) p = redMoraNF(p,strat, lazyReduce & KSTD_NF_ECART);
2231  }
2232  if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
2233  {
2234    if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
2235    p = redtail(p,strat->sl,strat);
2236  }
2237  /*- release temp data------------------------------- -*/
2238  cleanT(strat);
2239  assume(strat->L==NULL); /*strat->L unused */
2240  assume(strat->B==NULL); /*strat->B unused */
2241  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
2242  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
2243  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
2244  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
2245  omFree(strat->sevT);
2246  omFree(strat->S_2_R);
2247  omFree(strat->R);
2248
2249  omfree((ADDRESS)strat->fromQ);
2250  strat->fromQ=NULL;
2251  if (strat->kNoether!=NULL) pLmFree(&strat->kNoether);
2252//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
2253//  {
2254//    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2255//    if (ecartWeights)
2256//    {
2257//      omFreeSize((ADDRESS *)&ecartWeights,((currRing->N)+1)*sizeof(short));
2258//      ecartWeights=NULL;
2259//    }
2260//  }
2261  idDelete(&strat->Shdl);
2262  SI_RESTORE_OPT1(save1);
2263  if (TEST_OPT_PROT) PrintLn();
2264  return p;
2265}
2266
2267ideal kNF1 (ideal F,ideal Q,ideal q, kStrategy strat, int lazyReduce)
2268{
2269  assume(!idIs0(q));
2270  assume(!(idIs0(F)&&(Q==NULL)));
2271
2272// lazy_reduce flags: can be combined by |
2273//#define KSTD_NF_LAZY   1
2274  // do only a reduction of the leading term
2275//#define KSTD_NF_ECART  2
2276  // only local: reduce even with bad ecart
2277  poly   p;
2278  int   i;
2279  int   j;
2280  int   o;
2281  LObject   h;
2282  ideal res;
2283  BITSET save1;
2284  SI_SAVE_OPT1(save1);
2285
2286  //if (idIs0(q)) return idInit(IDELEMS(q),si_max(q->rank,F->rank));
2287  //if ((idIs0(F))&&(Q==NULL))
2288  //  return idCopy(q); /*F=0*/
2289  //strat->ak = si_max(idRankFreeModule(F),idRankFreeModule(q));
2290  /*- creating temp data structures------------------- -*/
2291  //strat->kAllAxis = (currRing->ppNoether) != NULL;
2292  strat->kNoether=pCopy((currRing->ppNoether));
2293  si_opt_1|=Sy_bit(OPT_REDTAIL);
2294  if (TEST_OPT_STAIRCASEBOUND
2295  && (0<Kstd1_deg)
2296  && ((strat->kNoether==NULL)
2297    ||(TEST_OPT_DEGBOUND && (pWTotaldegree(strat->kNoether)<Kstd1_deg))))
2298  {
2299    pLmDelete(&strat->kNoether);
2300    strat->kNoether=pOne();
2301    pSetExp(strat->kNoether,1, Kstd1_deg+1);
2302    pSetm(strat->kNoether);
2303    //strat->kAllAxis=TRUE;
2304  }
2305  initBuchMoraCrit(strat);
2306  if(rField_is_Ring(currRing))
2307    initBuchMoraPosRing(strat);
2308  else
2309    initBuchMoraPos(strat);
2310  initMora(F,strat);
2311  strat->enterS = enterSMoraNF;
2312  /*- set T -*/
2313  strat->tl = -1;
2314  strat->tmax = setmaxT;
2315  strat->T = initT();
2316  strat->R = initR();
2317  strat->sevT = initsevT();
2318  /*- set S -*/
2319  strat->sl = -1;
2320  /*- init local data struct.-------------------------- -*/
2321  /*Shdl=*/initS(F,Q,strat);
2322  if ((strat->ak!=0)
2323  && (strat->kNoether!=NULL))
2324  {
2325    if (strat->ak!=1)
2326    {
2327      pSetComp(strat->kNoether,1);
2328      pSetmComp(strat->kNoether);
2329      poly p=pHead(strat->kNoether);
2330      pSetComp(p,strat->ak);
2331      pSetmComp(p);
2332      p=pAdd(strat->kNoether,p);
2333      strat->kNoether=pNext(p);
2334      p_LmDelete(p,currRing);
2335    }
2336  }
2337  if (((lazyReduce & KSTD_NF_LAZY)==0)
2338  && (!rField_is_Ring(currRing)))
2339  {
2340    for (i=strat->sl; i>=0; i--)
2341      pNorm(strat->S[i]);
2342  }
2343  /*- compute------------------------------------------- -*/
2344  res=idInit(IDELEMS(q),strat->ak);
2345  for (i=0; i<IDELEMS(q); i++)
2346  {
2347    if (q->m[i]!=NULL)
2348    {
2349      p = pCopy(q->m[i]);
2350      deleteHC(&p,&o,&j,strat);
2351      if (p!=NULL)
2352      {
2353        /*- puts the elements of S also to T -*/
2354        for (j=0; j<=strat->sl; j++)
2355        {
2356          h.p = strat->S[j];
2357          h.ecart = strat->ecartS[j];
2358          h.pLength = h.length = pLength(h.p);
2359          if (strat->sevS[j] == 0) strat->sevS[j] = pGetShortExpVector(h.p);
2360          else assume(strat->sevS[j] == pGetShortExpVector(h.p));
2361          h.sev = strat->sevS[j];
2362          h.SetpFDeg();
2363          if(rField_is_Ring(currRing) && rHasLocalOrMixedOrdering(currRing))
2364            enterT_strong(h,strat);
2365          else
2366            enterT(h,strat);
2367        }
2368        if (TEST_OPT_PROT) { PrintS("r"); mflush(); }
2369        if(rField_is_Ring(currRing))
2370        {
2371          p = redMoraNFRing(p,strat, lazyReduce);
2372        }
2373        else
2374          p = redMoraNF(p,strat, lazyReduce);
2375        if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
2376        {
2377          if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
2378          p = redtail(p,strat->sl,strat);
2379        }
2380        cleanT(strat);
2381      }
2382      res->m[i]=p;
2383    }
2384    //else
2385    //  res->m[i]=NULL;
2386  }
2387  /*- release temp data------------------------------- -*/
2388  assume(strat->L==NULL); /*strat->L unused */
2389  assume(strat->B==NULL); /*strat->B unused */
2390  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
2391  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
2392  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
2393  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
2394  omFree(strat->sevT);
2395  omFree(strat->S_2_R);
2396  omFree(strat->R);
2397  omfree((ADDRESS)strat->fromQ);
2398  strat->fromQ=NULL;
2399  if (strat->kNoether!=NULL) pLmFree(&strat->kNoether);
2400//  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
2401//  {
2402//    pFDeg=strat->pOrigFDeg;
2403//    pLDeg=strat->pOrigLDeg;
2404//    if (ecartWeights)
2405//    {
2406//      omFreeSize((ADDRESS *)&ecartWeights,((currRing->N)+1)*sizeof(short));
2407//      ecartWeights=NULL;
2408//    }
2409//  }
2410  idDelete(&strat->Shdl);
2411  SI_RESTORE_OPT1(save1);
2412  if (TEST_OPT_PROT) PrintLn();
2413  return res;
2414}
2415
2416VAR intvec * kModW, * kHomW;
2417
2418long kModDeg(poly p,const ring r)
2419{
2420  long o=p_WDegree(p, r);
2421  long i=__p_GetComp(p, r);
2422  if (i==0) return o;
2423  //assume((i>0) && (i<=kModW->length()));
2424  if (i<=kModW->length())
2425    return o+(*kModW)[i-1];
2426  return o;
2427}
2428long kHomModDeg(poly p,const ring r)
2429{
2430  int i;
2431  long j=0;
2432
2433  for (i=r->N;i>0;i--)
2434    j+=p_GetExp(p,i,r)*(*kHomW)[i-1];
2435  if (kModW == NULL) return j;
2436  i = __p_GetComp(p,r);
2437  if (i==0) return j;
2438  return j+(*kModW)[i-1];
2439}
2440
2441static poly kTryHC(ideal F, ideal Q)
2442{
2443  if (TEST_OPT_PROT) PrintS("try HC in Zp ring\n");
2444  // create Zp_ring
2445  ring save_ring=currRing;
2446  ring Zp_ring=rCopy0(save_ring);
2447  nKillChar(Zp_ring->cf);
2448  Zp_ring->cf=nInitChar(n_Zp, (void*)(long)32003);
2449  rComplete(Zp_ring);
2450  // map data
2451  rChangeCurrRing(Zp_ring);
2452  nMapFunc nMap=n_SetMap(save_ring->cf,Zp_ring->cf);
2453  ideal FF=id_PermIdeal(F,IDELEMS(F),1,NULL,save_ring,Zp_ring,nMap,NULL,0,0);
2454  ideal QQ=NULL;
2455  if (Q!=NULL) QQ=id_PermIdeal(Q,IDELEMS(Q),1,NULL,save_ring,Zp_ring,nMap,NULL,0,0);
2456  // call std
2457  ideal res=kStd(FF,QQ,testHomog,NULL,NULL);
2458  // clean
2459  idDelete(&FF);
2460  if (QQ!=NULL) idDelete(&QQ);
2461  idDelete(&res);
2462  // map back
2463  rChangeCurrRing(save_ring);
2464  poly p=NULL;
2465  if (Zp_ring->ppNoether!=NULL)
2466  {
2467    p=p_PermPoly(Zp_ring->ppNoether,NULL,Zp_ring,save_ring,nMap,NULL,0,0);
2468    Zp_ring->ppNoether=NULL;
2469    if (TEST_OPT_PROT) PrintS("HC found in Zp ring\n");
2470  }
2471  rDelete(Zp_ring);
2472  return p;
2473}
2474
2475ideal kStd(ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
2476          int newIdeal, intvec *vw, s_poly_proc_t sp)
2477{
2478  if(idIs0(F))
2479    return idInit(1,F->rank);
2480
2481  if((Q!=NULL)&&(idIs0(Q))) Q=NULL;
2482#ifdef HAVE_SHIFTBBA
2483  if(rIsLPRing(currRing)) return kStdShift(F, Q, h, w, hilb, syzComp, newIdeal, vw, FALSE);
2484#endif
2485
2486  /* test HC precomputation*/
2487  poly save_noether=currRing->ppNoether;
2488  int ak = id_RankFreeModule(F,currRing);
2489  if((ak==0)
2490  && (h!=isHomog)
2491  && (w==NULL)
2492  && (hilb==NULL)
2493  && (vw==NULL)
2494  && (newIdeal==0)
2495  && (sp==NULL)
2496  && rOrd_is_ds(currRing)
2497  && rField_is_Q (currRing)
2498  && !rIsPluralRing(currRing))
2499    currRing->ppNoether=kTryHC(F,Q);
2500
2501  ideal r;
2502  BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2503  BOOLEAN delete_w=(w==NULL);
2504  kStrategy strat=new skStrategy;
2505
2506  strat->s_poly=sp;
2507  if(!TEST_OPT_RETURN_SB)
2508    strat->syzComp = syzComp;
2509  if (TEST_OPT_SB_1
2510    &&(!rField_is_Ring(currRing))
2511    )
2512    strat->newIdeal = newIdeal;
2513  if (rField_has_simple_inverse(currRing))
2514    strat->LazyPass=20;
2515  else
2516    strat->LazyPass=2;
2517  strat->LazyDegree = 1;
2518  strat->ak = ak;
2519  strat->kModW=kModW=NULL;
2520  strat->kHomW=kHomW=NULL;
2521  if (vw != NULL)
2522  {
2523    currRing->pLexOrder=FALSE;
2524    strat->kHomW=kHomW=vw;
2525    strat->pOrigFDeg = currRing->pFDeg;
2526    strat->pOrigLDeg = currRing->pLDeg;
2527    pSetDegProcs(currRing,kHomModDeg);
2528    toReset = TRUE;
2529  }
2530  if (h==testHomog)
2531  {
2532    if (strat->ak == 0)
2533    {
2534      h = (tHomog)idHomIdeal(F,Q);
2535      w=NULL;
2536    }
2537    else if (!TEST_OPT_DEGBOUND)
2538    {
2539      if (w!=NULL)
2540        h = (tHomog)idHomModule(F,Q,w);
2541      else
2542        h = (tHomog)idHomIdeal(F,Q);
2543    }
2544  }
2545  currRing->pLexOrder=b;
2546  if (h==isHomog)
2547  {
2548    if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2549    {
2550      strat->kModW = kModW = *w;
2551      if (vw == NULL)
2552      {
2553        strat->pOrigFDeg = currRing->pFDeg;
2554        strat->pOrigLDeg = currRing->pLDeg;
2555        pSetDegProcs(currRing,kModDeg);
2556        toReset = TRUE;
2557      }
2558    }
2559    currRing->pLexOrder = TRUE;
2560    if (hilb==NULL) strat->LazyPass*=2;
2561  }
2562  strat->homog=h;
2563#ifdef KDEBUG
2564  idTest(F);
2565  if (Q!=NULL) idTest(Q);
2566#endif
2567#ifdef HAVE_PLURAL
2568  if (rIsPluralRing(currRing))
2569  {
2570    const BOOLEAN bIsSCA  = rIsSCA(currRing) && strat->z2homog; // for Z_2 prod-crit
2571    strat->no_prod_crit   = ! bIsSCA;
2572    if (w!=NULL)
2573      r = nc_GB(F, Q, *w, hilb, strat, currRing);
2574    else
2575      r = nc_GB(F, Q, NULL, hilb, strat, currRing);
2576  }
2577  else
2578#endif
2579  {
2580    #if PRE_INTEGER_CHECK
2581    //the preinteger check strategy is not for modules
2582    if(nCoeff_is_Z(currRing->cf) && strat->ak <= 0)
2583    {
2584      ideal FCopy = idCopy(F);
2585      poly pFmon = preIntegerCheck(FCopy, Q);
2586      if(pFmon != NULL)
2587      {
2588        idInsertPoly(FCopy, pFmon);
2589        strat->kModW=kModW=NULL;
2590        if (h==testHomog)
2591        {
2592            if (strat->ak == 0)
2593            {
2594              h = (tHomog)idHomIdeal(FCopy,Q);
2595              w=NULL;
2596            }
2597            else if (!TEST_OPT_DEGBOUND)
2598            {
2599              if (w!=NULL)
2600                h = (tHomog)idHomModule(FCopy,Q,w);
2601              else
2602                h = (tHomog)idHomIdeal(FCopy,Q);
2603            }
2604        }
2605        currRing->pLexOrder=b;
2606        if (h==isHomog)
2607        {
2608          if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2609          {
2610            strat->kModW = kModW = *w;
2611            if (vw == NULL)
2612            {
2613              strat->pOrigFDeg = currRing->pFDeg;
2614              strat->pOrigLDeg = currRing->pLDeg;
2615              pSetDegProcs(currRing,kModDeg);
2616              toReset = TRUE;
2617            }
2618          }
2619          currRing->pLexOrder = TRUE;
2620          if (hilb==NULL) strat->LazyPass*=2;
2621        }
2622        strat->homog=h;
2623      }
2624      omTestMemory(1);
2625      if(w == NULL)
2626      {
2627        if(rHasLocalOrMixedOrdering(currRing))
2628            r=mora(FCopy,Q,NULL,hilb,strat);
2629        else
2630            r=bba(FCopy,Q,NULL,hilb,strat);
2631      }
2632      else
2633      {
2634        if(rHasLocalOrMixedOrdering(currRing))
2635            r=mora(FCopy,Q,*w,hilb,strat);
2636        else
2637            r=bba(FCopy,Q,*w,hilb,strat);
2638      }
2639      idDelete(&FCopy);
2640    }
2641    else
2642    #endif
2643    {
2644      if(w==NULL)
2645      {
2646        if(rHasLocalOrMixedOrdering(currRing))
2647          r=mora(F,Q,NULL,hilb,strat);
2648        else
2649          r=bba(F,Q,NULL,hilb,strat);
2650      }
2651      else
2652      {
2653        if(rHasLocalOrMixedOrdering(currRing))
2654          r=mora(F,Q,*w,hilb,strat);
2655        else
2656          r=bba(F,Q,*w,hilb,strat);
2657      }
2658    }
2659  }
2660#ifdef KDEBUG
2661  idTest(r);
2662#endif
2663  if (toReset)
2664  {
2665    kModW = NULL;
2666    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2667  }
2668  currRing->pLexOrder = b;
2669//Print("%d reductions canceled \n",strat->cel);
2670  delete(strat);
2671  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
2672  currRing->ppNoether=save_noether;
2673  return r;
2674}
2675
2676ideal kSba(ideal F, ideal Q, tHomog h,intvec ** w, int sbaOrder, int arri, intvec *hilb,int syzComp,
2677          int newIdeal, intvec *vw)
2678{
2679  if(idIs0(F))
2680    return idInit(1,F->rank);
2681  if(!rField_is_Ring(currRing))
2682  {
2683    ideal r;
2684    BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2685    BOOLEAN delete_w=(w==NULL);
2686    kStrategy strat=new skStrategy;
2687    strat->sbaOrder = sbaOrder;
2688    if (arri!=0)
2689    {
2690      strat->rewCrit1 = arriRewDummy;
2691      strat->rewCrit2 = arriRewCriterion;
2692      strat->rewCrit3 = arriRewCriterionPre;
2693    }
2694    else
2695    {
2696      strat->rewCrit1 = faugereRewCriterion;
2697      strat->rewCrit2 = faugereRewCriterion;
2698      strat->rewCrit3 = faugereRewCriterion;
2699    }
2700
2701    if(!TEST_OPT_RETURN_SB)
2702      strat->syzComp = syzComp;
2703    if (TEST_OPT_SB_1)
2704      //if(!rField_is_Ring(currRing)) // always true here
2705        strat->newIdeal = newIdeal;
2706    if (rField_has_simple_inverse(currRing))
2707      strat->LazyPass=20;
2708    else
2709      strat->LazyPass=2;
2710    strat->LazyDegree = 1;
2711    strat->enterOnePair=enterOnePairNormal;
2712    strat->chainCrit=chainCritNormal;
2713    if (TEST_OPT_SB_1) strat->chainCrit=chainCritOpt_1;
2714    strat->ak = id_RankFreeModule(F,currRing);
2715    strat->kModW=kModW=NULL;
2716    strat->kHomW=kHomW=NULL;
2717    if (vw != NULL)
2718    {
2719      currRing->pLexOrder=FALSE;
2720      strat->kHomW=kHomW=vw;
2721      strat->pOrigFDeg = currRing->pFDeg;
2722      strat->pOrigLDeg = currRing->pLDeg;
2723      pSetDegProcs(currRing,kHomModDeg);
2724      toReset = TRUE;
2725    }
2726    if (h==testHomog)
2727    {
2728      if (strat->ak == 0)
2729      {
2730        h = (tHomog)idHomIdeal(F,Q);
2731        w=NULL;
2732      }
2733      else if (!TEST_OPT_DEGBOUND)
2734      {
2735        if (w!=NULL)
2736          h = (tHomog)idHomModule(F,Q,w);
2737        else
2738          h = (tHomog)idHomIdeal(F,Q);
2739      }
2740    }
2741    currRing->pLexOrder=b;
2742    if (h==isHomog)
2743    {
2744      if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2745      {
2746        strat->kModW = kModW = *w;
2747        if (vw == NULL)
2748        {
2749          strat->pOrigFDeg = currRing->pFDeg;
2750          strat->pOrigLDeg = currRing->pLDeg;
2751          pSetDegProcs(currRing,kModDeg);
2752          toReset = TRUE;
2753        }
2754      }
2755      currRing->pLexOrder = TRUE;
2756      if (hilb==NULL) strat->LazyPass*=2;
2757    }
2758    strat->homog=h;
2759  #ifdef KDEBUG
2760    idTest(F);
2761    if(Q != NULL)
2762      idTest(Q);
2763  #endif
2764  #ifdef HAVE_PLURAL
2765    if (rIsPluralRing(currRing))
2766    {
2767      const BOOLEAN bIsSCA  = rIsSCA(currRing) && strat->z2homog; // for Z_2 prod-crit
2768      strat->no_prod_crit   = ! bIsSCA;
2769      if (w!=NULL)
2770        r = nc_GB(F, Q, *w, hilb, strat, currRing);
2771      else
2772        r = nc_GB(F, Q, NULL, hilb, strat, currRing);
2773    }
2774    else
2775  #endif
2776    {
2777      if (rHasLocalOrMixedOrdering(currRing))
2778      {
2779        if (w!=NULL)
2780          r=mora(F,Q,*w,hilb,strat);
2781        else
2782          r=mora(F,Q,NULL,hilb,strat);
2783      }
2784      else
2785      {
2786        strat->sigdrop = FALSE;
2787        if (w!=NULL)
2788          r=sba(F,Q,*w,hilb,strat);
2789        else
2790          r=sba(F,Q,NULL,hilb,strat);
2791      }
2792    }
2793  #ifdef KDEBUG
2794    idTest(r);
2795  #endif
2796    if (toReset)
2797    {
2798      kModW = NULL;
2799      pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2800    }
2801    currRing->pLexOrder = b;
2802  //Print("%d reductions canceled \n",strat->cel);
2803    //delete(strat);
2804    if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
2805    return r;
2806  }
2807  else
2808  {
2809    //--------------------------RING CASE-------------------------
2810    assume(sbaOrder == 1);
2811    assume(arri == 0);
2812    ideal r;
2813    r = idCopy(F);
2814    int sbaEnterS = -1;
2815    bool sigdrop = TRUE;
2816    //This is how we set the SBA algorithm;
2817    int totalsbaruns = 1,blockedreductions = 20,blockred = 0,loops = 0;
2818    while(sigdrop && (loops < totalsbaruns || totalsbaruns == -1)
2819                  && (blockred <= blockedreductions))
2820    {
2821      loops++;
2822      if(loops == 1)
2823        sigdrop = FALSE;
2824      BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2825      BOOLEAN delete_w=(w==NULL);
2826      kStrategy strat=new skStrategy;
2827      strat->sbaEnterS = sbaEnterS;
2828      strat->sigdrop = sigdrop;
2829      #if 0
2830      strat->blockred = blockred;
2831      #else
2832      strat->blockred = 0;
2833      #endif
2834      strat->blockredmax = blockedreductions;
2835      //printf("\nsbaEnterS beginning = %i\n",strat->sbaEnterS);
2836      //printf("\nsigdrop beginning = %i\n",strat->sigdrop);
2837      strat->sbaOrder = sbaOrder;
2838      if (arri!=0)
2839      {
2840        strat->rewCrit1 = arriRewDummy;
2841        strat->rewCrit2 = arriRewCriterion;
2842        strat->rewCrit3 = arriRewCriterionPre;
2843      }
2844      else
2845      {
2846        strat->rewCrit1 = faugereRewCriterion;
2847        strat->rewCrit2 = faugereRewCriterion;
2848        strat->rewCrit3 = faugereRewCriterion;
2849      }
2850
2851      if(!TEST_OPT_RETURN_SB)
2852        strat->syzComp = syzComp;
2853      if (TEST_OPT_SB_1)
2854        if(!rField_is_Ring(currRing))
2855          strat->newIdeal = newIdeal;
2856      if (rField_has_simple_inverse(currRing))
2857        strat->LazyPass=20;
2858      else
2859        strat->LazyPass=2;
2860      strat->LazyDegree = 1;
2861      strat->enterOnePair=enterOnePairNormal;
2862      strat->chainCrit=chainCritNormal;
2863      if (TEST_OPT_SB_1) strat->chainCrit=chainCritOpt_1;
2864      strat->ak = id_RankFreeModule(F,currRing);
2865      strat->kModW=kModW=NULL;
2866      strat->kHomW=kHomW=NULL;
2867      if (vw != NULL)
2868      {
2869        currRing->pLexOrder=FALSE;
2870        strat->kHomW=kHomW=vw;
2871        strat->pOrigFDeg = currRing->pFDeg;
2872        strat->pOrigLDeg = currRing->pLDeg;
2873        pSetDegProcs(currRing,kHomModDeg);
2874        toReset = TRUE;
2875      }
2876      if (h==testHomog)
2877      {
2878        if (strat->ak == 0)
2879        {
2880          h = (tHomog)idHomIdeal(F,Q);
2881          w=NULL;
2882        }
2883        else if (!TEST_OPT_DEGBOUND)
2884        {
2885          if (w!=NULL)
2886            h = (tHomog)idHomModule(F,Q,w);
2887          else
2888            h = (tHomog)idHomIdeal(F,Q);
2889        }
2890      }
2891      currRing->pLexOrder=b;
2892      if (h==isHomog)
2893      {
2894        if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
2895        {
2896          strat->kModW = kModW = *w;
2897          if (vw == NULL)
2898          {
2899            strat->pOrigFDeg = currRing->pFDeg;
2900            strat->pOrigLDeg = currRing->pLDeg;
2901            pSetDegProcs(currRing,kModDeg);
2902            toReset = TRUE;
2903          }
2904        }
2905        currRing->pLexOrder = TRUE;
2906        if (hilb==NULL) strat->LazyPass*=2;
2907      }
2908      strat->homog=h;
2909    #ifdef KDEBUG
2910      idTest(F);
2911      if(Q != NULL)
2912        idTest(Q);
2913    #endif
2914    #ifdef HAVE_PLURAL
2915      if (rIsPluralRing(currRing))
2916      {
2917        const BOOLEAN bIsSCA  = rIsSCA(currRing) && strat->z2homog; // for Z_2 prod-crit
2918        strat->no_prod_crit   = ! bIsSCA;
2919        if (w!=NULL)
2920          r = nc_GB(F, Q, *w, hilb, strat, currRing);
2921        else
2922          r = nc_GB(F, Q, NULL, hilb, strat, currRing);
2923      }
2924      else
2925    #endif
2926      {
2927        if (rHasLocalOrMixedOrdering(currRing))
2928        {
2929          if (w!=NULL)
2930            r=mora(F,Q,*w,hilb,strat);
2931          else
2932            r=mora(F,Q,NULL,hilb,strat);
2933        }
2934        else
2935        {
2936          if (w!=NULL)
2937            r=sba(r,Q,*w,hilb,strat);
2938          else
2939          {
2940            r=sba(r,Q,NULL,hilb,strat);
2941          }
2942        }
2943      }
2944    #ifdef KDEBUG
2945      idTest(r);
2946    #endif
2947      if (toReset)
2948      {
2949        kModW = NULL;
2950        pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
2951      }
2952      currRing->pLexOrder = b;
2953    //Print("%d reductions canceled \n",strat->cel);
2954      sigdrop = strat->sigdrop;
2955      sbaEnterS = strat->sbaEnterS;
2956      blockred = strat->blockred;
2957      delete(strat);
2958      if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
2959    }
2960    // Go to std
2961    if(sigdrop || blockred > blockedreductions)
2962    {
2963      r = kStd(r, Q, h, w, hilb, syzComp, newIdeal, vw);
2964    }
2965    return r;
2966  }
2967}
2968
2969#ifdef HAVE_SHIFTBBA
2970ideal kStdShift(ideal F, ideal Q, tHomog h,intvec ** w, intvec *hilb,int syzComp,
2971                int newIdeal, intvec *vw, BOOLEAN rightGB)
2972{
2973  assume(rIsLPRing(currRing));
2974  assume(idIsInV(F));
2975  ideal r;
2976  BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
2977  BOOLEAN delete_w=(w==NULL);
2978  kStrategy strat=new skStrategy;
2979
2980  strat->rightGB = rightGB;
2981
2982  if(!TEST_OPT_RETURN_SB)
2983    strat->syzComp = syzComp;
2984  if (TEST_OPT_SB_1)
2985    if(!rField_is_Ring(currRing))
2986      strat->newIdeal = newIdeal;
2987  if (rField_has_simple_inverse(currRing))
2988    strat->LazyPass=20;
2989  else
2990    strat->LazyPass=2;
2991  strat->LazyDegree = 1;
2992  strat->ak = id_RankFreeModule(F,currRing);
2993  strat->kModW=kModW=NULL;
2994  strat->kHomW=kHomW=NULL;
2995  if (vw != NULL)
2996  {
2997    currRing->pLexOrder=FALSE;
2998    strat->kHomW=kHomW=vw;
2999    strat->pOrigFDeg = currRing->pFDeg;
3000    strat->pOrigLDeg = currRing->pLDeg;
3001    pSetDegProcs(currRing,kHomModDeg);
3002    toReset = TRUE;
3003  }
3004  if (h==testHomog)
3005  {
3006    if (strat->ak == 0)
3007    {
3008      h = (tHomog)idHomIdeal(F,Q);
3009      w=NULL;
3010    }
3011    else if (!TEST_OPT_DEGBOUND)
3012    {
3013      if (w!=NULL)
3014        h = (tHomog)idHomModule(F,Q,w);
3015      else
3016        h = (tHomog)idHomIdeal(F,Q);
3017    }
3018  }
3019  currRing->pLexOrder=b;
3020  if (h==isHomog)
3021  {
3022    if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
3023    {
3024      strat->kModW = kModW = *w;
3025      if (vw == NULL)
3026      {
3027        strat->pOrigFDeg = currRing->pFDeg;
3028        strat->pOrigLDeg = currRing->pLDeg;
3029        pSetDegProcs(currRing,kModDeg);
3030        toReset = TRUE;
3031      }
3032    }
3033    currRing->pLexOrder = TRUE;
3034    if (hilb==NULL) strat->LazyPass*=2;
3035  }
3036  strat->homog=h;
3037#ifdef KDEBUG
3038  idTest(F);
3039#endif
3040  if (rHasLocalOrMixedOrdering(currRing))
3041  {
3042    /* error: no local ord yet with shifts */
3043    WerrorS("No local ordering possible for shift algebra");
3044    return(NULL);
3045  }
3046  else
3047  {
3048    /* global ordering */
3049    if (w!=NULL)
3050      r=bbaShift(F,Q,*w,hilb,strat);
3051    else
3052      r=bbaShift(F,Q,NULL,hilb,strat);
3053  }
3054#ifdef KDEBUG
3055  idTest(r);
3056#endif
3057  if (toReset)
3058  {
3059    kModW = NULL;
3060    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
3061  }
3062  currRing->pLexOrder = b;
3063//Print("%d reductions canceled \n",strat->cel);
3064  delete(strat);
3065  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
3066  assume(idIsInV(r));
3067  return r;
3068}
3069#endif
3070
3071//##############################################################
3072//##############################################################
3073//##############################################################
3074//##############################################################
3075//##############################################################
3076
3077ideal kMin_std(ideal F, ideal Q, tHomog h,intvec ** w, ideal &M, intvec *hilb,
3078              int syzComp, int reduced)
3079{
3080  if(idIs0(F))
3081  {
3082    M=idInit(1,F->rank);
3083    return idInit(1,F->rank);
3084  }
3085  if(rField_is_Ring(currRing))
3086  {
3087    ideal sb;
3088    sb = kStd(F, Q, h, w, hilb);
3089    idSkipZeroes(sb);
3090    if(IDELEMS(sb) <= IDELEMS(F))
3091    {
3092        M = idCopy(sb);
3093        idSkipZeroes(M);
3094        return(sb);
3095    }
3096    else
3097    {
3098        M = idCopy(F);
3099        idSkipZeroes(M);
3100        return(sb);
3101    }
3102  }
3103  ideal r=NULL;
3104  int Kstd1_OldDeg = Kstd1_deg,i;
3105  intvec* temp_w=NULL;
3106  BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
3107  BOOLEAN delete_w=(w==NULL);
3108  BOOLEAN oldDegBound=TEST_OPT_DEGBOUND;
3109  kStrategy strat=new skStrategy;
3110
3111  if(!TEST_OPT_RETURN_SB)
3112     strat->syzComp = syzComp;
3113  if (rField_has_simple_inverse(currRing))
3114    strat->LazyPass=20;
3115  else
3116    strat->LazyPass=2;
3117  strat->LazyDegree = 1;
3118  strat->minim=(reduced % 2)+1;
3119  strat->ak = id_RankFreeModule(F,currRing);
3120  if (delete_w)
3121  {
3122    temp_w=new intvec((strat->ak)+1);
3123    w = &temp_w;
3124  }
3125  if (h==testHomog)
3126  {
3127    if (strat->ak == 0)
3128    {
3129      h = (tHomog)idHomIdeal(F,Q);
3130      w=NULL;
3131    }
3132    else
3133    {
3134      h = (tHomog)idHomModule(F,Q,w);
3135    }
3136  }
3137  if (h==isHomog)
3138  {
3139    if (strat->ak > 0 && (w!=NULL) && (*w!=NULL))
3140    {
3141      kModW = *w;
3142      strat->kModW = *w;
3143      assume(currRing->pFDeg != NULL && currRing->pLDeg != NULL);
3144      strat->pOrigFDeg = currRing->pFDeg;
3145      strat->pOrigLDeg = currRing->pLDeg;
3146      pSetDegProcs(currRing,kModDeg);
3147
3148      toReset = TRUE;
3149      if (reduced>1)
3150      {
3151        Kstd1_OldDeg=Kstd1_deg;
3152        Kstd1_deg = -1;
3153        for (i=IDELEMS(F)-1;i>=0;i--)
3154        {
3155          if ((F->m[i]!=NULL) && (currRing->pFDeg(F->m[i],currRing)>=Kstd1_deg))
3156            Kstd1_deg = currRing->pFDeg(F->m[i],currRing)+1;
3157        }
3158      }
3159    }
3160    currRing->pLexOrder = TRUE;
3161    strat->LazyPass*=2;
3162  }
3163  strat->homog=h;
3164  ideal SB=NULL;
3165  if (rHasLocalOrMixedOrdering(currRing))
3166  {
3167    r=idMinBase(F,&SB); // SB and M via minbase
3168    strat->M=r;
3169    r=SB;
3170  }
3171  else
3172  {
3173    if (w!=NULL)
3174      r=bba(F,Q,*w,hilb,strat);
3175    else
3176      r=bba(F,Q,NULL,hilb,strat);
3177  }
3178#ifdef KDEBUG
3179  {
3180    int i;
3181    for (i=IDELEMS(r)-1; i>=0; i--) pTest(r->m[i]);
3182  }
3183#endif
3184  idSkipZeroes(r);
3185  if (toReset)
3186  {
3187    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
3188    kModW = NULL;
3189  }
3190  currRing->pLexOrder = b;
3191  if ((delete_w)&&(temp_w!=NULL)) delete temp_w;
3192  if ((IDELEMS(r)==1) && (r->m[0]!=NULL) && pIsConstant(r->m[0]) && (strat->ak==0))
3193  {
3194    M=idInit(1,F->rank);
3195    M->m[0]=pOne();
3196    //if (strat->ak!=0) { pSetComp(M->m[0],strat->ak); pSetmComp(M->m[0]); }
3197    if (strat->M!=NULL) idDelete(&strat->M);
3198  }
3199  else if (strat->M==NULL)
3200  {
3201    M=idInit(1,F->rank);
3202    WarnS("no minimal generating set computed");
3203  }
3204  else
3205  {
3206    idSkipZeroes(strat->M);
3207    M=strat->M;
3208  }
3209  delete(strat);
3210  if (reduced>2)
3211  {
3212    Kstd1_deg=Kstd1_OldDeg;
3213    if (!oldDegBound)
3214      si_opt_1 &= ~Sy_bit(OPT_DEGBOUND);
3215  }
3216  else
3217  {
3218    if (IDELEMS(M)>IDELEMS(r))
3219    {
3220      idDelete(&M);
3221      M=idCopy(r);
3222    }
3223  }
3224  return r;
3225}
3226
3227poly kNF(ideal F, ideal Q, poly p,int syzComp, int lazyReduce)
3228{
3229  if (p==NULL)
3230     return NULL;
3231
3232  poly pp = p;
3233
3234#ifdef HAVE_PLURAL
3235  if(rIsSCA(currRing))
3236  {
3237    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
3238    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
3239    pp = p_KillSquares(pp, m_iFirstAltVar, m_iLastAltVar, currRing);
3240
3241    if(Q == currRing->qideal)
3242      Q = SCAQuotient(currRing);
3243  }
3244#endif
3245  if((Q!=NULL) &&(idIs0(Q))) Q=NULL;
3246
3247  if ((idIs0(F))&&(Q==NULL))
3248  {
3249#ifdef HAVE_PLURAL
3250    if(p != pp)
3251      return pp;
3252#endif
3253    return pCopy(p); /*F+Q=0*/
3254  }
3255
3256  kStrategy strat=new skStrategy;
3257  strat->syzComp = syzComp;
3258  strat->ak = si_max(id_RankFreeModule(F,currRing),pMaxComp(p));
3259  poly res;
3260
3261  if (rHasLocalOrMixedOrdering(currRing))
3262  {
3263#ifdef HAVE_SHIFTBBA
3264    if (currRing->isLPring)
3265    {
3266      WerrorS("No local ordering possible for shift algebra");
3267      return(NULL);
3268    }
3269#endif
3270    res=kNF1(F,Q,pp,strat,lazyReduce);
3271  }
3272  else
3273    res=kNF2(F,Q,pp,strat,lazyReduce);
3274  delete(strat);
3275
3276#ifdef HAVE_PLURAL
3277  if(pp != p)
3278    p_Delete(&pp, currRing);
3279#endif
3280  return res;
3281}
3282
3283poly kNFBound(ideal F, ideal Q, poly p,int bound,int syzComp, int lazyReduce)
3284{
3285  if (p==NULL)
3286     return NULL;
3287
3288  poly pp = p;
3289
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 = p_KillSquares(pp, m_iFirstAltVar, m_iLastAltVar, currRing);
3296
3297    if(Q == currRing->qideal)
3298      Q = SCAQuotient(currRing);
3299  }
3300#endif
3301
3302  if ((idIs0(F))&&(Q==NULL))
3303  {
3304#ifdef HAVE_PLURAL
3305    if(p != pp)
3306      return pp;
3307#endif
3308    return pCopy(p); /*F+Q=0*/
3309  }
3310
3311  kStrategy strat=new skStrategy;
3312  strat->syzComp = syzComp;
3313  strat->ak = si_max(id_RankFreeModule(F,currRing),pMaxComp(p));
3314  poly res;
3315  res=kNF2Bound(F,Q,pp,bound,strat,lazyReduce);
3316  delete(strat);
3317
3318#ifdef HAVE_PLURAL
3319  if(pp != p)
3320    p_Delete(&pp, currRing);
3321#endif
3322  return res;
3323}
3324
3325ideal kNF(ideal F, ideal Q, ideal p,int syzComp,int lazyReduce)
3326{
3327  ideal res;
3328  if (TEST_OPT_PROT)
3329  {
3330    Print("(S:%d)",IDELEMS(p));mflush();
3331  }
3332  if (idIs0(p))
3333    return idInit(IDELEMS(p),si_max(p->rank,F->rank));
3334
3335  ideal pp = p;
3336#ifdef HAVE_PLURAL
3337  if(rIsSCA(currRing))
3338  {
3339    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
3340    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
3341    pp = id_KillSquares(pp, m_iFirstAltVar, m_iLastAltVar, currRing, false);
3342
3343    if(Q == currRing->qideal)
3344      Q = SCAQuotient(currRing);
3345  }
3346#endif
3347
3348  if ((Q!=NULL)&&(idIs0(Q))) Q=NULL;
3349
3350  if ((idIs0(F))&&(Q==NULL))
3351  {
3352#ifdef HAVE_PLURAL
3353    if(p != pp)
3354      return pp;
3355#endif
3356    return idCopy(p); /*F+Q=0*/
3357  }
3358
3359  kStrategy strat=new skStrategy;
3360  strat->syzComp = syzComp;
3361  strat->ak = si_max(id_RankFreeModule(F,currRing),id_RankFreeModule(p,currRing));
3362  if (strat->ak>0) // only for module case, see Tst/Short/bug_reduce.tst
3363  {
3364    strat->ak = si_max(strat->ak,(int)F->rank);
3365  }
3366
3367  if (rHasLocalOrMixedOrdering(currRing))
3368  {
3369#ifdef HAVE_SHIFTBBA
3370    if (currRing->isLPring)
3371    {
3372      WerrorS("No local ordering possible for shift algebra");
3373      return(NULL);
3374    }
3375#endif
3376    res=kNF1(F,Q,pp,strat,lazyReduce);
3377  }
3378  else
3379    res=kNF2(F,Q,pp,strat,lazyReduce);
3380  delete(strat);
3381
3382#ifdef HAVE_PLURAL
3383  if(pp != p)
3384    id_Delete(&pp, currRing);
3385#endif
3386
3387  return res;
3388}
3389
3390ideal kNFBound(ideal F, ideal Q, ideal p,int bound,int syzComp,int lazyReduce)
3391{
3392  ideal res;
3393  if (TEST_OPT_PROT)
3394  {
3395    Print("(S:%d)",IDELEMS(p));mflush();
3396  }
3397  if (idIs0(p))
3398    return idInit(IDELEMS(p),si_max(p->rank,F->rank));
3399
3400  ideal pp = p;
3401#ifdef HAVE_PLURAL
3402  if(rIsSCA(currRing))
3403  {
3404    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
3405    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
3406    pp = id_KillSquares(pp, m_iFirstAltVar, m_iLastAltVar, currRing, false);
3407
3408    if(Q == currRing->qideal)
3409      Q = SCAQuotient(currRing);
3410  }
3411#endif
3412
3413  if ((idIs0(F))&&(Q==NULL))
3414  {
3415#ifdef HAVE_PLURAL
3416    if(p != pp)
3417      return pp;
3418#endif
3419    return idCopy(p); /*F+Q=0*/
3420  }
3421
3422  kStrategy strat=new skStrategy;
3423  strat->syzComp = syzComp;
3424  strat->ak = si_max(id_RankFreeModule(F,currRing),id_RankFreeModule(p,currRing));
3425  if (strat->ak>0) // only for module case, see Tst/Short/bug_reduce.tst
3426  {
3427    strat->ak = si_max(strat->ak,(int)F->rank);
3428  }
3429
3430  res=kNF2Bound(F,Q,pp,bound,strat,lazyReduce);
3431  delete(strat);
3432
3433#ifdef HAVE_PLURAL
3434  if(pp != p)
3435    id_Delete(&pp, currRing);
3436#endif
3437
3438  return res;
3439}
3440
3441poly k_NF (ideal F, ideal Q, poly p,int syzComp, int lazyReduce, const ring _currRing)
3442{
3443  const ring save = currRing;
3444  if( currRing != _currRing ) rChangeCurrRing(_currRing);
3445  poly ret = kNF(F, Q, p, syzComp, lazyReduce);
3446  if( currRing != save )     rChangeCurrRing(save);
3447  return ret;
3448}
3449
3450/*2
3451*interreduces F
3452*/
3453// old version
3454ideal kInterRedOld (ideal F,const ideal Q)
3455{
3456  int j;
3457  kStrategy strat = new skStrategy;
3458
3459  ideal tempF = F;
3460  ideal tempQ = Q;
3461
3462#ifdef HAVE_PLURAL
3463  if(rIsSCA(currRing))
3464  {
3465    const unsigned int m_iFirstAltVar = scaFirstAltVar(currRing);
3466    const unsigned int m_iLastAltVar  = scaLastAltVar(currRing);
3467    tempF = id_KillSquares(F, m_iFirstAltVar, m_iLastAltVar, currRing);
3468
3469    // this should be done on the upper level!!! :
3470    //    tempQ = SCAQuotient(currRing);
3471
3472    if(Q == currRing->qideal)
3473      tempQ = SCAQuotient(currRing);
3474  }
3475#endif
3476
3477//  if (TEST_OPT_PROT)
3478//  {
3479//    writeTime("start InterRed:");
3480//    mflush();
3481//  }
3482  //strat->syzComp     = 0;
3483  strat->kAllAxis = (currRing->ppNoether) != NULL;
3484  strat->kNoether=pCopy((currRing->ppNoether));
3485  strat->ak = id_RankFreeModule(tempF,currRing);
3486  initBuchMoraCrit(strat);
3487  strat->NotUsedAxis = (BOOLEAN *)omAlloc(((currRing->N)+1)*sizeof(BOOLEAN));
3488  for (j=(currRing->N); j>0; j--) strat->NotUsedAxis[j] = TRUE;
3489  strat->enterS      = enterSBba;
3490  strat->posInT      = posInT17;
3491  strat->initEcart   = initEcartNormal;
3492  strat->sl   = -1;
3493  strat->tl          = -1;
3494  strat->tmax        = setmaxT;
3495  strat->T           = initT();
3496  strat->R           = initR();
3497  strat->sevT        = initsevT();
3498  if (rHasLocalOrMixedOrdering(currRing))   strat->honey = TRUE;
3499  initS(tempF, tempQ, strat);
3500  if (TEST_OPT_REDSB)
3501    strat->noTailReduction=FALSE;
3502  updateS(TRUE,strat);
3503  if (TEST_OPT_REDSB && TEST_OPT_INTSTRATEGY)
3504    completeReduce(strat);
3505  //else if (TEST_OPT_PROT) PrintLn();
3506  cleanT(strat);
3507  if (strat->kNoether!=NULL) pLmFree(&strat->kNoether);
3508  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
3509  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
3510  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
3511  omFreeSize((ADDRESS)strat->NotUsedAxis,((currRing->N)+1)*sizeof(BOOLEAN));
3512  omfree(strat->sevT);
3513  omfree(strat->S_2_R);
3514  omfree(strat->R);
3515
3516  if (strat->fromQ)
3517  {
3518    for (j=IDELEMS(strat->Shdl)-1;j>=0;j--)
3519    {
3520      if(strat->fromQ[j]) pDelete(&strat->Shdl->m[j]);
3521    }
3522    omFreeSize((ADDRESS)strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
3523  }
3524//  if (TEST_OPT_PROT)
3525//  {
3526//    writeTime("end Interred:");
3527//    mflush();
3528//  }
3529  ideal shdl=strat->Shdl;
3530  idSkipZeroes(shdl);
3531  if (strat->fromQ)
3532  {
3533    omfree(strat->fromQ);
3534    strat->fromQ=NULL;
3535    ideal res=kInterRed(shdl,NULL);
3536    idDelete(&shdl);
3537    shdl=res;
3538  }
3539  delete(strat);
3540#ifdef HAVE_PLURAL
3541  if( tempF != F )
3542    id_Delete( &tempF, currRing);
3543#endif
3544  return shdl;
3545}
3546// new version
3547ideal kInterRedBba (ideal F, ideal Q, int &need_retry)
3548{
3549  need_retry=0;
3550  int   red_result = 1;
3551  int   olddeg,reduc;
3552  BOOLEAN withT = FALSE;
3553  // BOOLEAN toReset=FALSE;
3554  kStrategy strat=new skStrategy;
3555  tHomog h;
3556
3557  if (rField_has_simple_inverse(currRing))
3558    strat->LazyPass=20;
3559  else
3560    strat->LazyPass=2;
3561  strat->LazyDegree = 1;
3562  strat->ak = id_RankFreeModule(F,currRing);
3563  strat->syzComp = strat->ak;
3564  strat->kModW=kModW=NULL;
3565  strat->kHomW=kHomW=NULL;
3566  if (strat->ak == 0)
3567  {
3568    h = (tHomog)idHomIdeal(F,Q);
3569  }
3570  else if (!TEST_OPT_DEGBOUND)
3571  {
3572    h = (tHomog)idHomIdeal(F,Q);
3573  }
3574  else
3575    h = isNotHomog;
3576  if (h==isHomog)
3577  {
3578    strat->LazyPass*=2;
3579  }
3580  strat->homog=h;
3581#ifdef KDEBUG
3582  idTest(F);
3583#endif
3584
3585  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
3586  if(rField_is_Ring(currRing))
3587    initBuchMoraPosRing(strat);
3588  else
3589    initBuchMoraPos(strat);
3590  initBba(strat);
3591  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
3592  strat->posInL=posInL0; /* ord according pComp */
3593
3594  /*Shdl=*/initBuchMora(F, Q, strat);
3595  reduc = olddeg = 0;
3596
3597#ifndef NO_BUCKETS
3598  if (!TEST_OPT_NOT_BUCKETS)
3599    strat->use_buckets = 1;
3600#endif
3601
3602  // redtailBBa against T for inhomogeneous input
3603  if (!TEST_OPT_OLDSTD)
3604    withT = ! strat->homog;
3605
3606  // strat->posInT = posInT_pLength;
3607  kTest_TS(strat);
3608
3609#ifdef HAVE_TAIL_RING
3610  kStratInitChangeTailRing(strat);
3611#endif
3612
3613  /* compute------------------------------------------------------- */
3614  while (strat->Ll >= 0)
3615  {
3616    #ifdef KDEBUG
3617      if (TEST_OPT_DEBUG) messageSets(strat);
3618    #endif
3619    if (strat->Ll== 0) strat->interpt=TRUE;
3620    /* picks the last element from the lazyset L */
3621    strat->P = strat->L[strat->Ll];
3622    strat->Ll--;
3623
3624    if (strat->P.p1 == NULL)
3625    {
3626      // for input polys, prepare reduction
3627      strat->P.PrepareRed(strat->use_buckets);
3628    }
3629
3630    if (strat->P.p == NULL && strat->P.t_p == NULL)
3631    {
3632      red_result = 0;
3633    }
3634    else
3635    {
3636      if (TEST_OPT_PROT)
3637        message(strat->P.pFDeg(),
3638                &olddeg,&reduc,strat, red_result);
3639
3640      /* reduction of the element chosen from L */
3641      red_result = strat->red(&strat->P,strat);
3642    }
3643
3644    // reduction to non-zero new poly
3645    if (red_result == 1)
3646    {
3647      /* statistic */
3648      if (TEST_OPT_PROT) PrintS("s");
3649
3650      // get the polynomial (canonicalize bucket, make sure P.p is set)
3651      strat->P.GetP(strat->lmBin);
3652
3653      int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
3654
3655      // reduce the tail and normalize poly
3656      // in the ring case we cannot expect LC(f) = 1,
3657      // therefore we call pCleardenom instead of pNorm
3658      if (TEST_OPT_INTSTRATEGY)
3659      {
3660        strat->P.pCleardenom();
3661        if (0)
3662        //if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
3663        {
3664          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
3665          strat->P.pCleardenom();
3666        }
3667      }
3668      else
3669      {
3670        strat->P.pNorm();
3671        if (0)
3672        //if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
3673          strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
3674      }
3675
3676#ifdef KDEBUG
3677      if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
3678#endif
3679
3680      // enter into S, L, and T
3681      if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
3682      {
3683        enterT(strat->P, strat);
3684        // posInS only depends on the leading term
3685        strat->enterS(strat->P, pos, strat, strat->tl);
3686
3687        if (pos<strat->sl)
3688        {
3689          need_retry++;
3690          // move all "larger" elements fromS to L
3691          // remove them from T
3692          int ii=pos+1;
3693          for(;ii<=strat->sl;ii++)
3694          {
3695            LObject h;
3696            h.Clear();
3697            h.tailRing=strat->tailRing;
3698            h.p=strat->S[ii]; strat->S[ii]=NULL;
3699            strat->initEcart(&h);
3700            h.sev=strat->sevS[ii];
3701            int jj=strat->tl;
3702            while (jj>=0)
3703            {
3704              if (strat->T[jj].p==h.p)
3705              {
3706                strat->T[jj].p=NULL;
3707                if (jj<strat->tl)
3708                {
3709                  memmove(&(strat->T[jj]),&(strat->T[jj+1]),
3710                          (strat->tl-jj)*sizeof(strat->T[jj]));
3711                  memmove(&(strat->sevT[jj]),&(strat->sevT[jj+1]),
3712                          (strat->tl-jj)*sizeof(strat->sevT[jj]));
3713                }
3714                strat->tl--;
3715                break;
3716              }
3717              jj--;
3718            }
3719            int lpos=strat->posInL(strat->L,strat->Ll,&h,strat);
3720            enterL(&strat->L,&strat->Ll,&strat->Lmax,h,lpos);
3721            #ifdef KDEBUG
3722            if (TEST_OPT_DEBUG)
3723            {
3724              Print("move S[%d] -> L[%d]: ",ii,pos);
3725              p_wrp(h.p,currRing, strat->tailRing);
3726              PrintLn();
3727            }
3728            #endif
3729          }
3730          if (strat->fromQ!=NULL)
3731          {
3732            for(ii=pos+1;ii<=strat->sl;ii++) strat->fromQ[ii]=0;
3733          }
3734          strat->sl=pos;
3735        }
3736      }
3737      else
3738      {
3739        // clean P
3740      }
3741      kDeleteLcm(&strat->P);
3742    }
3743
3744#ifdef KDEBUG
3745    if (TEST_OPT_DEBUG)
3746    {
3747      messageSets(strat);
3748    }
3749    strat->P.Clear();
3750#endif
3751    //kTest_TS(strat);: i_r out of sync in kInterRedBba, but not used!
3752  }
3753#ifdef KDEBUG
3754  //if (TEST_OPT_DEBUG) messageSets(strat);
3755#endif
3756  /* complete reduction of the standard basis--------- */
3757
3758  if((need_retry<=0) && (TEST_OPT_REDSB))
3759  {
3760    completeReduce(strat);
3761    if (strat->completeReduce_retry)
3762    {
3763      // completeReduce needed larger exponents, retry
3764      // hopefully: kStratChangeTailRing already provided a larger tailRing
3765      //    (otherwise: it will fail again)
3766      strat->completeReduce_retry=FALSE;
3767      completeReduce(strat);
3768      if (strat->completeReduce_retry)
3769      {
3770#ifdef HAVE_TAIL_RING
3771        if(currRing->bitmask>strat->tailRing->bitmask)
3772        {
3773          // retry without T
3774          strat->completeReduce_retry=FALSE;
3775          cleanT(strat);strat->tailRing=currRing;
3776          int i;
3777          for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
3778          completeReduce(strat);
3779        }
3780        if (strat->completeReduce_retry)
3781#endif
3782          Werror("exponent bound is %ld",currRing->bitmask);
3783      }
3784    }
3785  }
3786  else if (TEST_OPT_PROT) PrintLn();
3787
3788
3789  /* release temp data-------------------------------- */
3790  exitBuchMora(strat);
3791//  if (TEST_OPT_WEIGHTM)
3792//  {
3793//    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
3794//    if (ecartWeights)
3795//    {
3796//      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
3797//      ecartWeights=NULL;
3798//    }
3799//  }
3800  //if (TEST_OPT_PROT) messageStat(0/*hilbcount*/,strat);
3801  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
3802  ideal res=strat->Shdl;
3803  strat->Shdl=NULL;
3804  delete strat;
3805  return res;
3806}
3807ideal kInterRed (ideal F,const ideal Q)
3808{
3809#ifdef HAVE_PLURAL
3810  if(rIsPluralRing(currRing)) return kInterRedOld(F,Q);
3811#endif
3812  if ((rHasLocalOrMixedOrdering(currRing))|| (rField_is_numeric(currRing))
3813  ||(rField_is_Ring(currRing))
3814  )
3815    return kInterRedOld(F,Q);
3816
3817    //return kInterRedOld(F,Q);
3818
3819  BITSET save1;
3820  SI_SAVE_OPT1(save1);
3821  //si_opt_1|=Sy_bit(OPT_NOT_SUGAR);
3822  si_opt_1|=Sy_bit(OPT_REDTHROUGH);
3823  //si_opt_1&= ~Sy_bit(OPT_REDTAIL);
3824  //si_opt_1&= ~Sy_bit(OPT_REDSB);
3825  //extern char * showOption() ;
3826  //Print("%s\n",showOption());
3827
3828  int need_retry;
3829  int counter=3;
3830  ideal res, res1;
3831  int elems;
3832  ideal null=NULL;
3833  if ((Q==NULL) || (!TEST_OPT_REDSB))
3834  {
3835    elems=idElem(F);
3836    res=kInterRedBba(F,Q,need_retry);
3837  }
3838  else
3839  {
3840    ideal FF=idSimpleAdd(F,Q);
3841    res=kInterRedBba(FF,NULL,need_retry);
3842    idDelete(&FF);
3843    null=idInit(1,1);
3844    if (need_retry)
3845      res1=kNF(null,Q,res,0,KSTD_NF_LAZY | KSTD_NF_NONORM);
3846    else
3847      res1=kNF(null,Q,res);
3848    idDelete(&res);
3849    res=res1;
3850    need_retry=1;
3851  }
3852  if (idElem(res)<=1) need_retry=0;
3853  while (need_retry && (counter>0))
3854  {
3855    #ifdef KDEBUG
3856    if (TEST_OPT_DEBUG) { Print("retry counter %d\n",counter); }
3857    #endif
3858    res1=kInterRedBba(res,Q,need_retry);
3859    int new_elems=idElem(res1);
3860    counter -= (new_elems >= elems);
3861    elems = new_elems;
3862    idDelete(&res);
3863    if (idElem(res1)<=1) need_retry=0;
3864    if ((Q!=NULL) && (TEST_OPT_REDSB))
3865    {
3866      if (need_retry)
3867        res=kNF(null,Q,res1,0,KSTD_NF_LAZY | KSTD_NF_NONORM);
3868      else
3869        res=kNF(null,Q,res1);
3870      idDelete(&res1);
3871    }
3872    else
3873      res = res1;
3874    if (idElem(res)<=1) need_retry=0;
3875  }
3876  if (null!=NULL) idDelete(&null);
3877  SI_RESTORE_OPT1(save1);
3878  idSkipZeroes(res);
3879  return res;
3880}
3881
3882// returns TRUE if mora should use buckets, false otherwise
3883static BOOLEAN kMoraUseBucket(kStrategy strat)
3884{
3885#ifdef MORA_USE_BUCKETS
3886  if (TEST_OPT_NOT_BUCKETS)
3887    return FALSE;
3888  if (strat->red == redFirst)
3889  {
3890#ifdef NO_LDEG
3891    if (strat->syzComp==0)
3892      return TRUE;
3893#else
3894    if ((strat->homog || strat->honey) && (strat->syzComp==0))
3895      return TRUE;
3896#endif
3897  }
3898  else
3899  {
3900    #ifdef HAVE_RINGS
3901    assume(strat->red == redEcart || strat->red == redRiloc || strat->red == redRiloc_Z);
3902    #else
3903    assume(strat->red == redEcart);
3904    #endif
3905    if (strat->honey && (strat->syzComp==0))
3906      return TRUE;
3907  }
3908#endif
3909  return FALSE;
3910}
Note: See TracBrowser for help on using the repository browser.