-- | William A. Sethares.
-- "Adaptive Tunings for Musical Scales".
-- /Journal of the Acoustical Society of America/, 96(1), July 1994.
module Music.Theory.Tuning.Sethares_1994 where

import Data.Maybe {- base -}

import qualified Music.Theory.Tuning as T {- hmt -}

{- | Plomp-Levelt consonance curve.

R. Plomp and W. J. M. Levelt,
"Tonal Consonance and Critical Bandwidth,"
Journal of the Acoustical Society of America.38, 548-560 (1965).

"Relating Tuning and Timbre" <http://sethares.engr.wisc.edu/consemi.html>
MATLAB: <https://sethares.engr.wisc.edu/comprog.html>

> import Sound.SC3.Plot {- hsc3-plot -}
> plot_p1_ln [map (\f -> pl_dissonance (220,1) (f,1)) [220 .. 440]]
-}
pl_dissonance :: (Floating n, Ord n) => (n,n) -> (n,n) -> n
pl_dissonance :: forall n. (Floating n, Ord n) => (n, n) -> (n, n) -> n
pl_dissonance (n
f1,n
v1) (n
f2,n
v2) =
    let d_star :: n
d_star = n
0.24
        s1 :: n
s1 = n
0.0207
        s2 :: n
s2 = n
18.96
        c1 :: n
c1 = n
5
        c2 :: n
c2 = -n
5
        a1 :: n
a1 = -n
3.51
        a2 :: n
a2 = -n
5.75
        s :: n
s = n
d_star forall a. Fractional a => a -> a -> a
/ (n
s1 forall a. Num a => a -> a -> a
* forall a. Ord a => a -> a -> a
min n
f1 n
f2 forall a. Num a => a -> a -> a
+ n
s2)
        f_dif :: n
f_dif = forall a. Num a => a -> a
abs (n
f2 forall a. Num a => a -> a -> a
- n
f1)
        e1 :: n
e1 = n
c1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
exp (n
a1 forall a. Num a => a -> a -> a
* n
s forall a. Num a => a -> a -> a
* n
f_dif)
        e2 :: n
e2 = n
c2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
exp (n
a2 forall a. Num a => a -> a -> a
* n
s forall a. Num a => a -> a -> a
* n
f_dif)
    in n
v1 forall a. Num a => a -> a -> a
* n
v2 forall a. Num a => a -> a -> a
* (n
e1 forall a. Num a => a -> a -> a
+ n
e2)

-- | Sum of 'pl_dissonance' for all p in s1 and all q in s2.
pl_dissonance_h :: (Floating n, Ord n) => [(n,n)] -> [(n,n)] -> n
pl_dissonance_h :: forall n. (Floating n, Ord n) => [(n, n)] -> [(n, n)] -> n
pl_dissonance_h [(n, n)]
s1 [(n, n)]
s2 = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [forall n. (Floating n, Ord n) => (n, n) -> (n, n) -> n
pl_dissonance (n, n)
p (n, n)
q | (n, n)
p <- [(n, n)]
s1, (n, n)
q <- [(n, n)]
s2]

-- | Return local minima of sequence with index.
local_minima :: Ord t => [t] -> [(Int,t)]
local_minima :: forall t. Ord t => [t] -> [(Int, t)]
local_minima =
  let f :: (a, b, b, b) -> Maybe (a, b)
f (a
ix,b
i,b
j,b
k) = if b
j forall a. Ord a => a -> a -> Bool
<= b
i Bool -> Bool -> Bool
&& b
j forall a. Ord a => a -> a -> Bool
<= b
k then forall a. a -> Maybe a
Just (a
ix,b
j) else forall a. Maybe a
Nothing
      triples :: t -> [a] -> [(t, a, a, a)]
triples t
ix [a]
l = case [a]
l of
                       a
i:a
j:a
k:[a]
_ -> (t
ix,a
i,a
j,a
k) forall a. a -> [a] -> [a]
: t -> [a] -> [(t, a, a, a)]
triples (t
ix forall a. Num a => a -> a -> a
+ t
1) (forall a. [a] -> [a]
tail [a]
l)
                       [a]
_ -> []
  in forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {b} {a}. Ord b => (a, b, b, b) -> Maybe (a, b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {a}. Num t => t -> [a] -> [(t, a, a, a)]
triples Int
1

-- | William A. Sethares "Adaptive Tunings for Musical Scales".
--
-- > plot_p1_ln atms_fig_1
atms_fig_1 :: (Floating n,Enum n,Ord n) => [[n]]
atms_fig_1 :: forall n. (Floating n, Enum n, Ord n) => [[n]]
atms_fig_1 =
    let f0 :: [n]
f0 = [n
125,n
250,n
500,n
1000,n
2000]
        r_seq :: [n]
r_seq = forall a b. (a -> b) -> [a] -> [b]
map forall a. Floating a => a -> a
T.cents_to_fratio [n
0 .. n
1200]
    in forall a b. (a -> b) -> [a] -> [b]
map (\n
f -> forall a b. (a -> b) -> [a] -> [b]
map (\n
r -> forall n. (Floating n, Ord n) => (n, n) -> (n, n) -> n
pl_dissonance (n
f,n
1) (n
f forall a. Num a => a -> a -> a
* n
r,n
1)) [n]
r_seq) [n]
f0

-- > plot_p1_ln [atms_fig_2 880]
-- > map fst (local_minima (atms_fig_2 880)) == [204,231,267,316,386,435,498,583,702,814,884,969,1018]
atms_fig_2 :: (Ord t, Floating t, Enum t) => t -> [t]
atms_fig_2 :: forall t. (Ord t, Floating t, Enum t) => t -> [t]
atms_fig_2 t
f0 =
  let gen :: a -> [(a, b)]
gen a
fq = forall a b. (a -> b) -> [a] -> [b]
map (\a
r -> (a
fq forall a. Num a => a -> a -> a
* a
r,b
1)) [a
1 .. a
9]
      r_seq :: [t]
r_seq = forall a b. (a -> b) -> [a] -> [b]
map forall a. Floating a => a -> a
T.cents_to_fratio [t
0,t
1 .. t
1200]
  in forall a b. (a -> b) -> [a] -> [b]
map (\t
r -> forall n. (Floating n, Ord n) => [(n, n)] -> [(n, n)] -> n
pl_dissonance_h (forall {a} {b}. (Num a, Num b, Enum a) => a -> [(a, b)]
gen t
f0) (forall {a} {b}. (Num a, Num b, Enum a) => a -> [(a, b)]
gen (t
f0 forall a. Num a => a -> a -> a
* t
r))) [t]
r_seq

-- > Sound.SC3.Plot.plot_p1_ln [atms_fig_3 880]
-- > map fst (local_minima (atms_fig_3 880)) == [267,400,533,667,800,933,1043]
atms_fig_3 :: (Ord t, Floating t, Enum t) => t -> [t]
atms_fig_3 :: forall t. (Ord t, Floating t, Enum t) => t -> [t]
atms_fig_3 t
f0 =
  let b :: t
b = t
2 forall a. Floating a => a -> a -> a
** (t
1forall a. Fractional a => a -> a -> a
/t
9)
      gen :: t -> [(t, b)]
gen t
fq = forall a b. (a -> b) -> [a] -> [b]
map (\t
r -> (t
fq forall a. Num a => a -> a -> a
* t
r,b
1)) (t
1 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (t
b forall a. Floating a => a -> a -> a
**) [t
9,t
14,t
18,t
21,t
25,t
27,t
30])
      r_seq :: [t]
r_seq = forall a b. (a -> b) -> [a] -> [b]
map forall a. Floating a => a -> a
T.cents_to_fratio [t
0,t
1 .. t
1200]
  in forall a b. (a -> b) -> [a] -> [b]
map (\t
r -> forall n. (Floating n, Ord n) => [(n, n)] -> [(n, n)] -> n
pl_dissonance_h (forall {b}. Num b => t -> [(t, b)]
gen t
f0) (forall {b}. Num b => t -> [(t, b)]
gen (t
f0 forall a. Num a => a -> a -> a
* t
r))) [t]
r_seq

-- | "Relating Tuning and Timbre" <http://sethares.engr.wisc.edu/consemi.html>
--
-- > plot_p1_ln [rtt_fig_2 880]
-- > map fst (local_minima (rtt_fig_2 880)) == [267,316,386,498,582,702,884,969]
rtt_fig_2 :: (Ord t, Floating t, Enum t) => t -> [t]
rtt_fig_2 :: forall t. (Ord t, Floating t, Enum t) => t -> [t]
rtt_fig_2 t
f0 =
  let a_seq :: [t]
a_seq = forall a. Int -> [a] -> [a]
take Int
7 (forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
* t
0.88) t
1.0)
      gen :: a -> [(a, t)]
gen a
fq = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
r t
a -> (a
fq forall a. Num a => a -> a -> a
* a
r,t
a)) [a
1 .. a
7] [t]
a_seq
      r_seq :: [t]
r_seq = forall a b. (a -> b) -> [a] -> [b]
map forall a. Floating a => a -> a
T.cents_to_fratio [t
0,t
1 .. t
1200]
  in forall a b. (a -> b) -> [a] -> [b]
map (\t
r -> forall n. (Floating n, Ord n) => [(n, n)] -> [(n, n)] -> n
pl_dissonance_h (forall {a}. (Num a, Enum a) => a -> [(a, t)]
gen t
f0) (forall {a}. (Num a, Enum a) => a -> [(a, t)]
gen (t
f0 forall a. Num a => a -> a -> a
* t
r))) [t]
r_seq