Module:Temperament data

Module documentation[view] [edit] [history] [purge]

Note: Do not invoke this module directly; use the corresponding template instead: Template:Temperament data.

This module depends on the following other modules: Module: Rational Module: Utils

Todo: add documentation

---

local rat = require('Module:Rational')
local p = {}
local u = require('Module:Utils')

local function gcd(a,b)
    if type(a) == 'number' and type(b) == 'number' and a == math.floor(a) and b == math.floor(b) then
        if b == 0 then
            return a
        else
            return gcd(b, a % b) -- tail recursion
        end
    else
        error('Invalid argument to gcd (' .. tostring(a) .. ',' .. tostring(b) .. ')', 2)
    end
end

-- Linear algebra and RTT functions

local function matadd(a, b)
	local result = {}
	for i = 1, #a  do
		result[i] = {}
		for j = 1, #(b[1]) do
			result[i][j] = a[i][j] + b[i][j]
		end
	end
	return result
end

local function matsub(a, b)
	local result = {}
	for i = 1, #a  do
		result[i] = {}
		for j = 1, #(b[1]) do
			result[i][j] = a[i][j] - b[i][j]
		end
	end
	return result
end

local function matmul(a, b)
	local result = {}
	for i = 1, #a  do
		result[i] = {}
		for j = 1, #(b[1]) do
			result[i][j] = 0
			for k = 1, #(a[1]) do
				result[i][j] = result[i][j] + (a[i][k] * b[k][j])
			end
		end
	end
	return result
end


local function scalarmatmul(a, b)
	local result = {}
	for i = 1, #a  do
		result[i] = {}
		for j = 1, #(a[1]) do
			result[i][j] = a[i][j] * b
		end
	end
	return result
end

local function matinv(a)
	local dbl_identity = {}
	for i = 1, #a do
		dbl_identity[i] = {}
		for j = 1, #a do
			if i == j then
				dbl_identity[i][j] = 2
			else
				dbl_identity[i][j] = 0
			end
		end
	end

	local xn = scalarmatmul(a, 0.000005)
	
	for i = 1, 30 do
		xn = matmul(xn, matsub(dbl_identity, matmul(a, xn)))
	end
	return xn
end

local function transpose(a)
	local result = {}
	for i = 1, #a[1] do
		result[i] = {}
		for j = 1, #a do
			result[i][j] = a[j][i]
		end
	end
	return result
end

local function antitranspose(a)
	local result = {}
	for i = 1, #a[1] do
		result[i] = {}
		for j = 1, #a do
			result[i][j] = a[#a - j + 1][#a[1] - i + 1]
		end
	end
	return result
end


local function pseudoinv(a)
	return matmul(transpose(a), matinv(matmul(a, transpose(a))))
end

local function nullspace(mapping)
	local identity = {}
	for i = 1, #mapping[1] do
		identity[i] = {}
		for j = 1, #mapping[1] do
			if i == j then
				identity[i][j] = 1
			else
				identity[i][j] = 0
			end
		end
	end

	-- local w = {{0},{1},{0}}
	-- for i = 1, #mapping[1] do
	-- 	w[i] = {10}
	-- end

	return matsub(identity, matmul(pseudoinv(mapping), mapping))
end

local function unreduced_mapping_from_basis(comma_basis)
	return antitranspose(nullspace(antitranspose(comma_basis)))
end

local function get_reduced_mapping(comma_basis, preimage)
	a =  pseudoinv(matmul(unreduced_mapping_from_basis(comma_basis), preimage))
	for i = 1, #a do
		for j = 1, #a[1] do
			a[i][j] = math.floor(a[i][j] + 0.5) -- round each entry (they are not exact integers)
		end
	end
	return a
end

local function get_te_generator(subgroup, comma_basis, preimage)
	local v = get_reduced_mapping(comma_basis, preimage)
	local w = {}
	for i = 1, #subgroup do
		w[i] = {}
		for j = 1, #subgroup do
			if i == j then
				w[i][j] = math.log(2)/math.log(subgroup[i])
			else
				w[i][j] = 0
			end
		end
	end
	
	local jw = {{}}
	for i = 1, #subgroup do
		jw[1][i] = 1
	end
	local vw = matmul(v, w)
	local g = matmul(jw, pseudoinv(vw))
	return g
end


local function get_pote_generator(subgroup, comma_basis, preimage)
	local period = 1
	for i = 1, #subgroup do
		period = period * (subgroup[i]^preimage[i][1])
	end
	local te = get_te_generator(subgroup, comma_basis, preimage)
	local stretch_factor = te[1][1] * math.log(2) / math.log(period)
	return scalarmatmul(te, 1/stretch_factor)
end



-- Parsing/display functions

local function int_to_subgroup_monzo(subgroup, x) 
	local result = {}
	local x2 = x
	for i = 1, #subgroup do
		result[i] = 0
		while true do
			x2 = x2 / subgroup[i]
			if x2 ~= math.floor(x2) then
				break
			end
			result[i] = result[i] + 1
		end
		x2 = x
	end
	
	return result
end


local function rat_to_subgroup_monzo(subgroup, x)
	local n, d = rat.as_pair(x)
	return matsub({int_to_subgroup_monzo(subgroup, n)}, {int_to_subgroup_monzo(subgroup, d)})[1]	
end

local function rat_list_to_matrix(subgroup, list)
	local result = {}
	for j = 1, #subgroup do
		result[j] = {}
	end
	
	for i = 1, #list do
		local smonzo = rat_to_subgroup_monzo(subgroup, list[i])
		for j = 1, #subgroup do
			result[j][i] = smonzo[j]
		end
	end
	
	return result
end

local function mysplit (inputstr, sep)
        if sep == nil then
                sep = '%s'
        end
        local t={}
        for str in string.gmatch(inputstr, '([^'..sep..']+)') do
                table.insert(t, str)
        end
        return t
end

local function trim(x)
	local str = x
	str = str:gsub('%s+', '')
    str = string.gsub(str, '%s+', '')
    return str
end

function p.temperament_data(frame)
	local subgroup = mysplit(frame.args['subgroup'], '.')
	for i = 1, #subgroup do
		subgroup[i] = tonumber(subgroup[i])
	end
	local comma_matrix = mysplit(frame.args['comma_list'], ',')
	for i = 1, #comma_matrix do
		comma_matrix[i] = rat.parse(comma_matrix[i])
	end
	comma_matrix = rat_list_to_matrix(subgroup, comma_matrix)
	local unparsed_gens = mysplit(frame.args['generators'], ',')
	local generators =  mysplit(frame.args['generators'], ',')
	for i = 1, #generators do
		generators[i] = rat.parse(generators[i])
	end
	generators = rat_list_to_matrix(subgroup, generators)
	local mapping = get_reduced_mapping(comma_matrix, generators)
	local cte_generator = frame.args['cte_generator']
	local pote_generator = get_pote_generator(subgroup, comma_matrix, generators)
	local result =  '[[Subgroup]]: ' .. frame.args['subgroup']
	result = result .. '\n\n[[Comma list]]: ' .. frame.args['comma_list']
	result = result .. '\n\n[[Mapping]]: [⟨'
	for i = 1, #mapping do
		for j = 1, #mapping[1] do
			result = result .. mapping[i][j] .. ' '
		end
		result = result:sub(0,-2) .. '], ⟨'
	end	
	result = result:sub(0,-6) .. ']'
	
	result = result .. '\n\n: mapping generators: '
	for i = 1, #unparsed_gens do
		result = result .. '~' .. trim(unparsed_gens[i]) .. ', '
	end
	result = result:sub(0,-3)
	if cte_generator ~= '' then
		cte_generator = mysplit(cte_generator, ',')
		for i = 1, #cte_generator do
			cte_generator[i] = tonumber(cte_generator[i])
		end
		
		result = result .. '\n\n[[Optimal tuning]]s:\n* [[CTE]]:'
		
		for i = 1, #(cte_generator) do
			if subgroup[1] == 2 and i == 1 then
				result = result .. '~' .. trim(unparsed_gens[i]) ..  ' = ' .. '1\\1' .. ', '
			elseif subgroup[1] == 3 and i == 1 then
				result = result .. '~' .. trim(unparsed_gens[i]) ..  ' = ' .. '1\\1edt' .. ', '
			else
				result = result .. '~' .. trim(unparsed_gens[i]) .. ' = ' .. u._round(cte_generator[i], 7) .. ', '
			end
		end
		
		result = result:sub(0,-3)
	
		if subgroup[1] ~= 2 then
			result = result .. '\n* [[Lp tuning|POL2]]:'
		else
			result = result .. '\n* [[POTE]]:'
		end
	else
		if subgroup[1] ~= 2 then
			result = result .. '\n\n[[Optimal tuning]] ([[Lp tuning|POL2]]): '
		else
			result = result .. '\n\n[[Optimal tuning]] ([[POTE]]): '
		end
	end
	
	for i = 1, #(pote_generator[1]) do
		if subgroup[1] == 2 and i == 1 then
			result = result .. '~' .. trim(unparsed_gens[i]) ..  ' = ' .. '1\\1' .. ', '
		elseif subgroup[1] == 3 and i == 1 then
			result = result .. '~' .. trim(unparsed_gens[i]) ..  ' = ' .. '1\\1edt' .. ', '
		else
			result = result .. '~' .. trim(unparsed_gens[i]) .. ' = ' .. u._round(pote_generator[1][i] * 1200, 7) .. ', '
		end
	end
	result = result:sub(0,-3)
	
	return result
end

return p