-- | Zwicker, E. (1961) "Subdivision of the audible frequency range into critical bands"
--   The Journal of the Acoustical Society of America, Volume 33, Issue 2, p. 248 (1961)
--
-- <https://ccrma.stanford.edu/courses/120-fall-2003/lecture-5.html>
module Music.Theory.Pitch.Bark where

-- * TABLES

-- | Center freqencies of Bark scale critical bands (hz).
bark_center :: Num n => [n]
bark_center :: forall n. Num n => [n]
bark_center =
  [n
50,n
150,n
250,n
350,n
450,n
570,n
700,n
840,n
1000,n
1170
  ,n
1370,n
1600,n
1850,n
2150,n
2500,n
2900,n
3400,n
4000,n
4800,n
5800
  ,n
7000,n
8500,n
10500,n
13500]

-- | Edge freqencies of Bark scale critical bands (hz).
bark_edge :: Num n => [n]
bark_edge :: forall n. Num n => [n]
bark_edge =
  [n
0,n
100,n
200,n
300,n
400,n
510,n
630,n
770,n
920,n
1080,n
1270
  ,n
1480,n
1720,n
2000,n
2320,n
2700,n
3150,n
3700,n
4400,n
5300,n
6400
  ,n
7700,n
9500,n
12000,n
15500]

-- | Bandwidths of Bark scale critical bands (hz).
bark_bandwidth :: Num n => [n]
bark_bandwidth :: forall n. Num n => [n]
bark_bandwidth = let c :: [n]
c = forall n. Num n => [n]
bark_edge in forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) (forall a. [a] -> [a]
tail [n]
c) [n]
c

-- * FUNCTIONS

-- | Zwicker & Terhardt (1980)
--
-- > map (round . cps_to_bark_zwicker) bark_centre == concat [[0..7],[9..15],[15..19],[21..24]]
-- > let f = [0,100 .. 8000] in Sound.SC3.Plot.plot_p2_ln [zip f (map cps_to_bark_zwicker f)]
cps_to_bark_zwicker :: Floating a => a -> a
cps_to_bark_zwicker :: forall a. Floating a => a -> a
cps_to_bark_zwicker a
x = a
13 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
atan (a
0.00076 forall a. Num a => a -> a -> a
* a
x) forall a. Num a => a -> a -> a
+ a
3.5 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
atan ((a
x forall a. Fractional a => a -> a -> a
/ a
7500) forall a. Floating a => a -> a -> a
** a
2)

-- | Traunmüller, Hartmut.
--   "Analytical Expressions for the Tonotopic Sensory Scale."
--   Journal of the Acoustical Society of America. Vol. 88, Issue 1, 1990, pp. 97-100.
--
-- > r = concat [[0,1],[3,4],[4],[6..9],[9,10],[12],[12..17],[19,20],[20..23]]
-- > map (round . cps_to_bark_traunmuller) bark_centre == r
-- > let f = [0,100 .. 8000] in Sound.SC3.Plot.plot_p2_ln [zip f (map cps_to_bark_traunmuller f)]
cps_to_bark_traunmuller :: (Fractional n,Ord n) => n -> n
cps_to_bark_traunmuller :: forall n. (Fractional n, Ord n) => n -> n
cps_to_bark_traunmuller n
x =
  let y :: n
y = ((n
26.81 forall a. Num a => a -> a -> a
* n
x) forall a. Fractional a => a -> a -> a
/ (n
1960 forall a. Num a => a -> a -> a
+ n
x)) forall a. Num a => a -> a -> a
- n
0.53
  in if n
y forall a. Ord a => a -> a -> Bool
< n
2 then n
y forall a. Num a => a -> a -> a
+ n
0.15 forall a. Num a => a -> a -> a
* (n
2 forall a. Num a => a -> a -> a
- n
y) else if n
y forall a. Ord a => a -> a -> Bool
> n
20.1 then n
y forall a. Num a => a -> a -> a
+ n
0.22 forall a. Num a => a -> a -> a
* (n
y forall a. Num a => a -> a -> a
- n
20.1) else n
y

-- | Traunmüller (1990)
--
-- > Sound.SC3.Plot.plot_p2_ln [zip (map bark_to_cps_traunmuller [0..23]) [0..23]]
bark_to_cps_traunmuller :: (Fractional n,Ord n) => n -> n
bark_to_cps_traunmuller :: forall n. (Fractional n, Ord n) => n -> n
bark_to_cps_traunmuller n
y =
  let f :: a -> a
f a
x = a
1960 forall a. Num a => a -> a -> a
* ((a
x forall a. Num a => a -> a -> a
+ a
0.53) forall a. Fractional a => a -> a -> a
/ (a
26.28 forall a. Num a => a -> a -> a
- a
x))
  in if n
y forall a. Ord a => a -> a -> Bool
< n
2 then forall {a}. Fractional a => a -> a
f ((n
y forall a. Num a => a -> a -> a
- n
0.3) forall a. Fractional a => a -> a -> a
/ n
0.85) else if n
y forall a. Ord a => a -> a -> Bool
> n
20.1 then forall {a}. Fractional a => a -> a
f ((n
y forall a. Num a => a -> a -> a
+ n
4.422) forall a. Fractional a => a -> a -> a
/ n
1.22) else forall {a}. Fractional a => a -> a
f n
y

-- | Wang, Sekey & Gersho (1992)
--
-- > map (round . cps_to_bark_wsg) bark_centre == concat [[0..9],[9..21],[23]]
-- > let f = [0,100 .. 8000] in Sound.SC3.Plot.plot_p2_ln [zip f (map cps_to_bark_wsg f)]
cps_to_bark_wsg :: Floating a => a -> a
cps_to_bark_wsg :: forall a. Floating a => a -> a
cps_to_bark_wsg a
x = a
6 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
asinh (a
x forall a. Fractional a => a -> a -> a
/ a
600)

-- | Wang, Sekey & Gersho (1992)
--
-- > r = [100,204,313,430,560,705,870,1059,1278,1532,1828,2176,2584,3065,3630,4297,5083,6011,7106,8399]
-- > map (round . bark_to_cps_wsg) [1 .. 20] == r
-- > Sound.SC3.Plot.plot_p2_ln [zip (map bark_to_cps_wsg [0..23]) [0..23]]
bark_to_cps_wsg :: Floating a => a -> a
bark_to_cps_wsg :: forall a. Floating a => a -> a
bark_to_cps_wsg a
x = a
600 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sinh (a
x forall a. Fractional a => a -> a -> a
/ a
6)