-- | Clarence Barlow. \"Two Essays on Theory\".
-- /Computer Music Journal/, 11(1):44-60, 1987.
-- Translated by Henning Lohner.
module Music.Theory.Interval.Barlow_1987 where

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

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

-- | Barlow's /indigestibility/ function for prime numbers.
--
-- > map barlow [1,2,3,5,7,11,13] == [0,1,8/3,32/5,72/7,200/11,288/13]
barlow :: (Integral a,Fractional b) => a -> b
barlow :: forall a b. (Integral a, Fractional b) => a -> b
barlow a
p =
    let p' :: b
p' = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
p
        square :: a -> a
square a
n = a
n forall a. Num a => a -> a -> a
* a
n
    in b
2 forall a. Num a => a -> a -> a
* (forall {a}. Num a => a -> a
square (b
p' forall a. Num a => a -> a -> a
- b
1) forall a. Fractional a => a -> a -> a
/ b
p')

-- | Compute the disharmonicity of the interval /(p,q)/ using the
-- prime valuation function /pv/.
--
-- > map (disharmonicity barlow) [(9,10),(8,9)] == ([12 + 11/15,8 + 1/3] :: [Rational])
disharmonicity :: (Integral a,Num b) => (a -> b) -> (a,a) -> b
disharmonicity :: forall a b. (Integral a, Num b) => (a -> b) -> (a, a) -> b
disharmonicity a -> b
pv (a
p,a
q) =
    let n :: [(a, Int)]
n = forall i. Integral i => (i, i) -> [(i, Int)]
T.rat_prime_factors_m (a
p,a
q)
    in forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [forall {a}. Num a => a -> a
abs (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j) forall a. Num a => a -> a -> a
* a -> b
pv a
i | (a
i,Int
j) <- [(a, Int)]
n]

-- | The reciprocal of 'disharmonicity'.
--
-- > map (harmonicity barlow) [(9,10),(8,9),(2,1)] == ([15/191,3/25,1] :: [Rational])
harmonicity :: (Integral a,Fractional b) => (a -> b) -> (a,a) -> b
harmonicity :: forall a b. (Integral a, Fractional b) => (a -> b) -> (a, a) -> b
harmonicity a -> b
pv = forall a. Fractional a => a -> a
recip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => (a -> b) -> (a, a) -> b
disharmonicity a -> b
pv

harmonicity_m :: (Eq b,Integral a,Fractional b) => (a -> b) -> (a,a) -> Maybe b
harmonicity_m :: forall b a.
(Eq b, Integral a, Fractional b) =>
(a -> b) -> (a, a) -> Maybe b
harmonicity_m a -> b
pv = forall a. (Eq a, Fractional a) => a -> Maybe a
T.recip_m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => (a -> b) -> (a, a) -> b
disharmonicity a -> b
pv

-- | Variant of 'harmonicity' with 'Ratio' input.
--
-- > harmonicity_r barlow 1 == 1/0
harmonicity_r :: (Integral a,Fractional b) => (a -> b) -> Ratio a -> b
harmonicity_r :: forall a b. (Integral a, Fractional b) => (a -> b) -> Ratio a -> b
harmonicity_r a -> b
pv = forall a b. (Integral a, Fractional b) => (a -> b) -> (a, a) -> b
harmonicity a -> b
pv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Integral t => Ratio t -> (t, t)
T.rational_nd

-- | Variant of 'harmonicity_r' with output in (0,100), infinity maps to 100.
harmonicity_r_100 :: (RealFrac b, Integral a) => (a -> b) -> Ratio a -> Int
harmonicity_r_100 :: forall b a. (RealFrac b, Integral a) => (a -> b) -> Ratio a -> Int
harmonicity_r_100 a -> b
pv Ratio a
x =
  case forall b a.
(Eq b, Integral a, Fractional b) =>
(a -> b) -> (a, a) -> Maybe b
harmonicity_m a -> b
pv (forall t. Integral t => Ratio t -> (t, t)
T.rational_nd Ratio a
x) of
    Maybe b
Nothing -> Int
100
    Just b
y -> forall a b. (RealFrac a, Integral b) => a -> b
round (b
y forall a. Num a => a -> a -> a
* b
100)

-- | Set of 1. interval size (cents), 2. intervals as product of
-- powers of primes, 3. frequency ratio and 4. harmonicity value.
type Table_2_Row = (Double,[Int],Rational,Double)

-- | Given ratio /r/ generate 'Table_2_Row'
mk_table_2_row :: Rational -> Table_2_Row
mk_table_2_row :: Rational -> Table_2_Row
mk_table_2_row Rational
r =
  (forall r n. (Real r, Floating n) => r -> n
T.fratio_to_cents Rational
r
  ,forall i. (Integral i, Show i) => Int -> (i, i) -> [Int]
T.rat_prime_factors_t Int
6 (forall t. Integral t => Ratio t -> (t, t)
T.rational_nd Rational
r)
  ,Rational
r
  ,forall a b. (Integral a, Fractional b) => (a -> b) -> Ratio a -> b
harmonicity_r forall a b. (Integral a, Fractional b) => a -> b
barlow Rational
r)

-- | Table 2 (p.45)
--
-- > length (table_2 0.06) == 24
-- > length (table_2 0.04) == 66
table_2 :: Double -> [Table_2_Row]
table_2 :: Double -> [Table_2_Row]
table_2 Double
z =
    let g :: a -> Bool
g a
n = a
n forall a. Ord a => a -> a -> Bool
<= a
2 Bool -> Bool -> Bool
&& a
n forall a. Ord a => a -> a -> Bool
>= a
1
        r :: [Rational]
r = forall a. Eq a => [a] -> [a]
nub (forall a. Ord a => [a] -> [a]
sort (forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. (Ord a, Num a) => a -> Bool
g [Integer
p forall a. Integral a => a -> a -> Ratio a
% Integer
q | Integer
p <- [Integer
1..Integer
81],Integer
q <- [Integer
1..Integer
81]]))
        f :: (a, b, c, Double) -> Bool
f (a
_,b
_,c
_,Double
h) = Double
h forall a. Ord a => a -> a -> Bool
> Double
z
    in forall a. (a -> Bool) -> [a] -> [a]
filter forall {a} {b} {c}. (a, b, c, Double) -> Bool
f (forall a b. (a -> b) -> [a] -> [b]
map Rational -> Table_2_Row
mk_table_2_row [Rational]
r)

{- | Pretty printer for 'Table_2_Row' values.

> mapM_ (putStrLn . table_2_pp) (table_2 0.06)

> >    0.000 |  0  0  0  0  0  0 |  1:1  | Infinity
> >  111.731 |  4 -1 -1  0  0  0 | 15:16 | 0.076531
> >  182.404 |  1 -2  1  0  0  0 |  9:10 | 0.078534
> >  203.910 | -3  2  0  0  0  0 |  8:9  | 0.120000
> >  231.174 |  3  0  0 -1  0  0 |  7:8  | 0.075269
> >  266.871 | -1 -1  0  1  0  0 |  6:7  | 0.071672
> >  294.135 |  5 -3  0  0  0  0 | 27:32 | 0.076923
> >  315.641 |  1  1 -1  0  0  0 |  5:6  | 0.099338
> >  386.314 | -2  0  1  0  0  0 |  4:5  | 0.119048
> >  407.820 | -6  4  0  0  0  0 | 64:81 | 0.060000
> >  435.084 |  0  2  0 -1  0  0 |  7:9  | 0.064024
> >  498.045 |  2 -1  0  0  0  0 |  3:4  | 0.214286
> >  519.551 | -2  3 -1  0  0  0 | 20:27 | 0.060976
> >  701.955 | -1  1  0  0  0  0 |  2:3  | 0.272727
> >  764.916 |  1 -2  0  1  0  0 |  9:14 | 0.060172
> >  813.686 |  3  0 -1  0  0  0 |  5:8  | 0.106383
> >  884.359 |  0 -1  1  0  0  0 |  3:5  | 0.110294
> >  905.865 | -4  3  0  0  0  0 | 16:27 | 0.083333
> >  933.129 |  2  1  0 -1  0  0 |  7:12 | 0.066879
> >  968.826 | -2  0  0  1  0  0 |  4:7  | 0.081395
> >  996.090 |  4 -2  0  0  0  0 |  9:16 | 0.107143
> > 1017.596 |  0  2 -1  0  0  0 |  5:9  | 0.085227
> > 1088.269 | -3  1  1  0  0  0 |  8:15 | 0.082873
> > 1200.000 |  1  0  0  0  0  0 |  1:2  | 1.000000
-}
table_2_pp :: Table_2_Row -> String
table_2_pp :: Table_2_Row -> String
table_2_pp (Double
i,[Int]
j,Rational
k,Double
l) =
    let i' :: String
i' = forall r. PrintfType r => String -> r
printf String
"%8.3f" Double
i
        j' :: String
j' = [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map (forall r. PrintfType r => String -> r
printf String
"%2d") [Int]
j)
        k' :: String
k' = let (Integer
p,Integer
q) = forall t. Integral t => Ratio t -> (t, t)
T.rational_nd Rational
k in forall r. PrintfType r => String -> r
printf String
"%2d:%-2d" Integer
q Integer
p
        l' :: String
l' = forall r. PrintfType r => String -> r
printf String
"%1.6f" Double
l
    in forall a. [a] -> [[a]] -> [a]
intercalate String
" | " [String
i',String
j',String
k',String
l']