Annotation of OpenXM/src/asir-contrib/testing/noro/noro_pd.rr, Revision 1.1
1.1 ! noro 1: import("gr")$
! 2: module noro_pd$
! 3:
! 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, 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, quick_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_inclusion, qd_simp_comp, qd_remove_redundant_comp$
! 19: localf remove_redundant_comp, remove_redundant_comp_first, ppart, sq$
! 20: localf 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$
! 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: /* SYC primary decomositions */
! 73:
! 74: def syca_dec(B,V)
! 75: {
! 76: if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0;
! 77: if ( type(SepIdeal=getopt(sepideal)) == -1 ) SepIdeal = 1;
! 78: Ord = 0;
! 79: Gt = G0 = G = fast_gb(B,V,0,Ord);
! 80: Q0 = Q = []; IntQ0 = IntQ = [1]; First = 1;
! 81: while ( 1 ) {
! 82: if ( type(Gt[0])==1 ) break;
! 83: Pt = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec);
! 84: Qt = iso_comp(Gt,Pt,V,Ord);
! 85: IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord);
! 86: IntPt = ideal_list_intersection(map(first_element,Pt),V,Ord);
! 87: if ( First ) {
! 88: IntQ0 = IntQ = IntQt; IntP = IntPt; Qi = Qt; First = 0;
! 89: } else {
! 90: IntQ = ideal_intersection(IntQ,IntQt,V,Ord);
! 91: IntQ1 = ideal_intersection(IntQ0,IntQt,V,Ord);
! 92: if ( !gb_comp(IntQ0,IntQ1) ) {
! 93: IntQ0 = IntQ1; Q = append(Qt,Q); Q0 = append(Qt,Q0);
! 94: }
! 95: }
! 96: if ( gb_comp(IntQt,Gt) || gb_comp(IntQ,G) || gb_comp(IntQ0,G0) ) break;
! 97: if ( SepIdeal == 0 )
! 98: Ok = find_separating_ideal0(G,IntQ,IntP,V,Ord);
! 99: else if ( SepIdeal == 1 )
! 100: Ok = find_separating_ideal1(G,IntQ,IntP,V,Ord);
! 101: else if ( SepIdeal == 2 )
! 102: Ok = find_separating_ideal2(G,IntQ,IntP,V,Ord);
! 103: G1 = append(Ok,G);
! 104: Gt1 = fast_gb(G1,V,0,Ord);
! 105: if ( ideal_inclusion(Gt1,Gt,V,Ord) ) {
! 106: G = Gt; IntP = IntPt; Q = []; IntQ = [1];
! 107: } else
! 108: Gt = Gt1;
! 109: }
! 110: Q1 = qd_remove_redundant_comp(G0,Qi,Q0,V,Ord);
! 111: return append(Qi,Q1);
! 112: }
! 113:
! 114: def syc_dec(B,V)
! 115: {
! 116: if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0;
! 117: if ( type(SepIdeal=getopt(sepideal)) == -1 ) SepIdeal = 1;
! 118: Ord = 0;
! 119: G = fast_gb(B,V,0,Ord);
! 120: Q = []; IntQ = [1]; Gt = G; First = 1;
! 121: while ( 1 ) {
! 122: if ( type(Gt[0])==1 ) break;
! 123: Pt = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec);
! 124: Qt = iso_comp(Gt,Pt,V,Ord);
! 125: IntQt = ideal_list_intersection(map(first_element,Qt),V,Ord);
! 126: IntPt = ideal_list_intersection(map(first_element,Pt),V,Ord);
! 127: if ( First ) {
! 128: IntQ = IntQt; Qi = Qt; First = 0;
! 129: } else {
! 130: IntQ = ideal_intersection(IntQ,IntQt,V,Ord);
! 131: Q = append(Qt,Q);
! 132: }
! 133: if ( gb_comp(IntQ,G) ) break;
! 134: if ( SepIdeal == 0 )
! 135: Ok = find_separating_ideal0(Gt,IntQt,IntPt,V,Ord);
! 136: else if ( SepIdeal == 1 )
! 137: Ok = find_separating_ideal1(Gt,IntQt,IntPt,V,Ord);
! 138: else if ( SepIdeal == 2 )
! 139: Ok = find_separating_ideal2(Gt,IntQt,IntPt,V,Ord);
! 140: G1 = append(Ok,Gt);
! 141: Gt = fast_gb(G1,V,0,Ord);
! 142: }
! 143: Q = qd_remove_redundant_comp(G,Qi,Q,V,Ord);
! 144: return append(Qi,Q);
! 145: }
! 146:
! 147: /* Rad=rad(Q), return J s.t. Q cap (G+J) = G */
! 148:
! 149: def find_separating_ideal0(G,Q,Rad,V,Ord) {
! 150: C = ideal_colon(G,Q,V);
! 151: for ( CI = C, I = 1; ; I++ ) {
! 152: for ( T = CI, S = []; T != []; T = cdr(T) )
! 153: if ( nd_nf(car(T),Q,V,Ord,0) ) S = cons(car(T),S);
! 154: if ( S == [] )
! 155: error("find_separating_ideal0 : cannot happen");
! 156: G1 = append(S,G);
! 157: Int = ideal_intersection(G1,Q,V,Ord);
! 158: /* check whether (Q cap (G+S)) = G */
! 159: if ( gb_comp(Int,G) ) return reverse(S);
! 160: CI = ideal_product(CI,C,V);
! 161: }
! 162: }
! 163:
! 164: def find_separating_ideal1(G,Q,Rad,V,Ord) {
! 165: C = ideal_colon(G,Q,V);
! 166: for ( T = C, S = []; T != []; T = cdr(T) )
! 167: if ( nd_nf(car(T),Q,V,Ord,0) ) S = cons(car(T),S);
! 168: if ( S == [] )
! 169: error("find_separating_ideal1 : cannot happen");
! 170: G1 = append(S,G);
! 171: Int = ideal_intersection(G1,Q,V,Ord);
! 172: /* check whether (Q cap (G+S)) = G */
! 173: if ( gb_comp(Int,G) ) return reverse(S);
! 174:
! 175: C = qsort(S,comp_tdeg);
! 176: for ( T = C, S = []; T != []; T = cdr(T) ) {
! 177: if ( !nd_nf(car(T),Rad,V,Ord,0) ) continue;
! 178: Ui = U = car(T);
! 179: for ( I = 1; ; I++ ) {
! 180: G1 = cons(Ui,G);
! 181: Int = ideal_intersection(G1,Q,V,Ord);
! 182: if ( gb_comp(Int,G) ) break;
! 183: else
! 184: Ui = nd_nf(Ui*U,G,V,Ord,0);
! 185: }
! 186: if ( length(S) ) {
! 187: G1 = append(cons(Ui,S),G);
! 188: Int = ideal_intersection(G1,Q,V,Ord);
! 189: if ( !gb_comp(Int,G) )
! 190: break;
! 191: }
! 192: S = cons(Ui,S);
! 193: }
! 194: return reverse(S);
! 195: }
! 196:
! 197: def find_separating_ideal2(G,Q,Rad,V,Ord) {
! 198: C = ideal_colon(G,Q,V);
! 199: for ( T = C, S = []; T != []; T = cdr(T) )
! 200: if ( nd_nf(car(T),Q,V,Ord,0) ) S = cons(car(T),S);
! 201: if ( S == [] )
! 202: error("find_separating_ideal2 : cannot happen");
! 203: G1 = append(S,G);
! 204: Int = ideal_intersection(G1,Q,V,Ord);
! 205: /* check whether (Q cap (G+S)) = G */
! 206: if ( gb_comp(Int,G) ) return reverse(S);
! 207:
! 208: C = qsort(C,comp_tdeg);
! 209: for ( T = C, S = []; T != []; T = cdr(T) ) {
! 210: if ( !nd_nf(car(T),Rad,V,Ord,0) ) continue;
! 211: Ui = U = car(T);
! 212: for ( I = 1; ; I++ ) {
! 213: G1 = cons(Ui,G);
! 214: Int = ideal_intersection(G1,Q,V,Ord);
! 215: if ( gb_comp(Int,G) ) break;
! 216: else
! 217: Ui = nd_nf(Ui*U,G,V,Ord,0);
! 218: }
! 219: S = cons(Ui,S);
! 220: }
! 221: S = reverse(S);
! 222: Len = length(S);
! 223: Ok = [S[0]];
! 224: if ( Len > 1 ) {
! 225: K = 2;
! 226: while ( 1 ) {
! 227: for ( St = [], I = 0; I < K; I++ ) St = cons(S[I],St);
! 228: G1 = append(St,G);
! 229: Int = ideal_intersection(G1,Q,V,Ord);
! 230: if ( !gb_comp(Int,G) ) break;
! 231: Ok = St;
! 232: if ( K == Len ) break;
! 233: else {
! 234: K = 2*K;
! 235: if ( K > Len ) K = Len;
! 236: }
! 237: }
! 238: }
! 239: return Ok;
! 240: }
! 241:
! 242: /* SY primary decompsition */
! 243:
! 244: def sy_dec(B,V)
! 245: {
! 246: if ( type(Nolexdec=getopt(nolexdec)) == -1 ) Nolexdec = 0;
! 247: Ord = 0;
! 248: G = fast_gb(B,V,0,Ord);
! 249: Q = [];
! 250: IntQ = [1];
! 251: Gt = G;
! 252: First = 1;
! 253: while ( 1 ) {
! 254: if ( type(Gt[0]) == 1 ) break;
! 255: Pt = prime_dec(Gt,V|indep=1,nolexdec=Nolexdec);
! 256: L = pseudo_dec(Gt,Pt,V,Ord);
! 257: Qt = L[0]; Rt = L[1]; St = L[2];
! 258: IntQt = ideal_list_intersection(Qt,V,Ord);
! 259: if ( First ) {
! 260: IntQ = IntQt;
! 261: Qi = Qt;
! 262: First = 0;
! 263: } else {
! 264: IntQ = ideal_intersection(IntQ,IntQt,V,Ord);
! 265: Q = append(Qt,Q);
! 266: }
! 267: if ( gb_comp(IntQ,G) ) break;
! 268: for ( T = Rt; T != []; T = cdr(T) ) {
! 269: if ( type(car(T)[0]) == 1 ) continue;
! 270: U = sy_dec(car(T),V|nolexdec=Nolexdec);
! 271: IntQ = ideal_list_intersection(cons(IntQ,U),V,Ord);
! 272: Q = append(U,Q);
! 273: if ( gb_comp(IntQ,G) ) break;
! 274: }
! 275: Gt = fast_gb(append(Gt,St),V,0,Ord);
! 276: }
! 277: Q = remove_redundant_comp(G,Qi,Q,V,Ord);
! 278: return append(Qi,Q);
! 279: }
! 280:
! 281: def pseudo_dec(G,L,V,Ord)
! 282: {
! 283: N = length(L);
! 284: S = vector(N);
! 285: Q = vector(N);
! 286: R = vector(N);
! 287: L0 = map(first_element,L);
! 288: for ( I = 0; I < N; I++ ) {
! 289: LI = setminus(L0,[L0[I]]);
! 290: PI = ideal_list_intersection(LI,V,Ord);
! 291: PI = qsort(PI,comp_tdeg);
! 292: for ( T = PI; T != []; T = cdr(T) )
! 293: if ( p_nf(car(T),L0[I],V,Ord) ) break;
! 294: if ( T == [] ) error("separator : cannot happen");
! 295: SI = sat_ind(G,car(T),V);
! 296: QI = SI[0];
! 297: S[I] = car(T)^SI[1];
! 298: PV = L[I][1];
! 299: V0 = setminus(V,PV);
! 300: #if 0
! 301: GI = fast_gb(QI,append(V0,PV),0,
! 302: [[Ord,length(V0)],[Ord,length(PV)]]);
! 303: #else
! 304: GI = fast_gb(QI,append(V0,PV),0,
! 305: [[2,length(V0)],[Ord,length(PV)]]);
! 306: #endif
! 307: LCFI = lcfactor(GI,V0,Ord);
! 308: for ( F = 1, T = LCFI, Gt = QI; T != []; T = cdr(T) ) {
! 309: St = sat_ind(Gt,T[0],V);
! 310: Gt = St[0]; F *= T[0]^St[1];
! 311: }
! 312: Q[I] = Gt;
! 313: R[I] = fast_gb(cons(F,QI),V,0,Ord);
! 314: }
! 315: return [vtol(Q),vtol(R),vtol(S)];
! 316: }
! 317:
! 318: def iso_comp(G,L,V,Ord)
! 319: {
! 320: N = length(L);
! 321: S = vector(N);
! 322: Ind = vector(N);
! 323: Q = vector(N);
! 324: L0 = map(first_element,L);
! 325: for ( I = 0; I < N; I++ ) {
! 326: LI = setminus(L0,[L0[I]]);
! 327: PI = ideal_list_intersection(LI,V,Ord);
! 328: for ( T = PI; T != []; T = cdr(T) )
! 329: if ( p_nf(car(T),L0[I],V,Ord) ) break;
! 330: if ( T == [] ) error("separator : cannot happen");
! 331: S[I] = car(T);
! 332: QI = sat(G,S[I],V);
! 333: PV = L[I][1];
! 334: V0 = setminus(V,PV);
! 335: GI = elim_gb(QI,V0,PV,0,[[0,length(V0)],[0,length(PV)]]);
! 336: Q[I] = [contraction(GI,V0),L0[I]];
! 337: }
! 338: return vtol(Q);
! 339: }
! 340:
! 341: /* GTZ primary decompsition */
! 342:
! 343: def prima_dec(B,V)
! 344: {
! 345: G = nd_gr_trace(B,V,1,GBCheck,0);
! 346: G0 = G;
! 347: IntP = [1];
! 348: QD = [];
! 349: while ( 1 ) {
! 350: if ( ideal_inclusion(IntP,G0,V,0) )
! 351: return QD;
! 352: W = maxindep(G,V,0); NP = length(W);
! 353: V0 = setminus(V,W); N = length(V0);
! 354: V1 = append(V0,W);
! 355: G1 = fast_gb(G,V1,0,[[0,N],[0,NP]]);
! 356: LCF = lcfactor(G1,V0,0);
! 357: L = zprimacomp(G,V0);
! 358: F = 1;
! 359: for ( T = LCF, G2 = G1; T != []; T = cdr(T) ) {
! 360: S = sat_ind(G2,T[0],V1);
! 361: G2 = S[0]; F *= T[0]^S[1];
! 362: }
! 363: for ( T = L, QL = []; T != []; T = cdr(T) )
! 364: QL = cons(car(T)[0],QL);
! 365: Int = ideal_list_intersection(QL,V,0);
! 366: IntP = ideal_intersection(IntP,Int,V,0);
! 367: QD = append(QD,L);
! 368: F = p_nf(F,G,V,0);
! 369: G = cons(F,G);
! 370: }
! 371: }
! 372:
! 373: /* SL prime decomposition */
! 374:
! 375: def prime_dec(B,V)
! 376: {
! 377: if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
! 378: if ( type(NoLexDec=getopt(nolexdec)) == -1 ) NoLexDec = 0;
! 379: B = map(sq,B);
! 380: if ( !NoLexDec )
! 381: PD = lex_predec1(B,V);
! 382: else
! 383: PD = [B];
! 384: G = ideal_list_intersection(PD,V,0);
! 385: PD = remove_redundant_comp(G,[],PD,V,0);
! 386: R = [];
! 387: for ( T = PD; T != []; T = cdr(T) )
! 388: R = append(prime_dec_main(car(T),V|indep=Indep),R);
! 389: if ( Indep ) {
! 390: G = ideal_list_intersection(map(first_element,R),V,0);
! 391: R = remove_redundant_comp_first(G,R,V,0);
! 392: } else {
! 393: G = ideal_list_intersection(R,V,0);
! 394: R = remove_redundant_comp(G,[],R,V,0);
! 395: }
! 396: return R;
! 397: }
! 398:
! 399: def prime_dec_main(B,V)
! 400: {
! 401: if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
! 402: G = nd_gr_trace(B,V,1,GBCheck,0);
! 403: IntP = [1];
! 404: PD = [];
! 405: while ( 1 ) {
! 406: /* rad(G) subset IntP */
! 407: /* check if IntP subset rad(G) */
! 408: for ( T = IntP; T != []; T = cdr(T) ) {
! 409: if ( (GNV = modular_radical_membership(car(T),G,V)) ) {
! 410: F = car(T);
! 411: break;
! 412: }
! 413: }
! 414: if ( T == [] ) return PD;
! 415:
! 416: /* GNV = [GB(<NV*F-1,G>),NV] */
! 417: G1 = nd_gr_trace(GNV[0],cons(GNV[1],V),1,GBCheck,[[0,1],[0,length(V)]]);
! 418: G0 = elimination(G1,V);
! 419: PD0 = zprimecomp(G0,V,Indep);
! 420: if ( Indep ) {
! 421: Int = ideal_list_intersection(PD0[0],V,0);
! 422: IndepSet = PD0[1];
! 423: for ( PD1 = [], T = PD0[0]; T != []; T = cdr(T) )
! 424: PD1 = cons([car(T),IndepSet],PD1);
! 425: PD = append(PD,reverse(PD1));
! 426: } else {
! 427: Int = ideal_list_intersection(PD0,V,0);
! 428: PD = append(PD,PD0);
! 429: }
! 430: IntP = ideal_intersection(IntP,Int,V,0);
! 431: }
! 432: }
! 433:
! 434: /* pre-decomposition */
! 435:
! 436: def lex_predec1(B,V)
! 437: {
! 438: G = nd_gr_trace(B,V,1,GBCheck,2);
! 439: for ( T = G; T != []; T = cdr(T) ) {
! 440: F = fctr(car(T));
! 441: if ( length(F) > 2 || length(F) == 2 && F[1][1] > 1 ) {
! 442: for ( R = [], S = cdr(F); S != []; S = cdr(S) ) {
! 443: Ft = car(S)[0];
! 444: Gt = map(ptozp,map(p_nf,G,[Ft],V,0));
! 445: R1 = nd_gr_trace(cons(Ft,Gt),V,1,GBCheck,0);
! 446: R = cons(R1,R);
! 447: }
! 448: return R;
! 449: }
! 450: }
! 451: return [G];
! 452: }
! 453:
! 454: /* zero-dimensional prime/primary decomosition */
! 455:
! 456: def zprimedec(B,V,Mod)
! 457: {
! 458: L = partial_decomp(B,V,Mod);
! 459: P = L[0]; NP = L[1];
! 460: R = [];
! 461: for ( ; P != []; P = cdr(P) ) R = cons(car(car(P)),R);
! 462: for ( T = NP; T != []; T = cdr(T) ) {
! 463: R1 = complete_decomp(car(T),V,Mod);
! 464: R = append(R1,R);
! 465: }
! 466: return R;
! 467: }
! 468:
! 469: def zprimadec(B,V,Mod)
! 470: {
! 471: L = partial_qdecomp(B,V,Mod);
! 472: Q = L[0]; NQ = L[1];
! 473: R = [];
! 474: for ( ; Q != []; Q = cdr(Q) ) {
! 475: T = car(Q); R = cons([T[0],T[1]],R);
! 476: }
! 477: for ( T = NQ; T != []; T = cdr(T) ) {
! 478: R1 = complete_qdecomp(car(T),V,Mod);
! 479: R = append(R1,R);
! 480: }
! 481: return R;
! 482: }
! 483:
! 484: def complete_qdecomp(GD,V,Mod)
! 485: {
! 486: GQ = GD[0]; GP = GD[1]; D = GD[2];
! 487: W = vars(GP);
! 488: PV = setminus(W,V);
! 489: N = length(V); PN = length(PV);
! 490: U = find_npos([GP,D],V,PV,Mod);
! 491: NV = ttttt;
! 492: M = gen_minipoly(cons(NV-U,GQ),cons(NV,V),PV,0,NV,Mod);
! 493: M = ppart(M,NV,Mod);
! 494: MF = Mod ? modfctr(M) : fctr(M);
! 495: R = [];
! 496: for ( T = cdr(MF); T != []; T = cdr(T) ) {
! 497: S = car(T);
! 498: Mt = subst(S[0],NV,U);
! 499: GP1 = fast_gb(cons(Mt,GP),W,Mod,0);
! 500: GQ1 = fast_gb(cons(Mt^S[1],GQ),W,Mod,0);
! 501: if ( PV != [] ) {
! 502: GP1 = elim_gb(GP1,V,PV,Mod,[[0,N],[0,PN]]);
! 503: GQ1 = elim_gb(GQ1,V,PV,Mod,[[0,N],[0,PN]]);
! 504: }
! 505: R = cons([GQ1,GP1],R);
! 506: }
! 507: return R;
! 508: }
! 509:
! 510: def partial_qdecomp(B,V,Mod)
! 511: {
! 512: Elim = (Elim=getopt(elim))&&type(Elim)!=-1 ? 1 : 0;
! 513: N = length(V);
! 514: W = vars(B);
! 515: PV = setminus(W,V);
! 516: NP = length(PV);
! 517: W = append(V,PV);
! 518: if ( Elim && PV != [] ) Ord = [[0,N],[0,NP]];
! 519: else Ord = 0;
! 520: if ( Mod )
! 521: B = nd_f4(B,W,Mod,Ord);
! 522: else
! 523: B = nd_gr_trace(B,W,1,GBCheck,Ord);
! 524: Q = []; NQ = [[B,B,vector(N+1)]];
! 525: for ( I = length(V)-1; I >= 0; I-- ) {
! 526: NQ1 = [];
! 527: for ( T = NQ; T != []; T = cdr(T) ) {
! 528: L = partial_qdecomp0(car(T),V,PV,Ord,I,Mod);
! 529: Q = append(L[0],Q);
! 530: NQ1 = append(L[1],NQ1);
! 531: }
! 532: NQ = NQ1;
! 533: }
! 534: return [Q,NQ];
! 535: }
! 536:
! 537: def partial_qdecomp0(GD,V,PV,Ord,I,Mod)
! 538: {
! 539: GQ = GD[0]; GP = GD[1]; D = GD[2];
! 540: N = length(V); PN = length(PV);
! 541: W = append(V,PV);
! 542: VI = V[I];
! 543: M = gen_minipoly(GQ,V,PV,Ord,VI,Mod);
! 544: M = ppart(M,VI,Mod);
! 545: if ( Mod )
! 546: MF = modfctr(M,Mod);
! 547: else
! 548: MF = fctr(M);
! 549: Q = []; NQ = [];
! 550: if ( length(MF) == 2 && MF[1][1] == 1 ) {
! 551: D1 = D*1; D1[I] = M;
! 552: GQelim = elim_gb(GQ,V,PV,Mod,Ord);
! 553: GPelim = elim_gb(GP,V,PV,Mod,Ord);
! 554: LD = ldim(GQelim,V);
! 555: if ( deg(M,VI) == LD )
! 556: Q = cons([GQelim,GPelim,D1],Q);
! 557: else
! 558: NQ = cons([GQelim,GPelim,D1],NQ);
! 559: return [Q,NQ];
! 560: }
! 561: for ( T = cdr(MF); T != []; T = cdr(T) ) {
! 562: S = car(T); Mt = S[0]; D1 = D*1; D1[I] = Mt;
! 563:
! 564: GQ1 = fast_gb(cons(Mt^S[1],GQ),W,Mod,Ord);
! 565: GQelim = elim_gb(GQ1,V,PV,Mod,Ord);
! 566: GP1 = fast_gb(cons(Mt,GP),W,Mod,Ord);
! 567: GPelim = elim_gb(GP1,V,PV,Mod,Ord);
! 568:
! 569: D1[N] = LD = ldim(GPelim,V);
! 570:
! 571: for ( J = 0; J < N; J++ )
! 572: if ( D1[J] && deg(D1[J],V[J]) == LD ) break;
! 573: if ( J < N )
! 574: Q = cons([GQelim,GPelim,D1],Q);
! 575: else
! 576: NQ = cons([GQelim,GPelim,D1],NQ);
! 577: }
! 578: return [Q,NQ];
! 579: }
! 580:
! 581: def complete_decomp(GD,V,Mod)
! 582: {
! 583: G = GD[0]; D = GD[1];
! 584: W = vars(G);
! 585: PV = setminus(W,V);
! 586: N = length(V); PN = length(PV);
! 587: U = find_npos(GD,V,PV,Mod);
! 588: NV = ttttt;
! 589: M = gen_minipoly(cons(NV-U,G),cons(NV,V),PV,0,NV,Mod);
! 590: M = ppart(M,NV,Mod);
! 591: MF = Mod ? modfctr(M) : fctr(M);
! 592: if ( length(MF) == 2 ) return [G];
! 593: R = [];
! 594: for ( T = cdr(MF); T != []; T = cdr(T) ) {
! 595: Mt = subst(car(car(T)),NV,U);
! 596: G1 = fast_gb(cons(Mt,G),W,Mod,0);
! 597: if ( PV != [] ) G1 = elim_gb(G1,V,PV,Mod,[[0,N],[0,PN]]);
! 598: R = cons(G1,R);
! 599: }
! 600: return R;
! 601: }
! 602:
! 603: def partial_decomp(B,V,Mod)
! 604: {
! 605: Elim = (Elim=getopt(elim))&&type(Elim)!=-1 ? 1 : 0;
! 606: N = length(V);
! 607: W = vars(B);
! 608: PV = setminus(W,V);
! 609: NP = length(PV);
! 610: W = append(V,PV);
! 611: if ( Elim && PV != [] ) Ord = [[0,N],[0,NP]];
! 612: else Ord = 0;
! 613: if ( Mod )
! 614: B = nd_f4(B,W,Mod,Ord);
! 615: else
! 616: B = nd_gr_trace(B,W,1,GBCheck,Ord);
! 617: P = []; NP = [[B,vector(N+1)]];
! 618: for ( I = length(V)-1; I >= 0; I-- ) {
! 619: NP1 = [];
! 620: for ( T = NP; T != []; T = cdr(T) ) {
! 621: L = partial_decomp0(car(T),V,PV,Ord,I,Mod);
! 622: P = append(L[0],P);
! 623: NP1 = append(L[1],NP1);
! 624: }
! 625: NP = NP1;
! 626: }
! 627: return [P,NP];
! 628: }
! 629:
! 630: def partial_decomp0(GD,V,PV,Ord,I,Mod)
! 631: {
! 632: G = GD[0]; D = GD[1];
! 633: N = length(V); PN = length(PV);
! 634: W = append(V,PV);
! 635: VI = V[I];
! 636: M = gen_minipoly(G,V,PV,Ord,VI,Mod);
! 637: M = ppart(M,VI,Mod);
! 638: if ( Mod )
! 639: MF = modfctr(M,Mod);
! 640: else
! 641: MF = fctr(M);
! 642: if ( length(MF) == 2 && MF[1][1] == 1 ) {
! 643: D1 = D*1;
! 644: D1[I] = M;
! 645: Gelim = elim_gb(G,V,PV,Mod,Ord);
! 646: D1[N] = LD = ldim(Gelim,V);
! 647: GD1 = [Gelim,D1];
! 648: for ( J = 0; J < N; J++ )
! 649: if ( D1[J] && deg(D1[J],V[J]) == LD )
! 650: return [[GD1],[]];
! 651: return [[],[GD1]];
! 652: }
! 653: P = []; NP = [];
! 654: GI = elim_gb(G,V,PV,Mod,Ord);
! 655: for ( T = cdr(MF); T != []; T = cdr(T) ) {
! 656: Mt = car(car(T));
! 657: D1 = D*1;
! 658: D1[I] = Mt;
! 659: GIt = map(p_nf,GI,[Mt],V,Ord);
! 660: G1 = cons(Mt,GIt);
! 661: Gelim = elim_gb(G1,V,PV,Mod,Ord);
! 662: D1[N] = LD = ldim(Gelim,V);
! 663: for ( J = 0; J < N; J++ )
! 664: if ( D1[J] && deg(D1[J],V[J]) == LD ) break;
! 665: if ( J < N )
! 666: P = cons([Gelim,D1],P);
! 667: else
! 668: NP = cons([Gelim,D1],NP);
! 669: }
! 670: return [P,NP];
! 671: }
! 672:
! 673: /* prime/primary components over rational function field */
! 674:
! 675: def zprimacomp(G,V) {
! 676: L = zprimadec(G,V,0);
! 677: R = [];
! 678: dp_ord(0);
! 679: for ( T = L; T != []; T = cdr(T) ) {
! 680: S = car(T);
! 681: UQ = contraction(S[0],V);
! 682: UP = contraction(S[1],V);
! 683: R = cons([UQ,UP],R);
! 684: }
! 685: return R;
! 686: }
! 687:
! 688: def zprimecomp(G,V,Indep) {
! 689: W = maxindep(G,V,0);
! 690: V0 = setminus(V,W);
! 691: V1 = append(V0,W);
! 692: #if 0
! 693: O1 = [[0,length(V0)],[0,length(W)]];
! 694: G1 = nd_gr_trace(G,V1,1,GBCheck,O1);
! 695: dp_ord(0);
! 696: #else
! 697: G1 = G;
! 698: #endif
! 699: PD = zprimedec(G1,V0,0);
! 700: dp_ord(0);
! 701: R = [];
! 702: for ( T = PD; T != []; T = cdr(T) ) {
! 703: U = contraction(car(T),V0);
! 704: R = cons(U,R);
! 705: }
! 706: if ( Indep ) return [R,W];
! 707: else return R;
! 708: }
! 709:
! 710: def fast_gb(B,V,Mod,Ord)
! 711: {
! 712: NoRA = (NoRA=getopt(nora))&&type(NoRA)!=-1 ? 1 : 0;
! 713: if ( Mod )
! 714: G = nd_f4(B,V,Mod,Ord|nora=NoRA);
! 715: else {
! 716: if ( F4 )
! 717: G = map(ptozp,f4_chrem(B,V,Ord));
! 718: else
! 719: G = nd_gr_trace(B,V,1,GBCheck,Ord|nora=NoRA);
! 720: }
! 721: return G;
! 722: }
! 723:
! 724:
! 725: def elim_gb(G,V,PV,Mod,Ord)
! 726: {
! 727: N = length(V); PN = length(PV);
! 728: O1 = [[0,N],[0,PN]];
! 729: if ( Ord == O1 )
! 730: Ord = Ord[0][0];
! 731: if ( Mod ) /* XXX */
! 732: G = dp_gr_mod_main(G,V,0,Mod,Ord);
! 733: else if ( Procs ) {
! 734: Arg0 = ["nd_gr_trace",G,V,1,GBCheck,Ord];
! 735: Arg1 = ["nd_gr_trace_rat",G,V,PV,1,GBCheck,O1,Ord];
! 736: G = competitive_exec(Procs,Arg0,Arg1);
! 737: } else
! 738: G = nd_gr_trace(G,V,1,GBCheck,Ord);
! 739: return G;
! 740: }
! 741:
! 742: def ldim(G,V)
! 743: {
! 744: O0 = dp_ord(); dp_ord(0);
! 745: D = length(dp_mbase(map(dp_ptod,G,V)));
! 746: dp_ord(O0);
! 747: return D;
! 748: }
! 749:
! 750: def make_mod_subst(GD,V,PV,HC)
! 751: {
! 752: N = length(V);
! 753: PN = length(PV);
! 754: G = GD[0]; D = GD[1];
! 755: for ( I = 0; ; I = (I+1)%100 ) {
! 756: Mod = lprime(I);
! 757: S = [];
! 758: for ( J = PN-1; J >= 0; J-- )
! 759: S = append([PV[J],random()%Mod],S);
! 760: for ( T = HC; T != []; T = cdr(T) )
! 761: if ( !(subst(car(T),S)%Mod) ) break;
! 762: if ( T != [] ) continue;
! 763: for ( J = 0; J < N; J++ ) {
! 764: M = subst(D[J],S);
! 765: F = modsqfr(M,Mod);
! 766: if ( length(F) != 2 || F[1][1] != 1 ) break;
! 767: }
! 768: if ( J < N ) continue;
! 769: G0 = map(subst,G,S);
! 770: return [G0,Mod];
! 771: }
! 772: }
! 773:
! 774: def rsgn()
! 775: {
! 776: return random()%2 ? 1 : -1;
! 777: }
! 778:
! 779: def find_npos(GD,V,PV,Mod)
! 780: {
! 781: N = length(V); PN = length(PV);
! 782: G = GD[0]; D = GD[1]; LD = D[N];
! 783: Ord0 = dp_ord(); dp_ord(0);
! 784: HC = map(dp_hc,map(dp_ptod,G,V));
! 785: dp_ord(Ord0);
! 786: if ( !Mod ) {
! 787: W = append(V,PV);
! 788: G1 = nd_gr_trace(G,W,1,GBCheck,[[0,N],[0,PN]]);
! 789: L = make_mod_subst([G1,D],V,PV,HC);
! 790: return find_npos([L[0],D],V,[],L[1]);
! 791: }
! 792: N = length(V);
! 793: NV = ttttt;
! 794: for ( B = 2; ; B++ ) {
! 795: for ( J = N-2; J >= 0; J-- ) {
! 796: for ( U = 0, K = J; K < N; K++ )
! 797: U += rsgn()*((random()%B+1))*V[K];
! 798: M = minipolym(G,V,0,U,NV,Mod);
! 799: if ( deg(M,NV) == LD ) return U;
! 800: }
! 801: }
! 802: }
! 803:
! 804: def gen_minipoly(G,V,PV,Ord,VI,Mod)
! 805: {
! 806: if ( PV == [] ) {
! 807: NV = ttttt;
! 808: if ( Mod )
! 809: M = minipolym(G,V,Ord,VI,NV,Mod);
! 810: else
! 811: M = minipoly(G,V,Ord,VI,NV);
! 812: return subst(M,NV,VI);
! 813: }
! 814: W = setminus(V,[VI]);
! 815: PV1 = cons(VI,PV);
! 816: #if 0
! 817: while ( 1 ) {
! 818: V1 = append(W,PV1);
! 819: if ( Mod )
! 820: G = nd_gr(G,V1,Mod,[[0,1],[0,length(V1)-1]]|nora=1);
! 821: else
! 822: G = nd_gr_trace(G,V1,1,GBCheck,[[0,1],[0,length(V1)-1]]|nora=1);
! 823: if ( W == [] ) break;
! 824: else {
! 825: W = cdr(W);
! 826: G = elimination(G,cdr(V1));
! 827: }
! 828: }
! 829: #elif 1
! 830: if ( Mod ) {
! 831: G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]|nora=1);
! 832: G = elimination(G,PV1);
! 833: } else {
! 834: PV2 = setminus(PV1,[PV1[length(PV1)-1]]);
! 835: V2 = append(W,PV2);
! 836: G = nd_gr_trace(G,V2,1,GBCheck,[[0,length(W)],[0,length(PV2)]]|nora=1);
! 837: G = elimination(G,PV1);
! 838: }
! 839: #else
! 840: V1 = append(W,PV1);
! 841: if ( Mod )
! 842: G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]|nora=1);
! 843: else
! 844: G = nd_gr_trace(G,V1,1,GBCheck,[[0,length(W)],[0,length(PV1)]]|nora=1);
! 845: G = elimination(G,PV1);
! 846: #endif
! 847: if ( Mod )
! 848: G = nd_gr(G,PV1,Mod,[[0,1],[0,length(PV)]]|nora=1);
! 849: else
! 850: G = nd_gr_trace(G,PV1,1,GBCheck,[[0,1],[0,length(PV)]]|nora=1);
! 851: for ( M = car(G), T = cdr(G); T != []; T = cdr(T) )
! 852: if ( deg(car(T),VI) < deg(M,VI) ) M = car(T);
! 853: return M;
! 854: }
! 855:
! 856: def indepset(V,H)
! 857: {
! 858: if ( H == [] ) return V;
! 859: N = -1;
! 860: for ( T = V; T != []; T = cdr(T) ) {
! 861: VI = car(T);
! 862: HI = [];
! 863: for ( S = H; S != []; S = cdr(S) )
! 864: if ( !tdiv(car(S),VI) ) HI = cons(car(S),HI);
! 865: RI = indepset(setminus(V,[VI]),HI);
! 866: if ( length(RI) > N ) {
! 867: R = RI; N = length(RI);
! 868: }
! 869: }
! 870: return R;
! 871: }
! 872:
! 873: def maxindep(B,V,O)
! 874: {
! 875: G = nd_gr_trace(B,V,1,GBCheck,O);
! 876: Old = dp_ord();
! 877: dp_ord(O);
! 878: H = map(dp_dtop,map(dp_ht,map(dp_ptod,G,V)),V);
! 879: H = dp_mono_raddec(H,V);
! 880: N = length(V);
! 881: Dep = [];
! 882: for ( T = H, Len = N+1; T != []; T = cdr(T) ) {
! 883: M = length(car(T));
! 884: if ( M < Len ) {
! 885: Dep = [car(T)];
! 886: Len = M;
! 887: } else if ( M == Len )
! 888: Dep = cons(car(T),Dep);
! 889: }
! 890: R = setminus(V,Dep[0]);
! 891: dp_ord(Old);
! 892: return R;
! 893: }
! 894:
! 895: /* ideal operations */
! 896: def contraction(G,V)
! 897: {
! 898: C = [];
! 899: for ( T = G; T != []; T = cdr(T) ) {
! 900: C1 = dp_hc(dp_ptod(car(T),V));
! 901: S = fctr(C1);
! 902: for ( S = cdr(S); S != []; S = cdr(S) )
! 903: if ( !member(S[0][0],C) ) C = cons(S[0][0],C);
! 904: }
! 905: W = vars(G);
! 906: PV = setminus(W,V);
! 907: W = append(V,PV);
! 908: NV = ttttt;
! 909: for ( T = C, S = 1; T != []; T = cdr(T) )
! 910: S *= car(T);
! 911: G = saturation([G,NV],S,W);
! 912: return G;
! 913: }
! 914:
! 915: def ideal_list_intersection(L,V,Ord)
! 916: {
! 917: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 918: N = length(L);
! 919: if ( N == 0 ) return [1];
! 920: if ( N == 1 ) return fast_gb(L[0],V,Mod,Ord);
! 921: N2 = idiv(N,2);
! 922: for ( L1 = [], I = 0; I < N2; I++ ) L1 = cons(L[I],L1);
! 923: for ( L2 = []; I < N; I++ ) L2 = cons(L[I],L2);
! 924: I1 = ideal_list_intersection(L1,V,Ord|mod=Mod);
! 925: I2 = ideal_list_intersection(L2,V,Ord|mod=Mod);
! 926: return ideal_intersection(I1,I2,V,Ord|mod=Mod,
! 927: gbblock=[[0,length(I1)],[length(I1),length(I2)]]);
! 928: }
! 929:
! 930: def ideal_intersection(A,B,V,Ord)
! 931: {
! 932: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 933: if ( type(Block=getopt(gbblock)) == -1 ) Block = 0;
! 934: T = ttttt;
! 935: if ( Mod )
! 936: G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
! 937: cons(T,V),Mod,[[0,1],[Ord,length(V)]]);
! 938: else
! 939: if ( Procs ) {
! 940: Arg0 = ["nd_gr",
! 941: append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
! 942: cons(T,V),0,[[0,1],[Ord,length(V)]]];
! 943: Arg1 = ["nd_gr_trace",
! 944: append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
! 945: cons(T,V),1,GBCheck,[[0,1],[Ord,length(V)]]];
! 946: G = competitive_exec(Procs,Arg0,Arg1);
! 947: } else {
! 948: if ( Block )
! 949: G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
! 950: cons(T,V),0,[[0,1],[Ord,length(V)]]|gbblock=Block);
! 951: else
! 952: G = nd_gr(append(vtol(ltov(A)*T),vtol(ltov(B)*(1-T))),
! 953: cons(T,V),0,[[0,1],[Ord,length(V)]]);
! 954: }
! 955: G0 = elimination(G,V);
! 956: return G0;
! 957: }
! 958:
! 959: /* returns GB if F notin rad(G) */
! 960:
! 961: def radical_membership(F,G,V) {
! 962: F = p_nf(F,G,V,0);
! 963: if ( !F ) return 0;
! 964: NV = ttttt;
! 965: T = nd_gr_trace(cons(NV*F-1,G),cons(NV,V),1,GBCheck,0);
! 966: if ( type(car(T)) != 1 ) return [T,NV];
! 967: else return 0;
! 968: }
! 969:
! 970: def quick_radical_membership(F,G,V) {
! 971: F = p_nf(F,G,V,0);
! 972: if ( !F ) return 1;
! 973: NV = ttttt;
! 974: T = nd_f4(cons(NV*F-1,G),cons(NV,V),lprime(0),0);
! 975: if ( type(car(T)) != 1 ) return 0;
! 976: else return 1;
! 977: }
! 978:
! 979: def modular_radical_membership(F,G,V) {
! 980: F = p_nf(F,G,V,0);
! 981: if ( !F ) return 0;
! 982: NV = ttttt;
! 983: for ( J = 0; ; J++ ) {
! 984: Mod = lprime(J);
! 985: H = map(dp_hc,map(dp_ptod,G,V));
! 986: for ( ; H != []; H = cdr(H) ) if ( !(car(H)%Mod) ) break;
! 987: if ( H != [] ) continue;
! 988:
! 989: T = nd_f4(cons(NV*F-1,G),cons(NV,V),Mod,0);
! 990: if ( type(car(T)) == 1 ) {
! 991: I = radical_membership_rep(F,G,V,-1,0,Mod);
! 992: I1 = radical_membership_rep(F,G,V,I,0,0);
! 993: if ( I1 > 0 ) return 0;
! 994: }
! 995: return radical_membership(F,G,V);
! 996: }
! 997: }
! 998:
! 999: def radical_membership_rep(F,G,V,Max,Ord,Mod) {
! 1000: Ft = F;
! 1001: I = 1;
! 1002: while ( Max < 0 || I <= Max ) {
! 1003: Ft = nd_nf(Ft,G,V,Ord,Mod);
! 1004: if ( !Ft ) return I;
! 1005: Ft *= F;
! 1006: I++;
! 1007: }
! 1008: return -1;
! 1009: }
! 1010:
! 1011: def ideal_product(A,B,V)
! 1012: {
! 1013: dp_ord(0);
! 1014: DA = map(dp_ptod,A,V);
! 1015: DB = map(dp_ptod,B,V);
! 1016: DegA = map(dp_td,DA);
! 1017: DegB = map(dp_td,DB);
! 1018: for ( PA = [], T = A, DT = DegA; T != []; T = cdr(T), DT = cdr(DT) )
! 1019: PA = cons([car(T),car(DT)],PA);
! 1020: PA = reverse(PA);
! 1021: for ( PB = [], T = B, DT = DegB; T != []; T = cdr(T), DT = cdr(DT) )
! 1022: PB = cons([car(T),car(DT)],PB);
! 1023: PB = reverse(PB);
! 1024: R = [];
! 1025: for ( T = PA; T != []; T = cdr(T) )
! 1026: for ( S = PB; S != []; S = cdr(S) )
! 1027: R = cons([car(T)[0]*car(S)[0],car(T)[1]+car(S)[1]],R);
! 1028: T = qsort(R,comp_by_second);
! 1029: T = map(first_element,T);
! 1030: Len = length(A)>length(B)?length(A):length(B);
! 1031: Len *= 2;
! 1032: L = sep_list(T,Len); B0 = L[0]; B1 = L[1];
! 1033: R = nd_gr_trace(B0,V,0,-1,0);
! 1034: while ( B1 != [] ) {
! 1035: print(length(B1));
! 1036: L = sep_list(B1,Len);
! 1037: B0 = L[0]; B1 = L[1];
! 1038: R = nd_gr_trace(append(R,B0),V,0,-1,0|gbblock=[[0,length(R)]],nora=1);
! 1039: }
! 1040: return R;
! 1041: }
! 1042:
! 1043: def saturation(GNV,F,V)
! 1044: {
! 1045: G = GNV[0]; NV = GNV[1];
! 1046: if ( Procs ) {
! 1047: Arg0 = ["nd_gr_trace",
! 1048: cons(NV*F-1,G),cons(NV,V),0,GBCheck,[[0,1],[0,length(V)]]];
! 1049: Arg1 = ["nd_gr_trace",
! 1050: cons(NV*F-1,G),cons(NV,V),1,GBCheck,[[0,1],[0,length(V)]]];
! 1051: G1 = competitive_exec(Procs,Arg0,Arg1);
! 1052: } else
! 1053: G1 = nd_gr_trace(cons(NV*F-1,G),cons(NV,V),SatHomo,GBCheck,[[0,1],[0,length(V)]]);
! 1054: return elimination(G1,V);
! 1055: }
! 1056:
! 1057: def sat(G,F,V)
! 1058: {
! 1059: NV = ttttt;
! 1060: if ( Procs ) {
! 1061: Arg0 = ["nd_gr_trace",
! 1062: cons(NV*F-1,G),cons(NV,V),0,GBCheck,[[0,1],[0,length(V)]]];
! 1063: Arg1 = ["nd_gr_trace",
! 1064: cons(NV*F-1,G),cons(NV,V),1,GBCheck,[[0,1],[0,length(V)]]];
! 1065: G1 = competitive_exec(Procs,Arg0,Arg1);
! 1066: } else
! 1067: G1 = nd_gr_trace(cons(NV*F-1,G),cons(NV,V),SatHomo,GBCheck,[[0,1],[0,length(V)]]);
! 1068: return elimination(G1,V);
! 1069: }
! 1070:
! 1071: def satind(G,F,V)
! 1072: {
! 1073: NV = ttttt;
! 1074: N = length(V);
! 1075: B = append(G,[NV*F-1]);
! 1076: V1 = cons(NV,V);
! 1077: D = nd_gr_trace(B,V1,1,GBCheck,[[0,1],[0,N]]
! 1078: |nora=1,gentrace=1,gbblock=[[0,length(G)]]);
! 1079: G1 = D[0];
! 1080: Len = length(G1);
! 1081: Deg = compute_deg(B,V1,NV,D);
! 1082: D1 = 0;
! 1083: R = [];
! 1084: M = length(B);
! 1085: for ( I = 0; I < Len; I++ ) {
! 1086: if ( !member(NV,vars(G1[I])) ) {
! 1087: for ( J = 1; J < M; J++ )
! 1088: D1 = MAX(D1,Deg[I][J]);
! 1089: R = cons(G1[I],R);
! 1090: }
! 1091: }
! 1092: return [reverse(R),D1];
! 1093: }
! 1094:
! 1095: def sat_ind(G,F,V)
! 1096: {
! 1097: NV = ttttt;
! 1098: F = p_nf(F,G,V,0);
! 1099: for ( I = 0, GI = G; ; I++ ) {
! 1100: G1 = colon(GI,F,V);
! 1101: if ( ideal_inclusion(G1,GI,V,0) ) {
! 1102: return [GI,I];
! 1103: }
! 1104: else GI = G1;
! 1105: }
! 1106: }
! 1107:
! 1108: def colon(G,F,V)
! 1109: {
! 1110: F = p_nf(F,G,V,0);
! 1111: if ( !F ) return [1];
! 1112: NV = ttttt;
! 1113: V1 = cons(NV,V);
! 1114: T = nd_gr_trace(append(vtol(NV*ltov(G)),[(1-NV)*F]),V1,1,GBCheck,
! 1115: [[0,1],[0,length(V)]]|gbblock=[[0,length(G)]],nora=1);
! 1116: T = elimination(T,V);
! 1117: return map(ptozp,map(sdiv,T,F));
! 1118: }
! 1119:
! 1120: def ideal_colon(G,F,V)
! 1121: {
! 1122: G = nd_gr(G,V,0,0);
! 1123: L = mapat(colon,1,G,F,V);
! 1124: return ideal_list_intersection(L,V,0);
! 1125: }
! 1126:
! 1127: def ideal_inclusion(F,G,V,O)
! 1128: {
! 1129: if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
! 1130: if ( Mod ) {
! 1131: for ( T = F; T != []; T = cdr(T) )
! 1132: if ( p_nf_mod(car(T),G,V,O,Mod) ) return 0;
! 1133: } else {
! 1134: for ( T = F; T != []; T = cdr(T) )
! 1135: if ( p_nf(car(T),G,V,O) ) return 0;
! 1136: }
! 1137: return 1;
! 1138: }
! 1139:
! 1140: /* remove redundant components */
! 1141:
! 1142: def qd_simp_comp(QP,V)
! 1143: {
! 1144: R = ltov(QP);
! 1145: N = length(R);
! 1146: for ( I = 0; I < N; I++ ) {
! 1147: if ( R[I] ) {
! 1148: QI = R[I][0]; PI = R[I][1];
! 1149: for ( J = I+1; J < N; J++ )
! 1150: if ( R[J] && gb_comp(PI,R[J][1]) ) {
! 1151: QI = ideal_intersection(QI,R[J][0],V,0);
! 1152: R[J] = 0;
! 1153: }
! 1154: R[I] = [QI,PI];
! 1155: }
! 1156: }
! 1157: for ( I = N-1, S = []; I >= 0; I-- )
! 1158: if ( R[I] ) S = cons(R[I],S);
! 1159: return S;
! 1160: }
! 1161:
! 1162: def qd_remove_redundant_comp(G,Iso,Emb,V,Ord)
! 1163: {
! 1164: IsoInt = ideal_list_intersection(map(first_element,Iso),V,Ord);
! 1165: Emb = qd_simp_comp(Emb,V);
! 1166: Emb = qsort(Emb);
! 1167: A = ltov(Emb);
! 1168: N = length(A);
! 1169: for ( I = 0; I < N; I++ ) {
! 1170: if ( !A[I] ) continue;
! 1171: for ( T = [], J = 0; J < N; J++ )
! 1172: if ( J != I && A[J] ) T = cons(A[J][0],T);
! 1173: Int = ideal_list_intersection(T,V,Ord);
! 1174: Int = ideal_intersection(IsoInt,Int,V,Ord);
! 1175: if ( gb_comp(Int,G) ) A[I] = 0;
! 1176: }
! 1177: for ( T = [], I = 0; I < N; I++ )
! 1178: if ( A[I] ) T = cons(A[I],T);
! 1179: return reverse(T);
! 1180: }
! 1181:
! 1182: def remove_redundant_comp(G,Iso,Emb,V,Ord)
! 1183: {
! 1184: IsoInt = ideal_list_intersection(Iso,V,Ord);
! 1185:
! 1186: A = ltov(Emb);
! 1187: N = length(A);
! 1188: for ( I = 0; I < N; I++ ) {
! 1189: if ( !A[I] ) continue;
! 1190: for ( J = I+1; J < N; J++ )
! 1191: if ( A[J] && gb_comp(A[I],A[J]) ) A[J] = 0;
! 1192: }
! 1193: for ( I = 0; I < N; I++ ) {
! 1194: if ( !A[I] ) continue;
! 1195: for ( T = [], J = 0; J < N; J++ )
! 1196: if ( J != I && A[J] ) T = cons(A[J],T);
! 1197: Int = ideal_list_intersection(cons(IsoInt,T),V,Ord);
! 1198: if ( gb_comp(Int,G) ) A[I] = 0;
! 1199: }
! 1200: for ( T = [], I = 0; I < N; I++ )
! 1201: if ( A[I] ) T = cons(A[I],T);
! 1202: return reverse(T);
! 1203: }
! 1204:
! 1205: def remove_redundant_comp_first(G,P,V,Ord)
! 1206: {
! 1207: A = ltov(P);
! 1208: N = length(A);
! 1209: for ( I = 0; I < N; I++ ) {
! 1210: if ( !A[I] ) continue;
! 1211: for ( J = I+1; J < N; J++ )
! 1212: if ( A[J] && gb_comp(A[I][0],A[J][0]) ) A[J] = 0;
! 1213: }
! 1214: for ( I = 0; I < N; I++ ) {
! 1215: if ( !A[I] ) continue;
! 1216: for ( T = [], J = 0; J < N; J++ )
! 1217: if ( J != I && A[J] ) T = cons(A[J][0],T);
! 1218: Int = ideal_list_intersection(T,V,Ord);
! 1219: if ( gb_comp(Int,G) ) A[I] = 0;
! 1220: }
! 1221: for ( T = [], I = 0; I < N; I++ )
! 1222: if ( A[I] ) T = cons(A[I],T);
! 1223: return reverse(T);
! 1224: }
! 1225:
! 1226: /* polynomial operations */
! 1227:
! 1228: def ppart(F,V,Mod)
! 1229: {
! 1230: if ( !Mod )
! 1231: G = nd_gr([F],[V],0,0);
! 1232: else
! 1233: G = dp_gr_mod_main([F],[V],0,Mod,0);
! 1234: return G[0];
! 1235: }
! 1236:
! 1237:
! 1238: def sq(F)
! 1239: {
! 1240: if ( !F ) return 0;
! 1241: A = cdr(fctr(F));
! 1242: for ( R = 1; A != []; A = cdr(A) )
! 1243: R *= car(car(A));
! 1244: return R;
! 1245: }
! 1246:
! 1247: def lcfactor(G,V,O)
! 1248: {
! 1249: O0 = dp_ord(); dp_ord(O);
! 1250: C = [];
! 1251: for ( T = G; T != []; T = cdr(T) ) {
! 1252: C1 = dp_hc(dp_ptod(car(T),V));
! 1253: S = fctr(C1);
! 1254: for ( S = cdr(S); S != []; S = cdr(S) )
! 1255: if ( !member(S[0][0],C) ) C = cons(S[0][0],C);
! 1256: }
! 1257: dp_ord(O0);
! 1258: return C;
! 1259: }
! 1260:
! 1261: /* Ti = [D,I,M,C] */
! 1262:
! 1263: def compute_deg0(Ti,P,V,TV)
! 1264: {
! 1265: N = length(P[0]);
! 1266: Num = vector(N);
! 1267: for ( I = 0; I < N; I++ ) Num[I] = -1;
! 1268: for ( ; Ti != []; Ti = cdr(Ti) ) {
! 1269: Sj = car(Ti);
! 1270: Dj = Sj[0];
! 1271: Ij =Sj[1];
! 1272: Mj = deg(type(Sj[2])==9?dp_dtop(Sj[2],V):Sj[2],TV);
! 1273: Pj = P[Ij];
! 1274: if ( Dj )
! 1275: for ( I = 0; I < N; I++ )
! 1276: if ( Pj[I] >= 0 ) {
! 1277: T = Mj+Pj[I];
! 1278: Num[I] = MAX(Num[I],T);
! 1279: }
! 1280: }
! 1281: return Num;
! 1282: }
! 1283:
! 1284: def compute_deg(B,V,TV,Data)
! 1285: {
! 1286: GB = Data[0];
! 1287: Homo = Data[1];
! 1288: Trace = Data[2];
! 1289: IntRed = Data[3];
! 1290: Ind = Data[4];
! 1291: DB = map(dp_ptod,B,V);
! 1292: if ( Homo ) {
! 1293: DB = map(dp_homo,DB);
! 1294: V0 = append(V,[hhh]);
! 1295: } else
! 1296: V0 = V;
! 1297: Perm = Trace[0]; Trace = cdr(Trace);
! 1298: for ( I = length(Perm)-1, T = Trace; T != []; T = cdr(T) )
! 1299: if ( (J=car(T)[0]) > I ) I = J;
! 1300: N = I+1;
! 1301: N0 = length(B);
! 1302: P = vector(N);
! 1303: for ( T = Perm, I = 0; T != []; T = cdr(T), I++ ) {
! 1304: Pi = car(T);
! 1305: C = vector(N0);
! 1306: for ( J = 0; J < N0; J++ ) C[J] = -1;
! 1307: C[Pi[1]] = 0;
! 1308: P[Pi[0]] = C;
! 1309: }
! 1310: for ( T = Trace; T != []; T = cdr(T) ) {
! 1311: Ti = car(T); P[Ti[0]] = compute_deg0(Ti[1],P,V0,TV);
! 1312: }
! 1313: M = length(Ind);
! 1314: for ( T = IntRed; T != []; T = cdr(T) ) {
! 1315: Ti = car(T); P[Ti[0]] = compute_deg0(Ti[1],P,V,TV);
! 1316: }
! 1317: R = [];
! 1318: for ( J = 0; J < M; J++ ) {
! 1319: U = P[Ind[J]];
! 1320: R = cons(U,R);
! 1321: }
! 1322: return reverse(R);
! 1323: }
! 1324:
! 1325: /* set theoretic functions */
! 1326:
! 1327: def member(A,S)
! 1328: {
! 1329: for ( ; S != []; S = cdr(S) )
! 1330: if ( car(S) == A ) return 1;
! 1331: return 0;
! 1332: }
! 1333:
! 1334: def elimination(G,V) {
! 1335: for ( R = [], T = G; T != []; T = cdr(T) )
! 1336: if ( setminus(vars(car(T)),V) == [] ) R =cons(car(T),R);
! 1337: return R;
! 1338: }
! 1339:
! 1340: def setintersection(A,B)
! 1341: {
! 1342: for ( L = []; A != []; A = cdr(A) )
! 1343: if ( member(car(A),B) )
! 1344: L = cons(car(A),L);
! 1345: return L;
! 1346: }
! 1347:
! 1348: def setminus(A,B) {
! 1349: for ( T = reverse(A), R = []; T != []; T = cdr(T) ) {
! 1350: for ( S = B, M = car(T); S != []; S = cdr(S) )
! 1351: if ( car(S) == M ) break;
! 1352: if ( S == [] ) R = cons(M,R);
! 1353: }
! 1354: return R;
! 1355: }
! 1356:
! 1357: def sep_list(L,N)
! 1358: {
! 1359: if ( length(L) <= N ) return [L,[]];
! 1360: R = [];
! 1361: for ( T = L, I = 0; I < N; I++, T = cdr(T) )
! 1362: R = cons(car(T),R);
! 1363: return [reverse(R),T];
! 1364: }
! 1365:
! 1366: def first_element(L)
! 1367: {
! 1368: return L[0];
! 1369: }
! 1370:
! 1371: def comp_tdeg(A,B)
! 1372: {
! 1373: DA = tdeg(A);
! 1374: DB = tdeg(B);
! 1375: if ( DA > DB ) return 1;
! 1376: else if ( DA < DB ) return -1;
! 1377: else return 0;
! 1378: }
! 1379:
! 1380: def tdeg(P)
! 1381: {
! 1382: dp_ord(0);
! 1383: return dp_td(dp_ptod(P,vars(P)));
! 1384: }
! 1385:
! 1386: def comp_by_ord(A,B)
! 1387: {
! 1388: if ( dp_ht(A) > dp_ht(B) ) return 1;
! 1389: else if ( dp_ht(A) < dp_ht(B) ) return -1;
! 1390: else return 0;
! 1391: }
! 1392:
! 1393: def comp_by_second(A,B)
! 1394: {
! 1395: if ( A[1] > B[1] ) return 1;
! 1396: else if ( A[1] < B[1] ) return -1;
! 1397: else return 0;
! 1398: }
! 1399: endmodule$
! 1400: end$
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to noro_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