1 /****************************************
2 *  Computer Algebra System SINGULAR     *
3 ****************************************/
4 /*
5 *  ABSTRACT -  Kernel: noncomm. alg. of Buchberger
6 */
7 #define PLURAL_INTERNAL_DECLARATIONS
8 
9 #include "kernel/mod2.h"
10 
11 #ifdef HAVE_PLURAL
12 
13 #include "misc/options.h"
14 #include "misc/intvec.h"
15 
16 #include "polys/weight.h"
17 #include "kernel/polys.h"
18 #include "polys/monomials/ring.h"
19 
20 #include "polys/nc/gb_hack.h"
21 #include "polys/nc/nc.h"
22 #include "polys/nc/sca.h"
23 
24 
25 #include "kernel/ideals.h"
26 #include "kernel/GBEngine/kstd1.h"
27 #include "kernel/GBEngine/khstd.h"
28 //#include "spolys.h"
29 //#include "cntrlc.h"
30 #include "kernel/GBEngine/ratgring.h"
31 #include "kernel/GBEngine/kutil.h"
32 
33 #include "kernel/GBEngine/nc.h"
34 
35 #if 0
36 /*3
37 * reduction of p2 with p1
38 * do not destroy p1 and p2
39 * p1 divides p2 -> for use in NF algorithm
40 */
41 poly gnc_ReduceSpolyNew(const poly p1, poly p2/*,poly spNoether*/, const ring r)
42 {
43   return(nc_ReduceSPoly(p1,p_Copy(p2,r)/*,spNoether*/,r));
44 }
45 #endif
46 
47 /*2
48 *reduces h with elements from T choosing  the first possible
49 * element in t with respect to the given pDivisibleBy
50 */
redGrFirst(LObject * h,kStrategy strat)51 int redGrFirst (LObject* h,kStrategy strat)
52 {
53   int at,reddeg,d,i;
54   int pass = 0;
55   int j = 0;
56 
57   d = currRing->pFDeg((*h).p,currRing)+(*h).ecart;
58   reddeg = strat->LazyDegree+d;
59   loop
60   {
61     if (j > strat->sl)
62     {
63 #ifdef KDEBUG
64       if (TEST_OPT_DEBUG) PrintLn();
65 #endif
66       return 0;
67     }
68 #ifdef KDEBUG
69     if (TEST_OPT_DEBUG) Print("%d",j);
70 #endif
71     if (pDivisibleBy(strat->S[j],(*h).p))
72     {
73 #ifdef KDEBUG
74       if (TEST_OPT_DEBUG) PrintS("+\n");
75 #endif
76       /*
77       * the polynomial to reduce with is;
78       * T[j].p
79       */
80       if (!TEST_OPT_INTSTRATEGY)
81         pNorm(strat->S[j]);
82 #ifdef KDEBUG
83       if (TEST_OPT_DEBUG)
84       {
85         wrp(h->p);
86         PrintS(" with ");
87         wrp(strat->S[j]);
88       }
89 #endif
90       (*h).p = nc_ReduceSpoly(strat->S[j],(*h).p, currRing);
91       //spSpolyRed(strat->T[j].p,(*h).p,strat->kNoether);
92 
93 #ifdef KDEBUG
94       if (TEST_OPT_DEBUG)
95       {
96         PrintS(" to ");
97         wrp(h->p);
98       }
99 #endif
100       if ((*h).p == NULL)
101       {
102         kDeleteLcm(h);
103         return 0;
104       }
105       if (TEST_OPT_INTSTRATEGY)
106       {
107         h->pCleardenom();// also removes Content
108       }
109       /*computes the ecart*/
110       d = currRing->pLDeg((*h).p,&((*h).length),currRing);
111       (*h).FDeg=currRing->pFDeg((*h).p,currRing);
112       (*h).ecart = d-(*h).FDeg; /*pFDeg((*h).p);*/
113       if ((strat->syzComp!=0) && !strat->honey)
114       {
115         if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
116         {
117 #ifdef KDEBUG
118           if (TEST_OPT_DEBUG) PrintS(" > sysComp\n");
119 #endif
120           return 0;
121         }
122       }
123       /*- try to reduce the s-polynomial -*/
124       pass++;
125       /*
126       *test whether the polynomial should go to the lazyset L
127       *-if the degree jumps
128       *-if the number of pre-defined reductions jumps
129       */
130       if ((strat->Ll >= 0)
131       && ((d >= reddeg) || (pass > strat->LazyPass))
132       && !strat->homog)
133       {
134         at = strat->posInL(strat->L,strat->Ll,h,strat);
135         if (at <= strat->Ll)
136         {
137           i=strat->sl+1;
138           do
139           {
140             i--;
141             if (i<0) return 0;
142           } while (!pDivisibleBy(strat->S[i],(*h).p));
143           enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
144 #ifdef KDEBUG
145           if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
146 #endif
147           (*h).p = NULL;
148           return 0;
149         }
150       }
151       if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
152       {
153         reddeg = d+1;
154         Print(".%d",d);mflush();
155       }
156       j = 0;
157 #ifdef KDEBUG
158       if TEST_OPT_DEBUG PrintLn();
159 #endif
160     }
161     else
162     {
163 #ifdef KDEBUG
164       if (TEST_OPT_DEBUG) PrintS("-");
165 #endif
166       j++;
167     }
168   }
169 }
ratGB_divide_out(poly p)170 void ratGB_divide_out(poly p)
171 {
172   /* extracts monomial content from localized expression  */
173   /* searches for an m (monomial in var 1.. real_var_start-1)
174    * such that m divides p and divides p by this m if it exist*/
175   if (p==NULL) return;
176   poly root=p;
177   assume(rIsRatGRing(currRing));
178   poly f=pHead(p);
179   int i;
180   for (i=currRing->real_var_start;i<=currRing->real_var_end;i++)
181   {
182     pSetExp(f,i,0);
183   }
184   loop
185   {
186     pIter(p);
187     if (p==NULL) { pSetm(f); break;}
188     for (i=1;i<=rVar(currRing);i++)
189     {
190       pSetExp(f,i,si_min(pGetExp(f,i),pGetExp(p,i)));
191     }
192   }
193   if (!pIsConstant(f))
194   {
195 #ifdef KDEBUG
196     if (TEST_OPT_DEBUG)
197     {
198       PrintS("divide out:");p_wrp(f,currRing);
199       PrintS(" from ");pWrite(root);
200     }
201 #endif
202     p=root;
203     loop
204     {
205       if (p==NULL) break;
206       for (i=1;i<=rVar(currRing);i++)
207       {
208         pSetExp(p,i,pGetExp(p,i)-pGetExp(f,i));
209       }
210       pSetm(p);
211       pIter(p);
212     }
213   }
214   pDelete(&f);
215 }
216 
217 #ifdef HAVE_RATGRING
218 /*2
219 *reduces h with elements from T choosing  the first possible
220 * element in t with respect to the given pDivisibleBy
221 * for use in ratGB
222 */
redGrRatGB(LObject * h,kStrategy strat)223 int redGrRatGB (LObject* h,kStrategy strat)
224 {
225   int at,reddeg,d,i;
226   int pass = 0;
227   int j = 0;
228   int c_j=-1, c_e=-2;
229   poly c_p=NULL;
230   assume(strat->tailRing==currRing);
231 
232   ratGB_divide_out((*h).p);
233   d = currRing->pFDeg((*h).p,currRing)+(*h).ecart;
234   reddeg = strat->LazyDegree+d;
235   if (!TEST_OPT_INTSTRATEGY)
236   {
237     h->pCleardenom();// also does a pContentRat
238   }
239   loop
240   {
241     if (j > strat->sl)
242     {
243       if (c_j>=0)
244       {
245         /*
246         * the polynomial to reduce with is;
247         * S[c_j]
248         */
249         if (!TEST_OPT_INTSTRATEGY)
250           pNorm(strat->S[c_j]);
251 #ifdef KDEBUG
252     if (TEST_OPT_DEBUG)
253         if (TEST_OPT_DEBUG)
254         {
255           wrp(h->p);
256           Print(" with S[%d]= ",c_j);
257           wrp(strat->S[c_j]);
258         }
259 #endif
260     //poly hh = nc_CreateSpoly(strat->S[c_j],(*h).p, currRing);
261     //        Print("vor nc_rat_ReduceSpolyNew (ce:%d) ",c_e);wrp(h->p);PrintLn();
262     //if(c_e==-1)
263     //  c_p = nc_CreateSpoly(pCopy(strat->S[c_j]),pCopy((*h).p), currRing);
264     //else
265     //          c_p=nc_rat_ReduceSpolyNew(strat->S[c_j],pCopy((*h).p), currRing->real_var_start-1,currRing);
266     //        Print("nach nc_rat_ReduceSpolyNew ");wrp(c_p);PrintLn();
267     //        pDelete(&((*h).p));
268 
269         c_p=nc_rat_ReduceSpolyNew(strat->S[c_j],(*h).p, currRing->real_var_start-1,currRing);
270         (*h).p=c_p;
271         if (!TEST_OPT_INTSTRATEGY)
272         {
273           h->pCleardenom();// also removes Content
274         }
275 
276 #ifdef KDEBUG
277         if (TEST_OPT_DEBUG)
278         {
279           PrintS(" to ");
280           wrp(h->p);
281           PrintLn();
282         }
283 #endif
284         if ((*h).p == NULL)
285         {
286           kDeleteLcm(h);
287           return 0;
288         }
289         ratGB_divide_out((*h).p);
290         d = currRing->pLDeg((*h).p,&((*h).length),currRing);
291         (*h).FDeg=currRing->pFDeg((*h).p,currRing);
292         (*h).ecart = d-(*h).FDeg; /*pFDeg((*h).p);*/
293         /*- try to reduce the s-polynomial again -*/
294         pass++;
295         j=0;
296         c_j=-1; c_e=-2; c_p=NULL;
297       }
298       else
299       { // nothing found
300         return 0;
301       }
302     }
303     // first try usal division
304     if (p_LmDivisibleBy(strat->S[j],(*h).p,currRing))
305     {
306 #ifdef KDEBUG
307       if(TEST_OPT_DEBUG)
308       {
309         p_wrp(h->p,currRing); Print(" divisible by S[%d]=",j);
310         p_wrp(strat->S[j],currRing); PrintS(" e=-1\n");
311       }
312 #endif
313       if ((c_j<0)||(c_e>=0))
314       {
315         c_e=-1; c_j=j;
316       }
317     }
318     else
319     if (p_LmDivisibleByPart(strat->S[j],(*h).p,currRing,
320         currRing->real_var_start,currRing->real_var_end))
321     {
322       int a_e=(p_Totaldegree(strat->S[j],currRing)-currRing->pFDeg(strat->S[j],currRing));
323 #ifdef KDEBUG
324       if(TEST_OPT_DEBUG)
325       {
326         p_wrp(h->p,currRing); Print(" divisibly by S[%d]=",j);
327         p_wrp(strat->S[j],currRing); Print(" e=%d\n",a_e);
328       }
329 #endif
330       if ((c_j<0)||(c_e>a_e))
331       {
332         c_e=a_e; c_j=j;
333         //c_p = nc_CreateSpoly(pCopy(strat->S[c_j]),pCopy((*h).p), currRing);
334       }
335       /*computes the ecart*/
336       if ((strat->syzComp!=0) && !strat->honey)
337       {
338         if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
339         {
340 #ifdef KDEBUG
341           if (TEST_OPT_DEBUG) PrintS(" > sysComp\n");
342 #endif
343           return 0;
344         }
345       }
346     }
347     else
348     {
349 #ifdef KDEBUG
350       if(TEST_OPT_DEBUG)
351       {
352         p_wrp(h->p,currRing); Print(" not divisibly by S[%d]=",j);
353         p_wrp(strat->S[j],currRing); PrintLn();
354       }
355 #endif
356     }
357     j++;
358   }
359 }
360 #endif
361 
362 /*2
363 *  reduction procedure for the homogeneous case
364 *  and the case of a degree-ordering
365 */
366 #if 0
367 // currently unused
368 static int nc_redHomog (LObject* h,kStrategy strat)
369 {
370   if (strat->tl<0)
371   {
372     enterT((*h),strat);
373     return 1;
374   }
375 
376   int j = 0;
377 
378   if (TEST_OPT_DEBUG)
379   {
380     PrintS("red:");
381     wrp(h->p);
382     PrintS(" ");
383   }
384   loop
385   {
386     if (TEST_OPT_DEBUG) Print("%d",j);
387     if (pDivisibleBy(strat->S[j],(*h).p))
388     {
389       if (TEST_OPT_DEBUG)
390       {
391         PrintS("+\nwith ");
392         wrp(strat->S[j]);
393       }
394       /*- compute the s-polynomial -*/
395       (*h).p = nc_ReduceSpoly(strat->S[j],(*h).p,currRing);
396       if ((*h).p == NULL)
397       {
398         if (TEST_OPT_DEBUG) PrintS(" to 0\n");
399         kDeleteLcm(h);
400         return 0;
401       }
402 /*
403 *      else if (strat->syzComp)
404 *      {
405 *        if (pMinComp((*h).p) > strat->syzComp)
406 *        {
407 *          enterT((*h),strat);
408 *          return;
409 *        }
410 *      }
411 */
412       /*- try to reduce the s-polynomial -*/
413       j = 0;
414     }
415     else
416     {
417       if (j >= strat->sl)
418       {
419         enterT((*h),strat);
420         return 1;
421       }
422       j++;
423     }
424   }
425 }
426 #endif
427 
428 #if 0
429 /*2
430 *  reduction procedure for the homogeneous case
431 *  and the case of a degree-ordering
432 */
433 static int nc_redHomog0 (LObject* h,kStrategy strat)
434 {
435   if (strat->tl<0)
436   {
437     enterT((*h),strat);
438     return 0;
439   }
440 
441   int j = 0;
442   int k = 0;
443 
444   if (TEST_OPT_DEBUG)
445   {
446     PrintS("red:");
447     wrp(h->p);
448     PrintS(" ");
449   }
450   loop
451   {
452     if (TEST_OPT_DEBUG) Print("%d",j);
453     if (pDivisibleBy(strat->T[j].p,(*h).p))
454     {
455       if (TEST_OPT_DEBUG)
456       {
457         PrintS("+\nwith ");
458         wrp(strat->S[j]);
459       }
460       /*- compute the s-polynomial -*/
461       (*h).p = nc_ReduceSpoly(strat->T[j].p,(*h).p,strat->kNoether,currRing);
462       if ((*h).p == NULL)
463       {
464         if (TEST_OPT_DEBUG) PrintS(" to 0\n");
465         kDeleteLcm(h);
466         return 0;
467       }
468       else
469       {
470         if (TEST_OPT_INTSTRATEGY)
471         {
472           h->pCleardenom();// also removes Content
473         }
474         if (strat->syzComp!=0)
475         {
476           if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
477           {
478 /*
479 *           (*h).length=pLength0((*h).p);
480 */
481             enterT((*h),strat);
482             return 0;
483           }
484         }
485       }
486       /*- try to reduce the s-polynomial -*/
487       j = 0;
488     }
489     else
490     {
491       if (j >= strat->tl)
492       {
493         if (TEST_OPT_INTSTRATEGY)
494         {
495           h->pCleardenom();// also removes Content
496         }
497 /*
498 *       (*h).length=pLength0((*h).p);
499 */
500         enterT((*h),strat);
501         return 0;
502       }
503       j++;
504     }
505   }
506 }
507 
508 /*2
509 *  reduction procedure for the inhomogeneous case
510 *  and not a degree-ordering
511 */
512 static int nc_redLazy (LObject* h,kStrategy strat)
513 {
514   if (strat->tl<0)
515   {
516     enterT((*h),strat);
517     return 0;
518   }
519 
520   int at,d,i;
521   int j = 0;
522   int pass = 0;
523   int reddeg = currRing->pFDeg((*h).p,currRing);
524 
525   if (TEST_OPT_DEBUG)
526   {
527     PrintS("red:");
528     wrp(h->p);
529     PrintS(" ");
530   }
531   loop
532   {
533     if (TEST_OPT_DEBUG) Print("%d",j);
534     if (pDivisibleBy(strat->S[j],(*h).p))
535     {
536       if (TEST_OPT_DEBUG)
537       {
538         PrintS("+\nwith ");
539         wrp(strat->S[j]);
540       }
541       /*- compute the s-polynomial -*/
542       (*h).p = nc_ReduceSpoly(strat->S[j],(*h).p,strat->kNoether,currRing);
543       if ((*h).p == NULL)
544       {
545         if (TEST_OPT_DEBUG) PrintS(" to 0\n");
546         kDeleteLcm(h);
547         return 0;
548       }
549 //      else if (strat->syzComp)
550 //      {
551 //        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
552 //        {
553 //          if (TEST_OPT_DEBUG) PrintS(" > syzComp\n");
554 //          if (TEST_OPT_INTSTRATEGY) p_Content(h->p,currRing);
555 //          enterTBba((*h),strat->tl+1,strat);
556 //          return;
557 //        }
558 //      }
559       else
560       {
561         if (TEST_OPT_DEBUG)
562         {
563           PrintS("to:");
564           wrp((*h).p);
565           PrintLn();
566         }
567         if (TEST_OPT_INTSTRATEGY)
568         {
569           pCleardenom(h->p);// also removes Content
570         }
571       }
572       /*- try to reduce the s-polynomial -*/
573       pass++;
574       d = currRing->pFDeg((*h).p,currRing);
575       if ((strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
576       {
577         at = posInL11(strat->L,strat->Ll,h,strat);
578         if (at <= strat->Ll)
579         {
580           i=strat->sl+1;
581           do
582           {
583             i--;
584             if (i<0)
585             {
586               enterT((*h),strat);
587               return 0;
588             }
589           }
590           while (!pDivisibleBy(strat->S[i],(*h).p));
591           if (TEST_OPT_DEBUG) Print(" ->L[%d]\n",at);
592           enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
593           (*h).p = NULL;
594           return 0;
595         }
596       }
597       else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d != reddeg))
598       {
599         Print(".%d",d);mflush();
600         reddeg = d;
601       }
602       j = 0;
603     }
604     else
605     {
606       if (TEST_OPT_DEBUG) PrintS("-");
607       if (j >= strat->sl)
608       {
609         if (TEST_OPT_DEBUG) PrintLn();
610         if (TEST_OPT_INTSTRATEGY)
611         {
612           h->pCleardenom();// also removes Content
613         }
614         enterT((*h),strat);
615         return 0;
616       }
617       j++;
618     }
619   }
620 }
621 
622 /*2
623 *  reduction procedure for the sugar-strategy (honey)
624 * reduces h with elements from T choosing first possible
625 * element in T with respect to the given ecart
626 */
627 static int nc_redHoney (LObject*  h,kStrategy strat)
628 {
629   if (strat->tl<0)
630   {
631     enterT((*h),strat);
632     return 0;
633   }
634 
635   poly pi;
636   int i,j,at,reddeg,d,pass,ei;
637 
638   pass = j = 0;
639   d = reddeg = currRing->pFDeg((*h).p,currRing)+(*h).ecart;
640   if (TEST_OPT_DEBUG)
641   {
642     PrintS("red:");
643     wrp((*h).p);
644   }
645   loop
646   {
647     if (TEST_OPT_DEBUG) Print("%d",j);
648     if (pDivisibleBy(strat->T[j].p,(*h).p))
649     {
650       if (TEST_OPT_DEBUG) PrintS("+");
651       pi = strat->T[j].p;
652       ei = strat->T[j].ecart;
653       /*
654       * the polynomial to reduce with (up to the moment) is;
655       * pi with ecart ei
656       */
657       i = j;
658       loop
659       {
660         /*- takes the first possible with respect to ecart -*/
661         i++;
662         if (i > strat->tl)
663           break;
664         if ((!BTEST1(20)) && (ei <= (*h).ecart))
665           break;
666         if (TEST_OPT_DEBUG) Print("%d",i);
667         if ((strat->T[i].ecart < ei) && pDivisibleBy(strat->T[i].p,(*h).p))
668         {
669           if (TEST_OPT_DEBUG) PrintS("+");
670           /*
671           * the polynomial to reduce with is now;
672           */
673           pi = strat->T[i].p;
674           ei = strat->T[i].ecart;
675         }
676         else if (TEST_OPT_DEBUG) PrintS("-");
677       }
678 
679       /*
680       * end of search: have to reduce with pi
681       */
682       if (ei > (*h).ecart)
683       {
684         /*
685         * It is not possible to reduce h with smaller ecart;
686         * if possible h goes to the lazy-set L,i.e
687         * if its position in L would be not the last one
688         */
689         if (strat->Ll >= 0) /* L is not empty */
690         {
691           at = strat->posInL(strat->L,strat->Ll,h,strat);
692           if(at <= strat->Ll)
693           /*- h will not become the next element to reduce -*/
694           {
695             enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
696             if (TEST_OPT_DEBUG) Print(" ecart too big: -> L%d\n",at);
697             (*h).p = NULL;
698             return 0;
699           }
700         }
701       }
702       if (TEST_OPT_DEBUG)
703       {
704         PrintS("\nwith ");
705         wrp(pi);
706       }
707       if (strat->fromT)
708       {
709         strat->fromT=FALSE;
710         (*h).p = nc_ReduceSpoly(pi,(*h).p,strat->kNoether,currRing);
711       }
712       else
713         (*h).p = nc_ReduceSpoly(pi,(*h).p,strat->kNoether,currRing);
714       if (TEST_OPT_DEBUG)
715       {
716         PrintS(" to ");
717         wrp((*h).p);
718         PrintLn();
719       }
720       if ((*h).p == NULL)
721       {
722         kDeleteLcm(h);
723         return 0;
724       }
725       if (TEST_OPT_INTSTRATEGY)
726       {
727         h->pCleardenom();// also does remove Content
728       }
729       /* compute the ecart */
730       if (ei <= (*h).ecart)
731         (*h).ecart = d-currRing->pFDeg((*h).p,currRing);
732       else
733         (*h).ecart = d-currRing->pFDeg((*h).p,currRing)+ei-(*h).ecart;
734 //      if (strat->syzComp)
735 //      {
736 //        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
737 //        {
738 //          if (TEST_OPT_DEBUG)
739 //            PrintS("  >syzComp\n");
740 //          if (TEST_OPT_INTSTRATEGY) p_Content(h->p,currRing);
741 //          at=strat->posInT(strat->T,strat->tl,(*h));
742 //          enterTBba((*h),at,strat);
743 //          return;
744 //        }
745 //      }
746       /*
747       * try to reduce the s-polynomial h
748       *test first whether h should go to the lazyset L
749       *-if the degree jumps
750       *-if the number of pre-defined reductions jumps
751       */
752       pass++;
753       d = currRing->pFDeg((*h).p,currRing)+(*h).ecart;
754       if ((strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
755       {
756         at = strat->posInL(strat->L,strat->Ll,h,strat);
757         if (at <= strat->Ll)
758         {
759           /*test if h is already standardbasis element*/
760           i=strat->sl+1;
761           do
762           {
763             i--;
764             if (i<0)
765             {
766               enterT((*h),strat);
767               return 0;
768             }
769           } while (!pDivisibleBy(strat->S[i],(*h).p));
770           enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
771           if (TEST_OPT_DEBUG)
772             Print(" degree jumped: -> L%d\n",at);
773           (*h).p = NULL;
774           return 0;
775         }
776       }
777       else if (TEST_OPT_PROT && (strat->Ll < 0) && (d > reddeg))
778       {
779         reddeg = d;
780         Print(".%d",d); mflush();
781       }
782       j = 0;
783     }
784     else
785     {
786       if (TEST_OPT_DEBUG) PrintS("-");
787       if (j >= strat->tl)
788       {
789         if (TEST_OPT_DEBUG) PrintLn();
790         if (TEST_OPT_INTSTRATEGY)
791         {
792           h->pCleardenom();// also does remove Content
793         }
794         enterT((*h),strat);
795         return 0;
796       }
797       j++;
798     }
799   }
800 }
801 
802 /*2
803 *  reduction procedure for tests only
804 *  reduces with elements from T and chooses the best possible
805 */
806 static int nc_redBest (LObject*  h,kStrategy strat)
807 {
808   if (strat->tl<0)
809   {
810     enterT((*h),strat);
811     return 0;
812   }
813 
814   int j,jbest,at,reddeg,d,pass;
815   poly     p,ph;
816   pass = j = 0;
817 
818   if (strat->honey)
819     reddeg = currRing->pFDeg((*h).p,currRing)+(*h).ecart;
820   else
821     reddeg = currRing->pFDeg((*h).p,currRing);
822   loop
823   {
824     if (pDivisibleBy(strat->T[j].p,(*h).p))
825     {
826       /* compute the s-polynomial */
827       if (!TEST_OPT_INTSTRATEGY) pNorm((*h).p);
828 #ifdef SDRING
829       // spSpolyShortBba will not work in the SRING case
830       if (pSDRING)
831       {
832         p=spSpolyCreate(strat->T[j].p,(*h).p,strat->kNoether);
833         if (p!=NULL) pDelete(&pNext(p));
834       }
835       else
836 #endif
837       p = nc_CreateShortSpoly(strat->T[j].p,(*h).p);
838       /* computes only the first monomial of the spoly  */
839       if (p)
840       {
841         jbest = j;
842         /* looking for the best possible reduction */
843         if ((strat->syzComp==0) || (pMinComp(p) <= strat->syzComp))
844         {
845           loop
846           {
847             j++;
848             if (j > strat->tl)
849               break;
850             if (pDivisibleBy(strat->T[j].p,(*h).p))
851             {
852 #ifdef SDRING
853               // spSpolyShortBba will not work in the SRING case
854               if (pSDRING)
855               {
856                 ph=spSpolyCreate(strat->T[j].p,(*h).p,strat->kNoether);
857                 if (ph!=NULL) pDelete(&pNext(ph));
858               }
859               else
860 #endif
861               ph = nc_CreateShortSpoly(strat->T[j].p,(*h).p);
862               if (ph==NULL)
863               {
864                 pLmFree(p);
865                 pDelete(&((*h).p));
866                 kDeleteLcm(h);
867                 return 0;
868               }
869               else if (pLmCmp(ph,p) == -1)
870               {
871                 pLmFree(p);
872                 p = ph;
873                 jbest = j;
874               }
875               else
876               {
877                 pLmFree(ph);
878               }
879             }
880           }
881         }
882         pLmFree(p);
883         (*h).p = nc_ReduceSpoly(strat->T[jbest].p,(*h).p,strat->kNoether,currRing);
884       }
885       else
886       {
887         kDeleteLcm(h);
888         return 0;
889       }
890       if (strat->honey && currRing->pLexOrder)
891         strat->initEcart(h);
892       /* h.length:=l; */
893       /* try to reduce the s-polynomial */
894 //      if (strat->syzComp)
895 //      {
896 //        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
897 //        {
898 //          if (TEST_OPT_DEBUG)
899 //            PrintS(" >syzComp\n");
900 //          if (TEST_OPT_INTSTRATEGY) p_Content(h->p,currRing);
901 //          at=strat->posInT(strat->T,strat->tl,(*h));
902 //          enterTBba((*h),at,strat);
903 //          return;
904 //        }
905 //      }
906       if (strat->honey || currRing->pLexOrder)
907       {
908         pass++;
909         d = currRing->pFDeg((*h).p,currRing);
910         if (strat->honey)
911           d += (*h).ecart;
912         if ((strat->Ll >= 0) && ((pass > strat->LazyPass) || (d > reddeg)))
913         {
914           at = strat->posInL(strat->L,strat->Ll,h,strat);
915           if (at <= strat->Ll)
916           {
917             enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
918             (*h).p = NULL;
919             return 0;
920           }
921         }
922         else if (TEST_OPT_PROT && (strat->Ll < 0) && (d != reddeg))
923         {
924           reddeg = d;
925           Print("%d.");
926           mflush();
927         }
928       }
929       j = 0;
930     }
931     else
932     {
933       if (j >= strat->tl)
934       {
935         if (TEST_OPT_INTSTRATEGY)
936         {
937           h->pCleardenom();// also removes Content
938         }
939         enterT((*h),strat);
940         return 0;
941       }
942       j++;
943     }
944   }
945 }
946 
947 #endif
948 
949 #ifdef HAVE_RATGRING
nc_gr_initBba(ideal F,kStrategy strat)950 void nc_gr_initBba(ideal F, kStrategy strat)
951 #else
952 void nc_gr_initBba(ideal, kStrategy strat)
953 #endif
954 {
955   assume(rIsPluralRing(currRing));
956 
957   // int i;
958 //  idhdl h;
959  /* setting global variables ------------------- */
960   strat->enterS = enterSBba;
961 
962 /*
963   if ((BTEST1(20)) && (!strat->honey))
964     strat->red = nc_redBest;
965   else if (strat->honey)
966     strat->red = nc_redHoney;
967   else if (currRing->pLexOrder && !strat->homog)
968     strat->red = nc_redLazy;
969   else if (TEST_OPT_INTSTRATEGY && strat->homog)
970     strat->red = nc_redHomog0;
971   else
972     strat->red = nc_redHomog;
973 */
974 
975 //   if (rIsPluralRing(currRing))
976     strat->red = redGrFirst;
977 #ifdef HAVE_RATGRING
978   if (rIsRatGRing(currRing))
979   {
980     int ii=IDELEMS(F)-1;
981     int jj;
982     BOOLEAN is_rat_id=FALSE;
983     for(;ii>=0;ii--)
984     {
985       for(jj=currRing->real_var_start;jj<=currRing->real_var_end;jj++)
986       {
987         if(pGetExp(F->m[ii],jj)>0) { is_rat_id=TRUE; break; }
988       }
989       if (is_rat_id) break;
990     }
991     if (is_rat_id) strat->red=redGrRatGB;
992   }
993 #endif
994 
995   if (currRing->pLexOrder && strat->honey)
996     strat->initEcart = initEcartNormal;
997   else
998     strat->initEcart = initEcartBBA;
999   if (strat->honey)
1000     strat->initEcartPair = initEcartPairMora;
1001   else
1002     strat->initEcartPair = initEcartPairBba;
1003 //  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1004 //  {
1005 //     //interred  machen   Aenderung
1006 //     pFDegOld=currRing->pFDeg;
1007 //     pLDegOld=currRing->pLDeg;
1008 //  //   h=ggetid("ecart");
1009 //  //   if ((h!=NULL) && (IDTYP(h)==INTVEC_CMD))
1010 //  //   {
1011 //  //     ecartWeights=iv2array(IDINTVEC(h));
1012 //  //   }
1013 //  //   else
1014 //    {
1015 //      ecartWeights=(short *)omAlloc(((currRing->N)+1)*sizeof(short));
1016 //      /*uses automatic computation of the ecartWeights to set them*/
1017 //      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
1018 //    }
1019 //    currRing->pFDeg=totaldegreeWecart;
1020 //    currRing->pLDeg=maxdegreeWecart;
1021 //    for(i=1; i<=(currRing->N); i++)
1022 //      Print(" %d",ecartWeights[i]);
1023 //    PrintLn();
1024 //    mflush();
1025 //  }
1026 }
1027 
1028 #define MYTEST 0
1029 
k_gnc_gr_bba(const ideal F,const ideal Q,const intvec *,const intvec *,kStrategy strat,const ring _currRing)1030 ideal k_gnc_gr_bba(const ideal F, const ideal Q, const intvec *, const intvec *, kStrategy strat, const ring _currRing)
1031 {
1032   const ring save = currRing; if( currRing != _currRing ) rChangeCurrRing(_currRing);
1033 
1034 #if MYTEST
1035    PrintS("<gnc_gr_bba>\n");
1036 #endif
1037 
1038 #ifdef HAVE_PLURAL
1039 #if MYTEST
1040    PrintS("currRing: \n");
1041    rWrite(currRing);
1042 #ifdef RDEBUG
1043    rDebugPrint(currRing);
1044 #endif
1045 
1046    PrintS("F: \n");
1047    idPrint(F);
1048    PrintS("Q: \n");
1049    idPrint(Q);
1050 #endif
1051 #endif
1052 
1053   assume(currRing->OrdSgn != -1); // no mora!!! it terminates only for global ordering!!! (?)
1054 
1055   // intvec *w=NULL;
1056   // intvec *hilb=NULL;
1057   int   olddeg,reduc;
1058   int red_result=1;
1059   int /*hilbeledeg=1,*/hilbcount=0/*,minimcnt=0*/;
1060 
1061   initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1062   // initHilbCrit(F,Q,&hilb,strat);
1063   /* in plural we don't need Hilb yet */
1064   nc_gr_initBba(F,strat);
1065   initBuchMoraPos(strat);
1066   if (rIsRatGRing(currRing))
1067   {
1068     strat->posInL=posInL0; // by pCmp of lcm
1069   }
1070   /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1071   /*Shdl=*/initBuchMora(F, Q,strat);
1072   strat->posInT=posInT110;
1073   reduc = olddeg = 0;
1074 
1075   /* compute------------------------------------------------------- */
1076   while (strat->Ll >= 0)
1077   {
1078     if (TEST_OPT_DEBUG) messageSets(strat);
1079 
1080     if (strat->Ll== 0) strat->interpt=TRUE;
1081     if (TEST_OPT_DEGBOUND
1082     && ((strat->honey
1083     && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
1084        || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
1085     {
1086       /*
1087       *stops computation if
1088       * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1089       *a predefined number Kstd1_deg
1090       */
1091       while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1092       break;
1093     }
1094     /* picks the last element from the lazyset L */
1095     strat->P = strat->L[strat->Ll];
1096     strat->Ll--;
1097     //kTest(strat);
1098 
1099     if (strat->P.p != NULL)
1100     if (pNext(strat->P.p) == strat->tail)
1101     {
1102       /* deletes the short spoly and computes */
1103       pLmFree(strat->P.p);
1104       /* the real one */
1105 //      if (ncRingType(currRing)==nc_lie) /* prod crit */
1106 //        if(pHasNotCF(strat->P.p1,strat->P.p2))
1107 //        {
1108 //          strat->cp++;
1109 //          /* prod.crit itself in nc_CreateSpoly */
1110 //        }
1111 
1112 
1113       if( ! rIsRatGRing(currRing) )
1114       {
1115         strat->P.p = nc_CreateSpoly(strat->P.p1,strat->P.p2,currRing);
1116       }
1117 #ifdef HAVE_RATGRING
1118       else
1119       {
1120         /* rational case */
1121         strat->P.p = nc_rat_CreateSpoly(strat->P.p1,strat->P.p2,currRing->real_var_start-1,currRing);
1122       }
1123 #endif
1124 
1125 
1126 #ifdef PDEBUG
1127       p_Test(strat->P.p, currRing);
1128 #endif
1129 
1130 #if MYTEST
1131       if (TEST_OPT_DEBUG)
1132       {
1133         PrintS("p1: "); pWrite(strat->P.p1);
1134         PrintS("p2: "); pWrite(strat->P.p2);
1135         PrintS("SPoly: "); pWrite(strat->P.p);
1136       }
1137 #endif
1138     }
1139 
1140 
1141     if (strat->P.p != NULL)
1142     {
1143       if (TEST_OPT_PROT)
1144         message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
1145               &olddeg,&reduc,strat, red_result);
1146 
1147 #if MYTEST
1148       if (TEST_OPT_DEBUG)
1149       {
1150         PrintS("p1: "); pWrite(strat->P.p1);
1151         PrintS("p2: "); pWrite(strat->P.p2);
1152         PrintS("SPoly before: "); pWrite(strat->P.p);
1153       }
1154 #endif
1155 
1156       /* reduction of the element chosen from L */
1157       strat->red(&strat->P,strat);
1158 
1159 #if MYTEST
1160       if (TEST_OPT_DEBUG)
1161       {
1162         PrintS("red SPoly: "); pWrite(strat->P.p);
1163       }
1164 #endif
1165     }
1166     if (strat->P.p != NULL)
1167     {
1168       if (TEST_OPT_PROT)
1169       {
1170         PrintS("s\n");
1171       }
1172       /* enter P.p into s and L */
1173       {
1174 /* quick unit detection in the rational case */
1175 #ifdef HAVE_RATGRING
1176         if( rIsRatGRing(currRing) )
1177         {
1178           if ( p_LmIsConstantRat(strat->P.p, currRing) )
1179           {
1180 #ifdef PDEBUG
1181              PrintS("unit element detected:");
1182              p_wrp(strat->P.p,currRing);
1183 #endif
1184             p_Delete(&strat->P.p,currRing, strat->tailRing);
1185             strat->P.p = pOne();
1186           }
1187       }
1188 #endif
1189         strat->P.sev=0;
1190         int pos=posInS(strat,strat->sl,strat->P.p, strat->P.ecart);
1191         {
1192           if (TEST_OPT_INTSTRATEGY)
1193           {
1194             if ((strat->syzComp==0)||(!strat->homog))
1195             {
1196               #ifdef HAVE_RATGRING
1197               if(!rIsRatGRing(currRing))
1198               #endif
1199                 strat->P.p = redtailBba(strat->P.p,pos-1,strat);
1200             }
1201 
1202             strat->P.p=p_Cleardenom(strat->P.p, currRing);
1203           }
1204           else
1205           {
1206             pNorm(strat->P.p);
1207             if ((strat->syzComp==0)||(!strat->homog))
1208             {
1209               strat->P.p = redtailBba(strat->P.p,pos-1,strat);
1210             }
1211           }
1212           if (TEST_OPT_DEBUG)
1213           {
1214             PrintS("new s:"); wrp(strat->P.p);
1215             PrintLn();
1216 #if MYTEST
1217             PrintS("s: "); pWrite(strat->P.p);
1218 #endif
1219 
1220           }
1221           // kTest(strat);
1222           //
1223           enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat);
1224 
1225           if (strat->sl==-1) pos=0;
1226           else pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
1227 
1228           strat->enterS(strat->P,pos,strat,-1);
1229         }
1230 //      if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1231       }
1232       kDeleteLcm(&strat->P);
1233     }
1234     //kTest(strat);
1235   }
1236   if (TEST_OPT_DEBUG) messageSets(strat);
1237 
1238   /* complete reduction of the standard basis--------- */
1239   if (TEST_OPT_SB_1)
1240   {
1241     int k=1;
1242     int j;
1243     while(k<=strat->sl)
1244     {
1245       j=0;
1246       loop
1247       {
1248         if (j>=k) break;
1249         clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
1250         j++;
1251       }
1252       k++;
1253     }
1254   }
1255 
1256   if (TEST_OPT_REDSB)
1257      completeReduce(strat);
1258   /* release temp data-------------------------------- */
1259   exitBuchMora(strat);
1260 //  if (TEST_OPT_WEIGHTM)
1261 //  {
1262 //    currRing->pFDeg=pFDegOld;
1263 //    currRing->pLDeg=pLDegOld;
1264 //    if (ecartWeights)
1265 //    {
1266 //      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
1267 //      ecartWeights=NULL;
1268 //    }
1269 //  }
1270   if (TEST_OPT_PROT) messageStat(hilbcount,strat);
1271   if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1272 
1273 
1274 #ifdef PDEBUG
1275 /* for counting number of pairs [enterL] in Plural */
1276 /*   extern int zaehler; */
1277 /*   Print("Total pairs considered:%d\n",zaehler); zaehler=0; */
1278 #endif /*PDEBUG*/
1279 
1280 #if MYTEST
1281   PrintS("</gnc_gr_bba>\n");
1282 #endif
1283 
1284   if( currRing != save )     rChangeCurrRing(save);
1285 
1286   return (strat->Shdl);
1287 }
1288 
k_gnc_gr_mora(const ideal F,const ideal Q,const intvec *,const intvec *,kStrategy strat,const ring _currRing)1289 ideal k_gnc_gr_mora(const ideal F, const ideal Q, const intvec *, const intvec *, kStrategy strat, const ring _currRing)
1290 {
1291 #ifndef SING_NDEBUG
1292   // Not yet!
1293   WarnS("Sorry, non-commutative mora is not yet implemented!");
1294 #endif
1295 
1296   return gnc_gr_bba(F, Q, NULL, NULL, strat, _currRing);
1297 }
1298 
1299 #endif
1300 
1301