[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.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>