Basic abstract temperament translation code
Jump to navigation
Jump to search
(code language: Maple)
ech := proc(l) # reduced row echelon form of listlist l local M; M := Matrix(l); convert(LinearAlgebra[ReducedRowEchelonForm](M), listlist) end: relpar := proc(u, v) # relative parity of two permutations local t; t := table('antisymmetric'); t[op(u)] := 1; t[op(v)]; end: pari := proc(u) # parity of permutation u local v; v := sort(u); relpar(u, v) end: zerlist := proc(n) # list of n 0s local i, u; u := NULL; for i from 1 to n do u := u,0 od; [u] end: denomlist := proc(w) map(denom, w) end: cleardenom := proc(w) local n; n := ilcm(op(denomlist(w))); n * w end: vec2e := proc(w) # rref temperament identifier from val list or projection matrix w local i, u, v, z; u := ech(w); z := NULL; for i from 1 to nops(u) do v := u[i]; if not convert(v, set)={0} then z := z,v fi od: [z] end: wedgie := proc(w) # reduction of multivector w to wedgie local i, n, u; u := cleardenom(w); n := igcd(op(u)); if n=0 then RETURN(w) fi; u := u/n; for i from 1 to nops(w) do if not u[i]=0 then if u[i]>0 then RETURN(u) fi; RETURN(-u) fi od end: mvec := proc(l) # multivector wedge product of vector list l local c, i, j, k, q, r, t, u, v, w; u := combinat[permute](nops(l)); c := combinat[choose](nops(l[1]), nops(l)); w := zerlist(nops(c)); for i from 1 to nops(c) do t := c[i]; r := 0; for j from 1 to nops(u) do v := u[j]; q := pari(v); for k from 1 to nops(v) do q := q * l[v[k], t[k]] od; r := r+q od; w[i] := w[i]+r od; w end: wedgie2e := proc(w, n, p) # rank n p-limit multival to rref local b, c, i, j, k, m, u, v, x, y, z; m := numtheory[pi](p); b := combinat[choose](m, n); c := combinat[choose](m, n-1); z := NULL; for i from 1 to nops(c) do u := c[i]; v := NULL; for j from 1 to m do y := [op(u), j]; if nops(convert(y, set))<n then v:=v,0 fi; x := sort(y); for k from 1 to nops(b) do if x=b[k] then v := v,relpar(b[k], y)*w[k] fi od od; v := [v]; z := z,v od; vec2e([z]) end: e2wedgie := proc(l) # rref l to wedgie wedgie(mvec(l)) end: e2frob := proc(l) # rref or normal val list to Frobenius projection map local U, V; U := Matrix(l); V := LinearAlgebra[Transpose](U); convert(V.(U.V)^(-1).U, listlist) end: dualproj := proc(w) # dual projection map convert(LinearAlgebra[IdentityMatrix](nops(w[1])), listlist)-w end: norc2e := proc(l) # normal comma list to rref local M, N; M := Matrix(l); N := LinearAlgebra[NullSpace](M); N := convert(N, list); N := Matrix(N); N := LinearAlgebra[Transpose](N); ech(convert(N, listlist)) end: