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