-- | David Rosenboom, "In the Beginning: Etude I (Trombones)", 1979
--   <http://davidrosenboom.com/media/beginning-etude-i-trombones>
--
-- kw: subharmonics, difference tones
module Music.Theory.Tuning.Rosenboom_1979 where

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

import qualified Music.Theory.Function as T
import qualified Music.Theory.List as T
import qualified Music.Theory.Pitch as T
import qualified Music.Theory.Pitch.Name as T
import qualified Music.Theory.Tuning.Et as T
import qualified Music.Theory.Tuning.Scala as Scala
import qualified Music.Theory.Tuple as T

t2_to_ratio :: (Integer,Integer) -> Rational
t2_to_ratio :: (Integer, Integer) -> Rational
t2_to_ratio (Integer
n,Integer
d) = Integer
n forall a. Integral a => a -> a -> Ratio a
% Integer
d

-- | Tuning, ratios for each octave.
--
-- > length (concat dr_tuning_oct) == 19
-- > import qualified Music.Theory.Tuning as T
-- > map (map (T.ratio_to_cents . t2_to_ratio)) dr_tuning_oct
dr_tuning_oct :: Num n => [[(n,n)]]
dr_tuning_oct :: forall n. Num n => [[(n, n)]]
dr_tuning_oct =
    [[(n
1,n
1),(n
4,n
3),(n
16,n
11),(n
8,n
5),(n
16,n
9)]
    ,[(n
1,n
1),(n
8,n
7),(n
4,n
3),(n
3,n
2),(n
8,n
5),(n
16,n
9)]
    ,[(n
1,n
1),(n
9,n
8),(n
5,n
4),(n
4,n
3),(n
11,n
8),(n
3,n
2),(n
8,n
5),(n
7,n
4)]]

-- | Tuning, actual ratios.
dr_tuning :: [Rational]
dr_tuning :: [Rational]
dr_tuning = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Rational
o -> forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Num a => a -> a -> a
* Rational
o) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, Integer) -> Rational
t2_to_ratio)) [Rational
1,Rational
2,Rational
4] forall n. Num n => [[(n, n)]]
dr_tuning_oct)

-- | Actual scale, in CPS.
--
-- > let r = [52,69,76,83,92,104,119,138,156,166,185,208,234,260,277,286,311,332,363]
-- > map round dr_scale == r
dr_scale :: [Double]
dr_scale :: [Double]
dr_scale =
    let f0 :: Double
f0 = forall i n. (Integral i, Floating n) => Octave_PitchClass i -> n
T.octpc_to_cps (Int
1::Int,Int
8)
        f :: Rational -> Double
f = (forall a. Num a => a -> a -> a
* Double
f0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational
    in forall a b. (a -> b) -> [a] -> [b]
map Rational -> Double
f [Rational]
dr_tuning

-- > putStrLn (unlines (map (unwords . T.hs_r_pitch_pp 1)  dr_scale_tbl_12et))
-- > map (\(f,p,_,_,_) -> (T.pitch_to_midi p,f)) dr_scale_tbl_12et
dr_scale_tbl_12et :: [T.HS_R T.Pitch]
dr_scale_tbl_12et :: [HS_R Pitch]
dr_scale_tbl_12et = forall a b. (a -> b) -> [a] -> [b]
map ((Double, Double) -> Double -> HS_R Pitch
T.nearest_12et_tone_k0 (Double
69,Double
440)) [Double]
dr_scale

-- > Scala.scale_verify dr_scale_scala
-- > putStrLn $ unlines $ Scala.scale_pp dr_scale_scala
dr_scale_scala :: Scala.Scale
dr_scale_scala :: Scale
dr_scale_scala =
    let f :: b -> (a, Pitch, c, d, e) -> (Int, b)
f b
r (a
_,Pitch
p,c
_,d
_,e
_) = (forall i. Integral i => Pitch -> i
T.pitch_to_midi Pitch
p :: Int,b
r)
        sq :: [(Int, Rational)]
sq = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {b} {a} {c} {d} {e}. b -> (a, Pitch, c, d, e) -> (Int, b)
f [Rational]
dr_tuning [HS_R Pitch]
dr_scale_tbl_12et
        g :: Rational -> Int -> (Rational, (Int, Rational))
g Rational
z Int
k = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
k [(Int, Rational)]
sq of
                  Maybe Rational
Nothing -> (Rational
z,(Int
k,Rational
z))
                  Just Rational
r -> (Rational
r,(Int
k,Rational
r))
        r_seq :: [(Int, Rational)]
r_seq = forall a b. (a, b) -> b
snd (forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Rational -> Int -> (Rational, (Int, Rational))
g Rational
1 [Int
33 .. Int
32 forall a. Num a => a -> a -> a
+ Int
12 forall a. Num a => a -> a -> a
* Int
3 forall a. Num a => a -> a -> a
- Int
1]) forall a. [a] -> [a] -> [a]
++ [(Int
68,Rational
8)]
    in (String
"dr_itb_etude_1",String
"...",Int
3 forall a. Num a => a -> a -> a
* Int
12,forall a b. (a -> b) -> [a] -> [b]
map (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Int, Rational)]
r_seq)

-- > putStrLn (unlines (map (unwords . T.hs_r_pitch_pp 1)  dr_scale_tbl_24et))
dr_scale_tbl_24et :: [T.HS_R T.Pitch]
dr_scale_tbl_24et :: [HS_R Pitch]
dr_scale_tbl_24et = forall a b. (a -> b) -> [a] -> [b]
map ((Double, Double) -> Double -> HS_R Pitch
T.nearest_24et_tone_k0 (Double
69,Double
440)) [Double]
dr_scale

dr_chords :: [[T.Pitch]]
dr_chords :: [[Pitch]]
dr_chords =
    [[Pitch
T.aes1,Pitch
T.bes2,Pitch
T.des3,Pitch
T.ees4] -- S1
    ,[Pitch
T.aes1,Pitch
T.aes2,Pitch
T.fes3,Pitch
T.ees4]
    ,[Pitch
T.aes1,Pitch
T.bes2,Pitch
T.des3,Pitch
T.ees4]
    ,[Pitch
T.aes1,Pitch
T.bes2,Pitch
T.des3,Pitch
T.ees4] -- S2
    ,[Pitch
T.aes1,Pitch
T.ges2,Pitch
T.aes3,Pitch
T.ees4]
    ,[Pitch
T.aes1,Pitch
T.bes2,Pitch
T.des3,Pitch
T.ees4]
    ,[Pitch
T.aes1,Pitch
T.bes2,Pitch
T.des3,Pitch
T.ees4] -- S3
    ,[Pitch
T.aes1,Pitch
T.ges2,Pitch
T.aes3,Pitch
T.ees4]
    ,[Pitch
T.aes1,Pitch
T.ges2,Pitch
T.aes3,Pitch
T.ees4] -- S4
    ,[Pitch
T.aes1,Pitch
T.aes2,Pitch
T.fes3,Pitch
T.ees4]
    ,[Pitch
T.aes1,Pitch
T.fes2,Pitch
T.des4,Pitch
T.ees4] -- S5
    ,[Pitch
T.ges2,Pitch
T.aes2,Pitch
T.aes3,Pitch
T.d4]
    ,[Pitch
T.aes1,Pitch
T.d2,Pitch
T.aes3,Pitch
T.ees4]
    ,[Pitch
T.aes2,Pitch
T.fes3,Pitch
T.d4] -- S6
    ,[Pitch
T.aes1,Pitch
T.fes2,Pitch
T.des4,Pitch
T.ees4]
    ,[Pitch
T.aes1,Pitch
T.fes2,Pitch
T.des4,Pitch
T.ees4] -- S7
    ,[Pitch
T.aes1,Pitch
T.ges2,Pitch
T.aes3,Pitch
T.ees4]
    ,[Pitch
T.aes1,Pitch
T.ges2,Pitch
T.aes3,Pitch
T.ees4] -- S8
    ,[Pitch
T.aes1,Pitch
T.d2,Pitch
T.aes3,Pitch
T.ees4]
    ]

-- > sum (map snd (concat dr_ratio_seq)) == 20 * 11
-- > map (sum . map snd) dr_ratio_seq == replicate 20 11
dr_ratio_seq :: Num n => [[(n,n)]]
dr_ratio_seq :: forall n. Num n => [[(n, n)]]
dr_ratio_seq =
    [[(n
11,n
3),(n
2,n
2),(n
6,n
6)]
    ,[(n
7,n
2),(n
7,n
7),(n
6,n
2)]
    ,[(n
6,n
9),(n
2,n
2)]
    ,[(n
2,n
9),(n
11,n
2)]
    ,[(n
10,n
5),(n
10,n
3),(n
10,n
3)]
    ,[(n
10,n
10),(n
5,n
1)]
    ,[(n
5,n
7),(n
11,n
4)]
    ,[(n
11,n
3),(n
8,n
8)]
    ,[(n
8,n
8),(n
10,n
3)] -- p2
    ,[(n
10,n
7),(n
10,n
4)]
    ,[(n
10,n
4),(n
3,n
3),(n
4,n
4)]
    ,[(n
4,n
3),(n
9,n
7),(n
5,n
1)]
    ,[(n
7,n
7),(n
7,n
4)]
    ,[(n
9,n
9),(n
9,n
2)]
    ,[(n
9,n
7),(n
7,n
4)]
    ,[(n
7,n
3),(n
9,n
4),(n
7,n
4)]
    ,[(n
5,n
3),(n
4,n
4),(n
6,n
1),(n
4,n
3)]
    ,[(n
4,n
4),(n
7,n
7)]
    ,[(n
7,n
2),(n
5,n
8),(n
8,n
1)]
    ,[(n
8,n
1),(n
1,n
10)]
    ]

-- > import Data.Function {- base -}
-- > import Data.List {- base -}
-- > reverse (sortBy (compare `on` snd) dr_ratio_seq_hist)
dr_ratio_seq_hist :: (Ord n,Num n) => [((n,n),Int)]
dr_ratio_seq_hist :: forall n. (Ord n, Num n) => [((n, n), Int)]
dr_ratio_seq_hist = forall a. Ord a => [a] -> [(a, Int)]
T.histogram (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall n. Num n => [[(n, n)]]
dr_ratio_seq)

dr_nt :: Integral i => [([i],[i])]
dr_nt :: forall i. Integral i => [([i], [i])]
dr_nt =
    [([i
1,i
7,i
8,i
17],[i
12,i
13,i
15,i
17])
    ,([i
1,i
6,i
10,i
17],[i
6,i
10,i
9])]

-- > map (T.bimap1 (map T.pitch_pp) . dr_nt_pitch) dr_nt
dr_nt_pitch :: ([Int], [Int]) -> ([T.Pitch], [T.Pitch])
dr_nt_pitch :: ([Int], [Int]) -> ([Pitch], [Pitch])
dr_nt_pitch =
    let f :: Int -> Pitch
f Int
k = forall a b c d e. (a, b, c, d, e) -> b
T.p5_snd ([HS_R Pitch]
dr_scale_tbl_24et forall a. [a] -> Int -> a
!! (Int
k forall a. Num a => a -> a -> a
- Int
1))
    in forall t u. (t -> u) -> (t, t) -> (u, u)
T.bimap1 (forall a b. (a -> b) -> [a] -> [b]
map Int -> Pitch
f)

{-

-- from harmonic series
hs :: Num n => [(n,n)]
hs = [(1,1),(9,8),(5,4),(11,8),(3,2),(7,4)]

-- from subharmonic series
shs :: Num n => [(n,n)]
shs = [(8,7),(16,11),(8,5),(16,9)]

-}