Basic abstract temperament translation code
IMPORTED REVISION FROM WIKISPACES
This is an imported revision from Wikispaces. The revision metadata is included below for reference:
- This revision was by author genewardsmith and made on 2011-06-18 18:04:39 UTC.
- The original revision id was 237481247.
- The revision comment was:
The revision contents are below, presented both in the original Wikispaces Wikitext format, and in HTML exactly as Wikispaces rendered it.
Original Wikitext content:
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:Original HTML content:
<html><head><title>Basic abstract temperament translation code</title></head><body><br />
ech := proc(l)<br />
<ol><li>reduced row echelon form of listlist l</li></ol>local M;<br />
M := Matrix(l);<br />
convert(LinearAlgebra[ReducedRowEchelonForm](M), listlist) end:<br />
<br />
relpar := proc(u, v)<br />
<ol><li>relative parity of two permutations</li></ol>local t;<br />
t := table('antisymmetric');<br />
t[op(u)] := 1;<br />
t[op(v)];<br />
end:<br />
<br />
pari := proc(u)<br />
<ol><li>parity of permutation u</li></ol>local v;<br />
v := sort(u);<br />
relpar(u, v) end:<br />
<br />
zerlist := proc(n)<br />
<ol><li>list of n 0s</li></ol>local i, u;<br />
u := NULL;<br />
for i from 1 to n do<br />
u := u,0 od;<br />
[u] end:<br />
<br />
denomlist := proc(w)<br />
map(denom, w) end:<br />
<br />
cleardenom := proc(w)<br />
local n;<br />
n := ilcm(op(denomlist(w)));<br />
n * w end:<br />
<br />
vec2e := proc(w)<br />
<ol><li>rref temperament identifier from val list or projection matrix w</li></ol>local i, u, v, z;<br />
u := ech(w);<br />
z := NULL;<br />
for i from 1 to nops(u) do<br />
v := u[i];<br />
if not convert(v, set)={0} then<br />
z := z,v fi od:<br />
[z] end:<br />
<br />
wedgie := proc(w)<br />
<ol><li>reduction of multivector w to wedgie</li></ol>local i, n, u;<br />
u := cleardenom(w);<br />
n := igcd(op(u));<br />
if n=0 then RETURN(w) fi;<br />
u := u/n;<br />
for i from 1 to nops(w) do<br />
if not u[i]=0 then<br />
if u[i]>0 then RETURN(u) fi;<br />
RETURN(-u) fi od end:<br />
<br />
mvec := proc(l)<br />
<ol><li>multivector wedge product of vector list l</li></ol>local c, i, j, k, q, r, t, u, v, w;<br />
u := combinat[permute](nops(l));<br />
c := combinat[choose](nops(l[1]), nops(l));<br />
w := zerlist(nops(c));<br />
for i from 1 to nops(c) do<br />
t := c[i];<br />
r := 0;<br />
for j from 1 to nops(u) do<br />
v := u[j];<br />
q := pari(v);<br />
for k from 1 to nops(v) do<br />
q := q * l[v[k], t[k]] od;<br />
r := r+q od;<br />
w[i] := w[i]+r od;<br />
w end:<br />
<br />
wedgie2e := proc(w, n, p)<br />
<ol><li>rank n p-limit multival to rref</li></ol>local b, c, i, j, k, m, u, v, x, y, z;<br />
m := numtheory[pi](p);<br />
b := combinat[choose](m, n);<br />
c := combinat[choose](m, n-1);<br />
z := NULL;<br />
for i from 1 to nops(c) do<br />
u := c[i];<br />
v := NULL;<br />
for j from 1 to m do<br />
y := [op(u), j];<br />
if nops(convert(y, set))<n then v:=v,0 fi;<br />
x := sort(y);<br />
for k from 1 to nops(b) do<br />
if x=b[k] then v := v,relpar(b[k], y)*w[k] fi od od;<br />
v := [v];<br />
z := z,v od;<br />
vec2e([z]) end:<br />
<br />
e2wedgie := proc(l)<br />
<ol><li>rref l to wedgie</li></ol>wedgie(mvec(l)) end:<br />
<br />
e2frob := proc(l)<br />
<ol><li>rref or normal val list to Frobenius projection map</li></ol>local U, V;<br />
U := Matrix(l);<br />
V := LinearAlgebra[Transpose](U);<br />
convert(V.(U.V)^(-1).U, listlist) end:<br />
<br />
dualproj := proc(w)<br />
<ol><li>dual projection map</li></ol>convert(LinearAlgebra[IdentityMatrix](nops(w[1])), listlist)-w end:</body></html>