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>