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