1 | /**************************************** |
---|
2 | * Computer Algebra System SINGULAR * |
---|
3 | ****************************************/ |
---|
4 | /* $Id: shiftgb.cc,v 1.1 2007-06-02 13:29:07 levandov Exp $ */ |
---|
5 | /* |
---|
6 | * ABSTRACT: kernel: utils for shift GB and free GB |
---|
7 | */ |
---|
8 | |
---|
9 | |
---|
10 | ideal freegb(ideal I, int uptodeg, int lVblock) |
---|
11 | { |
---|
12 | } |
---|
13 | |
---|
14 | poly pLPshift(poly p, int sh, int uptodeg, int lV) |
---|
15 | { |
---|
16 | /* assume shift takes place */ |
---|
17 | /* shifts the poly by sh */ |
---|
18 | |
---|
19 | if (sh == 0) return(p); /* the zero shift */ |
---|
20 | |
---|
21 | poly q = NULL; |
---|
22 | while (p!=NULL) |
---|
23 | { |
---|
24 | q = p_Add_q(q,pmLPshift(p,sh,uptodeg,lV)); |
---|
25 | pIter(p); |
---|
26 | } |
---|
27 | |
---|
28 | /* int version: returns TRUE if it was successful */ |
---|
29 | } |
---|
30 | |
---|
31 | |
---|
32 | poly pmLPshift(poly p, int sh, int uptodeg, int lV) |
---|
33 | { |
---|
34 | /* pm is a monomial */ |
---|
35 | |
---|
36 | if (sh == 0) return(p); /* the zero shift */ |
---|
37 | |
---|
38 | int L = pmLastVblock(p,lV); |
---|
39 | if (L+sh > uptodeg) |
---|
40 | { |
---|
41 | return(NULL); /* violation, 2check */ |
---|
42 | } |
---|
43 | int *e=(int *)omAlloc0((currRing->N)*sizeof(int)); |
---|
44 | int *s=(int *)omAlloc0((currRing->N)*sizeof(int)); |
---|
45 | pGetExpV(p,e); |
---|
46 | number c = pGetCoeff(p); |
---|
47 | int i,j; |
---|
48 | for (i=1; i<=currRing->N; i++) |
---|
49 | { |
---|
50 | if (e[j]) |
---|
51 | { |
---|
52 | s[j+sh] = e[j]; /* actually 1 */ |
---|
53 | } |
---|
54 | } |
---|
55 | poly m = pOne(); |
---|
56 | pSetExpV(m,s); |
---|
57 | pSetCoeff0(m,c); |
---|
58 | freeT(e, currRing->N); |
---|
59 | freeT(s, currRing->N); |
---|
60 | /* pSetm(m); */ /* done in the pSetExpV */ |
---|
61 | return(m); |
---|
62 | } |
---|
63 | |
---|
64 | int pLastVblock(poly p, int lV) |
---|
65 | { |
---|
66 | /* returns the number of maximal block */ |
---|
67 | /* appearing among the monomials of p */ |
---|
68 | poly q = pCopy(p); /* need it ? */ |
---|
69 | int ans = 0; int ansnew; |
---|
70 | while (q!=NULL) |
---|
71 | { |
---|
72 | ansnew = pmLastVblock(q,lV); |
---|
73 | ans = si_max(ans,ansnew); |
---|
74 | pIter(q); |
---|
75 | } |
---|
76 | return(ans); |
---|
77 | } |
---|
78 | |
---|
79 | int pmLastVblock(poly p, int lV) |
---|
80 | { |
---|
81 | /* for a monomial p, returns the number of the last block */ |
---|
82 | /* where a nonzero exponent is sitting */ |
---|
83 | int *e=(int *)omAlloc0((currRing->N)*sizeof(int)); |
---|
84 | pGetExpV(p,e); |
---|
85 | int j,b; |
---|
86 | while ( (!e[j]) && (j>=1) ) j--; |
---|
87 | b = (int)(j/lV) + 1; /* the number of the block */ |
---|
88 | return (b); |
---|
89 | } |
---|
90 | |
---|
91 | int isInV(poly p, int lV) |
---|
92 | { |
---|
93 | if (lV<=0) return; |
---|
94 | /* returns 1 iff p is in V */ |
---|
95 | /* that is in the same block there is only one nonzero exponent */ |
---|
96 | /* lV = the length of V = the number of orig vars */ |
---|
97 | int *e = (int *)omAlloc0((currRing->N)*sizeof(int)); |
---|
98 | int b = (int)(currRing->N)/lV; /* the number of blocks */ |
---|
99 | int *B = (int *)omAlloc0((b)*sizeof(int)); /* the num of elements in a block */ |
---|
100 | pGetExpV(p,e); |
---|
101 | int i,j; |
---|
102 | for (j=1; j<=b; j++) |
---|
103 | { |
---|
104 | /* we go through all the vars */ |
---|
105 | /* by blocks in lV vars */ |
---|
106 | for (i=(j-1)*lV + 1; i<= j*lV; i++) |
---|
107 | { |
---|
108 | if (!e[i]) B[j] = B[j]+1; |
---|
109 | } |
---|
110 | } |
---|
111 | j = b; |
---|
112 | while ( (!B[j]) && (j>=1)) j--; |
---|
113 | if (j==0) |
---|
114 | { |
---|
115 | /* it is a zero exp vector, which is in V */ |
---|
116 | return(1); |
---|
117 | } |
---|
118 | /* now B[j] != 0 */ |
---|
119 | for (j; j>=1; j--) |
---|
120 | { |
---|
121 | if (B[j]!=1) |
---|
122 | { |
---|
123 | return(0); |
---|
124 | } |
---|
125 | } |
---|
126 | return(1); |
---|
127 | } |
---|
128 | |
---|
129 | /* including the self pairs? */ |
---|
130 | |
---|
131 | /*1 |
---|
132 | * put the pairs (s[i],sh \dot p) into the set B, ecart=ecart(p) |
---|
133 | */ |
---|
134 | |
---|
135 | |
---|
136 | void enterOnePairManyShifts (int i, poly p, int ecart, int isFromQ, kStrategy strat, int atR = -1, int uptodeg, int lV) |
---|
137 | { |
---|
138 | |
---|
139 | int j; |
---|
140 | int lb = pLastVblock(p,lV); |
---|
141 | poly q; |
---|
142 | for (j=0; j<= uptodeg - lb; j++) |
---|
143 | { |
---|
144 | q = pLPshift(p,j,uptodeg,lV); |
---|
145 | enterOnePairShift(i, p, ecart, isFromQ, strat, -1, uptodeg, lV); |
---|
146 | } |
---|
147 | } |
---|
148 | |
---|
149 | /*2 |
---|
150 | * put the pair (s[i],p) into the set B, ecart=ecart(p) |
---|
151 | */ |
---|
152 | |
---|
153 | |
---|
154 | void enterOnePairShift (int i, poly p, int ecart, int isFromQ, kStrategy strat, int atR = -1, int uptodeg, int lV) |
---|
155 | { |
---|
156 | |
---|
157 | /* need additionally: int up_to_degree, poly V0 with the variables in (0) or just the number lV = the length of the first block */ |
---|
158 | /* should cycle through all shifts of s[i] until up_to_degree - lastVblock(s[i]) */ |
---|
159 | /* that is create the pairs (f, s \dot g) for deg(s\dot g)= */ |
---|
160 | |
---|
161 | assume(i<=strat->sl); |
---|
162 | if (strat->interred_flag) return; |
---|
163 | |
---|
164 | int l,j,compare; |
---|
165 | LObject Lp; |
---|
166 | Lp.i_r = -1; |
---|
167 | |
---|
168 | #ifdef KDEBUG |
---|
169 | Lp.ecart=0; Lp.length=0; |
---|
170 | #endif |
---|
171 | /*- computes the lcm(s[i],p) -*/ |
---|
172 | Lp.lcm = pInit(); |
---|
173 | |
---|
174 | pLcm(p,strat->S[i],Lp.lcm); |
---|
175 | pSetm(Lp.lcm); |
---|
176 | |
---|
177 | /* apply the V criterion */ |
---|
178 | if (!isInV(Lp.lcm)) |
---|
179 | { |
---|
180 | pLmFree(Lp.lcm); |
---|
181 | Lp.lcm=NULL; |
---|
182 | return; |
---|
183 | } |
---|
184 | |
---|
185 | |
---|
186 | #ifdef HAVE_PLURAL |
---|
187 | const BOOLEAN bIsPluralRing = rIsPluralRing(currRing); |
---|
188 | const BOOLEAN bIsSCA = rIsSCA(currRing) && strat->homog; // for prod-crit |
---|
189 | const BOOLEAN bNCProdCrit = ( !bIsPluralRing || bIsSCA ); // commutative or homogeneous SCA |
---|
190 | #else |
---|
191 | const BOOLEAN bIsPluralRing = FALSE; |
---|
192 | const BOOLEAN bIsSCA = FALSE; |
---|
193 | const BOOLEAN bNCProdCrit = TRUE; |
---|
194 | #endif |
---|
195 | |
---|
196 | if (strat->sugarCrit && bNCProdCrit) |
---|
197 | { |
---|
198 | if((!((strat->ecartS[i]>0)&&(ecart>0))) |
---|
199 | && pHasNotCF(p,strat->S[i])) |
---|
200 | { |
---|
201 | /* |
---|
202 | *the product criterion has applied for (s,p), |
---|
203 | *i.e. lcm(s,p)=product of the leading terms of s and p. |
---|
204 | *Suppose (s,r) is in L and the leading term |
---|
205 | *of p divides lcm(s,r) |
---|
206 | *(==> the leading term of p divides the leading term of r) |
---|
207 | *but the leading term of s does not divide the leading term of r |
---|
208 | *(notice that this condition is automatically satisfied if r is still |
---|
209 | *in S), then (s,r) can be cancelled. |
---|
210 | *This should be done here because the |
---|
211 | *case lcm(s,r)=lcm(s,p) is not covered by chainCrit. |
---|
212 | * |
---|
213 | *Moreover, skipping (s,r) holds also for the noncommutative case. |
---|
214 | */ |
---|
215 | strat->cp++; |
---|
216 | pLmFree(Lp.lcm); |
---|
217 | Lp.lcm=NULL; |
---|
218 | return; |
---|
219 | } |
---|
220 | else |
---|
221 | Lp.ecart = si_max(ecart,strat->ecartS[i]); |
---|
222 | if (strat->fromT && (strat->ecartS[i]>ecart)) |
---|
223 | { |
---|
224 | pLmFree(Lp.lcm); |
---|
225 | Lp.lcm=NULL; |
---|
226 | return; |
---|
227 | /*the pair is (s[i],t[.]), discard it if the ecart is too big*/ |
---|
228 | } |
---|
229 | /* |
---|
230 | *the set B collects the pairs of type (S[j],p) |
---|
231 | *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p) |
---|
232 | *if the leading term of s devides lcm(r,p) then (r,p) will be canceled |
---|
233 | *if the leading term of r devides lcm(s,p) then (s,p) will not enter B |
---|
234 | */ |
---|
235 | { |
---|
236 | j = strat->Bl; |
---|
237 | loop |
---|
238 | { |
---|
239 | if (j < 0) break; |
---|
240 | compare=pDivComp(strat->B[j].lcm,Lp.lcm); |
---|
241 | if ((compare==1) |
---|
242 | &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart))) |
---|
243 | { |
---|
244 | strat->c3++; |
---|
245 | if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0)) |
---|
246 | { |
---|
247 | pLmFree(Lp.lcm); |
---|
248 | return; |
---|
249 | } |
---|
250 | break; |
---|
251 | } |
---|
252 | else |
---|
253 | if ((compare ==-1) |
---|
254 | && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart)) |
---|
255 | { |
---|
256 | deleteInL(strat->B,&strat->Bl,j,strat); |
---|
257 | strat->c3++; |
---|
258 | } |
---|
259 | j--; |
---|
260 | } |
---|
261 | } |
---|
262 | } |
---|
263 | else /*sugarcrit*/ |
---|
264 | { |
---|
265 | if (bNCProdCrit) |
---|
266 | { |
---|
267 | // if currRing->nc_type!=quasi (or skew) |
---|
268 | // TODO: enable productCrit for super commutative algebras... |
---|
269 | if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/ |
---|
270 | pHasNotCF(p,strat->S[i])) |
---|
271 | { |
---|
272 | /* |
---|
273 | *the product criterion has applied for (s,p), |
---|
274 | *i.e. lcm(s,p)=product of the leading terms of s and p. |
---|
275 | *Suppose (s,r) is in L and the leading term |
---|
276 | *of p devides lcm(s,r) |
---|
277 | *(==> the leading term of p devides the leading term of r) |
---|
278 | *but the leading term of s does not devide the leading term of r |
---|
279 | *(notice that tis condition is automatically satisfied if r is still |
---|
280 | *in S), then (s,r) can be canceled. |
---|
281 | *This should be done here because the |
---|
282 | *case lcm(s,r)=lcm(s,p) is not covered by chainCrit. |
---|
283 | */ |
---|
284 | strat->cp++; |
---|
285 | pLmFree(Lp.lcm); |
---|
286 | Lp.lcm=NULL; |
---|
287 | return; |
---|
288 | } |
---|
289 | if (strat->fromT && (strat->ecartS[i]>ecart)) |
---|
290 | { |
---|
291 | pLmFree(Lp.lcm); |
---|
292 | Lp.lcm=NULL; |
---|
293 | return; |
---|
294 | /*the pair is (s[i],t[.]), discard it if the ecart is too big*/ |
---|
295 | } |
---|
296 | /* |
---|
297 | *the set B collects the pairs of type (S[j],p) |
---|
298 | *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p) |
---|
299 | *if the leading term of s devides lcm(r,p) then (r,p) will be canceled |
---|
300 | *if the leading term of r devides lcm(s,p) then (s,p) will not enter B |
---|
301 | */ |
---|
302 | for(j = strat->Bl;j>=0;j--) |
---|
303 | { |
---|
304 | compare=pDivComp(strat->B[j].lcm,Lp.lcm); |
---|
305 | if (compare==1) |
---|
306 | { |
---|
307 | strat->c3++; |
---|
308 | if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0)) |
---|
309 | { |
---|
310 | pLmFree(Lp.lcm); |
---|
311 | return; |
---|
312 | } |
---|
313 | break; |
---|
314 | } |
---|
315 | else |
---|
316 | if (compare ==-1) |
---|
317 | { |
---|
318 | deleteInL(strat->B,&strat->Bl,j,strat); |
---|
319 | strat->c3++; |
---|
320 | } |
---|
321 | } |
---|
322 | } |
---|
323 | } |
---|
324 | /* |
---|
325 | *the pair (S[i],p) enters B if the spoly != 0 |
---|
326 | */ |
---|
327 | /*- compute the short s-polynomial -*/ |
---|
328 | if (strat->fromT && !TEST_OPT_INTSTRATEGY) |
---|
329 | pNorm(p); |
---|
330 | if ((strat->S[i]==NULL) || (p==NULL)) |
---|
331 | return; |
---|
332 | if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0)) |
---|
333 | Lp.p=NULL; |
---|
334 | else |
---|
335 | { |
---|
336 | #ifdef HAVE_PLURAL |
---|
337 | if ( bIsPluralRing ) |
---|
338 | { |
---|
339 | if(pHasNotCF(p, strat->S[i])) |
---|
340 | { |
---|
341 | if(ncRingType(currRing) == nc_lie) |
---|
342 | { |
---|
343 | // generalized prod-crit for lie-type |
---|
344 | strat->cp++; |
---|
345 | Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i]); |
---|
346 | } |
---|
347 | else |
---|
348 | if( bIsSCA ) |
---|
349 | { |
---|
350 | // product criterion for homogeneous case in SCA |
---|
351 | strat->cp++; |
---|
352 | Lp.p = NULL; |
---|
353 | } |
---|
354 | else |
---|
355 | Lp.p = nc_CreateSpoly(strat->S[i],p,currRing); // ? |
---|
356 | } |
---|
357 | else Lp.p = nc_CreateSpoly(strat->S[i],p,currRing); |
---|
358 | } |
---|
359 | else |
---|
360 | #endif |
---|
361 | { |
---|
362 | Lp.p = ksCreateShortSpoly(strat->S[i],p, strat->tailRing); |
---|
363 | } |
---|
364 | } |
---|
365 | if (Lp.p == NULL) |
---|
366 | { |
---|
367 | /*- the case that the s-poly is 0 -*/ |
---|
368 | if (strat->pairtest==NULL) initPairtest(strat); |
---|
369 | strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/ |
---|
370 | strat->pairtest[strat->sl+1] = TRUE; |
---|
371 | /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/ |
---|
372 | /* |
---|
373 | *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is |
---|
374 | *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not |
---|
375 | *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading |
---|
376 | *term of p devides the lcm(s,r) |
---|
377 | *(this canceling should be done here because |
---|
378 | *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit) |
---|
379 | *the first case is handeled in chainCrit |
---|
380 | */ |
---|
381 | if (Lp.lcm!=NULL) pLmFree(Lp.lcm); |
---|
382 | } |
---|
383 | else |
---|
384 | { |
---|
385 | /*- the pair (S[i],p) enters B -*/ |
---|
386 | Lp.p1 = strat->S[i]; |
---|
387 | Lp.p2 = p; |
---|
388 | |
---|
389 | if ( !bIsPluralRing ) |
---|
390 | pNext(Lp.p) = strat->tail; |
---|
391 | |
---|
392 | if (atR >= 0) |
---|
393 | { |
---|
394 | Lp.i_r1 = strat->S_2_R[i]; |
---|
395 | Lp.i_r2 = atR; |
---|
396 | } |
---|
397 | else |
---|
398 | { |
---|
399 | Lp.i_r1 = -1; |
---|
400 | Lp.i_r2 = -1; |
---|
401 | } |
---|
402 | strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart); |
---|
403 | |
---|
404 | if (TEST_OPT_INTSTRATEGY) |
---|
405 | { |
---|
406 | if (!bIsPluralRing) |
---|
407 | nDelete(&(Lp.p->coef)); |
---|
408 | } |
---|
409 | |
---|
410 | l = strat->posInL(strat->B,strat->Bl,&Lp,strat); |
---|
411 | enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l); |
---|
412 | } |
---|
413 | } |
---|
414 | |
---|
415 | |
---|
416 | |
---|
417 | /*3 |
---|
418 | *(s[0],h),...,(s[k],h) will be put to the pairset L |
---|
419 | * additionally we put the pairs (h, s \sdot h) for s>=1 to L |
---|
420 | */ |
---|
421 | void initenterpairsShift (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1) |
---|
422 | { |
---|
423 | |
---|
424 | if ((strat->syzComp==0) |
---|
425 | || (pGetComp(h)<=strat->syzComp)) |
---|
426 | { |
---|
427 | int j; |
---|
428 | BOOLEAN new_pair=FALSE; |
---|
429 | |
---|
430 | if (pGetComp(h)==0) |
---|
431 | { |
---|
432 | /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/ |
---|
433 | if ((isFromQ)&&(strat->fromQ!=NULL)) |
---|
434 | { |
---|
435 | for (j=0; j<=k; j++) |
---|
436 | { |
---|
437 | if (!strat->fromQ[j]) |
---|
438 | { |
---|
439 | new_pair=TRUE; |
---|
440 | enterOnePair(j,h,ecart,isFromQ,strat, atR); |
---|
441 | //Print("j:%d, Ll:%d\n",j,strat->Ll); |
---|
442 | } |
---|
443 | } |
---|
444 | } |
---|
445 | else |
---|
446 | { |
---|
447 | new_pair=TRUE; |
---|
448 | for (j=0; j<=k; j++) |
---|
449 | { |
---|
450 | enterOnePair(j,h,ecart,isFromQ,strat, atR); |
---|
451 | } |
---|
452 | /* HERE we put (h, s*h) pairs */ |
---|
453 | } |
---|
454 | } |
---|
455 | else |
---|
456 | { |
---|
457 | for (j=0; j<=k; j++) |
---|
458 | { |
---|
459 | if ((pGetComp(h)==pGetComp(strat->S[j])) |
---|
460 | || (pGetComp(strat->S[j])==0)) |
---|
461 | { |
---|
462 | new_pair=TRUE; |
---|
463 | enterOnePair(j,h,ecart,isFromQ,strat, atR); |
---|
464 | //Print("j:%d, Ll:%d\n",j,strat->Ll); |
---|
465 | } |
---|
466 | } |
---|
467 | /* HERE we put (h, s*h) pairs TOO */ |
---|
468 | } |
---|
469 | |
---|
470 | if (new_pair) chainCrit(h,ecart,strat); |
---|
471 | |
---|
472 | } |
---|
473 | } |
---|
474 | |
---|
475 | |
---|
476 | |
---|
477 | ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat) |
---|
478 | { |
---|
479 | #ifdef KDEBUG |
---|
480 | bba_count++; |
---|
481 | int loop_count = 0; |
---|
482 | #endif |
---|
483 | om_Opts.MinTrack = 5; |
---|
484 | int srmax,lrmax, red_result = 1; |
---|
485 | int olddeg,reduc; |
---|
486 | int hilbeledeg=1,hilbcount=0,minimcnt=0; |
---|
487 | BOOLEAN withT = FALSE; |
---|
488 | |
---|
489 | initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/ |
---|
490 | initBuchMoraPos(strat); |
---|
491 | initHilbCrit(F,Q,&hilb,strat); |
---|
492 | initBba(F,strat); |
---|
493 | /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/ |
---|
494 | /*Shdl=*/initBuchMora(F, Q,strat); |
---|
495 | if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank); |
---|
496 | srmax = strat->sl; |
---|
497 | reduc = olddeg = lrmax = 0; |
---|
498 | |
---|
499 | #ifndef NO_BUCKETS |
---|
500 | if (!TEST_OPT_NOT_BUCKETS) |
---|
501 | strat->use_buckets = 1; |
---|
502 | #endif |
---|
503 | |
---|
504 | // redtailBBa against T for inhomogenous input |
---|
505 | if (!K_TEST_OPT_OLDSTD) |
---|
506 | withT = ! strat->homog; |
---|
507 | |
---|
508 | // strat->posInT = posInT_pLength; |
---|
509 | kTest_TS(strat); |
---|
510 | |
---|
511 | #ifdef HAVE_TAIL_RING |
---|
512 | kStratInitChangeTailRing(strat); |
---|
513 | #endif |
---|
514 | |
---|
515 | /* compute------------------------------------------------------- */ |
---|
516 | while (strat->Ll >= 0) |
---|
517 | { |
---|
518 | if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/ |
---|
519 | #ifdef KDEBUG |
---|
520 | loop_count++; |
---|
521 | if (TEST_OPT_DEBUG) messageSets(strat); |
---|
522 | #endif |
---|
523 | if (strat->Ll== 0) strat->interpt=TRUE; |
---|
524 | if (TEST_OPT_DEGBOUND |
---|
525 | && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)) |
---|
526 | || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))) |
---|
527 | { |
---|
528 | /* |
---|
529 | *stops computation if |
---|
530 | * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then |
---|
531 | *a predefined number Kstd1_deg |
---|
532 | */ |
---|
533 | while ((strat->Ll >= 0) |
---|
534 | && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL) |
---|
535 | && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)) |
---|
536 | || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))) |
---|
537 | ) |
---|
538 | deleteInL(strat->L,&strat->Ll,strat->Ll,strat); |
---|
539 | if (strat->Ll<0) break; |
---|
540 | else strat->noClearS=TRUE; |
---|
541 | } |
---|
542 | /* picks the last element from the lazyset L */ |
---|
543 | strat->P = strat->L[strat->Ll]; |
---|
544 | strat->Ll--; |
---|
545 | |
---|
546 | if (pNext(strat->P.p) == strat->tail) |
---|
547 | { |
---|
548 | // deletes the short spoly |
---|
549 | pLmFree(strat->P.p); |
---|
550 | strat->P.p = NULL; |
---|
551 | poly m1 = NULL, m2 = NULL; |
---|
552 | |
---|
553 | // check that spoly creation is ok |
---|
554 | while (strat->tailRing != currRing && |
---|
555 | !kCheckSpolyCreation(&(strat->P), strat, m1, m2)) |
---|
556 | { |
---|
557 | assume(m1 == NULL && m2 == NULL); |
---|
558 | // if not, change to a ring where exponents are at least |
---|
559 | // large enough |
---|
560 | kStratChangeTailRing(strat); |
---|
561 | } |
---|
562 | // create the real one |
---|
563 | ksCreateSpoly(&(strat->P), NULL, strat->use_buckets, |
---|
564 | strat->tailRing, m1, m2, strat->R); |
---|
565 | } |
---|
566 | else if (strat->P.p1 == NULL) |
---|
567 | { |
---|
568 | if (strat->minim > 0) |
---|
569 | strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing); |
---|
570 | // for input polys, prepare reduction |
---|
571 | strat->P.PrepareRed(strat->use_buckets); |
---|
572 | } |
---|
573 | |
---|
574 | if (strat->P.p == NULL && strat->P.t_p == NULL) |
---|
575 | { |
---|
576 | red_result = 0; |
---|
577 | } |
---|
578 | else |
---|
579 | { |
---|
580 | if (TEST_OPT_PROT) |
---|
581 | message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(), |
---|
582 | &olddeg,&reduc,strat, red_result); |
---|
583 | |
---|
584 | /* reduction of the element choosen from L */ |
---|
585 | red_result = strat->red(&strat->P,strat); |
---|
586 | } |
---|
587 | |
---|
588 | // reduction to non-zero new poly |
---|
589 | if (red_result == 1) |
---|
590 | { |
---|
591 | /* statistic */ |
---|
592 | if (TEST_OPT_PROT) PrintS("s"); |
---|
593 | |
---|
594 | // get the polynomial (canonicalize bucket, make sure P.p is set) |
---|
595 | strat->P.GetP(strat->lmBin); |
---|
596 | |
---|
597 | int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart); |
---|
598 | |
---|
599 | // reduce the tail and normalize poly |
---|
600 | if (TEST_OPT_INTSTRATEGY) |
---|
601 | { |
---|
602 | strat->P.pCleardenom(); |
---|
603 | if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL)) |
---|
604 | { |
---|
605 | strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT); |
---|
606 | strat->P.pCleardenom(); |
---|
607 | } |
---|
608 | } |
---|
609 | else |
---|
610 | { |
---|
611 | strat->P.pNorm(); |
---|
612 | if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL)) |
---|
613 | strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT); |
---|
614 | } |
---|
615 | |
---|
616 | #ifdef KDEBUG |
---|
617 | if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();} |
---|
618 | #endif |
---|
619 | |
---|
620 | // min_std stuff |
---|
621 | if ((strat->P.p1==NULL) && (strat->minim>0)) |
---|
622 | { |
---|
623 | if (strat->minim==1) |
---|
624 | { |
---|
625 | strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing); |
---|
626 | p_Delete(&strat->P.p2, currRing, strat->tailRing); |
---|
627 | } |
---|
628 | else |
---|
629 | { |
---|
630 | strat->M->m[minimcnt]=strat->P.p2; |
---|
631 | strat->P.p2=NULL; |
---|
632 | } |
---|
633 | if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL) |
---|
634 | pNext(strat->M->m[minimcnt]) |
---|
635 | = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]), |
---|
636 | strat->tailRing, currRing, |
---|
637 | currRing->PolyBin); |
---|
638 | minimcnt++; |
---|
639 | } |
---|
640 | |
---|
641 | // enter into S, L, and T |
---|
642 | //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp)) |
---|
643 | enterT(strat->P, strat); |
---|
644 | enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl); |
---|
645 | // posInS only depends on the leading term |
---|
646 | if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp)) |
---|
647 | { |
---|
648 | strat->enterS(strat->P, pos, strat, strat->tl); |
---|
649 | } |
---|
650 | else |
---|
651 | { |
---|
652 | // strat->P.Delete(); // syzComp test: it is in T |
---|
653 | } |
---|
654 | if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat); |
---|
655 | // Print("[%d]",hilbeledeg); |
---|
656 | if (strat->P.lcm!=NULL) pLmFree(strat->P.lcm); |
---|
657 | if (strat->sl>srmax) srmax = strat->sl; |
---|
658 | } |
---|
659 | else if (strat->P.p1 == NULL && strat->minim > 0) |
---|
660 | { |
---|
661 | p_Delete(&strat->P.p2, currRing, strat->tailRing); |
---|
662 | } |
---|
663 | #ifdef KDEBUG |
---|
664 | memset(&(strat->P), 0, sizeof(strat->P)); |
---|
665 | #endif |
---|
666 | kTest_TS(strat); |
---|
667 | } |
---|
668 | #ifdef KDEBUG |
---|
669 | if (TEST_OPT_DEBUG) messageSets(strat); |
---|
670 | #endif |
---|
671 | /* complete reduction of the standard basis--------- */ |
---|
672 | if (TEST_OPT_SB_1) |
---|
673 | { |
---|
674 | int k=1; |
---|
675 | int j; |
---|
676 | while(k<=strat->sl) |
---|
677 | { |
---|
678 | j=0; |
---|
679 | loop |
---|
680 | { |
---|
681 | if (j>=k) break; |
---|
682 | clearS(strat->S[j],strat->sevS[j],&k,&j,strat); |
---|
683 | j++; |
---|
684 | } |
---|
685 | k++; |
---|
686 | } |
---|
687 | } |
---|
688 | |
---|
689 | if (TEST_OPT_REDSB) |
---|
690 | { |
---|
691 | completeReduce(strat); |
---|
692 | if (strat->completeReduce_retry) |
---|
693 | { |
---|
694 | // completeReduce needed larger exponents, retry |
---|
695 | // to reduce with S (instead of T) |
---|
696 | // and in currRing (instead of strat->tailRing) |
---|
697 | cleanT(strat);strat->tailRing=currRing; |
---|
698 | int i; |
---|
699 | for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1; |
---|
700 | completeReduce(strat); |
---|
701 | } |
---|
702 | } |
---|
703 | |
---|
704 | /* release temp data-------------------------------- */ |
---|
705 | exitBuchMora(strat); |
---|
706 | if (TEST_OPT_WEIGHTM) |
---|
707 | { |
---|
708 | pRestoreDegProcs(pFDegOld, pLDegOld); |
---|
709 | if (ecartWeights) |
---|
710 | { |
---|
711 | omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short)); |
---|
712 | ecartWeights=NULL; |
---|
713 | } |
---|
714 | } |
---|
715 | if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat); |
---|
716 | if (Q!=NULL) updateResult(strat->Shdl,Q,strat); |
---|
717 | return (strat->Shdl); |
---|
718 | } |
---|