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