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

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