![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to new_pd.rr CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / asir-contrib / testing / noro|
Return to new_pd.rr CVS log | Up to [local] / OpenXM / src / asir-contrib / testing / noro |
1.1 noro 1: /* $OpenXM$ */
2: import("gr")$
3: module noro_pd$
4: static GBCheck,F4,EProcs,Procs,SatHomo,GBRat$
5:
6: localf get_lc,tomonic$
7: localf para_exec,nd_gr_rat,competitive_exec,call_func$
8: localf call_ideal_list_intersection$
9: localf first_second$
10: localf third$
11: localf locsat,iso_comp_para,extract_qj,colon_prime_dec,extract_comp$
12: localf colon_prime_dec1$
13: localf separator$
14: localf member,mingen,compute_gbsyz,redcoef,recompute_trace3,dtop,topnum$
15: localf ideal_colon1$
16: localf prepost$
17: localf monodec0,monodec,prod$
18: localf extract_qd,primary_check$
19: localf second$
20: localf gbrat,comp_third_tdeg,comp_tord$
21: localf power$
22:
23: localf syci_dec, syc_dec$
24: localf syca_dec,syc0_dec$
25:
26: localf find_si0,find_si1,find_si2$
27: localf find_ssi0,find_ssi1,find_ssi2$
28:
29: localf init_pprocs, init_eprocs, init_procs, kill_procs$
30:
31: localf sy_dec, pseudo_dec, iso_comp, prima_dec$
32:
33: localf prime_dec, prime_dec_main, lex_predec1, zprimedec, zprimadec$
34: localf complete_qdecomp, partial_qdecomp, partial_qdecomp0, complete_decomp$
35: localf partial_decomp, partial_decomp0, zprimacomp, zprimecomp$
36: localf fast_gb, incremental_gb, elim_gb, ldim, make_mod_subst$
37: localf rsgn, find_npos, gen_minipoly, indepset$
38: localf maxindep, contraction, ideal_list_intersection, ideal_intersection$
39: localf radical_membership, modular_radical_membership$
40: localf radical_membership_rep, ideal_product, saturation$
41: localf sat, satind, sat_ind, colon$
42: localf ideal_colon, ideal_sat, ideal_inclusion, qd_simp_comp, qd_remove_redundant_comp$
43: localf pd_simp_comp$
44: localf pd_remove_redundant_comp, ppart, sq, gen_fctr, gen_nf, gen_gb_comp$
45: localf gen_mptop, lcfactor, compute_deg0, compute_deg, member$
46: localf elimination, setintersection, setminus, sep_list$
47: localf first, comp_tdeg, comp_tdeg_first, tdeg, comp_by_ord, comp_by_second$
48: localf gbcheck,f4,sathomo,qd_check,qdb_check$
49:
50: SatHomo=0$
51: GBCheck=1$
52: GBRat=0$
53:
54: #define MAX(a,b) ((a)>(b)?(a):(b))
55: #define ACCUM_TIME(C,R) {T1 = time(); C += (T1[0]-T0[0])+(T1[1]-T0[1]); R += (T1[3]-T0[3]); }
56:
57: def gbrat(A)
58: {
59: if ( A ) GBRat = 1;
60: else GBRat = 0;
61: }
62:
63: def gbcheck(A)
64: {
65: if ( A ) GBCheck = 1;
66: else GBCheck = -1;
67: }
68:
69: def f4(A)
70: {
71: if ( A ) F4 = 1;
72: else F4 = 0;
73: }
74:
75: def sathomo(A)
76: {
77: if ( A ) SatHomo = 1;
78: else SatHomo = 0;
79: }
80:
81: def init_eprocs()
82: {
83: if ( type(NoX=getopt(nox)) == -1 ) NoX = 0;
84: if ( !EProcs ) {
85: if ( NoX ) {
86: P0 = ox_launch_nox();
87: P1 = ox_launch_nox();
88: } else {
89: P0 = ox_launch();
90: P1 = ox_launch();
91: }
92: EProcs = [P0,P1];
93: }
94: }
95:
96: def init_pprocs(N)
97: {
98: if ( type(NoX=getopt(nox)) == -1 ) NoX = 0;
99: for ( R = [], I = 0; I < N; I++ ) {
100: P = NoX ? ox_launch_nox() : ox_launch();
101: R = cons(P,R);
102: }
103: return reverse(R);
104: }
105:
106: def init_procs()
107: {
108: if ( type(NoX=getopt(nox)) == -1 ) NoX = 0;
109: if ( !Procs ) {
110: if ( NoX ) {
111: P0 = ox_launch_nox();
112: P1 = ox_launch_nox();
113: } else {
114: P0 = ox_launch();
115: P1 = ox_launch();
116: }
117: Procs = [P0,P1];
118: }
119: }
120:
121: def kill_procs()
122: {
123: if ( Procs ) {
124: ox_shutdown(Procs[0]);
125: ox_shutdown(Procs[1]);
126: Procs = 0;
127: }
128: if ( EProcs ) {
129: ox_shutdown(EProcs[0]);
130: ox_shutdown(EProcs[1]);
131: EProcs = 0;
132: }
133: }
134:
135: def qd_check(B,V,QD)
136: {
137: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
138: G = nd_gr(B,V,Mod,0);
139: Iso = ideal_list_intersection(map(first,QD[0]),V,0|mod=Mod);
140: Emb = ideal_list_intersection(map(first,QD[1]),V,0|mod=Mod);
141: GG = ideal_intersection(Iso,Emb,V,0|mod=Mod);
142: return gen_gb_comp(G,GG,Mod);
143: }
144:
145: def primary_check(B,V)
146: {
147: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
148: G = nd_gr(B,V,Mod,0);
149: PL = prime_dec(G,V|indep=1,mod=Mod);
150: if ( length(PL) > 1 ) return 0;
151: P = PL[0][0]; Y = PL[0][1];
152: Z = setminus(V,Y);
153: H = elim_gb(G,Z,Y,Mod,[[0,length(Z)],[0,length(Y)]]);
154: H = contraction(H,Z|mod=Mod);
155: H = nd_gr(H,V,Mod,0);
156: if ( gen_gb_comp(G,H,Mod) ) return nd_gr(P,V,Mod,0);
157: else return 0;
158: }
159:
160: def qdb_check(B,V,QD)
161: {
162: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
163: G = nd_gr(B,V,Mod,0);
164: N = length(QD);
165: for ( I = 0, Q = [1]; I < N; I++ )
166: for ( J = 0, QL = map(first,QD[I]), L = length(QL);
167: J < L; J++ )
168: Q = ideal_intersection(Q,QL[J],V,0|mod=Mod);
169: if ( !gen_gb_comp(G,Q,Mod) )
170: return 0;
171: for ( I = 0; I < N; I++ ) {
172: T = QD[I];
173: M = length(T);
174: for ( J = 0; J < M; J++ ) {
175: P = primary_check(T[J][0],V|mod=Mod);
176: if ( !P ) return 0;
177: PP = nd_gr(T[J][1],V,Mod,0);
178: if ( !gen_gb_comp(P,PP,Mod) ) return 0;
179: }
180: }
181: return 1;
182: }
183:
184: def extract_qd(QD,V,Ind)
185: {
186: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
187: N = length(Ind);
188: for ( I = 0, Q = [1]; I < N; I++ )
189: for ( J = 0, QL = map(first,QD[Ind[I]]), L = length(QL);
190: J < L; J++ )
191: Q = ideal_intersection(Q,QL[J],V,0|mod=Mod);
192: return Q;
193: }
194:
195: /* SYC primary decomositions */
196:
197: def syc_dec(B,V)
198: {
199: if ( type(SI=getopt(si)) == -1 ) SI = 2;
200: SIFList=[find_ssi0, find_ssi1,find_ssi2];
201: if ( SI<0 || SI>2 ) error("sycb_dec : si should be 0,1,2");
202: SIF = SIFList[SI];
203:
204: if ( type(MaxLevel=getopt(level)) == -1 ) MaxLevel = -1;
205: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
206: if ( type(Lexdec=getopt(lexdec)) == -1 ) Lexdec = 0;
207: if ( type(Time=getopt(time)) == -1 ) Time = 0;
208: if ( type(Iso=getopt(iso)) == -1 ) Iso = 0;
209: if ( type(Colon=getopt(colon)) == -1 ) Colon = 1;
210: Ord = 0;
211: Tall = time();
212: C = Gt = G = fast_gb(B,V,Mod,Ord|trace=1);
213: Q = []; IntQ = [1]; First = 1;
214: Tpd = Tiso = Tsep = 0;
215: RTpd = RTiso = RTsep = 0;
216: for ( Level = 0; MaxLevel < 0 || Level <= MaxLevel; Level++ ) {
217: if ( type(Gt[0])==1 ) break;
218: T3 = T2 = T1 = T0 = time();
219: if ( First ) {
220: PtR = prime_dec(C,V|indep=1,lexdec=Lexdec,mod=Mod,radical=1);
221: Pt = PtR[0]; IntPt = PtR[1];
222: if ( gen_gb_comp(Gt,IntPt,Mod) ) {
223: /* Gt is radical and Gt = cap Pt */
224: for ( T = Pt, Qt = []; T != []; T = cdr(T) )
225: Qt = cons([car(T)[0],car(T)[0]],Qt);
226: return append(Q,[Qt]);
227: }
228: }
229: T1 = time(); Tpd += (T1[0]-T0[0])+(T1[1]-T0[1]); RTpd += (T1[3]-T0[3]);
230: Qt = iso_comp(Gt,Pt,V,Ord|mod=Mod,first=First,iso=Iso);
231: Q = append(Q,[Qt]);
232: for ( T = Qt; T != []; T = cdr(T) )
233: IntQ = ideal_intersection(IntQ,car(T)[0],V,Ord
234: |mod=Mod,
235: gbblock=[[0,length(IntQ)],[length(IntQ),length(car(T)[0])]]);
236: if ( First ) { IntP = IntPt; First = 0; }
237: if ( gen_gb_comp(IntQ,G,Mod) ) break;
238:
239: M = mingen(IntQ,V);
240: for ( Pt = [], C = [1], T = M; T != []; T = cdr(T) ) {
241: Ci = colon(G,car(T),V|isgb=1);
242: if ( type(Ci[0]) != 1 ) {
243: Pi = prime_dec(Ci,V|indep=1,lexdec=Lexdec,radical=1,mod=Mod);
244: C = ideal_intersection(C,Pi[1],V,Ord);
245: Pt = append(Pt,Pi[0]);
246: }
247: }
248: Pt = pd_simp_comp(Pt,V|first=1,mod=Mod);
249: if ( Colon ) C = ideal_colon(G,IntQ,V|mod=Mod);
250: T2 = time(); Tiso += (T2[0]-T1[0])+(T2[1]-T1[1]); RTiso += (T2[3]-T1[3]);
251: Ok = (*SIF)(C,G,IntQ,IntP,V,Ord|mod=Mod);
252: Gt = append(Ok,G);
253: T3 = time(); Tsep += (T3[0]-T2[0])+(T3[1]-T2[1]); RTsep += (T3[3]-T2[3]);
254: }
255: T4 = time(); RTall = (T4[3]-Tall[3]); Tall = (T4[0]-Tall[0])+(T3[1]-Tall[1]);
256: if ( Time ) {
257: print(["cpu","total",Tall,"pd",Tpd,"iso",Tiso,"sep",Tsep]);
258: print(["elapsed","total",RTall,"pd",RTpd,"iso",RTiso,"sep",RTsep]);
259: }
260: return Q;
261: }
262:
263: static Tint2, RTint2$
264:
265: def syci_dec(B,V)
266: {
267: if ( type(SI=getopt(si)) == -1 ) SI = 1;
268: if ( SI<0 || SI>2 ) error("sycb_assdec : si should be 0,1,2");
269: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
270: if ( type(Lexdec=getopt(lexdec)) == -1 ) Lexdec = 0;
271: if ( type(Time=getopt(time)) == -1 ) Time = 0;
272: if ( type(Iso=getopt(iso)) == -1 ) Iso = 0;
273: if ( type(Ass=getopt(ass)) == -1 ) Ass = 0;
274: if ( type(Colon=getopt(colon)) == -1 ) Colon = 0;
275: if ( type(Para=getopt(para)) == -1 ) Para = 0;
276: Ord = 0;
277: Tiso = Tint = Tpd = Text = Tint2 = 0;
278: RTiso = RTint = RTpd = RText = RTint2 = 0;
279: T00 = time();
280: G = fast_gb(B,V,Mod,Ord|trace=1);
281: IntQ = [1]; QL = RL = []; First = 1;
282: for ( Level = 0; ; Level++ ) {
283: T0 = time();
284: if ( First ) {
285: PtR = prime_dec(G,V|indep=1,lexdec=Lexdec,mod=Mod,radical=1);
286: Pt = PtR[0]; IntPt = PtR[1]; Rad = IntPt;
1.2 ! noro 287: if ( gen_gb_comp(G,Rad,Mod) ) {
! 288: /* Gt is radical and Gt = cap Pt */
! 289: for ( T = Pt, Qt = []; T != []; T = cdr(T) )
! 290: Qt = cons([car(T)[0],car(T)[0],car(T)[1]],Qt);
! 291: return [reverse(Qt)];
! 292: }
1.1 noro 293: } else
294: Pt = colon_prime_dec(G,IntQ,V|lexdec=Lexdec,mod=Mod,para=Para);
295: ACCUM_TIME(Tpd,RTpd)
296: T0 = time();
297: Rt = iso_comp(G,Pt,V,Ord|mod=Mod,iso=Iso,para=Para,intq=IntQ);
298: RL = append(RL,[Rt]);
299: ACCUM_TIME(Tiso,RTiso)
300: T0 = time();
301: IntQ = ideal_list_intersection(map(first,Rt),V,Ord|mod=Mod,para=Para);
302: QL = append(QL,[IntQ]);
303: ACCUM_TIME(Tint,RTint)
304: if ( gen_gb_comp(IntQ,G,Mod) ) break;
305: First = 0;
306: }
307: T0 = time();
308: if ( !Ass )
309: RL = extract_comp(QL,RL,V,Rad|mod=Mod,para=Para,si=SI,colon=Colon,ass=Ass);
310: ACCUM_TIME(Text,RText)
311: if ( Time ) {
312: T1 = time();
313: Tall = T1[0]-T00[0]+T1[1]-T00[1]; RTall += T1[3]-T00[3];
314: Tass = Tall-Text; RTass = RTall-RText;
315: print(["total",Tall,"ass",Tass,"pd",Tpd,"iso",Tiso,"int",Tint,"ext",Text]);
316: print(["elapsed",RTall,"ass",RTass,"pd",RTpd,"iso",RTiso,"int",RTint,"ext",RText]);
317: }
318: return RL;
319: }
320:
321: def extract_comp(QL,RL,V,Rad) {
322: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
323: if ( type(Para=getopt(para)) == -1 ) Para = 0;
324: if ( type(Colon=getopt(colon)) == -1 ) Colon = 0;
325: if ( type(SI=getopt(si)) == -1 ) SI = 1;
326: if ( type(Ass=getopt(ass)) == -1 ) Ass = 0;
327:
328: L = length(QL);
329: if ( Para ) {
330: for ( Task = [], I = 1; I < L; I++ ) {
331: QI = QL[I-1]; RI = RL[I]; NI = length(RI);
332: for ( J = 0, TI = []; J < NI; J++ ) {
333: T = ["noro_pd.extract_qj",QI,V,RI[J],Rad,Mod,SI,Colon,I];
334: Task = cons(T,Task);
335: }
336: }
337: print("comps:",2); print(length(Task),2); print("");
338: R = para_exec(Para,Task);
339: S = vector(L);
340: for ( I = 1; I < L; I++ ) S[I] = [];
341: S[0] = RL[0];
342: for ( T = R; T != []; T = cdr(T) ) {
343: U = car(T); Level = U[0]; Body = U[1];
344: S[Level] = cons(Body,S[Level]);
345: }
346: return vtol(S);
347: } else {
348: TL = [RL[0]];
349: for ( I = 1; I < L; I++ ) {
350: print("level:",2); print(I,2);
351: print(" comps:",2); print(length(RL[I]),2); print("");
352: QI = QL[I-1]; RI = RL[I]; NI = length(RI);
353: for ( J = 0, TI = []; J < NI; J++ ) {
354: TIJ = extract_qj(QI,V,RI[J],Rad,Mod,SI,Colon,-1);
355: TI = cons(TIJ,TI);
356: }
357: TI = reverse(TI); TL = cons(TI,TL);
358: }
359: TL = reverse(TL);
360: }
361: return TL;
362: }
363:
364: def colon_prime_dec(G,IntQ,V) {
365: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
366: if ( type(Lexdec=getopt(lexdec)) == -1 ) Lexdec = 0;
367: if ( type(Para=getopt(para)) == -1 ) Para = 0;
368: if ( !Mod ) M = mingen(IntQ,V);
369: else M = IntQ;
370: if ( Para ) {
371: L = length(M);
372: for ( Task = [], J = 0, RI = []; J < L; J++ )
373: if ( gen_nf(M[J],G,V,Ord,Mod) ) {
374: T = ["noro_pd.colon_prime_dec1",G,M[J],Mod,V];
375: Task = cons(T,Task);
376: }
377: Task = reverse(Task);
378: R = para_exec(Para,Task);
379: for ( Pt = [], T = R; T != []; T = cdr(T) ) Pt = append(Pt,car(T));
380: } else {
381: for ( Pt = [], T = M; T != []; T = cdr(T) ) {
382: Pi = colon_prime_dec1(G,car(T),Mod,V);
383: Pt = append(Pt,Pi);
384: }
385: }
386: Pt = pd_simp_comp(Pt,V|first=1,mod=Mod);
387: return Pt;
388: }
389:
390: def colon_prime_dec1(G,F,Mod,V)
391: {
392: Ci = colon(G,F,V|isgb=1,mod=Mod);
393: if ( type(Ci[0]) != 1 )
394: Pi = prime_dec(Ci,V|indep=1,lexdec=Lexdec,mod=Mod);
395: else
396: Pi = [];
397: return Pi;
398: }
399:
400: def extract_qj(Q,V,QL,Rad,Mod,SI,Colon,Level)
401: {
402: SIFList=[find_ssi0, find_ssi1,find_ssi2];
403: SIF = SIFList[SI];
404: G = QL[0]; P = QL[1]; PV = QL[2];
405: C = Colon ? ideal_colon(G,Q,V|mod=Mod) : P;
406: Ok = (*SIF)(C,G,Q,Rad,V,0|mod=Mod);
407: V0 = setminus(V,PV);
408: HJ = elim_gb(append(Ok,G),V0,PV,Mod,[[0,length(V0)],[0,length(PV)]]);
409: HJ = contraction(HJ,V0|mod=Mod);
410: IJ = nd_gr(HJ,V,Mod,Ord);
411: return Level >= 0 ? [Level,[IJ,P]] : [IJ,P];
412: }
413:
414: def syca_dec(B,V)
415: {
416: T00 = time();
417: if ( type(SI=getopt(si)) == -1 ) SI = 2;
418: SIFList=[find_si0, find_si1,find_si2]; SIF = SIFList[SI];
419: if ( !SIF ) error("syca_dec : si should be 0,1,2");
420:
421: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
422: if ( type(Lexdec=getopt(lexdec)) == -1 ) Lexdec = 0;
423: if ( type(NoSimp=getopt(nosimp)) == -1 ) NoSimp = 0;
424: if ( type(Time=getopt(time)) == -1 ) Time = 0;
425: if ( type(Iso=getopt(iso)) == -1 ) Iso = 0;
426: Ord = 0;
427: Gt = G0 = G = fast_gb(B,V,Mod,Ord|trace=1);
428: Q0 = Q = []; IntQ0 = IntQ = [1]; First = 1;
429: C = 0;
430:
431: Tass = Tiso = Tcolon = Tsep = Tirred = 0;
432: Rass = Riso = Rcolon = Rsep = Rirred = 0;
433: while ( 1 ) {
434: if ( type(Gt[0])==1 ) break;
435: T0 = time();
436: PtR = prime_dec(Gt,V|indep=1,lexdec=Lexdec,mod=Mod,radical=1);
437: T1 = time(); Tass += T1[0]-T0[0]+T1[1]-T0[1]; Rass += T1[3]-T0[3];
438: Pt = PtR[0]; IntPt = PtR[1];
439: if ( gen_gb_comp(Gt,IntPt,Mod) ) {
440: /* Gt is radical and Gt = cap Pt */
441: for ( T = Pt, Qt = []; T != []; T = cdr(T) )
442: Qt = cons([car(T)[0],car(T)[0]],Qt);
443: if ( First )
444: return [Qt,[]];
445: else
446: Q0 = append(Qt,Q0);
447: break;
448: }
449: T0 = time();
450: Qt = iso_comp(Gt,Pt,V,Ord|mod=Mod,isgb=1,iso=Iso);
451: T1 = time(); Tiso += T1[0]-T0[0]+T1[1]-T0[1]; Riso += T1[3]-T0[3];
452: IntQt = ideal_list_intersection(map(first,Qt),V,Ord|mod=Mod);
453: if ( First ) {
454: IntQ0 = IntQ = IntQt; IntP = IntPt; Qi = Qt; First = 0;
455: } else {
456: IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod);
457: if ( gen_gb_comp(IntQ,IntQ1,Mod) ) {
458: G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
459: continue;
460: } else {
461: IntQ = IntQ1;
462: IntQ1 = ideal_intersection(IntQ0,IntQt,V,Ord|mod=Mod);
463: if ( !gen_gb_comp(IntQ0,IntQ1,Mod) ) {
464: Q = append(Qt,Q);
465: for ( T = Qt; T != []; T = cdr(T) )
466: if ( !ideal_inclusion(IntQ0,car(T)[0],V,Ord|mod=Mod) )
467: Q0 = append(Q0,[car(T)]);
468: IntQ0 = IntQ1;
469: }
470: }
471: }
472: if ( gen_gb_comp(IntQt,Gt,Mod) || gen_gb_comp(IntQ,G,Mod) || gen_gb_comp(IntQ0,G0,Mod) ) break;
473: T0 = time();
474: C1 = ideal_colon(G,IntQ,V|mod=Mod);
475: T1 = time(); Tcolon += T1[0]-T0[0]+T1[1]-T0[1]; Rcolon += T1[3]-T0[3];
476: if ( C && gen_gb_comp(C,C1,Mod) ) {
477: G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
478: continue;
479: } else C = C1;
480: T0 = time();
481: Ok = (*SIF)(C,G,IntQ,IntP,V,Ord|mod=Mod);
482: G1 = append(Ok,G);
483: Gt1 = incremental_gb(G1,V,Ord|mod=Mod);
484: T1 = time(); Tsep += T1[0]-T0[0]+T1[1]-T0[1]; Rsep += T1[3]-T0[3];
485: Gt = Gt1;
486: }
487: T0 = time();
488: if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G0,Qi,Q0,V,Ord|mod=Mod);
489: else Q1 = Q0;
490: if ( Time ) {
491: T1 = time(); Tirred += T1[0]-T0[0]+T1[1]-T0[1]; Rirred += T1[3]-T0[3];
492: Tall = T1[0]-T00[0]+T1[1]-T00[1]; Rall += T1[3]-T00[3];
493: print(["total",Tall,"ass",Tass,"iso",Tiso, "colon",Tcolon,"sep",Tsep,"irred",Tirred]);
494: print(["Rtotal",Rall,"Rass",Rass,"Riso",Riso, "Rcolon",Rcolon,"Rsep",Rsep,"Rirred",Rirred]);
495: print(["iso",length(Qi),"emb",length(Q0),"->",length(Q1)]);
496: }
497: return [Qi,Q1];
498: }
499:
500: def syc0_dec(B,V)
501: {
502: T00 = time();
503: if ( type(SI=getopt(si)) == -1 ) SI = 1;
504: SIFList=[find_si0, find_si1,find_si2,find_ssi0,find_ssi1,find_ssi2]; SIF = SIFList[SI];
505: if ( !SIF ) error("syc0_dec : si should be 0,1,2");
506: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
507: if ( type(Lexdec=getopt(lexdec)) == -1 ) Lexdec = 0;
508: if ( type(NoSimp=getopt(nosimp)) == -1 ) NoSimp = 0;
509: if ( type(Time=getopt(time)) == -1 ) Time = 0;
510: Ord = 0;
511: G = fast_gb(B,V,Mod,Ord);
512: Q = []; IntQ = [1]; Gt = G; First = 1;
513: Tass = Tiso = Tcolon = Tsep = Tirred = 0;
514: Rass = Riso = Rcolon = Rsep = Rirred = 0;
515: while ( 1 ) {
516: if ( type(Gt[0])==1 ) break;
517: T0 = time();
518: PtR = prime_dec(Gt,V|indep=1,lexdec=Lexdec,mod=Mod,radical=1);
519: T1 = time(); Tass += T1[0]-T0[0]+T1[1]-T0[1]; Rass += T1[3]-T0[3];
520: Pt = PtR[0]; IntPt = PtR[1];
521: if ( gen_gb_comp(Gt,IntPt,Mod) ) {
522: /* Gt is radical and Gt = cap Pt */
523: for ( T = Pt, Qt = []; T != []; T = cdr(T) )
524: Qt = cons([car(T)[0],car(T)[0]],Qt);
525: if ( First )
526: return [Qt,[]];
527: else
528: Q = append(Qt,Q);
529: break;
530: }
531:
532: T0 = time();
533: Qt = iso_comp(Gt,Pt,V,Ord|mod=Mod,isgb=1);
534: T1 = time(); Tiso += T1[0]-T0[0]+T1[1]-T0[1]; Riso += T1[3]-T0[3];
535: IntQt = ideal_list_intersection(map(first,Qt),V,Ord|mod=Mod);
536: if ( First ) {
537: IntQ = IntQt; Qi = Qt; First = 0;
538: } else {
539: IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod);
540: if ( !gen_gb_comp(IntQ1,IntQ,Mod) )
541: Q = append(Qt,Q);
542: }
543: if ( gen_gb_comp(IntQ,G,Mod) || gen_gb_comp(IntQt,Gt,Mod) )
544: break;
545: T0 = time();
546: C = ideal_colon(Gt,IntQt,V|mod=Mod);
547: T1 = time(); Tcolon += T1[0]-T0[0]+T1[1]-T0[1]; Rcolon += T1[3]-T0[3];
548: T0 = time();
549: Ok = (*SIF)(C,Gt,IntQt,IntPt,V,Ord|mod=Mod);
550: G1 = append(Ok,Gt);
551: Gt = incremental_gb(G1,V,Ord|mod=Mod);
552: T1 = time(); Tsep += T1[0]-T0[0]+T1[1]-T0[1]; Rsep += T1[3]-T0[3];
553: }
554: T0 = time();
555: if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G,Qi,Q,V,Ord|mod=Mod);
556: else Q1 = Q;
557: T1 = time(); Tirred += T1[0]-T0[0]+T1[1]-T0[1]; Rirred += T1[3]-T0[3];
558: Tall = T1[0]-T00[0]+T1[1]-T00[1]; Rall += T1[3]-T00[3];
559: if ( Time ) {
560: print(["total",Tall,"ass",Tass,"iso",Tiso, "colon",Tcolon,"sep",Tsep,"irred",Tirred]);
561: print(["Rtotal",Rall,"Rass",Rass,"Riso",Riso, "Rcolon",Rcolon,"Rsep",Rsep,"Rirred",Rirred]);
562: print(["iso",length(Qi),"emb",length(Q),"->",length(Q1)]);
563: }
564: return [Qi,Q1];
565: }
566:
567: def power(A,I) { return A^I; }
568:
569:
570: /* functions for computating a separing ideal */
571: /* C=G:Q, Rad=rad(Q), return J s.t. Q cap (G+J) = G */
572:
573: def find_si0(C,G,Q,Rad,V,Ord) {
574: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
575: for ( CI = C, I = 1; ; I++ ) {
576: for ( T = CI, S = []; T != []; T = cdr(T) )
577: if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
578: if ( S == [] )
579: error("find_si0 : cannot happen");
580: G1 = append(S,G);
581: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
582: /* check whether (Q cap (G+S)) = G */
583: if ( gen_gb_comp(Int,G,Mod) ) { print([0]); return reverse(S); }
584: CI = ideal_product(CI,C,V|mod=Mod);
585: }
586: }
587:
588: def find_si1(C,G,Q,Rad,V,Ord) {
589: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
590: for ( T = C, S = []; T != []; T = cdr(T) )
591: if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
592: if ( S == [] )
593: error("find_si1 : cannot happen");
594: G1 = append(S,G);
595: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
596: /* check whether (Q cap (G+S)) = G */
597: if ( gen_gb_comp(Int,G,Mod) ) { print([0]); return reverse(S); }
598:
599: C = qsort(C,comp_tdeg);
600:
601: Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
602: Int0 = incremental_gb(append(vtol(ltov(G)*Tmp),vtol(ltov(Q)*(1-Tmp))),
603: TV,Ord1|gbblock=[[0,length(G)]],mod=Mod);
604: Dp = dp_gr_print(); dp_gr_print(0);
605: for ( T = C, S = []; T != []; T = cdr(T) ) {
606: if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
607: Ui = U = car(T);
608: for ( I = 1; ; I++ ) {
609: G1 = cons(Ui,G);
610: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
611: if ( gen_gb_comp(Int,G,Mod) ) break;
612: else
613: Ui = gen_nf(Ui*U,G,V,Ord,Mod);
614: }
615: print([length(T),I],2);
616: Int1 = incremental_gb(append(Int0,[Tmp*Ui]),TV,Ord1
617: |gbblock=[[0,length(Int0)]],mod=Mod);
618: Int = elimination(Int1,V);
619: if ( !gen_gb_comp(Int,G,Mod) ) {
620: break;
621: } else {
622: Int0 = Int1;
623: S = cons(Ui,S);
624: }
625: }
626: print("");
627: dp_gr_print(Dp);
628: return reverse(S);
629: }
630:
631: def find_si2(C,G,Q,Rad,V,Ord) {
632: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
633: for ( T = C, S = []; T != []; T = cdr(T) )
634: if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
635: if ( S == [] )
636: error("find_si2 : cannot happen");
637: G1 = append(S,G);
638: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
639: /* check whether (Q cap (G+S)) = G */
640: if ( gen_gb_comp(Int,G,Mod) ) { print([0]); return reverse(S); }
641:
642: C = qsort(C,comp_tdeg);
643:
644: Dp = dp_gr_print(); dp_gr_print(0);
645: Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
646: Int0 = incremental_gb(append(vtol(ltov(G)*Tmp),vtol(ltov(Q)*(1-Tmp))),
647: TV,Ord1|gbblock=[[0,length(G)]],mod=Mod);
648: for ( T = C, S = []; T != []; T = cdr(T) ) {
649: if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
650: Ui = U = car(T);
651: for ( I = 1; ; I++ ) {
652: Int1 = incremental_gb(append(Int0,[Tmp*Ui]),TV,Ord1
653: |gbblock=[[0,length(Int0)]],mod=Mod);
654: Int = elimination(Int1,V);
655: if ( gen_gb_comp(Int,G,Mod) ) break;
656: else
657: Ui = gen_nf(Ui*U,G,V,Ord,Mod);
658: }
659: print([length(T),I],2);
660: S = cons(Ui,S);
661: }
662: S = qsort(S,comp_tdeg);
663: print("");
664: End = Len = length(S);
665:
666: Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
667: Prev = 1;
668: G1 = append(G,[S[0]]);
669: Int0 = incremental_gb(append(vtol(ltov(G1)*Tmp),vtol(ltov(Q)*(1-Tmp))),
670: TV,Ord1|gbblock=[[0,length(G)]],mod=Mod);
671: if ( End > 1 ) {
672: Cur = 2;
673: while ( Prev < Cur ) {
674: for ( St = [], I = Prev; I < Cur; I++ ) St = cons(Tmp*S[I],St);
675: Int1 = incremental_gb(append(Int0,St),TV,Ord1
676: |gbblock=[[0,length(Int0)]],mod=Mod);
677: Int = elimination(Int1,V);
678: if ( gen_gb_comp(Int,G,Mod) ) {
679: print([Cur],2);
680: Prev = Cur;
681: Cur = Cur+idiv(End-Cur+1,2);
682: Int0 = Int1;
683: } else {
684: End = Cur;
685: Cur = Prev + idiv(Cur-Prev,2);
686: }
687: }
688: for ( St = [], I = 0; I < Prev; I++ ) St = cons(S[I],St);
689: } else
690: St = [S[0]];
691: print("");
692: for ( I = Prev; I < Len; I++ ) {
693: Int1 = incremental_gb(append(Int0,[Tmp*S[I]]),TV,Ord1
694: |gbblock=[[0,length(Int0)]],mod=Mod);
695: Int = elimination(Int1,V);
696: if ( gen_gb_comp(Int,G,Mod) ) {
697: print([I],2);
698: St = cons(S[I],St);
699: Int0 = Int1;
700: }
701: }
702: Ok = reverse(St);
703: print("");
704: print([length(S),length(Ok)]);
705: dp_gr_print(Dp);
706: return Ok;
707: }
708:
709: /* functions for computing a saturated separating ideal */
710:
711: def find_ssi0(C,G,Q,Rad,V,Ord) {
712: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
713: if ( type(Reduce=getopt(red)) == -1 ) Reduce = 0;
714: for ( T = C, S = []; T != []; T = cdr(T) )
715: if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
716: if ( S == [] )
717: error("find_ssi0 : cannot happen");
718: G1 = append(S,G);
719: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
720: /* check whether (Q cap (G+S)) = G */
721: if ( gen_gb_comp(Int,G,Mod) ) { print([0]); return reverse(S); }
722:
723: if ( Reduce ) {
724: for ( T = C, U = []; T != []; T = cdr(T) )
725: if ( gen_nf(car(T),Rad,V,Ord,Mod) ) U = cons(car(T),U);
726: U = reverse(U);
727: } else
728: U = C;
729:
730: for ( I = 1; ; I++ ) {
731: print([I],2);
732: S = map(power,U,I);
733: G1 = append(S,G);
734: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
735: /* check whether (Q cap (G+S)) = G */
736: if ( gen_gb_comp(Int,G,Mod) ) { print(""); return reverse(S); }
737: }
738: }
739:
740: def find_ssi1(C,G,Q,Rad,V,Ord) {
741: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
742: if ( type(Reduce=getopt(red)) == -1 ) Reduce = 0;
743: for ( T = C, S = []; T != []; T = cdr(T) )
744: if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
745: if ( S == [] )
746: error("find_ssi1 : cannot happen");
747: G1 = append(S,G);
748: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
749: /* check whether (Q cap (G+S)) = G */
750: if ( gen_gb_comp(Int,G,Mod) ) { print([0]); return reverse(S); }
751:
752: dp_ord(Ord); DC = map(dp_ptod,C,V);
753: DC = qsort(DC,comp_tord); C = map(dp_dtop,DC,V);
754: print(length(C),2);
755: if ( Reduce ) {
756: SC = map(sq,C,Mod);
757: SC = reverse(SC); C = reverse(C);
758: for ( T = C, C1 = [], R1 = append(SC,Rad); T != []; T = cdr(T) ) {
759: R0 = car(R1); R1 = cdr(R1);
760: if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
761: if ( radical_membership(R0,R1,V|mod=Mod) ) {
762: C1 = cons(car(T),C1);
763: R1 = append(R1,[R0]);
764: }
765: }
766: print("->",0); print(length(C1),2);
767: C = C1;
768: }
769: print(" ",2);
770:
771: Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
772: Int0 = incremental_gb(append(vtol(ltov(G)*Tmp),vtol(ltov(Q)*(1-Tmp))),
773: TV,Ord1|gbblock=[[0,length(G)]],mod=Mod);
774: Dp = dp_gr_print(); dp_gr_print(0);
775: for ( J = 0, T = C, S = [], GS = G; T != []; T = cdr(T), J++ ) {
776: if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
777: Ui = U = car(T);
778: for ( I = 1; ; I++ ) {
779: Int1 = nd_gr(append(Int0,[Tmp*Ui]),TV,Mod,Ord1
780: |gbblock=[[0,length(Int0)]],newelim=1);
781: if ( Int1 ) {
782: Int = elimination(Int1,V);
783: if ( gen_gb_comp(Int,G,Mod) ) break;
784: }
785: print("x",2);
786: Ui = gen_nf(Ui*U,G,V,Ord,Mod);
787: }
788: print(J,2);
789: Int0 = Int1;
790: S = cons(Ui,S);
791: }
792: print("");
793: dp_gr_print(Dp);
794: return reverse(S);
795: }
796:
797: def find_ssi2(C,G,Q,Rad,V,Ord) {
798: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
799: if ( type(Reduce=getopt(red)) == -1 ) Reduce = 0;
800: for ( T = C, S = []; T != []; T = cdr(T) )
801: if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
802: if ( S == [] )
803: error("find_ssi2 : cannot happen");
804: G1 = append(S,G);
805: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
806: /* check whether (Q cap (G+S)) = G */
807: if ( gen_gb_comp(Int,G,Mod) ) { print([0]); return reverse(S); }
808:
809: #if 0
810: dp_ord(Ord); DC = map(dp_ptod,C,V);
811: DC = qsort(DC,comp_tord); C = map(dp_dtop,DC,V);
812: #else
813: C = qsort(C,comp_tdeg);
814: #endif
815: if ( Reduce ) {
816: for ( T = C, C1 = [], R1 = Rad; T != []; T = cdr(T) ) {
817: if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
818: if ( radical_membership(car(T),R1,V) ) {
819: C1 = cons(car(T),C1);
820: R1 = cons(sq(car(T),Mod),R1);
821: }
822: }
823: print(["C",length(C),"->",length(C1)]);
824: C = reverse(C1);
825: }
826: for ( T = C, S = []; T != []; T = cdr(T) ) {
827: if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
828: Ui = U = car(T);
829: S = cons([Ui,U],S);
830: }
831: S = qsort(S,comp_tdeg_first);
832: print("");
833:
834: Dp = dp_gr_print(); dp_gr_print(0);
835: Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
836: Int0 = incremental_gb(append(vtol(ltov(G)*Tmp),vtol(ltov(Q)*(1-Tmp))),
837: TV,Ord1|gbblock=[[0,length(G)]],mod=Mod);
838: OK = [];
839: while ( S != [] ) {
840: Len = length(S); print("remaining gens : ",0); print(Len);
841: S1 = [];
842: for ( Start = Prev = 0; Start < Len; Start = Prev ) {
843: Cur = Start+1;
844: print(Start,2);
845: while ( Prev < Len ) {
846: for ( St = [], I = Prev; I < Cur; I++ ) St = cons(Tmp*S[I][0],St);
847: Int1 = nd_gr(append(Int0,St),TV,Mod,Ord1|gbblock=[[0,length(Int0)]],newelim=1);
848: if ( !Int1 ) {
849: print("x",0); break;
850: }
851: Int = elimination(Int1,V);
852: if ( gen_gb_comp(Int,G,Mod) ) {
853: print([Prev,Cur-1],2);
854: Prev = Cur;
855: Cur += (Prev-Start)+1;
856: if ( Cur > Len ) Cur = Len;
857: Int0 = Int1;
858: } else
859: break;
860: }
861: for ( I = Start; I < Prev; I++ ) OK = cons(S[I][0],OK);
862: if ( Prev == Start ) {
863: Ui = S[I][0]; U = S[I][1];
864: Ui = gen_nf(Ui*U,G,V,Ord,Mod);
865: S1 = cons([Ui,U],S1);
866: Prev++;
867: }
868: }
869: S = reverse(S1);
870: print("");
871: }
872: print("");
873: OK = reverse(OK);
874: dp_gr_print(Dp);
875: return OK;
876: }
877:
878: /* SY primary decompsition */
879:
880: def sy_dec(B,V)
881: {
882: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
883: if ( type(Lexdec=getopt(lexdec)) == -1 ) Lexdec = 0;
884: Ord = 0;
885: G = fast_gb(B,V,Mod,Ord);
886: Q = [];
887: IntQ = [1];
888: Gt = G;
889: First = 1;
890: while ( 1 ) {
891: if ( type(Gt[0]) == 1 ) break;
892: Pt = prime_dec(Gt,V|indep=1,lexdec=Lexdec,mod=Mod);
893: L = pseudo_dec(Gt,Pt,V,Ord|mod=Mod);
894: Qt = L[0]; Rt = L[1]; St = L[2];
895: IntQt = ideal_list_intersection(map(first,Qt),V,Ord|mod=Mod);
896: if ( First ) {
897: IntQ = IntQt;
898: Qi = Qt;
899: First = 0;
900: } else {
901: IntQ = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod);
902: Q = append(Qt,Q);
903: }
904: if ( gen_gb_comp(IntQ,G,Mod) ) break;
905: for ( T = Rt; T != []; T = cdr(T) ) {
906: if ( type(car(T)[0]) == 1 ) continue;
907: U = sy_dec(car(T),V|lexdec=Lexdec,mod=Mod);
908: IntQ = ideal_list_intersection(cons(IntQ,map(first,U)),
909: V,Ord|mod=Mod);
910: Q = append(U,Q);
911: if ( gen_gb_comp(IntQ,G,Mod) ) break;
912: }
913: Gt = fast_gb(append(Gt,St),V,Mod,Ord);
914: }
915: Q = qd_remove_redundant_comp(G,Qi,Q,V,Ord|mod=Mod);
916: return append(Qi,Q);
917: }
918:
919: def pseudo_dec(G,L,V,Ord)
920: {
921: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
922: N = length(L);
923: S = vector(N);
924: Q = vector(N);
925: R = vector(N);
926: L0 = map(first,L);
927: for ( I = 0; I < N; I++ ) {
928: LI = setminus(L0,[L0[I]]);
929: PI = ideal_list_intersection(LI,V,Ord|mod=Mod);
930: PI = qsort(PI,comp_tdeg);
931: for ( T = PI; T != []; T = cdr(T) )
932: if ( gen_nf(car(T),L0[I],V,Ord,Mod) ) break;
933: if ( T == [] ) error("separator : cannot happen");
934: SI = satind(G,car(T),V|mod=Mod);
935: QI = SI[0];
936: S[I] = car(T)^SI[1];
937: PV = L[I][1];
938: V0 = setminus(V,PV);
939: #if 0
940: GI = fast_gb(QI,append(V0,PV),Mod,
941: [[Ord,length(V0)],[Ord,length(PV)]]);
942: #else
943: GI = fast_gb(QI,append(V0,PV),Mod,
944: [[2,length(V0)],[Ord,length(PV)]]);
945: #endif
946: LCFI = lcfactor(GI,V0,Ord,Mod);
947: for ( F = 1, T = LCFI, Gt = QI; T != []; T = cdr(T) ) {
948: St = satind(Gt,T[0],V|mod=Mod);
949: Gt = St[0]; F *= T[0]^St[1];
950: }
951: Q[I] = [Gt,L0[I]];
952: R[I] = fast_gb(cons(F,QI),V,Mod,Ord);
953: }
954: return [vtol(Q),vtol(R),vtol(S)];
955: }
956:
957: def iso_comp(G,L,V,Ord)
958: {
959: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
960: if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
961: if ( type(Iso=getopt(iso)) == -1 ) Iso = 0;
962: if ( type(Para=getopt(para)) == -1 ) Para = 0;
963: if ( type(Q=getopt(intq)) == -1 ) Q = 0;
964:
965: S = separator(L,V|mod=Mod);
966: N = length(L);
967: print("comps : ",2); print(N); print("",2);
968: if ( Para ) {
969: Task = [];
970: for ( I = 0; I < N; I++ ) {
971: T = ["noro_pd.locsat",G,V,L[I],S[I],Mod,IsGB,Iso,Q];
972: Task = cons(T,Task);
973: }
974: Task = reverse(Task);
975: R = para_exec(Para,Task);
976: return R;
977: } else {
978: for ( I = 0, R = []; I < N; I++ ) {
979: QI = locsat(G,V,L[I],S[I],Mod,IsGB,Iso,Q);
980: if ( type(QI[0][0])==1 )
981: error("iso_comp : cannot happen");
982: print(".",2);
983: R = cons(QI,R);
984: }
985: print("");
986: return reverse(R);
987: }
988: }
989:
990: def locsat(G,V,L,S,Mod,IsGB,Iso,Q)
991: {
992: P = L[0]; PV = L[1]; V0 = setminus(V,PV);
993: if ( Iso==1 ) {
994: QI = sat(G,S,V|isgb=IsGB,mod=Mod);
995: GI = elim_gb(QI,V0,PV,Mod,[[0,length(V0)],[0,length(PV)]]);
996: GI = nd_gr(contraction(GI,V0|mod=Mod),V,Mod,0);
997: } else if ( Iso==0 ) {
998: HI = elim_gb(G,V0,PV,Mod,[[0,length(V0)],[0,length(PV)]]);
999: GI = nd_gr(contraction(HI,V0|mod=Mod),V,Mod,0);
1000: GI = sat(GI,S,V|isgb=IsGB,mod=Mod);
1001: } else if ( Iso==2 ) {
1002: HI = elim_gb(G,V0,PV,Mod,[[0,length(V0)],[0,length(PV)]]);
1003: TV = ttttt;
1004: if ( Mod )
1005: GI = nd_gr(cons(TV*S-1,HI),cons(TV,V0),Mod,[[0,1],[0,length(V0)]]);
1006: else
1007: GI = nd_gr_trace(append(HI,[TV*S-1]),cons(TV,V0),
1008: 1,1,[[0,1],[0,length(V0)]]|gbblock=[[0,length(HI)]]);
1009: GI = elimination(GI,V);
1010: GI = nd_gr(contraction(GI,V0|mod=Mod),V,Mod,0);
1011: }
1012: if ( Q )
1013: GI = ideal_intersection(Q,GI,V,0|mod=Mod);
1014: return [GI,P,PV];
1015: }
1016:
1017: /* GTZ primary decompsition */
1018:
1019: def prima_dec(B,V)
1020: {
1021: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1022: if ( type(Ord=getopt(ord)) == -1 ) Ord = 0;
1023: G0 = fast_gb(B,V,Mod,0);
1024: G = fast_gb(G0,V,Mod,Ord);
1025: IntP = [1];
1026: QD = [];
1027: while ( 1 ) {
1028: if ( type(G[0])==1 || ideal_inclusion(IntP,G0,V,0|mod=Mod) )
1029: break;
1030: W = maxindep(G,V,Ord); NP = length(W);
1031: V0 = setminus(V,W); N = length(V0);
1032: V1 = append(V0,W);
1033: G1 = fast_gb(G,V1,Mod,[[Ord,N],[Ord,NP]]);
1034: LCF = lcfactor(G1,V0,Ord,Mod);
1035: L = zprimacomp(G,V0|mod=Mod);
1036: F = 1;
1037: for ( T = LCF, G2 = G; T != []; T = cdr(T) ) {
1038: S = satind(G2,T[0],V1|mod=Mod);
1039: G2 = S[0]; F *= T[0]^S[1];
1040: }
1041: for ( T = L, QL = []; T != []; T = cdr(T) )
1042: QL = cons(car(T)[0],QL);
1043: Int = ideal_list_intersection(QL,V,0|mod=Mod);
1044: IntP = ideal_intersection(IntP,Int,V,0|mod=Mod);
1045: QD = append(QD,L);
1046: F = gen_nf(F,G,V,0,Mod);
1047: G = fast_gb(cons(F,G),V,Mod,Ord);
1048: }
1049: QD = qd_remove_redundant_comp(G0,[],QD,V,0);
1050: return QD;
1051: }
1052:
1053: /* SL prime decomposition */
1054:
1055: def prime_dec(B,V)
1056: {
1057: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1058: if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
1059: if ( type(NoLexDec=getopt(lexdec)) == -1 ) LexDec = 0;
1060: if ( type(Rad=getopt(radical)) == -1 ) Rad = 0;
1061: B = map(sq,B,Mod);
1062: if ( LexDec )
1063: PD = lex_predec1(B,V|mod=Mod);
1064: else
1065: PD = [B];
1066: if ( length(PD) > 1 ) {
1067: G = ideal_list_intersection(PD,V,0|mod=Mod);
1068: PD = pd_remove_redundant_comp(G,PD,V,0|mod=Mod);
1069: }
1070: R = [];
1071: for ( T = PD; T != []; T = cdr(T) )
1072: R = append(prime_dec_main(car(T),V|indep=Indep,mod=Mod),R);
1073: if ( Indep ) {
1074: G = ideal_list_intersection(map(first,R),V,0|mod=Mod);
1075: if ( LexDec ) R = pd_simp_comp(R,V|first=1,mod=Mod);
1076: } else {
1077: G = ideal_list_intersection(R,V,0|mod=Mod);
1078: if ( LexDec ) R = pd_simp_comp(R,V|first=1,mod=Mod);
1079: }
1080: return Rad ? [R,G] : R;
1081: }
1082:
1083: def prime_dec_main(B,V)
1084: {
1085: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1086: if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
1087: G = fast_gb(B,V,Mod,0);
1088: IntP = [1];
1089: PD = [];
1090: while ( 1 ) {
1091: /* rad(G) subset IntP */
1092: /* check if IntP subset rad(G) */
1093: for ( T = IntP; T != []; T = cdr(T) ) {
1094: if ( (GNV = radical_membership(car(T),G,V|mod=Mod,isgb=1)) ) {
1095: F = car(T);
1096: break;
1097: }
1098: }
1099: if ( T == [] ) return PD;
1100:
1101: /* GNV = [GB(<NV*F-1,G>),NV] */
1102: G1 = fast_gb(GNV[0],cons(GNV[1],V),Mod,[[0,1],[0,length(V)]]);
1103: G0 = elimination(G1,V);
1104: PD0 = zprimecomp(G0,V,Indep|mod=Mod);
1105: if ( Indep ) {
1106: Int = ideal_list_intersection(PD0[0],V,0|mod=Mod);
1107: IndepSet = PD0[1];
1108: for ( PD1 = [], T = PD0[0]; T != []; T = cdr(T) )
1109: PD1 = cons([car(T),IndepSet],PD1);
1110: PD = append(PD,reverse(PD1));
1111: } else {
1112: Int = ideal_list_intersection(PD0,V,0|mod=Mod);
1113: PD = append(PD,PD0);
1114: }
1115: IntP = ideal_intersection(IntP,Int,V,0|mod=Mod);
1116: }
1117: }
1118:
1119: /* pre-decomposition */
1120:
1121: def lex_predec1(B,V)
1122: {
1123: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1124: G = fast_gb(B,V,Mod,2);
1125: for ( T = G; T != []; T = cdr(T) ) {
1126: F = gen_fctr(car(T),Mod);
1127: if ( length(F) > 2 || length(F) == 2 && F[1][1] > 1 ) {
1128: for ( R = [], S = cdr(F); S != []; S = cdr(S) ) {
1129: Ft = car(S)[0];
1130: Gt = map(ptozp,map(gen_nf,G,[Ft],V,0,Mod));
1131: R1 = fast_gb(cons(Ft,Gt),V,Mod,0);
1132: R = cons(R1,R);
1133: }
1134: return R;
1135: }
1136: }
1137: return [G];
1138: }
1139:
1140: /* zero-dimensional prime/primary decomosition */
1141:
1142: def zprimedec(B,V,Mod)
1143: {
1144: L = partial_decomp(B,V,Mod);
1145: P = L[0]; NP = L[1];
1146: R = [];
1147: for ( ; P != []; P = cdr(P) ) R = cons(car(car(P)),R);
1148: for ( T = NP; T != []; T = cdr(T) ) {
1149: R1 = complete_decomp(car(T),V,Mod);
1150: R = append(R1,R);
1151: }
1152: return R;
1153: }
1154:
1155: def zprimadec(B,V,Mod)
1156: {
1157: L = partial_qdecomp(B,V,Mod);
1158: Q = L[0]; NQ = L[1];
1159: R = [];
1160: for ( ; Q != []; Q = cdr(Q) ) {
1161: T = car(Q); R = cons([T[0],T[1]],R);
1162: }
1163: for ( T = NQ; T != []; T = cdr(T) ) {
1164: R1 = complete_qdecomp(car(T),V,Mod);
1165: R = append(R1,R);
1166: }
1167: return R;
1168: }
1169:
1170: def complete_qdecomp(GD,V,Mod)
1171: {
1172: GQ = GD[0]; GP = GD[1]; D = GD[2];
1173: W = vars(GP);
1174: PV = setminus(W,V);
1175: N = length(V); PN = length(PV);
1176: U = find_npos([GP,D],V,PV,Mod);
1177: NV = ttttt;
1178: M = gen_minipoly(cons(NV-U,GQ),cons(NV,V),PV,0,NV,Mod);
1179: M = ppart(M,NV,Mod);
1180: MF = Mod ? modfctr(M) : fctr(M);
1181: R = [];
1182: for ( T = cdr(MF); T != []; T = cdr(T) ) {
1183: S = car(T);
1184: Mt = subst(S[0],NV,U);
1185: GP1 = fast_gb(cons(Mt,GP),W,Mod,0);
1186: GQ1 = fast_gb(cons(Mt^S[1],GQ),W,Mod,0);
1187: if ( PV != [] ) {
1188: GP1 = elim_gb(GP1,V,PV,Mod,[[0,N],[0,PN]]);
1189: GQ1 = elim_gb(GQ1,V,PV,Mod,[[0,N],[0,PN]]);
1190: }
1191: R = cons([GQ1,GP1],R);
1192: }
1193: return R;
1194: }
1195:
1196: def partial_qdecomp(B,V,Mod)
1197: {
1198: Elim = (Elim=getopt(elim))&&type(Elim)!=-1 ? 1 : 0;
1199: N = length(V);
1200: W = vars(B);
1201: PV = setminus(W,V);
1202: NP = length(PV);
1203: W = append(V,PV);
1204: if ( Elim && PV != [] ) Ord = [[0,N],[0,NP]];
1205: else Ord = 0;
1206: if ( Mod )
1207: B = nd_f4(B,W,Mod,Ord);
1208: else
1209: B = nd_gr_trace(B,W,1,GBCheck,Ord);
1210: Q = []; NQ = [[B,B,vector(N+1)]];
1211: for ( I = length(V)-1; I >= 0; I-- ) {
1212: NQ1 = [];
1213: for ( T = NQ; T != []; T = cdr(T) ) {
1214: L = partial_qdecomp0(car(T),V,PV,Ord,I,Mod);
1215: Q = append(L[0],Q);
1216: NQ1 = append(L[1],NQ1);
1217: }
1218: NQ = NQ1;
1219: }
1220: return [Q,NQ];
1221: }
1222:
1223: def partial_qdecomp0(GD,V,PV,Ord,I,Mod)
1224: {
1225: GQ = GD[0]; GP = GD[1]; D = GD[2];
1226: N = length(V); PN = length(PV);
1227: W = append(V,PV);
1228: VI = V[I];
1229: M = gen_minipoly(GQ,V,PV,Ord,VI,Mod);
1230: M = ppart(M,VI,Mod);
1231: if ( Mod )
1232: MF = modfctr(M,Mod);
1233: else
1234: MF = fctr(M);
1235: Q = []; NQ = [];
1236: if ( length(MF) == 2 && MF[1][1] == 1 ) {
1237: D1 = D*1; D1[I] = M;
1238: GQelim = elim_gb(GQ,V,PV,Mod,Ord);
1239: GPelim = elim_gb(GP,V,PV,Mod,Ord);
1240: LD = ldim(GQelim,V);
1241: if ( deg(M,VI) == LD )
1242: Q = cons([GQelim,GPelim,D1],Q);
1243: else
1244: NQ = cons([GQelim,GPelim,D1],NQ);
1245: return [Q,NQ];
1246: }
1247: for ( T = cdr(MF); T != []; T = cdr(T) ) {
1248: S = car(T); Mt = S[0]; D1 = D*1; D1[I] = Mt;
1249:
1250: GQ1 = fast_gb(cons(Mt^S[1],GQ),W,Mod,Ord);
1251: GQelim = elim_gb(GQ1,V,PV,Mod,Ord);
1252: GP1 = fast_gb(cons(Mt,GP),W,Mod,Ord);
1253: GPelim = elim_gb(GP1,V,PV,Mod,Ord);
1254:
1255: D1[N] = LD = ldim(GPelim,V);
1256:
1257: for ( J = 0; J < N; J++ )
1258: if ( D1[J] && deg(D1[J],V[J]) == LD ) break;
1259: if ( J < N )
1260: Q = cons([GQelim,GPelim,D1],Q);
1261: else
1262: NQ = cons([GQelim,GPelim,D1],NQ);
1263: }
1264: return [Q,NQ];
1265: }
1266:
1267: def complete_decomp(GD,V,Mod)
1268: {
1269: G = GD[0]; D = GD[1];
1270: W = vars(G);
1271: PV = setminus(W,V);
1272: N = length(V); PN = length(PV);
1273: U = find_npos(GD,V,PV,Mod);
1274: NV = ttttt;
1275: M = gen_minipoly(cons(NV-U,G),cons(NV,V),PV,0,NV,Mod);
1276: M = ppart(M,NV,Mod);
1277: MF = Mod ? modfctr(M) : fctr(M);
1278: if ( length(MF) == 2 ) return [G];
1279: R = [];
1280: for ( T = cdr(MF); T != []; T = cdr(T) ) {
1281: Mt = subst(car(car(T)),NV,U);
1282: G1 = fast_gb(cons(Mt,G),W,Mod,0);
1283: if ( PV != [] ) G1 = elim_gb(G1,V,PV,Mod,[[0,N],[0,PN]]);
1284: R = cons(G1,R);
1285: }
1286: return R;
1287: }
1288:
1289: def partial_decomp(B,V,Mod)
1290: {
1291: Elim = (Elim=getopt(elim))&&type(Elim)!=-1 ? 1 : 0;
1292: N = length(V);
1293: W = vars(B);
1294: PV = setminus(W,V);
1295: NP = length(PV);
1296: W = append(V,PV);
1297: if ( Elim && PV != [] ) Ord = [[0,N],[0,NP]];
1298: else Ord = 0;
1299: if ( Mod )
1300: B = nd_f4(B,W,Mod,Ord);
1301: else
1302: B = nd_gr_trace(B,W,1,GBCheck,Ord);
1303: P = []; NP = [[B,vector(N+1)]];
1304: for ( I = length(V)-1; I >= 0; I-- ) {
1305: NP1 = [];
1306: for ( T = NP; T != []; T = cdr(T) ) {
1307: L = partial_decomp0(car(T),V,PV,Ord,I,Mod);
1308: P = append(L[0],P);
1309: NP1 = append(L[1],NP1);
1310: }
1311: NP = NP1;
1312: }
1313: return [P,NP];
1314: }
1315:
1316: def partial_decomp0(GD,V,PV,Ord,I,Mod)
1317: {
1318: G = GD[0]; D = GD[1];
1319: N = length(V); PN = length(PV);
1320: W = append(V,PV);
1321: VI = V[I];
1322: M = gen_minipoly(G,V,PV,Ord,VI,Mod);
1323: M = ppart(M,VI,Mod);
1324: if ( Mod )
1325: MF = modfctr(M,Mod);
1326: else
1327: MF = fctr(M);
1328: if ( length(MF) == 2 && MF[1][1] == 1 ) {
1329: D1 = D*1;
1330: D1[I] = M;
1331: Gelim = elim_gb(G,V,PV,Mod,Ord);
1332: D1[N] = LD = ldim(Gelim,V);
1333: GD1 = [Gelim,D1];
1334: for ( J = 0; J < N; J++ )
1335: if ( D1[J] && deg(D1[J],V[J]) == LD )
1336: return [[GD1],[]];
1337: return [[],[GD1]];
1338: }
1339: P = []; NP = [];
1340: GI = elim_gb(G,V,PV,Mod,Ord);
1341: for ( T = cdr(MF); T != []; T = cdr(T) ) {
1342: Mt = car(car(T));
1343: D1 = D*1;
1344: D1[I] = Mt;
1345: GIt = map(gen_nf,GI,[Mt],V,Ord,Mod);
1346: G1 = cons(Mt,GIt);
1347: Gelim = elim_gb(G1,V,PV,Mod,Ord);
1348: D1[N] = LD = ldim(Gelim,V);
1349: for ( J = 0; J < N; J++ )
1350: if ( D1[J] && deg(D1[J],V[J]) == LD ) break;
1351: if ( J < N )
1352: P = cons([Gelim,D1],P);
1353: else
1354: NP = cons([Gelim,D1],NP);
1355: }
1356: return [P,NP];
1357: }
1358:
1359: /* prime/primary components over rational function field */
1360:
1361: def zprimacomp(G,V) {
1362: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1363: L = zprimadec(G,V,0|mod=Mod);
1364: R = [];
1365: dp_ord(0);
1366: for ( T = L; T != []; T = cdr(T) ) {
1367: S = car(T);
1368: UQ = contraction(S[0],V|mod=Mod);
1369: UP = contraction(S[1],V|mod=Mod);
1370: R = cons([UQ,UP],R);
1371: }
1372: return R;
1373: }
1374:
1375: def zprimecomp(G,V,Indep) {
1376: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1377: W = maxindep(G,V,0|mod=Mod);
1378: V0 = setminus(V,W);
1379: V1 = append(V0,W);
1380: #if 0
1381: O1 = [[0,length(V0)],[0,length(W)]];
1382: G1 = fast_gb(G,V1,Mod,O1);
1383: dp_ord(0);
1384: #else
1385: G1 = G;
1386: #endif
1387: PD = zprimedec(G1,V0,Mod);
1388: dp_ord(0);
1389: R = [];
1390: for ( T = PD; T != []; T = cdr(T) ) {
1391: U = contraction(car(T),V0|mod=Mod);
1392: U = nd_gr(U,V,Mod,0);
1393: R = cons(U,R);
1394: }
1395: if ( Indep ) return [R,W];
1396: else return R;
1397: }
1398:
1399: def fast_gb(B,V,Mod,Ord)
1400: {
1401: if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
1402: if ( type(NoRA=getopt(nora)) == -1 ) NoRA = 0;
1403: if ( type(Trace=getopt(trace)) == -1 ) Trace = 0;
1404: if ( Mod )
1405: G = nd_f4(B,V,Mod,Ord|nora=NoRA);
1406: else if ( F4 )
1407: G = map(ptozp,f4_chrem(B,V,Ord));
1408: else if ( Trace ) {
1409: if ( Block )
1410: G = nd_gr_trace(B,V,1,1,Ord|nora=NoRA,gbblock=Block);
1411: else
1412: G = nd_gr_trace(B,V,1,1,Ord|nora=NoRA);
1413: } else {
1414: if ( Block )
1415: G = nd_gr(B,V,0,Ord|nora=NoRA,gbblock=Block);
1416: else
1417: G = nd_gr(B,V,0,Ord|nora=NoRA);
1418: }
1419: return G;
1420: }
1421:
1422: def incremental_gb(A,V,Ord)
1423: {
1424: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1425: if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
1426: if ( Mod ) {
1427: if ( Block )
1428: G = nd_gr(A,V,Mod,Ord|gbblock=Block);
1429: else
1430: G = nd_gr(A,V,Mod,Ord);
1431: } else if ( Procs ) {
1432: Arg0 = ["nd_gr",A,V,0,Ord];
1433: Arg1 = ["nd_gr_trace",A,V,1,GBCheck,Ord];
1434: G = competitive_exec(Procs,Arg0,Arg1);
1435: } else if ( Block )
1436: G = nd_gr(A,V,0,Ord|gbblock=Block);
1437: else
1438: G = nd_gr(A,V,0,Ord);
1439: return G;
1440: }
1441:
1442: def elim_gb(G,V,PV,Mod,Ord)
1443: {
1444: N = length(V); PN = length(PV);
1445: O1 = [[0,N],[0,PN]];
1446: if ( Ord == O1 )
1447: Ord = Ord[0][0];
1448: if ( Mod ) /* XXX */ {
1449: for ( T = G, H = []; T != []; T = cdr(T) )
1450: if ( car(T) ) H = cons(car(T),H);
1451: G = reverse(H);
1452: G = dp_gr_mod_main(G,V,0,Mod,Ord);
1453: } else if ( EProcs ) {
1454: #if 1
1455: Arg0 = ["dp_gr_main",G,V,0,0,Ord];
1456: #else
1457: Arg0 = ["nd_gr",G,V,0,Ord];
1458: #endif
1459: Arg1 = ["noro_pd.nd_gr_rat",G,V,PV,O1,Ord];
1460: G = competitive_exec(EProcs,Arg0,Arg1);
1461: } else if ( GBRat ) {
1462: G1 = nd_gr(G,append(V,PV),0,O1);
1463: G1 = nd_gr_postproc(G1,V,0,Ord,0);
1464: return G1;
1465: } else
1466: #if 1
1.2 ! noro 1467: #if 0
1.1 noro 1468: G = dp_gr_main(G,V,0,0,Ord);
1469: #else
1470: G = nd_gr_trace(G,V,1,1,Ord);
1471: #endif
1472: #else
1473: G = nd_gr(G,V,0,Ord);
1474: #endif
1475: return G;
1476: }
1477:
1478: def ldim(G,V)
1479: {
1480: O0 = dp_ord(); dp_ord(0);
1481: D = length(dp_mbase(map(dp_ptod,G,V)));
1482: dp_ord(O0);
1483: return D;
1484: }
1485:
1486: /* over Q only */
1487:
1488: def make_mod_subst(GD,V,PV,HC)
1489: {
1490: N = length(V);
1491: PN = length(PV);
1492: G = GD[0]; D = GD[1];
1493: for ( I = 0; ; I = (I+1)%100 ) {
1494: Mod = lprime(I);
1495: S = [];
1496: for ( J = PN-1; J >= 0; J-- )
1497: S = append([PV[J],random()%Mod],S);
1498: for ( T = HC; T != []; T = cdr(T) )
1499: if ( !(subst(car(T),S)%Mod) ) break;
1500: if ( T != [] ) continue;
1501: for ( J = 0; J < N; J++ ) {
1502: M = subst(D[J],S);
1503: F = modsqfr(M,Mod);
1504: if ( length(F) != 2 || F[1][1] != 1 ) break;
1505: }
1506: if ( J < N ) continue;
1507: G0 = map(subst,G,S);
1508: return [G0,Mod];
1509: }
1510: }
1511:
1512: def rsgn()
1513: {
1514: return random()%2 ? 1 : -1;
1515: }
1516:
1517: def find_npos(GD,V,PV,Mod)
1518: {
1519: N = length(V); PN = length(PV);
1520: G = GD[0]; D = GD[1]; LD = D[N];
1521: Ord0 = dp_ord(); dp_ord(0);
1522: HC = map(dp_hc,map(dp_ptod,G,V));
1523: dp_ord(Ord0);
1524: if ( !Mod ) {
1525: W = append(V,PV);
1526: G1 = nd_gr_trace(G,W,1,GBCheck,[[0,N],[0,PN]]);
1527: L = make_mod_subst([G1,D],V,PV,HC);
1528: return find_npos([L[0],D],V,[],L[1]);
1529: }
1530: N = length(V);
1531: NV = ttttt;
1532: for ( B = 2; ; B++ ) {
1533: for ( J = N-2; J >= 0; J-- ) {
1534: for ( U = 0, K = J; K < N; K++ )
1535: U += rsgn()*((random()%B+1))*V[K];
1536: M = minipolym(G,V,0,U,NV,Mod);
1537: if ( deg(M,NV) == LD ) return U;
1538: }
1539: }
1540: }
1541:
1542: def gen_minipoly(G,V,PV,Ord,VI,Mod)
1543: {
1544: if ( PV == [] ) {
1545: NV = sssss;
1546: if ( Mod )
1547: M = minipolym(G,V,Ord,VI,NV,Mod);
1548: else
1549: M = minipoly(G,V,Ord,VI,NV);
1550: return subst(M,NV,VI);
1551: }
1552: W = setminus(V,[VI]);
1553: PV1 = cons(VI,PV);
1554: #if 0
1555: while ( 1 ) {
1556: V1 = append(W,PV1);
1557: if ( Mod )
1558: G = nd_gr(G,V1,Mod,[[0,1],[0,length(V1)-1]]|nora=1);
1559: else
1560: G = nd_gr_trace(G,V1,1,GBCheck,[[0,1],[0,length(V1)-1]]|nora=1);
1561: if ( W == [] ) break;
1562: else {
1563: W = cdr(W);
1564: G = elimination(G,cdr(V1));
1565: }
1566: }
1567: #elif 1
1568: if ( Mod ) {
1569: V1 = append(W,PV1);
1570: G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]);
1571: G = elimination(G,PV1);
1572: } else {
1573: PV2 = setminus(PV1,[PV1[length(PV1)-1]]);
1574: V2 = append(W,PV2);
1575: G = nd_gr_trace(G,V2,1,GBCheck,[[0,length(W)],[0,length(PV2)]]|nora=1);
1576: G = elimination(G,PV1);
1577: }
1578: #else
1579: V1 = append(W,PV1);
1580: if ( Mod )
1581: G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]|nora=1);
1582: else
1583: G = nd_gr_trace(G,V1,1,GBCheck,[[0,length(W)],[0,length(PV1)]]|nora=1);
1584: G = elimination(G,PV1);
1585: #endif
1586: if ( Mod )
1587: G = nd_gr(G,PV1,Mod,[[0,1],[0,length(PV)]]|nora=1);
1588: else
1589: G = nd_gr_trace(G,PV1,1,GBCheck,[[0,1],[0,length(PV)]]|nora=1);
1590: for ( M = car(G), T = cdr(G); T != []; T = cdr(T) )
1591: if ( deg(car(T),VI) < deg(M,VI) ) M = car(T);
1592: return M;
1593: }
1594:
1595: def indepset(V,H)
1596: {
1597: if ( H == [] ) return V;
1598: N = -1;
1599: for ( T = V; T != []; T = cdr(T) ) {
1600: VI = car(T);
1601: HI = [];
1602: for ( S = H; S != []; S = cdr(S) )
1603: if ( !tdiv(car(S),VI) ) HI = cons(car(S),HI);
1604: RI = indepset(setminus(V,[VI]),HI);
1605: if ( length(RI) > N ) {
1606: R = RI; N = length(RI);
1607: }
1608: }
1609: return R;
1610: }
1611:
1612: def maxindep(B,V,O)
1613: {
1614: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1615: G = fast_gb(B,V,Mod,O);
1616: Old = dp_ord();
1617: dp_ord(O);
1618: H = map(dp_dtop,map(dp_ht,map(dp_ptod,G,V)),V);
1619: H = map(sq,H,0);
1620: H = nd_gr(H,V,0,0);
1621: H = monodec0(H,V);
1622: N = length(V);
1623: Dep = [];
1624: for ( T = H, Len = N+1; T != []; T = cdr(T) ) {
1625: M = length(car(T));
1626: if ( M < Len ) {
1627: Dep = [car(T)];
1628: Len = M;
1629: } else if ( M == Len )
1630: Dep = cons(car(T),Dep);
1631: }
1632: R = setminus(V,Dep[0]);
1633: dp_ord(Old);
1634: return R;
1635: }
1636:
1637: /* ideal operations */
1638: def contraction(G,V)
1639: {
1640: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1641: C = [];
1642: for ( T = G; T != []; T = cdr(T) ) {
1643: C1 = dp_hc(dp_ptod(car(T),V));
1644: S = gen_fctr(C1,Mod);
1645: for ( S = cdr(S); S != []; S = cdr(S) )
1646: if ( !member(S[0][0],C) ) C = cons(S[0][0],C);
1647: }
1648: W = vars(G);
1649: PV = setminus(W,V);
1650: W = append(V,PV);
1651: NV = ttttt;
1652: for ( T = C, S = 1; T != []; T = cdr(T) )
1653: S *= car(T);
1654: G = saturation([G,NV],S,W|mod=Mod);
1655: return G;
1656: }
1657:
1658: def ideal_list_intersection(L,V,Ord)
1659: {
1660: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1661: if ( type(Para=getopt(para)) == -1 || type(Para) != 4 ) Para = [];
1662: N = length(L);
1663: if ( N == 0 ) return [1];
1664: if ( N == 1 ) return fast_gb(L[0],V,Mod,Ord);
1.2 ! noro 1665: if ( N > 2 && (Len = length(Para)) >= 2 ) {
! 1666: Div = N >= 2*Len ? Len : 2;
! 1667: QR = iqr(N,Div); Q = QR[0]; R = QR[1];
! 1668: T = []; K = 0;
! 1669: for ( I = 0; I < Div; I++ ) {
! 1670: LenI = I<R? Q+1 : Q;
! 1671: if ( LenI ) {
! 1672: for ( LI = [], J = 0; J < LenI; J++ ) LI = cons(L[K++],LI);
! 1673: TI = ["noro_pd.call_ideal_list_intersection",LI,V,Mod,Ord];
! 1674: T = cons(TI,T);
! 1675: }
! 1676: }
! 1677: Tint = para_exec(Para,T);
! 1678: return ideal_list_intersection(Tint,V,Ord|mod=Mod,para=Para);
1.1 noro 1679: } else {
1.2 ! noro 1680: N2 = idiv(N,2);
! 1681: for ( L1 = [], I = 0; I < N2; I++ ) L1 = cons(L[I],L1);
! 1682: for ( L2 = []; I < N; I++ ) L2 = cons(L[I],L2);
1.1 noro 1683: I1 = ideal_list_intersection(L1,V,Ord|mod=Mod);
1684: I2 = ideal_list_intersection(L2,V,Ord|mod=Mod);
1.2 ! noro 1685: return ideal_intersection(I1,I2,V,Ord|mod=Mod,
! 1686: gbblock=[[0,length(I1)],[length(I1),length(I2)]]);
1.1 noro 1687: }
1688: }
1689:
1690: def call_ideal_list_intersection(L,V,Mod,Ord)
1691: {
1692: return ideal_list_intersection(L,V,Ord|mod=Mod);
1693: }
1694:
1695: def ideal_intersection(A,B,V,Ord)
1696: {
1697: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1698: if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
1699: T = ttttt;
1700: if ( Mod ) {
1701: if ( Block )
1702: G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
1703: cons(T,V),Mod,[[0,1],[Ord,length(V)]]|gbblock=Block,nora=0);
1704: else
1705: G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
1706: cons(T,V),Mod,[[0,1],[Ord,length(V)]]|nora=0);
1707: } else
1708: if ( Procs ) {
1709: Arg0 = ["nd_gr",
1710: append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
1711: cons(T,V),0,[[0,1],[Ord,length(V)]]];
1712: Arg1 = ["nd_gr_trace",
1713: append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
1714: cons(T,V),1,GBCheck,[[0,1],[Ord,length(V)]]];
1715: G = competitive_exec(Procs,Arg0,Arg1);
1716: } else {
1717: if ( Block )
1718: G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
1719: cons(T,V),0,[[0,1],[Ord,length(V)]]|gbblock=Block,nora=0);
1720: else
1721: G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
1722: cons(T,V),0,[[0,1],[Ord,length(V)]]|nora=0);
1723: }
1724: G0 = elimination(G,V);
1725: if ( 0 && !Procs )
1726: G0 = nd_gr_postproc(G0,V,Mod,Ord,0);
1727: return G0;
1728: }
1729:
1730: /* returns GB if F notin rad(G) */
1731:
1732: def radical_membership(F,G,V) {
1733: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1734: if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
1735: F = gen_nf(F,G,V,0,Mod);
1736: if ( !F ) return 0;
1737: F2 = gen_nf(F*F,G,V,0,Mod);
1738: if ( !F2 ) return 0;
1739: F3 = gen_nf(F2*F,G,V,0,Mod);
1740: if ( !F3 ) return 0;
1741: NV = ttttt;
1742: if ( IsGB )
1743: T = nd_gr(append(G,[NV*F-1]),cons(NV,V),Mod,0
1744: |gbblock=[[0,length(G)]]);
1745: else
1746: T = nd_gr(append(G,[NV*F-1]),cons(NV,V),Mod,0);
1747: if ( type(car(T)) != 1 ) return [T,NV];
1748: else return 0;
1749: }
1750:
1751: def modular_radical_membership(F,G,V) {
1752: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1753: if ( Mod )
1754: return radical_membership(F,G,V|mod=Mod);
1755:
1756: F = gen_nf(F,G,V,0,0);
1757: if ( !F ) return 0;
1758: NV = ttttt;
1759: for ( J = 0; ; J++ ) {
1760: Mod = lprime(J);
1761: H = map(dp_hc,map(dp_ptod,G,V));
1762: for ( ; H != []; H = cdr(H) ) if ( !(car(H)%Mod) ) break;
1763: if ( H != [] ) continue;
1764:
1765: T = nd_f4(cons(NV*F-1,G),cons(NV,V),Mod,0);
1766: if ( type(car(T)) == 1 ) {
1767: I = radical_membership_rep(F,G,V,-1,0,Mod);
1768: I1 = radical_membership_rep(F,G,V,I,0,0);
1769: if ( I1 > 0 ) return 0;
1770: }
1771: return radical_membership(F,G,V);
1772: }
1773: }
1774:
1775: def radical_membership_rep(F,G,V,Max,Ord,Mod) {
1776: Ft = F;
1777: I = 1;
1778: while ( Max < 0 || I <= Max ) {
1779: Ft = gen_nf(Ft,G,V,Ord,Mod);
1780: if ( !Ft ) return I;
1781: Ft *= F;
1782: I++;
1783: }
1784: return -1;
1785: }
1786:
1787: def ideal_product(A,B,V)
1788: {
1789: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1790: dp_ord(0);
1791: DA = map(dp_ptod,A,V);
1792: DB = map(dp_ptod,B,V);
1793: DegA = map(dp_td,DA);
1794: DegB = map(dp_td,DB);
1795: for ( PA = [], T = A, DT = DegA; T != []; T = cdr(T), DT = cdr(DT) )
1796: PA = cons([car(T),car(DT)],PA);
1797: PA = reverse(PA);
1798: for ( PB = [], T = B, DT = DegB; T != []; T = cdr(T), DT = cdr(DT) )
1799: PB = cons([car(T),car(DT)],PB);
1800: PB = reverse(PB);
1801: R = [];
1802: for ( T = PA; T != []; T = cdr(T) )
1803: for ( S = PB; S != []; S = cdr(S) )
1804: R = cons([car(T)[0]*car(S)[0],car(T)[1]+car(S)[1]],R);
1805: T = qsort(R,comp_by_second);
1806: T = map(first,T);
1807: Len = length(A)>length(B)?length(A):length(B);
1808: Len *= 2;
1809: L = sep_list(T,Len); B0 = L[0]; B1 = L[1];
1810: R = fast_gb(B0,V,Mod,0);
1811: while ( B1 != [] ) {
1812: print(length(B1));
1813: L = sep_list(B1,Len);
1814: B0 = L[0]; B1 = L[1];
1815: R = fast_gb(append(R,B0),V,Mod,0|gbblock=[[0,length(R)]],nora=1);
1816: }
1817: return R;
1818: }
1819:
1820: def saturation(GNV,F,V)
1821: {
1822: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1823: G = GNV[0]; NV = GNV[1];
1824: if ( Mod )
1825: G1 = nd_gr(cons(NV*F-1,G),cons(NV,V),Mod,[[0,1],[0,length(V)]]);
1826: else if ( Procs ) {
1827: Arg0 = ["nd_gr_trace",
1828: cons(NV*F-1,G),cons(NV,V),0,GBCheck,[[0,1],[0,length(V)]]];
1829: Arg1 = ["nd_gr_trace",
1830: cons(NV*F-1,G),cons(NV,V),1,GBCheck,[[0,1],[0,length(V)]]];
1831: G1 = competitive_exec(Procs,Arg0,Arg1);
1832: } else
1833: G1 = nd_gr(cons(NV*F-1,G),cons(NV,V),0,[[0,1],[0,length(V)]]);
1834: return elimination(G1,V);
1835: }
1836:
1837: def sat(G,F,V)
1838: {
1839: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1840: if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
1841: NV = ttttt;
1842: if ( Mod )
1843: G1 = nd_gr(cons(NV*F-1,G),cons(NV,V),Mod,[[0,1],[0,length(V)]]);
1844: else if ( Procs ) {
1845: Arg0 = ["nd_gr_trace",
1846: cons(NV*F-1,G),cons(NV,V),0,GBCheck,[[0,1],[0,length(V)]]];
1847: Arg1 = ["nd_gr_trace",
1848: cons(NV*F-1,G),cons(NV,V),1,GBCheck,[[0,1],[0,length(V)]]];
1849: G1 = competitive_exec(Procs,Arg0,Arg1);
1850: } else {
1851: B1 = append(G,[NV*F-1]);
1852: V1 = cons(NV,V);
1853: Ord1 = [[0,1],[0,length(V)]];
1854: if ( IsGB )
1855: G1 = nd_gr(B1,V1,0,Ord1|gbblock=[[0,length(G)]]);
1856: else
1857: G1 = nd_gr(B1,V1,0,Ord1);
1858: }
1859: return elimination(G1,V);
1860: }
1861:
1862: def satind(G,F,V)
1863: {
1864: if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
1865: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1866: NV = ttttt;
1867: N = length(V);
1868: B = append(G,[NV*F-1]);
1869: V1 = cons(NV,V);
1870: Ord1 = [[0,1],[0,N]];
1871: if ( Mod )
1872: if ( Block )
1873: D = nd_gr(B,V1,Mod,Ord1|nora=1,gentrace=1,gbblock=Block);
1874: else
1875: D = nd_gr(B,V1,Mod,Ord1|nora=1,gentrace=1);
1876: else
1877: if ( Block )
1878: D = nd_gr_trace(B,V1,SatHomo,GBCheck,Ord1
1879: |nora=1,gentrace=1,gbblock=Block);
1880: else
1881: D = nd_gr_trace(B,V1,SatHomo,GBCheck,Ord1
1882: |nora=1,gentrace=1);
1883: G1 = D[0];
1884: Len = length(G1);
1885: Deg = compute_deg(B,V1,NV,D);
1886: D1 = 0;
1887: R = [];
1888: M = length(B);
1889: for ( I = 0; I < Len; I++ ) {
1890: if ( !member(NV,vars(G1[I])) ) {
1891: for ( J = 1; J < M; J++ )
1892: D1 = MAX(D1,Deg[I][J]);
1893: R = cons(G1[I],R);
1894: }
1895: }
1896: return [reverse(R),D1];
1897: }
1898:
1899: def sat_ind(G,F,V)
1900: {
1901: if ( type(Ord=getopt(ord)) == -1 ) Ord = 0;
1902: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1903: NV = ttttt;
1904: F = gen_nf(F,G,V,Ord,Mod);
1905: for ( I = 0, GI = G; ; I++ ) {
1906: G1 = colon(GI,F,V|mod=Mod,ord=Ord);
1907: if ( ideal_inclusion(G1,GI,V,Ord|mod=Mod) ) {
1908: return [GI,I];
1909: }
1910: else GI = G1;
1911: }
1912: }
1913:
1914: def colon(G,F,V)
1915: {
1916: if ( type(Ord=getopt(ord)) == -1 ) Ord = 0;
1917: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1918: if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
1919: F = gen_nf(F,G,V,Ord,Mod);
1920: if ( !F ) return [1];
1921: if ( IsGB )
1922: T = ideal_intersection(G,[F],V,Ord|gbblock=[[0,length(G)]],mod=Mod);
1923: else
1924: T = ideal_intersection(G,[F],V,Ord|mod=Mod);
1925: return Mod?map(sdivm,T,F,Mod):map(ptozp,map(sdiv,T,F));
1926: }
1927:
1928: #if 1
1929: def ideal_colon(G,F,V)
1930: {
1931: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1932: G = nd_gr(G,V,Mod,0);
1933: C = [1];
1934: TV = ttttt;
1935: F = qsort(F,comp_tdeg);
1936: for ( T = F; T != []; T = cdr(T) ) {
1937: S = colon(G,car(T),V|isgb=1,mod=Mod);
1938: if ( type(S[0])!= 1 ) {
1939: C = nd_gr(append(vtol(ltov(C)*TV),vtol(ltov(S)*(1-TV))),
1940: cons(TV,V),Mod,[[0,1],[Ord,length(V)]]|gbblock=[[0,length(C)]]);
1941: C = elimination(C,V);
1942: }
1943: }
1944: return C;
1945: }
1946: #else
1947: def ideal_colon(G,F,V)
1948: {
1949: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1950: G = nd_gr(G,V,Mod,0);
1951: for ( T = F, L = []; T != []; T = cdr(T) ) {
1952: C = colon(G,car(T),V|isgb=1,mod=Mod);
1953: if ( type(C[0]) != 1 ) L = cons(C,L);
1954: }
1955: L = reverse(L);
1956: return ideal_list_intersection(L,V,0|mod=Mod);
1957: }
1958:
1959: #endif
1960:
1961: def ideal_colon1(G,F,V)
1962: {
1963: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1964: F = qsort(F,comp_tdeg);
1965: T = mingen(F,V|mod=Mod);
1966: return ideal_colon(G,T,V|mod=Mod);
1967: }
1968:
1969: def member(A,L)
1970: {
1971: for ( ; L != []; L = cdr(L) )
1972: if ( car(L) == A ) return 1;
1973: return 0;
1974: }
1975:
1976: def mingen(B,V) {
1977: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1978: Data = nd_gr(B,V,Mod,O|gentrace=1,gensyz=1);
1979: G = Data[0];
1980: S = compute_gbsyz(V,Data);
1981: S = dtop(S,V);
1982: R = topnum(S);
1983: N = length(G);
1984: U = [];
1985: for ( I = 0; I < N; I++ )
1986: if ( !member(I,R) ) U = cons(G[I],U);
1987: return U;
1988: }
1989:
1990: def compute_gbsyz(V,Data)
1991: {
1992: G = Data[0];
1993: Homo = Data[1];
1994: Trace = Data[2];
1995: IntRed = Data[3];
1996: Ind = Data[4];
1997: InputRed = Data[5];
1998: SpairTrace = Data[6];
1999: DB = map(dp_ptod,G,V);
2000: N = length(G);
2001: P = vector(N);
2002: for ( I = 0; I < N; I++ ) {
2003: C = vector(N); C[I] = 1; P[I] = C;
2004: }
2005: U = [];
2006: for ( T = SpairTrace; T != []; T = cdr(T) ) {
2007: Ti = car(T);
2008: if ( Ti[0] != -1 ) error("Input is not a GB");
2009: R = recompute_trace3(Ti[1],P,0);
2010: U = cons(redcoef(R)[0],U);
2011: }
2012: return reverse(U);
2013: }
2014:
2015: def redcoef(L) {
2016: N =L[0]$ D = L[1]$ Len = length(N)$
2017: for ( I = 0; I < Len; I++ ) if ( N[I] ) break;
2018: if ( I == Len ) return [N,0];
2019: for ( I = 0, G = D; I < Len; I++ )
2020: if ( N[I] ) G = igcd(G,dp_hc(N[I])/dp_hc(dp_ptozp(N[I])));
2021: return [N/G,D/G];
2022: }
2023:
2024: def recompute_trace3(Ti,P,C)
2025: {
2026: for ( Num = 0, Den = 1; Ti != []; Ti = cdr(Ti) ) {
2027: Sj = car(Ti); Dj = Sj[0]; Ij =Sj[1]; Mj = Sj[2]; Cj = Sj[3];
2028: /* Num/Den <- (Dj*(Num/Den)+Mj*P[Ij])/Cj */
2029: /* Num/Den <- (Dj*Num+Den*Mj*P[Ij])/(Den*Cj) */
2030: if ( Dj )
2031: Num = (Dj*Num+Den*Mj*P[Ij]);
2032: Den *= Cj;
2033: if ( C ) C *= Dj;
2034: }
2035: return [Num,C];
2036: }
2037:
2038: def dtop(A,V)
2039: {
2040: T = type(A);
2041: if ( T == 4 || T == 5 || T == 6 )
2042: return map(dtop,A,V);
2043: else if ( T == 9 ) return dp_dtop(A,V);
2044: else return A;
2045: }
2046:
2047: def topnum(L)
2048: {
2049: for ( R = [], T = L; T != []; T = cdr(T) ) {
2050: V = car(T);
2051: N = length(V);
2052: for ( I = 0; I < N && !V[I]; I++ );
2053: if ( type(V[I])==1 ) R = cons(I,R);
2054: }
2055: return reverse(R);
2056: }
2057:
2058: def ideal_sat(G,F,V)
2059: {
2060: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
2061: G = nd_gr(G,V,Mod,0);
2062: for ( T = F, L = []; T != []; T = cdr(T) )
2063: L = cons(sat(G,car(T),V|mod=Mod),L);
2064: L = reverse(L);
2065: return ideal_list_intersection(L,V,0|mod=Mod);
2066: }
2067:
2068: def ideal_inclusion(F,G,V,O)
2069: {
2070: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
2071: for ( T = F; T != []; T = cdr(T) )
2072: if ( gen_nf(car(T),G,V,O,Mod) ) return 0;
2073: return 1;
2074: }
2075:
2076: /* remove redundant components */
2077:
2078: def qd_simp_comp(QP,V)
2079: {
2080: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
2081: R = ltov(QP);
2082: N = length(R);
2083: for ( I = 0; I < N; I++ ) {
2084: if ( R[I] ) {
2085: QI = R[I][0]; PI = R[I][1];
2086: for ( J = I+1; J < N; J++ )
2087: if ( R[J] && gen_gb_comp(PI,R[J][1],Mod) ) {
2088: QI = ideal_intersection(QI,R[J][0],V,0|mod=Mod);
2089: R[J] = 0;
2090: }
2091: R[I] = [QI,PI];
2092: }
2093: }
2094: for ( I = N-1, S = []; I >= 0; I-- )
2095: if ( R[I] ) S = cons(R[I],S);
2096: return S;
2097: }
2098:
2099: def qd_remove_redundant_comp(G,Iso,Emb,V,Ord)
2100: {
2101: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
2102: IsoInt = ideal_list_intersection(map(first,Iso),V,Ord|mod=Mod);
2103: Emb = qd_simp_comp(Emb,V|mod=Mod);
2104: Emb = reverse(qsort(Emb));
2105: A = ltov(Emb); N = length(A);
2106: Pre = IsoInt; Post = vector(N+1);
2107: for ( Post[N] = IsoInt, I = N-1; I >= 1; I-- )
2108: Post[I] = ideal_intersection(Post[I+1],A[I][0],V,Ord|mod=Mod);
2109: for ( I = 0; I < N; I++ ) {
2110: print(".",2);
2111: Int = ideal_intersection(Pre,Post[I+1],V,Ord|mod=Mod);
2112: if ( gen_gb_comp(Int,G,Mod) ) A[I] = 0;
2113: else
2114: Pre = ideal_intersection(Pre,A[I][0],V,Ord|mod=Mod);
2115: }
2116: for ( T = [], I = 0; I < N; I++ )
2117: if ( A[I] ) T = cons(A[I],T);
2118: return reverse(T);
2119: }
2120:
2121: def pd_simp_comp(PL,V)
2122: {
2123: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
2124: if ( type(First=getopt(first)) == -1 ) First = 0;
2125: A = ltov(PL); N = length(A);
2126: if ( N == 1 ) return PL;
2127: for ( I = 0; I < N; I++ ) {
2128: if ( !A[I] ) continue;
2129: AI = First?A[I][0]:A[I];
2130: for ( J = 0; J < N; J++ ) {
2131: if ( J == I || !A[J] ) continue;
2132: AJ = First?A[J][0]:A[J];
2133: if ( gen_gb_comp(AI,AJ,Mod) || ideal_inclusion(AI,AJ,V,Ord|mod=Mod) )
2134: A[J] = 0;
2135: }
2136: }
2137: for ( I = 0, T = []; I < N; I++ ) if ( A[I] ) T = cons(A[I],T);
2138: return reverse(T);
2139: }
2140:
2141: def pd_remove_redundant_comp(G,P,V,Ord)
2142: {
2143: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
2144: if ( type(First=getopt(first)) == -1 ) First = 0;
2145: if ( length(P) == 1 ) return P;
2146:
2147: A = ltov(P); N = length(A);
2148: for ( I = 0; I < N; I++ ) {
2149: if ( !A[I] ) continue;
2150: for ( J = I+1; J < N; J++ )
2151: if ( A[J] &&
2152: gen_gb_comp(First?A[I][0]:A[I],First?A[J][0]:A[J],Mod) ) A[J] = 0;
2153: }
2154: for ( I = 0, T = []; I < N; I++ ) if ( A[I] ) T = cons(A[I],T);
2155: A = ltov(reverse(T)); N = length(A);
2156: Pre = [1]; Post = vector(N+1);
2157: for ( Post[N] = [1], I = N-1; I >= 1; I-- )
2158: Post[I] = ideal_intersection(Post[I+1],First?A[I][0]:A[I],V,Ord|mod=Mod);
2159: for ( I = 0; I < N; I++ ) {
2160: Int = ideal_intersection(Pre,Post[I+1],V,Ord|mod=Mod);
2161: if ( gen_gb_comp(Int,G,Mod) ) A[I] = 0;
2162: else
2163: Pre = ideal_intersection(Pre,First?A[I][0]:A[I],V,Ord|mod=Mod);
2164: }
2165: for ( T = [], I = 0; I < N; I++ ) if ( A[I] ) T = cons(A[I],T);
2166: return reverse(T);
2167: }
2168:
2169: /* polynomial operations */
2170:
2171: def ppart(F,V,Mod)
2172: {
2173: if ( !Mod )
2174: G = nd_gr([F],[V],0,0);
2175: else
2176: G = dp_gr_mod_main([F],[V],0,Mod,0);
2177: return G[0];
2178: }
2179:
2180:
2181: def sq(F,Mod)
2182: {
2183: if ( !F ) return 0;
2184: A = cdr(gen_fctr(F,Mod));
2185: for ( R = 1; A != []; A = cdr(A) )
2186: R *= car(car(A));
2187: return R;
2188: }
2189:
2190: def lcfactor(G,V,O,Mod)
2191: {
2192: O0 = dp_ord(); dp_ord(O);
2193: C = [];
2194: for ( T = G; T != []; T = cdr(T) ) {
2195: C1 = dp_hc(dp_ptod(car(T),V));
2196: S = gen_fctr(C1,Mod);
2197: for ( S = cdr(S); S != []; S = cdr(S) )
2198: if ( !member(S[0][0],C) ) C = cons(S[0][0],C);
2199: }
2200: dp_ord(O0);
2201: return C;
2202: }
2203:
2204: def gen_fctr(F,Mod)
2205: {
2206: if ( Mod ) return modfctr(F,Mod);
2207: else return fctr(F);
2208: }
2209:
2210: def gen_mptop(F)
2211: {
2212: if ( !F ) return F;
2213: else if ( type(F)==1 )
2214: if ( ntype(F)==5 ) return mptop(F);
2215: else return F;
2216: else {
2217: V = var(F);
2218: D = deg(F,V);
2219: for ( R = 0, I = 0; I <= D; I++ )
2220: if ( C = coef(F,I,V) ) R += gen_mptop(C)*V^I;
2221: return R;
2222: }
2223: }
2224:
2225: def gen_nf(F,G,V,Ord,Mod)
2226: {
2227: if ( !Mod ) return p_nf(F,G,V,Ord);
2228:
2229: setmod(Mod);
2230: dp_ord(Ord); DF = dp_mod(dp_ptod(F,V),Mod,[]);
2231: N = length(G); DG = newvect(N);
2232: for ( I = N-1, IL = []; I >= 0; I-- ) {
2233: DG[I] = dp_mod(dp_ptod(G[I],V),Mod,[]);
2234: IL = cons(I,IL);
2235: }
2236: T = dp_nf_mod(IL,DF,DG,1,Mod);
2237: for ( R = 0; T; T = dp_rest(T) )
2238: R += gen_mptop(dp_hc(T))*dp_dtop(dp_ht(T),V);
2239: return R;
2240: }
2241:
2242: /* Ti = [D,I,M,C] */
2243:
2244: def compute_deg0(Ti,P,V,TV)
2245: {
2246: N = length(P[0]);
2247: Num = vector(N);
2248: for ( I = 0; I < N; I++ ) Num[I] = -1;
2249: for ( ; Ti != []; Ti = cdr(Ti) ) {
2250: Sj = car(Ti);
2251: Dj = Sj[0];
2252: Ij =Sj[1];
2253: Mj = deg(type(Sj[2])==9?dp_dtop(Sj[2],V):Sj[2],TV);
2254: Pj = P[Ij];
2255: if ( Dj )
2256: for ( I = 0; I < N; I++ )
2257: if ( Pj[I] >= 0 ) {
2258: T = Mj+Pj[I];
2259: Num[I] = MAX(Num[I],T);
2260: }
2261: }
2262: return Num;
2263: }
2264:
2265: def compute_deg(B,V,TV,Data)
2266: {
2267: GB = Data[0];
2268: Homo = Data[1];
2269: Trace = Data[2];
2270: IntRed = Data[3];
2271: Ind = Data[4];
2272: DB = map(dp_ptod,B,V);
2273: if ( Homo ) {
2274: DB = map(dp_homo,DB);
2275: V0 = append(V,[hhh]);
2276: } else
2277: V0 = V;
2278: Perm = Trace[0]; Trace = cdr(Trace);
2279: for ( I = length(Perm)-1, T = Trace; T != []; T = cdr(T) )
2280: if ( (J=car(T)[0]) > I ) I = J;
2281: N = I+1;
2282: N0 = length(B);
2283: P = vector(N);
2284: for ( T = Perm, I = 0; T != []; T = cdr(T), I++ ) {
2285: Pi = car(T);
2286: C = vector(N0);
2287: for ( J = 0; J < N0; J++ ) C[J] = -1;
2288: C[Pi[1]] = 0;
2289: P[Pi[0]] = C;
2290: }
2291: for ( T = Trace; T != []; T = cdr(T) ) {
2292: Ti = car(T); P[Ti[0]] = compute_deg0(Ti[1],P,V0,TV);
2293: }
2294: M = length(Ind);
2295: for ( T = IntRed; T != []; T = cdr(T) ) {
2296: Ti = car(T); P[Ti[0]] = compute_deg0(Ti[1],P,V,TV);
2297: }
2298: R = [];
2299: for ( J = 0; J < M; J++ ) {
2300: U = P[Ind[J]];
2301: R = cons(U,R);
2302: }
2303: return reverse(R);
2304: }
2305:
2306: /* set theoretic functions */
2307:
2308: def member(A,S)
2309: {
2310: for ( ; S != []; S = cdr(S) )
2311: if ( car(S) == A ) return 1;
2312: return 0;
2313: }
2314:
2315: def elimination(G,V) {
2316: for ( R = [], T = G; T != []; T = cdr(T) )
2317: if ( setminus(vars(car(T)),V) == [] ) R =cons(car(T),R);
2318: return R;
2319: }
2320:
2321: def setintersection(A,B)
2322: {
2323: for ( L = []; A != []; A = cdr(A) )
2324: if ( member(car(A),B) )
2325: L = cons(car(A),L);
2326: return L;
2327: }
2328:
2329: def setminus(A,B) {
2330: for ( T = reverse(A), R = []; T != []; T = cdr(T) ) {
2331: for ( S = B, M = car(T); S != []; S = cdr(S) )
2332: if ( car(S) == M ) break;
2333: if ( S == [] ) R = cons(M,R);
2334: }
2335: return R;
2336: }
2337:
2338: def sep_list(L,N)
2339: {
2340: if ( length(L) <= N ) return [L,[]];
2341: R = [];
2342: for ( T = L, I = 0; I < N; I++, T = cdr(T) )
2343: R = cons(car(T),R);
2344: return [reverse(R),T];
2345: }
2346:
2347: def first(L)
2348: {
2349: return L[0];
2350: }
2351:
2352: def second(L)
2353: {
2354: return L[1];
2355: }
2356:
2357: def third(L)
2358: {
2359: return L[2];
2360: }
2361:
2362: def first_second(L)
2363: {
2364: return [L[0],L[1]];
2365: }
2366:
2367: def comp_tord(A,B)
2368: {
2369: DA = dp_ht(A);
2370: DB = dp_ht(B);
2371: if ( DA > DB ) return 1;
2372: else if ( DA < DB ) return -1;
2373: else return 0;
2374: }
2375:
2376: def comp_tdeg(A,B)
2377: {
2378: DA = tdeg(A);
2379: DB = tdeg(B);
2380: if ( DA > DB ) return 1;
2381: else if ( DA < DB ) return -1;
2382: else return 0;
2383: }
2384:
2385: def comp_tdeg_first(A,B)
2386: {
2387: DA = tdeg(A[0]);
2388: DB = tdeg(B[0]);
2389: if ( DA > DB ) return 1;
2390: else if ( DA < DB ) return -1;
2391: else return 0;
2392: }
2393:
2394: def comp_third_tdeg(A,B)
2395: {
2396: if ( A[2] > B[2] ) return 1;
2397: if ( A[2] < B[2] ) return -1;
2398: DA = tdeg(A[0]);
2399: DB = tdeg(B[0]);
2400: if ( DA > DB ) return 1;
2401: else if ( DA < DB ) return -1;
2402: else return 0;
2403: }
2404:
2405: def tdeg(P)
2406: {
2407: dp_ord(0);
2408: return dp_td(dp_ptod(P,vars(P)));
2409: }
2410:
2411: def comp_by_ord(A,B)
2412: {
2413: if ( dp_ht(A) > dp_ht(B) ) return 1;
2414: else if ( dp_ht(A) < dp_ht(B) ) return -1;
2415: else return 0;
2416: }
2417:
2418: def comp_by_second(A,B)
2419: {
2420: if ( A[1] > B[1] ) return 1;
2421: else if ( A[1] < B[1] ) return -1;
2422: else return 0;
2423: }
2424:
2425: def get_lc(F)
2426: {
2427: if ( type(F)==1 ) return F;
2428: V = var(F);
2429: D = deg(F,V);
2430: return get_lc(coef(F,D,V));
2431: }
2432:
2433: def tomonic(F,Mod)
2434: {
2435: C = get_lc(F);
2436: IC = inv(C,Mod);
2437: return (IC*F)%Mod;
2438: }
2439:
2440: def gen_gb_comp(A,B,Mod)
2441: {
2442: if ( !Mod ) return gb_comp(A,B);
2443: LA = length(A); LB = length(B);
2444: if ( LA != LB ) return 0;
2445: A = map(tomonic,A,Mod);
2446: B = map(tomonic,B,Mod);
2447: A = qsort(A); B = qsort(B);
2448: if ( A != B ) return 0;
2449: return 1;
2450: }
2451:
2452: def prod(L)
2453: {
2454: for ( R = 1; L != []; L = cdr(L) )
2455: R *= car(L);
2456: return R;
2457: }
2458:
2459: def monodec0(B,V)
2460: {
2461: M = monodec(B,V);
2462: return map(vars,M);
2463: }
2464:
2465: def monodec(B,V)
2466: {
2467: B = map(sq,B,0);
2468: G = nd_gr_postproc(B,V,0,0,0);
2469: V = vars(G);
2470: N = length(V);
2471: if ( N == 0 ) return G == [] ? [[]] : [];
2472: if ( N == 1 ) return G;
2473: if ( N < 20 ) {
2474: T = dp_mono_raddec(G,V);
2475: return map(prod,T);
2476: }
2477: X = car(V); W = cdr(V);
2478: D0 = monodec(map(subst,B,X,0),W);
2479: T0 = map(dp_ptod,D0,W);
2480: D1 = monodec(map(subst,B,X,1),W);
2481: T1 = map(dp_ptod,D1,W);
2482: for ( T = T1; T != []; T = cdr(T) ) {
2483: for ( M = car(T), S1 = [], S = T0; S != []; S = cdr(S) )
2484: if ( !dp_redble(car(S),M) ) S1= cons(car(S),S1);
2485: T0 = S1;
2486: }
2487: D0 = map(dp_dtop,T0,W);
2488: D0 = vtol(X*ltov(D0));
2489: return append(D0,D1);
2490: }
2491:
2492: def separator(P,V)
2493: {
2494: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
2495: N = length(P);
2496: M = matrix(N,N);
2497: for ( I = 0; I < N; I++ ) {
2498: /* M[I][J] is an element of P[I]-P[J] */
2499: PI = qsort(P[I][0],comp_tdeg);
2500: for ( J = 0; J < N; J++ ) {
2501: if ( J == I ) continue;
2502: for ( T = PI; T != []; T = cdr(T) )
2503: if ( gen_nf(car(T),P[J][0],V,0,Mod) ) break;
2504: M[I][J] = sq(car(T),Mod);
2505: }
2506: }
2507: S = vector(N);
2508: for ( J = 0; J < N; J++ ) {
2509: for ( I = 0, T = 1; I < N; I++ ) {
2510: if ( I == J ) continue;
2511: T = sq(T*M[I][J],Mod);
2512: }
2513: S[J] = T;
2514: }
2515: return S;
2516: }
2517:
2518: def prepost(PL,V)
2519: {
2520: A = ltov(PL); N = length(A);
2521: Pre = vector(N);
2522: Post = vector(N);
2523: R = vector(N);
2524: Pre[0] = [1];
2525: print("pre ",2);
2526: for ( I = 1; I < N; I++, print(".",2) )
2527: Pre[I] = ideal_intersection(Pre[I-1],A[I-1][0],V,0
2528: |gbblock=[[0,length(Pre[I-1])]],mod=Mod);
2529: print("done");
2530: print("post ",2);
2531: Post[N-1] = [1];
2532: for ( I = N-2; I >= 0; I--, print(".",2) )
2533: Post[I] = ideal_intersection(Post[I+1],A[I+1][0],V,0
2534: |gbblock=[[0,length(Post[I+1])]],mod=Mod);
2535: print("done");
2536: print("int ",2);
2537: for ( I = 0; I < N; I++, print(".",2) )
2538: R[I] = ideal_intersection(Pre[I],Post[I],V,0
2539: |gbblock=[[0,length(Pre[I])],[length(Pre[I]),length(Post[I])]],
2540: mod=Mod);
2541: print("done");
2542: return R;
2543: }
2544:
2545: /* XXX */
2546:
2547: def call_func(Arg)
2548: {
2549: F = car(Arg);
2550: return call(strtov(F),cdr(Arg));
2551: }
2552:
2553: def competitive_exec(P,Arg0,Arg1)
2554: {
2555: P0 = P[0]; P1 = P[1];
2556: ox_cmo_rpc(P0,"noro_pd.call_func",Arg0|sync=1);
2557: ox_cmo_rpc(P1,"noro_pd.call_func",Arg1|sync=1);
2558: F = ox_select(P);
2559: R = ox_get(F[0]);
2560: if ( length(F) == 2 ) {
2561: ox_get(F[1]);
2562: } else {
2563: U = setminus(P,F);
2564: ox_reset(U[0]);
2565: }
2566: return R;
2567: }
2568:
2569:
2570: def nd_gr_rat(B,V,PV,Ord1,Ord)
2571: {
2572: G = nd_gr(B,append(V,PV),0,Ord1);
2573: G1 = nd_gr_postproc(G,V,0,Ord,0);
2574: return G1;
2575: }
2576:
2577: /* Task[i] = [fname,[arg0,...,argn]] */
2578:
2579: def para_exec(Proc,Task) {
2580: Free = Proc;
2581: N = length(Task);
2582: R = [];
2583: while ( N ) {
2584: while ( Task != [] && Free != [] ) {
2585: T = car(Task); Task = cdr(Task);
2586: ox_cmo_rpc(car(Free),"noro_pd.call_func",T);
2587: ox_push_cmd(car(Free),258); Free = cdr(Free);
2588: }
2589: Finish0 = Finish = ox_select(Proc);
2590: for ( ; Finish != []; Finish = cdr(Finish) ) {
2591: print(".",2);
2592: L = ox_get(car(Finish));
2593: R = cons(L,R);
2594: N--;
2595: }
2596: Free = append(Free,Finish0);
2597: }
2598: print("");
2599: return reverse(R);
2600: }
2601: endmodule$
2602: end$