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

Annotation of OpenXM/src/asir-contrib/testing/noro/mpmat.rr, Revision 1.1

1.1     ! noro        1: def utabout(U,Name)
        !             2: {
        !             3:        output(Name);
        !             4:        M = U[0][0];
        !             5:        D = U[0][1];
        !             6:        F = U[1];
        !             7:        N = size(M)[0];
        !             8:        for ( I = 0; I < N; I++ ) {
        !             9:                for ( J = 0; J < N; J++ ) { print(M[I][J],0);  print(" ",0); }
        !            10:                print("");
        !            11:        }
        !            12:        print("");
        !            13:        print(D);
        !            14:        print("");
        !            15:        for ( D = deg(F,var(F)), I = 0; I <= D; I++ ) {
        !            16:                print(I,0); print(" ",0); print(coef(F,I));
        !            17:        }
        !            18:        output();
        !            19: }
        !            20:
        !            21: def minipoly_mat(G,V,O,V1,V0)
        !            22: {
        !            23:        if ( !zero_dim(hmlist(G,V,O),V,O) )
        !            24:                error("tolex : ideal is not zero-dimensional!");
        !            25:
        !            26:        N = length(V);
        !            27:        dp_ord(O);
        !            28:
        !            29:        HM = hmlist(G,V,O);
        !            30:        MB = dp_mbase(map(dp_ptod,HM,V));
        !            31:        Mat = utabtomat(G,V,V1,MB);
        !            32:
        !            33:        for ( J = 0; ; J++ ) {
        !            34:                M = lprime(J);
        !            35:                if ( !valid_modulus(HM,M) )
        !            36:                        continue;
        !            37:                MP = minipolym(G,V,O,V1,V0,M);
        !            38:                MP = subst(MP,V0,V1);
        !            39:                for ( D = deg(MP,V1), TL = [], J = 0; J <= D; J++ )
        !            40:                        TL = cons(V1^J,TL);
        !            41:                NF = gennf(G,TL,V,O,V1,1)[0];
        !            42:                R = tolex_main(V,O,NF,[MP],M,MB);
        !            43:                return [Mat,subst(ptozp(R[0]),V1,V0)];
        !            44:        }
        !            45: }
        !            46:
        !            47: def utabtomat(G,V,V1,MB)
        !            48: {
        !            49:        Len = length(G); PS = vector(Len);
        !            50:        for ( I = 0, T = G; T != []; T = cdr(T), I++ ) PS[I] = dp_ptod(car(T),V);
        !            51:        for ( I = Len - 1, GI = []; I >= 0; I-- ) GI = cons(I,GI);
        !            52:        N = length(MB);
        !            53:        U = dp_ptod(V1,V);
        !            54:        UTAB = newvect(N);
        !            55:        for ( I = 0; I < N; I++ ) {
        !            56:                UTAB[I] = [MB[I],remove_cont(dp_true_nf(GI,U*MB[I],PS,1))];
        !            57:                if ( dp_gr_print() )
        !            58:                        print(".",2);
        !            59:        }
        !            60:        if ( dp_gr_print() )
        !            61:                print("");
        !            62:
        !            63:        M = matrix(N,N);
        !            64:        for ( I = 0, LCM = 1; I < N; I++ ) LCM = ilcm(UTAB[I][1][1],LCM);
        !            65:        for ( I = 0; I < N; I++ ) {
        !            66:                F = UTAB[I][1][0]; Mul = LCM/UTAB[I][1][1];
        !            67:                for ( K = 0; K < N; K++ )
        !            68:                        if ( MB[K] == dp_ht(F) ) {
        !            69:                                M[K][I] = Mul*dp_hc(F);
        !            70:                                F = dp_rest(F);
        !            71:                        }
        !            72:        }
        !            73:        return [M,LCM];
        !            74: }
        !            75: end$

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>