Basic abstract temperament translation code

From Xenharmonic Wiki
Revision as of 00:00, 17 July 2018 by Wikispaces>FREEZE
Jump to navigation Jump to search

(code language: Maple)


ech := proc(l)

  1. reduced row echelon form of listlist l

local M;

M := Matrix(l);

convert(LinearAlgebra[ReducedRowEchelonForm](M), listlist) end:

relpar := proc(u, v)

  1. relative parity of two permutations

local t;

t := table('antisymmetric');

t[op(u)] := 1;

t[op(v)];

end:

pari := proc(u)

  1. parity of permutation u

local v;

v := sort(u);

relpar(u, v) end:

zerlist := proc(n)

  1. 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)

  1. 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)

  1. 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)

  1. 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)

  1. 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)

  1. rref l to wedgie

wedgie(mvec(l)) end:

e2frob := proc(l)

  1. 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)

  1. dual projection map

convert(LinearAlgebra[IdentityMatrix](nops(w[1])), listlist)-w end:

norc2e := proc(l)

  1. 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: