Annotation of OpenXM/src/asir-contrib/testing/noro/module_syz.rr, Revision 1.1
1.1 ! noro 1: module newsyz;
! 2:
! 3: localf module_syz, module_fres, module_minres;
! 4: localf simplify_syz, icont, mod, remove_cont;
! 5:
! 6: /* F : a list of (lists or polynomials),
! 7: V : a variable list, H >1=> over GF(H), H=0,1=> over Q
! 8: O : term order
! 9: return: [GS,G]
! 10: GS : a GB of syz(F) wrt [1,O] (POT), G: a GB of F wrt [1,O]
! 11: */
! 12:
! 13: def module_syz(F,V,H,O)
! 14: {
! 15: Weyl = type(getopt(weyl)) != -1 ? 1 : 0;
! 16: K = length(F);
! 17: if ( type(F[0]) <= 2 ) {
! 18: for ( T = [], S = F; S != []; S = cdr(S) )
! 19: T = cons([car(S)],T);
! 20: F = reverse(T);
! 21: }
! 22: N = length(F[0]);
! 23: B = [];
! 24: for ( I = 0; I < K; I++ ) {
! 25: E = vector(N+K);
! 26: for ( J = 0; J < N; J++ ) E[J] = F[I][J];
! 27: E[N+I] = 1;
! 28: B = cons(vtol(E),B);
! 29: }
! 30: B = reverse(B);
! 31: if ( H >= 2 ) {
! 32: if ( Weyl )
! 33: G = nd_weyl_gr(B,V,H,[1,O]);
! 34: else
! 35: G = nd_gr(B,V,H,[1,O]);
! 36: } else {
! 37: if ( Weyl )
! 38: G = nd_weyl_gr_trace(B,V,H,-1,[1,O]);
! 39: else
! 40: G = nd_gr_trace(B,V,H,-1,[1,O]);
! 41: }
! 42: G0 = []; S0 = []; Gen0 = [];
! 43: for ( T = G; T != []; T = cdr(T) ) {
! 44: H = car(T);
! 45: for ( J = 0; J < N; J++ ) if ( H[J] ) break;
! 46: if ( J == N ) {
! 47: H1 = vector(K);
! 48: for ( J = 0; J < K; J++ ) H1[J] = H[N+J];
! 49: S0 = cons(vtol(H1),S0);
! 50: } else {
! 51: H1 = vector(N);
! 52: for ( J = 0; J < N; J++ ) H1[J] = H[J];
! 53: G0 = cons(vtol(H1),G0);
! 54: H1 = vector(K);
! 55: for ( J = 0; J < K; J++ ) H1[J] = H[N+J];
! 56: Gen0 = cons(vtol(H1),Gen0);
! 57: }
! 58: }
! 59: return [S0,G0,Gen0];
! 60: }
! 61:
! 62: def module_fres(F,V,H,O)
! 63: {
! 64: Weyl = type(getopt(weyl)) != -1 ? 1 : 0;
! 65: R = [F];
! 66: while ( 1 ) {
! 67: if ( Weyl )
! 68: L = module_syz(car(R),V,H,O|weyl=1);
! 69: else
! 70: L = module_syz(car(R),V,H,O);
! 71: if ( L[0] == [] ) return R;
! 72: else R = cons(L[0],R);
! 73: }
! 74: }
! 75:
! 76: def module_minres(F,V,H,O)
! 77: {
! 78: Weyl = type(getopt(weyl)) != -1 ? 1 : 0;
! 79: R = [F];
! 80: while ( 1 ) {
! 81: if ( Weyl )
! 82: L = module_syz(car(R),V,H,O|weyl=1);
! 83: else
! 84: L = module_syz(car(R),V,H,O);
! 85: if ( L[0] == [] ) return R;
! 86: S = simplify_syz(L[0],R[0],H);
! 87: R = append(S,cdr(R));
! 88: if ( R[0] == [] ) return cdr(R);
! 89: }
! 90: }
! 91:
! 92: /* M1 = syz(M2)
! 93: return [M1',M2'] (simplified ones)
! 94: */
! 95: def simplify_syz(M1,M2,Mod)
! 96: {
! 97: while ( 1 ) {
! 98: for ( T = M1, I = 0; T != []; T = cdr(T), I++ ) {
! 99: for ( S = car(T), J = 0; S != []; S = cdr(S), J++ )
! 100: if ( type(car(S))==1 ) break;
! 101: if ( S != [] ) break;
! 102: }
! 103: if ( T == [] ) return [M1,M2];
! 104: M1i = ltov(car(T)); H = M1i[J];
! 105: N = length(M1i);
! 106: for ( T = M1, K = 0, R1 = []; T != []; T = cdr(T), K++ ) {
! 107: if ( K != I ) {
! 108: M1k = ltov(car(T));
! 109: if ( M1k[J] )
! 110: M1k = remove_cont(H*M1k-M1k[J]*M1i,Mod);
! 111: for ( S = [], L = N-1; L >= 0; L-- )
! 112: if ( L != J ) S = cons(M1k[L],S);
! 113: R1 = cons(S,R1);
! 114: }
! 115: }
! 116: M1 = reverse(R1);
! 117: for ( R2 = [], T = M2, K = 0; T != []; T = cdr(T), K++ )
! 118: if ( K != J ) R2 = cons(car(T),R2);
! 119: M2 = reverse(R2);
! 120: }
! 121: }
! 122:
! 123: def icont(P)
! 124: {
! 125: P1 = ptozp(P);
! 126: return sdiv(P,P1);
! 127: }
! 128:
! 129: def mod(F,Mod)
! 130: {
! 131: return F%Mod;
! 132: }
! 133:
! 134: def remove_cont(V,Mod)
! 135: {
! 136: if ( Mod >= 2 ) return map(mod,V,Mod);
! 137: N = length(V);
! 138: for ( I = 0; I < N; I++ ) if ( V[I] ) break;
! 139: if ( I == N ) return V;
! 140: for ( C = icont(V[I]), I = 1; I < N; I++ )
! 141: if ( V[I] ) C = igcd(icont(V[I]),C);
! 142: return V/C;
! 143: }
! 144: endmodule;
! 145: end$
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>