Annotation of OpenXM/src/asir-contrib/testing/noro/mwl.rr, Revision 1.3
1.1 noro 1: /*
2: F=y^2-x*(x-1)*(x-t)$
3: F=y^2-(x^3+t^7)$
4: F=y^2-(x^3+t*(t^10+1))$
5: F=y^2-(x^3+t^11+1)$
6: F=(y^2+72*x*y-10*t^2*y)-(x^3+60*x^2*t-15*x*t^3+t^5)$
7: */
8: /* 6A1fibre2a.txt */
9: A1=y^2-(x^3+(2*t^2+18)*x^2+(t^4-82*t^2+81)*x)$
10: /* A2try3d.txt */
11: A2=y^2-(x^3-x+t^2)$
12: /* A8fibre2.txt */
13: A8=y^2-(x^3+t^2*x^2-8*t*x+16)$
14: /* D8fibre1.txt */
15: D8=y^2-(x^3-3*(t^2-1)*x-2*t^3+3*t)$
16: /* E7A1fibre1.txt */
17: E7=y^2-(x^3+t*x)$
18: /* F5ss1new2.txt */
19: F5=y^2-(x^3+t^11-t)$
20: /* F6ss1new2.txt */
21: F6=y^2-(x^3+t^12-1)$
1.2 noro 22: /* OS8split4 */
23: OS8=y^2-240*x*y-300*t^2*y-x^3+476*t*x^2+65*t^3*x-t^5$
1.1 noro 24: import("gr")$
25: module mwl$
26: localf generate_coef_ideal$
27: localf pdecomp,pdecomp_main,ideal_intersection,ldim$
28: localf pdecomp_ff,pdecomp_ff_main,ideal_intersection_ff,ldim_ff$
29: localf ideal_elimination,gbcheck,f4$
1.3 ! noro 30: localf pdecomp_de,pdecomp_de_main,split,zcolon$
1.1 noro 31: static GBCheck,F4$
32: #define Tmp ttttt
33:
34: def gbcheck(A)
35: {
36: if ( A ) GBCheck = 1;
37: else GBCheck = -1;
38: }
39:
40: def f4(A)
41: {
42: if ( A ) F4 = 1;
43: else F4 = 0;
44: }
45:
1.2 noro 46: /* if option simp=1 is given, we try simplifying the output ideal. */
47: /* Remove an^3-bm^2 and an -> v^2, bm -> v^3 */
48:
1.1 noro 49: def generate_coef_ideal(F)
50: {
1.2 noro 51: if ( type(Simp=getopt(simp)) == -1 ) Simp = 0;
1.1 noro 52: A1 = coef(coef(F,1,x),1,y);
53: A2 = -coef(coef(F,2,x),0,y);
54: A3 = coef(coef(F,0,x),1,y);
55: A4 = -coef(coef(F,1,x),0,y);
56: A6 = -coef(coef(F,0,x),0,y);
57: D = vector(5,
58: [deg(A1,t)/1,deg(A2,t)/2,deg(A3,t)/3,deg(A4,t)/4,deg(A6,t)/6]);
59: D = map(ceil,D);
60: for ( K = D[0], I = 1; I < 5; I++ ) if ( K < D[I] ) K = D[I];
61: VX = [];
62: for ( I = 0, X = 0; I <= 2*K; I++ ) {
63: V = strtov("a"+rtostr(I));
64: X += V*t^I;
65: VX = cons(V,VX);
66: }
67: VY = [];
68: for ( I = 0, Y = 0; I <= 3*K; I++ ) {
69: V = strtov("b"+rtostr(I));
70: Y += V*t^I;
71: VY = cons(V,VY);
72: }
73: S = subst(F,x,X,y,Y);
74: N = deg(S,t);
75: for ( R = [], I = 0; I <= N; I++ ) R = cons(coef(S,I,t),R);
1.2 noro 76: if ( Simp ) {
77: R0 = car(R); R = cdr(R);
78: VX0 = car(VX); VX = cdr(VX);
79: VY0 = car(VY); VY = cdr(VY);
80: if ( subst(R0,VX0,v^2,VY0,v^3)==0 ) {
81: R = subst(R,VX0,v^2,VY0,v^3);
82: return [R,append(append(VY,VX),[v])];
83: } else
84: error("The output ideal cannot be simplified");
85: } else
86: return [R,append((VY),(VX))];
1.1 noro 87: }
88:
89: def pdecomp(B,V) {
90: if ( F4 ) G0 = nd_f4_trace(B,V,1,GBCheck,0);
91: else G0 = nd_gr_trace(B,V,1,GBCheck,0);
92: G=[G0];
93: for ( T = reverse(V); T !=[]; T = cdr(T) ) {
94: G1 = [];
95: X = car(T);
96: for ( S = G; S != []; S = cdr(S) ) {
97: GX = pdecomp_main(car(S),V,0,X);
98: G1 = append(GX,G1);
99: }
100: G = G1;
101: }
102: return [G,G0];
103: }
104:
105: def pdecomp_ff(B,V,Mod) {
106: if ( F4 ) G0 = nd_f4(B,V,Mod,0);
107: else G0 = nd_gr(B,V,Mod,0);
108: G=[G0];
109: for ( T = reverse(V); T !=[]; T = cdr(T) ) {
110: G1 = [];
111: X = car(T);
112: for ( S = G; S != []; S = cdr(S) ) {
113: GX = pdecomp_ff_main(car(S),V,0,X,Mod);
114: G1 = append(GX,G1);
115: }
116: G = G1;
117: }
118: return [G,G0];
119: }
120:
121: def pdecomp_main(G,V,Ord,X) {
122: M = minipoly(G,V,Ord,X,Tmp);
123: M = subst(M,Tmp,X);
124: FM = cdr(fctr(M));
125: if ( length(FM) == 1 ) return [G];
126: G2 = [];
127: for ( T = FM; T != []; T = cdr(T) ) {
128: F1 = car(T);
129: for ( I = 0, N = F1[1], NF=1; I < N; I++ )
130: NF = p_nf(NF*F1[0],G,V,Ord);
131: if ( F4 ) G1 = nd_f4_trace(cons(NF,G),V,1,GBCheck,Ord);
132: else G1 = nd_gr_trace(cons(NF,G),V,1,GBCheck,Ord);
133: G2 =cons(G1,G2);
134: }
135: return G2;
136: }
137:
138: def pdecomp_ff_main(G,V,Ord,X,Mod) {
139: M = minipolym(G,V,Ord,X,Tmp,Mod);
140: M = subst(M,Tmp,X);
141: FM = cdr(modfctr(M,Mod));
142: if ( length(FM) == 1 ) return [G];
143: G2 = [];
144: for ( T = FM; T != []; T = cdr(T) ) {
145: F1 = car(T);
146: for ( I = 0, N = F1[1], NF=1; I < N; I++ )
147: NF = p_nf_mod(NF*F1[0],G,V,Ord,Mod);
148: if ( F4 ) G1 = nd_f4(cons(NF,G),V,Mod,Ord);
149: else G1 = nd_gr(cons(NF,G),V,Mod,Ord);
150: G2 =cons(G1,G2);
151: }
152: return G2;
153: }
154:
1.3 ! noro 155: def pdecomp_de(B,V) {
! 156: if ( F4 ) G0 = nd_f4_trace(B,V,1,GBCheck,0);
! 157: else G0 = nd_gr_trace(B,V,1,GBCheck,0);
! 158: G=[G0];
! 159: for ( T = reverse(V); T !=[]; T = cdr(T) ) {
! 160: G1 = [];
! 161: X = car(T);
! 162: for ( S = G; S != []; S = cdr(S) ) {
! 163: GX = pdecomp_de_main(car(S),V,0,X);
! 164: G1 = append(GX,G1);
! 165: }
! 166: G = G1;
! 167: }
! 168: return [G,G0];
! 169: }
! 170:
! 171: #if 1
! 172: def pdecomp_de_main(G,V,Ord,X) {
! 173: M = minipoly(G,V,Ord,X,Tmp);
! 174: M = subst(M,Tmp,X);
! 175: FM = cdr(fctr(M));
! 176: if ( length(FM) == 1 ) return [G];
! 177: G2 = [];
! 178: G1 = G;
! 179: for ( T = FM; length(T) > 1; T = cdr(T) ) {
! 180: F1 = car(T);
! 181: for ( I = 0, N = F1[1], NF=1; I < N; I++ )
! 182: NF = p_nf(NF*F1[0],G1,V,Ord);
! 183: C = split(V,G1,NF,Ord);
! 184: /* C = [G1:NF,G1+NF] */
! 185: G1 = C[0]; G2 =cons(C[1],G2);
! 186: }
! 187: G2 = cons(G1,G2);
! 188: return G2;
! 189: }
! 190: #else
! 191: def pdecomp_de_main(G,V,Ord,X) {
! 192: M = minipoly(G,V,Ord,X,Tmp);
! 193: M = subst(M,Tmp,X);
! 194: FM = cdr(fctr(M));
! 195: if ( length(FM) == 1 ) return [G];
! 196: G2 = [];
! 197: G1 = G;
! 198: NFM = length(FM);
! 199: A = vector(NFM);
! 200: for ( J = 0; J < NFM; J++ ) {
! 201: FJ = FM[J];
! 202: for ( I = 0, N = FJ[1], NF=1; I < N; I++ )
! 203: NF = p_nf(NF*FJ[0],G1,V,Ord);
! 204: A[J] = NF;
! 205: }
! 206: for ( T = FM, J = 0; J < NFM; J++ ) {
! 207: for ( I = 0, NF=1; I < NFM; I++ )
! 208: if ( I != J )
! 209: NF = p_nf(NF*A[I],G,V,Ord);
! 210: C = zcolon(V,G1,NF,Ord);
! 211: G2 =cons(C,G2);
! 212: }
! 213: return G2;
! 214: }
! 215: #endif
! 216:
! 217: /* from de.rr */
! 218:
! 219: def split(V,Id,F,Ord)
! 220: {
! 221: Id = map(ptozp,Id);
! 222: N = length(V);
! 223: dp_ord(Ord);
! 224: set_field(Id,V,Ord);
! 225: DF = dptodalg(dp_ptod(F,V));
! 226: Ret = inv_or_split_dalg(DF);
! 227: /* Ret = GB(Id:F) */
! 228: /* compute GB(Id+<f>) */
! 229: Gquo = append(map(ptozp,map(dp_dtop,Ret,V)),Id);
! 230: /* inter-reduction */
! 231: Gquo = nd_gr_postproc(Gquo,V,0,Ord,0);
! 232: B = cons(F,Id);
! 233: if ( F4 ) Grem = nd_f4_trace(B,V,1,GBCheck,Ord);
! 234: else Grem = nd_gr_trace(B,V,1,GBCheck,Ord);
! 235: return [map(ptozp,Gquo),map(ptozp,Grem)];
! 236: }
! 237:
! 238: /* Id:F for zero-dim. ideal Id */
! 239:
! 240: def zcolon(V,Id,F,Ord)
! 241: {
! 242: Id = map(ptozp,Id);
! 243: N = length(V);
! 244: dp_ord(Ord);
! 245: set_field(Id,V,Ord);
! 246: DF = dptodalg(dp_ptod(F,V));
! 247: Ret = inv_or_split_dalg(DF);
! 248: /* Ret = GB(Id:F) */
! 249: /* compute GB(Id+<f>) */
! 250: Gquo = append(map(ptozp,map(dp_dtop,Ret,V)),Id);
! 251: Gquo = nd_gr_postproc(Gquo,V,0,Ord,0);
! 252: return map(ptozp,Gquo);
! 253: }
! 254:
1.1 noro 255: def ideal_intersection(L,V,Ord)
256: {
257: N = length(L);
258: if ( N == 1 ) return L[0];
259: N2 = idiv(N,2);
260: for ( I = 0, L1 = []; I < N2; I++, L = cdr(L) ) L1 = cons(car(L),L1);
261: L1 = reverse(L1);
262: J = ideal_intersection(L,V,Ord);
263: J1 = ideal_intersection(L1,V,Ord);
264: R = append(vtol(ltov(J)*Tmp),vtol(ltov(J1)*(1-Tmp)));
265: if ( F4 ) G = nd_f4_trace(R,cons(Tmp,V),1,GBCheck,[[0,1],[Ord,length(V)]]);
266: else G = nd_gr_trace(R,cons(Tmp,V),1,GBCheck,[[0,1],[Ord,length(V)]]);
267: G = ideal_elimination(G,V);
268: return G;
269: }
270:
271: def ideal_intersection_ff(L,V,Ord,Mod)
272: {
273: N = length(L);
274: if ( N == 1 ) return L[0];
275: N2 = idiv(N,2);
276: for ( I = 0, L1 = []; I < N2; I++, L = cdr(L) ) L1 = cons(car(L),L1);
277: L1 = reverse(L1);
278: J = ideal_intersection_ff(L,V,Ord,Mod);
279: J1 = ideal_intersection_ff(L1,V,Ord,Mod);
280: R = append(vtol(ltov(J)*Tmp),vtol(ltov(J1)*(1-Tmp)));
281: if ( F4 ) G = nd_f4(R,cons(Tmp,V),Mod,[[0,1],[Ord,length(V)]]);
282: else G = nd_gr(R,cons(Tmp,V),Mod,[[0,1],[Ord,length(V)]]);
283: G = ideal_elimination(G,V);
284: return G;
285: }
286:
287: def ideal_elimination(G,V)
288: {
289: ANS=[];
290: NG=length(G);
291:
292: for (I=NG-1;I>=0;I--) {
293: VSet=vars(G[I]);
294: DIFF=setminus(VSet,V);
295: if ( DIFF ==[] ) ANS=cons(G[I],ANS);
296: }
297: return ANS;
298: }
299:
300: def ldim(G,V)
301: {
302: G = nd_gr_trace(G,V,1,1,0);
303: if ( ! zero_dim(G,V,0) ) error("<G> is not zero-dimensional");
304: return length(dp_mbase(map(dp_ptod,G,V)));
305: }
306:
307: def ldim_ff(G,V,Mod)
308: {
309: G = nd_gr(G,V,Mod,0);
310: if ( ! zero_dim(G,V,0) ) error("<G> is not zero-dimensional");
311: return length(dp_mbase(map(dp_ptod,G,V)));
312: }
313: endmodule$
314: end$
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to mwl.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