Annotation of OpenXM/src/asir-contrib/testing/noro/module_syz.rr, Revision 1.2
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);
1.2 ! nisiyama 87: if ( S == [[],[]] ) return cdr(R);
1.1 noro 88: R = append(S,cdr(R));
89: if ( R[0] == [] ) return cdr(R);
90: }
91: }
92:
93: /* M1 = syz(M2)
94: return [M1',M2'] (simplified ones)
95: */
96: def simplify_syz(M1,M2,Mod)
97: {
98: while ( 1 ) {
99: for ( T = M1, I = 0; T != []; T = cdr(T), I++ ) {
100: for ( S = car(T), J = 0; S != []; S = cdr(S), J++ )
101: if ( type(car(S))==1 ) break;
102: if ( S != [] ) break;
103: }
104: if ( T == [] ) return [M1,M2];
105: M1i = ltov(car(T)); H = M1i[J];
106: N = length(M1i);
107: for ( T = M1, K = 0, R1 = []; T != []; T = cdr(T), K++ ) {
108: if ( K != I ) {
109: M1k = ltov(car(T));
110: if ( M1k[J] )
111: M1k = remove_cont(H*M1k-M1k[J]*M1i,Mod);
112: for ( S = [], L = N-1; L >= 0; L-- )
113: if ( L != J ) S = cons(M1k[L],S);
114: R1 = cons(S,R1);
115: }
116: }
117: M1 = reverse(R1);
118: for ( R2 = [], T = M2, K = 0; T != []; T = cdr(T), K++ )
119: if ( K != J ) R2 = cons(car(T),R2);
120: M2 = reverse(R2);
121: }
122: }
123:
124: def icont(P)
125: {
126: P1 = ptozp(P);
127: return sdiv(P,P1);
128: }
129:
130: def mod(F,Mod)
131: {
132: return F%Mod;
133: }
134:
135: def remove_cont(V,Mod)
136: {
137: if ( Mod >= 2 ) return map(mod,V,Mod);
138: N = length(V);
139: for ( I = 0; I < N; I++ ) if ( V[I] ) break;
140: if ( I == N ) return V;
141: for ( C = icont(V[I]), I = 1; I < N; I++ )
142: if ( V[I] ) C = igcd(icont(V[I]),C);
143: return V/C;
144: }
145: endmodule;
146: end$
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>