Basic abstract temperament translation code: Difference between revisions
Jump to navigation
Jump to search
Wikispaces>spt3125 **Imported revision 505938090 - Original comment: ** |
Wikispaces>FREEZE No edit summary |
||
| Line 1: | Line 1: | ||
(code language: [http://en.wikipedia.org/wiki/Maple_%28software%29 Maple]) | |||
---- | ----- | ||
ech := proc(l) | |||
<ol><li>reduced row echelon form of listlist l</li></ol>local M; | |||
M := Matrix(l); | M := Matrix(l); | ||
convert(LinearAlgebra[ReducedRowEchelonForm](M), listlist) end: | convert(LinearAlgebra[ReducedRowEchelonForm](M), listlist) end: | ||
relpar := proc(u, v) | relpar := proc(u, v) | ||
local t; | <ol><li>relative parity of two permutations</li></ol>local t; | ||
t := table('antisymmetric'); | t := table('antisymmetric'); | ||
t[op(u)] := 1; | t[op(u)] := 1; | ||
t[op(v)]; | t[op(v)]; | ||
end: | end: | ||
pari := proc(u) | pari := proc(u) | ||
local v; | <ol><li>parity of permutation u</li></ol>local v; | ||
v := sort(u); | v := sort(u); | ||
relpar(u, v) end: | relpar(u, v) end: | ||
zerlist := proc(n) | zerlist := proc(n) | ||
local i, u; | <ol><li>list of n 0s</li></ol>local i, u; | ||
u := NULL; | u := NULL; | ||
for i from 1 to n do | for i from 1 to n do | ||
u := u,0 od; | u := u,0 od; | ||
[u] end: | [u] end: | ||
denomlist := proc(w) | denomlist := proc(w) | ||
map(denom, w) end: | map(denom, w) end: | ||
cleardenom := proc(w) | cleardenom := proc(w) | ||
local n; | local n; | ||
n := ilcm(op(denomlist(w))); | n := ilcm(op(denomlist(w))); | ||
n * w end: | n * w end: | ||
vec2e := proc(w) | vec2e := proc(w) | ||
local i, u, v, z; | <ol><li>rref temperament identifier from val list or projection matrix w</li></ol>local i, u, v, z; | ||
u := ech(w); | u := ech(w); | ||
z := NULL; | z := NULL; | ||
for i from 1 to nops(u) do | for i from 1 to nops(u) do | ||
v := u[i]; | v := u[i]; | ||
if not convert(v, set)={0} then | if not convert(v, set)={0} then | ||
z := z,v fi od: | z := z,v fi od: | ||
[z] end: | [z] end: | ||
wedgie := proc(w) | wedgie := proc(w) | ||
local i, n, u; | <ol><li>reduction of multivector w to wedgie</li></ol>local i, n, u; | ||
u := cleardenom(w); | u := cleardenom(w); | ||
n := igcd(op(u)); | n := igcd(op(u)); | ||
if n=0 then RETURN(w) fi; | if n=0 then RETURN(w) fi; | ||
u := u/n; | u := u/n; | ||
for i from 1 to nops(w) do | for i from 1 to nops(w) do | ||
if not u[i]=0 then | if not u[i]=0 then | ||
if u[i]>0 then RETURN(u) fi; | if u[i]>0 then RETURN(u) fi; | ||
RETURN(-u) fi od end: | RETURN(-u) fi od end: | ||
mvec := proc(l) | mvec := proc(l) | ||
local c, i, j, k, q, r, t, u, v, w; | <ol><li>multivector wedge product of vector list l</li></ol>local c, i, j, k, q, r, t, u, v, w; | ||
u := combinat[permute](nops(l)); | u := combinat[permute](nops(l)); | ||
c := combinat[choose](nops(l[1]), nops(l)); | c := combinat[choose](nops(l[1]), nops(l)); | ||
w := zerlist(nops(c)); | w := zerlist(nops(c)); | ||
for i from 1 to nops(c) do | for i from 1 to nops(c) do | ||
t := c[i]; | t := c[i]; | ||
r := 0; | r := 0; | ||
for j from 1 to nops(u) do | for j from 1 to nops(u) do | ||
v := u[j]; | v := u[j]; | ||
q := pari(v); | q := pari(v); | ||
for k from 1 to nops(v) do | for k from 1 to nops(v) do | ||
q := q * l[v[k], t[k]] od; | q := q * l[v[k], t[k]] od; | ||
r := r+q od; | r := r+q od; | ||
w[i] := w[i]+r od; | w[i] := w[i]+r od; | ||
w end: | w end: | ||
wedgie2e := proc(w, n, p) | wedgie2e := proc(w, n, p) | ||
local b, c, i, j, k, m, u, v, x, y, z; | <ol><li>rank n p-limit multival to rref</li></ol>local b, c, i, j, k, m, u, v, x, y, z; | ||
m := numtheory[pi](p); | m := numtheory[pi](p); | ||
b := combinat[choose](m, n); | b := combinat[choose](m, n); | ||
c := combinat[choose](m, n-1); | c := combinat[choose](m, n-1); | ||
z := NULL; | z := NULL; | ||
for i from 1 to nops(c) do | for i from 1 to nops(c) do | ||
u := c[i]; | u := c[i]; | ||
v := NULL; | v := NULL; | ||
for j from 1 to m do | for j from 1 to m do | ||
y := [op(u), j]; | y := [op(u), j]; | ||
if nops(convert(y, set))<n then v:=v,0 fi; | if nops(convert(y, set))<n then v:=v,0 fi; | ||
x := sort(y); | x := sort(y); | ||
for k from 1 to nops(b) do | for k from 1 to nops(b) do | ||
if x=b[k] then v := v,relpar(b[k], y)*w[k] fi od od; | if x=b[k] then v := v,relpar(b[k], y)*w[k] fi od od; | ||
v := [v]; | v := [v]; | ||
z := z,v od; | z := z,v od; | ||
vec2e([z]) end: | vec2e([z]) end: | ||
e2wedgie := proc(l) | e2wedgie := proc(l) | ||
wedgie(mvec(l)) end: | <ol><li>rref l to wedgie</li></ol>wedgie(mvec(l)) end: | ||
e2frob := proc(l) | e2frob := proc(l) | ||
local U, V; | <ol><li>rref or normal val list to Frobenius projection map</li></ol>local U, V; | ||
U := Matrix(l); | U := Matrix(l); | ||
V := LinearAlgebra[Transpose](U); | V := LinearAlgebra[Transpose](U); | ||
convert(V.(U.V)^(-1).U, listlist) end: | convert(V.(U.V)^(-1).U, listlist) end: | ||
dualproj := proc(w) | dualproj := proc(w) | ||
convert(LinearAlgebra[IdentityMatrix](nops(w[1])), listlist)-w end: | <ol><li>dual projection map</li></ol>convert(LinearAlgebra[IdentityMatrix](nops(w[1])), listlist)-w end: | ||
norc2e := proc(l) | norc2e := proc(l) | ||
local M, N; | <ol><li>normal comma list to rref</li></ol>local M, N; | ||
M := Matrix(l); | M := Matrix(l); | ||
N := LinearAlgebra[NullSpace](M); | N := LinearAlgebra[NullSpace](M); | ||
N := convert(N, list); | N := convert(N, list); | ||
N := Matrix(N); | N := Matrix(N); | ||
N := LinearAlgebra[Transpose](N); | N := LinearAlgebra[Transpose](N); | ||
ech(convert(N, listlist)) end: | |||
ech(convert(N, listlist)) end: | |||
[[Category:algorithm]] | |||
[[Category:code]] | |||
[[Category:maple]] | |||
[ | |||
Revision as of 00:00, 17 July 2018
(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: