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