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