Annotation of OpenXM/src/asir-contrib/testing/noro/pd.rr, Revision 1.10
1.10 ! noro 1: /* $OpenXM$ */
1.1 noro 2: import("gr")$
3: module noro_pd$
4: static GBCheck,F4,Procs,SatHomo$
5:
6: localf init_procs, kill_procs, syca_dec, syc_dec, find_separating_ideal0$
7: localf find_separating_ideal1, find_separating_ideal2$
8: localf sy_dec, pseudo_dec, iso_comp, prima_dec$
9: localf prime_dec, prime_dec_main, lex_predec1, zprimedec, zprimadec$
10: localf complete_qdecomp, partial_qdecomp, partial_qdecomp0, complete_decomp$
11: localf partial_decomp, partial_decomp0, zprimacomp, zprimecomp$
1.5 noro 12: localf fast_gb, incremental_gb, elim_gb, ldim, make_mod_subst$
1.1 noro 13: localf rsgn, find_npos, gen_minipoly, indepset$
14: localf maxindep, contraction, ideal_list_intersection, ideal_intersection$
1.7 noro 15: localf radical_membership, modular_radical_membership$
1.1 noro 16: localf radical_membership_rep, ideal_product, saturation$
17: localf sat, satind, sat_ind, colon$
1.2 noro 18: localf ideal_colon, ideal_sat, ideal_inclusion, qd_simp_comp, qd_remove_redundant_comp$
1.7 noro 19: localf pd_remove_redundant_comp, ppart, sq, gen_fctr, gen_nf, gen_gb_comp$
20: localf gen_mptop, lcfactor, compute_deg0, compute_deg, member$
1.1 noro 21: localf elimination, setintersection, setminus, sep_list$
22: localf first_element, comp_tdeg, tdeg, comp_by_ord, comp_by_second$
1.7 noro 23: localf gbcheck,f4,sathomo,qd_check$
1.1 noro 24:
25: SatHomo=0$
26: GBCheck=1$
27:
28: #define MAX(a,b) ((a)>(b)?(a):(b))
29:
30: def gbcheck(A)
31: {
32: if ( A ) GBCheck = 1;
1.3 noro 33: else GBCheck = -1;
1.1 noro 34: }
35:
36: def f4(A)
37: {
38: if ( A ) F4 = 1;
39: else F4 = 0;
40: }
41:
42: def sathomo(A)
43: {
44: if ( A ) SatHomo = 1;
45: else SatHomo = 0;
46: }
47:
48: def init_procs()
49: {
50: if ( type(NoX=getopt(nox)) == -1 ) NoX = 0;
51: if ( !Procs ) {
52: if ( NoX ) {
53: P0 = ox_launch_nox();
54: P1 = ox_launch_nox();
55: } else {
56: P0 = ox_launch();
57: P1 = ox_launch();
58: }
59: Procs = [P0,P1];
60: }
61: }
62:
63: def kill_procs()
64: {
65: if ( Procs ) {
66: ox_shutdown(Procs[0]);
67: ox_shutdown(Procs[1]);
68: Procs = 0;
69: }
70: }
71:
1.6 noro 72: def qd_check(B,V,QD)
73: {
1.7 noro 74: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
75: G = nd_gr(B,V,Mod,0);
76: Iso = ideal_list_intersection(map(first_element,QD[0]),V,0|mod=Mod);
77: Emb = ideal_list_intersection(map(first_element,QD[1]),V,0|mod=Mod);
78: GG = ideal_intersection(Iso,Emb,V,0|mod=Mod);
79: return gen_gb_comp(G,GG,Mod);
1.6 noro 80: }
81:
1.1 noro 82: /* SYC primary decomositions */
83:
84: def syca_dec(B,V)
85: {
86: T00 = time();
1.7 noro 87: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1 noro 88: if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0;
89: if ( type(SepIdeal=getopt(sepideal)) == -1 ) SepIdeal = 1;
90: if ( type(NoSimp=getopt(nosimp)) == -1 ) NoSimp = 0;
91: if ( type(Time=getopt(time)) == -1 ) Time = 0;
92: Ord = 0;
1.7 noro 93: Gt = G0 = G = fast_gb(B,V,Mod,Ord);
1.1 noro 94: Q0 = Q = []; IntQ0 = IntQ = [1]; First = 1;
95: C = 0;
96:
97: Tass = Tiso = Tcolon = Tsep = Tirred = 0;
98: Rass = Riso = Rcolon = Rsep = Rirred = 0;
99: while ( 1 ) {
100: if ( type(Gt[0])==1 ) break;
101: T0 = time();
1.8 noro 102: PtR = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec,mod=Mod,radical=1);
1.1 noro 103: T1 = time(); Tass += T1[0]-T0[0]+T1[1]-T0[1]; Rass += T1[3]-T0[3];
1.8 noro 104: Pt = PtR[0]; IntPt = PtR[1];
105: if ( gen_gb_comp(Gt,IntPt,Mod) ) {
106: /* Gt is radical and Gt = cap Pt */
107: for ( T = Pt, Qt = []; T != []; T = cdr(T) )
108: Qt = cons([car(T)[0],car(T)[0]],Qt);
109: if ( First )
110: return [Qt,[]];
111: else
112: Q0 = append(Qt,Q0);
113: break;
114: }
1.1 noro 115: T0 = time();
1.7 noro 116: Qt = iso_comp(Gt,Pt,V,Ord|mod=Mod,isgb=1);
1.1 noro 117: T1 = time(); Tiso += T1[0]-T0[0]+T1[1]-T0[1]; Riso += T1[3]-T0[3];
1.7 noro 118: IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord|mod=Mod);
1.1 noro 119: if ( First ) {
120: IntQ0 = IntQ = IntQt; IntP = IntPt; Qi = Qt; First = 0;
121: } else {
1.7 noro 122: IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod);
123: if ( gen_gb_comp(IntQ,IntQ1,Mod) ) {
1.1 noro 124: G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
125: continue;
126: } else {
127: IntQ = IntQ1;
1.7 noro 128: IntQ1 = ideal_intersection(IntQ0,IntQt,V,Ord|mod=Mod);
129: if ( !gen_gb_comp(IntQ0,IntQ1,Mod) ) {
130: Q = append(Qt,Q);
131: #if 1
132: for ( T = Qt; T != []; T = cdr(T) )
133: if ( !ideal_inclusion(IntQ0,car(T)[0],V,Ord|mod=Mod) )
134: Q0 = append(Q0,[car(T)]);
135: #else
136: Q0 = append(Q0,Qt);
137: #endif
1.1 noro 138: IntQ0 = IntQ1;
139: }
140: }
141: }
1.7 noro 142: if ( gen_gb_comp(IntQt,Gt,Mod) || gen_gb_comp(IntQ,G,Mod) || gen_gb_comp(IntQ0,G0,Mod) ) break;
1.1 noro 143: T0 = time();
1.7 noro 144: C1 = ideal_colon(G,IntQ,V|mod=Mod);
1.1 noro 145: T1 = time(); Tcolon += T1[0]-T0[0]+T1[1]-T0[1]; Rcolon += T1[3]-T0[3];
1.7 noro 146: if ( C && gen_gb_comp(C,C1,Mod) ) {
1.1 noro 147: G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
148: continue;
149: } else C = C1;
150: T0 = time();
151: if ( SepIdeal == 0 )
1.7 noro 152: Ok = find_separating_ideal0(C,G,IntQ,IntP,V,Ord|mod=Mod);
1.1 noro 153: else if ( SepIdeal == 1 )
1.7 noro 154: Ok = find_separating_ideal1(C,G,IntQ,IntP,V,Ord|mod=Mod);
1.1 noro 155: else if ( SepIdeal == 2 )
1.7 noro 156: Ok = find_separating_ideal2(C,G,IntQ,IntP,V,Ord|mod=Mod);
1.1 noro 157: G1 = append(Ok,G);
1.8 noro 158: Gt1 = incremental_gb(G1,V,Ord|mod=Mod);
1.1 noro 159: T1 = time(); Tsep += T1[0]-T0[0]+T1[1]-T0[1]; Rsep += T1[3]-T0[3];
160: #if 0
1.7 noro 161: if ( ideal_inclusion(Gt1,Gt,V,Ord|mod=Mod) ) {
1.1 noro 162: G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
163: } else
164: #endif
165: Gt = Gt1;
166: }
167: T0 = time();
1.7 noro 168: if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G0,Qi,Q0,V,Ord|mod=Mod);
1.1 noro 169: else Q1 = Q0;
170: if ( Time ) {
171: T1 = time(); Tirred += T1[0]-T0[0]+T1[1]-T0[1]; Rirred += T1[3]-T0[3];
172: Tall = T1[0]-T00[0]+T1[1]-T00[1]; Rall += T1[3]-T00[3];
173: print(["total",Tall,"ass",Tass,"iso",Tiso, "colon",Tcolon,"sep",Tsep,"irred",Tirred]);
174: print(["Rtotal",Rall,"Rass",Rass,"Riso",Riso, "Rcolon",Rcolon,"Rsep",Rsep,"Rirred",Rirred]);
175: print(["iso",length(Qi),"emb",length(Q0),"->",length(Q1)]);
176: }
177: return [Qi,Q1];
178: }
179:
180: def syc_dec(B,V)
181: {
182: T00 = time();
1.7 noro 183: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1 noro 184: if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0;
185: if ( type(SepIdeal=getopt(sepideal)) == -1 ) SepIdeal = 1;
186: if ( type(NoSimp=getopt(nosimp)) == -1 ) NoSimp = 0;
187: if ( type(Time=getopt(time)) == -1 ) Time = 0;
188: Ord = 0;
1.7 noro 189: G = fast_gb(B,V,Mod,Ord);
1.1 noro 190: Q = []; IntQ = [1]; Gt = G; First = 1;
191: Tass = Tiso = Tcolon = Tsep = Tirred = 0;
192: Rass = Riso = Rcolon = Rsep = Rirred = 0;
193: while ( 1 ) {
194: if ( type(Gt[0])==1 ) break;
195: T0 = time();
1.8 noro 196: PtR = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec,mod=Mod,radical=1);
1.1 noro 197: T1 = time(); Tass += T1[0]-T0[0]+T1[1]-T0[1]; Rass += T1[3]-T0[3];
1.8 noro 198: Pt = PtR[0]; IntPt = PtR[1];
199: if ( gen_gb_comp(Gt,IntPt,Mod) ) {
200: /* Gt is radical and Gt = cap Pt */
201: for ( T = Pt, Qt = []; T != []; T = cdr(T) )
202: Qt = cons([car(T)[0],car(T)[0]],Qt);
203: if ( First )
204: return [Qt,[]];
205: else
206: Q = append(Qt,Q);
207: break;
208: }
209:
1.1 noro 210: T0 = time();
1.7 noro 211: Qt = iso_comp(Gt,Pt,V,Ord|mod=Mod,isgb=1);
1.1 noro 212: T1 = time(); Tiso += T1[0]-T0[0]+T1[1]-T0[1]; Riso += T1[3]-T0[3];
1.7 noro 213: IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord|mod=Mod);
1.1 noro 214: if ( First ) {
215: IntQ = IntQt; Qi = Qt; First = 0;
216: } else {
1.7 noro 217: IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod);
218: if ( !gen_gb_comp(IntQ1,IntQ,Mod) )
1.1 noro 219: Q = append(Qt,Q);
220: }
1.7 noro 221: if ( gen_gb_comp(IntQ,G,Mod) || gen_gb_comp(IntQt,Gt,Mod) )
1.1 noro 222: break;
223: T0 = time();
1.7 noro 224: C = ideal_colon(Gt,IntQt,V|mod=Mod);
1.1 noro 225: T1 = time(); Tcolon += T1[0]-T0[0]+T1[1]-T0[1]; Rcolon += T1[3]-T0[3];
1.2 noro 226: T0 = time();
1.1 noro 227: if ( SepIdeal == 0 )
1.7 noro 228: Ok = find_separating_ideal0(C,Gt,IntQt,IntPt,V,Ord|mod=Mod);
1.1 noro 229: else if ( SepIdeal == 1 )
1.7 noro 230: Ok = find_separating_ideal1(C,Gt,IntQt,IntPt,V,Ord|mod=Mod);
1.1 noro 231: else if ( SepIdeal == 2 )
1.7 noro 232: Ok = find_separating_ideal2(C,Gt,IntQt,IntPt,V,Ord|mod=Mod);
1.1 noro 233: G1 = append(Ok,Gt);
1.8 noro 234: Gt = incremental_gb(G1,V,Ord|mod=Mod);
1.1 noro 235: T1 = time(); Tsep += T1[0]-T0[0]+T1[1]-T0[1]; Rsep += T1[3]-T0[3];
236: }
237: T0 = time();
1.7 noro 238: if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G,Qi,Q,V,Ord|mod=Mod);
1.1 noro 239: else Q1 = Q;
240: T1 = time(); Tirred += T1[0]-T0[0]+T1[1]-T0[1]; Rirred += T1[3]-T0[3];
241: Tall = T1[0]-T00[0]+T1[1]-T00[1]; Rall += T1[3]-T00[3];
242: if ( Time ) {
243: print(["total",Tall,"ass",Tass,"iso",Tiso, "colon",Tcolon,"sep",Tsep,"irred",Tirred]);
244: print(["Rtotal",Rall,"Rass",Rass,"Riso",Riso, "Rcolon",Rcolon,"Rsep",Rsep,"Rirred",Rirred]);
245: print(["iso",length(Qi),"emb",length(Q),"->",length(Q1)]);
246: }
247: return [Qi,Q1];
248: }
249:
1.7 noro 250: /* XXX */
1.1 noro 251: /* C=G:Q, Rad=rad(Q), return J s.t. Q cap (G+J) = G */
252:
253: def find_separating_ideal0(C,G,Q,Rad,V,Ord) {
1.7 noro 254: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1 noro 255: for ( CI = C, I = 1; ; I++ ) {
256: for ( T = CI, S = []; T != []; T = cdr(T) )
1.7 noro 257: if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
1.1 noro 258: if ( S == [] )
259: error("find_separating_ideal0 : cannot happen");
260: G1 = append(S,G);
1.7 noro 261: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
1.1 noro 262: /* check whether (Q cap (G+S)) = G */
1.7 noro 263: if ( gen_gb_comp(Int,G,Mod) ) return reverse(S);
264: CI = ideal_product(CI,C,V|mod=Mod);
1.1 noro 265: }
266: }
267:
268: def find_separating_ideal1(C,G,Q,Rad,V,Ord) {
1.7 noro 269: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1 noro 270: for ( T = C, S = []; T != []; T = cdr(T) )
1.7 noro 271: if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
1.1 noro 272: if ( S == [] )
273: error("find_separating_ideal1 : cannot happen");
274: G1 = append(S,G);
1.7 noro 275: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
1.1 noro 276: /* check whether (Q cap (G+S)) = G */
1.7 noro 277: if ( gen_gb_comp(Int,G,Mod) ) return reverse(S);
1.1 noro 278:
1.5 noro 279: /* or qsort(C,comp_tdeg) */
1.1 noro 280: C = qsort(S,comp_tdeg);
1.5 noro 281:
282: Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
283: Int0 = incremental_gb(append(vtol(ltov(G)*Tmp),vtol(ltov(Q)*(1-Tmp))),
1.7 noro 284: TV,Ord1|gbblock=[[0,length(G)]],mod=Mod);
1.8 noro 285: Dp = dp_gr_print(); dp_gr_print(0);
1.1 noro 286: for ( T = C, S = []; T != []; T = cdr(T) ) {
1.7 noro 287: if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
1.1 noro 288: Ui = U = car(T);
289: for ( I = 1; ; I++ ) {
290: G1 = cons(Ui,G);
1.7 noro 291: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
292: if ( gen_gb_comp(Int,G,Mod) ) break;
1.1 noro 293: else
1.7 noro 294: Ui = gen_nf(Ui*U,G,V,Ord,Mod);
1.1 noro 295: }
1.8 noro 296: print([length(T),I],2);
1.5 noro 297: Int1 = incremental_gb(append(Int0,[Tmp*Ui]),TV,Ord1
1.7 noro 298: |gbblock=[[0,length(Int0)]],mod=Mod);
1.5 noro 299: Int = elimination(Int1,V);
1.8 noro 300: if ( !gen_gb_comp(Int,G,Mod) ) {
1.5 noro 301: break;
1.8 noro 302: } else {
1.5 noro 303: Int0 = Int1;
304: S = cons(Ui,S);
1.1 noro 305: }
306: }
1.8 noro 307: print("");
308: dp_gr_print(Dp);
1.1 noro 309: return reverse(S);
310: }
311:
312: def find_separating_ideal2(C,G,Q,Rad,V,Ord) {
1.7 noro 313: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1 noro 314: for ( T = C, S = []; T != []; T = cdr(T) )
1.7 noro 315: if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
1.1 noro 316: if ( S == [] )
317: error("find_separating_ideal2 : cannot happen");
318: G1 = append(S,G);
1.7 noro 319: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
1.1 noro 320: /* check whether (Q cap (G+S)) = G */
1.7 noro 321: if ( gen_gb_comp(Int,G,Mod) ) return reverse(S);
1.1 noro 322:
1.5 noro 323: /* or qsort(S,comp_tdeg) */
1.1 noro 324: C = qsort(C,comp_tdeg);
1.5 noro 325: Dp = dp_gr_print(); dp_gr_print(0);
1.1 noro 326: for ( T = C, S = []; T != []; T = cdr(T) ) {
1.7 noro 327: if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
1.1 noro 328: Ui = U = car(T);
329: for ( I = 1; ; I++ ) {
1.7 noro 330: G1 = append(G,[Ui]);
331: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod,
332: gbblock=[[0,length(G)],[length(G1),length(Q)]]);
333: if ( gen_gb_comp(Int,G,Mod) ) break;
1.1 noro 334: else
1.7 noro 335: Ui = gen_nf(Ui*U,G,V,Ord,Mod);
1.1 noro 336: }
1.7 noro 337: print([length(T),I],2);
1.1 noro 338: S = cons(Ui,S);
339: }
1.7 noro 340: print("");
1.5 noro 341: S = qsort(S,comp_tdeg);
1.8 noro 342: End = Len = length(S);
1.5 noro 343:
344: Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
1.8 noro 345: Prev = 1;
346: G1 = append(G,[S[0]]);
347: Int0 = incremental_gb(append(vtol(ltov(G1)*Tmp),vtol(ltov(Q)*(1-Tmp))),
348: TV,Ord1|gbblock=[[0,length(G)]],mod=Mod);
349: if ( End > 1 ) {
1.5 noro 350: Cur = 2;
351: while ( Prev < Cur ) {
352: for ( St = [], I = Prev; I < Cur; I++ ) St = cons(Tmp*S[I],St);
353: Int1 = incremental_gb(append(Int0,St),TV,Ord1
1.7 noro 354: |gbblock=[[0,length(Int0)]],mod=Mod);
1.5 noro 355: Int = elimination(Int1,V);
1.7 noro 356: if ( gen_gb_comp(Int,G,Mod) ) {
1.8 noro 357: print([Cur],2);
1.5 noro 358: Prev = Cur;
1.8 noro 359: Cur = Cur+idiv(End-Cur+1,2);
1.5 noro 360: Int0 = Int1;
361: } else {
1.8 noro 362: End = Cur;
1.5 noro 363: Cur = Prev + idiv(Cur-Prev,2);
1.1 noro 364: }
365: }
1.5 noro 366: for ( St = [], I = 0; I < Prev; I++ ) St = cons(S[I],St);
367: } else
1.8 noro 368: St = [S[0]];
369: print("");
1.9 noro 370: for ( I = Prev; I < Len; I++ ) {
371: Int1 = incremental_gb(append(Int0,[Tmp*S[I]]),TV,Ord1
372: |gbblock=[[0,length(Int0)]],mod=Mod);
373: Int = elimination(Int1,V);
374: if ( gen_gb_comp(Int,G,Mod) ) {
375: print([I],2);
376: St = cons(S[I],St);
377: Int0 = Int1;
1.8 noro 378: }
379: }
380: Ok = reverse(St);
381: print("");
1.5 noro 382: print([length(S),length(Ok)]);
383: dp_gr_print(Dp);
1.1 noro 384: return Ok;
385: }
386:
387: /* SY primary decompsition */
388:
389: def sy_dec(B,V)
390: {
1.7 noro 391: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1 noro 392: if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0;
393: Ord = 0;
1.7 noro 394: G = fast_gb(B,V,Mod,Ord);
1.1 noro 395: Q = [];
396: IntQ = [1];
397: Gt = G;
398: First = 1;
399: while ( 1 ) {
400: if ( type(Gt[0]) == 1 ) break;
1.7 noro 401: Pt = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec,mod=Mod);
402: L = pseudo_dec(Gt,Pt,V,Ord|mod=Mod);
1.1 noro 403: Qt = L[0]; Rt = L[1]; St = L[2];
1.7 noro 404: IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord|mod=Mod);
1.1 noro 405: if ( First ) {
406: IntQ = IntQt;
407: Qi = Qt;
408: First = 0;
409: } else {
1.7 noro 410: IntQ = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod);
1.1 noro 411: Q = append(Qt,Q);
412: }
1.7 noro 413: if ( gen_gb_comp(IntQ,G,Mod) ) break;
1.1 noro 414: for ( T = Rt; T != []; T = cdr(T) ) {
415: if ( type(car(T)[0]) == 1 ) continue;
1.7 noro 416: U = sy_dec(car(T),V|nolexdec=Nolexdec,mod=Mod);
417: IntQ = ideal_list_intersection(cons(IntQ,map(first_element,U)),
418: V,Ord|mod=Mod);
1.1 noro 419: Q = append(U,Q);
1.7 noro 420: if ( gen_gb_comp(IntQ,G,Mod) ) break;
1.1 noro 421: }
1.7 noro 422: Gt = fast_gb(append(Gt,St),V,Mod,Ord);
1.1 noro 423: }
1.7 noro 424: Q = qd_remove_redundant_comp(G,Qi,Q,V,Ord|mod=Mod);
1.1 noro 425: return append(Qi,Q);
426: }
427:
428: def pseudo_dec(G,L,V,Ord)
429: {
1.7 noro 430: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1 noro 431: N = length(L);
432: S = vector(N);
433: Q = vector(N);
434: R = vector(N);
435: L0 = map(first_element,L);
436: for ( I = 0; I < N; I++ ) {
437: LI = setminus(L0,[L0[I]]);
1.7 noro 438: PI = ideal_list_intersection(LI,V,Ord|mod=Mod);
1.1 noro 439: PI = qsort(PI,comp_tdeg);
440: for ( T = PI; T != []; T = cdr(T) )
1.7 noro 441: if ( gen_nf(car(T),L0[I],V,Ord,Mod) ) break;
1.1 noro 442: if ( T == [] ) error("separator : cannot happen");
1.7 noro 443: SI = satind(G,car(T),V|mod=Mod);
1.1 noro 444: QI = SI[0];
445: S[I] = car(T)^SI[1];
446: PV = L[I][1];
447: V0 = setminus(V,PV);
448: #if 0
1.7 noro 449: GI = fast_gb(QI,append(V0,PV),Mod,
1.1 noro 450: [[Ord,length(V0)],[Ord,length(PV)]]);
451: #else
1.7 noro 452: GI = fast_gb(QI,append(V0,PV),Mod,
1.1 noro 453: [[2,length(V0)],[Ord,length(PV)]]);
454: #endif
1.7 noro 455: LCFI = lcfactor(GI,V0,Ord,Mod);
1.1 noro 456: for ( F = 1, T = LCFI, Gt = QI; T != []; T = cdr(T) ) {
1.7 noro 457: St = satind(Gt,T[0],V|mod=Mod);
1.1 noro 458: Gt = St[0]; F *= T[0]^St[1];
459: }
1.7 noro 460: Q[I] = [Gt,L0[I]];
461: R[I] = fast_gb(cons(F,QI),V,Mod,Ord);
1.1 noro 462: }
463: return [vtol(Q),vtol(R),vtol(S)];
464: }
465:
466: def iso_comp(G,L,V,Ord)
467: {
1.7 noro 468: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
469: if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
1.1 noro 470: N = length(L);
471: S = vector(N);
472: Ind = vector(N);
473: Q = vector(N);
474: L0 = map(first_element,L);
1.7 noro 475: if ( !IsGB ) G = nd_gr(G,V,Mod,Ord);
1.1 noro 476: for ( I = 0; I < N; I++ ) {
477: LI = setminus(L0,[L0[I]]);
1.7 noro 478: PI = ideal_list_intersection(LI,V,Ord|mod=Mod);
1.1 noro 479: for ( T = PI; T != []; T = cdr(T) )
1.7 noro 480: if ( gen_nf(car(T),L0[I],V,Ord,Mod) ) break;
1.1 noro 481: if ( T == [] ) error("separator : cannot happen");
482: S[I] = car(T);
1.7 noro 483: QI = sat(G,S[I],V|isgb=1,mod=Mod);
1.1 noro 484: PV = L[I][1];
485: V0 = setminus(V,PV);
1.7 noro 486: GI = elim_gb(QI,V0,PV,Mod,[[0,length(V0)],[0,length(PV)]]);
487: Q[I] = [contraction(GI,V0|mod=Mod),L0[I]];
1.1 noro 488: }
489: return vtol(Q);
490: }
491:
492: /* GTZ primary decompsition */
493:
494: def prima_dec(B,V)
495: {
1.7 noro 496: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
497: if ( type(Ord=getopt(ord)) == -1 ) Ord = 0;
498: G0 = fast_gb(B,V,Mod,0);
499: G = fast_gb(G0,V,Mod,Ord);
1.1 noro 500: IntP = [1];
501: QD = [];
502: while ( 1 ) {
1.7 noro 503: if ( type(G[0])==1 || ideal_inclusion(IntP,G0,V,0|mod=Mod) )
504: break;
505: W = maxindep(G,V,Ord); NP = length(W);
1.1 noro 506: V0 = setminus(V,W); N = length(V0);
507: V1 = append(V0,W);
1.7 noro 508: G1 = fast_gb(G,V1,Mod,[[Ord,N],[Ord,NP]]);
509: LCF = lcfactor(G1,V0,Ord,Mod);
510: L = zprimacomp(G,V0|mod=Mod);
1.1 noro 511: F = 1;
1.7 noro 512: for ( T = LCF, G2 = G; T != []; T = cdr(T) ) {
513: S = satind(G2,T[0],V1|mod=Mod);
1.1 noro 514: G2 = S[0]; F *= T[0]^S[1];
515: }
516: for ( T = L, QL = []; T != []; T = cdr(T) )
517: QL = cons(car(T)[0],QL);
1.7 noro 518: Int = ideal_list_intersection(QL,V,0|mod=Mod);
519: IntP = ideal_intersection(IntP,Int,V,0|mod=Mod);
1.1 noro 520: QD = append(QD,L);
1.7 noro 521: F = gen_nf(F,G,V,0,Mod);
522: G = fast_gb(cons(F,G),V,Mod,Ord);
1.1 noro 523: }
1.7 noro 524: QD = qd_remove_redundant_comp(G0,[],QD,V,0);
525: return QD;
1.1 noro 526: }
527:
528: /* SL prime decomposition */
529:
530: def prime_dec(B,V)
531: {
1.7 noro 532: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1 noro 533: if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
534: if ( type(NoLexDec=getopt(nolexdec)) == -1 ) NoLexDec = 0;
1.8 noro 535: if ( type(Rad=getopt(radical)) == -1 ) Rad = 0;
1.7 noro 536: B = map(sq,B,Mod);
1.1 noro 537: if ( !NoLexDec )
1.7 noro 538: PD = lex_predec1(B,V|mod=Mod);
1.1 noro 539: else
540: PD = [B];
1.7 noro 541: G = ideal_list_intersection(PD,V,0|mod=Mod);
542: PD = pd_remove_redundant_comp(G,PD,V,0|mod=Mod);
1.1 noro 543: R = [];
544: for ( T = PD; T != []; T = cdr(T) )
1.7 noro 545: R = append(prime_dec_main(car(T),V|indep=Indep,mod=Mod),R);
1.1 noro 546: if ( Indep ) {
1.7 noro 547: G = ideal_list_intersection(map(first_element,R),V,0|mod=Mod);
548: if ( !NoLexDec ) R = pd_remove_redundant_comp(G,R,V,0|first=1,mod=Mod);
1.1 noro 549: } else {
1.7 noro 550: G = ideal_list_intersection(R,V,0|mod=Mod);
551: if ( !NoLexDec ) R = pd_remove_redundant_comp(G,R,V,0|mod=Mod);
1.1 noro 552: }
1.8 noro 553: return Rad ? [R,G] : R;
1.1 noro 554: }
555:
556: def prime_dec_main(B,V)
557: {
1.7 noro 558: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1 noro 559: if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
1.7 noro 560: G = fast_gb(B,V,Mod,0);
1.1 noro 561: IntP = [1];
562: PD = [];
563: while ( 1 ) {
564: /* rad(G) subset IntP */
565: /* check if IntP subset rad(G) */
566: for ( T = IntP; T != []; T = cdr(T) ) {
1.7 noro 567: if ( (GNV = modular_radical_membership(car(T),G,V|mod=Mod)) ) {
1.1 noro 568: F = car(T);
569: break;
570: }
571: }
572: if ( T == [] ) return PD;
573:
574: /* GNV = [GB(<NV*F-1,G>),NV] */
1.7 noro 575: G1 = fast_gb(GNV[0],cons(GNV[1],V),Mod,[[0,1],[0,length(V)]]);
1.1 noro 576: G0 = elimination(G1,V);
1.7 noro 577: PD0 = zprimecomp(G0,V,Indep|mod=Mod);
1.1 noro 578: if ( Indep ) {
1.7 noro 579: Int = ideal_list_intersection(PD0[0],V,0|mod=Mod);
1.1 noro 580: IndepSet = PD0[1];
581: for ( PD1 = [], T = PD0[0]; T != []; T = cdr(T) )
582: PD1 = cons([car(T),IndepSet],PD1);
583: PD = append(PD,reverse(PD1));
584: } else {
1.7 noro 585: Int = ideal_list_intersection(PD0,V,0|mod=Mod);
1.1 noro 586: PD = append(PD,PD0);
587: }
1.7 noro 588: IntP = ideal_intersection(IntP,Int,V,0|mod=Mod);
1.1 noro 589: }
590: }
591:
592: /* pre-decomposition */
593:
594: def lex_predec1(B,V)
595: {
1.7 noro 596: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
597: G = fast_gb(B,V,Mod,2);
1.1 noro 598: for ( T = G; T != []; T = cdr(T) ) {
1.7 noro 599: F = gen_fctr(car(T),Mod);
1.1 noro 600: if ( length(F) > 2 || length(F) == 2 && F[1][1] > 1 ) {
601: for ( R = [], S = cdr(F); S != []; S = cdr(S) ) {
602: Ft = car(S)[0];
1.7 noro 603: Gt = map(ptozp,map(gen_nf,G,[Ft],V,0,Mod));
604: R1 = fast_gb(cons(Ft,Gt),V,Mod,0);
1.1 noro 605: R = cons(R1,R);
606: }
607: return R;
608: }
609: }
610: return [G];
611: }
612:
613: /* zero-dimensional prime/primary decomosition */
614:
615: def zprimedec(B,V,Mod)
616: {
617: L = partial_decomp(B,V,Mod);
618: P = L[0]; NP = L[1];
619: R = [];
620: for ( ; P != []; P = cdr(P) ) R = cons(car(car(P)),R);
621: for ( T = NP; T != []; T = cdr(T) ) {
622: R1 = complete_decomp(car(T),V,Mod);
623: R = append(R1,R);
624: }
625: return R;
626: }
627:
628: def zprimadec(B,V,Mod)
629: {
630: L = partial_qdecomp(B,V,Mod);
631: Q = L[0]; NQ = L[1];
632: R = [];
633: for ( ; Q != []; Q = cdr(Q) ) {
634: T = car(Q); R = cons([T[0],T[1]],R);
635: }
636: for ( T = NQ; T != []; T = cdr(T) ) {
637: R1 = complete_qdecomp(car(T),V,Mod);
638: R = append(R1,R);
639: }
640: return R;
641: }
642:
643: def complete_qdecomp(GD,V,Mod)
644: {
645: GQ = GD[0]; GP = GD[1]; D = GD[2];
646: W = vars(GP);
647: PV = setminus(W,V);
648: N = length(V); PN = length(PV);
649: U = find_npos([GP,D],V,PV,Mod);
650: NV = ttttt;
651: M = gen_minipoly(cons(NV-U,GQ),cons(NV,V),PV,0,NV,Mod);
652: M = ppart(M,NV,Mod);
653: MF = Mod ? modfctr(M) : fctr(M);
654: R = [];
655: for ( T = cdr(MF); T != []; T = cdr(T) ) {
656: S = car(T);
657: Mt = subst(S[0],NV,U);
658: GP1 = fast_gb(cons(Mt,GP),W,Mod,0);
659: GQ1 = fast_gb(cons(Mt^S[1],GQ),W,Mod,0);
660: if ( PV != [] ) {
661: GP1 = elim_gb(GP1,V,PV,Mod,[[0,N],[0,PN]]);
662: GQ1 = elim_gb(GQ1,V,PV,Mod,[[0,N],[0,PN]]);
663: }
664: R = cons([GQ1,GP1],R);
665: }
666: return R;
667: }
668:
669: def partial_qdecomp(B,V,Mod)
670: {
671: Elim = (Elim=getopt(elim))&&type(Elim)!=-1 ? 1 : 0;
672: N = length(V);
673: W = vars(B);
674: PV = setminus(W,V);
675: NP = length(PV);
676: W = append(V,PV);
677: if ( Elim && PV != [] ) Ord = [[0,N],[0,NP]];
678: else Ord = 0;
679: if ( Mod )
680: B = nd_f4(B,W,Mod,Ord);
681: else
682: B = nd_gr_trace(B,W,1,GBCheck,Ord);
683: Q = []; NQ = [[B,B,vector(N+1)]];
684: for ( I = length(V)-1; I >= 0; I-- ) {
685: NQ1 = [];
686: for ( T = NQ; T != []; T = cdr(T) ) {
687: L = partial_qdecomp0(car(T),V,PV,Ord,I,Mod);
688: Q = append(L[0],Q);
689: NQ1 = append(L[1],NQ1);
690: }
691: NQ = NQ1;
692: }
693: return [Q,NQ];
694: }
695:
696: def partial_qdecomp0(GD,V,PV,Ord,I,Mod)
697: {
698: GQ = GD[0]; GP = GD[1]; D = GD[2];
699: N = length(V); PN = length(PV);
700: W = append(V,PV);
701: VI = V[I];
702: M = gen_minipoly(GQ,V,PV,Ord,VI,Mod);
703: M = ppart(M,VI,Mod);
704: if ( Mod )
705: MF = modfctr(M,Mod);
706: else
707: MF = fctr(M);
708: Q = []; NQ = [];
709: if ( length(MF) == 2 && MF[1][1] == 1 ) {
710: D1 = D*1; D1[I] = M;
711: GQelim = elim_gb(GQ,V,PV,Mod,Ord);
712: GPelim = elim_gb(GP,V,PV,Mod,Ord);
713: LD = ldim(GQelim,V);
714: if ( deg(M,VI) == LD )
715: Q = cons([GQelim,GPelim,D1],Q);
716: else
717: NQ = cons([GQelim,GPelim,D1],NQ);
718: return [Q,NQ];
719: }
720: for ( T = cdr(MF); T != []; T = cdr(T) ) {
721: S = car(T); Mt = S[0]; D1 = D*1; D1[I] = Mt;
722:
723: GQ1 = fast_gb(cons(Mt^S[1],GQ),W,Mod,Ord);
724: GQelim = elim_gb(GQ1,V,PV,Mod,Ord);
725: GP1 = fast_gb(cons(Mt,GP),W,Mod,Ord);
726: GPelim = elim_gb(GP1,V,PV,Mod,Ord);
727:
728: D1[N] = LD = ldim(GPelim,V);
729:
730: for ( J = 0; J < N; J++ )
731: if ( D1[J] && deg(D1[J],V[J]) == LD ) break;
732: if ( J < N )
733: Q = cons([GQelim,GPelim,D1],Q);
734: else
735: NQ = cons([GQelim,GPelim,D1],NQ);
736: }
737: return [Q,NQ];
738: }
739:
740: def complete_decomp(GD,V,Mod)
741: {
742: G = GD[0]; D = GD[1];
743: W = vars(G);
744: PV = setminus(W,V);
745: N = length(V); PN = length(PV);
746: U = find_npos(GD,V,PV,Mod);
747: NV = ttttt;
748: M = gen_minipoly(cons(NV-U,G),cons(NV,V),PV,0,NV,Mod);
749: M = ppart(M,NV,Mod);
750: MF = Mod ? modfctr(M) : fctr(M);
751: if ( length(MF) == 2 ) return [G];
752: R = [];
753: for ( T = cdr(MF); T != []; T = cdr(T) ) {
754: Mt = subst(car(car(T)),NV,U);
755: G1 = fast_gb(cons(Mt,G),W,Mod,0);
756: if ( PV != [] ) G1 = elim_gb(G1,V,PV,Mod,[[0,N],[0,PN]]);
757: R = cons(G1,R);
758: }
759: return R;
760: }
761:
762: def partial_decomp(B,V,Mod)
763: {
764: Elim = (Elim=getopt(elim))&&type(Elim)!=-1 ? 1 : 0;
765: N = length(V);
766: W = vars(B);
767: PV = setminus(W,V);
768: NP = length(PV);
769: W = append(V,PV);
770: if ( Elim && PV != [] ) Ord = [[0,N],[0,NP]];
771: else Ord = 0;
772: if ( Mod )
773: B = nd_f4(B,W,Mod,Ord);
774: else
775: B = nd_gr_trace(B,W,1,GBCheck,Ord);
776: P = []; NP = [[B,vector(N+1)]];
777: for ( I = length(V)-1; I >= 0; I-- ) {
778: NP1 = [];
779: for ( T = NP; T != []; T = cdr(T) ) {
780: L = partial_decomp0(car(T),V,PV,Ord,I,Mod);
781: P = append(L[0],P);
782: NP1 = append(L[1],NP1);
783: }
784: NP = NP1;
785: }
786: return [P,NP];
787: }
788:
789: def partial_decomp0(GD,V,PV,Ord,I,Mod)
790: {
791: G = GD[0]; D = GD[1];
792: N = length(V); PN = length(PV);
793: W = append(V,PV);
794: VI = V[I];
795: M = gen_minipoly(G,V,PV,Ord,VI,Mod);
796: M = ppart(M,VI,Mod);
797: if ( Mod )
798: MF = modfctr(M,Mod);
799: else
800: MF = fctr(M);
801: if ( length(MF) == 2 && MF[1][1] == 1 ) {
802: D1 = D*1;
803: D1[I] = M;
804: Gelim = elim_gb(G,V,PV,Mod,Ord);
805: D1[N] = LD = ldim(Gelim,V);
806: GD1 = [Gelim,D1];
807: for ( J = 0; J < N; J++ )
808: if ( D1[J] && deg(D1[J],V[J]) == LD )
809: return [[GD1],[]];
810: return [[],[GD1]];
811: }
812: P = []; NP = [];
813: GI = elim_gb(G,V,PV,Mod,Ord);
814: for ( T = cdr(MF); T != []; T = cdr(T) ) {
815: Mt = car(car(T));
816: D1 = D*1;
817: D1[I] = Mt;
1.7 noro 818: GIt = map(gen_nf,GI,[Mt],V,Ord,Mod);
1.1 noro 819: G1 = cons(Mt,GIt);
820: Gelim = elim_gb(G1,V,PV,Mod,Ord);
821: D1[N] = LD = ldim(Gelim,V);
822: for ( J = 0; J < N; J++ )
823: if ( D1[J] && deg(D1[J],V[J]) == LD ) break;
824: if ( J < N )
825: P = cons([Gelim,D1],P);
826: else
827: NP = cons([Gelim,D1],NP);
828: }
829: return [P,NP];
830: }
831:
832: /* prime/primary components over rational function field */
833:
834: def zprimacomp(G,V) {
1.7 noro 835: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
836: L = zprimadec(G,V,0|mod=Mod);
1.1 noro 837: R = [];
838: dp_ord(0);
839: for ( T = L; T != []; T = cdr(T) ) {
840: S = car(T);
1.7 noro 841: UQ = contraction(S[0],V|mod=Mod);
842: UP = contraction(S[1],V|mod=Mod);
1.1 noro 843: R = cons([UQ,UP],R);
844: }
845: return R;
846: }
847:
848: def zprimecomp(G,V,Indep) {
1.7 noro 849: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
850: W = maxindep(G,V,0|mod=Mod);
1.1 noro 851: V0 = setminus(V,W);
852: V1 = append(V0,W);
853: #if 0
854: O1 = [[0,length(V0)],[0,length(W)]];
1.7 noro 855: G1 = fast_gb(G,V1,Mod,O1);
1.1 noro 856: dp_ord(0);
857: #else
858: G1 = G;
859: #endif
1.7 noro 860: PD = zprimedec(G1,V0,Mod);
1.1 noro 861: dp_ord(0);
862: R = [];
863: for ( T = PD; T != []; T = cdr(T) ) {
1.7 noro 864: U = contraction(car(T),V0|mod=Mod);
1.1 noro 865: R = cons(U,R);
866: }
867: if ( Indep ) return [R,W];
868: else return R;
869: }
870:
871: def fast_gb(B,V,Mod,Ord)
872: {
1.7 noro 873: if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
874: if ( type(NoRA=getopt(nora)) == -1 ) NoRA = 0;
1.1 noro 875: if ( Mod )
876: G = nd_f4(B,V,Mod,Ord|nora=NoRA);
1.7 noro 877: else if ( F4 )
878: G = map(ptozp,f4_chrem(B,V,Ord));
879: else if ( Block )
880: G = nd_gr_trace(B,V,1,GBCheck,Ord|nora=NoRA,gbblock=Block);
881: else
882: G = nd_gr_trace(B,V,1,GBCheck,Ord|nora=NoRA);
1.1 noro 883: return G;
884: }
885:
1.5 noro 886: def incremental_gb(A,V,Ord)
887: {
888: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
889: if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
1.7 noro 890: if ( Mod ) {
891: if ( Block )
892: G = nd_gr(A,V,Mod,Ord|gbblock=Block);
893: else
894: G = nd_gr(A,V,Mod,Ord);
895: } else if ( Procs ) {
1.5 noro 896: Arg0 = ["nd_gr",A,V,0,Ord];
897: Arg1 = ["nd_gr_trace",A,V,1,GBCheck,Ord];
898: G = competitive_exec(Procs,Arg0,Arg1);
899: } else if ( Block )
900: G = nd_gr(A,V,0,Ord|gbblock=Block);
901: else
902: G = nd_gr(A,V,0,Ord);
903: return G;
904: }
1.1 noro 905:
906: def elim_gb(G,V,PV,Mod,Ord)
907: {
908: N = length(V); PN = length(PV);
909: O1 = [[0,N],[0,PN]];
910: if ( Ord == O1 )
911: Ord = Ord[0][0];
1.7 noro 912: if ( Mod ) /* XXX */ {
913: for ( T = G, H = []; T != []; T = cdr(T) )
914: if ( car(T) ) H = cons(car(T),H);
915: G = reverse(H);
1.1 noro 916: G = dp_gr_mod_main(G,V,0,Mod,Ord);
1.7 noro 917: } else if ( Procs ) {
1.1 noro 918: Arg0 = ["nd_gr_trace",G,V,1,GBCheck,Ord];
919: Arg1 = ["nd_gr_trace_rat",G,V,PV,1,GBCheck,O1,Ord];
920: G = competitive_exec(Procs,Arg0,Arg1);
921: } else
922: G = nd_gr_trace(G,V,1,GBCheck,Ord);
923: return G;
924: }
925:
926: def ldim(G,V)
927: {
928: O0 = dp_ord(); dp_ord(0);
929: D = length(dp_mbase(map(dp_ptod,G,V)));
930: dp_ord(O0);
931: return D;
932: }
933:
1.7 noro 934: /* over Q only */
935:
1.1 noro 936: def make_mod_subst(GD,V,PV,HC)
937: {
938: N = length(V);
939: PN = length(PV);
940: G = GD[0]; D = GD[1];
941: for ( I = 0; ; I = (I+1)%100 ) {
942: Mod = lprime(I);
943: S = [];
944: for ( J = PN-1; J >= 0; J-- )
945: S = append([PV[J],random()%Mod],S);
946: for ( T = HC; T != []; T = cdr(T) )
947: if ( !(subst(car(T),S)%Mod) ) break;
948: if ( T != [] ) continue;
949: for ( J = 0; J < N; J++ ) {
950: M = subst(D[J],S);
951: F = modsqfr(M,Mod);
952: if ( length(F) != 2 || F[1][1] != 1 ) break;
953: }
954: if ( J < N ) continue;
955: G0 = map(subst,G,S);
956: return [G0,Mod];
957: }
958: }
959:
960: def rsgn()
961: {
962: return random()%2 ? 1 : -1;
963: }
964:
965: def find_npos(GD,V,PV,Mod)
966: {
967: N = length(V); PN = length(PV);
968: G = GD[0]; D = GD[1]; LD = D[N];
969: Ord0 = dp_ord(); dp_ord(0);
970: HC = map(dp_hc,map(dp_ptod,G,V));
971: dp_ord(Ord0);
972: if ( !Mod ) {
973: W = append(V,PV);
974: G1 = nd_gr_trace(G,W,1,GBCheck,[[0,N],[0,PN]]);
975: L = make_mod_subst([G1,D],V,PV,HC);
976: return find_npos([L[0],D],V,[],L[1]);
977: }
978: N = length(V);
979: NV = ttttt;
980: for ( B = 2; ; B++ ) {
981: for ( J = N-2; J >= 0; J-- ) {
982: for ( U = 0, K = J; K < N; K++ )
983: U += rsgn()*((random()%B+1))*V[K];
984: M = minipolym(G,V,0,U,NV,Mod);
985: if ( deg(M,NV) == LD ) return U;
986: }
987: }
988: }
989:
990: def gen_minipoly(G,V,PV,Ord,VI,Mod)
991: {
992: if ( PV == [] ) {
993: NV = ttttt;
994: if ( Mod )
995: M = minipolym(G,V,Ord,VI,NV,Mod);
996: else
997: M = minipoly(G,V,Ord,VI,NV);
998: return subst(M,NV,VI);
999: }
1000: W = setminus(V,[VI]);
1001: PV1 = cons(VI,PV);
1002: #if 0
1003: while ( 1 ) {
1004: V1 = append(W,PV1);
1005: if ( Mod )
1006: G = nd_gr(G,V1,Mod,[[0,1],[0,length(V1)-1]]|nora=1);
1007: else
1008: G = nd_gr_trace(G,V1,1,GBCheck,[[0,1],[0,length(V1)-1]]|nora=1);
1009: if ( W == [] ) break;
1010: else {
1011: W = cdr(W);
1012: G = elimination(G,cdr(V1));
1013: }
1014: }
1015: #elif 1
1016: if ( Mod ) {
1.7 noro 1017: V1 = append(W,PV1);
1018: G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]);
1.1 noro 1019: G = elimination(G,PV1);
1020: } else {
1021: PV2 = setminus(PV1,[PV1[length(PV1)-1]]);
1022: V2 = append(W,PV2);
1023: G = nd_gr_trace(G,V2,1,GBCheck,[[0,length(W)],[0,length(PV2)]]|nora=1);
1024: G = elimination(G,PV1);
1025: }
1026: #else
1027: V1 = append(W,PV1);
1028: if ( Mod )
1029: G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]|nora=1);
1030: else
1031: G = nd_gr_trace(G,V1,1,GBCheck,[[0,length(W)],[0,length(PV1)]]|nora=1);
1032: G = elimination(G,PV1);
1033: #endif
1034: if ( Mod )
1035: G = nd_gr(G,PV1,Mod,[[0,1],[0,length(PV)]]|nora=1);
1036: else
1037: G = nd_gr_trace(G,PV1,1,GBCheck,[[0,1],[0,length(PV)]]|nora=1);
1038: for ( M = car(G), T = cdr(G); T != []; T = cdr(T) )
1039: if ( deg(car(T),VI) < deg(M,VI) ) M = car(T);
1040: return M;
1041: }
1042:
1043: def indepset(V,H)
1044: {
1045: if ( H == [] ) return V;
1046: N = -1;
1047: for ( T = V; T != []; T = cdr(T) ) {
1048: VI = car(T);
1049: HI = [];
1050: for ( S = H; S != []; S = cdr(S) )
1051: if ( !tdiv(car(S),VI) ) HI = cons(car(S),HI);
1052: RI = indepset(setminus(V,[VI]),HI);
1053: if ( length(RI) > N ) {
1054: R = RI; N = length(RI);
1055: }
1056: }
1057: return R;
1058: }
1059:
1060: def maxindep(B,V,O)
1061: {
1.7 noro 1062: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1063: G = fast_gb(B,V,Mod,O);
1.1 noro 1064: Old = dp_ord();
1065: dp_ord(O);
1066: H = map(dp_dtop,map(dp_ht,map(dp_ptod,G,V)),V);
1067: H = dp_mono_raddec(H,V);
1068: N = length(V);
1069: Dep = [];
1070: for ( T = H, Len = N+1; T != []; T = cdr(T) ) {
1071: M = length(car(T));
1072: if ( M < Len ) {
1073: Dep = [car(T)];
1074: Len = M;
1075: } else if ( M == Len )
1076: Dep = cons(car(T),Dep);
1077: }
1078: R = setminus(V,Dep[0]);
1079: dp_ord(Old);
1080: return R;
1081: }
1082:
1083: /* ideal operations */
1084: def contraction(G,V)
1085: {
1.7 noro 1086: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1 noro 1087: C = [];
1088: for ( T = G; T != []; T = cdr(T) ) {
1089: C1 = dp_hc(dp_ptod(car(T),V));
1.7 noro 1090: S = gen_fctr(C1,Mod);
1.1 noro 1091: for ( S = cdr(S); S != []; S = cdr(S) )
1092: if ( !member(S[0][0],C) ) C = cons(S[0][0],C);
1093: }
1094: W = vars(G);
1095: PV = setminus(W,V);
1096: W = append(V,PV);
1097: NV = ttttt;
1098: for ( T = C, S = 1; T != []; T = cdr(T) )
1099: S *= car(T);
1.7 noro 1100: G = saturation([G,NV],S,W|mod=Mod);
1.1 noro 1101: return G;
1102: }
1103:
1104: def ideal_list_intersection(L,V,Ord)
1105: {
1106: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1107: N = length(L);
1108: if ( N == 0 ) return [1];
1109: if ( N == 1 ) return fast_gb(L[0],V,Mod,Ord);
1110: N2 = idiv(N,2);
1111: for ( L1 = [], I = 0; I < N2; I++ ) L1 = cons(L[I],L1);
1112: for ( L2 = []; I < N; I++ ) L2 = cons(L[I],L2);
1113: I1 = ideal_list_intersection(L1,V,Ord|mod=Mod);
1114: I2 = ideal_list_intersection(L2,V,Ord|mod=Mod);
1115: return ideal_intersection(I1,I2,V,Ord|mod=Mod,
1116: gbblock=[[0,length(I1)],[length(I1),length(I2)]]);
1117: }
1118:
1119: def ideal_intersection(A,B,V,Ord)
1120: {
1121: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1122: if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
1123: T = ttttt;
1.7 noro 1124: if ( Mod ) {
1125: if ( Block )
1126: G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
1127: cons(T,V),Mod,[[0,1],[Ord,length(V)]]|gbblock=Block,nora=1);
1128: else
1129: G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
1130: cons(T,V),Mod,[[0,1],[Ord,length(V)]]|nora=1);
1131: } else
1.1 noro 1132: if ( Procs ) {
1133: Arg0 = ["nd_gr",
1134: append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
1135: cons(T,V),0,[[0,1],[Ord,length(V)]]];
1136: Arg1 = ["nd_gr_trace",
1137: append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
1138: cons(T,V),1,GBCheck,[[0,1],[Ord,length(V)]]];
1139: G = competitive_exec(Procs,Arg0,Arg1);
1140: } else {
1141: if ( Block )
1142: G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
1.7 noro 1143: cons(T,V),0,[[0,1],[Ord,length(V)]]|gbblock=Block,nora=0);
1.1 noro 1144: else
1145: G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
1.7 noro 1146: cons(T,V),0,[[0,1],[Ord,length(V)]]|nora=0);
1.1 noro 1147: }
1148: G0 = elimination(G,V);
1.7 noro 1149: if ( 0 && !Procs )
1150: G0 = nd_gr_postproc(G0,V,Mod,Ord,0);
1.1 noro 1151: return G0;
1152: }
1153:
1154: /* returns GB if F notin rad(G) */
1155:
1156: def radical_membership(F,G,V) {
1.7 noro 1157: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1158: F = gen_nf(F,G,V,0,Mod);
1.1 noro 1159: if ( !F ) return 0;
1160: NV = ttttt;
1.7 noro 1161: T = fast_gb(cons(NV*F-1,G),cons(NV,V),Mod,0);
1.1 noro 1162: if ( type(car(T)) != 1 ) return [T,NV];
1163: else return 0;
1164: }
1165:
1.7 noro 1166: def modular_radical_membership(F,G,V) {
1167: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1168: if ( Mod )
1169: return radical_membership(F,G,V|mod=Mod);
1.1 noro 1170:
1.7 noro 1171: F = gen_nf(F,G,V,0,0);
1.1 noro 1172: if ( !F ) return 0;
1173: NV = ttttt;
1174: for ( J = 0; ; J++ ) {
1175: Mod = lprime(J);
1176: H = map(dp_hc,map(dp_ptod,G,V));
1177: for ( ; H != []; H = cdr(H) ) if ( !(car(H)%Mod) ) break;
1178: if ( H != [] ) continue;
1179:
1180: T = nd_f4(cons(NV*F-1,G),cons(NV,V),Mod,0);
1181: if ( type(car(T)) == 1 ) {
1182: I = radical_membership_rep(F,G,V,-1,0,Mod);
1183: I1 = radical_membership_rep(F,G,V,I,0,0);
1184: if ( I1 > 0 ) return 0;
1185: }
1186: return radical_membership(F,G,V);
1187: }
1188: }
1189:
1190: def radical_membership_rep(F,G,V,Max,Ord,Mod) {
1191: Ft = F;
1192: I = 1;
1193: while ( Max < 0 || I <= Max ) {
1.7 noro 1194: Ft = gen_nf(Ft,G,V,Ord,Mod);
1.1 noro 1195: if ( !Ft ) return I;
1196: Ft *= F;
1197: I++;
1198: }
1199: return -1;
1200: }
1201:
1202: def ideal_product(A,B,V)
1203: {
1.7 noro 1204: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1 noro 1205: dp_ord(0);
1206: DA = map(dp_ptod,A,V);
1207: DB = map(dp_ptod,B,V);
1208: DegA = map(dp_td,DA);
1209: DegB = map(dp_td,DB);
1210: for ( PA = [], T = A, DT = DegA; T != []; T = cdr(T), DT = cdr(DT) )
1211: PA = cons([car(T),car(DT)],PA);
1212: PA = reverse(PA);
1213: for ( PB = [], T = B, DT = DegB; T != []; T = cdr(T), DT = cdr(DT) )
1214: PB = cons([car(T),car(DT)],PB);
1215: PB = reverse(PB);
1216: R = [];
1217: for ( T = PA; T != []; T = cdr(T) )
1218: for ( S = PB; S != []; S = cdr(S) )
1219: R = cons([car(T)[0]*car(S)[0],car(T)[1]+car(S)[1]],R);
1220: T = qsort(R,comp_by_second);
1221: T = map(first_element,T);
1222: Len = length(A)>length(B)?length(A):length(B);
1223: Len *= 2;
1224: L = sep_list(T,Len); B0 = L[0]; B1 = L[1];
1.7 noro 1225: R = fast_gb(B0,V,Mod,0);
1.1 noro 1226: while ( B1 != [] ) {
1227: print(length(B1));
1228: L = sep_list(B1,Len);
1229: B0 = L[0]; B1 = L[1];
1.7 noro 1230: R = fast_gb(append(R,B0),V,Mod,0|gbblock=[[0,length(R)]],nora=1);
1.1 noro 1231: }
1232: return R;
1233: }
1234:
1235: def saturation(GNV,F,V)
1236: {
1.7 noro 1237: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1 noro 1238: G = GNV[0]; NV = GNV[1];
1.7 noro 1239: if ( Mod )
1240: G1 = nd_gr(cons(NV*F-1,G),cons(NV,V),Mod,[[0,1],[0,length(V)]]);
1241: else if ( Procs ) {
1.1 noro 1242: Arg0 = ["nd_gr_trace",
1243: cons(NV*F-1,G),cons(NV,V),0,GBCheck,[[0,1],[0,length(V)]]];
1244: Arg1 = ["nd_gr_trace",
1245: cons(NV*F-1,G),cons(NV,V),1,GBCheck,[[0,1],[0,length(V)]]];
1246: G1 = competitive_exec(Procs,Arg0,Arg1);
1247: } else
1248: G1 = nd_gr_trace(cons(NV*F-1,G),cons(NV,V),SatHomo,GBCheck,[[0,1],[0,length(V)]]);
1249: return elimination(G1,V);
1250: }
1251:
1252: def sat(G,F,V)
1253: {
1.7 noro 1254: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.5 noro 1255: if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
1.1 noro 1256: NV = ttttt;
1.7 noro 1257: if ( Mod )
1258: G1 = nd_gr(cons(NV*F-1,G),cons(NV,V),Mod,[[0,1],[0,length(V)]]);
1259: else if ( Procs ) {
1.1 noro 1260: Arg0 = ["nd_gr_trace",
1261: cons(NV*F-1,G),cons(NV,V),0,GBCheck,[[0,1],[0,length(V)]]];
1262: Arg1 = ["nd_gr_trace",
1263: cons(NV*F-1,G),cons(NV,V),1,GBCheck,[[0,1],[0,length(V)]]];
1264: G1 = competitive_exec(Procs,Arg0,Arg1);
1.5 noro 1265: } else {
1266: B1 = append(G,[NV*F-1]);
1267: V1 = cons(NV,V);
1268: Ord1 = [[0,1],[0,length(V)]];
1269: if ( IsGB )
1270: G1 = nd_gr_trace(B1,V1,SatHomo,GBCheck,Ord1|
1271: gbblock=[[0,length(G)]]);
1272: else
1273: G1 = nd_gr_trace(B1,V1,SatHomo,GBCheck,Ord1);
1274: }
1.1 noro 1275: return elimination(G1,V);
1276: }
1277:
1278: def satind(G,F,V)
1279: {
1.7 noro 1280: if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
1281: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1 noro 1282: NV = ttttt;
1283: N = length(V);
1284: B = append(G,[NV*F-1]);
1285: V1 = cons(NV,V);
1.7 noro 1286: Ord1 = [[0,1],[0,N]];
1287: if ( Mod )
1288: if ( Block )
1289: D = nd_gr(B,V1,Mod,Ord1|nora=1,gentrace=1,gbblock=Block);
1290: else
1291: D = nd_gr(B,V1,Mod,Ord1|nora=1,gentrace=1);
1292: else
1293: if ( Block )
1294: D = nd_gr_trace(B,V1,SatHomo,GBCheck,Ord1
1295: |nora=1,gentrace=1,gbblock=Block);
1296: else
1297: D = nd_gr_trace(B,V1,SatHomo,GBCheck,Ord1
1298: |nora=1,gentrace=1);
1.1 noro 1299: G1 = D[0];
1300: Len = length(G1);
1301: Deg = compute_deg(B,V1,NV,D);
1302: D1 = 0;
1303: R = [];
1304: M = length(B);
1305: for ( I = 0; I < Len; I++ ) {
1306: if ( !member(NV,vars(G1[I])) ) {
1307: for ( J = 1; J < M; J++ )
1308: D1 = MAX(D1,Deg[I][J]);
1309: R = cons(G1[I],R);
1310: }
1311: }
1312: return [reverse(R),D1];
1313: }
1314:
1315: def sat_ind(G,F,V)
1316: {
1.7 noro 1317: if ( type(Ord=getopt(ord)) == -1 ) Ord = 0;
1318: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1 noro 1319: NV = ttttt;
1.7 noro 1320: F = gen_nf(F,G,V,Ord,Mod);
1.1 noro 1321: for ( I = 0, GI = G; ; I++ ) {
1.7 noro 1322: G1 = colon(GI,F,V|mod=Mod,ord=Ord);
1323: if ( ideal_inclusion(G1,GI,V,Ord|mod=Mod) ) {
1.1 noro 1324: return [GI,I];
1325: }
1326: else GI = G1;
1327: }
1328: }
1329:
1330: def colon(G,F,V)
1331: {
1.7 noro 1332: if ( type(Ord=getopt(ord)) == -1 ) Ord = 0;
1333: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.5 noro 1334: if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
1.7 noro 1335: F = gen_nf(F,G,V,Ord,Mod);
1.1 noro 1336: if ( !F ) return [1];
1.5 noro 1337: if ( IsGB )
1.7 noro 1338: T = ideal_intersection(G,[F],V,Ord|gbblock=[[0,length(G)]],mod=Mod);
1.5 noro 1339: else
1.7 noro 1340: T = ideal_intersection(G,[F],V,Ord|mod=Mod);
1341: return Mod?map(sdivm,T,F,Mod):map(ptozp,map(sdiv,T,F));
1.1 noro 1342: }
1343:
1344: def ideal_colon(G,F,V)
1345: {
1.7 noro 1346: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1347: G = nd_gr(G,V,Mod,0);
1.5 noro 1348: for ( T = F, L = []; T != []; T = cdr(T) )
1.7 noro 1349: L = cons(colon(G,car(T),V|isgb=1,mod=Mod),L);
1.5 noro 1350: L = reverse(L);
1.7 noro 1351: return ideal_list_intersection(L,V,0|mod=Mod);
1.1 noro 1352: }
1353:
1.2 noro 1354: def ideal_sat(G,F,V)
1355: {
1.7 noro 1356: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1357: G = nd_gr(G,V,Mod,0);
1358: for ( T = F, L = []; T != []; T = cdr(T) )
1359: L = cons(sat(G,car(T),V|mod=Mod),L);
1360: L = reverse(L);
1361: return ideal_list_intersection(L,V,0|mod=Mod);
1.2 noro 1362: }
1363:
1.1 noro 1364: def ideal_inclusion(F,G,V,O)
1365: {
1366: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.7 noro 1367: for ( T = F; T != []; T = cdr(T) )
1368: if ( gen_nf(car(T),G,V,O,Mod) ) return 0;
1.1 noro 1369: return 1;
1370: }
1371:
1372: /* remove redundant components */
1373:
1374: def qd_simp_comp(QP,V)
1375: {
1.7 noro 1376: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.1 noro 1377: R = ltov(QP);
1378: N = length(R);
1379: for ( I = 0; I < N; I++ ) {
1380: if ( R[I] ) {
1381: QI = R[I][0]; PI = R[I][1];
1382: for ( J = I+1; J < N; J++ )
1.7 noro 1383: if ( R[J] && gen_gb_comp(PI,R[J][1],Mod) ) {
1384: QI = ideal_intersection(QI,R[J][0],V,0|mod=Mod);
1.1 noro 1385: R[J] = 0;
1386: }
1387: R[I] = [QI,PI];
1388: }
1389: }
1390: for ( I = N-1, S = []; I >= 0; I-- )
1391: if ( R[I] ) S = cons(R[I],S);
1392: return S;
1393: }
1394:
1395: def qd_remove_redundant_comp(G,Iso,Emb,V,Ord)
1396: {
1.7 noro 1397: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1398: IsoInt = ideal_list_intersection(map(first_element,Iso),V,Ord|mod=Mod);
1399: Emb = qd_simp_comp(Emb,V|mod=Mod);
1.6 noro 1400: Emb = reverse(qsort(Emb));
1401: A = ltov(Emb); N = length(A);
1402: Pre = IsoInt; Post = vector(N+1);
1.7 noro 1403: for ( Post[N] = IsoInt, I = N-1; I >= 1; I-- )
1404: Post[I] = ideal_intersection(Post[I+1],A[I][0],V,Ord|mod=Mod);
1.1 noro 1405: for ( I = 0; I < N; I++ ) {
1.7 noro 1406: print(".",2);
1407: Int = ideal_intersection(Pre,Post[I+1],V,Ord|mod=Mod);
1408: if ( gen_gb_comp(Int,G,Mod) ) A[I] = 0;
1.6 noro 1409: else
1.7 noro 1410: Pre = ideal_intersection(Pre,A[I][0],V,Ord|mod=Mod);
1.1 noro 1411: }
1412: for ( T = [], I = 0; I < N; I++ )
1413: if ( A[I] ) T = cons(A[I],T);
1414: return reverse(T);
1415: }
1416:
1.6 noro 1417: def pd_remove_redundant_comp(G,P,V,Ord)
1.1 noro 1418: {
1.7 noro 1419: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
1.6 noro 1420: if ( type(First=getopt(first)) == -1 ) First = 0;
1421: A = ltov(P); N = length(A);
1.1 noro 1422: for ( I = 0; I < N; I++ ) {
1423: if ( !A[I] ) continue;
1424: for ( J = I+1; J < N; J++ )
1.6 noro 1425: if ( A[J] &&
1.7 noro 1426: gen_gb_comp(First?A[I][0]:A[I],First?A[J][0]:A[J],Mod) ) A[J] = 0;
1.1 noro 1427: }
1.6 noro 1428: for ( I = 0, T = []; I < N; I++ ) if ( A[I] ) T = cons(A[I],T);
1429: A = ltov(reverse(T)); N = length(A);
1430: Pre = [1]; Post = vector(N+1);
1431: for ( Post[N] = [1], I = N-1; I >= 1; I-- )
1.7 noro 1432: Post[I] = ideal_intersection(Post[I+1],First?A[I][0]:A[I],V,Ord|mod=Mod);
1.1 noro 1433: for ( I = 0; I < N; I++ ) {
1.7 noro 1434: Int = ideal_intersection(Pre,Post[I+1],V,Ord|mod=Mod);
1435: if ( gen_gb_comp(Int,G,Mod) ) A[I] = 0;
1.6 noro 1436: else
1.7 noro 1437: Pre = ideal_intersection(Pre,First?A[I][0]:A[I],V,Ord|mod=Mod);
1.1 noro 1438: }
1.6 noro 1439: for ( T = [], I = 0; I < N; I++ ) if ( A[I] ) T = cons(A[I],T);
1.1 noro 1440: return reverse(T);
1441: }
1442:
1443: /* polynomial operations */
1444:
1445: def ppart(F,V,Mod)
1446: {
1447: if ( !Mod )
1448: G = nd_gr([F],[V],0,0);
1449: else
1450: G = dp_gr_mod_main([F],[V],0,Mod,0);
1451: return G[0];
1452: }
1453:
1454:
1.7 noro 1455: def sq(F,Mod)
1.1 noro 1456: {
1457: if ( !F ) return 0;
1.7 noro 1458: A = cdr(gen_fctr(F,Mod));
1.1 noro 1459: for ( R = 1; A != []; A = cdr(A) )
1460: R *= car(car(A));
1461: return R;
1462: }
1463:
1.7 noro 1464: def lcfactor(G,V,O,Mod)
1.1 noro 1465: {
1466: O0 = dp_ord(); dp_ord(O);
1467: C = [];
1468: for ( T = G; T != []; T = cdr(T) ) {
1469: C1 = dp_hc(dp_ptod(car(T),V));
1.7 noro 1470: S = gen_fctr(C1,Mod);
1.1 noro 1471: for ( S = cdr(S); S != []; S = cdr(S) )
1472: if ( !member(S[0][0],C) ) C = cons(S[0][0],C);
1473: }
1474: dp_ord(O0);
1475: return C;
1476: }
1477:
1.7 noro 1478: def gen_fctr(F,Mod)
1479: {
1480: if ( Mod ) return modfctr(F,Mod);
1481: else return fctr(F);
1482: }
1483:
1484: def gen_mptop(F)
1485: {
1486: if ( !F ) return F;
1487: else if ( type(F)==1 )
1488: if ( ntype(F)==5 ) return mptop(F);
1489: else return F;
1490: else {
1491: V = var(F);
1492: D = deg(F,V);
1493: for ( R = 0, I = 0; I <= D; I++ )
1494: if ( C = coef(F,I,V) ) R += gen_mptop(C)*V^I;
1495: return R;
1496: }
1497: }
1498:
1499: def gen_nf(F,G,V,Ord,Mod)
1500: {
1501: if ( !Mod ) return p_nf(F,G,V,Ord);
1502:
1503: setmod(Mod);
1504: dp_ord(Ord); DF = dp_mod(dp_ptod(F,V),Mod,[]);
1505: N = length(G); DG = newvect(N);
1506: for ( I = N-1, IL = []; I >= 0; I-- ) {
1507: DG[I] = dp_mod(dp_ptod(G[I],V),Mod,[]);
1508: IL = cons(I,IL);
1509: }
1510: T = dp_nf_mod(IL,DF,DG,1,Mod);
1511: for ( R = 0; T; T = dp_rest(T) )
1512: R += gen_mptop(dp_hc(T))*dp_dtop(dp_ht(T),V);
1513: return R;
1514: }
1515:
1.1 noro 1516: /* Ti = [D,I,M,C] */
1517:
1518: def compute_deg0(Ti,P,V,TV)
1519: {
1520: N = length(P[0]);
1521: Num = vector(N);
1522: for ( I = 0; I < N; I++ ) Num[I] = -1;
1523: for ( ; Ti != []; Ti = cdr(Ti) ) {
1524: Sj = car(Ti);
1525: Dj = Sj[0];
1526: Ij =Sj[1];
1527: Mj = deg(type(Sj[2])==9?dp_dtop(Sj[2],V):Sj[2],TV);
1528: Pj = P[Ij];
1529: if ( Dj )
1530: for ( I = 0; I < N; I++ )
1531: if ( Pj[I] >= 0 ) {
1532: T = Mj+Pj[I];
1533: Num[I] = MAX(Num[I],T);
1534: }
1535: }
1536: return Num;
1537: }
1538:
1539: def compute_deg(B,V,TV,Data)
1540: {
1541: GB = Data[0];
1542: Homo = Data[1];
1543: Trace = Data[2];
1544: IntRed = Data[3];
1545: Ind = Data[4];
1546: DB = map(dp_ptod,B,V);
1547: if ( Homo ) {
1548: DB = map(dp_homo,DB);
1549: V0 = append(V,[hhh]);
1550: } else
1551: V0 = V;
1552: Perm = Trace[0]; Trace = cdr(Trace);
1553: for ( I = length(Perm)-1, T = Trace; T != []; T = cdr(T) )
1554: if ( (J=car(T)[0]) > I ) I = J;
1555: N = I+1;
1556: N0 = length(B);
1557: P = vector(N);
1558: for ( T = Perm, I = 0; T != []; T = cdr(T), I++ ) {
1559: Pi = car(T);
1560: C = vector(N0);
1561: for ( J = 0; J < N0; J++ ) C[J] = -1;
1562: C[Pi[1]] = 0;
1563: P[Pi[0]] = C;
1564: }
1565: for ( T = Trace; T != []; T = cdr(T) ) {
1566: Ti = car(T); P[Ti[0]] = compute_deg0(Ti[1],P,V0,TV);
1567: }
1568: M = length(Ind);
1569: for ( T = IntRed; T != []; T = cdr(T) ) {
1570: Ti = car(T); P[Ti[0]] = compute_deg0(Ti[1],P,V,TV);
1571: }
1572: R = [];
1573: for ( J = 0; J < M; J++ ) {
1574: U = P[Ind[J]];
1575: R = cons(U,R);
1576: }
1577: return reverse(R);
1578: }
1579:
1580: /* set theoretic functions */
1581:
1582: def member(A,S)
1583: {
1584: for ( ; S != []; S = cdr(S) )
1585: if ( car(S) == A ) return 1;
1586: return 0;
1587: }
1588:
1589: def elimination(G,V) {
1590: for ( R = [], T = G; T != []; T = cdr(T) )
1591: if ( setminus(vars(car(T)),V) == [] ) R =cons(car(T),R);
1592: return R;
1593: }
1594:
1595: def setintersection(A,B)
1596: {
1597: for ( L = []; A != []; A = cdr(A) )
1598: if ( member(car(A),B) )
1599: L = cons(car(A),L);
1600: return L;
1601: }
1602:
1603: def setminus(A,B) {
1604: for ( T = reverse(A), R = []; T != []; T = cdr(T) ) {
1605: for ( S = B, M = car(T); S != []; S = cdr(S) )
1606: if ( car(S) == M ) break;
1607: if ( S == [] ) R = cons(M,R);
1608: }
1609: return R;
1610: }
1611:
1612: def sep_list(L,N)
1613: {
1614: if ( length(L) <= N ) return [L,[]];
1615: R = [];
1616: for ( T = L, I = 0; I < N; I++, T = cdr(T) )
1617: R = cons(car(T),R);
1618: return [reverse(R),T];
1619: }
1620:
1621: def first_element(L)
1622: {
1623: return L[0];
1624: }
1625:
1626: def comp_tdeg(A,B)
1627: {
1628: DA = tdeg(A);
1629: DB = tdeg(B);
1630: if ( DA > DB ) return 1;
1631: else if ( DA < DB ) return -1;
1632: else return 0;
1633: }
1634:
1635: def tdeg(P)
1636: {
1637: dp_ord(0);
1638: return dp_td(dp_ptod(P,vars(P)));
1639: }
1640:
1641: def comp_by_ord(A,B)
1642: {
1643: if ( dp_ht(A) > dp_ht(B) ) return 1;
1644: else if ( dp_ht(A) < dp_ht(B) ) return -1;
1645: else return 0;
1646: }
1647:
1648: def comp_by_second(A,B)
1649: {
1650: if ( A[1] > B[1] ) return 1;
1651: else if ( A[1] < B[1] ) return -1;
1652: else return 0;
1653: }
1.7 noro 1654:
1655: def gen_gb_comp(A,B,Mod)
1656: {
1657: if ( !Mod ) return gb_comp(A,B);
1658: LA = length(A); LB = length(B);
1659: if ( LA != LB ) return 0;
1660: A = qsort(A); B = qsort(B);
1661: if ( A != B ) return 0;
1662: return 1;
1663: }
1664:
1.1 noro 1665: endmodule$
1666: end$
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to 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