1 /****************************************
2 * Computer Algebra System SINGULAR *
3 ****************************************/
4 /*
5 * ABSTRACT - Kernel: factorizing alg. of Buchberger
6 */
7
8 #include "kernel/mod2.h"
9 #include "misc/options.h"
10 #include "kernel/polys.h"
11 #include "kernel/ideals.h"
12 #include "kernel/GBEngine/kutil.h"
13 #include "kernel/GBEngine/kstd1.h"
14 #include "kernel/GBEngine/khstd.h"
15 #include "polys/weight.h"
16 #include "misc/intvec.h"
17 #include "polys/clapsing.h"
18 #include "kernel/ideals.h"
19 #include "kernel/GBEngine/kstdfac.h"
20
21 VAR int strat_nr=0;
22 /*3
23 * copy o->T to n->T, assumes that n->S is already copied
24 */
copyT(kStrategy o,kStrategy n)25 static void copyT (kStrategy o,kStrategy n)
26 {
27 int i,j;
28 poly p;
29 TSet t=(TSet)omAlloc0(o->tmax*sizeof(TObject));
30 TObject** r = (TObject**)omAlloc0(o->tmax*sizeof(TObject*));
31
32 for (j=0; j<=o->tl; j++)
33 {
34 t[j] = o->T[j];
35 r[t[j].i_r] = &t[j];
36 p = o->T[j].p;
37 i = -1;
38 loop
39 {
40 i++;
41 if (i>o->sl)
42 {
43 t[j].p=pCopy(p);
44 break;
45 }
46 if (p == o->S[i])
47 {
48 t[j].p=n->S[i];
49 break;
50 }
51 }
52 t[j].t_p = NULL; // ?? or t[j].p ??
53 t[j].max_exp = NULL; // ?? or p_GetMaxExpP(t[j].t_p,o->tailRing); ??
54 t[j].pLength = pLength(p);
55 }
56 n->T=t;
57 n->R=r;
58 }
59
60 /*3
61 * copy o->L to n->L, assumes that n->T,n->tail is already copied
62 */
copyL(kStrategy o,kStrategy n)63 static void copyL (kStrategy o,kStrategy n)
64 {
65 int i,j;
66 poly p;
67 LSet l=(LSet)omAlloc(o->Lmax*sizeof(LObject));
68
69 for (j=0; j<=o->Ll; j++)
70 {
71 l[j] = o->L[j];
72 // copy .p ----------------------------------------------
73 if (pNext(o->L[j].p)!=o->tail)
74 l[j].p=pCopy(o->L[j].p);
75 else
76 {
77 l[j].p=p_LmInit(o->L[j].p,currRing);
78 if (pGetCoeff(o->L[j].p)!=NULL) pSetCoeff0(l[j].p,nCopy(pGetCoeff(o->L[j].p)));
79 pNext(l[j].p)=n->tail;
80 }
81 // copy .lcm ----------------------------------------------
82 if (o->L[j].lcm!=NULL)
83 l[j].lcm=pLmInit(o->L[j].lcm);
84 else
85 l[j].lcm=NULL;
86 l[j].p1=NULL;
87 l[j].p2=NULL;
88 l[j].t_p = NULL;
89
90 // copy .p1 , i_r1----------------------------------------------
91 p = o->L[j].p1;
92 i = -1;
93 loop
94 {
95 if(p==NULL) break;
96 i++;
97 if(i>o->tl)
98 {
99 WarnS("poly p1 not found in T:");wrp(p);PrintLn();
100 l[j].p1=pCopy(p);
101 l[j].i_r1=-1;
102 break;
103 }
104 if (p == o->T[i].p)
105 {
106 l[j].p1=n->T[i].p;
107 l[j].i_r1=n->T[i].i_r;
108 break;
109 }
110 }
111
112 // copy .p2 , i_r2----------------------------------------------
113 p = o->L[j].p2;
114 i = -1;
115 loop
116 {
117 if(p==NULL) break;
118 i++;
119 if(i>o->tl)
120 {
121 WarnS("poly p2 not found in T:");wrp(p);PrintLn();
122 l[j].p2=pCopy(p);
123 l[j].i_r2=-1;
124 break;
125 }
126 if (p == o->T[i].p)
127 {
128 l[j].p2=n->T[i].p;
129 l[j].i_r2=n->T[i].i_r;
130 break;
131 }
132 }
133
134 // copy .ecart ---------------------------------------------
135 l[j].ecart=o->L[j].ecart;
136 // copy .length --------------------------------------------
137 l[j].length=o->L[j].length;
138 // copy .pLength -------------------------------------------
139 l[j].pLength=o->L[j].pLength;
140 // copy .sev -----------------------------------------------
141 l[j].sev=o->L[j].sev;
142 l[j].i_r = o->L[j].i_r;
143 //l[j].i_r1 = o->L[j].i_r1;
144 //l[j].i_r2 = o->L[j].i_r2;
145 }
146 n->L=l;
147 }
148
kStratCopy(kStrategy o)149 kStrategy kStratCopy(kStrategy o)
150 {
151 // int i;
152 kTest_TS(o);
153 kStrategy s=new skStrategy;
154 s->next=NULL;
155 s->red=o->red;
156 s->initEcart=o->initEcart;
157 s->posInT=o->posInT;
158 s->posInL=o->posInL;
159 s->enterS=o->enterS;
160 s->initEcartPair=o->initEcartPair;
161 s->posInLOld=o->posInLOld;
162 s->enterOnePair=o->enterOnePair;
163 s->chainCrit=o->chainCrit;
164 s->Shdl=idCopy(o->Shdl);
165 s->S=s->Shdl->m;
166 s->tailRing = o->tailRing;
167 if (o->D!=NULL) s->D=idCopy(o->D);
168 else s->D=NULL;
169 s->ecartS=(int *)omAlloc(IDELEMS(o->Shdl)*sizeof(int));
170 memcpy(s->ecartS,o->ecartS,IDELEMS(o->Shdl)*sizeof(int));
171 s->sevS=(unsigned long *)omAlloc(IDELEMS(o->Shdl)*sizeof(unsigned long));
172 memcpy(s->sevS,o->sevS,IDELEMS(o->Shdl)*sizeof(unsigned long));
173 s->S_2_R=(int*)omAlloc(IDELEMS(o->Shdl)*sizeof(int));
174 memcpy(s->S_2_R,o->S_2_R,IDELEMS(o->Shdl)*sizeof(int));
175 s->sevT=(unsigned long *)omAlloc(o->tmax*sizeof(unsigned long));
176 memcpy(s->sevT,o->sevT,o->tmax*sizeof(unsigned long));
177 if(o->fromQ!=NULL)
178 {
179 s->fromQ=(int *)omAlloc(IDELEMS(o->Shdl)*sizeof(int));
180 memcpy(s->fromQ,o->fromQ,IDELEMS(o->Shdl)*sizeof(int));
181 }
182 else
183 s->fromQ=NULL;
184 copyT(o,s);//s->T=...
185 s->tail = pInit();
186 copyL(o,s);//s->L=...
187 s->B=initL();
188 s->kHEdge=pCopy(o->kHEdge);
189 s->kNoether=pCopy(o->kNoether);
190 if (o->NotUsedAxis!=NULL)
191 {
192 s->NotUsedAxis=(BOOLEAN *)omAlloc(currRing->N*sizeof(BOOLEAN));
193 memcpy(s->NotUsedAxis,o->NotUsedAxis,currRing->N*sizeof(BOOLEAN));
194 }
195 //s->P=s->L[s->Ll+1];
196 s->P.Init(o->tailRing);
197 s->update=o->update;
198 s->posInLOldFlag=o->posInLOldFlag;
199 s->kModW = o->kModW;
200 // if (o->kModW!=NULL)
201 // s->kModW=ivCopy(o->kModW);
202 // else
203 // s->kModW=NULL;
204 s->pairtest=NULL;
205 s->sl=o->sl;
206 s->mu=o->mu;
207 s->tl=o->tl;
208 s->tmax=o->tmax;
209 s->Ll=o->Ll;
210 s->Lmax=o->Lmax;
211 s->Bl=-1;
212 s->Bmax=setmaxL;
213 s->ak=o->ak;
214 s->syzComp=o->syzComp;
215 s->LazyPass=o->LazyPass;
216 s->LazyDegree=o->LazyDegree;
217 s->HCord=o->HCord;
218 s->lastAxis=o->lastAxis;
219 s->interpt=o->interpt;
220 s->homog=o->homog;
221 s->news=o->news;
222 s->newt=o->newt;
223 s->kHEdgeFound=o->kHEdgeFound;
224 s->honey=o->honey;
225 s->sugarCrit=o->sugarCrit;
226 s->Gebauer=o->Gebauer;
227 s->noTailReduction=o->noTailReduction;
228 s->fromT=o->fromT;
229 s->noetherSet=o->noetherSet;
230 #ifdef HAVE_PLURAL
231 s->no_prod_crit=o->no_prod_crit;
232 #endif
233 kTest_TS(s);
234 return s;
235 }
236
k_factorize(poly p,ideal & rfac,ideal & fac_copy)237 BOOLEAN k_factorize(poly p,ideal &rfac, ideal &fac_copy)
238 {
239 int facdeg=currRing->pFDeg(p,currRing);
240 ideal fac=singclap_factorize(pCopy(p),NULL,1,currRing);
241 int fac_elems;
242 fac_elems=IDELEMS(fac);
243 rfac=fac;
244 fac_copy=idInit(fac_elems,1);
245
246 if ((fac_elems!=1)||(facdeg!=currRing->pFDeg(fac->m[0],currRing)))
247 {
248 if (TEST_OPT_DEBUG)
249 {
250 Print("%d factors:\n",fac_elems);
251 pWrite(p); PrintS(" ->\n");
252 int ii=fac_elems;
253 while(ii>0) { ii--;pWrite(fac->m[ii]); }
254 }
255 else if (TEST_OPT_PROT)
256 {
257 int ii=fac_elems;
258 if (ii>1)
259 {
260 while(ii>0) { PrintS("F"); ii--; }
261 }
262 }
263 return TRUE;
264 }
265 else
266 {
267 pDelete(&(fac->m[0]));
268 fac->m[0]=pCopy(p);
269 }
270 return FALSE;
271 }
272
completeReduceFac(kStrategy strat,ideal_list FL)273 static void completeReduceFac (kStrategy strat, ideal_list FL)
274 {
275 int si;
276
277 strat->noTailReduction = FALSE;
278 if (TEST_OPT_PROT)
279 {
280 PrintLn();
281 // if (timerv) writeTime("standard base computed:");
282 }
283 if (TEST_OPT_PROT)
284 {
285 Print("(S:%d)",strat->sl);mflush();
286 }
287 for (si=strat->sl; si>0; si--)
288 {
289 strat->S[si] = redtailBba(strat->S[si],si-1,strat);
290 if (TEST_OPT_INTSTRATEGY)
291 {
292 strat->S[si]=p_Cleardenom(strat->S[si], currRing);
293 }
294 if (TEST_OPT_PROT)
295 {
296 PrintS("-");mflush();
297 }
298 int i;
299 if (strat->redTailChange)
300 {
301 for(i=strat->tl;i>=0;i--)
302 {
303 strat->initEcart(&strat->T[i]);
304 }
305 }
306 ideal fac;
307 ideal fac_copy;
308
309 if (!k_factorize(strat->S[si],fac,fac_copy))
310 {
311 idDelete(&fac);
312 idDelete(&fac_copy);
313 continue;
314 }
315
316 deleteInS(si,strat);
317
318 for(i=IDELEMS(fac)-1;i>=0;i--)
319 {
320 kStrategy n=strat;
321 if (i>=1)
322 {
323 n=kStratCopy(strat); // includes: memset(&n->P,0,sizeof(n->P));
324 n->next=strat->next;
325 strat->next=n;
326 }
327 else
328 {
329 n->P.Init(strat->tailRing);
330 }
331
332 n->P.p=fac->m[i];
333 //n->P.pLength=pLength(n->P.p); // by initEcart
334 n->initEcart(&n->P);
335 /* enter P.p into s and L */
336 int pos;
337 if (n->sl==-1) pos=0;
338 else pos=posInS(n,n->sl,n->P.p,n->P.ecart);
339 if (TEST_OPT_INTSTRATEGY)
340 {
341 n->P.p = redtailBba(n->P.p,pos-1,n);
342 n->P.pCleardenom();
343 }
344 else
345 {
346 pNorm(n->P.p);
347 n->P.p = redtailBba(n->P.p,pos-1,n);
348 }
349 n->P.pLength=pLength(n->P.p);
350 if (TEST_OPT_DEBUG)
351 {
352 Print("new s(%d)->S:",n->nr);
353 pWrite(n->P.p);
354 }
355 enterpairs(n->P.p,n->sl,n->P.ecart,pos,n);
356 enterT(n->P,n);
357 n->enterS(n->P,pos,n, n->tl);
358
359 /* construct D */
360 if (IDELEMS(fac)>1)
361 {
362 if (n->D==NULL)
363 {
364 n->D=idCopy(fac_copy);
365 idSkipZeroes(n->D);
366 }
367 else
368 {
369 idTest(n->D);
370 ideal r=idAdd(n->D,fac_copy);
371 idDelete(&n->D);
372 n->D=r;
373 }
374 if (TEST_OPT_DEBUG)
375 {
376 Print("new s(%d)->D:\n",n->nr);
377 iiWriteMatrix((matrix)n->D,"D",1,currRing,0);
378 PrintLn();
379 }
380 }
381
382 fac_copy->m[i]=pCopy(fac->m[i]);
383 fac->m[i]=NULL;
384
385 /* check for empty sets */
386 if (n->D!=NULL)
387 {
388 int j=IDELEMS(n->D)-1;
389 while(j>=0)
390 {
391 if (n->D->m[j]!=NULL)
392 {
393 poly r=kNF(n->Shdl,NULL,n->D->m[j],0,KSTD_NF_LAZY | KSTD_NF_NONORM);
394 if (r==NULL)
395 {
396 if (TEST_OPT_DEBUG)
397 {
398 Print("empty set s(%d) because D[%d]:",n->nr,j);
399 pWrite(n->D->m[j]);
400 messageSets(n);
401 }
402 while (n->Ll >= 0) deleteInL(n->L,&n->Ll,n->Ll,n);
403 while (n->tl >= 0)
404 {
405 int i=n->sl;
406 while (i>=0)
407 {
408 if (n->S[i]==n->T[n->tl].p)
409 {
410 n->T[n->tl].p=NULL; n->S[i]=NULL;
411 break;
412 }
413 i--;
414 }
415 pDelete(&n->T[n->tl].p);
416 n->tl--;
417 }
418 memset(n->Shdl->m,0,IDELEMS(n->Shdl)*sizeof(poly));
419 n->sl=-1;
420 if (strat==n) si=-1;
421 break;
422 }
423 else
424 {
425 pDelete(&r);
426 }
427 }
428 j--;
429 }
430 }
431 /* check for empty sets */
432 {
433 ideal_list Lj=FL;
434 while (Lj!=NULL)
435 {
436 if ((n->sl>=0)&&(n->S[0]!=NULL))
437 {
438 ideal r=kNF(n->Shdl,NULL,Lj->d,0,KSTD_NF_LAZY | KSTD_NF_NONORM);
439 if (idIs0(r))
440 {
441 if (TEST_OPT_DEBUG)
442 {
443 Print("empty set because:L[%p]\n",(void *)Lj);
444 iiWriteMatrix((matrix)Lj->d,"L",1,currRing,0);
445 }
446 while (n->Ll >= 0) deleteInL(n->L,&n->Ll,n->Ll,n);
447 while (n->tl >= 0)
448 {
449 int i=n->sl;
450 while (i>=0)
451 {
452 if (n->S[i]==n->T[n->tl].p)
453 {
454 n->T[n->tl].p=NULL; n->S[i]=NULL;
455 break;
456 }
457 i--;
458 }
459 pDelete(&n->T[n->tl].p);
460 n->tl--;
461 }
462 memset(n->Shdl->m,0,IDELEMS(n->Shdl)*sizeof(poly));
463 n->sl=-1;
464 if (strat==n) si=-1;
465 idDelete(&r);
466 break;
467 }
468 idDelete(&r);
469 }
470 Lj=Lj->next;
471 }
472 }
473 } /* for */
474 for(i=0;i<IDELEMS(fac);i++) fac->m[i]=NULL;
475 idDelete(&fac);
476 idDelete(&fac_copy);
477 if ((strat->Ll>=0) && (strat->sl>=0)) break;
478 else si=strat->sl+1;
479 }
480 }
481
bbafac(ideal,ideal Q,intvec *,kStrategy strat,ideal_list FL)482 ideal bbafac (ideal /*F*/, ideal Q,intvec */*w*/,kStrategy strat, ideal_list FL)
483 {
484 int olddeg,reduc=0;
485 int red_result = 1;
486 reduc = olddeg = 0;
487 /* compute------------------------------------------------------- */
488 if ((strat->Ll==-1) && (strat->sl>=0))
489 {
490 if (TEST_OPT_REDSB) completeReduceFac(strat,FL);
491 }
492 kTest_TS(strat);
493 while (strat->Ll >= 0)
494 {
495 if (TEST_OPT_DEBUG) messageSets(strat);
496 if (strat->Ll== 0) strat->interpt=TRUE;
497 if (TEST_OPT_DEGBOUND
498 && ((strat->honey
499 && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
500 || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
501 {
502 /*
503 *stops computation if
504 * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
505 *a predefined number Kstd1_deg
506 */
507 while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
508 break;
509 }
510 /* picks the last element from the lazyset L */
511 strat->P = strat->L[strat->Ll];
512 strat->Ll--;
513 if (pNext(strat->P.p) == strat->tail)
514 {
515 /* deletes the short spoly and computes */
516 pLmFree(strat->P.p);
517 /* the real one */
518 strat->P.p = ksOldCreateSpoly(strat->P.p1,
519 strat->P.p2,
520 strat->kNoether);
521 }
522 if (strat->honey)
523 {
524 if (TEST_OPT_PROT)
525 message(strat->P.ecart+currRing->pFDeg(strat->P.p,currRing),&olddeg,&reduc,strat, red_result);
526 }
527 else
528 {
529 if (TEST_OPT_PROT)
530 message(currRing->pFDeg(strat->P.p,currRing),&olddeg,&reduc,strat, red_result);
531 }
532 /* reduction of the element chosen from L */
533 kTest_TS(strat);
534 red_result = strat->red(&strat->P,strat);
535 if (strat->P.p != NULL)
536 {
537 /* statistic */
538 if (TEST_OPT_PROT) PrintS("s");
539 ideal fac;
540 ideal fac_copy;
541
542 if (!k_factorize(strat->P.p,fac,fac_copy))
543 {
544 if (TEST_OPT_INTSTRATEGY)
545 {
546 strat->P.p = redtailBba(strat->P.p,strat->sl,strat);
547 if (strat->redTailChange) strat->P.pCleardenom();
548 }
549 else
550 {
551 pNorm(strat->P.p);
552 strat->P.p = redtailBba(strat->P.p,strat->sl,strat);
553 }
554 if (strat->redTailChange)
555 {
556 idDelete(&fac);
557 idDelete(&fac_copy);
558 if (!k_factorize(strat->P.p,fac,fac_copy))
559 {
560 pDelete(&(fac->m[0]));
561 fac->m[0]=strat->P.p;
562 strat->P.p=NULL;
563 }
564 else
565 {
566 pDelete(&strat->P.p);
567 }
568 }
569 }
570 kDeleteLcm(&strat->P);
571 int i;
572
573 for(i=IDELEMS(fac)-1;i>=0;i--)
574 {
575 int ii;
576 kStrategy n=strat;
577 if (i>=1)
578 {
579 n=kStratCopy(strat); // includes memset(&n->P,0,sizeof(n->P));
580 kTest_TS(n);
581 n->next=strat->next;
582 strat->next=n;
583 }
584 else
585 {
586 n->P.Init(strat->tailRing);
587 }
588
589 n->P.p=fac->m[i];
590 //n->P.pLength=pLength(n->P.p); // by initEcart
591 n->initEcart(&n->P);
592 kTest_TS(n);
593
594 /* enter P.p into s and L */
595 int pos;
596 if (n->sl==-1) pos=0;
597 else pos=posInS(n,n->sl,n->P.p,n->P.ecart);
598
599 // we have already reduced all elements from fac....
600 if (TEST_OPT_INTSTRATEGY)
601 {
602 n->P.p = redtailBba(n->P.p,pos-1,n);
603 if (n->redTailChange)
604 {
605 n->P.pCleardenom();
606 n->P.pLength=pLength(n->P.p);
607 }
608 }
609 else
610 {
611 pNorm(n->P.p);
612 n->P.p = redtailBba(n->P.p,pos-1,n);
613 if (n->redTailChange)
614 {
615 n->P.pLength=pLength(n->P.p);
616 }
617 }
618 kTest_TS(n);
619
620 if (TEST_OPT_DEBUG)
621 {
622 PrintS("new s:");
623 wrp(n->P.p);
624 PrintLn();
625 }
626 enterpairs(n->P.p,n->sl,n->P.ecart,pos,n);
627 enterT(n->P,n);
628 n->enterS(n->P,pos,n, n->tl);
629 {
630 int i=n->Ll;
631 for(;i>=0;i--)
632 {
633 n->L[i].i_r1= -1;
634 for(ii=0; ii<=n->tl; ii++)
635 {
636 if (n->R[ii]->p==n->L[i].p1) { n->L[i].i_r1=ii;break; }
637 }
638 n->L[i].i_r2= -1;
639 for(ii=0; ii<=n->tl; ii++)
640 {
641 if (n->R[ii]->p==n->L[i].p2) { n->L[i].i_r2=ii;break; }
642 }
643 }
644 }
645 kTest_TS(n);
646 /* construct D */
647 if (IDELEMS(fac)>1)
648 {
649 if (n->D==NULL)
650 {
651 n->D=idCopy(fac_copy);
652 idSkipZeroes(n->D);
653 }
654 else
655 {
656 idTest(n->D);
657 ideal r=idAdd(n->D,fac_copy);
658 idDelete(&n->D);
659 n->D=r;
660 }
661 if (TEST_OPT_DEBUG)
662 {
663 PrintS("new D:\n");
664 iiWriteMatrix((matrix)n->D,"D",1,currRing,0);
665 PrintLn();
666 }
667 }
668
669 fac_copy->m[i]=pCopy(fac->m[i]);
670 fac->m[i]=NULL;
671
672 /* check for empty sets */
673 if (n->D!=NULL)
674 {
675 int j=IDELEMS(n->D)-1;
676 while(j>=0)
677 {
678 if (n->D->m[j]!=NULL)
679 {
680 poly r=kNF(n->Shdl,NULL,n->D->m[j],0,KSTD_NF_LAZY | KSTD_NF_NONORM);
681 if (r==NULL)
682 {
683 if (TEST_OPT_DEBUG)
684 {
685 Print("empty set s(%d) because: D[%d]:", n->nr,j);
686 pWrite(n->D->m[j]);
687 messageSets(n);
688 }
689 //if (n->Ll >=0) Print("Ll:%d|",n->Ll);
690 while (n->Ll >= 0) deleteInL(n->L,&n->Ll,n->Ll,n);
691 //if (n->tl >=0) Print("tl:%d|",n->tl);
692 while (n->tl >= 0)
693 {
694 int i=n->sl;
695 while (i>=0)
696 {
697 if (n->S[i]==n->T[n->tl].p)
698 {
699 n->T[n->tl].p=NULL; n->S[i]=NULL;
700 break;
701 }
702 i--;
703 }
704 pDelete(&n->T[n->tl].p);
705 n->tl--;
706 }
707 memset(n->Shdl->m,0,IDELEMS(n->Shdl)*sizeof(poly));
708 n->sl=-1;
709 break;
710 }
711 else
712 {
713 pDelete(&r);
714 }
715 }
716 j--;
717 }
718 }
719
720 /* check for empty sets */
721 {
722 ideal_list Lj=FL;
723 while (Lj!=NULL)
724 {
725 if ((n->sl>=0)&&(n->S[0]!=NULL))
726 {
727 ideal r=kNF(n->Shdl,NULL,Lj->d,0,KSTD_NF_LAZY | KSTD_NF_NONORM);
728 if (idIs0(r))
729 {
730 if (TEST_OPT_DEBUG)
731 {
732 #ifdef KDEBUG
733 Print("empty set s(%d) because:L[%d]\n",n->nr,Lj->nr);
734 #else
735 Print("empty set s(%d) because:\n",n->nr);
736 #endif
737 iiWriteMatrix((matrix)Lj->d,"L",1,currRing,0);
738 }
739 while (n->Ll >= 0) deleteInL(n->L,&n->Ll,n->Ll,n);
740 while (n->tl >= 0)
741 {
742 int i=n->sl;
743 while (i>=0)
744 {
745 if (n->S[i]==n->T[n->tl].p)
746 {
747 n->T[n->tl].p=NULL; n->S[i]=NULL;
748 break;
749 }
750 i--;
751 }
752 pDelete(&n->T[n->tl].p);
753 n->tl--;
754 }
755 memset(n->Shdl->m,0,IDELEMS(n->Shdl)*sizeof(poly));
756 n->sl=-1;
757 idDelete(&r);
758 break;
759 }
760 idDelete(&r);
761 }
762 Lj=Lj->next;
763 }
764 }
765 } /* for */
766 for(i=0;i<IDELEMS(fac);i++) fac->m[i]=NULL;
767 idDelete(&fac);
768 idDelete(&fac_copy);
769 }
770 #ifdef KDEBUG
771 strat->P.lcm=NULL;
772 #endif
773 kTest_TS(strat);
774 if ((strat->Ll==-1) && (strat->sl>=0))
775 {
776 if (TEST_OPT_REDSB) completeReduceFac(strat,FL);
777 }
778 kTest_TS(strat);
779 }
780 #ifdef KDEBUG
781 if (TEST_OPT_DEBUG) messageSets(strat);
782 #endif
783 /* complete reduction of the standard basis--------- */
784 /* release temp data-------------------------------- */
785 if (TEST_OPT_WEIGHTM)
786 {
787 pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
788 if (ecartWeights)
789 {
790 omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
791 ecartWeights=NULL;
792 }
793 }
794 exitBuchMora(strat);
795 if (TEST_OPT_PROT) { PrintLn(); messageStat(0,strat); }
796 if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
797 return (strat->Shdl);
798 }
799
kStdfac(ideal F,ideal Q,tHomog h,intvec ** w,ideal D)800 ideal_list kStdfac(ideal F, ideal Q, tHomog h,intvec ** w,ideal D)
801 {
802 ideal r;
803 BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
804 BOOLEAN delete_w=(w==NULL);
805 kStrategy strat=new skStrategy;
806 kStrategy orgstrat=strat;
807 ideal_list L=NULL;
808
809 if (rField_has_simple_inverse(currRing))
810 strat->LazyPass=20;
811 else
812 strat->LazyPass=2;
813 strat->LazyDegree = 1;
814 strat->ak = id_RankFreeModule(F,currRing);
815 if (h==testHomog)
816 {
817 if (strat->ak==0)
818 {
819 h = (tHomog)idHomIdeal(F,Q);
820 w=NULL;
821 }
822 else
823 h = (tHomog)idHomModule(F,Q,w);
824 }
825 if (h==isHomog)
826 {
827 if ((w!=NULL) && (*w!=NULL))
828 {
829 kModW = *w;
830 strat->kModW = *w;
831 strat->pOrigFDeg = currRing->pFDeg;
832 strat->pOrigLDeg = currRing->pLDeg;
833 pSetDegProcs(currRing,kModDeg);
834 toReset = TRUE;
835 }
836 currRing->pLexOrder = TRUE;
837 strat->LazyPass*=2;
838 }
839 strat->homog=h;
840 initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
841 initBuchMoraPos(strat);
842 initBba(strat);
843 initBuchMora(F, Q,strat);
844 if (D!=NULL)
845 {
846 strat->D=idCopy(D);
847 }
848 // Ende der Initalisierung
849 while (strat!=NULL)
850 {
851 if (TEST_OPT_DEBUG)
852 PrintS("====================================\n");
853 if (w!=NULL)
854 r=bbafac(F,Q,*w,strat,L);
855 else
856 r=bbafac(F,Q,NULL,strat,L);
857 #ifdef KDEBUG
858 int i;
859 for (i=0; i<IDELEMS(r); i++) pTest(r->m[i]);
860 #endif
861 idSkipZeroes(r);
862 // Testausgabe:
863 //if (!idIs0(r))
864 //{
865 // PrintS("===================================================\n");
866 // iiWriteMatrix((matrix)r,"S",1,currRing,0);
867 // PrintS("\n===================================================\n");
868 //}
869 //else
870 //{
871 // PrintS("=========empty============================\n");
872 //}
873 if(!idIs0(r))
874 {
875 ideal_list LL=(ideal_list)omAlloc(sizeof(*LL));
876 LL->d=r;
877 #ifndef SING_NDEBUG
878 LL->nr=strat->nr;
879 #endif
880 LL->next=L;
881 L=LL;
882 }
883 strat=strat->next;
884 }
885 /* check for empty sets */
886 if (L!=NULL)
887 {
888 ideal_list Lj=L->next;
889 ideal_list Lj_prev=L;
890 while (Lj!=NULL)
891 {
892 ideal_list Li=L;
893 while(Li!=Lj)
894 {
895 ideal r=kNF(Lj->d,NULL,Li->d,0,KSTD_NF_LAZY | KSTD_NF_NONORM);
896 if (idIs0(r))
897 {
898 #ifdef KDEBUG
899 if (TEST_OPT_DEBUG)
900 {
901 Print("empty set L[%p] because:L[%p]\n",(void*)Lj,(void*)Li);
902 }
903 #endif
904 // delete L[j],
905 Li=L;
906 if (Lj_prev!=NULL)
907 {
908 Lj=Lj_prev;
909 if (Lj==L) Lj_prev=NULL;
910 else
911 {
912 Lj_prev=L;
913 while(Lj_prev->next!=Lj) Lj_prev=Lj_prev->next;
914 }
915 }
916 else Lj=NULL;
917 }
918 else
919 {
920 Li=Li->next;
921 }
922 idDelete (&r);
923 }
924 if (Lj!=NULL) Lj=Lj->next;
925 }
926 }
927 // Ende: aufraeumen
928 if (toReset)
929 {
930 pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
931 kModW = NULL;
932 }
933 currRing->pLexOrder = b;
934 delete(strat);
935 strat=orgstrat;
936 while (strat!=NULL)
937 {
938 orgstrat=strat->next;
939 delete(strat);
940 strat=orgstrat;
941 }
942 if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
943 return L;
944 }
945