1 /****************************************
2 * Computer Algebra System SINGULAR *
3 ****************************************/
4 /***************************************************************
5 * File: ratgring.cc
6 * Purpose: Ore-noncommutative kernel procedures
7 * Author: levandov (Viktor Levandovsky)
8 * Created: 8/00 - 11/00
9 *******************************************************************/
10
11
12
13 #include "kernel/mod2.h"
14 #ifdef HAVE_RATGRING
15 #include "kernel/GBEngine/ratgring.h"
16 #include "polys/nc/nc.h"
17 #include "polys/monomials/ring.h"
18 #include "kernel/polys.h"
19 #include "coeffs/numbers.h"
20 #include "kernel/ideals.h"
21 #include "polys/matpol.h"
22 #include "polys/kbuckets.h"
23 #include "kernel/GBEngine/kstd1.h"
24 #include "polys/sbuckets.h"
25 #include "polys/prCopy.h"
26 #include "polys/operations/p_Mult_q.h"
27 #include "polys/clapsing.h"
28 #include "misc/options.h"
29
pLcmRat(poly a,poly b,poly m,int rat_shift)30 void pLcmRat(poly a, poly b, poly m, int rat_shift)
31 {
32 /* rat_shift is the last exp one should count with */
33 int i;
34 for (i=(currRing->N); i>=rat_shift; i--)
35 {
36 pSetExp(m,i, si_max( pGetExp(a,i), pGetExp(b,i)));
37 }
38 pSetComp(m, si_max(pGetComp(a), pGetComp(b)));
39 /* Don't do a pSetm here, otherwise hres/lres chockes */
40 }
41
42 // void pLcmRat(poly a, poly b, poly m, poly pshift)
43 // {
44 // /* shift is the exp of rational elements */
45 // int i;
46 // for (i=(currRing->N); i; i--)
47 // {
48 // if (!pGetExp(pshift,i))
49 // {
50 // pSetExp(m,i, si_max( pGetExp(a,i), pGetExp(b,i)));
51 // }
52 // else
53 // {
54 // /* do we really need it? */
55 // pSetExp(m,i,0);
56 // }
57 // }
58 // pSetComp(m, si_max(pGetComp(a), pGetComp(b)));
59 // /* Don't do a pSetm here, otherwise hres/lres chockes */
60 // }
61
62 /* returns a subpoly of p, s.t. its monomials have the same D-part */
63
p_HeadRat(poly p,int ishift,ring r)64 poly p_HeadRat(poly p, int ishift, ring r)
65 {
66 poly q = pNext(p);
67 if (q == NULL) return p;
68 poly res = p_Head(p,r);
69 const long cmp = p_GetComp(p, r);
70 while ( (q!=NULL) && (p_Comp_k_n(p, q, ishift+1, r)) && (p_GetComp(q, r) == cmp) )
71 {
72 res = p_Add_q(res,p_Head(q,r),r);
73 q = pNext(q);
74 }
75 p_SetCompP(res,cmp,r);
76 return res;
77 }
78
79 /* to test!!! */
80 /* ExpVector(pr) = ExpVector(p1) - ExpVector(p2) */
p_ExpVectorDiffRat(poly pr,poly p1,poly p2,int ishift,ring r)81 void p_ExpVectorDiffRat(poly pr, poly p1, poly p2, int ishift, ring r)
82 {
83 p_LmCheckPolyRing1(p1, r);
84 p_LmCheckPolyRing1(p2, r);
85 p_LmCheckPolyRing1(pr, r);
86 int i;
87 poly t=pr;
88 int e1,e2;
89 for (i=ishift+1; i<=r->N; i++)
90 {
91 e1 = p_GetExp(p1, i, r);
92 e2 = p_GetExp(p2, i, r);
93 // pAssume1(p_GetExp(p1, i, r) >= p_GetExp(p2, i, r));
94 if (e1 < e2)
95 {
96 #ifdef PDEBUG
97 PrintS("negative ExpVectorDiff\n");
98 #endif
99 p_Delete(&t,r);
100 break;
101 }
102 else
103 {
104 p_SetExp(t,i, e1-e2,r);
105 }
106 }
107 p_Setm(t,r);
108 }
109
110 /* returns ideal (u,v) s.t. up + vq = 0 */
111
ncGCD2(poly p,poly q,const ring r)112 ideal ncGCD2(poly p, poly q, const ring r)
113 {
114 // todo: must destroy p,q
115 intvec *w = NULL;
116 ideal h = idInit(2,1);
117 h->m[0] = p_Copy(p,r);
118 h->m[1] = p_Copy(q,r);
119 #ifdef PDEBUG
120 PrintS("running syzygy comp. for nc_GCD:\n");
121 #endif
122 ideal sh = idSyzygies(h, testHomog, &w);
123 #ifdef PDEBUG
124 PrintS("done syzygy comp. for nc_GCD\n");
125 #endif
126 /* in comm case, there is only 1 syzygy */
127 /* singclap_gcd(); */
128 poly K, K1, K2;
129 K = sh->m[0]; /* take just the first element - to be enhanced later */
130 K1 = pTakeOutComp(&K, 1); // 1st component is taken out from K
131 // pShift(&K,-2); // 2nd component to 0th comp.
132 K2 = pTakeOutComp(&K, 1);
133 // K2 = K;
134
135 PrintS("syz1: "); p_wrp(K1,r);
136 PrintS("syz2: "); p_wrp(K2,r);
137
138 /* checking signs before multiplying */
139 number ck1 = p_GetCoeff(K1,r);
140 number ck2 = p_GetCoeff(K2,r);
141 BOOLEAN bck1, bck2;
142 bck1 = n_GreaterZero(ck1,r);
143 bck2 = n_GreaterZero(ck2,r);
144 /* K1 <0, K2 <0 (-K1,-K2) */
145 // if ( !(bck1 && bck2) ) /* - , - */
146 // {
147 // K1 = p_Neg(K1,r);
148 // K2 = p_Neg(K2,r);
149 // }
150 id_Delete(&h,r);
151 h = idInit(2,1);
152 h->m[0] = p_Copy(K1,r);
153 h->m[1] = p_Copy(K2,r);
154 id_Delete(&sh,r);
155 return(h);
156 }
157
158 /* returns ideal (u,v) s.t. up + vq = 0 */
159
ncGCD(poly p,poly q,const ring r)160 ideal ncGCD(poly p, poly q, const ring r)
161 {
162 // destroys p and q
163 // assume: p,q are in the comm. ring
164 // to be used in the coeff business
165 #ifdef PDEBUG
166 PrintS(" GCD_start:");
167 #endif
168 poly g = singclap_gcd(p_Copy(p,r),p_Copy(q,r), r);
169 #ifdef PDEBUG
170 p_wrp(g,r);
171 PrintS(" GCD_end;\n");
172 #endif
173 poly u = singclap_pdivide(q, g, r); //q/g
174 poly v = singclap_pdivide(p, g, r); //p/g
175 v = p_Neg(v,r);
176 p_Delete(&p,r);
177 p_Delete(&q,r);
178 ideal h = idInit(2,1);
179 h->m[0] = u; // p_Copy(u,r);
180 h->m[1] = v; // p_Copy(v,r);
181 return(h);
182 }
183
184 /* PINLINE1 void p_ExpVectorDiff
185 remains as is -> BUT we can do memory shift on smaller number of exp's */
186
187
188 /*4 - follow the numbering of gring.cc
189 * creates the S-polynomial of p1 and p2
190 * do not destroy p1 and p2
191 */
192 // poly nc_rat_CreateSpoly(poly p1, poly p2, poly spNoether, int ishift, const ring r)
193 // {
194 // if ((p_GetComp(p1,r)!=p_GetComp(p2,r))
195 // && (p_GetComp(p1,r)!=0)
196 // && (p_GetComp(p2,r)!=0))
197 // {
198 // #ifdef PDEBUG
199 // Print("nc_CreateSpoly : different components!");
200 // #endif
201 // return(NULL);
202 // }
203 // /* prod. crit does not apply yet */
204 // // if ((r->nc->type==nc_lie) && pHasNotCF(p1,p2)) /* prod crit */
205 // // {
206 // // return(nc_p_Bracket_qq(pCopy(p2),p1));
207 // // }
208 // poly pL=pOne();
209 // poly m1=pOne();
210 // poly m2=pOne();
211 // /* define shift */
212 // int is = ishift; /* TODO */
213 // pLcmRat(p1,p2,pL,is);
214 // p_Setm(pL,r);
215 // poly pr1 = p_GetExp_k_n(p1,1,ishift-1,r); /* rat D-exp of p1 */
216 // poly pr2 = p_GetExp_k_n(p2,1,ishift-1,r); /* rat D-exp of p2 */
217 // #ifdef PDEBUG
218 // p_Test(pL,r);
219 // #endif
220 // p_ExpVectorDiff(m1,pL,p1,r); /* purely in D part by construction */
221 // //p_SetComp(m1,0,r);
222 // //p_Setm(m1,r);
223 // #ifdef PDEBUG
224 // p_Test(m1,r);
225 // #endif
226 // p_ExpVectorDiff(m2,pL,p2,r); /* purely in D part by construction */
227 // //p_SetComp(m2,0,r);
228 // //p_Setm(m2,r);
229 // #ifdef PDEBUG
230 // p_Test(m2,r);
231 // #endif
232 // p_Delete(&pL,r);
233 // /* zero exponents ! */
234
235 // /* EXTRACT LEADCOEF */
236
237 // poly H1 = p_HeadRat(p1,is,r);
238 // poly M1 = r->nc->p_Procs.mm_Mult_p(m1,p_Copy(H1,r),r);
239
240 // /* POLY: number C1 = n_Copy(p_GetCoeff(M1,r),r); */
241 // /* RAT: */
242
243 // poly C1 = p_GetCoeffRat(M1,ishift,r);
244
245 // poly H2 = p_HeadRat(p2,is,r);
246 // poly M2 = r->nc->p_Procs.mm_Mult_p(m2,p_Copy(H2,r),r);
247
248 // /* POLY: number C2 = n_Copy(p_GetCoeff(M2,r),r); */
249 // /* RAT: */
250
251 // poly C2 = p_GetCoeffRat(M2,ishift,r);
252
253 // /* we do not assume that X's commute */
254 // /* we just run NC syzygies */
255
256 // /* NEW IDEA: change the ring to K<X>, map things there
257 // and return the result back; seems to be a good optimization */
258 // /* to be done later */
259 // /* problem: map to subalgebra. contexts, induced (non-unique) orderings etc. */
260
261 // intvec *w = NULL;
262 // ideal h = idInit(2,1);
263 // h->m[0] = p_Copy(C1,r);
264 // h->m[1] = p_Copy(C2,r);
265 // #ifdef PDEBUG
266 // Print("running syzygy comp. for coeffs");
267 // #endif
268 // ideal sh = idSyzygies(h, testHomog, &w);
269 // /* in comm case, there is only 1 syzygy */
270 // /* singclap_gcd(); */
271 // poly K,K1,K2;
272 // K = sh->m[0];
273 // K1 = pTakeOutComp(&K, 1); // 1st component is taken out from K
274 // pShift(&K,-2); // 2nd component to 0th comp.
275 // K2 = K;
276
277 // /* checking signs before multiplying */
278 // number ck1 = p_GetCoeff(K1,r);
279 // number ck2 = p_GetCoeff(K2,r);
280 // BOOLEAN bck1, bck2;
281 // bck1 = n_GreaterZero(ck1,r);
282 // bck2 = n_GreaterZero(ck2,r);
283 // /* K1 >0, K2 >0 (K1,-K2) */
284 // /* K1 >0, K2 <0 (K1,-K2) */
285 // /* K1 <0, K2 >0 (-K1,K2) */
286 // /* K1 <0, K2 <0 (-K1,K2) */
287 // if ( (bck1) && (bck2) ) /* +, + */
288 // {
289 // K2 = p_Neg(K2,r);
290 // }
291 // if ( (bck1) && (!bck2) ) /* + , - */
292 // {
293 // K2 = p_Neg(K2,r);
294 // }
295 // if ( (!bck1) && (bck2) ) /* - , + */
296 // {
297 // K1 = p_Neg(K1,r);
298 // }
299 // if ( !(bck1 && bck2) ) /* - , - */
300 // {
301 // K1 = p_Neg(K1,r);
302 // }
303
304 // poly P1,P2;
305
306 // // p_LmDeleteRat(M1,ishift,r); // get tail(D^(gamma-alpha) * lm(p1)) = h_f
307 // P1 = p_Copy(p1,r);
308 // p_LmDeleteAndNextRat(P1,ishift,r); // get tail(p1) = t_f
309 // P1 = r->nc->p_Procs.mm_Mult_p(m1,P1,r);
310 // P1 = p_Add_q(P1,M1,r);
311
312 // // p_LmDeleteRat(M2,ishift,r);
313 // P2 = p_Copy(p2,r);
314 // p_LmDeleteAndNextRat(P2,ishift,r);// get tail(p2)=t_g
315 // P2 = r->nc->p_Procs.mm_Mult_p(m2,P2,r);
316 // P2 = p_Add_q(P2,M2,r);
317
318 // /* coeff business */
319
320 // P1 = p_Mult_q(P1,K1,r);
321 // P2 = p_Mult_q(P2,K2,r);
322 // P1 = p_Add_q(P1,P2,r);
323
324 // /* cleaning up */
325
326 // #ifdef PDEBUG
327 // p_Test(p1,r);
328 // #endif
329 // /* questionable: */
330 // if (P1!=NULL) pCleardenom(P1);
331 // return(P1);
332 // }
333
334 #undef CC
335
336 /*4 - follow the numbering of gring.cc
337 * creates the S-polynomial of p1 and p2
338 * do not destroy p1 and p2
339 */
nc_rat_CreateSpoly(poly pp1,poly pp2,int ishift,const ring r)340 poly nc_rat_CreateSpoly(poly pp1, poly pp2, int ishift, const ring r)
341 {
342
343 poly p1 = p_Copy(pp1,r);
344 poly p2 = p_Copy(pp2,r);
345
346 const long lCompP1 = p_GetComp(p1,r);
347 const long lCompP2 = p_GetComp(p2,r);
348
349 if ((lCompP1!=lCompP2) && (lCompP1!=0) && (lCompP2!=0))
350 {
351 #ifdef PDEBUG
352 WerrorS("nc_rat_CreateSpoly: different non-zero components!");
353 #endif
354 return(NULL);
355 }
356
357 if ( (p_LmIsConstantRat(p1,r)) || (p_LmIsConstantRat(p2,r)) )
358 {
359 p_Delete(&p1,r);
360 p_Delete(&p2,r);
361 return( NULL );
362 }
363
364
365 /* note: prod. crit does not apply! */
366 poly pL=pOne();
367 poly m1=pOne();
368 poly m2=pOne();
369 int is = ishift; /* TODO */
370 pLcmRat(p1,p2,pL,is);
371 p_Setm(pL,r);
372 #ifdef PDEBUG
373 p_Test(pL,r);
374 #endif
375 poly pr1 = p_GetExp_k_n(p1,1,ishift,r); /* rat D-exp of p1 */
376 poly pr2 = p_GetExp_k_n(p2,1,ishift,r); /* rat D-exp of p2 */
377 p_ExpVectorDiff(m1,pL,pr1,r); /* purely in D part by construction */
378 p_ExpVectorDiff(m2,pL,pr2,r); /* purely in D part by construction */
379 p_Delete(&pr1,r);
380 p_Delete(&pr2,r);
381 p_Delete(&pL,r);
382 #ifdef PDEBUG
383 p_Test(m1,r);
384 PrintS("d^{gamma-alpha} = "); p_wrp(m1,r); PrintLn();
385 p_Test(m2,r);
386 PrintS("d^{gamma-beta} = "); p_wrp(m2,r); PrintLn();
387 #endif
388
389 poly HF = NULL;
390 HF = p_HeadRat(p1,is,r); // lm_D(f)
391 HF = nc_mm_Mult_p(m1, HF, r); // // d^{gamma-alpha} lm_D(f)
392 poly C = p_GetCoeffRat(HF, is, r); // c = lc_D(h_f) in the paper
393
394 poly HG = NULL;
395 HG = p_HeadRat(p2,is,r); // lm_D(g)
396 HG = nc_mm_Mult_p(m2, HG, r); // // d^{gamma-beta} lm_D(g)
397 poly K = p_GetCoeffRat(HG, is, r); // k = lc_D(h_g) in the paper
398
399 #ifdef PDEBUG
400 PrintS("f: "); p_wrp(p1,r); PrintS("\n");
401 PrintS("c: "); p_wrp(C,r); PrintS("\n");
402 PrintS("g: "); p_wrp(p2,r); PrintS("\n");
403 PrintS("k: "); p_wrp(K,r); PrintS("\n");
404 #endif
405
406 ideal ncsyz = ncGCD(C,K,r);
407 poly KK = ncsyz->m[0]; ncsyz->m[0]=NULL; //p_Copy(ncsyz->m[0],r); // k'
408 poly CC = ncsyz->m[1]; ncsyz->m[1]= NULL; //p_Copy(ncsyz->m[1],r); // c'
409 id_Delete(&ncsyz,r);
410
411 p_LmDeleteAndNextRat(&p1, is, r); // t_f
412 p_LmDeleteAndNextRat(&HF, is, r); // r_f = h_f - lt_D(h_f)
413
414 p_LmDeleteAndNextRat(&p2, is, r); // t_g
415 p_LmDeleteAndNextRat(&HG, is, r); // r_g = h_g - lt_D(h_g)
416
417
418 #ifdef PDEBUG
419 PrintS(" t_f: "); p_wrp(p1,r); PrintS("\n");
420 PrintS(" t_g: "); p_wrp(p2,r); PrintS("\n");
421 PrintS(" r_f: "); p_wrp(HF,r); PrintS("\n");
422 PrintS(" r_g: "); p_wrp(HG,r); PrintS("\n");
423 PrintS(" c': "); p_wrp(CC,r); PrintS("\n");
424 PrintS(" k': "); p_wrp(KK,r); PrintS("\n");
425
426 #endif
427
428 // k'(r_f + d^{gamma-alpha} t_f)
429
430 p1 = p_Mult_q(m1, p1, r); // p1 = d^{gamma-alpha} t_f
431 p1 = p_Add_q(p1,HF,r); // p1 = r_f + d^{gamma-alpha} t_f
432 p1 = p_Mult_q(KK,p1,r); // p1 = k'(r_f + d^{gamma-alpha} t_f)
433
434 // c'(r_f + d^{gamma-beta} t_g)
435
436 p2 = p_Mult_q(m2, p2, r); // p2 = d^{gamma-beta} t_g
437 p2 = p_Add_q(p2,HG,r); // p2 = r_g + d^{gamma-beta} t_g
438 p2 = p_Mult_q(CC,p2,r); // p2 = c'(r_g + d^{gamma-beta} t_g)
439
440 #ifdef PDEBUG
441 p_Test(p1,r);
442 p_Test(p2,r);
443 PrintS(" k'(r_f + d^{gamma-alpha} t_f): "); p_wrp(p1,r);
444 PrintS(" c'(r_g + d^{gamma-beta} t_g): "); p_wrp(p2,r);
445 #endif
446
447 poly out = p_Add_q(p1,p2,r); // delete p1, p2; // the sum
448
449 #ifdef PDEBUG
450 p_Test(out,r);
451 #endif
452
453 // if ( out!=NULL ) pCleardenom(out); // postponed to enterS
454 return(out);
455 }
456
457
458 /*2
459 * reduction of p2 with p1
460 * do not destroy p1, but p2
461 * p1 divides p2 -> for use in NF algorithm
462 * works in an integer fashion
463 */
464
nc_rat_ReduceSpolyNew(const poly p1,poly p2,int ishift,const ring r)465 poly nc_rat_ReduceSpolyNew(const poly p1, poly p2, int ishift, const ring r)
466 {
467 const long lCompP1 = p_GetComp(p1,r);
468 const long lCompP2 = p_GetComp(p2,r);
469
470 if ((lCompP1!=lCompP2) && (lCompP1!=0) && (lCompP2!=0))
471 {
472 #ifdef PDEBUG
473 WerrorS("nc_rat_ReduceSpolyNew: different non-zero components!");
474 #endif
475 return(NULL);
476 }
477
478 if (p_LmIsConstantRat(p1,r))
479 {
480 return( NULL );
481 }
482
483
484 int is = ishift; /* TODO */
485
486 poly m = pOne();
487 p_ExpVectorDiffRat(m, p2, p1, ishift, r); // includes X and D parts
488 //p_Setm(m,r);
489 // m = p_GetExp_k_n(m,1,ishift,r); /* rat D-exp of m */
490 #ifdef PDEBUG
491 p_Test(m,r);
492 PrintS("d^alpha = "); p_wrp(m,r); PrintLn();
493 #endif
494
495 /* pSetComp(m,r)=0? */
496 poly HH = NULL;
497 poly H = NULL;
498 HH = p_HeadRat(p1,is,r); //p_Copy(p_HeadRat(p1,is,r),r); // lm_D(g)
499 // H = r->nc->p_Procs.mm_Mult_p(m, p_Copy(HH, r), r); // d^aplha lm_D(g)
500 H = nc_mm_Mult_p(m, HH, r); // d^aplha lm_D(g) == h_g in the paper
501
502 poly K = p_GetCoeffRat(H, is, r); //p_Copy( p_GetCoeffRat(H, is, r), r); // k in the paper
503 poly P = p_GetCoeffRat(p2, is, r); //p_Copy( p_GetCoeffRat(p2, is, r), r); // lc_D(p_2) == lc_D(f)
504
505 #ifdef PDEBUG
506 PrintS("k: "); p_wrp(K,r); PrintS("\n");
507 PrintS("p: "); p_wrp(P,r); PrintS("\n");
508 PrintS("f: "); p_wrp(p2,r); PrintS("\n");
509 PrintS("g: "); p_wrp(p1,r); PrintS("\n");
510 #endif
511 // alt:
512 poly out = p_Copy(p1,r);
513 p_LmDeleteAndNextRat(&out, is, r); // out == t_g
514
515 ideal ncsyz = ncGCD(P,K,r);
516 poly KK = ncsyz->m[0]; ncsyz->m[0]=NULL; //p_Copy(ncsyz->m[0],r); // k'
517 poly PP = ncsyz->m[1]; ncsyz->m[1]= NULL; //p_Copy(ncsyz->m[1],r); // p'
518
519 #ifdef PDEBUG
520 PrintS("t_g: "); p_wrp(out,r);
521 PrintS("k': "); p_wrp(KK,r); PrintS("\n");
522 PrintS("p': "); p_wrp(PP,r); PrintS("\n");
523 #endif
524 id_Delete(&ncsyz,r);
525 p_LmDeleteAndNextRat(&p2, is, r); // t_f
526 p_LmDeleteAndNextRat(&H, is, r); // r_g = h_g - lt_D(h_g)
527
528 #ifdef PDEBUG
529 PrintS(" t_f: "); p_wrp(p2,r);
530 PrintS(" r_g: "); p_wrp(H,r);
531 #endif
532
533 p2 = p_Mult_q(KK, p2, r); // p2 = k' t_f
534
535 #ifdef PDEBUG
536 p_Test(p2,r);
537 PrintS(" k' t_f: "); p_wrp(p2,r);
538 #endif
539
540 // out = r->nc->p_Procs.mm_Mult_p(m, out, r); // d^aplha t_g
541 out = nc_mm_Mult_p(m, out, r); // d^aplha t_g
542 p_Delete(&m,r);
543
544 #ifdef PDEBUG
545 PrintS(" d^a t_g: "); p_wrp(out,r);
546 PrintS(" end reduction\n");
547 #endif
548
549 out = p_Add_q(H, out, r); // r_g + d^a t_g
550
551 #ifdef PDEBUG
552 p_Test(out,r);
553 #endif
554 out = p_Mult_q(PP, out, r); // p' (r_g + d^a t_g)
555 out = p_Add_q(p2,out,r); // delete out, p2; // the sum
556
557 #ifdef PDEBUG
558 p_Test(out,r);
559 #endif
560
561 // if ( out!=NULL ) pCleardenom(out); // postponed to enterS
562 return(out);
563 }
564
565 // return: FALSE, if there exists i in ishift..r->N,
566 // such that a->exp[i] > b->exp[i]
567 // TRUE, otherwise
568
p_DivisibleByRat(poly a,poly b,int ishift,const ring r)569 BOOLEAN p_DivisibleByRat(poly a, poly b, int ishift, const ring r)
570 {
571 #ifdef PDEBUG
572 PrintS("invoke p_DivByRat with a = ");
573 p_wrp(p_Head(a,r),r);
574 PrintS(" and b= ");
575 p_wrp(p_Head(b,r),r);
576 PrintLn();
577 #endif
578 int i;
579 for(i=r->N; i>ishift; i--)
580 {
581 #ifdef PDEBUG
582 Print("i=%d,",i);
583 #endif
584 if (p_GetExp(a,i,r) > p_GetExp(b,i,r)) return FALSE;
585 }
586 return ((p_GetComp(a,r)==p_GetComp(b,r)) || (p_GetComp(a,r)==0));
587 }
588 /*2
589 *reduces h with elements from reducer choosing the best possible
590 * element in t with respect to the given red_length
591 * arrays reducer and red_length are [0..(rl-1)]
592 */
redRat(poly * h,poly * reducer,int * red_length,int rl,int ishift,ring r)593 int redRat (poly* h, poly *reducer, int *red_length, int rl, int ishift, ring r)
594 {
595 if ((*h)==NULL) return 0;
596
597 int j,i,l;
598
599 loop
600 {
601 j=rl;l=MAX_INT_VAL;
602 for(i=rl-1;i>=0;i--)
603 {
604 // Print("test %d, l=%d (curr=%d, l=%d\n",i,red_length[i],j,l);
605 if ((l>red_length[i]) && (p_DivisibleByRat(reducer[i],*h,ishift,r)))
606 {
607 j=i; l=red_length[i];
608 // PrintS(" yes\n");
609 }
610 // else PrintS(" no\n");
611 }
612 if (j >=rl)
613 {
614 return 1; // not reducible
615 }
616
617 if (TEST_OPT_DEBUG)
618 {
619 PrintS("reduce ");
620 p_wrp(*h,r);
621 PrintS(" with ");
622 p_wrp(reducer[j],r);
623 }
624 poly hh=nc_rat_ReduceSpolyNew(reducer[j], *h, ishift, r);
625 // p_Delete(h,r);
626 *h=hh;
627 if (TEST_OPT_DEBUG)
628 {
629 PrintS(" to ");
630 p_wrp(*h,r);
631 PrintLn();
632 }
633 if ((*h)==NULL)
634 {
635 return 0;
636 }
637 }
638 }
639
640 // test if monomial is a constant, i.e. if all exponents and the component
641 // is zero
p_LmIsConstantRat(const poly p,const ring r)642 BOOLEAN p_LmIsConstantRat(const poly p, const ring r)
643 {
644 if (p_LmIsConstantCompRat(p, r))
645 return (p_GetComp(p, r) == 0);
646 return FALSE;
647 }
648
649 // test if the monomial is a constant as a vector component
650 // i.e., test if all exponents are zero
p_LmIsConstantCompRat(const poly p,const ring r)651 BOOLEAN p_LmIsConstantCompRat(const poly p, const ring r)
652 {
653 int i = r->real_var_end;
654
655 while ( (p_GetExp(p,i,r)==0) && (i>=r->real_var_start))
656 {
657 i--;
658 }
659 return ( i+1 == r->real_var_start );
660 }
661
662 #endif
663