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