-- | Kyle Gann. "La Monte Young's The Well-Tuned Piano".
-- /Perspectives of New Music/, 31(1):134--162, Winter 1993.
module Music.Theory.Tuning.Gann_1993 where

import Data.List {- base -}
import Data.Maybe {- base -}

import qualified Music.Theory.List as T {- hmt -}
import qualified Music.Theory.Math as T {- hmt -}
import qualified Music.Theory.Pitch as T {- hmt -}
import qualified Music.Theory.Tuning as T {- hmt -}
import qualified Music.Theory.Tuning.Graph.Euler as T {- hmt -}
import qualified Music.Theory.Tuning.Type as T {- hmt -}

{- | Ratios for 'lmy_wtp'. lmy = La Monte Young. wtp = Well-Tuned Piano.

> let c = [0,177,204,240,471,444,675,702,738,969,942,1173]
> in map (round . T.ratio_to_cents) lmy_wtp_r == c

-}
lmy_wtp_r :: [Rational]
lmy_wtp_r :: [Rational]
lmy_wtp_r =
    [Rational
1,Rational
567forall a. Fractional a => a -> a -> a
/Rational
512
    ,Rational
9forall a. Fractional a => a -> a -> a
/Rational
8,Rational
147forall a. Fractional a => a -> a -> a
/Rational
128
    ,Rational
21forall a. Fractional a => a -> a -> a
/Rational
16
    ,Rational
1323forall a. Fractional a => a -> a -> a
/Rational
1024,Rational
189forall a. Fractional a => a -> a -> a
/Rational
128
    ,Rational
3forall a. Fractional a => a -> a -> a
/Rational
2,Rational
49forall a. Fractional a => a -> a -> a
/Rational
32
    ,Rational
7forall a. Fractional a => a -> a -> a
/Rational
4,Rational
441forall a. Fractional a => a -> a -> a
/Rational
256
    ,Rational
63forall a. Fractional a => a -> a -> a
/Rational
32]

-- | The pitch-class of the key associated with each ratio of the tuning.
--
-- > mapMaybe lmy_wtp_ratio_to_pc [1,1323/1024,7/4] == [3,8,0]
lmy_wtp_ratio_to_pc :: Rational -> Maybe T.PitchClass
lmy_wtp_ratio_to_pc :: Rational -> Maybe PitchClass
lmy_wtp_ratio_to_pc Rational
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall i. Integral i => i -> i
T.mod12 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ PitchClass
3)) (forall a. Eq a => a -> [a] -> Maybe PitchClass
elemIndex Rational
r [Rational]
lmy_wtp_r)

lmy_wtp_ratio_to_pc_err :: Rational -> T.PitchClass
lmy_wtp_ratio_to_pc_err :: Rational -> PitchClass
lmy_wtp_ratio_to_pc_err = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"lmy_wtp_ratio_to_pc") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Maybe PitchClass
lmy_wtp_ratio_to_pc

-- | The list of all non-unison ascending intervals possible in 'lmy_wtp_r'.
--
-- > length lmy_wtp_univ == 66
lmy_wtp_univ :: [(Rational,(T.PitchClass,T.PitchClass))]
lmy_wtp_univ :: [(Rational, (PitchClass, PitchClass))]
lmy_wtp_univ =
    let f :: (Rational, Rational) -> Maybe (Rational, (PitchClass, PitchClass))
f (Rational
p,Rational
q) = if Rational
p forall a. Ord a => a -> a -> Bool
< Rational
q
                  then forall a. a -> Maybe a
Just (forall i. Integral i => Ratio i -> Ratio i
T.ratio_interval_class (Rational
pforall a. Fractional a => a -> a -> a
/Rational
q)
                            ,(Rational -> PitchClass
lmy_wtp_ratio_to_pc_err Rational
p
                             ,Rational -> PitchClass
lmy_wtp_ratio_to_pc_err Rational
q))
                  else forall a. Maybe a
Nothing
    in forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Rational, Rational) -> Maybe (Rational, (PitchClass, PitchClass))
f (forall t u. [t] -> [u] -> [(t, u)]
T.all_pairs [Rational]
lmy_wtp_r [Rational]
lmy_wtp_r)

{- | Collated and sorted 'lmy_wtp_univ'.

> let r_cents_pp = show . round . T.ratio_to_cents

> import qualified Music.Theory.Math as T {- hmt -}

> let f (r,i) = concat [T.ratio_pp r," = "
>                      ,r_cents_pp r," = #"
>                      ,show (length i)," = "
>                      ,unwords (map show i)]

> putStrLn $ unlines $ map f lmy_wtp_uniq

3:2 = 702 = #9 = (3,10) (4,9) (5,10) (6,11) (6,1) (7,0) (7,2) (8,1) (9,2)
7:4 = 969 = #7 = (3,0) (5,2) (6,7) (7,10) (8,9) (11,0) (1,2)
7:6 = 267 = #6 = (4,8) (5,7) (6,2) (7,11) (9,1) (10,0)
9:7 = 435 = #4 = (4,1) (5,0) (6,9) (11,2)
9:8 = 204 = #6 = (3,5) (4,2) (6,8) (7,9) (11,1) (0,2)
21:16 = 471 = #6 = (3,7) (5,9) (6,0) (7,1) (8,2) (10,2)
27:14 = 1137 = #2 = (4,6) (9,11)
27:16 = 906 = #3 = (4,7) (8,11) (9,0)
49:32 = 738 = #3 = (3,11) (5,1) (6,10)
49:36 = 534 = #1 = (5,11)
63:32 = 1173 = #5 = (3,2) (4,5) (8,7) (9,10) (1,0)
49:48 = 36 = #2 = (5,6) (10,11)
81:56 = 639 = #1 = (4,11)
81:64 = 408 = #1 = (4,0)
147:128 = 240 = #3 = (3,6) (5,8) (10,1)
189:128 = 675 = #3 = (3,9) (4,10) (8,0)
441:256 = 942 = #2 = (3,1) (8,10)
567:512 = 177 = #1 = (3,4)
1323:1024 = 444 = #1 = (3,8)

-}
lmy_wtp_uniq :: [(Rational,[(T.PitchClass,T.PitchClass)])]
lmy_wtp_uniq :: [(Rational, [(PitchClass, PitchClass)])]
lmy_wtp_uniq = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall t. Integral t => Ratio t -> t
T.ratio_nd_sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall k a v. Ord k => (a -> k) -> (a -> v) -> [a] -> [(k, [v])]
T.collate_on forall a b. (a, b) -> a
fst forall a b. (a, b) -> b
snd [(Rational, (PitchClass, PitchClass))]
lmy_wtp_univ)

{- | Gann, 1993, p.137.

> cents_i lmy_wtp == [0,177,204,240,471,444,675,702,738,969,942,1173]

> import Data.List {- base -}
> import Music.Theory.Tuning.Scala {- hmt -}
> scl <- scl_load "young-lm_piano"
> cents_i (scale_to_tuning 0.01 scl) == cents_i lmy_wtp

> let f = d12_midi_tuning_f (lmy_wtp,-74.7,-3)
> import qualified Music.Theory.Pitch as T
> T.octpc_to_midi (-1,11) == 11
> map (round . T.midi_detune_to_cps . f) [62,63,69] == [293,298,440]
> map (fmap round . T.midi_detune_normalise . f) [0 .. 127]

-}
lmy_wtp :: T.Tuning
lmy_wtp :: Tuning
lmy_wtp = Either [Rational] [Cents]
-> Maybe (Either Rational Cents) -> Tuning
T.Tuning (forall a b. a -> Either a b
Left [Rational]
lmy_wtp_r) forall a. Maybe a
Nothing

-- | Ratios for 'lmy_wtp_1964.
lmy_wtp_1964_r :: [Rational]
lmy_wtp_1964_r :: [Rational]
lmy_wtp_1964_r =
    let n :: [Rational]
n = [Rational
1,Rational
279,Rational
9,Rational
147,Rational
21,Rational
93,Rational
189,Rational
3,Rational
49,Rational
7,Rational
31,Rational
63]
        d :: [Rational]
d = [Rational
1,Rational
256,Rational
8,Rational
128,Rational
16,Rational
64,Rational
128,Rational
2,Rational
32,Rational
4,Rational
16,Rational
32]
    in forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Fractional a => a -> a -> a
(/) [Rational]
n [Rational]
d

{- | La Monte Young's initial 1964 tuning for \"The Well-Tuned Piano\" (Gann, 1993, p.141).

> cents_i lmy_wtp_1964 == [0,149,204,240,471,647,675,702,738,969,1145,1173]

> import Music.Theory.Tuning.Scala
> let nm = ("young-lm_piano_1964","LaMonte Young's Well-Tuned Piano (1964)")
> let scl = tuning_to_scale nm lmy_wtp_1964
> putStr $ unlines $ scale_pp scl

-}
lmy_wtp_1964 :: T.Tuning
lmy_wtp_1964 :: Tuning
lmy_wtp_1964 = Either [Rational] [Cents]
-> Maybe (Either Rational Cents) -> Tuning
T.Tuning (forall a b. a -> Either a b
Left [Rational]
lmy_wtp_1964_r) forall a. Maybe a
Nothing

{- | Euler diagram for 'lmy_wtp'.

let dir = "/home/rohan/sw/hmt/data/dot/"
let f = unlines . T.euler_plane_to_dot_rat (3,True)
writeFile (dir ++ "euler-wtp.dot") (f lmy_wtp_euler)

-}
lmy_wtp_euler :: T.Euler_Plane Rational
lmy_wtp_euler :: Euler_Plane Rational
lmy_wtp_euler =
    let {l1 :: [Rational]
l1 = PitchClass -> Rational -> Rational -> [Rational]
T.tun_seq PitchClass
4 (Rational
3forall a. Fractional a => a -> a -> a
/Rational
2) (Rational
49forall a. Fractional a => a -> a -> a
/Rational
32)
        ;l2 :: [Rational]
l2 = PitchClass -> Rational -> Rational -> [Rational]
T.tun_seq PitchClass
5 (Rational
3forall a. Fractional a => a -> a -> a
/Rational
2) (Rational
7forall a. Fractional a => a -> a -> a
/Rational
4)
        ;l3 :: [Rational]
l3 = PitchClass -> Rational -> Rational -> [Rational]
T.tun_seq PitchClass
3 (Rational
3forall a. Fractional a => a -> a -> a
/Rational
2) Rational
1
        ;([(Rational, Rational)]
c1,[(Rational, Rational)]
c2) = (Rational, Rational)
-> T3 [Rational]
-> ([(Rational, Rational)], [(Rational, Rational)])
T.euler_align_rat (Rational
7forall a. Fractional a => a -> a -> a
/Rational
4,Rational
7forall a. Fractional a => a -> a -> a
/Rational
4) ([Rational]
l1,[Rational]
l2,[Rational]
l3)}
    in ([[Rational]
l1,[Rational]
l2,[Rational]
l3],[(Rational, Rational)]
c1 forall a. [a] -> [a] -> [a]
++ [(Rational, Rational)]
c2)