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