[BACK]Return to module_syz.rr CVS log [TXT][DIR] Up to [local] / OpenXM / src / asir-contrib / testing / noro

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>