Annotation of OpenXM/src/asir-contrib/testing/noro/obsolete/pd.rr, Revision 1.1
1.1 ! noro 1: /* $OpenXM$ */
! 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$
! 12: localf fast_gb, incremental_gb, elim_gb, ldim, make_mod_subst$
! 13: localf rsgn, find_npos, gen_minipoly, indepset$
! 14: localf maxindep, contraction, ideal_list_intersection, ideal_intersection$
! 15: localf radical_membership, modular_radical_membership$
! 16: localf radical_membership_rep, ideal_product, saturation$
! 17: localf sat, satind, sat_ind, colon$
! 18: localf ideal_colon, ideal_sat, ideal_inclusion, qd_simp_comp, qd_remove_redundant_comp$
! 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$
! 21: localf elimination, setintersection, setminus, sep_list$
! 22: localf first_element, comp_tdeg, tdeg, comp_by_ord, comp_by_second$
! 23: localf gbcheck,f4,sathomo,qd_check$
! 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;
! 33: else GBCheck = -1;
! 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:
! 72: def qd_check(B,V,QD)
! 73: {
! 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);
! 80: }
! 81:
! 82: /* SYC primary decomositions */
! 83:
! 84: def syca_dec(B,V)
! 85: {
! 86: T00 = time();
! 87: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 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;
! 93: Gt = G0 = G = fast_gb(B,V,Mod,Ord);
! 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();
! 102: PtR = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec,mod=Mod,radical=1);
! 103: T1 = time(); Tass += T1[0]-T0[0]+T1[1]-T0[1]; Rass += T1[3]-T0[3];
! 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: }
! 115: T0 = time();
! 116: Qt = iso_comp(Gt,Pt,V,Ord|mod=Mod,isgb=1);
! 117: T1 = time(); Tiso += T1[0]-T0[0]+T1[1]-T0[1]; Riso += T1[3]-T0[3];
! 118: IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord|mod=Mod);
! 119: if ( First ) {
! 120: IntQ0 = IntQ = IntQt; IntP = IntPt; Qi = Qt; First = 0;
! 121: } else {
! 122: IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod);
! 123: if ( gen_gb_comp(IntQ,IntQ1,Mod) ) {
! 124: G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
! 125: continue;
! 126: } else {
! 127: IntQ = IntQ1;
! 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
! 138: IntQ0 = IntQ1;
! 139: }
! 140: }
! 141: }
! 142: if ( gen_gb_comp(IntQt,Gt,Mod) || gen_gb_comp(IntQ,G,Mod) || gen_gb_comp(IntQ0,G0,Mod) ) break;
! 143: T0 = time();
! 144: C1 = ideal_colon(G,IntQ,V|mod=Mod);
! 145: T1 = time(); Tcolon += T1[0]-T0[0]+T1[1]-T0[1]; Rcolon += T1[3]-T0[3];
! 146: if ( C && gen_gb_comp(C,C1,Mod) ) {
! 147: G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
! 148: continue;
! 149: } else C = C1;
! 150: T0 = time();
! 151: if ( SepIdeal == 0 )
! 152: Ok = find_separating_ideal0(C,G,IntQ,IntP,V,Ord|mod=Mod);
! 153: else if ( SepIdeal == 1 )
! 154: Ok = find_separating_ideal1(C,G,IntQ,IntP,V,Ord|mod=Mod);
! 155: else if ( SepIdeal == 2 )
! 156: Ok = find_separating_ideal2(C,G,IntQ,IntP,V,Ord|mod=Mod);
! 157: G1 = append(Ok,G);
! 158: Gt1 = incremental_gb(G1,V,Ord|mod=Mod);
! 159: T1 = time(); Tsep += T1[0]-T0[0]+T1[1]-T0[1]; Rsep += T1[3]-T0[3];
! 160: #if 0
! 161: if ( ideal_inclusion(Gt1,Gt,V,Ord|mod=Mod) ) {
! 162: G = Gt; IntP = IntPt; Q = []; IntQ = [1]; C = 0;
! 163: } else
! 164: #endif
! 165: Gt = Gt1;
! 166: }
! 167: T0 = time();
! 168: if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G0,Qi,Q0,V,Ord|mod=Mod);
! 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();
! 183: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 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;
! 189: G = fast_gb(B,V,Mod,Ord);
! 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();
! 196: PtR = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec,mod=Mod,radical=1);
! 197: T1 = time(); Tass += T1[0]-T0[0]+T1[1]-T0[1]; Rass += T1[3]-T0[3];
! 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:
! 210: T0 = time();
! 211: Qt = iso_comp(Gt,Pt,V,Ord|mod=Mod,isgb=1);
! 212: T1 = time(); Tiso += T1[0]-T0[0]+T1[1]-T0[1]; Riso += T1[3]-T0[3];
! 213: IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord|mod=Mod);
! 214: if ( First ) {
! 215: IntQ = IntQt; Qi = Qt; First = 0;
! 216: } else {
! 217: IntQ1 = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod);
! 218: if ( !gen_gb_comp(IntQ1,IntQ,Mod) )
! 219: Q = append(Qt,Q);
! 220: }
! 221: if ( gen_gb_comp(IntQ,G,Mod) || gen_gb_comp(IntQt,Gt,Mod) )
! 222: break;
! 223: T0 = time();
! 224: C = ideal_colon(Gt,IntQt,V|mod=Mod);
! 225: T1 = time(); Tcolon += T1[0]-T0[0]+T1[1]-T0[1]; Rcolon += T1[3]-T0[3];
! 226: T0 = time();
! 227: if ( SepIdeal == 0 )
! 228: Ok = find_separating_ideal0(C,Gt,IntQt,IntPt,V,Ord|mod=Mod);
! 229: else if ( SepIdeal == 1 )
! 230: Ok = find_separating_ideal1(C,Gt,IntQt,IntPt,V,Ord|mod=Mod);
! 231: else if ( SepIdeal == 2 )
! 232: Ok = find_separating_ideal2(C,Gt,IntQt,IntPt,V,Ord|mod=Mod);
! 233: G1 = append(Ok,Gt);
! 234: Gt = incremental_gb(G1,V,Ord|mod=Mod);
! 235: T1 = time(); Tsep += T1[0]-T0[0]+T1[1]-T0[1]; Rsep += T1[3]-T0[3];
! 236: }
! 237: T0 = time();
! 238: if ( !NoSimp ) Q1 = qd_remove_redundant_comp(G,Qi,Q,V,Ord|mod=Mod);
! 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:
! 250: /* XXX */
! 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) {
! 254: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 255: for ( CI = C, I = 1; ; I++ ) {
! 256: for ( T = CI, S = []; T != []; T = cdr(T) )
! 257: if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
! 258: if ( S == [] )
! 259: error("find_separating_ideal0 : cannot happen");
! 260: G1 = append(S,G);
! 261: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
! 262: /* check whether (Q cap (G+S)) = G */
! 263: if ( gen_gb_comp(Int,G,Mod) ) return reverse(S);
! 264: CI = ideal_product(CI,C,V|mod=Mod);
! 265: }
! 266: }
! 267:
! 268: def find_separating_ideal1(C,G,Q,Rad,V,Ord) {
! 269: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 270: for ( T = C, S = []; T != []; T = cdr(T) )
! 271: if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
! 272: if ( S == [] )
! 273: error("find_separating_ideal1 : cannot happen");
! 274: G1 = append(S,G);
! 275: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
! 276: /* check whether (Q cap (G+S)) = G */
! 277: if ( gen_gb_comp(Int,G,Mod) ) return reverse(S);
! 278:
! 279: /* or qsort(C,noro_pd.comp_tdeg) */
! 280: C = qsort(S,noro_pd.comp_tdeg);
! 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))),
! 284: TV,Ord1|gbblock=[[0,length(G)]],mod=Mod);
! 285: Dp = dp_gr_print(); dp_gr_print(0);
! 286: for ( T = C, S = []; T != []; T = cdr(T) ) {
! 287: if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
! 288: Ui = U = car(T);
! 289: for ( I = 1; ; I++ ) {
! 290: G1 = cons(Ui,G);
! 291: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
! 292: if ( gen_gb_comp(Int,G,Mod) ) break;
! 293: else
! 294: Ui = gen_nf(Ui*U,G,V,Ord,Mod);
! 295: }
! 296: print([length(T),I],2);
! 297: Int1 = incremental_gb(append(Int0,[Tmp*Ui]),TV,Ord1
! 298: |gbblock=[[0,length(Int0)]],mod=Mod);
! 299: Int = elimination(Int1,V);
! 300: if ( !gen_gb_comp(Int,G,Mod) ) {
! 301: break;
! 302: } else {
! 303: Int0 = Int1;
! 304: S = cons(Ui,S);
! 305: }
! 306: }
! 307: print("");
! 308: dp_gr_print(Dp);
! 309: return reverse(S);
! 310: }
! 311:
! 312: def find_separating_ideal2(C,G,Q,Rad,V,Ord) {
! 313: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 314: for ( T = C, S = []; T != []; T = cdr(T) )
! 315: if ( gen_nf(car(T),Q,V,Ord,Mod) ) S = cons(car(T),S);
! 316: if ( S == [] )
! 317: error("find_separating_ideal2 : cannot happen");
! 318: G1 = append(S,G);
! 319: Int = ideal_intersection(G1,Q,V,Ord|mod=Mod);
! 320: /* check whether (Q cap (G+S)) = G */
! 321: if ( gen_gb_comp(Int,G,Mod) ) return reverse(S);
! 322:
! 323: /* or qsort(S,noro_pd.comp_tdeg) */
! 324: C = qsort(C,noro_pd.comp_tdeg);
! 325: Dp = dp_gr_print(); dp_gr_print(0);
! 326: for ( T = C, S = []; T != []; T = cdr(T) ) {
! 327: if ( !gen_nf(car(T),Rad,V,Ord,Mod) ) continue;
! 328: Ui = U = car(T);
! 329: for ( I = 1; ; I++ ) {
! 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;
! 334: else
! 335: Ui = gen_nf(Ui*U,G,V,Ord,Mod);
! 336: }
! 337: print([length(T),I],2);
! 338: S = cons(Ui,S);
! 339: }
! 340: print("");
! 341: S = qsort(S,noro_pd.comp_tdeg);
! 342: End = Len = length(S);
! 343:
! 344: Tmp = ttttt; TV = cons(Tmp,V); Ord1 = [[0,1],[Ord,length(V)]];
! 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 ) {
! 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
! 354: |gbblock=[[0,length(Int0)]],mod=Mod);
! 355: Int = elimination(Int1,V);
! 356: if ( gen_gb_comp(Int,G,Mod) ) {
! 357: print([Cur],2);
! 358: Prev = Cur;
! 359: Cur = Cur+idiv(End-Cur+1,2);
! 360: Int0 = Int1;
! 361: } else {
! 362: End = Cur;
! 363: Cur = Prev + idiv(Cur-Prev,2);
! 364: }
! 365: }
! 366: for ( St = [], I = 0; I < Prev; I++ ) St = cons(S[I],St);
! 367: } else
! 368: St = [S[0]];
! 369: print("");
! 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;
! 378: }
! 379: }
! 380: Ok = reverse(St);
! 381: print("");
! 382: print([length(S),length(Ok)]);
! 383: dp_gr_print(Dp);
! 384: return Ok;
! 385: }
! 386:
! 387: /* SY primary decompsition */
! 388:
! 389: def sy_dec(B,V)
! 390: {
! 391: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 392: if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0;
! 393: Ord = 0;
! 394: G = fast_gb(B,V,Mod,Ord);
! 395: Q = [];
! 396: IntQ = [1];
! 397: Gt = G;
! 398: First = 1;
! 399: while ( 1 ) {
! 400: if ( type(Gt[0]) == 1 ) break;
! 401: Pt = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec,mod=Mod);
! 402: L = pseudo_dec(Gt,Pt,V,Ord|mod=Mod);
! 403: Qt = L[0]; Rt = L[1]; St = L[2];
! 404: IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord|mod=Mod);
! 405: if ( First ) {
! 406: IntQ = IntQt;
! 407: Qi = Qt;
! 408: First = 0;
! 409: } else {
! 410: IntQ = ideal_intersection(IntQ,IntQt,V,Ord|mod=Mod);
! 411: Q = append(Qt,Q);
! 412: }
! 413: if ( gen_gb_comp(IntQ,G,Mod) ) break;
! 414: for ( T = Rt; T != []; T = cdr(T) ) {
! 415: if ( type(car(T)[0]) == 1 ) continue;
! 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);
! 419: Q = append(U,Q);
! 420: if ( gen_gb_comp(IntQ,G,Mod) ) break;
! 421: }
! 422: Gt = fast_gb(append(Gt,St),V,Mod,Ord);
! 423: }
! 424: Q = qd_remove_redundant_comp(G,Qi,Q,V,Ord|mod=Mod);
! 425: return append(Qi,Q);
! 426: }
! 427:
! 428: def pseudo_dec(G,L,V,Ord)
! 429: {
! 430: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 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]]);
! 438: PI = ideal_list_intersection(LI,V,Ord|mod=Mod);
! 439: PI = qsort(PI,noro_pd.comp_tdeg);
! 440: for ( T = PI; T != []; T = cdr(T) )
! 441: if ( gen_nf(car(T),L0[I],V,Ord,Mod) ) break;
! 442: if ( T == [] ) error("separator : cannot happen");
! 443: SI = sat_ind(G,car(T),V|mod=Mod);
! 444: QI = SI[0];
! 445: S[I] = car(T)^SI[1];
! 446: PV = L[I][1];
! 447: V0 = setminus(V,PV);
! 448: #if 0
! 449: GI = fast_gb(QI,append(V0,PV),Mod,
! 450: [[Ord,length(V0)],[Ord,length(PV)]]);
! 451: #else
! 452: GI = fast_gb(QI,append(V0,PV),Mod,
! 453: [[2,length(V0)],[Ord,length(PV)]]);
! 454: #endif
! 455: LCFI = lcfactor(GI,V0,Ord,Mod);
! 456: for ( F = 1, T = LCFI, Gt = QI; T != []; T = cdr(T) ) {
! 457: St = sat_ind(Gt,T[0],V|mod=Mod);
! 458: Gt = St[0]; F *= T[0]^St[1];
! 459: }
! 460: Q[I] = [Gt,L0[I]];
! 461: R[I] = fast_gb(cons(F,QI),V,Mod,Ord);
! 462: }
! 463: return [vtol(Q),vtol(R),vtol(S)];
! 464: }
! 465:
! 466: def iso_comp(G,L,V,Ord)
! 467: {
! 468: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 469: if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
! 470: N = length(L);
! 471: S = vector(N);
! 472: Ind = vector(N);
! 473: Q = vector(N);
! 474: L0 = map(first_element,L);
! 475: if ( !IsGB ) G = nd_gr(G,V,Mod,Ord);
! 476: for ( I = 0; I < N; I++ ) {
! 477: LI = setminus(L0,[L0[I]]);
! 478: PI = ideal_list_intersection(LI,V,Ord|mod=Mod);
! 479: for ( T = PI; T != []; T = cdr(T) )
! 480: if ( gen_nf(car(T),L0[I],V,Ord,Mod) ) break;
! 481: if ( T == [] ) error("separator : cannot happen");
! 482: S[I] = car(T);
! 483: QI = sat(G,S[I],V|isgb=1,mod=Mod);
! 484: PV = L[I][1];
! 485: V0 = setminus(V,PV);
! 486: GI = elim_gb(QI,V0,PV,Mod,[[0,length(V0)],[0,length(PV)]]);
! 487: Q[I] = [contraction(GI,V0|mod=Mod),L0[I]];
! 488: }
! 489: return vtol(Q);
! 490: }
! 491:
! 492: /* GTZ primary decompsition */
! 493:
! 494: def prima_dec(B,V)
! 495: {
! 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);
! 500: IntP = [1];
! 501: QD = [];
! 502: while ( 1 ) {
! 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);
! 506: V0 = setminus(V,W); N = length(V0);
! 507: V1 = append(V0,W);
! 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);
! 511: F = 1;
! 512: for ( T = LCF, G2 = G; T != []; T = cdr(T) ) {
! 513: S = sat_ind(G2,T[0],V1|mod=Mod);
! 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);
! 518: Int = ideal_list_intersection(QL,V,0|mod=Mod);
! 519: IntP = ideal_intersection(IntP,Int,V,0|mod=Mod);
! 520: QD = append(QD,L);
! 521: F = gen_nf(F,G,V,0,Mod);
! 522: G = fast_gb(cons(F,G),V,Mod,Ord);
! 523: }
! 524: QD = qd_remove_redundant_comp(G0,[],QD,V,0);
! 525: return QD;
! 526: }
! 527:
! 528: /* SL prime decomposition */
! 529:
! 530: def prime_dec(B,V)
! 531: {
! 532: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 533: if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
! 534: if ( type(NoLexDec=getopt(nolexdec)) == -1 ) NoLexDec = 0;
! 535: if ( type(Rad=getopt(radical)) == -1 ) Rad = 0;
! 536: B = map(sq,B,Mod);
! 537: if ( !NoLexDec )
! 538: PD = lex_predec1(B,V|mod=Mod);
! 539: else
! 540: PD = [B];
! 541: G = ideal_list_intersection(PD,V,0|mod=Mod);
! 542: PD = pd_remove_redundant_comp(G,PD,V,0|mod=Mod);
! 543: R = [];
! 544: for ( T = PD; T != []; T = cdr(T) )
! 545: R = append(prime_dec_main(car(T),V|indep=Indep,mod=Mod),R);
! 546: if ( Indep ) {
! 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);
! 549: } else {
! 550: G = ideal_list_intersection(R,V,0|mod=Mod);
! 551: if ( !NoLexDec ) R = pd_remove_redundant_comp(G,R,V,0|mod=Mod);
! 552: }
! 553: return Rad ? [R,G] : R;
! 554: }
! 555:
! 556: def prime_dec_main(B,V)
! 557: {
! 558: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 559: if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
! 560: G = fast_gb(B,V,Mod,0);
! 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) ) {
! 567: if ( (GNV = modular_radical_membership(car(T),G,V|mod=Mod)) ) {
! 568: F = car(T);
! 569: break;
! 570: }
! 571: }
! 572: if ( T == [] ) return PD;
! 573:
! 574: /* GNV = [GB(<NV*F-1,G>),NV] */
! 575: G1 = fast_gb(GNV[0],cons(GNV[1],V),Mod,[[0,1],[0,length(V)]]);
! 576: G0 = elimination(G1,V);
! 577: PD0 = zprimecomp(G0,V,Indep|mod=Mod);
! 578: if ( Indep ) {
! 579: Int = ideal_list_intersection(PD0[0],V,0|mod=Mod);
! 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 {
! 585: Int = ideal_list_intersection(PD0,V,0|mod=Mod);
! 586: PD = append(PD,PD0);
! 587: }
! 588: IntP = ideal_intersection(IntP,Int,V,0|mod=Mod);
! 589: }
! 590: }
! 591:
! 592: /* pre-decomposition */
! 593:
! 594: def lex_predec1(B,V)
! 595: {
! 596: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 597: G = fast_gb(B,V,Mod,2);
! 598: for ( T = G; T != []; T = cdr(T) ) {
! 599: F = gen_fctr(car(T),Mod);
! 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];
! 603: Gt = map(ptozp,map(gen_nf,G,[Ft],V,0,Mod));
! 604: R1 = fast_gb(cons(Ft,Gt),V,Mod,0);
! 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;
! 818: GIt = map(gen_nf,GI,[Mt],V,Ord,Mod);
! 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) {
! 835: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 836: L = zprimadec(G,V,0|mod=Mod);
! 837: R = [];
! 838: dp_ord(0);
! 839: for ( T = L; T != []; T = cdr(T) ) {
! 840: S = car(T);
! 841: UQ = contraction(S[0],V|mod=Mod);
! 842: UP = contraction(S[1],V|mod=Mod);
! 843: R = cons([UQ,UP],R);
! 844: }
! 845: return R;
! 846: }
! 847:
! 848: def zprimecomp(G,V,Indep) {
! 849: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 850: W = maxindep(G,V,0|mod=Mod);
! 851: V0 = setminus(V,W);
! 852: V1 = append(V0,W);
! 853: #if 0
! 854: O1 = [[0,length(V0)],[0,length(W)]];
! 855: G1 = fast_gb(G,V1,Mod,O1);
! 856: dp_ord(0);
! 857: #else
! 858: G1 = G;
! 859: #endif
! 860: PD = zprimedec(G1,V0,Mod);
! 861: dp_ord(0);
! 862: R = [];
! 863: for ( T = PD; T != []; T = cdr(T) ) {
! 864: U = contraction(car(T),V0|mod=Mod);
! 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: {
! 873: if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
! 874: if ( type(NoRA=getopt(nora)) == -1 ) NoRA = 0;
! 875: if ( Mod )
! 876: G = nd_f4(B,V,Mod,Ord|nora=NoRA);
! 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);
! 883: return G;
! 884: }
! 885:
! 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;
! 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 ) {
! 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: }
! 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];
! 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);
! 916: G = dp_gr_mod_main(G,V,0,Mod,Ord);
! 917: } else if ( Procs ) {
! 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:
! 934: /* over Q only */
! 935:
! 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 ) {
! 1017: V1 = append(W,PV1);
! 1018: G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]);
! 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: {
! 1062: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 1063: G = fast_gb(B,V,Mod,O);
! 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: {
! 1086: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 1087: C = [];
! 1088: for ( T = G; T != []; T = cdr(T) ) {
! 1089: C1 = dp_hc(dp_ptod(car(T),V));
! 1090: S = gen_fctr(C1,Mod);
! 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);
! 1100: G = saturation([G,NV],S,W|mod=Mod);
! 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;
! 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
! 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))),
! 1143: cons(T,V),0,[[0,1],[Ord,length(V)]]|gbblock=Block,nora=0);
! 1144: else
! 1145: G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
! 1146: cons(T,V),0,[[0,1],[Ord,length(V)]]|nora=0);
! 1147: }
! 1148: G0 = elimination(G,V);
! 1149: if ( 0 && !Procs )
! 1150: G0 = nd_gr_postproc(G0,V,Mod,Ord,0);
! 1151: return G0;
! 1152: }
! 1153:
! 1154: /* returns GB if F notin rad(G) */
! 1155:
! 1156: def radical_membership(F,G,V) {
! 1157: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 1158: F = gen_nf(F,G,V,0,Mod);
! 1159: if ( !F ) return 0;
! 1160: NV = ttttt;
! 1161: T = fast_gb(cons(NV*F-1,G),cons(NV,V),Mod,0);
! 1162: if ( type(car(T)) != 1 ) return [T,NV];
! 1163: else return 0;
! 1164: }
! 1165:
! 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);
! 1170:
! 1171: F = gen_nf(F,G,V,0,0);
! 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 ) {
! 1194: Ft = gen_nf(Ft,G,V,Ord,Mod);
! 1195: if ( !Ft ) return I;
! 1196: Ft *= F;
! 1197: I++;
! 1198: }
! 1199: return -1;
! 1200: }
! 1201:
! 1202: def ideal_product(A,B,V)
! 1203: {
! 1204: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 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,noro_pd.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];
! 1225: R = fast_gb(B0,V,Mod,0);
! 1226: while ( B1 != [] ) {
! 1227: print(length(B1));
! 1228: L = sep_list(B1,Len);
! 1229: B0 = L[0]; B1 = L[1];
! 1230: R = fast_gb(append(R,B0),V,Mod,0|gbblock=[[0,length(R)]],nora=1);
! 1231: }
! 1232: return R;
! 1233: }
! 1234:
! 1235: def saturation(GNV,F,V)
! 1236: {
! 1237: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 1238: G = GNV[0]; NV = GNV[1];
! 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 ) {
! 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: {
! 1254: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 1255: if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
! 1256: NV = ttttt;
! 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 ) {
! 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);
! 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: }
! 1275: return elimination(G1,V);
! 1276: }
! 1277:
! 1278: def satind(G,F,V)
! 1279: {
! 1280: if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
! 1281: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 1282: NV = ttttt;
! 1283: N = length(V);
! 1284: B = append(G,[NV*F-1]);
! 1285: V1 = cons(NV,V);
! 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);
! 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: {
! 1317: if ( type(Ord=getopt(ord)) == -1 ) Ord = 0;
! 1318: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 1319: NV = ttttt;
! 1320: F = gen_nf(F,G,V,Ord,Mod);
! 1321: for ( I = 0, GI = G; ; I++ ) {
! 1322: G1 = colon(GI,F,V|mod=Mod,ord=Ord);
! 1323: if ( ideal_inclusion(G1,GI,V,Ord|mod=Mod) ) {
! 1324: return [GI,I];
! 1325: }
! 1326: else GI = G1;
! 1327: }
! 1328: }
! 1329:
! 1330: def colon(G,F,V)
! 1331: {
! 1332: if ( type(Ord=getopt(ord)) == -1 ) Ord = 0;
! 1333: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 1334: if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
! 1335: F = gen_nf(F,G,V,Ord,Mod);
! 1336: if ( !F ) return [1];
! 1337: if ( IsGB )
! 1338: T = ideal_intersection(G,[F],V,Ord|gbblock=[[0,length(G)]],mod=Mod);
! 1339: else
! 1340: T = ideal_intersection(G,[F],V,Ord|mod=Mod);
! 1341: return Mod?map(sdivm,T,F,Mod):map(ptozp,map(sdiv,T,F));
! 1342: }
! 1343:
! 1344: def ideal_colon(G,F,V)
! 1345: {
! 1346: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 1347: G = nd_gr(G,V,Mod,0);
! 1348: for ( T = F, L = []; T != []; T = cdr(T) )
! 1349: L = cons(colon(G,car(T),V|isgb=1,mod=Mod),L);
! 1350: L = reverse(L);
! 1351: return ideal_list_intersection(L,V,0|mod=Mod);
! 1352: }
! 1353:
! 1354: def ideal_sat(G,F,V)
! 1355: {
! 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);
! 1362: }
! 1363:
! 1364: def ideal_inclusion(F,G,V,O)
! 1365: {
! 1366: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 1367: for ( T = F; T != []; T = cdr(T) )
! 1368: if ( gen_nf(car(T),G,V,O,Mod) ) return 0;
! 1369: return 1;
! 1370: }
! 1371:
! 1372: /* remove redundant components */
! 1373:
! 1374: def qd_simp_comp(QP,V)
! 1375: {
! 1376: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 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++ )
! 1383: if ( R[J] && gen_gb_comp(PI,R[J][1],Mod) ) {
! 1384: QI = ideal_intersection(QI,R[J][0],V,0|mod=Mod);
! 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: {
! 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);
! 1400: Emb = reverse(qsort(Emb));
! 1401: A = ltov(Emb); N = length(A);
! 1402: Pre = IsoInt; Post = vector(N+1);
! 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);
! 1405: for ( I = 0; I < N; I++ ) {
! 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;
! 1409: else
! 1410: Pre = ideal_intersection(Pre,A[I][0],V,Ord|mod=Mod);
! 1411: }
! 1412: for ( T = [], I = 0; I < N; I++ )
! 1413: if ( A[I] ) T = cons(A[I],T);
! 1414: return reverse(T);
! 1415: }
! 1416:
! 1417: def pd_remove_redundant_comp(G,P,V,Ord)
! 1418: {
! 1419: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 1420: if ( type(First=getopt(first)) == -1 ) First = 0;
! 1421: A = ltov(P); N = length(A);
! 1422: for ( I = 0; I < N; I++ ) {
! 1423: if ( !A[I] ) continue;
! 1424: for ( J = I+1; J < N; J++ )
! 1425: if ( A[J] &&
! 1426: gen_gb_comp(First?A[I][0]:A[I],First?A[J][0]:A[J],Mod) ) A[J] = 0;
! 1427: }
! 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-- )
! 1432: Post[I] = ideal_intersection(Post[I+1],First?A[I][0]:A[I],V,Ord|mod=Mod);
! 1433: for ( I = 0; I < N; I++ ) {
! 1434: Int = ideal_intersection(Pre,Post[I+1],V,Ord|mod=Mod);
! 1435: if ( gen_gb_comp(Int,G,Mod) ) A[I] = 0;
! 1436: else
! 1437: Pre = ideal_intersection(Pre,First?A[I][0]:A[I],V,Ord|mod=Mod);
! 1438: }
! 1439: for ( T = [], I = 0; I < N; I++ ) if ( A[I] ) T = cons(A[I],T);
! 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:
! 1455: def sq(F,Mod)
! 1456: {
! 1457: if ( !F ) return 0;
! 1458: A = cdr(gen_fctr(F,Mod));
! 1459: for ( R = 1; A != []; A = cdr(A) )
! 1460: R *= car(car(A));
! 1461: return R;
! 1462: }
! 1463:
! 1464: def lcfactor(G,V,O,Mod)
! 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));
! 1470: S = gen_fctr(C1,Mod);
! 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:
! 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:
! 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: }
! 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:
! 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 / obsolete