-- | Tuning, Harry Partch
module Music.Theory.Tuning.Partch where

import qualified Data.Map.Strict as M {- containers -}
import Data.Ratio {- base -}

import qualified Music.Theory.Tuning as T

orelate :: Integral i => Ratio i -> i -> Ratio i
orelate :: forall i. Integral i => Ratio i -> i -> Ratio i
orelate Ratio i
r i
m = forall n. (Ord n, Fractional n) => n -> n
T.fold_ratio_to_octave_err (Ratio i
r forall a. Num a => a -> a -> a
* (i
m forall a. Integral a => a -> a -> Ratio a
% i
1))

urelate :: Integral i => Ratio i -> i -> Ratio i
urelate :: forall i. Integral i => Ratio i -> i -> Ratio i
urelate Ratio i
r i
m = forall n. (Ord n, Fractional n) => n -> n
T.fold_ratio_to_octave_err (Ratio i
r forall a. Num a => a -> a -> a
* (i
1 forall a. Integral a => a -> a -> Ratio a
% i
m))

-- | Incipient Tonality Diamond
--
-- > itd_map [4 .. 6]
itd_map :: [Integer] -> M.Map (Int,Int) Rational
itd_map :: [Integer] -> Map (Int, Int) Rational
itd_map [Integer]
relation =
  let limit :: Int
limit = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
relation
      z :: [Rational]
z = forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Ratio i -> i -> Ratio i
orelate Rational
1) [Integer]
relation
      c0 :: [((Int, Int), Rational)]
c0 = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> (Int
n,Int
0)) [Int
0 .. Int
limit forall a. Num a => a -> a -> a
- Int
1]) [Rational]
z
      cN :: [((Int, Int), Rational)]
cN = [((Int
i,Int
k),forall i. Integral i => Ratio i -> i -> Ratio i
urelate ([Rational]
z forall a. [a] -> Int -> a
!! Int
i) ([Integer]
relation forall a. [a] -> Int -> a
!! Int
k)) |
            Int
i <- [Int
0 .. Int
limit forall a. Num a => a -> a -> a
- Int
1],
            Int
k <- [Int
1 .. Int
limit forall a. Num a => a -> a -> a
- Int
1]]
  in forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([((Int, Int), Rational)]
c0 forall a. [a] -> [a] -> [a]
++ [((Int, Int), Rational)]
cN)

map_to_table :: t -> (Int,Int) -> M.Map (Int,Int) t -> [[t]]
map_to_table :: forall t. t -> (Int, Int) -> Map (Int, Int) t -> [[t]]
map_to_table t
k (Int
nr,Int
nc) Map (Int, Int) t
m =
  [[forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault t
k (Int
i,Int
j) Map (Int, Int) t
m | Int
j <- [Int
0 .. Int
nc forall a. Num a => a -> a -> a
- Int
1]] | Int
i <- [Int
0 .. Int
nr forall a. Num a => a -> a -> a
- Int
1]]

-- | 'map_to_table' of 'itd_map'.
--
-- > itd_tbl [4 .. 13]
itd_tbl :: [Integer] -> [[Rational]]
itd_tbl :: [Integer] -> [[Rational]]
itd_tbl [Integer]
r =
  let err :: a
err = forall a. HasCallStack => [Char] -> a
error [Char]
"itd_tbl"
      n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
r
  in forall t. t -> (Int, Int) -> Map (Int, Int) t -> [[t]]
map_to_table forall {a}. a
err (Int
n,Int
n) ([Integer] -> Map (Int, Int) Rational
itd_map [Integer]
r)

{-

import Data.List {- base -}
import qualified Music.Theory.Array.Text as T {- hmt -}
import qualified Music.Theory.Show as T {- hmt -}

pp tbl = putStrLn $ unlines $ T.table_pp T.table_opt_plain (map (map T.rational_pp) tbl)
pp (itd_tbl [4 .. 6])
pp (itd_tbl [4 .. 13])

$ itd 4 5 6
  1/1     8/5     4/3
  5/4     1/1     5/3
  3/2     6/5     1/1
$ itd 4 5 6 7 8 9 10 11 12 13
  1/1     8/5     4/3     8/7     1/1    16/9     8/5    16/11    4/3    16/13
  5/4     1/1     5/3    10/7     5/4    10/9     1/1    20/11    5/3    20/13
  3/2     6/5     1/1    12/7     3/2     4/3     6/5    12/11    1/1    24/13
  7/4     7/5     7/6     1/1     7/4    14/9     7/5    14/11    7/6    14/13
  1/1     8/5     4/3     8/7     1/1    16/9     8/5    16/11    4/3    16/13
  9/8     9/5     3/2     9/7     9/8     1/1     9/5    18/11    3/2    18/13
  5/4     1/1     5/3    10/7     5/4    10/9     1/1    20/11    5/3    20/13
 11/8    11/10   11/6    11/7    11/8    11/9    11/10    1/1    11/6    22/13
  3/2     6/5     1/1    12/7     3/2     4/3     6/5    12/11    1/1    24/13
 13/8    13/10   13/12   13/7    13/8    13/9    13/10   13/11   13/12    1/1
$

-}