Annotation of OpenXM/src/asir-contrib/testing/noro/mwl.rr, Revision 1.2
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$
30: static GBCheck,F4$
31: #define Tmp ttttt
32:
33: def gbcheck(A)
34: {
35: if ( A ) GBCheck = 1;
36: else GBCheck = -1;
37: }
38:
39: def f4(A)
40: {
41: if ( A ) F4 = 1;
42: else F4 = 0;
43: }
44:
1.2 ! noro 45: /* if option simp=1 is given, we try simplifying the output ideal. */
! 46: /* Remove an^3-bm^2 and an -> v^2, bm -> v^3 */
! 47:
1.1 noro 48: def generate_coef_ideal(F)
49: {
1.2 ! noro 50: if ( type(Simp=getopt(simp)) == -1 ) Simp = 0;
1.1 noro 51: A1 = coef(coef(F,1,x),1,y);
52: A2 = -coef(coef(F,2,x),0,y);
53: A3 = coef(coef(F,0,x),1,y);
54: A4 = -coef(coef(F,1,x),0,y);
55: A6 = -coef(coef(F,0,x),0,y);
56: D = vector(5,
57: [deg(A1,t)/1,deg(A2,t)/2,deg(A3,t)/3,deg(A4,t)/4,deg(A6,t)/6]);
58: D = map(ceil,D);
59: for ( K = D[0], I = 1; I < 5; I++ ) if ( K < D[I] ) K = D[I];
60: VX = [];
61: for ( I = 0, X = 0; I <= 2*K; I++ ) {
62: V = strtov("a"+rtostr(I));
63: X += V*t^I;
64: VX = cons(V,VX);
65: }
66: VY = [];
67: for ( I = 0, Y = 0; I <= 3*K; I++ ) {
68: V = strtov("b"+rtostr(I));
69: Y += V*t^I;
70: VY = cons(V,VY);
71: }
72: S = subst(F,x,X,y,Y);
73: N = deg(S,t);
74: for ( R = [], I = 0; I <= N; I++ ) R = cons(coef(S,I,t),R);
1.2 ! noro 75: if ( Simp ) {
! 76: R0 = car(R); R = cdr(R);
! 77: VX0 = car(VX); VX = cdr(VX);
! 78: VY0 = car(VY); VY = cdr(VY);
! 79: if ( subst(R0,VX0,v^2,VY0,v^3)==0 ) {
! 80: R = subst(R,VX0,v^2,VY0,v^3);
! 81: return [R,append(append(VY,VX),[v])];
! 82: } else
! 83: error("The output ideal cannot be simplified");
! 84: } else
! 85: return [R,append((VY),(VX))];
1.1 noro 86: }
87:
88: def pdecomp(B,V) {
89: if ( F4 ) G0 = nd_f4_trace(B,V,1,GBCheck,0);
90: else G0 = nd_gr_trace(B,V,1,GBCheck,0);
91: G=[G0];
92: for ( T = reverse(V); T !=[]; T = cdr(T) ) {
93: G1 = [];
94: X = car(T);
95: for ( S = G; S != []; S = cdr(S) ) {
96: GX = pdecomp_main(car(S),V,0,X);
97: G1 = append(GX,G1);
98: }
99: G = G1;
100: }
101: return [G,G0];
102: }
103:
104: def pdecomp_ff(B,V,Mod) {
105: if ( F4 ) G0 = nd_f4(B,V,Mod,0);
106: else G0 = nd_gr(B,V,Mod,0);
107: G=[G0];
108: for ( T = reverse(V); T !=[]; T = cdr(T) ) {
109: G1 = [];
110: X = car(T);
111: for ( S = G; S != []; S = cdr(S) ) {
112: GX = pdecomp_ff_main(car(S),V,0,X,Mod);
113: G1 = append(GX,G1);
114: }
115: G = G1;
116: }
117: return [G,G0];
118: }
119:
120: def pdecomp_main(G,V,Ord,X) {
121: M = minipoly(G,V,Ord,X,Tmp);
122: M = subst(M,Tmp,X);
123: FM = cdr(fctr(M));
124: if ( length(FM) == 1 ) return [G];
125: G2 = [];
126: for ( T = FM; T != []; T = cdr(T) ) {
127: F1 = car(T);
128: for ( I = 0, N = F1[1], NF=1; I < N; I++ )
129: NF = p_nf(NF*F1[0],G,V,Ord);
130: if ( F4 ) G1 = nd_f4_trace(cons(NF,G),V,1,GBCheck,Ord);
131: else G1 = nd_gr_trace(cons(NF,G),V,1,GBCheck,Ord);
132: G2 =cons(G1,G2);
133: }
134: return G2;
135: }
136:
137: def pdecomp_ff_main(G,V,Ord,X,Mod) {
138: M = minipolym(G,V,Ord,X,Tmp,Mod);
139: M = subst(M,Tmp,X);
140: FM = cdr(modfctr(M,Mod));
141: if ( length(FM) == 1 ) return [G];
142: G2 = [];
143: for ( T = FM; T != []; T = cdr(T) ) {
144: F1 = car(T);
145: for ( I = 0, N = F1[1], NF=1; I < N; I++ )
146: NF = p_nf_mod(NF*F1[0],G,V,Ord,Mod);
147: if ( F4 ) G1 = nd_f4(cons(NF,G),V,Mod,Ord);
148: else G1 = nd_gr(cons(NF,G),V,Mod,Ord);
149: G2 =cons(G1,G2);
150: }
151: return G2;
152: }
153:
154: def ideal_intersection(L,V,Ord)
155: {
156: N = length(L);
157: if ( N == 1 ) return L[0];
158: N2 = idiv(N,2);
159: for ( I = 0, L1 = []; I < N2; I++, L = cdr(L) ) L1 = cons(car(L),L1);
160: L1 = reverse(L1);
161: J = ideal_intersection(L,V,Ord);
162: J1 = ideal_intersection(L1,V,Ord);
163: R = append(vtol(ltov(J)*Tmp),vtol(ltov(J1)*(1-Tmp)));
164: if ( F4 ) G = nd_f4_trace(R,cons(Tmp,V),1,GBCheck,[[0,1],[Ord,length(V)]]);
165: else G = nd_gr_trace(R,cons(Tmp,V),1,GBCheck,[[0,1],[Ord,length(V)]]);
166: G = ideal_elimination(G,V);
167: return G;
168: }
169:
170: def ideal_intersection_ff(L,V,Ord,Mod)
171: {
172: N = length(L);
173: if ( N == 1 ) return L[0];
174: N2 = idiv(N,2);
175: for ( I = 0, L1 = []; I < N2; I++, L = cdr(L) ) L1 = cons(car(L),L1);
176: L1 = reverse(L1);
177: J = ideal_intersection_ff(L,V,Ord,Mod);
178: J1 = ideal_intersection_ff(L1,V,Ord,Mod);
179: R = append(vtol(ltov(J)*Tmp),vtol(ltov(J1)*(1-Tmp)));
180: if ( F4 ) G = nd_f4(R,cons(Tmp,V),Mod,[[0,1],[Ord,length(V)]]);
181: else G = nd_gr(R,cons(Tmp,V),Mod,[[0,1],[Ord,length(V)]]);
182: G = ideal_elimination(G,V);
183: return G;
184: }
185:
186: def ideal_elimination(G,V)
187: {
188: ANS=[];
189: NG=length(G);
190:
191: for (I=NG-1;I>=0;I--) {
192: VSet=vars(G[I]);
193: DIFF=setminus(VSet,V);
194: if ( DIFF ==[] ) ANS=cons(G[I],ANS);
195: }
196: return ANS;
197: }
198:
199: def ldim(G,V)
200: {
201: G = nd_gr_trace(G,V,1,1,0);
202: if ( ! zero_dim(G,V,0) ) error("<G> is not zero-dimensional");
203: return length(dp_mbase(map(dp_ptod,G,V)));
204: }
205:
206: def ldim_ff(G,V,Mod)
207: {
208: G = nd_gr(G,V,Mod,0);
209: if ( ! zero_dim(G,V,0) ) error("<G> is not zero-dimensional");
210: return length(dp_mbase(map(dp_ptod,G,V)));
211: }
212: endmodule$
213: 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