-- Hoogle documentation, generated by Haddock
-- See Hoogle, http://www.haskell.org/hoogle/
-- | Haskell Music Theory
--
@package hmt
@version 0.15
-- | Robert Morris and D. Starr. "The Structure of All-Interval Series".
-- Journal of Music Theory, 18:364-389, 1974.
module Music.Theory.Z12.Morris_1974
-- | msum . map return.
--
--
-- observeAll (fromList [1..7]) == [1..7]
--
fromList :: MonadPlus m => [a] -> m a
-- | MonadPlus all-interval series.
--
--
-- [0,1,3,2,9,5,10,4,7,11,8,6] `elem` observeAll (all_interval_m 12)
-- length (observeAll (all_interval_m 12)) == 3856
-- map (length . observeAll . all_interval_m) [4,6,8,10] == [2,4,24,288]
--
all_interval_m :: MonadPlus m => Int -> m [Int]
-- | observeAll of all_interval_m.
--
--
-- let r = [[0,1,5,2,4,3],[0,2,1,4,5,3],[0,4,5,2,1,3],[0,5,1,4,2,3]]
-- in all_interval 6 == r
--
all_interval :: Int -> [[Int]]
-- | Z12 set class database.
module Music.Theory.Z12.Literature
-- | Set class database with descriptors for historically and theoretically
-- significant set classes, indexed by Forte name.
--
--
-- lookup "6-Z17" sc_db == Just "All-Trichord Hexachord"
-- lookup "7-35" sc_db == Just "diatonic collection (d)"
--
sc_db :: [(String, String)]
-- | Generalised Z-n functions.
module Music.Theory.Z
lift_unary_Z :: Integral a => a -> (t -> a) -> t -> a
lift_binary_Z :: Integral a => a -> (s -> t -> a) -> s -> t -> a
z_add :: Integral a => a -> a -> a -> a
z_sub :: Integral a => a -> a -> a -> a
z_mul :: Integral a => a -> a -> a -> a
z_negate :: Integral a => a -> a -> a
z_fromInteger :: Integral a => a -> Integer -> a
z_signum :: t -> t1 -> t2
z_abs :: t -> t1 -> t2
to_Z :: Integral i => i -> i -> i
from_Z :: (Integral i, Num n) => i -> n
-- | Z not in set.
--
--
-- z_complement 5 [0,2,3] == [1,4]
-- z_complement 12 [0,2,4,5,7,9,11] == [1,3,6,8,10]
--
z_complement :: (Enum a, Eq a, Num a) => a -> [a] -> [a]
z_quot :: Integral i => i -> i -> i -> i
z_rem :: Integral c => c -> c -> c -> c
z_div :: Integral c => c -> c -> c -> c
z_mod :: Integral c => c -> c -> c -> c
z_quotRem :: Integral t => t -> t -> t -> (t, t)
z_divMod :: Integral t => t -> t -> t -> (t, t)
z_toInteger :: Integral i => i -> i -> i
-- | Serial (ordered) pitch-class operations on Z.
module Music.Theory.Z.SRO
-- | Transpose p by n.
--
--
-- tn 5 4 [0,1,4] == [4,0,3]
-- tn 12 4 [1,5,6] == [5,9,10]
--
tn :: (Integral i, Functor f) => i -> i -> f i -> f i
-- | Invert p about n.
--
--
-- invert 5 0 [0,1,4] == [0,4,1]
-- invert 12 6 [4,5,6] == [8,7,6]
-- invert 12 0 [0,1,3] == [0,11,9]
--
invert :: (Integral i, Functor f) => i -> i -> f i -> f i
-- | Composition of invert about 0 and tn.
--
--
-- tni 5 1 [0,1,3] == [1,0,3]
-- tni 12 4 [1,5,6] == [3,11,10]
-- (invert 12 0 . tn 12 4) [1,5,6] == [7,3,2]
--
tni :: (Integral i, Functor f) => i -> i -> f i -> f i
-- | Modulo multiplication.
--
--
-- mn 12 11 [0,1,4,9] == tni 12 0 [0,1,4,9]
--
mn :: (Integral i, Functor f) => i -> i -> f i -> f i
-- | T-related sequences of p.
--
--
-- length (t_related 12 [0,3,6,9]) == 12
--
t_related :: (Integral i, Functor f) => i -> f i -> [f i]
-- | T/I-related sequences of p.
--
--
-- length (ti_related 12 [0,1,3]) == 24
-- length (ti_related 12 [0,3,6,9]) == 24
-- ti_related 12 [0] == map return [0..11]
--
ti_related :: (Eq (f i), Integral i, Functor f) => i -> f i -> [f i]
-- | R/T/I-related sequences of p.
--
--
-- length (rti_related 12 [0,1,3]) == 48
-- length (rti_related 12 [0,3,6,9]) == 24
--
rti_related :: Integral i => i -> [i] -> [[i]]
-- | Variant of tn, transpose p so first element is n.
--
--
-- tn_to 12 5 [0,1,3] == [5,6,8]
-- map (tn_to 12 0) [[0,1,3],[1,3,0],[3,0,1]]
--
tn_to :: Integral a => a -> a -> [a] -> [a]
-- | Variant of invert, inverse about nth element.
--
--
-- map (invert_ix 12 0) [[0,1,3],[3,4,6]] == [[0,11,9],[3,2,0]]
-- map (invert_ix 12 1) [[0,1,3],[3,4,6]] == [[2,1,11],[5,4,2]]
--
invert_ix :: Integral i => i -> Int -> [i] -> [i]
-- | The standard t-matrix of p.
--
--
-- tmatrix 12 [0,1,3] == [[0,1,3]
-- ,[11,0,2]
-- ,[9,10,0]]
--
tmatrix :: Integral i => i -> [i] -> [[i]]
-- | Ronald C. Read. "Every one a winner or how to avoid isomorphism search
-- when cataloguing combinatorial configurations." /Annals of Discrete
-- Mathematics/ 2:107–20, 1978.
module Music.Theory.Z.Read_1978
-- | Coding.
type Code = Int
-- | Bit array.
type Array = [Bool]
-- | Pretty printer for Array.
array_pp :: Array -> String
-- | Parse PP of Array.
--
--
-- parse_array "01001" == [False,True,False,False,True]
--
parse_array :: String -> Array
-- | Generate Code from Array, the coding is most to least
-- significant.
--
--
-- array_to_code (map toEnum [1,1,0,0,1,0,0,0,1,1,1,0,0]) == 6428
--
array_to_code :: Array -> Code
-- | Inverse of array_to_code.
--
--
-- code_to_array 13 6428 == map toEnum [1,1,0,0,1,0,0,0,1,1,1,0,0]
--
code_to_array :: Int -> Code -> Array
-- | Array to set.
--
--
-- array_to_set (map toEnum [1,1,0,0,1,0,0,0,1,1,1,0,0]) == [0,1,4,8,9,10]
-- T.encode [0,1,4,8,9,10] == 1811
--
array_to_set :: Integral i => [Bool] -> [i]
-- | Inverse of array_to_set, z is the degree of the array.
set_to_array :: Integral i => i -> [i] -> Array
-- | array_to_code of set_to_array.
--
--
-- set_to_code 12 [0,2,3,5]
-- map (set_to_code 12) (T.ti_related 12 [0,2,3,5])
--
set_to_code :: Integral i => i -> [i] -> Code
-- | Logical complement.
array_complement :: Array -> Array
-- | The prime form is the maximum encoding.
--
--
-- array_is_prime (set_to_array 12 [0,2,3,5]) == False
--
array_is_prime :: Array -> Bool
-- | The augmentation rule adds 1 in each empty slot at end of
-- array.
--
--
-- map array_pp (array_augment (parse_array "01000")) == ["01100","01010","01001"]
--
array_augment :: Array -> [Array]
-- | Enumerate first half of the set-classes under given prime
-- function. The second half can be derived as the complement of the
-- first.
--
--
-- import Music.Theory.Z12.Forte_1973
-- length scs == 224
-- map (length . scs_n) [0..12] == [1,1,6,12,29,38,50,38,29,12,6,1,1]
--
--
--
-- let z12 = map (fmap (map array_to_set)) (enumerate_half array_is_prime 12)
-- map (length . snd) z12 == [1,1,6,12,29,38,50]
--
--
-- This can become slow, edit z to find out. It doesn't matter
-- about n. This can be edited so that small n would run
-- quickly even for large z.
--
--
-- fmap (map array_to_set) (lookup 5 (enumerate_half array_is_prime 16))
--
enumerate_half :: (Array -> Bool) -> Int -> [(Int, [Array])]
-- | Encoder for encode_prime.
--
--
-- encode [0,1,3,6,8,9] == 843
--
encode :: Integral i => [i] -> Code
-- | Decoder for encode_prime.
--
--
-- decode 12 843 == [0,1,3,6,8,9]
--
decode :: Integral i => i -> Code -> [i]
-- | Binary encoding prime form algorithm, equalivalent to Rahn.
--
--
-- encode_prime 12 [0,1,3,6,8,9] == [0,2,3,6,7,9]
-- Music.Theory.Z12.Rahn_1980.rahn_prime [0,1,3,6,8,9] == [0,2,3,6,7,9]
--
encode_prime :: Integral i => i -> [i] -> [i]
-- | http://www.unicode.org/charts/PDF/U1D100.pdf
module Music.Theory.Unicode
type Unicode_Table = [(Int, String)]
unicode :: [Unicode_Table]
accidentals :: Unicode_Table
notes :: Unicode_Table
rests :: Unicode_Table
clefs :: Unicode_Table
-- | Tuple functions.
--
-- Uniform tuples have types T2, T3 etc. and functions
-- names are prefixed t2_ etc.
--
-- Heterogenous tuples (products) are prefixed p2_ etc.
module Music.Theory.Tuple
p2_swap :: (s, t) -> (t, s)
-- | Uniform two-tuple.
type T2 a = (a, a)
t2 :: [t] -> T2 t
t2_list :: T2 a -> [a]
t2_swap :: T2 t -> T2 t
t2_map :: (p -> q) -> T2 p -> T2 q
t2_zipWith :: (p -> q -> r) -> T2 p -> T2 q -> T2 r
t2_infix :: (a -> a -> b) -> T2 a -> b
-- | Infix mappend.
--
--
-- t2_join ([1,2],[3,4]) == [1,2,3,4]
--
t2_join :: Monoid m => T2 m -> m
t2_concat :: [T2 [a]] -> T2 [a]
t2_sort :: Ord t => (t, t) -> (t, t)
-- | Left rotation.
--
--
-- p3_rotate_left (1,2,3) == (2,3,1)
--
p3_rotate_left :: (s, t, u) -> (t, u, s)
p3_fst :: (a, b, c) -> a
p3_snd :: (a, b, c) -> b
p3_third :: (a, b, c) -> c
type T3 a = (a, a, a)
t3 :: [t] -> T3 t
t3_rotate_left :: T3 t -> T3 t
t3_fst :: T3 t -> t
t3_snd :: T3 t -> t
t3_third :: T3 t -> t
t3_map :: (p -> q) -> T3 p -> T3 q
t3_zipWith :: (p -> q -> r) -> T3 p -> T3 q -> T3 r
t3_list :: T3 a -> [a]
t3_infix :: (a -> a -> a) -> T3 a -> a
t3_join :: T3 [a] -> [a]
p4_fst :: (a, b, c, d) -> a
p4_snd :: (a, b, c, d) -> b
p4_third :: (a, b, c, d) -> c
p4_fourth :: (a, b, c, d) -> d
type T4 a = (a, a, a, a)
t4 :: [t] -> T4 t
t4_list :: T4 t -> [t]
t4_fst :: T4 t -> t
t4_snd :: T4 t -> t
t4_third :: T4 t -> t
t4_fourth :: T4 t -> t
t4_map :: (p -> q) -> T4 p -> T4 q
t4_zipWith :: (p -> q -> r) -> T4 p -> T4 q -> T4 r
t4_infix :: (a -> a -> a) -> T4 a -> a
t4_join :: T4 [a] -> [a]
p5_fst :: (a, b, c, d, e) -> a
p5_snd :: (a, b, c, d, e) -> b
p5_third :: (a, b, c, d, e) -> c
p5_fourth :: (a, b, c, d, e) -> d
p5_fifth :: (a, b, c, d, e) -> e
type T5 a = (a, a, a, a, a)
t5 :: [t] -> T5 t
t5_list :: T5 t -> [t]
t5_map :: (p -> q) -> T5 p -> T5 q
t5_fst :: T5 t -> t
t5_snd :: T5 t -> t
t5_fourth :: T5 t -> t
t5_fifth :: T5 t -> t
t5_infix :: (a -> a -> a) -> T5 a -> a
t5_join :: T5 [a] -> [a]
p6_fst :: (a, b, c, d, e, f) -> a
p6_snd :: (a, b, c, d, e, f) -> b
p6_third :: (a, b, c, d, e, f) -> c
p6_fourth :: (a, b, c, d, e, f) -> d
p6_fifth :: (a, b, c, d, e, f) -> e
p6_sixth :: (a, b, c, d, e, f) -> f
type T6 a = (a, a, a, a, a, a)
t6 :: [t] -> T6 t
t6_list :: T6 t -> [t]
t6_map :: (p -> q) -> T6 p -> T6 q
type T7 a = (a, a, a, a, a, a, a)
t7_list :: T7 t -> [t]
t7_map :: (p -> q) -> T7 p -> T7 q
type T8 a = (a, a, a, a, a, a, a, a)
t8_list :: T8 t -> [t]
t8_map :: (p -> q) -> T8 p -> T8 q
type T9 a = (a, a, a, a, a, a, a, a, a)
t9_list :: T9 t -> [t]
t9_map :: (p -> q) -> T9 p -> T9 q
module Music.Theory.Time.Notation
-- | Fractional seconds.
type FSEC = Double
-- | Minutes, seconds as (min,sec)
type MINSEC = (Int, Int)
-- | Minutes, seconds, centi-seconds as (min,sec,csec)
type MINCSEC = (Int, Int, Int)
-- | Fractional seconds to (min,sec).
--
--
-- map fsec_to_minsec [59.49,60,60.51] == [(0,59),(1,0),(1,1)]
--
fsec_to_minsec :: FSEC -> MINSEC
-- | MINSEC pretty printer.
--
--
-- map (minsec_pp . fsec_to_minsec) [59,61] == ["00:59","01:01"]
--
minsec_pp :: MINSEC -> String
-- | Fractional seconds to (min,sec,csec).
--
--
-- map fsec_to_mincsec [1,1.5,4/3] == [(0,1,0),(0,1,50),(0,1,33)]
--
fsec_to_mincsec :: FSEC -> MINCSEC
-- | MINCSEC pretty printer.
--
--
-- map (mincsec_pp . fsec_to_mincsec) [1,4/3] == ["00:01.00","00:01.33"]
--
mincsec_pp :: MINCSEC -> String
span_pp :: (t -> String) -> (t, t) -> String
module Music.Theory.Time.Duration
-- | Duration stored as hours, minutes, seconds and
-- milliseconds.
data Duration
Duration :: Int -> Int -> Int -> Int -> Duration
hours :: Duration -> Int
minutes :: Duration -> Int
seconds :: Duration -> Int
milliseconds :: Duration -> Int
-- | Convert fractional seconds to integral
-- (seconds,milliseconds).
--
--
-- s_sms 1.75 == (1,750)
--
s_sms :: (RealFrac n, Integral i) => n -> (i, i)
-- | Inverse of s_sms.
--
--
-- sms_s (1,750) == 1.75
--
sms_s :: Integral i => (i, i) -> Double
-- | Read function for Duration tuple.
read_duration_tuple :: String -> (Int, Int, Int, Int)
-- | Read function for Duration. Allows either
-- H:M:S.MS or M:S.MS or S.MS.
--
--
-- read_duration "01:35:05.250" == Duration 1 35 5 250
-- read_duration "35:05.250" == Duration 0 35 5 250
-- read_duration "05.250" == Duration 0 0 5 250
--
read_duration :: String -> Duration
-- | Show function for Duration.
--
--
-- show_duration (Duration 1 35 5 250) == "01:35:05.250"
-- show (Duration 1 15 0 000) == "01:15:00.000"
--
show_duration :: Duration -> String
normalise_minutes :: Duration -> Duration
normalise_seconds :: Duration -> Duration
normalise_milliseconds :: Duration -> Duration
normalise_duration :: Duration -> Duration
-- | Extract Duration tuple applying filter function at each element
--
--
-- duration_tuple id (Duration 1 35 5 250) == (1,35,5,250)
--
duration_to_tuple :: (Int -> a) -> Duration -> (a, a, a, a)
-- | Inverse of duration_to_tuple.
tuple_to_duration :: (a -> Int) -> (a, a, a, a) -> Duration
duration_to_hours :: Fractional n => Duration -> n
duration_to_minutes :: Fractional n => Duration -> n
duration_to_seconds :: Fractional n => Duration -> n
hours_to_duration :: RealFrac a => a -> Duration
minutes_to_duration :: RealFrac a => a -> Duration
seconds_to_duration :: RealFrac a => a -> Duration
nil_duration :: Duration
negate_duration :: Duration -> Duration
duration_diff :: Duration -> Duration -> Duration
instance Eq Duration
instance Show Duration
instance Read Duration
module Music.Theory.Tiling.Canon
-- | Sequence.
type S = [Int]
-- | Canon of (period,sequence,multipliers,displacements).
type R = (Int, S, [Int], [Int])
-- | Voice.
type V = [Int]
-- | Tiling (sequence)
type T = [[Int]]
-- | Cycle at period.
--
--
-- take 9 (p_cycle 18 [0,2,5]) == [0,2,5,18,20,23,36,38,41]
--
p_cycle :: Int -> [Int] -> [Int]
-- | Element of (sequence,multiplier,displacement).
type E = (S, Int, Int)
-- | Resolve sequence from E.
--
--
-- e_to_seq ([0,2,5],2,1) == [1,5,11]
-- e_to_seq ([0,1],3,4) == [4,7]
-- e_to_seq ([0],1,2) == [2]
--
e_to_seq :: E -> [Int]
-- | Infer E from sequence.
--
--
-- e_from_seq [1,5,11] == ([0,2,5],2,1)
-- e_from_seq [4,7] == ([0,1],3,4)
-- e_from_seq [2] == ([0],1,2)
--
e_from_seq :: [Int] -> E
-- | Set of V from R.
r_voices :: R -> [V]
-- | concatMap of r_voices.
rr_voices :: [R] -> [V]
-- | Retrograde of T, the result T is sorted.
--
--
-- let r = [[0,7,14],[1,5,9],[2,4,6],[3,8,13],[10,11,12]]
-- in t_retrograde [[0,7,14],[1,6,11],[2,3,4],[5,9,13],[8,10,12]] == r
--
t_retrograde :: T -> T
-- | The normal form of T is the min of t and it's
-- t_retrograde.
--
--
-- let r = [[0,7,14],[1,5,9],[2,4,6],[3,8,13],[10,11,12]]
-- in t_normal [[0,7,14],[1,6,11],[2,3,4],[5,9,13],[8,10,12]] == r
--
t_normal :: T -> T
-- | Derive set of R from T.
--
--
-- let {r = [(21,[0,1,2],[10,8,2,4,7,5,1],[0,1,2,3,5,8,14])]
-- ;t = [[0,10,20],[1,9,17],[2,4,6],[3,7,11],[5,12,19],[8,13,18],[14,15,16]]}
-- in r_from_t t == r
--
r_from_t :: T -> [R]
-- | msum . map return.
--
--
-- observeAll (fromList [1..7]) == [1..7]
--
fromList :: MonadPlus m => [a] -> m a
-- | Search for perfect tilings of the sequence S using
-- multipliers from m to degree n with k parts.
perfect_tilings_m :: MonadPlus m => [S] -> [Int] -> Int -> Int -> m T
-- | t_normal of observeAll of perfect_tilings_m.
--
--
-- perfect_tilings [[0,1]] [1..3] 6 3 == []
--
--
--
-- let r = [[[0,7,14],[1,5,9],[2,4,6],[3,8,13],[10,11,12]]]
-- in perfect_tilings [[0,1,2]] [1,2,4,5,7] 15 5 == r
--
--
--
-- length (perfect_tilings [[0,1,2]] [1..12] 15 5) == 1
--
--
--
-- let r = [[[0,1],[2,5],[3,7],[4,6]]
-- ,[[0,1],[2,6],[3,5],[4,7]]
-- ,[[0,2],[1,4],[3,7],[5,6]]]
-- in perfect_tilings [[0,1]] [1..4] 8 4 == r
--
--
--
-- let r = [[[0,1],[2,5],[3,7],[4,9],[6,8]]
-- ,[[0,1],[2,7],[3,5],[4,8],[6,9]]
-- ,[[0,2],[1,4],[3,8],[5,9],[6,7]]
-- ,[[0,2],[1,5],[3,6],[4,9],[7,8]]
-- ,[[0,3],[1,6],[2,4],[5,9],[7,8]]]
-- in perfect_tilings [[0,1]] [1..5] 10 5 == r
--
--
-- Johnson 2004, p.2
--
--
-- let r = [[0,6,12],[1,8,15],[2,11,20],[3,5,7],[4,9,14],[10,13,16],[17,18,19]]
-- in perfect_tilings [[0,1,2]] [1,2,3,5,6,7,9] 21 7 == [r]
--
--
--
-- let r = [[0,10,20],[1,9,17],[2,4,6],[3,7,11],[5,12,19],[8,13,18],[14,15,16]]
-- in perfect_tilings [[0,1,2]] [1,2,4,5,7,8,10] 21 7 == [t_retrograde r]
--
perfect_tilings :: [S] -> [Int] -> Int -> Int -> [T]
-- | Variant of elem for ordered sequences, which can therefore
-- return False when searching infinite sequences.
--
--
-- 5 `elemOrd` [0,2..] == False && 10 `elemOrd` [0,2..] == True
--
elemOrd :: Ord a => a -> [a] -> Bool
-- | A .* diagram of n places of V.
--
--
-- v_dot_star 18 [0,2..] == "*.*.*.*.*.*.*.*.*."
--
v_dot_star :: Int -> V -> String
-- | A white space and index diagram of n places of V.
--
--
-- >>> mapM_ (putStrLn . v_space_ix 9) [[0,2..],[1,3..]]
-- >
-- > 0 2 4 6 8
-- > 1 3 5 7
--
v_space_ix :: Int -> V -> String
-- | Insert | every n places.
--
--
-- with_bars 6 (v_dot_star 18 [0,2..]) == "*.*.*.|*.*.*.|*.*.*."
--
with_bars :: Int -> String -> String
-- | Variant with measure length m and number of measures n.
--
--
-- v_dot_star_m 6 3 [0,2..] == "*.*.*.|*.*.*.|*.*.*."
--
v_dot_star_m :: Int -> Int -> V -> String
-- | Print .* diagram.
v_print :: Int -> [V] -> IO ()
-- | Variant to print | at measures.
v_print_m :: Int -> Int -> [V] -> IO ()
-- | Variant that discards first k measures.
v_print_m_from :: Int -> Int -> Int -> [V] -> IO ()
-- | Tom Johnson. "Perfect Rhythmic Tilings". Technical report, IRCAM, 24
-- January 2004. MaMuX Lecture.
module Music.Theory.Tiling.Johnson_2004
-- | {0,1,2} order 5, p.1
--
--
-- >>> v_print 15 (r_voices p1)
-- >
-- > ..***..........
-- > ........*.*.*..
-- > .....*...*...*.
-- > .*....*....*...
-- > *......*......*
--
p1 :: R
-- | {0,1,2} order 7, p.2
--
--
-- >>> v_print 21 (r_voices p2)
-- >
-- > ..............***....
-- > ..*.*.*..............
-- > ...*...*...*.........
-- > ........*....*....*..
-- > .....*......*......*.
-- > .*.......*.......*...
-- > *.........*.........*
--
p2 :: R
-- | {0,1} order 4, p.3
--
--
-- >>> v_print 8 (r_voices p3)
-- >
-- > *...*...
-- > .**.....
-- > ...*..*.
-- > .....*.*
--
p3 :: R
-- | {0,1} order 5, p.4
--
--
-- >>> mapM_ (v_print 10 . r_voices) p4
-- >
-- > *...*.....
-- > .**.......
-- > ...*....*.
-- > .....*.*..
-- > ......*..*
-- >
-- > *....*....
-- > .**.......
-- > ...*..*...
-- > ....*...*.
-- > .......*.*
-- >
-- > *...*.....
-- > .*....*...
-- > ..**......
-- > .....*..*.
-- > .......*.*
--
p4 :: [R]
-- | Open {1,2,3} order 5, p.4
--
--
-- >>> v_print 18 (r_voices p4_b)
-- >
-- > ...***............
-- > ........*.*.*.....
-- > .........*...*...*
-- > .*....*....*......
-- > *......*......*...
--
p4_b :: R
-- | Tom Johnson. "Tiling in my Music". The Experimental Music
-- Yearbook, 1, 2009.
module Music.Theory.Tiling.Johnson_2009
-- | Tilework for Clarinet, p.3
--
--
-- >>> v_print 36 (rr_voices p3)
-- >
-- > *.*..*............*.*..*............
-- > .*.*..*............*.*..*...........
-- > ........*.*..*............*.*..*....
-- > ....*..*.*............*..*.*........
-- > ...........*..*.*............*..*.*.
-- > ............*..*.*............*..*.*
--
p3 :: [R]
-- | Tilework for String Quartet, p.5
--
--
-- >>> mapM_ (v_print 24 . r_voices) p5
-- >
-- > ******......******......
-- > ......******......******
-- >
-- > *.****.*....*.****.*....
-- > ......*.****.*....*.****
-- >
-- > **.***..*...**.***..*...
-- > ......**.***..*...**.***
-- >
-- > *..***.**...*..***.**...
-- > ......*..***.**...*..***
--
p5 :: [R]
-- | Extra Perfect (p.7)
--
--
-- >>> v_print_m_from 18 6 6 (r_voices p7)
-- >
-- > **.*..|......|......|......|......|......
-- > ......|.*.*..|.*....|......|......|......
-- > ......|......|......|......|.*..*.|....*.
-- > ......|......|...*..|.*....|...*..|......
-- > ......|......|....*.|...*..|......|.*....
-- > ......|*.....|*.....|......|*.....|......
-- > ....*.|......|......|*.....|......|...*..
-- > ......|......|......|....*.|......|*.....
--
p7 :: R
-- | Tilework for Log Drums (2005), p.10
--
--
-- >>> v_print 18 (r_voices p10)
-- >
-- > *.*.*.............
-- > .*...*...*........
-- > ...*...*...*......
-- > ......*...*...*...
-- > ........*...*...*.
-- > .............*.*.*
--
p10 :: R
-- | Self-Similar Melodies (1996), p.11
--
--
-- >>> v_print_m 20 5 (r_voices p11)
-- >
-- > *.....*.....*..*..*.|....*.....*.....*...|..*..*..*.....*.....|*.....*.....*..*..*.|....*.....*.....*...
-- > ....................|*.....*.....*..*..*.|....*.....*.....*...|..*..*..*.....*.....|*.....*.....*..*..*.
-- > ....................|....................|*.....*.....*..*..*.|....*.....*.....*...|..*..*..*.....*.....
--
p11 :: R
module Music.Theory.Z12
-- | Z12 are modulo 12 integers.
--
--
-- map signum [-1,0::Z12,1] == [1,0,1]
-- map abs [-1,0::Z12,1] == [11,0,1]
--
newtype Z12
Z12 :: Int -> Z12
-- | Cyclic Enum instance for Z12.
--
--
-- pred (0::Z12) == 11
-- succ (11::Z12) == 0
-- [9::Z12 .. 3] == [9,10,11,0,1,2,3]
-- [9::Z12,11 .. 3] == [9,11,1,3]
--
-- | Bounded instance for Z12.
--
--
-- [minBound::Z12 .. maxBound] == [0::Z12 .. 11]
--
-- | The Z12 modulo (ie. 12) as a Z12 value. This is
-- required when lifting generalised Z functions to Z12.
-- It is not the same as writing 12::Z12.
--
--
-- z12_modulo == Z12 12
-- z12_modulo /= 12
-- (12::Z12) == 0
-- show z12_modulo == "(Z12 12)"
--
z12_modulo :: Z12
-- | Basis for Z12 show instance.
--
--
-- map show [-1,0::Z12,1,z12_modulo] == ["11","0","1","(Z12 12)"]
--
z12_showsPrec :: Int -> Z12 -> ShowS
-- | Lift unary function over integers to Z12.
--
--
-- lift_unary_Z12 (negate) 7 == 5
--
lift_unary_Z12 :: (Int -> Int) -> Z12 -> Z12
-- | Lift unary function over integers to Z12.
--
--
-- map (lift_binary_Z12 (+) 4) [1,5,6] == [5,9,10]
--
lift_binary_Z12 :: (Int -> Int -> Int) -> Z12 -> Z12 -> Z12
-- | Raise an error if the internal Z12 value is negative.
check_negative :: (Int -> Int) -> Z12 -> Z12
-- | Convert integral to Z12.
--
--
-- map to_Z12 [-9,-3,0,13] == [3,9,0,1]
--
to_Z12 :: Integral i => i -> Z12
-- | Convert Z12 to integral.
from_Z12 :: Integral i => Z12 -> i
-- | Z12 not in set.
--
--
-- complement [0,2,4,5,7,9,11] == [1,3,6,8,10]
--
complement :: [Z12] -> [Z12]
instance Eq Z12
instance Ord Z12
instance Integral Z12
instance Real Z12
instance Num Z12
instance Show Z12
instance Bounded Z12
instance Enum Z12
-- | Pitch-class set (unordered) operations on Z12.
module Music.Theory.Z12.TTO
-- | Map to pitch-class and reduce to set.
--
--
-- pcset [1,13] == [1]
--
pcset :: Integral a => [a] -> [Z12]
-- | Transpose by n.
--
--
-- tn 4 [1,5,6] == [5,9,10]
-- tn 4 [0,4,8] == [0,4,8]
--
tn :: Z12 -> [Z12] -> [Z12]
-- | Invert about n.
--
--
-- invert 6 [4,5,6] == [6,7,8]
-- invert 0 [0,1,3] == [0,9,11]
--
invert :: Z12 -> [Z12] -> [Z12]
-- | Composition of invert about 0 and tn.
--
--
-- tni 4 [1,5,6] == [3,10,11]
-- (invert 0 . tn 4) [1,5,6] == [2,3,7]
--
tni :: Z12 -> [Z12] -> [Z12]
-- | Modulo 12 multiplication
--
--
-- mn 11 [0,1,4,9] == invert 0 [0,1,4,9]
--
mn :: Z12 -> [Z12] -> [Z12]
-- | M5, ie. mn 5.
--
--
-- m5 [0,1,3] == [0,3,5]
--
m5 :: [Z12] -> [Z12]
-- | T-related sets of p.
--
--
-- length (t_related [0,1,3]) == 12
-- t_related [0,3,6,9] == [[0,3,6,9],[1,4,7,10],[2,5,8,11]]
--
t_related :: [Z12] -> [[Z12]]
-- | T/I-related set of p.
--
--
-- length (ti_related [0,1,3]) == 24
-- ti_related [0,3,6,9] == [[0,3,6,9],[1,4,7,10],[2,5,8,11]]
--
ti_related :: [Z12] -> [[Z12]]
-- | Ronald C. Read. "Every one a winner or how to avoid isomorphism search
-- when cataloguing combinatorial configurations." /Annals of Discrete
-- Mathematics/ 2:107–20, 1978.
module Music.Theory.Z12.Read_1978
type Code = Code
-- | Encoder for encode_prime.
--
--
-- encode [0,1,3,6,8,9] == 843
--
encode :: [Z12] -> Code
-- | Decoder for encode_prime.
--
--
-- decode 843 == [0,1,3,6,8,9]
--
decode :: Code -> [Z12]
-- | Binary encoding prime form algorithm, equalivalent to Rahn.
--
--
-- encode_prime [0,1,3,6,8,9] == [0,2,3,6,7,9]
-- Music.Theory.Z12.Rahn_1980.rahn_prime [0,1,3,6,8,9] == [0,2,3,6,7,9]
--
encode_prime :: [Z12] -> [Z12]
-- | Extensions to Data.Maybe.
module Music.Theory.Maybe
-- | Variant of unzip.
--
--
-- let r = ([Just 1,Nothing,Just 3],[Just 'a',Nothing,Just 'c'])
-- in maybe_unzip [Just (1,'a'),Nothing,Just (3,'c')] == r
--
maybe_unzip :: [Maybe (a, b)] -> ([Maybe a], [Maybe b])
-- | Replace Nothing elements with last Just value. This does
-- not alter the length of the list.
--
--
-- maybe_latch 1 [Nothing,Just 2,Nothing,Just 4] == [1,2,2,4]
--
maybe_latch :: a -> [Maybe a] -> [a]
-- | Variant requiring initial value is not Nothing.
--
--
-- maybe_latch1 [Just 1,Nothing,Nothing,Just 4] == [1,1,1,4]
--
maybe_latch1 :: [Maybe a] -> [a]
-- | map of fmap.
--
--
-- maybe_map negate [Nothing,Just 2] == [Nothing,Just (-2)]
--
maybe_map :: (a -> b) -> [Maybe a] -> [Maybe b]
-- | If either is Nothing then False, else eq of
-- values.
maybe_eq_by :: (t -> u -> Bool) -> Maybe t -> Maybe u -> Bool
-- | Join two values, either of which may be missing.
maybe_join' :: (s -> t) -> (s -> s -> t) -> Maybe s -> Maybe s -> Maybe t
-- | maybe_join' of id
maybe_join :: (t -> t -> t) -> Maybe t -> Maybe t -> Maybe t
-- | Apply predicate inside Maybe.
--
--
-- maybe_predicate even (Just 3) == Nothing
--
maybe_predicate :: (a -> Bool) -> Maybe a -> Maybe a
-- | map of maybe_predicate.
--
--
-- let r = [Nothing,Nothing,Nothing,Just 4]
-- in maybe_filter even [Just 1,Nothing,Nothing,Just 4] == r
--
maybe_filter :: (a -> Bool) -> [Maybe a] -> [Maybe a]
-- | Variant of filter that retains Nothing as a placeholder
-- for removed elements.
--
--
-- filter_maybe even [1..4] == [Nothing,Just 2,Nothing,Just 4]
--
filter_maybe :: (a -> Bool) -> [a] -> [Maybe a]
-- | Math functions.
module Music.Theory.Math
-- | Real (alias for Double).
type R = Double
-- |
-- http://reference.wolfram.com/mathematica/ref/FractionalPart.html
integral_and_fractional_parts :: (Integral i, RealFrac t) => t -> (i, t)
-- | Type specialised.
integer_and_fractional_parts :: RealFrac t => t -> (Integer, t)
-- |
-- http://reference.wolfram.com/mathematica/ref/FractionalPart.html
--
--
-- import Sound.SC3.Plot {- hsc3-plot -}
-- plotTable1 (map fractional_part [-2.0,-1.99 .. 2.0])
--
fractional_part :: RealFrac a => a -> a
-- | http://reference.wolfram.com/mathematica/ref/SawtoothWave.html
--
--
-- plotTable1 (map sawtooth_wave [-2.0,-1.99 .. 2.0])
--
sawtooth_wave :: RealFrac a => a -> a
-- | Pretty printer for Rational that elides denominators of
-- 1.
--
--
-- map rational_pp [1,3/2,2] == ["1","3/2","2"]
--
rational_pp :: (Show a, Integral a) => Ratio a -> String
-- | Pretty print ratio as : separated integers.
--
--
-- map ratio_pp [1,3/2,2] == ["1:1","3:2","2:1"]
--
ratio_pp :: Rational -> String
-- | Predicate that is true if n/d can be simplified, ie. where
-- gcd of n and d is not 1.
--
--
-- let r = [False,True,False]
-- in map rational_simplifies [(2,3),(4,6),(5,7)] == r
--
rational_simplifies :: Integral a => (a, a) -> Bool
-- | numerator and denominator of rational.
rational_nd :: Integral t => Ratio t -> (t, t)
-- | Rational as a whole number, or Nothing.
rational_whole :: Integral a => Ratio a -> Maybe a
-- | Erroring variant.
rational_whole_err :: Integral a => Ratio a -> a
-- | Variant of showFFloat. The Show instance for floats
-- resorts to exponential notation very readily.
--
--
-- [show 0.01,realfloat_pp 2 0.01] == ["1.0e-2","0.01"]
--
realfloat_pp :: RealFloat a => Int -> a -> String
-- | Type specialised realfloat_pp.
float_pp :: Int -> Float -> String
-- | Type specialised realfloat_pp.
double_pp :: Int -> Double -> String
-- | Show only positive and negative values, always with sign.
--
--
-- map num_diff_str [-2,-1,0,1,2] == ["-2","-1","","+1","+2"]
-- map show [-2,-1,0,1,2] == ["-2","-1","0","1","2"]
--
num_diff_str :: (Num a, Ord a, Show a) => a -> String
-- | Clarence Barlow. "Two Essays on Theory". Computer Music
-- Journal, 11(1):44-60, 1987. Translated by Henning Lohner.
module Music.Theory.Meter.Barlow_1987
traceShow :: a -> b -> b
-- | One indexed variant of genericIndex.
--
--
-- map (at [11..13]) [1..3] == [11,12,13]
--
at :: Integral n => [a] -> n -> a
-- | Variant of at with boundary rules and specified error message.
--
--
-- map (at' 'x' [11..13]) [0..4] == [1,11,12,13,1]
-- at' 'x' [0] 3 == undefined
--
at' :: (Num a, Show a, Integral n, Show n, Show m) => m -> [a] -> n -> a
-- | Variant of mod with input constraints.
--
--
-- mod' (-1) 2 == 1
--
mod' :: (Integral a, Show a) => a -> a -> a
-- | Specialised variant of fromIntegral.
to_r :: (Integral n, Show n) => n -> R
-- | Variant on div with input constraints.
div' :: (Integral a, Show a) => String -> a -> a -> a
-- | A stratification is a tree of integral subdivisions.
type Stratification t = [t]
-- | Indispensibilities from stratification.
--
--
-- indispensibilities [3,2,2] == [11,0,6,3,9,1,7,4,10,2,8,5]
-- indispensibilities [2,3,2] == [11,0,6,2,8,4,10,1,7,3,9,5]
-- indispensibilities [2,2,3] == [11,0,4,8,2,6,10,1,5,9,3,7]
-- indispensibilities [3,5] == [14,0,9,3,6,12,1,10,4,7,13,2,11,5,8]
--
indispensibilities :: (Integral n, Show n) => Stratification n -> [n]
-- | The indispensibility measure (ψ).
--
--
-- map (lower_psi [2] 1) [1..2] == [1,0]
-- map (lower_psi [3] 1) [1..3] == [2,0,1]
-- map (lower_psi [2,2] 2) [1..4] == [3,0,2,1]
-- map (lower_psi [5] 1) [1..5] == [4,0,3,1,2]
-- map (lower_psi [3,2] 2) [1..6] == [5,0,3,1,4,2]
-- map (lower_psi [2,3] 2) [1..6] == [5,0,2,4,1,3]
--
lower_psi :: (Integral a, Show a) => Stratification a -> a -> a -> a
-- | The first nth primes, reversed.
--
--
-- reverse_primes 14 == [43,41,37,31,29,23,19,17,13,11,7,5,3,2]
--
reverse_primes :: (Integral n, Show n) => n -> [n]
-- | Generate prime stratification for n.
--
--
-- map prime_stratification [2,3,5,7,11] == [[2],[3],[5],[7],[11]]
-- map prime_stratification [6,8,9,12] == [[3,2],[2,2,2],[3,3],[3,2,2]]
-- map prime_stratification [22,10,4,1] == [[11,2],[5,2],[2,2],[]]
-- map prime_stratification [18,16,12] == [[3,3,2],[2,2,2,2],[3,2,2]]
--
prime_stratification :: (Integral n, Show n) => n -> Stratification n
-- | Fundamental indispensibilities for prime numbers (Ψ).
--
--
-- map (upper_psi 2) [1..2] == [1,0]
-- map (upper_psi 3) [1..3] == [2,0,1]
-- map (upper_psi 5) [1..5] == [4,0,3,1,2]
-- map (upper_psi 7) [1..7] == [6,0,4,2,5,1,3]
-- map (upper_psi 11) [1..11] == [10,0,6,4,9,1,7,3,8,2,5]
-- map (upper_psi 13) [1..13] == [12,0,7,4,10,1,8,5,11,2,9,3,6]
--
upper_psi :: (Integral a, Show a) => a -> a -> a
-- | Table such that each subsequent row deletes the least indispensibile
-- pulse.
--
--
-- thinning_table [3,2] == [[True,True,True,True,True,True]
-- ,[True,False,True,True,True,True]
-- ,[True,False,True,False,True,True]
-- ,[True,False,True,False,True,False]
-- ,[True,False,False,False,True,False]
-- ,[True,False,False,False,False,False]]
--
thinning_table :: (Integral n, Show n) => Stratification n -> [[Bool]]
-- | Trivial pretty printer for thinning_table.
--
--
-- putStrLn (thinning_table_pp [3,2])
-- putStrLn (thinning_table_pp [2,3])
--
--
--
-- ****** ******
-- *.**** *.****
-- *.*.** *.**.*
-- *.*.*. *..*.*
-- *...*. *..*..
-- *..... *.....
--
thinning_table_pp :: (Integral n, Show n) => Stratification n -> String
-- | Scale values against length of list minus one.
--
--
-- relative_to_length [0..5] == [0.0,0.2,0.4,0.6,0.8,1.0]
--
relative_to_length :: (Real a, Fractional b) => [a] -> [b]
-- | Variant of indispensibilities that scales value to lie in
-- (0,1).
--
-- relative_indispensibilities [3,2] == [1,0,0.6,0.2,0.8,0.4]
relative_indispensibilities :: (Integral n, Show n) => Stratification n -> [R]
-- | Align two meters (given as stratifications) to least common multiple
-- of their degrees. The indispensibilities function is given as
-- an argument so that it may be relative if required. This generates
-- Table 7 (p.58).
--
--
-- let r = [(5,5),(0,0),(2,3),(4,1),(1,4),(3,2)]
-- in align_meters indispensibilities [2,3] [3,2] == r
--
--
--
-- let r = [(1,1),(0,0),(0.4,0.6),(0.8,0.2),(0.2,0.8),(0.6,0.4)]
-- in align_meters relative_indispensibilities [2,3] [3,2] == r
--
--
--
-- align_meters indispensibilities [2,2,3] [3,5]
-- align_meters relative_indispensibilities [2,2,3] [3,5]
--
align_meters :: (t -> [b]) -> t -> t -> [(b, b)]
-- | Type pairing a stratification and a tempo.
type S_MM t = ([t], t)
-- | Variant of div that requires mod be 0.
whole_div :: Integral a => a -> a -> a
-- | Variant of quot that requires rem be 0.
whole_quot :: Integral a => a -> a -> a
-- | Rule to prolong stratification of two S_MM values such that
-- pulse at the deeper level are aligned. (Paragraph 2, p.58)
--
--
-- let x = ([2,2,2],1)
-- in prolong_stratifications x x == (fst x,fst x)
--
--
--
-- let r = ([2,5,3,3,2],[3,2,5,5])
-- in prolong_stratifications ([2,5],50) ([3,2],60) == r
--
--
--
-- prolong_stratifications ([2,2,3],5) ([3,5],4) == ([2,2,3],[3,5])
--
prolong_stratifications :: (Integral n, Show n) => S_MM n -> S_MM n -> ([n], [n])
-- | Arithmetic mean (average) of a list.
--
--
-- mean [0..5] == 2.5
--
mean :: Fractional a => [a] -> a
-- | Square of n.
--
--
-- square 5 == 25
--
square :: Num a => a -> a
-- | Composition of prolong_stratifications and align_meters.
--
--
-- align_s_mm indispensibilities ([2,2,3],5) ([3,5],4)
--
align_s_mm :: (Integral n, Show n) => ([n] -> [t]) -> S_MM n -> S_MM n -> [(t, t)]
-- | An attempt at Equation 5 of the CMJ paper. When n is
-- h-1 the output is incorrect (it is the product of the correct
-- values for n at h-1 and h).
--
--
-- map (upper_psi' 5) [1..5] /= [4,0,3,1,2]
-- map (upper_psi' 7) [1..7] /= [6,0,4,2,5,1,3]
-- map (upper_psi' 11) [1..11] /= [10,0,6,4,9,1,7,3,8,2,5]
-- map (upper_psi' 13) [1..13] /= [12,0,7,4,10,1,8,5,11,2,9,3,6]
--
upper_psi' :: (Integral a, Show a) => a -> a -> a
-- | The MPS limit equation given on p.58.
--
--
-- mps_limit 3 == 21 + 7/9
--
mps_limit :: Floating a => a -> a
-- | The square of the product of the input sequence is summed, then
-- divided by the square of the sequence length.
--
--
-- mean_square_product [(0,0),(1,1),(2,2),(3,3)] == 6.125
-- mean_square_product [(2,3),(4,5)] == (6^2 + 20^2) / 2^2
--
mean_square_product :: Fractional n => [(n, n)] -> n
-- | An incorrect attempt at the description in paragraph two of p.58 of
-- the CMJ paper.
--
--
-- let p ~= q = abs (p - q) < 1e-4
-- metrical_affinity [2,3] 1 [3,2] 1 ~= 0.0324
-- metrical_affinity [2,2,3] 20 [3,5] 16 ~= 0.0028
--
metrical_affinity :: (Integral n, Show n) => [n] -> n -> [n] -> n -> R
-- | An incorrect attempt at Equation 6 of the CMJ paper, see
-- omega_z.
--
--
-- let p ~= q = abs (p - q) < 1e-4
-- metrical_affinity' [2,2,2] 1 [2,2,2] 1 ~= 1.06735
-- metrical_affinity' [2,2,2] 1 [2,2,3] 1 ~= 0.57185
-- metrical_affinity' [2,2,2] 1 [2,3,2] 1 ~= 0.48575
-- metrical_affinity' [2,2,2] 1 [3,2,2] 1 ~= 0.45872
--
--
--
-- metrical_affinity' [3,2,2] 3 [2,2,3] 2 ~= 0.10282
--
metrical_affinity' :: (Integral t, Show t) => [t] -> t -> [t] -> t -> R
-- | Common music notation note and alteration values.
module Music.Theory.Pitch.Note
-- | Enumeration of common music notation note names (C to
-- B).
data Note_T
C :: Note_T
D :: Note_T
E :: Note_T
F :: Note_T
G :: Note_T
A :: Note_T
B :: Note_T
-- | Transform Note_T to pitch-class number.
--
--
-- map note_to_pc [C,E,G] == [0,4,7]
--
note_to_pc :: Integral i => Note_T -> i
-- | Modal transposition of Note_T value.
--
--
-- note_t_transpose C 2 == E
--
note_t_transpose :: Note_T -> Int -> Note_T
-- | Enumeration of common music notation note alterations.
data Alteration_T
DoubleFlat :: Alteration_T
ThreeQuarterToneFlat :: Alteration_T
Flat :: Alteration_T
QuarterToneFlat :: Alteration_T
Natural :: Alteration_T
QuarterToneSharp :: Alteration_T
Sharp :: Alteration_T
ThreeQuarterToneSharp :: Alteration_T
DoubleSharp :: Alteration_T
-- | Generic form.
generic_alteration_to_diff :: Integral i => Alteration_T -> Maybe i
-- | Transform Alteration_T to semitone alteration. Returns
-- Nothing for non-semitone alterations.
--
--
-- map alteration_to_diff [Flat,QuarterToneSharp] == [Just (-1),Nothing]
--
alteration_to_diff :: Alteration_T -> Maybe Int
-- | Is Alteration_T 12-ET.
alteration_is_12et :: Alteration_T -> Bool
-- | Transform Alteration_T to semitone alteration.
--
--
-- map alteration_to_diff_err [Flat,Sharp] == [-1,1]
--
alteration_to_diff_err :: Integral i => Alteration_T -> i
-- | Transform Alteration_T to fractional semitone alteration, ie.
-- allow quarter tones.
--
--
-- alteration_to_fdiff QuarterToneSharp == 0.5
--
alteration_to_fdiff :: Fractional n => Alteration_T -> n
-- | Transform fractional semitone alteration to Alteration_T, ie.
-- allow quarter tones.
--
--
-- map fdiff_to_alteration [-0.5,0.5] == [Just QuarterToneFlat
-- ,Just QuarterToneSharp]
--
fdiff_to_alteration :: (Fractional n, Eq n) => n -> Maybe Alteration_T
-- | Raise Alteration_T by a quarter tone where possible.
--
--
-- alteration_raise_quarter_tone Flat == Just QuarterToneFlat
-- alteration_raise_quarter_tone DoubleSharp == Nothing
--
alteration_raise_quarter_tone :: Alteration_T -> Maybe Alteration_T
-- | Lower Alteration_T by a quarter tone where possible.
--
--
-- alteration_lower_quarter_tone Sharp == Just QuarterToneSharp
-- alteration_lower_quarter_tone DoubleFlat == Nothing
--
alteration_lower_quarter_tone :: Alteration_T -> Maybe Alteration_T
-- | Edit Alteration_T by a quarter tone where possible,
-- -0.5 lowers, 0 retains, 0.5 raises.
--
--
-- import Data.Ratio
-- alteration_edit_quarter_tone (-1 % 2) Flat == Just ThreeQuarterToneFlat
--
alteration_edit_quarter_tone :: (Fractional n, Eq n) => n -> Alteration_T -> Maybe Alteration_T
-- | Simplify Alteration_T to standard 12ET by deleting quarter
-- tones.
--
--
-- Data.List.nub (map alteration_clear_quarter_tone [minBound..maxBound])
--
alteration_clear_quarter_tone :: Alteration_T -> Alteration_T
-- | Unicode has entries for Musical Symbols in the range
-- U+1D100 through U+1D1FF. The 3/4 symbols
-- are non-standard, here they correspond to MUSICAL SYMBOL FLAT
-- DOWN and MUSICAL SYMBOL SHARP UP.
--
--
-- map alteration_symbol [minBound .. maxBound] == "𝄫𝄭♭𝄳♮𝄲♯𝄰𝄪"
--
alteration_symbol :: Alteration_T -> Char
-- | The ISO ASCII spellings for alterations. Naturals as written
-- as the empty string.
--
--
-- mapMaybe alteration_iso_m [Flat .. Sharp] == ["b","","#"]
--
alteration_iso_m :: Alteration_T -> Maybe String
-- | The ISO ASCII spellings for alterations.
alteration_iso :: Alteration_T -> String
-- | The Tonhöhe ASCII spellings for alterations.
--
-- See http://www.musiccog.ohio-state.edu/Humdrum/guide04.html and
-- http://lilypond.org/doc/v2.16/Documentation/notation/writing-pitches
--
--
-- map alteration_tonh [Flat .. Sharp] == ["es","eh","","ih","is"]
--
alteration_tonh :: Alteration_T -> String
-- | Generalised alteration, given as a rational semitone difference and a
-- string representation of the alteration.
type Alteration_T' = (Rational, String)
-- | Transform Alteration_T to Alteration_T'.
--
--
-- let r = [(-1,"♭"),(0,"♮"),(1,"♯")]
-- in map alteration_t' [Flat,Natural,Sharp] == r
--
alteration_t' :: Alteration_T -> Alteration_T'
-- | Function to spell a PitchClass.
type Spelling n = n -> (Note_T, Alteration_T)
instance Eq Note_T
instance Enum Note_T
instance Bounded Note_T
instance Ord Note_T
instance Show Note_T
instance Eq Alteration_T
instance Enum Alteration_T
instance Bounded Alteration_T
instance Ord Alteration_T
instance Show Alteration_T
-- | Spelling rules for common music notation.
module Music.Theory.Pitch.Spelling
-- | Variant of Spelling for incomplete functions.
type Spelling_M i = i -> Maybe (Note_T, Alteration_T)
-- | Spelling for natural (♮) notes only.
--
--
-- map pc_spell_natural_m [0,1] == [Just (C,Natural),Nothing]
--
pc_spell_natural_m :: Integral i => Spelling_M i
-- | Erroring variant of pc_spell_natural_m.
--
--
-- map pc_spell_natural [0,5,7] == [(C,Natural),(F,Natural),(G,Natural)]
--
pc_spell_natural :: Integral i => Spelling i
-- | Use spelling from simplest key-signature. Note that this is ambiguous
-- for 8, which could be either G Sharp (♯) in A Major or
-- A Flat (♭) in E Flat (♭) Major.
--
--
-- map pc_spell_ks [6,8] == [(F,Sharp),(A,Flat)]
--
pc_spell_ks :: Integral i => Spelling i
-- | Use always sharp (♯) spelling.
--
--
-- map pc_spell_sharp [6,8] == [(F,Sharp),(G,Sharp)]
-- Data.List.nub (map (snd . pc_spell_sharp) [1,3,6,8,10]) == [Sharp]
-- octpc_to_pitch pc_spell_sharp (4,6) == Pitch F Sharp 4
--
pc_spell_sharp :: Integral i => Spelling i
-- | Use always flat (♭) spelling.
--
--
-- map pc_spell_flat [6,8] == [(G,Flat),(A,Flat)]
-- Data.List.nub (map (snd . pc_spell_flat) [1,3,6,8,10]) == [Flat]
--
pc_spell_flat :: Integral i => Spelling i
-- | Either
module Music.Theory.Either
-- | Maybe Left of Either.
fromLeft :: Either a b -> Maybe a
-- | Maybe Right of Either.
fromRight :: Either a b -> Maybe b
-- | Data.Function related functions.
module Music.Theory.Function
-- | && of predicates.
predicate_and :: (t -> Bool) -> (t -> Bool) -> t -> Bool
-- | all of predicates.
--
--
-- let r = [False,False,True,False,True,False]
-- in map (predicate_all [(> 0),(< 5),even]) [0..5] == r
--
predicate_all :: [t -> Bool] -> t -> Bool
-- | || of predicates.
predicate_or :: (t -> Bool) -> (t -> Bool) -> t -> Bool
-- | any of predicates.
--
--
-- let r = [True,False,True,False,True,True]
-- in map (predicate_any [(== 0),(== 5),even]) [0..5] == r
--
predicate_any :: [t -> Bool] -> t -> Bool
-- | fmap . fmap, ie. (t -> c) -> (a -> b
-- -> t) -> a -> b -> c.
(.:) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
-- | fmap . .:, ie. (t -> d) -> (a -> b
-- -> c -> t) -> a -> b -> c -> d.
(.::) :: (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b))
-- | fmap . .::.
(.:::) :: (Functor f, Functor g, Functor h, Functor i) => (a -> b) -> f (g (h (i a))) -> f (g (h (i b)))
-- | fmap . .:::.
(.::::) :: (Functor f, Functor g, Functor h, Functor i, Functor j) => (a -> b) -> f (g (h (i (j a)))) -> f (g (h (i (j b))))
-- | fmap . .::::.
(.:::::) :: (Functor f, Functor g, Functor h, Functor i, Functor j, Functor k) => (a -> b) -> f (g (h (i (j (k a))))) -> f (g (h (i (j (k b)))))
-- | Common music notation duration model.
module Music.Theory.Duration
-- | Common music notation durational model
data Duration
Duration :: Integer -> Integer -> Rational -> Duration
-- | division of whole note
division :: Duration -> Integer
-- | number of dots
dots :: Duration -> Integer
-- | tuplet modifier
multiplier :: Duration -> Rational
-- | Are multipliers equal?
duration_meq :: Duration -> Duration -> Bool
-- | Compare durations with equal multipliers.
duration_compare_meq :: Duration -> Duration -> Maybe Ordering
-- | Erroring variant of duration_compare_meq.
duration_compare_meq_err :: Duration -> Duration -> Ordering
-- | Ord instance in terms of duration_compare_meq_err.
order_pair :: Ordering -> (t, t) -> (t, t)
-- | Sort a pair of equal type values using given comparison function.
--
--
-- sort_pair compare ('b','a') == ('a','b')
--
sort_pair :: (t -> t -> Ordering) -> (t, t) -> (t, t)
sort_pair_m :: (t -> t -> Maybe Ordering) -> (t, t) -> Maybe (t, t)
-- | True if neither duration is dotted.
no_dots :: (Duration, Duration) -> Bool
-- | Sum undotted divisions, input is required to be sorted.
sum_dur_undotted :: (Integer, Integer) -> Maybe Duration
-- | Sum dotted divisions, input is required to be sorted.
--
--
-- sum_dur_dotted (4,1,4,1) == Just (Duration 2 1 1)
-- sum_dur_dotted (4,0,2,1) == Just (Duration 1 0 1)
-- sum_dur_dotted (8,1,4,0) == Just (Duration 4 2 1)
-- sum_dur_dotted (16,0,4,2) == Just (Duration 2 0 1)
--
sum_dur_dotted :: (Integer, Integer, Integer, Integer) -> Maybe Duration
-- | Sum durations. Not all durations can be summed, and the present
-- algorithm is not exhaustive.
--
--
-- import Music.Theory.Duration.Name
-- sum_dur quarter_note eighth_note == Just dotted_quarter_note
-- sum_dur dotted_quarter_note eighth_note == Just half_note
-- sum_dur quarter_note dotted_eighth_note == Just double_dotted_quarter_note
--
sum_dur :: Duration -> Duration -> Maybe Duration
-- | Erroring variant of sum_dur.
sum_dur' :: Duration -> Duration -> Duration
-- | Give MusicXML type for division.
--
--
-- map whole_note_division_to_musicxml_type [2,4] == ["half","quarter"]
--
whole_note_division_to_musicxml_type :: Integer -> String
-- | Variant of whole_note_division_to_musicxml_type extracting
-- division from Duration.
--
--
-- duration_to_musicxml_type quarter_note == "quarter"
--
duration_to_musicxml_type :: Duration -> String
-- | Give Lilypond notation for Duration. Note that the
-- duration multiplier is not written.
--
--
-- import Music.Theory.Duration.Name
-- map duration_to_lilypond_type [half_note,dotted_quarter_note] == ["2","4."]
--
duration_to_lilypond_type :: Duration -> String
-- | Calculate number of beams at notated division.
--
--
-- whole_note_division_to_beam_count 32 == Just 3
--
whole_note_division_to_beam_count :: Integer -> Maybe Integer
-- | Calculate number of beams at Duration.
--
--
-- map duration_beam_count [half_note,sixteenth_note] == [0,2]
--
duration_beam_count :: Duration -> Integer
whole_note_division_pp :: Integer -> Maybe Char
duration_pp :: Duration -> Maybe String
-- | Duration to **recip notation.
--
-- http://humdrum.org/Humdrum/representations/recip.rep.html
--
--
-- let d = map (\z -> Duration z 0 1) [0,1,2,4,8,16,32]
-- in map duration_recip_pp d == ["0","1","2","4","8","16","32"]
--
--
--
-- let d = [Duration 1 1 (1/3),Duration 4 1 1,Duration 4 1 (2/3)]
-- in map duration_recip_pp d == ["3.","4.","6."]
--
duration_recip_pp :: Duration -> String
instance Eq Duration
instance Show Duration
instance Ord Duration
-- | Names for common music notation durations.
module Music.Theory.Duration.Name
breve :: Duration
thirtysecond_note :: Duration
sixteenth_note :: Duration
eighth_note :: Duration
quarter_note :: Duration
half_note :: Duration
whole_note :: Duration
dotted_breve :: Duration
dotted_thirtysecond_note :: Duration
dotted_sixteenth_note :: Duration
dotted_eighth_note :: Duration
dotted_quarter_note :: Duration
dotted_half_note :: Duration
dotted_whole_note :: Duration
double_dotted_breve :: Duration
double_dotted_thirtysecond_note :: Duration
double_dotted_sixteenth_note :: Duration
double_dotted_eighth_note :: Duration
double_dotted_quarter_note :: Duration
double_dotted_half_note :: Duration
double_dotted_whole_note :: Duration
-- | Rational quarter-note notation for durations.
module Music.Theory.Duration.RQ
-- | Rational Quarter-Note
type RQ = Rational
-- | Rational quarter note to duration value. It is a mistake to hope this
-- could handle tuplets directly since, for instance, a 3:2
-- dotted note will be of the same duration as a plain undotted note.
--
--
-- rq_to_duration (3/4) == Just dotted_eighth_note
--
rq_to_duration :: RQ -> Maybe Duration
-- | Is RQ a cmn duration.
--
--
-- map rq_is_cmn [1/4,1/5,1/8,3/32] == [True,False,True,False]
--
rq_is_cmn :: RQ -> Bool
-- | Variant of rq_to_duration with error message.
rq_to_duration_err :: Show a => a -> RQ -> Duration
-- | Convert a whole note division integer to an RQ value.
--
--
-- map whole_note_division_to_rq [1,2,4,8] == [4,2,1,1/2]
--
whole_note_division_to_rq :: Integer -> RQ
-- | Apply dots to an RQ duration.
--
--
-- map (rq_apply_dots 1) [1,2] == [3/2,7/4]
--
rq_apply_dots :: RQ -> Integer -> RQ
-- | Convert Duration to RQ value, see rq_to_duration
-- for partial inverse.
--
--
-- let d = [half_note,dotted_quarter_note,dotted_whole_note]
-- in map duration_to_rq d == [2,3/2,6]
--
duration_to_rq :: Duration -> RQ
-- | compare function for Duration via duration_to_rq.
--
--
-- half_note `duration_compare_rq` quarter_note == GT
--
duration_compare_rq :: Duration -> Duration -> Ordering
-- | RQ modulo.
--
--
-- map (rq_mod (5/2)) [3/2,3/4,5/2] == [1,1/4,0]
--
rq_mod :: RQ -> RQ -> RQ
-- | Is p divisible by q, ie. is the denominator of
-- p/q == 1.
--
--
-- map (rq_divisible_by (3%2)) [1%2,1%3] == [True,False]
--
rq_divisible_by :: RQ -> RQ -> Bool
-- | Is RQ a whole number (ie. is denominator ==
-- 1.
--
--
-- map rq_is_integral [1,3/2,2] == [True,False,True]
--
rq_is_integral :: RQ -> Bool
-- | Return numerator of RQ if denominator ==
-- 1.
--
--
-- map rq_integral [1,3/2,2] == [Just 1,Nothing,Just 2]
--
rq_integral :: RQ -> Maybe Integer
-- | Derive the tuplet structure of a set of RQ values.
--
--
-- rq_derive_tuplet_plain [1/2] == Nothing
-- rq_derive_tuplet_plain [1/2,1/2] == Nothing
-- rq_derive_tuplet_plain [1/4,1/4] == Nothing
-- rq_derive_tuplet_plain [1/3,2/3] == Just (3,2)
-- rq_derive_tuplet_plain [1/2,1/3,1/6] == Just (6,4)
-- rq_derive_tuplet_plain [1/3,1/6] == Just (6,4)
-- rq_derive_tuplet_plain [2/5,3/5] == Just (5,4)
-- rq_derive_tuplet_plain [1/3,1/6,2/5,1/10] == Just (30,16)
--
--
--
-- map rq_derive_tuplet_plain [[1/3,1/6],[2/5,1/10]] == [Just (6,4)
-- ,Just (10,8)]
--
rq_derive_tuplet_plain :: [RQ] -> Maybe (Integer, Integer)
-- | Derive the tuplet structure of a set of RQ values.
--
--
-- rq_derive_tuplet [1/4,1/8,1/8] == Nothing
-- rq_derive_tuplet [1/3,2/3] == Just (3,2)
-- rq_derive_tuplet [1/2,1/3,1/6] == Just (3,2)
-- rq_derive_tuplet [2/5,3/5] == Just (5,4)
-- rq_derive_tuplet [1/3,1/6,2/5,1/10] == Just (15,8)
--
rq_derive_tuplet :: [RQ] -> Maybe (Integer, Integer)
-- | Remove tuplet multiplier from value, ie. to give notated duration.
-- This seems odd but is neccessary to avoid ambiguity. Ie. is 1
-- a quarter note or a 3:2 tuplet dotted-quarter-note etc.
--
--
-- map (rq_un_tuplet (3,2)) [1,2/3,1/2,1/3] == [3/2,1,3/4,1/2]
--
rq_un_tuplet :: (Integer, Integer) -> RQ -> RQ
-- | If an RQ duration is un-representable by a single cmn
-- duration, give tied notation.
--
--
-- catMaybes (map rq_to_cmn [1..9]) == [(4,1),(4,3),(8,1)]
--
--
--
-- map rq_to_cmn [5/4,5/8] == [Just (1,1/4),Just (1/2,1/8)]
--
rq_to_cmn :: RQ -> Maybe (RQ, RQ)
-- | Predicate to determine if a segment can be notated either without a
-- tuplet or with a single tuplet.
--
--
-- rq_can_notate [1/2,1/4,1/4] == True
-- rq_can_notate [1/3,1/6] == True
-- rq_can_notate [2/5,1/10] == True
-- rq_can_notate [1/3,1/6,2/5,1/10] == False
-- rq_can_notate [4/7,1/7,6/7,3/7] == True
-- rq_can_notate [4/7,1/7,2/7] == True
--
rq_can_notate :: [RQ] -> Bool
-- | Duration annotations.
module Music.Theory.Duration.Annotation
-- | Standard music notation durational model annotations
data D_Annotation
Tie_Right :: D_Annotation
Tie_Left :: D_Annotation
Begin_Tuplet :: (Integer, Integer, Duration) -> D_Annotation
End_Tuplet :: D_Annotation
-- | Annotated Duration.
type Duration_A = (Duration, [D_Annotation])
begin_tuplet :: D_Annotation -> Maybe (Integer, Integer, Duration)
da_begin_tuplet :: Duration_A -> Maybe (Integer, Integer, Duration)
begins_tuplet :: D_Annotation -> Bool
-- | Does Duration_A begin a tuplet?
da_begins_tuplet :: Duration_A -> Bool
-- | Does Duration_A end a tuplet?
da_ends_tuplet :: Duration_A -> Bool
-- | Is Duration_A tied to the the right?
da_tied_right :: Duration_A -> Bool
-- | Annotate a sequence of Duration_A as a tuplet.
--
--
-- import Music.Theory.Duration.Name
-- da_tuplet (3,2) [(quarter_note,[Tie_Left]),(eighth_note,[Tie_Right])]
--
da_tuplet :: (Integer, Integer) -> [Duration_A] -> [Duration_A]
-- | Transform predicates into Ordering predicate such that if
-- f holds then LT, if g holds then GT else
-- EQ.
--
--
-- map (begin_end_cmp (== '{') (== '}')) "{a}" == [LT,EQ,GT]
--
begin_end_cmp :: (t -> Bool) -> (t -> Bool) -> t -> Ordering
-- | Variant of begin_end_cmp, predicates are constructed by
-- ==.
--
--
-- map (begin_end_cmp_eq '{' '}') "{a}" == [LT,EQ,GT]
--
begin_end_cmp_eq :: Eq t => t -> t -> t -> Ordering
-- | Given an Ordering predicate where LT opens a group,
-- GT closes a group, and EQ continues current group,
-- construct tree from list.
--
--
-- let {l = "a {b {c d} e f} g h i"
-- ;t = group_tree (begin_end_cmp_eq '{' '}') l}
-- in catMaybes (flatten t) == l
--
--
--
-- let d = putStrLn . drawTree . fmap show
-- in d (group_tree (begin_end_cmp_eq '(' ')') "a(b(cd)ef)ghi")
--
group_tree :: (a -> Ordering) -> [a] -> Tree (Maybe a)
-- | Group tuplets into a Tree. Branch nodes have label
-- Nothing, leaf nodes label Just Duration_A.
--
--
-- import Music.Theory.Duration.Name.Abbreviation
--
--
--
-- let d = [(q,[])
-- ,(e,[Begin_Tuplet (3,2,e)])
-- ,(s,[Begin_Tuplet (3,2,s)]),(s,[]),(s,[End_Tuplet])
-- ,(e,[End_Tuplet])
-- ,(q,[])]
-- in catMaybes (flatten (da_group_tuplets d)) == d
--
da_group_tuplets :: [Duration_A] -> Tree (Maybe Duration_A)
-- | Variant of break that places separator at left.
--
--
-- break_left (== 3) [1..6] == ([1..3],[4..6])
-- break_left (== 3) [1..3] == ([1..3],[])
--
break_left :: (a -> Bool) -> [a] -> ([a], [a])
-- | Variant of break_left that balances begin & end predicates.
--
--
-- break_left (== ')') "test (sep) _) balanced"
-- sep_balanced True (== '(') (== ')') "test (sep) _) balanced"
-- sep_balanced False (== '(') (== ')') "(test (sep) _) balanced"
--
sep_balanced :: Bool -> (a -> Bool) -> (a -> Bool) -> [a] -> ([a], [a])
-- | Group non-nested tuplets, ie. groups nested tuplets at one level.
da_group_tuplets_nn :: [Duration_A] -> [Either Duration_A [Duration_A]]
-- | Keep right variant of zipWith, unused rhs values are returned.
--
--
-- zip_with_kr (,) [1..3] ['a'..'e'] == ([(1,'a'),(2,'b'),(3,'c')],"de")
--
zip_with_kr :: (a -> b -> c) -> [a] -> [b] -> ([c], [b])
-- | Keep right variant of zip, unused rhs values are returned.
--
--
-- zip_kr [1..4] ['a'..'f'] == ([(1,'a'),(2,'b'),(3,'c'),(4,'d')],"ef")
--
zip_kr :: [a] -> [b] -> ([(a, b)], [b])
-- | zipWith variant that adopts the shape of the lhs.
--
--
-- let {p = [Left 1,Right [2,3],Left 4]
-- ;q = "abcd"}
-- in nn_reshape (,) p q == [Left (1,'a'),Right [(2,'b'),(3,'c')],Left (4,'d')]
--
nn_reshape :: (a -> b -> c) -> [Either a [a]] -> [b] -> [Either c [c]]
-- | Replace elements at Traversable with result of joining with
-- elements from list.
adopt_shape :: Traversable t => (a -> b -> c) -> [b] -> t a -> t c
-- | Variant of adopt_shape that considers only Just elements
-- at Traversable.
--
--
-- let {s = "a(b(cd)ef)ghi"
-- ;t = group_tree (begin_end_cmp_eq '(' ')') s}
-- in adopt_shape_m (,) [1..13] t
--
adopt_shape_m :: Traversable t => (a -> b -> c) -> [b] -> t (Maybe a) -> t (Maybe c)
-- | Does a have Tie_Left and Tie_Right?
d_annotated_tied_lr :: [D_Annotation] -> (Bool, Bool)
-- | Does d have Tie_Left and Tie_Right?
duration_a_tied_lr :: Duration_A -> (Bool, Bool)
instance Eq D_Annotation
instance Show D_Annotation
-- | Time Signatures.
module Music.Theory.Time_Signature
-- | A Time Signature is a (numerator,denominator) pair.
type Time_Signature = (Integer, Integer)
-- | Tied, non-multiplied durations to fill a whole measure.
--
--
-- ts_whole_note (3,8) == [dotted_quarter_note]
-- ts_whole_note (2,2) == [whole_note]
--
ts_whole_note :: Time_Signature -> [Duration]
-- | Duration of measure in RQ.
--
--
-- map ts_whole_note_rq [(3,8),(2,2)] == [3/2,4]
--
ts_whole_note_rq :: Time_Signature -> RQ
-- | Duration, in RQ, of a measure of indicated
-- Time_Signature.
--
--
-- map ts_rq [(3,4),(5,8)] == [3,5/2]
--
ts_rq :: Time_Signature -> RQ
-- | Time_Signature derived from whole note duration in RQ
-- form.
--
--
-- map rq_to_ts [4,3/2,7/4,6] == [(4,4),(3,8),(7,16),(6,4)]
--
rq_to_ts :: Rational -> Time_Signature
-- | Uniform division of time signature.
--
--
-- ts_divisions (3,4) == [1,1,1]
-- ts_divisions (3,8) == [1/2,1/2,1/2]
-- ts_divisions (2,2) == [2,2]
-- ts_divisions (1,1) == [4]
--
ts_divisions :: Time_Signature -> [RQ]
-- | Convert a duration to a pulse count in relation to the indicated time
-- signature.
--
--
-- ts_duration_pulses (3,8) quarter_note == 2
--
ts_duration_pulses :: Time_Signature -> Duration -> Rational
-- | Rewrite time signature to indicated denominator.
--
--
-- ts_rewrite 8 (3,4) == (6,8)
--
ts_rewrite :: Integer -> Time_Signature -> Time_Signature
-- | Sum time signatures.
--
--
-- ts_sum [(3,16),(1,2)] == (11,16)
--
ts_sum :: [Time_Signature] -> Time_Signature
-- | A composite time signature is a sequence of Time_Signatures.
type Composite_Time_Signature = [Time_Signature]
-- | The RQ is the sum of ts_rq of the elements.
--
--
-- cts_rq [(3,4),(1,8)] == 3 + 1/2
--
cts_rq :: Composite_Time_Signature -> RQ
-- | The divisions are the concat of the ts_divisions of the
-- elements.
--
--
-- cts_divisions [(3,4),(1,8)] == [1,1,1,1/2]
--
cts_divisions :: Composite_Time_Signature -> [RQ]
-- | Pulses are 1-indexed, RQ locations are 0-indexed.
--
--
-- map (cts_pulse_to_rq [(2,4),(1,8),(1,4)]) [1 .. 4] == [0,1,2,2 + 1/2]
--
cts_pulse_to_rq :: Composite_Time_Signature -> Int -> RQ
-- | Variant that gives the window of the pulse (ie. the start
-- location and the duration).
--
--
-- let r = [(0,1),(1,1),(2,1/2),(2 + 1/2,1)]
-- in map (cts_pulse_to_rqw [(2,4),(1,8),(1,4)]) [1 .. 4] == r
--
cts_pulse_to_rqw :: Composite_Time_Signature -> Int -> (RQ, RQ)
-- | A rational time signature is a Composite_Time_Signature where
-- the parts are Rational.
type Rational_Time_Signature = [(Rational, Rational)]
-- | The sum of the RQ of the elements.
--
--
-- rts_rq [(3,4),(1,8)] == 3 + 1/2
-- rts_rq [(3/2,4),(1/2,8)] == 3/2 + 1/4
--
rts_rq :: Rational_Time_Signature -> RQ
-- | The divisions of the elements.
--
--
-- rts_divisions [(3,4),(1,8)] == [1,1,1,1/2]
-- rts_divisions [(3/2,4),(1/2,8)] == [1,1/2,1/4]
--
rts_divisions :: Rational_Time_Signature -> [[RQ]]
rts_derive :: [RQ] -> Rational_Time_Signature
-- | Pulses are 1-indexed, RQ locations are 0-indexed.
--
--
-- map (rts_pulse_to_rq [(2,4),(1,8),(1,4)]) [1 .. 4] == [0,1,2,2 + 1/2]
-- map (rts_pulse_to_rq [(3/2,4),(1/2,8),(1/4,4)]) [1 .. 4] == [0,1,3/2,7/4]
--
rts_pulse_to_rq :: Rational_Time_Signature -> Int -> RQ
-- | Variant that gives the window of the pulse (ie. the start
-- location and the duration).
--
--
-- let r = [(0,1),(1,1),(2,1/2),(2 + 1/2,1)]
-- in map (rts_pulse_to_rqw [(2,4),(1,8),(1,4)]) [1 .. 4] == r
--
rts_pulse_to_rqw :: Rational_Time_Signature -> Int -> (RQ, RQ)
-- | Abbreviated names for Duration values when written as literals.
-- There are letter names where w is whole_note and
-- so on, and numerical names where _4 is
-- quarter_note and so on. In both cases a ' extension
-- means a dot so that e'' is a double dotted
-- eighth_note.
--
--
-- zipWith duration_compare_meq [e,e,e,e'] [e,s,q,e] == [EQ,GT,LT,GT]
-- zipWith sum_dur [e,q,q'] [e,e,e] == [Just q,Just q',Just h]
-- zipWith sum_dur' [e,q,q'] [e,e,e] == [q,q',h]
--
module Music.Theory.Duration.Name.Abbreviation
w :: Duration
s :: Duration
e :: Duration
q :: Duration
h :: Duration
w' :: Duration
s' :: Duration
e' :: Duration
q' :: Duration
h' :: Duration
w'' :: Duration
s'' :: Duration
e'' :: Duration
q'' :: Duration
h'' :: Duration
_1 :: Duration
_32 :: Duration
_16 :: Duration
_8 :: Duration
_4 :: Duration
_2 :: Duration
_1' :: Duration
_32' :: Duration
_16' :: Duration
_8' :: Duration
_4' :: Duration
_2' :: Duration
_1'' :: Duration
_32'' :: Duration
_16'' :: Duration
_8'' :: Duration
_4'' :: Duration
_2'' :: Duration
-- | Common music notation tempo indications.
module Music.Theory.Tempo_Marking
-- | A tempo marking is in terms of a common music notation
-- Duration.
type Tempo_Marking = (Duration, Rational)
-- | Duration of a RQ value, in seconds, given indicated tempo.
--
--
-- rq_to_seconds (quarter_note,90) 1 == 60/90
--
rq_to_seconds :: Tempo_Marking -> RQ -> Rational
-- | The duration, in seconds, of a pulse at the indicated time signature
-- and tempo marking.
--
--
-- import Music.Theory.Duration.Name
-- pulse_duration (6,8) (quarter_note,60) == 1/2
--
pulse_duration :: Time_Signature -> Tempo_Marking -> Rational
-- | The duration, in seconds, of a measure at the indicated time signaure
-- and tempo marking.
--
--
-- measure_duration (3,4) (quarter_note,90) == 2
-- measure_duration (6,8) (quarter_note,120) == 3/2
--
measure_duration :: Time_Signature -> Tempo_Marking -> Rational
-- | Fractional variant of measure_duration.
measure_duration_f :: Fractional c => Time_Signature -> Tempo_Marking -> c
-- | Italian terms and markings from Wittner metronome (W.-Germany).
-- http://wittner-gmbh.de/
metronome_table_wittner :: Num n => [(String, (n, n))]
-- | Italian terms and markings from Nikko Seiki metronome (Japan).
-- http://nikkoseiki.com/
metronome_table_nikko :: Num n => [(String, (n, n))]
-- | Lookup metronome mark in table.
--
--
-- mm_name metronome_table_nikko 72 == Just "Andante"
--
mm_name :: (Num a, Ord a) => [(String, (a, a))] -> a -> Maybe String
-- | Set operations on lists.
module Music.Theory.Set.List
-- | Remove duplicate elements with nub and then sort.
--
--
-- set_l [3,3,3,2,2,1] == [1,2,3]
--
set :: Ord a => [a] -> [a]
-- | Size of powerset of set of cardinality n, ie. 2
-- ^ n.
--
--
-- map n_powerset [6..9] == [64,128,256,512]
--
n_powerset :: Integral n => n -> n
-- | Powerset, ie. set of all subsets.
--
--
-- sort (powerset [1,2]) == [[],[1],[1,2],[2]]
-- map length (map (\n -> powerset [1..n]) [6..9]) == [64,128,256,512]
--
powerset :: [a] -> [[a]]
-- | Two element subsets.
--
--
-- pairs [1,2,3] == [(1,2),(1,3),(2,3)]
--
pairs :: [a] -> [(a, a)]
-- | Three element subsets.
--
--
-- triples [1..4] == [(1,2,3),(1,2,4),(1,3,4),(2,3,4)]
--
--
--
-- let f n = genericLength (triples [1..n]) == nk_combinations n 3
-- in all f [1..15]
--
triples :: [a] -> [(a, a, a)]
-- | Set expansion (ie. to multiset of degree n).
--
--
-- expand_set 4 [1,2,3] == [[1,1,2,3],[1,2,2,3],[1,2,3,3]]
--
expand_set :: Ord a => Int -> [a] -> [[a]]
-- | All distinct multiset partitions, see partitions.
--
--
-- partitions "aab" == [["aab"],["a","ab"],["b","aa"],["b","a","a"]]
--
--
--
-- partitions "abc" == [["abc"]
-- ,["bc","a"],["b","ac"],["c","ab"]
-- ,["c","b","a"]]
--
partitions :: Eq a => [a] -> [[[a]]]
-- | Cartesian product of two sets.
--
--
-- let r = [('a',1),('a',2),('b',1),('b',2),('c',1),('c',2)]
-- in cartesian_product "abc" [1,2] == r
--
cartesian_product :: [a] -> [b] -> [(a, b)]
-- | Set operations on Sets.
module Music.Theory.Set.Set
set :: Ord a => [a] -> Set a
powerset :: Ord a => Set a -> Set (Set a)
pairs :: Ord a => Set a -> Set (a, a)
-- | Godfried T. Toussaint et. al. "The distance geometry of music"
-- Journal of Computational Geometry: Theory and Applications
-- Volume 42, Issue 5, July, 2009
-- (http://dx.doi.org/10.1016/j.comgeo.2008.04.005)
module Music.Theory.Bjorklund
-- | Bjorklund's algorithm to construct a binary sequence of n bits
-- with k ones such that the k ones are distributed as
-- evenly as possible among the (n - k) zeroes.
--
--
-- bjorklund (5,9) == [True,False,True,False,True,False,True,False,True]
-- xdot (bjorklund (5,9)) == "x.x.x.x.x"
--
--
--
-- let es = [(2,3),(2,5)
-- ,(3,4),(3,5),(3,8)
-- ,(4,7),(4,9),(4,12),(4,15)
-- ,(5,6),(5,7),(5,8),(5,9),(5,11),(5,12),(5,13),(5,16)
-- ,(6,7),(6,13)
-- ,(7,8),(7,9),(7,10),(7,12),(7,15),(7,16),(7,17),(7,18)
-- ,(8,17),(8,19)
-- ,(9,14),(9,16),(9,22),(9,23)
-- ,(11,12),(11,24)
-- ,(13,24)
-- ,(15,34)]
-- in map (\e -> let e' = bjorklund e in (e,xdot e',iseq_str e')) es
--
--
--
-- [((2,3),"xx.","(12)")
-- ,((2,5),"x.x..","(23)")
-- ,((3,4),"xxx.","(112)")
-- ,((3,5),"x.x.x","(221)")
-- ,((3,8),"x..x..x.","(332)")
-- ,((4,7),"x.x.x.x","(2221)")
-- ,((4,9),"x.x.x.x..","(2223)")
-- ,((4,12),"x..x..x..x..","(3333)")
-- ,((4,15),"x...x...x...x..","(4443)")
-- ,((5,6),"xxxxx.","(11112)")
-- ,((5,7),"x.xx.xx","(21211)")
-- ,((5,8),"x.xx.xx.","(21212)")
-- ,((5,9),"x.x.x.x.x","(22221)")
-- ,((5,11),"x.x.x.x.x..","(22223)")
-- ,((5,12),"x..x.x..x.x.","(32322)")
-- ,((5,13),"x..x.x..x.x..","(32323)")
-- ,((5,16),"x..x..x..x..x...","(33334)")
-- ,((6,7),"xxxxxx.","(111112)")
-- ,((6,13),"x.x.x.x.x.x..","(222223)")
-- ,((7,8),"xxxxxxx.","(1111112)")
-- ,((7,9),"x.xxx.xxx","(2112111)")
-- ,((7,10),"x.xx.xx.xx","(2121211)")
-- ,((7,12),"x.xx.x.xx.x.","(2122122)")
-- ,((7,15),"x.x.x.x.x.x.x..","(2222223)")
-- ,((7,16),"x..x.x.x..x.x.x.","(3223222)")
-- ,((7,17),"x..x.x..x.x..x.x.","(3232322)")
-- ,((7,18),"x..x.x..x.x..x.x..","(3232323)")
-- ,((8,17),"x.x.x.x.x.x.x.x..","(22222223)")
-- ,((8,19),"x..x.x.x..x.x.x..x.","(32232232)")
-- ,((9,14),"x.xx.xx.xx.xx.","(212121212)")
-- ,((9,16),"x.xx.x.x.xx.x.x.","(212221222)")
-- ,((9,22),"x..x.x..x.x..x.x..x.x.","(323232322)")
-- ,((9,23),"x..x.x..x.x..x.x..x.x..","(323232323)")
-- ,((11,12),"xxxxxxxxxxx.","(11111111112)")
-- ,((11,24),"x..x.x.x.x.x..x.x.x.x.x.","(32222322222)")
-- ,((13,24),"x.xx.x.x.x.x.xx.x.x.x.x.","(2122222122222)")
-- ,((15,34),"x..x.x.x.x..x.x.x.x..x.x.x.x..x.x.","(322232223222322)")]
--
bjorklund :: (Int, Int) -> [Bool]
-- | xdot notation for pattern.
--
--
-- xdot (bjorklund (5,9)) == "x.x.x.x.x"
--
xdot :: [Bool] -> String
-- | The iseq of a pattern is the distance between True
-- values.
--
--
-- iseq (bjorklund (5,9)) == [2,2,2,2,1]
--
iseq :: [Bool] -> [Int]
-- | iseq of pattern as compact string.
--
--
-- iseq_str (bjorklund (5,9)) == "(22221)"
--
iseq_str :: [Bool] -> String
-- | List functions.
module Music.Theory.List
-- | Bracket sequence with left and right values.
--
--
-- bracket ('<','>') "1,2,3" == "<1,2,3>"
--
bracket :: (a, a) -> [a] -> [a]
-- | Variant where brackets are sequences.
--
--
-- bracket_l ("<:",":>") "1,2,3" == "<:1,2,3:>"
--
bracket_l :: ([a], [a]) -> [a] -> [a]
-- | Generic form of rotate_left.
genericRotate_left :: Integral i => i -> [a] -> [a]
-- | Left rotation.
--
--
-- rotate_left 1 [1..3] == [2,3,1]
-- rotate_left 3 [1..5] == [4,5,1,2,3]
--
rotate_left :: Int -> [a] -> [a]
-- | Generic form of rotate_right.
genericRotate_right :: Integral n => n -> [a] -> [a]
-- | Right rotation.
--
--
-- rotate_right 1 [1..3] == [3,1,2]
--
rotate_right :: Int -> [a] -> [a]
-- | Rotate left by n mod #p places.
--
--
-- rotate 1 [1..3] == [2,3,1]
-- rotate 8 [1..5] == [4,5,1,2,3]
--
rotate :: Integral n => n -> [a] -> [a]
-- | Rotate right by n places.
--
--
-- rotate_r 8 [1..5] == [3,4,5,1,2]
--
rotate_r :: Integral n => n -> [a] -> [a]
-- | All rotations.
--
--
-- rotations [0,1,3] == [[0,1,3],[1,3,0],[3,0,1]]
--
rotations :: [a] -> [[a]]
-- | Generic form of adj2.
genericAdj2 :: Integral n => n -> [t] -> [(t, t)]
-- | Adjacent elements of list, at indicated distance, as pairs.
--
--
-- adj2 1 [1..5] == [(1,2),(2,3),(3,4),(4,5)]
-- adj2 2 [1..4] == [(1,2),(3,4)]
-- adj2 3 [1..5] == [(1,2),(4,5)]
--
adj2 :: Int -> [t] -> [(t, t)]
-- | Append first element to end of list.
--
--
-- close [1..3] == [1,2,3,1]
--
close :: [a] -> [a]
-- | adj2 . close.
--
--
-- adj2_cyclic 1 [1..3] == [(1,2),(2,3),(3,1)]
--
adj2_cyclic :: Int -> [t] -> [(t, t)]
-- | Interleave elements of p and q.
--
--
-- interleave [1..3] [4..6] == [1,4,2,5,3,6]
-- interleave ".+-" "abc" == ".a+b-c"
-- interleave [1..3] [] == []
--
interleave :: [b] -> [b] -> [b]
-- | Variant that continues with the longer input.
--
--
-- interleave_continue ".+-" "abc" == ".a+b-c"
-- interleave_continue [1..3] [] == [1..3]
-- interleave_continue [] [1..3] == [1..3]
--
interleave_continue :: [a] -> [a] -> [a]
-- | interleave of rotate_left by i and j.
--
--
-- interleave_rotations 9 3 [1..13] == [10,4,11,5,12,6,13,7,1,8,2,9,3,10,4,11,5,12,6,13,7,1,8,2,9,3]
--
interleave_rotations :: Int -> Int -> [b] -> [b]
-- | Count occurences of elements in list.
--
--
-- histogram "hohoh" == [('h',3),('o',2)]
--
histogram :: (Ord a, Integral i) => [a] -> [(a, i)]
-- | List segments of length i at distance j.
--
--
-- segments 2 1 [1..5] == [[1,2],[2,3],[3,4],[4,5]]
-- segments 2 2 [1..5] == [[1,2],[3,4]]
--
segments :: Int -> Int -> [a] -> [[a]]
-- | foldl1 intersect.
--
--
-- intersect_l [[1,2],[1,2,3],[1,2,3,4]] == [1,2]
--
intersect_l :: Eq a => [[a]] -> [a]
-- | foldl1 union.
--
--
-- sort (union_l [[1,3],[2,3],[3]]) == [1,2,3]
--
union_l :: Eq a => [[a]] -> [a]
-- | Intersection of adjacent elements of list at distance n.
--
--
-- adj_intersect 1 [[1,2],[1,2,3],[1,2,3,4]] == [[1,2],[1,2,3]]
--
adj_intersect :: Eq a => Int -> [[a]] -> [[a]]
-- | List of cycles at distance n.
--
--
-- cycles 2 [1..6] == [[1,3,5],[2,4,6]]
-- cycles 3 [1..9] == [[1,4,7],[2,5,8],[3,6,9]]
-- cycles 4 [1..8] == [[1,5],[2,6],[3,7],[4,8]]
--
cycles :: Int -> [a] -> [[a]]
-- | Given accesors for key and value collate input.
--
--
-- let r = [('A',"a"),('B',"bd"),('C',"ce"),('D',"f")]
-- in collate_on fst snd (zip "ABCBCD" "abcdef")
--
collate_on :: (Eq k, Ord k) => (a -> k) -> (a -> v) -> [a] -> [(k, [v])]
-- | collate_on of fst and snd.
--
--
-- collate (zip [1,2,1] "abc") == [(1,"ac"),(2,"b")]
--
collate :: Ord a => [(a, b)] -> [(a, [b])]
-- | Make assoc list with given key.
--
--
-- with_key 'a' [1..3] == [('a',1),('a',2),('a',3)]
--
with_key :: k -> [v] -> [(k, v)]
-- | Intervals to values, zero is n.
--
--
-- dx_d 5 [1,2,3] == [5,6,8,11]
--
dx_d :: Num a => a -> [a] -> [a]
-- | Variant that takes initial value and separates final value. This is an
-- appropriate function for mapAccumL.
--
--
-- dx_d' 5 [1,2,3] == (11,[5,6,8])
-- dx_d' 0 [1,1,1] == (3,[0,1,2])
--
dx_d' :: Num t => t -> [t] -> (t, [t])
-- | Integrate, ie. pitch class segment to interval sequence.
--
--
-- d_dx [5,6,8,11] == [1,2,3]
-- d_dx [] == []
--
d_dx :: Num a => [a] -> [a]
-- | Elements of p not in q.
--
--
-- [1,2,3] `difference` [1,2] == [3]
--
difference :: Eq a => [a] -> [a] -> [a]
-- | Is p a subset of q, ie. is intersect of p
-- and q == p.
--
--
-- is_subset [1,2] [1,2,3] == True
--
is_subset :: Eq a => [a] -> [a] -> Bool
-- | Is p a superset of q, ie. flip is_subset.
--
--
-- is_superset [1,2,3] [1,2] == True
--
is_superset :: Eq a => [a] -> [a] -> Bool
-- | Is p a subsequence of q, ie. synonym for
-- isInfixOf.
--
--
-- subsequence [1,2] [1,2,3] == True
--
subsequence :: Eq a => [a] -> [a] -> Bool
-- | Variant of elemIndices that requires e to be unique in
-- p.
--
--
-- elem_index_unique 'a' "abcda" == undefined
--
elem_index_unique :: Eq a => a -> [a] -> Int
-- | Basis of find_bounds. There is an option to consider the last
-- element specially, and if equal to the last span is given.
find_bounds' :: Bool -> (t -> s -> Ordering) -> [(t, t)] -> s -> Maybe (t, t)
-- | Find adjacent elements of list that bound element under given
-- comparator.
--
--
-- let {f = find_bounds True compare [1..5]
-- ;r = [Nothing,Just (1,2),Just (3,4),Just (4,5)]}
-- in map f [0,1,3.5,5] == r
--
find_bounds :: Bool -> (t -> s -> Ordering) -> [t] -> s -> Maybe (t, t)
-- | Variant of drop from right of list.
--
--
-- dropRight 1 [1..9] == [1..8]
--
dropRight :: Int -> [a] -> [a]
-- | Variant of dropWhile from right of list.
--
--
-- dropWhileRight Data.Char.isDigit "A440" == "A"
--
dropWhileRight :: (a -> Bool) -> [a] -> [a]
-- | Apply f at first element, and g at all other elements.
--
--
-- at_head negate id [1..5] == [-1,2,3,4,5]
--
at_head :: (a -> b) -> (a -> b) -> [a] -> [b]
-- | Apply f at all but last element, and g at last element.
--
--
-- at_last (* 2) negate [1..4] == [2,4,6,-4]
--
at_last :: (a -> b) -> (a -> b) -> [a] -> [b]
-- | Separate list into an initial list and a last element tuple.
--
--
-- separate_last [1..5] == ([1..4],5)
--
separate_last :: [a] -> ([a], a)
-- | Replace directly repeated elements with Nothing.
--
--
-- indicate_repetitions "abba" == [Just 'a',Just 'b',Nothing,Just 'a']
--
indicate_repetitions :: Eq a => [a] -> [Maybe a]
-- | groupBy does not make adjacent comparisons, it compares each
-- new element to the start of the group. This function is the adjacent
-- variant.
--
--
-- groupBy (<) [1,2,3,2,4,1,5,9] == [[1,2,3,2,4],[1,5,9]]
-- adjacent_groupBy (<) [1,2,3,2,4,1,5,9] == [[1,2,3],[2,4],[1,5,9]]
--
adjacent_groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
-- | groupBy on structure of Maybe, ie. all
-- Just compare equal.
--
--
-- let r = [[Just 1],[Nothing,Nothing],[Just 4,Just 5]]
-- in group_just [Just 1,Nothing,Nothing,Just 4,Just 5] == r
--
group_just :: [Maybe a] -> [[Maybe a]]
-- | Predicate to determine if all elements of the list are ==.
all_eq :: Eq n => [n] -> Bool
-- | groupBy of sortBy.
--
--
-- let r = [[('1','a'),('1','c')],[('2','d')],[('3','b'),('3','e')]]
-- in sort_group_on fst (zip "13123" "abcde") == r
--
sort_group_on :: Ord b => (a -> b) -> [a] -> [[a]]
-- | Maybe cons element onto list.
--
--
-- Nothing `mcons` "something" == "something"
-- Just 's' `mcons` "omething" == "something"
--
mcons :: Maybe a -> [a] -> [a]
-- | Comparison function type.
type Compare_F a = a -> a -> Ordering
-- | If f compares EQ, defer to g.
two_stage_compare :: Compare_F a -> Compare_F a -> Compare_F a
-- | Invert Ordering.
ordering_invert :: Ordering -> Ordering
-- | Sort sequence a based on ordering of sequence b.
--
--
-- sort_to "abc" [1,3,2] == "acb"
-- sort_to "adbce" [1,4,2,3,5] == "abcde"
--
sort_to :: Ord i => [e] -> [i] -> [e]
-- | flip of sort_to.
--
--
-- sort_on [1,4,2,3,5] "adbce" == "abcde"
--
sort_on :: Ord i => [i] -> [e] -> [e]
-- | sortBy of two_stage_compare.
sort_by_two_stage :: (Ord b, Ord c) => (a -> b) -> (a -> c) -> [a] -> [a]
-- | Given a comparison function, merge two ascending lists.
--
--
-- mergeBy compare [1,3,5] [2,4] == [1..5]
--
merge_by :: Compare_F a -> [a] -> [a] -> [a]
-- | mergeBy of two_stage_compare.
merge_by_two_stage :: Ord b => (a -> b) -> Compare_F c -> (a -> c) -> [a] -> [a] -> [a]
-- | mergeBy compare.
merge :: Ord a => [a] -> [a] -> [a]
-- | Merge list of sorted lists given comparison function. Note that this
-- is not equal to mergeAll.
merge_set_by :: (a -> a -> Ordering) -> [[a]] -> [a]
-- | merge_set_by of compare.
--
--
-- merge_set [[1,3,5,7,9],[2,4,6,8],[10]] == [1..10]
--
merge_set :: Ord a => [[a]] -> [a]
-- | merge_by variant that joins (resolves) equal elements.
--
--
-- let {left p _ = p
-- ;right _ q = q
-- ;cmp = compare `on` fst
-- ;p = zip [1,3,5] "abc"
-- ;q = zip [1,2,3] "ABC"
-- ;left_r = [(1,'a'),(2,'B'),(3,'b'),(5,'c')]
-- ;right_r = [(1,'A'),(2,'B'),(3,'C'),(5,'c')]}
-- in merge_by_resolve left cmp p q == left_r &&
-- merge_by_resolve right cmp p q == right_r
--
merge_by_resolve :: (a -> a -> a) -> Compare_F a -> [a] -> [a] -> [a]
-- | Apply f to both elements of a two-tuple, ie. bimap
-- f f.
bimap1 :: (t -> u) -> (t, t) -> (u, u)
-- | Basic temporal sequence functions.
module Music.Theory.Time.Seq
-- | Sequence of elements with uniform duration.
type Useq t a = (t, [a])
-- | Duration sequence. The duration is the forward duration of the
-- value, if it has other durations they must be encoded at a.
type Dseq t a = [(t, a)]
-- | Inter-offset sequence. The duration is the interval before the
-- value. To indicate the duration of the final value a must have
-- an nil (end of sequence) value.
type Iseq t a = [(t, a)]
-- | Pattern sequence. The duration is a triple of logical,
-- sounding and forward durations.
type Pseq t a = [((t, t, t), a)]
-- | Time-point sequence. To express holes a must have a
-- empty value. To indicate the duration of the final value
-- a must have an nil (end of sequence) value.
type Tseq t a = [(t, a)]
-- | Window sequence. The temporal field is (time,duration).
-- Holes exist where t(n) + d(n) < t(n+1).
-- Overlaps exist where the same relation is >.
type Wseq t a = [((t, t), a)]
pseq_zip :: [t] -> [t] -> [t] -> [a] -> Pseq t a
wseq_zip :: [t] -> [t] -> [a] -> Wseq t a
-- | Given functions for deriving start and end times calculate time span
-- of sequence.
--
--
-- seq_tspan id id [] == (0,0)
-- seq_tspan id id (zip [0..9] ['a'..]) == (0,9)
--
seq_tspan :: Num n => (t -> n) -> (t -> n) -> [(t, a)] -> (n, n)
tseq_tspan :: Num t => Tseq t a -> (t, t)
wseq_tspan :: Num t => Wseq t a -> (t, t)
dseq_dur :: Num t => Dseq t a -> t
iseq_dur :: Num t => Iseq t a -> t
pseq_dur :: Num t => Pseq t a -> t
-- | The interval of tseq_tspan.
--
--
-- tseq_dur (zip [0..] "abcde|") == 5
--
tseq_dur :: Num t => Tseq t a -> t
-- | The interval of wseq_tspan.
--
--
-- wseq_dur (zip (zip [0..] (repeat 2)) "abcde") == 6
--
wseq_dur :: Num t => Wseq t a -> t
-- | Keep only elements in the indicated temporal window.
--
--
-- let r = [((5,1),'e'),((6,1),'f'),((7,1),'g'),((8,1),'h')]
-- in wseq_twindow (5,9) (zip (zip [1..10] (repeat 1)) ['a'..]) == r
--
wseq_twindow :: (Num t, Ord t) => (t, t) -> Wseq t a -> Wseq t a
dseq_append :: Dseq t a -> Dseq t a -> Dseq t a
iseq_append :: Iseq t a -> Iseq t a -> Iseq t a
pseq_append :: Pseq t a -> Pseq t a -> Pseq t a
-- | Merge comparing only on time.
tseq_merge :: Ord t => Tseq t a -> Tseq t a -> Tseq t a
-- | Merge, where times are equal compare values.
tseq_merge_by :: Ord t => Compare_F a -> Tseq t a -> Tseq t a -> Tseq t a
-- | Merge, where times are equal apply f to form a single value.
--
--
-- let {p = zip [1,3,5] "abc"
-- ;q = zip [1,2,3] "ABC"
-- ;left_r = [(1,'a'),(2,'B'),(3,'b'),(5,'c')]
-- ;right_r = [(1,'A'),(2,'B'),(3,'C'),(5,'c')]}
-- in tseq_merge_resolve (\x _ -> x) p q == left_r &&
-- tseq_merge_resolve (\_ x -> x) p q == right_r
--
tseq_merge_resolve :: Ord t => (a -> a -> a) -> Tseq t a -> Tseq t a -> Tseq t a
wseq_merge :: Ord t => Wseq t a -> Wseq t a -> Wseq t a
tseq_lookup_window_by :: (t -> t -> Ordering) -> Tseq t e -> t -> (Maybe (t, e), Maybe (t, e))
tseq_lookup_active_by :: (t -> t -> Ordering) -> Tseq t e -> t -> Maybe e
tseq_lookup_active :: Ord t => Tseq t e -> t -> Maybe e
tseq_lookup_active_by_def :: e -> (t -> t -> Ordering) -> Tseq t e -> t -> e
tseq_lookup_active_def :: Ord t => e -> Tseq t e -> t -> e
data Interpolation_T
None :: Interpolation_T
Linear :: Interpolation_T
-- | Variant of Tseq where nodes have an Intepolation_T
-- value.
type Lseq t a = Tseq (t, Interpolation_T) a
-- | Linear interpolation.
lerp :: (Fractional t, Real t, Fractional e) => (t, e) -> (t, e) -> t -> e
-- | Temporal map.
lseq_tmap :: (t -> t') -> Lseq t a -> Lseq t' a
-- | This can give Nothing if t precedes the Lseq or
-- if t is after the final element of Lseq and that element
-- has an interpolation type other than None.
lseq_lookup :: (Fractional t, Real t, Fractional e) => (t -> t -> Ordering) -> Lseq t e -> t -> Maybe e
-- | erroring variant.
lseq_lookup_err :: (Fractional t, Real t, Fractional e) => (t -> t -> Ordering) -> Lseq t e -> t -> e
seq_tmap :: (t -> t') -> [(t, a)] -> [(t', a)]
seq_map :: (b -> c) -> [(a, b)] -> [(a, c)]
-- | Map t and e simultaneously.
seq_bimap :: (t -> t') -> (e -> e') -> [(t, e)] -> [(t', e')]
seq_tfilter :: (t -> Bool) -> [(t, a)] -> [(t, a)]
seq_filter :: (b -> Bool) -> [(a, b)] -> [(a, b)]
seq_find :: (a -> Bool) -> [(t, a)] -> Maybe (t, a)
-- | mapMaybe variant.
seq_map_maybe :: (p -> Maybe q) -> [(t, p)] -> [(t, q)]
-- | Variant of catMaybes.
seq_cat_maybes :: [(t, Maybe q)] -> [(t, q)]
-- | If value is unchanged, according to f, replace with
-- Nothing.
--
--
-- let r = [(1,'s'),(2,'t'),(4,'r'),(6,'i'),(7,'n'),(9,'g')]
-- in seq_cat_maybes (seq_changed_by (==) (zip [1..] "sttrrinng")) == r
--
seq_changed_by :: (a -> a -> Bool) -> [(t, a)] -> [(t, Maybe a)]
-- | seq_changed_by ==.
seq_changed :: Eq a => [(t, a)] -> [(t, Maybe a)]
-- | Apply f at time points of Wseq.
wseq_tmap_st :: (t -> t) -> Wseq t a -> Wseq t a
-- | Apply f at durations of elements of Wseq.
wseq_tmap_dur :: (t -> t) -> Wseq t a -> Wseq t a
-- | Given a function that determines a voice for a value, partition
-- a sequence into voices.
seq_partition :: Ord v => (a -> v) -> [(t, a)] -> [(v, [(t, a)])]
-- | Type specialised seq_partition.
--
--
-- let {p = zip [0,1,3,5] (zip (repeat 0) "abcd")
-- ;q = zip [2,4,6,7] (zip (repeat 1) "ABCD")
-- ;sq = tseq_merge p q}
-- in tseq_partition fst sq == [(0,p),(1,q)]
--
tseq_partition :: Ord v => (a -> v) -> Tseq t a -> [(v, Tseq t a)]
wseq_partition :: Ord v => (a -> v) -> Wseq t a -> [(v, Wseq t a)]
-- | Given a decision predicate and a join function, recursively join
-- adjacent elements.
--
--
-- coalesce_f undefined undefined [] == []
-- coalesce_f (==) const "abbcccbba" == "abcba"
-- coalesce_f (==) (+) [1,2,2,3,3,3] == [1,4,6,3]
--
coalesce_f :: (t -> t -> Bool) -> (t -> t -> t) -> [t] -> [t]
-- | coalesce_f using mappend for the join function.
coalesce_m :: Monoid t => (t -> t -> Bool) -> [t] -> [t]
-- | Form of coalesce_f where the decision predicate is on the
-- element, and a join function sums the times.
--
--
-- let r = [(1,'a'),(2,'b'),(3,'c'),(2,'d'),(1,'e')]
-- in seq_coalesce (==) const (useq_to_dseq (1,"abbcccdde")) == r
--
seq_coalesce :: Num t => (a -> a -> Bool) -> (a -> a -> a) -> [(t, a)] -> [(t, a)]
dseq_coalesce :: Num t => (a -> a -> Bool) -> (a -> a -> a) -> Dseq t a -> Dseq t a
-- | Given equality predicate, simplify sequence by summing
-- durations of adjacent equal elements. This is a special case of
-- dseq_coalesce where the join function is const.
-- The implementation is simpler and non-recursive.
--
--
-- let {d = useq_to_dseq (1,"abbcccdde")
-- ;r = dseq_coalesce (==) const d}
-- in dseq_coalesce' (==) d == r
--
dseq_coalesce' :: Num t => (a -> a -> Bool) -> Dseq t a -> Dseq t a
iseq_coalesce :: Num t => (a -> a -> Bool) -> (a -> a -> a) -> Iseq t a -> Iseq t a
seq_tcoalesce :: (t -> t -> Bool) -> (a -> a -> a) -> [(t, a)] -> [(t, a)]
tseq_tcoalesce :: Eq t => (a -> a -> a) -> Tseq t a -> Tseq t a
wseq_tcoalesce :: ((t, t) -> (t, t) -> Bool) -> (a -> a -> a) -> Wseq t a -> Wseq t a
-- | Post-process groupBy of cmp on fst.
--
--
-- let r = [(0,"a"),(1,"bc"),(2,"de"),(3,"f")]
-- in group_f (==) (zip [0,1,1,2,2,3] ['a'..]) == r
--
group_f :: (Eq t, Num t) => (t -> t -> Bool) -> [(t, a)] -> [(t, [a])]
-- | Group values at equal time points.
--
--
-- let r = [(0,"a"),(1,"bc"),(2,"de"),(3,"f")]
-- in tseq_group (zip [0,1,1,2,2,3] ['a'..]) == r
--
tseq_group :: (Eq t, Num t) => Tseq t a -> Tseq t [a]
-- | Group values where the inter-offset time is 0 to the left.
--
--
-- let r = [(0,"a"),(1,"bcd"),(1,"ef")]
-- in iseq_group (zip [0,1,0,0,1,0] ['a'..]) == r
--
iseq_group :: (Eq t, Num t) => Iseq t a -> Iseq t [a]
-- | Set durations so that there are no gaps or overlaps.
--
--
-- let r = wseq_zip [0,3,5] [3,2,1] "abc"
-- in wseq_fill_dur (wseq_zip [0,3,5] [2,1,1] "abc") == r
--
wseq_fill_dur :: Num t => Wseq t a -> Wseq t a
dseq_lcm :: Dseq Rational e -> Integer
-- | Scale by lcm so that all durations are integral.
dseq_set_whole :: [Dseq Rational e] -> [Dseq Integer e]
-- | Given a a default value, a Tseq sq and a list of
-- time-points t, generate a Tseq that is a union of the
-- timepoints at sq and t where times in t not at
-- sq are given the current value, or def if there
-- is no value.
--
--
-- tseq_latch 'a' [(2,'b'),(4,'c')] [1..5] == zip [1..5] "abbcc"
--
tseq_latch :: Ord t => a -> Tseq t a -> [t] -> Tseq t a
-- | Transform Wseq to Tseq by discaring durations.
wseq_discard_dur :: Wseq t a -> Tseq t a
-- | Edit durations to ensure that notes don't overlap. If the same note is
-- played simultaneously delete shorter note. If a note extends into a
-- later note shorten duration (apply d_fn to iot).
wseq_remove_overlaps :: (Eq e, Ord t, Num t) => (e -> e -> Bool) -> (t -> t) -> Wseq t e -> Wseq t e
-- | Unjoin elements (assign equal time stamps to all elements).
seq_unjoin :: [(t, [e])] -> [(t, e)]
-- | Type specialised.
wseq_unjoin :: Wseq t [e] -> Wseq t e
-- | Container for values that have on and off modes.
data On_Off a
On :: a -> On_Off a
Off :: a -> On_Off a
-- | Structural comparison at On_Off, On compares less than
-- Off.
cmp_on_off :: On_Off a -> On_Off b -> Ordering
-- | Translate container types.
either_to_on_off :: Either a a -> On_Off a
-- | Translate container types.
on_off_to_either :: On_Off a -> Either a a
-- | Convert Wseq to Tseq transforming elements to On
-- and Off parts. When merging, off elements precede
-- on elements at equal times.
--
--
-- let {sq = [((0,5),'a'),((2,2),'b')]
-- ;r = [(0,On 'a'),(2,On 'b'),(4,Off 'b'),(5,Off 'a')]}
-- in wseq_on_off sq == r
--
--
--
-- let {sq = [((0,1),'a'),((1,1),'b'),((2,1),'c')]
-- ;r = [(0,On 'a'),(1,Off 'a')
-- ,(1,On 'b'),(2,Off 'b')
-- ,(2,On 'c'),(3,Off 'c')]}
-- in wseq_on_off sq == r
--
wseq_on_off :: (Num t, Ord t) => Wseq t a -> Tseq t (On_Off a)
-- | on_off_to_either of wseq_on_off.
wseq_on_off_either :: (Num t, Ord t) => Wseq t a -> Tseq t (Either a a)
-- | Variant that applies on and off functions to nodes.
--
--
-- let {sq = [((0,5),'a'),((2,2),'b')]
-- ;r = [(0,'A'),(2,'B'),(4,'b'),(5,'a')]}
-- in wseq_on_off_f Data.Char.toUpper id sq == r
--
wseq_on_off_f :: (Ord t, Num t) => (a -> b) -> (a -> b) -> Wseq t a -> Tseq t b
-- | Inverse of wseq_on_off given a predicate function for locating
-- the off node of an on node.
--
--
-- let {sq = [(0,On 'a'),(2,On 'b'),(4,Off 'b'),(5,Off 'a')]
-- ;r = [((0,5),'a'),((2,2),'b')]}
-- in tseq_on_off_to_wseq (==) sq == r
--
tseq_on_off_to_wseq :: Num t => (a -> a -> Bool) -> Tseq t (On_Off a) -> Wseq t a
useq_to_dseq :: Useq t a -> Dseq t a
-- | The conversion requires a start time and a nil value used as an
-- eof marker. Productive given indefinite input sequence.
--
--
-- let r = zip [0,1,3,6,8,9] "abcde|"
-- in dseq_to_tseq 0 '|' (zip [1,2,3,2,1] "abcde") == r
--
--
--
-- let {d = zip [1,2,3,2,1] "abcde"
-- ;r = zip [0,1,3,6,8,9,10] "abcdeab"}
-- in take 7 (dseq_to_tseq 0 undefined (cycle d)) == r
--
dseq_to_tseq :: Num t => t -> a -> Dseq t a -> Tseq t a
-- | Variant where the nil is take as the last element of the
-- sequence.
--
--
-- let r = zip [0,1,3,6,8,9] "abcdee"
-- in dseq_to_tseq_last 0 (zip [1,2,3,2,1] "abcde") == r
--
dseq_to_tseq_last :: Num t => t -> Dseq t a -> Tseq t a
-- | The conversion requires a start time and does not consult the
-- logical duration.
--
--
-- let p = pseq_zip (repeat undefined) (cycle [1,2]) (cycle [1,1,2]) "abcdef"
-- in pseq_to_wseq 0 p == wseq_zip [0,1,2,4,5,6] (cycle [1,2]) "abcdef"
--
pseq_to_wseq :: Num t => t -> Pseq t a -> Wseq t a
-- | The last element of Tseq is required to be an eof marker
-- that has no duration and is not represented in the Dseq.
--
--
-- let r = zip [1,2,3,2,1] "abcde"
-- in tseq_to_dseq undefined (zip [0,1,3,6,8,9] "abcde|") == r
--
--
--
-- let r = zip [1,2,3,2,1] "-abcd"
-- in tseq_to_dseq '-' (zip [1,3,6,8,9] "abcd|") == r
--
tseq_to_dseq :: (Ord t, Num t) => a -> Tseq t a -> Dseq t a
-- | The last element of Tseq is required to be an eof marker
-- that has no duration and is not represented in the Wseq. The
-- duration of each value is either derived from the value, if an
-- dur function is given, or else the inter-offset time.
--
--
-- let r = wseq_zip [0,1,3,6,8] [1,2,3,2,1] "abcde"
-- in tseq_to_wseq Nothing (zip [0,1,3,6,8,9] "abcde|") == r
--
--
--
-- let r = wseq_zip [0,1,3,6,8] (map fromEnum "abcde") "abcde"
-- in tseq_to_wseq (Just fromEnum) (zip [0,1,3,6,8,9] "abcde|") == r
--
tseq_to_wseq :: Num t => Maybe (a -> t) -> Tseq t a -> Wseq t a
tseq_to_iseq :: Num t => Tseq t a -> Dseq t a
-- | Requires start time.
--
--
-- let r = zip (zip [0,1,3,6,8,9] [1,2,3,2,1]) "abcde"
-- in dseq_to_wseq 0 (zip [1,2,3,2,1] "abcde") == r
--
dseq_to_wseq :: Num t => t -> Dseq t a -> Wseq t a
-- | Inverse of dseq_to_wseq. The empty value is used to fill
-- holes in Wseq. If values overlap at Wseq durations are
-- truncated.
--
--
-- let w = wseq_zip [0,1,3,6,8,9] [1,2,3,2,1] "abcde"
-- in wseq_to_dseq '-' w == zip [1,2,3,2,1] "abcde"
--
--
--
-- let w = wseq_zip [3,10] [6,2] "ab"
-- in wseq_to_dseq '-' w == zip [3,6,1,2] "-a-b"
--
--
--
-- let w = wseq_zip [0,1] [2,2] "ab"
-- in wseq_to_dseq '-' w == zip [1,2] "ab"
--
--
--
-- let w = wseq_zip [0,0,0] [2,2,2] "abc"
-- in wseq_to_dseq '-' w == zip [0,0,2] "abc"
--
wseq_to_dseq :: (Num t, Ord t) => a -> Wseq t a -> Dseq t a
-- | Given a list of Dseq (measures) convert to a list of
-- Tseq and the end time of the overall sequence.
--
--
-- let r = [[(0,'a'),(1,'b'),(3,'c')],[(4,'d'),(7,'e'),(9,'f')]]
-- in dseql_to_tseql 0 [zip [1,2,1] "abc",zip [3,2,1] "def"] == (10,r)
--
dseql_to_tseql :: Num t => t -> [Dseq t a] -> (t, [Tseq t a])
dseq_tmap :: (t -> t') -> Dseq t a -> Dseq t' a
pseq_tmap :: ((t, t, t) -> (t', t', t')) -> Pseq t a -> Pseq t' a
tseq_tmap :: (t -> t') -> Dseq t a -> Dseq t' a
tseq_bimap :: (t -> t') -> (e -> e') -> Tseq t e -> Tseq t' e'
wseq_tmap :: ((t, t) -> (t', t')) -> Wseq t a -> Wseq t' a
dseq_map :: (a -> b) -> Dseq t a -> Dseq t b
pseq_map :: (a -> b) -> Pseq t a -> Pseq t b
tseq_map :: (a -> b) -> Tseq t a -> Tseq t b
wseq_map :: (a -> b) -> Wseq t a -> Wseq t b
dseq_tfilter :: (t -> Bool) -> Dseq t a -> Dseq t a
iseq_tfilter :: (t -> Bool) -> Iseq t a -> Iseq t a
pseq_tfilter :: ((t, t, t) -> Bool) -> Pseq t a -> Pseq t a
tseq_tfilter :: (t -> Bool) -> Tseq t a -> Tseq t a
wseq_tfilter :: ((t, t) -> Bool) -> Wseq t a -> Wseq t a
dseq_filter :: (a -> Bool) -> Dseq t a -> Dseq t a
iseq_filter :: (a -> Bool) -> Iseq t a -> Iseq t a
pseq_filter :: (a -> Bool) -> Pseq t a -> Pseq t a
tseq_filter :: (a -> Bool) -> Tseq t a -> Tseq t a
wseq_filter :: (a -> Bool) -> Wseq t a -> Wseq t a
wseq_map_maybe :: (a -> Maybe b) -> Wseq t a -> Wseq t b
wseq_cat_maybes :: Wseq t (Maybe a) -> Wseq t a
instance Eq Interpolation_T
instance Enum Interpolation_T
instance Show Interpolation_T
instance Eq a => Eq (On_Off a)
instance Show a => Show (On_Off a)
-- | Regular array data as markdown (MD) tables.
module Music.Theory.Array.MD
-- | Append k to the right of l until result has n
-- places.
pad_right :: a -> Int -> [a] -> [a]
-- | Append k to each row of tbl as required to be regular
-- (all rows equal length).
make_regular :: a -> [[a]] -> [[a]]
-- | Delete trailing Char where isSpace holds.
delete_trailing_whitespace :: [Char] -> [Char]
-- | Optional header row then data rows.
type MD_Table t = (Maybe [String], [[t]])
-- | Join second table to right of initial table.
md_table_join :: MD_Table a -> MD_Table a -> MD_Table a
-- | Add a row number column at the front of the table.
md_number_rows :: MD_Table String -> MD_Table String
-- | Markdown table, perhaps with header. Table is in row order. Options
-- are: pad_left.
--
--
-- md_table_opt False (Nothing,[["a","bc","def"],["ghij","klm","no","p"]])
--
md_table_opt :: Bool -> MD_Table String -> [String]
md_table' :: MD_Table String -> [String]
-- | curry of md_table'.
md_table :: Maybe [String] -> [[String]] -> [String]
-- | Variant relying on Show instances.
--
--
-- md_table_show Nothing [[1..4],[5..8],[9..12]]
--
md_table_show :: Show t => Maybe [String] -> [[t]] -> [String]
-- | Variant in column order (ie. transpose).
--
--
-- md_table_column_order [["a","bc","def"],["ghij","klm","no"]]
--
md_table_column_order :: Maybe [String] -> [[String]] -> [String]
-- | Two-tuple show variant.
md_table_p2 :: (Show a, Show b) => Maybe [String] -> ([a], [b]) -> [String]
-- | Three-tuple show variant.
md_table_p3 :: (Show a, Show b, Show c) => Maybe [String] -> ([a], [b], [c]) -> [String]
-- | Matrix form, ie. header in both first row and first column, in each
-- case displaced by one location which is empty.
--
--
-- let t = md_matrix "" (map return "abc") (map (map show) [[1,2,3],[2,3,1],[3,1,2]])
--
--
--
-- >>> putStrLn $ unlines $ md_table' t
-- - - - -
-- a b c
-- a 1 2 3
-- b 2 3 1
-- c 3 1 2
-- - - - -
--
md_matrix :: a -> [a] -> [[a]] -> MD_Table a
-- | Variant for String tables where nil is the empty string
-- and the header cells are in bold.
md_matrix_bold :: [String] -> [[String]] -> MD_Table String
-- | Tom Johnson. "Networks". In Conference on Mathematics and Computation
-- in Music, Berlin, May 2007.
module Music.Theory.Block_Design.Johnson_2007
data Design i
Design :: [i] -> [[i]] -> Design i
c_7_3_1 :: Num i => [i]
b_7_3_1 :: (Ord i, Num i) => ([[i]], [[i]])
d_7_3_1 :: (Enum n, Ord n, Num n) => (Design n, Design n)
n_7_3_1 :: Num i => [(i, i)]
p_9_3_1 :: Num i => [[i]]
b_13_4_1 :: (Enum i, Num i, Ord i) => ([[i]], [[i]])
d_13_4_1 :: (Enum n, Ord n, Num n) => (Design n, Design n)
n_13_4_1 :: Num i => [(i, i)]
b_12_4_3 :: Integral i => [[i]]
n_12_4_3 :: Num i => [(i, i)]
-- | Common music notation pitch values.
module Music.Theory.Pitch
-- | Pitch classes are modulo twelve integers.
type PitchClass = Int
-- | Octaves are integers, the octave of middle C is 4.
type Octave = Int
-- | Octave and PitchClass duple.
type Octave_PitchClass i = (i, i)
type OctPC = (Octave, PitchClass)
-- | Common music notation pitch value.
data Pitch
Pitch :: Note_T -> Alteration_T -> Octave -> Pitch
note :: Pitch -> Note_T
alteration :: Pitch -> Alteration_T
octave :: Pitch -> Octave
-- | Generalised pitch, given by a generalised alteration.
data Pitch'
Pitch' :: Note_T -> Alteration_T' -> Octave -> Pitch'
-- | Pretty printer for Pitch'.
pitch'_pp :: Pitch' -> String
-- | Pitch' printed without octave.
pitch'_class_pp :: Pitch' -> String
-- | Simplify Pitch to standard 12ET by deleting quarter tones.
--
--
-- let p = Pitch A QuarterToneSharp 4
-- in alteration (pitch_clear_quarter_tone p) == Sharp
--
pitch_clear_quarter_tone :: Pitch -> Pitch
-- | Pitch to Octave and PitchClass notation.
--
--
-- pitch_to_octpc (Pitch F Sharp 4) == (4,6)
--
pitch_to_octpc :: Integral i => Pitch -> Octave_PitchClass i
-- | Is Pitch 12-ET.
pitch_is_12et :: Pitch -> Bool
-- | Pitch to midi note number notation.
--
--
-- pitch_to_midi (Pitch A Natural 4) == 69
--
pitch_to_midi :: Integral i => Pitch -> i
-- | Pitch to fractional midi note number notation.
--
--
-- pitch_to_fmidi (Pitch A QuarterToneSharp 4) == 69.5
--
pitch_to_fmidi :: Fractional n => Pitch -> n
-- | Extract PitchClass of Pitch
--
--
-- pitch_to_pc (Pitch A Natural 4) == 9
-- pitch_to_pc (Pitch F Sharp 4) == 6
--
pitch_to_pc :: Pitch -> PitchClass
-- | Pitch comparison, implemented via pitch_to_fmidi.
--
--
-- pitch_compare (Pitch A Natural 4) (Pitch A QuarterToneSharp 4) == LT
--
pitch_compare :: Pitch -> Pitch -> Ordering
-- | Given Spelling function translate from OctPC notation to
-- Pitch.
octpc_to_pitch :: Integral i => Spelling i -> Octave_PitchClass i -> Pitch
-- | Normalise OctPC value, ie. ensure PitchClass is in
-- (0,11).
--
--
-- octpc_nrm (4,16) == (5,4)
--
octpc_nrm :: Integral i => Octave_PitchClass i -> Octave_PitchClass i
-- | Transpose OctPC value.
--
--
-- octpc_trs 7 (4,9) == (5,4)
-- octpc_trs (-11) (4,9) == (3,10)
--
octpc_trs :: Integral i => i -> Octave_PitchClass i -> Octave_PitchClass i
-- | OctPC value to integral midi note number.
--
--
-- octpc_to_midi (4,9) == 69
--
octpc_to_midi :: Integral i => Octave_PitchClass i -> i
-- | fromIntegral of octpc_to_midi.
octpc_to_fmidi :: (Integral i, Num n) => Octave_PitchClass i -> n
-- | Inverse of octpc_to_midi.
--
--
-- midi_to_octpc 69 == (4,9)
--
midi_to_octpc :: Integral i => i -> Octave_PitchClass i
-- | Enumerate range, inclusive.
--
--
-- octpc_range ((3,8),(4,1)) == [(3,8),(3,9),(3,10),(3,11),(4,0),(4,1)]
--
octpc_range :: (OctPC, OctPC) -> [OctPC]
-- | Midi note number to Pitch.
--
--
-- let r = ["C4","E♭4","F♯4"]
-- in map (pitch_pp . midi_to_pitch pc_spell_ks) [60,63,66] == r
--
midi_to_pitch :: Integral i => Spelling i -> i -> Pitch
-- | Fractional midi note number to Pitch.
--
--
-- import Music.Theory.Pitch.Spelling
-- pitch_pp (fmidi_to_pitch pc_spell_ks 65.5) == "F𝄲4"
-- pitch_pp (fmidi_to_pitch pc_spell_ks 66.5) == "F𝄰4"
-- pitch_pp (fmidi_to_pitch pc_spell_ks 67.5) == "A𝄭4"
-- pitch_pp (fmidi_to_pitch pc_spell_ks 69.5) == "B𝄭4"
--
fmidi_to_pitch :: RealFrac n => Spelling Int -> n -> Pitch
-- | Composition of pitch_to_fmidi and then fmidi_to_pitch.
--
--
-- import Music.Theory.Pitch.Name as T
-- import Music.Theory.Pitch.Spelling as T
--
--
--
-- pitch_tranpose T.pc_spell_ks 2 T.ees5 == T.f5
--
pitch_tranpose :: RealFrac n => Spelling Int -> n -> Pitch -> Pitch
-- | Set octave of p2 so that it nearest to p1.
--
--
-- import Music.Theory.Pitch.Name as T
--
--
--
-- let {r = ["B1","C2","C#2"];f = pitch_in_octave_nearest T.cis2}
-- in map (pitch_pp_iso . f) [T.b4,T.c4,T.cis4] == r
--
pitch_in_octave_nearest :: Pitch -> Pitch -> Pitch
-- | Raise Note_T of Pitch, account for octave transposition.
--
--
-- pitch_note_raise (Pitch B Natural 3) == Pitch C Natural 4
--
pitch_note_raise :: Pitch -> Pitch
-- | Lower Note_T of Pitch, account for octave transposition.
--
--
-- pitch_note_lower (Pitch C Flat 4) == Pitch B Flat 3
--
pitch_note_lower :: Pitch -> Pitch
-- | Rewrite Pitch to not use 3/4 tone alterations, ie.
-- re-spell to 1/4 alteration.
--
--
-- let {p = Pitch A ThreeQuarterToneFlat 4
-- ;q = Pitch G QuarterToneSharp 4}
-- in pitch_rewrite_threequarter_alteration p == q
--
pitch_rewrite_threequarter_alteration :: Pitch -> Pitch
-- | Apply function to octave of PitchClass.
--
--
-- pitch_edit_octave (+ 1) (Pitch A Natural 4) == Pitch A Natural 5
--
pitch_edit_octave :: (Octave -> Octave) -> Pitch -> Pitch
-- | Midi note number to cycles per second.
--
--
-- map midi_to_cps [60,69] == [261.6255653005986,440.0]
--
midi_to_cps :: (Integral i, Floating f) => i -> f
-- | Fractional midi note number to cycles per second.
--
--
-- map fmidi_to_cps [69,69.1] == [440.0,442.5488940698553]
--
fmidi_to_cps :: Floating a => a -> a
-- | fmidi_to_cps of pitch_to_fmidi.
pitch_to_cps :: Floating n => Pitch -> n
-- | Frequency (cycles per second) to midi note number, ie.
-- round of cps_to_fmidi.
--
--
-- map cps_to_midi [261.6,440] == [60,69]
--
cps_to_midi :: (Integral i, Floating f, RealFrac f) => f -> i
-- | Frequency (cycles per second) to fractional midi note number.
--
--
-- cps_to_fmidi 440 == 69
-- cps_to_fmidi (fmidi_to_cps 60.25) == 60.25
--
cps_to_fmidi :: Floating a => a -> a
-- | Midi note number with cents detune.
type Midi_Detune = (Int, Double)
-- | Frequency (in hertz) to Midi_Detune.
--
--
-- map (fmap round . cps_to_midi_detune) [440.00,508.35] == [(69,0),(71,50)]
--
cps_to_midi_detune :: Double -> Midi_Detune
-- | Inverse of cps_to_midi_detune.
midi_detune_to_cps :: Midi_Detune -> Double
-- | midi_to_cps of octpc_to_midi.
--
--
-- octpc_to_cps (4,9) == 440
--
octpc_to_cps :: (Integral i, Floating n) => Octave_PitchClass i -> n
-- | midi_to_octpc of cps_to_midi.
cps_to_octpc :: (Floating f, RealFrac f, Integral i) => f -> Octave_PitchClass i
-- | Slight generalisation of ISO pitch representation. Allows octave to be
-- elided, pitch names to be lower case, and double sharps written as
-- ##.
--
-- See http://www.musiccog.ohio-state.edu/Humdrum/guide04.html
--
--
-- let r = [Pitch C Natural 4,Pitch A Flat 5,Pitch F DoubleSharp 6]
-- in mapMaybe (parse_iso_pitch_oct 4) ["C","Ab5","f##6",""] == r
--
parse_iso_pitch_oct :: Octave -> String -> Maybe Pitch
-- | Variant of parse_iso_pitch_oct requiring octave.
parse_iso_pitch :: String -> Maybe Pitch
-- | Pretty printer for Pitch (unicode, see
-- alteration_symbol).
--
--
-- pitch_pp (Pitch E Flat 4) == "E♭4"
-- pitch_pp (Pitch F QuarterToneSharp 3) == "F𝄲3"
--
pitch_pp :: Pitch -> String
-- | Pitch printed without octave.
pitch_class_pp :: Pitch -> String
-- | Sequential list of n pitch class names starting from k.
--
--
-- pitch_class_names_12et 11 2 == ["B","C"]
--
pitch_class_names_12et :: Integral n => n -> n -> [String]
-- | Pretty printer for Pitch (ISO, ASCII, see
-- alteration_iso).
--
--
-- pitch_pp_iso (Pitch E Flat 4) == "Eb4"
-- pitch_pp_iso (Pitch F DoubleSharp 3) == "Fx3"
--
pitch_pp_iso :: Pitch -> String
-- | Pretty printer for Pitch (ASCII, see alteration_tonh).
--
--
-- pitch_pp_hly (Pitch E Flat 4) == "ees4"
-- pitch_pp_hly (Pitch F QuarterToneSharp 3) == "fih3"
-- pitch_pp_hly (Pitch B Natural 6) == "b6"
--
pitch_pp_hly :: Pitch -> String
-- | Pretty printer for Pitch (Tonhöhe, see alteration_tonh).
--
--
-- pitch_pp_tonh (Pitch E Flat 4) == "Es4"
-- pitch_pp_tonh (Pitch F QuarterToneSharp 3) == "Fih3"
-- pitch_pp_tonh (Pitch B Natural 6) == "H6"
--
pitch_pp_tonh :: Pitch -> String
instance Eq Pitch
instance Show Pitch
instance Eq Pitch'
instance Show Pitch'
instance Ord Pitch
-- | Constants names for Pitch values. eses indicates double
-- flat, eseh three quarter tone flat, es flat, eh
-- quarter tone flat, ih quarter tone sharp, is sharp,
-- isih three quarter tone sharp and isis double sharp.
module Music.Theory.Pitch.Name
a0 :: Pitch
b0 :: Pitch
bes0 :: Pitch
ais0 :: Pitch
bis0 :: Pitch
c1 :: Pitch
b1 :: Pitch
a1 :: Pitch
g1 :: Pitch
f1 :: Pitch
e1 :: Pitch
d1 :: Pitch
ces1 :: Pitch
bes1 :: Pitch
aes1 :: Pitch
ges1 :: Pitch
fes1 :: Pitch
ees1 :: Pitch
des1 :: Pitch
cis1 :: Pitch
bis1 :: Pitch
ais1 :: Pitch
gis1 :: Pitch
fis1 :: Pitch
eis1 :: Pitch
dis1 :: Pitch
c2 :: Pitch
b2 :: Pitch
a2 :: Pitch
g2 :: Pitch
f2 :: Pitch
e2 :: Pitch
d2 :: Pitch
ces2 :: Pitch
bes2 :: Pitch
aes2 :: Pitch
ges2 :: Pitch
fes2 :: Pitch
ees2 :: Pitch
des2 :: Pitch
cis2 :: Pitch
bis2 :: Pitch
ais2 :: Pitch
gis2 :: Pitch
fis2 :: Pitch
eis2 :: Pitch
dis2 :: Pitch
cisis2 :: Pitch
bisis2 :: Pitch
aisis2 :: Pitch
gisis2 :: Pitch
fisis2 :: Pitch
eisis2 :: Pitch
disis2 :: Pitch
ceseh2 :: Pitch
beseh2 :: Pitch
aeseh2 :: Pitch
geseh2 :: Pitch
feseh2 :: Pitch
eeseh2 :: Pitch
deseh2 :: Pitch
ceh2 :: Pitch
beh2 :: Pitch
aeh2 :: Pitch
geh2 :: Pitch
feh2 :: Pitch
eeh2 :: Pitch
deh2 :: Pitch
cih2 :: Pitch
bih2 :: Pitch
aih2 :: Pitch
gih2 :: Pitch
fih2 :: Pitch
eih2 :: Pitch
dih2 :: Pitch
cisih2 :: Pitch
bisih2 :: Pitch
aisih2 :: Pitch
gisih2 :: Pitch
fisih2 :: Pitch
eisih2 :: Pitch
disih2 :: Pitch
c3 :: Pitch
b3 :: Pitch
a3 :: Pitch
g3 :: Pitch
f3 :: Pitch
e3 :: Pitch
d3 :: Pitch
ces3 :: Pitch
bes3 :: Pitch
aes3 :: Pitch
ges3 :: Pitch
fes3 :: Pitch
ees3 :: Pitch
des3 :: Pitch
cis3 :: Pitch
bis3 :: Pitch
ais3 :: Pitch
gis3 :: Pitch
fis3 :: Pitch
eis3 :: Pitch
dis3 :: Pitch
ceses3 :: Pitch
beses3 :: Pitch
aeses3 :: Pitch
geses3 :: Pitch
feses3 :: Pitch
eeses3 :: Pitch
deses3 :: Pitch
cisis3 :: Pitch
bisis3 :: Pitch
aisis3 :: Pitch
gisis3 :: Pitch
fisis3 :: Pitch
eisis3 :: Pitch
disis3 :: Pitch
ceseh3 :: Pitch
beseh3 :: Pitch
aeseh3 :: Pitch
geseh3 :: Pitch
feseh3 :: Pitch
eeseh3 :: Pitch
deseh3 :: Pitch
ceh3 :: Pitch
beh3 :: Pitch
aeh3 :: Pitch
geh3 :: Pitch
feh3 :: Pitch
eeh3 :: Pitch
deh3 :: Pitch
cih3 :: Pitch
bih3 :: Pitch
aih3 :: Pitch
gih3 :: Pitch
fih3 :: Pitch
eih3 :: Pitch
dih3 :: Pitch
cisih3 :: Pitch
bisih3 :: Pitch
aisih3 :: Pitch
gisih3 :: Pitch
fisih3 :: Pitch
eisih3 :: Pitch
disih3 :: Pitch
c4 :: Pitch
b4 :: Pitch
a4 :: Pitch
g4 :: Pitch
f4 :: Pitch
e4 :: Pitch
d4 :: Pitch
ces4 :: Pitch
bes4 :: Pitch
aes4 :: Pitch
ges4 :: Pitch
fes4 :: Pitch
ees4 :: Pitch
des4 :: Pitch
cis4 :: Pitch
bis4 :: Pitch
ais4 :: Pitch
gis4 :: Pitch
fis4 :: Pitch
eis4 :: Pitch
dis4 :: Pitch
ceses4 :: Pitch
beses4 :: Pitch
aeses4 :: Pitch
geses4 :: Pitch
feses4 :: Pitch
eeses4 :: Pitch
deses4 :: Pitch
cisis4 :: Pitch
bisis4 :: Pitch
aisis4 :: Pitch
gisis4 :: Pitch
fisis4 :: Pitch
eisis4 :: Pitch
disis4 :: Pitch
ceseh4 :: Pitch
beseh4 :: Pitch
aeseh4 :: Pitch
geseh4 :: Pitch
feseh4 :: Pitch
eeseh4 :: Pitch
deseh4 :: Pitch
ceh4 :: Pitch
beh4 :: Pitch
aeh4 :: Pitch
geh4 :: Pitch
feh4 :: Pitch
eeh4 :: Pitch
deh4 :: Pitch
cih4 :: Pitch
bih4 :: Pitch
aih4 :: Pitch
gih4 :: Pitch
fih4 :: Pitch
eih4 :: Pitch
dih4 :: Pitch
cisih4 :: Pitch
bisih4 :: Pitch
aisih4 :: Pitch
gisih4 :: Pitch
fisih4 :: Pitch
eisih4 :: Pitch
disih4 :: Pitch
c5 :: Pitch
b5 :: Pitch
a5 :: Pitch
g5 :: Pitch
f5 :: Pitch
e5 :: Pitch
d5 :: Pitch
ces5 :: Pitch
bes5 :: Pitch
aes5 :: Pitch
ges5 :: Pitch
fes5 :: Pitch
ees5 :: Pitch
des5 :: Pitch
cis5 :: Pitch
bis5 :: Pitch
ais5 :: Pitch
gis5 :: Pitch
fis5 :: Pitch
eis5 :: Pitch
dis5 :: Pitch
ceses5 :: Pitch
beses5 :: Pitch
aeses5 :: Pitch
geses5 :: Pitch
feses5 :: Pitch
eeses5 :: Pitch
deses5 :: Pitch
cisis5 :: Pitch
bisis5 :: Pitch
aisis5 :: Pitch
gisis5 :: Pitch
fisis5 :: Pitch
eisis5 :: Pitch
disis5 :: Pitch
ceseh5 :: Pitch
beseh5 :: Pitch
aeseh5 :: Pitch
geseh5 :: Pitch
feseh5 :: Pitch
eeseh5 :: Pitch
deseh5 :: Pitch
ceh5 :: Pitch
beh5 :: Pitch
aeh5 :: Pitch
geh5 :: Pitch
feh5 :: Pitch
eeh5 :: Pitch
deh5 :: Pitch
cih5 :: Pitch
bih5 :: Pitch
aih5 :: Pitch
gih5 :: Pitch
fih5 :: Pitch
eih5 :: Pitch
dih5 :: Pitch
cisih5 :: Pitch
bisih5 :: Pitch
aisih5 :: Pitch
gisih5 :: Pitch
fisih5 :: Pitch
eisih5 :: Pitch
disih5 :: Pitch
c6 :: Pitch
b6 :: Pitch
a6 :: Pitch
g6 :: Pitch
f6 :: Pitch
e6 :: Pitch
d6 :: Pitch
ces6 :: Pitch
bes6 :: Pitch
aes6 :: Pitch
ges6 :: Pitch
fes6 :: Pitch
ees6 :: Pitch
des6 :: Pitch
cis6 :: Pitch
bis6 :: Pitch
ais6 :: Pitch
gis6 :: Pitch
fis6 :: Pitch
eis6 :: Pitch
dis6 :: Pitch
ceseh6 :: Pitch
beseh6 :: Pitch
aeseh6 :: Pitch
geseh6 :: Pitch
feseh6 :: Pitch
eeseh6 :: Pitch
deseh6 :: Pitch
ceh6 :: Pitch
beh6 :: Pitch
aeh6 :: Pitch
geh6 :: Pitch
feh6 :: Pitch
eeh6 :: Pitch
deh6 :: Pitch
cih6 :: Pitch
bih6 :: Pitch
aih6 :: Pitch
gih6 :: Pitch
fih6 :: Pitch
eih6 :: Pitch
dih6 :: Pitch
cisih6 :: Pitch
bisih6 :: Pitch
aisih6 :: Pitch
gisih6 :: Pitch
fisih6 :: Pitch
eisih6 :: Pitch
disih6 :: Pitch
c7 :: Pitch
b7 :: Pitch
a7 :: Pitch
g7 :: Pitch
f7 :: Pitch
e7 :: Pitch
d7 :: Pitch
ces7 :: Pitch
bes7 :: Pitch
aes7 :: Pitch
ges7 :: Pitch
fes7 :: Pitch
ees7 :: Pitch
des7 :: Pitch
cis7 :: Pitch
bis7 :: Pitch
ais7 :: Pitch
gis7 :: Pitch
fis7 :: Pitch
eis7 :: Pitch
dis7 :: Pitch
c8 :: Pitch
d8 :: Pitch
cis8 :: Pitch
-- | Common music notation clefs.
module Music.Theory.Clef
-- | Clef enumeration type.
data Clef_T
Bass :: Clef_T
Tenor :: Clef_T
Alto :: Clef_T
Treble :: Clef_T
Percussion :: Clef_T
-- | Clef with octave offset.
data Clef i
Clef :: Clef_T -> i -> Clef i
clef_t :: Clef i -> Clef_T
clef_octave :: Clef i -> i
-- | Give clef range as a Pitch pair indicating the notes below and
-- above the staff.
--
--
-- map clef_range [Treble,Bass] == [Just (d4,g5),Just (f2,b3)]
-- clef_range Percussion == Nothing
--
clef_range :: Clef_T -> Maybe (Pitch, Pitch)
-- | Suggest a Clef given a Pitch.
--
--
-- map clef_suggest [c2,c4] == [Clef Bass (-1),Clef Treble 0]
--
clef_suggest :: Integral i => Pitch -> Clef i
-- | Set clef_octave to 0.
clef_zero :: Integral i => Clef i -> Clef i
-- | Set clef_octave to be no further than r from 0.
clef_restrict :: Integral i => i -> Clef i -> Clef i
instance Eq Clef_T
instance Ord Clef_T
instance Show Clef_T
instance Eq i => Eq (Clef i)
instance Ord i => Ord (Clef i)
instance Show i => Show (Clef i)
module Music.Theory.Instrument.Choir
-- | Voice types.
data Voice
Bass :: Voice
Tenor :: Voice
Alto :: Voice
Soprano :: Voice
-- | Single character abbreviation for Voice.
voice_abbrev :: Voice -> Char
-- | Standard Clef for Voice.
voice_clef :: Integral i => Voice -> Clef i
-- | Table giving ranges for Voices.
type Voice_Rng_Tbl = [(Voice, (Pitch, Pitch))]
-- | More or less standard choir ranges, inclusive.
voice_rng_tbl_std :: Voice_Rng_Tbl
-- | More conservative ranges, inclusive.
voice_rng_tbl_safe :: Voice_Rng_Tbl
-- | Erroring variant.
lookup_err :: Eq a => a -> [(a, b)] -> b
-- | Lookup voice range table.
voice_rng :: Voice_Rng_Tbl -> Voice -> (Pitch, Pitch)
-- | Lookup voice_rng_tbl_std.
voice_rng_std :: Voice -> (Pitch, Pitch)
-- | Lookup voice_rng_tbl_safe.
voice_rng_safe :: Voice -> (Pitch, Pitch)
-- | Is p >= l and <= r.
in_range_inclusive :: Ord a => a -> (a, a) -> Bool
-- | Is p in range for v, (std & safe).
--
--
-- map (in_voice_rng T.c4) [Bass .. Soprano]
--
in_voice_rng :: Pitch -> Voice -> (Bool, Bool)
-- | Given tbl list Voices that can sing Pitch.
possible_voices :: Voice_Rng_Tbl -> Pitch -> [Voice]
-- | std variant.
possible_voices_std :: Pitch -> [Voice]
-- | safe variant.
possible_voices_safe :: Pitch -> [Voice]
-- | Enumeration of SATB voices.
satb :: [Voice]
-- | Names of satb.
satb_name :: [String]
-- | voice_abbrev of satb as Strings.
satb_abbrev :: [String]
-- | Voice & part number.
type Part = (Voice, Int)
-- | k part choir, ordered by voice.
ch_satb_seq :: Int -> [Part]
-- | ch_satb_seq grouped in parts.
--
--
-- map (map part_nm) (ch_parts 8)
--
ch_parts :: Int -> [[Part]]
-- | Abreviated name for part.
--
--
-- part_nm (Soprano,1) == "S1"
--
part_nm :: Part -> String
-- | k SATB choirs, grouped by choir.
--
--
-- k_ch_groups 2
--
k_ch_groups :: Int -> [[Part]]
-- | concat of k_ch_groups.
k_ch_groups' :: Int -> [Part]
-- | Two k part SATB choirs in score order.
--
--
-- map part_nm (concat (dbl_ch_parts 8))
--
dbl_ch_parts :: Int -> [[Part]]
-- | voice_clef for Parts.
mk_clef_seq :: [Part] -> [Clef Int]
instance Eq Voice
instance Ord Voice
instance Enum Voice
instance Bounded Voice
instance Show Voice
-- | Common music notation intervals.
module Music.Theory.Interval
-- | Interval type or degree.
data Interval_T
Unison :: Interval_T
Second :: Interval_T
Third :: Interval_T
Fourth :: Interval_T
Fifth :: Interval_T
Sixth :: Interval_T
Seventh :: Interval_T
-- | Interval quality.
data Interval_Q
Diminished :: Interval_Q
Minor :: Interval_Q
Perfect :: Interval_Q
Major :: Interval_Q
Augmented :: Interval_Q
-- | Common music notation interval. An Ordering of LT
-- indicates an ascending interval, GT a descending interval, and
-- EQ a unison.
data Interval
Interval :: Interval_T -> Interval_Q -> Ordering -> Octave -> Interval
interval_type :: Interval -> Interval_T
interval_quality :: Interval -> Interval_Q
interval_direction :: Interval -> Ordering
interval_octave :: Interval -> Octave
-- | Interval type between Note_T values.
--
--
-- map (interval_ty C) [E,B] == [Third,Seventh]
--
interval_ty :: Note_T -> Note_T -> Interval_T
-- | Table of interval qualities. For each Interval_T gives directed
-- semitone interval counts for each allowable Interval_Q. For
-- lookup function see interval_q, for reverse lookup see
-- interval_q_reverse.
interval_q_tbl :: Integral n => [(Interval_T, [(n, Interval_Q)])]
-- | Lookup Interval_Q for given Interval_T and semitone
-- count.
--
--
-- interval_q Unison 11 == Just Diminished
-- interval_q Third 5 == Just Augmented
-- interval_q Fourth 5 == Just Perfect
-- interval_q Unison 3 == Nothing
--
interval_q :: Interval_T -> Int -> Maybe Interval_Q
-- | Lookup semitone difference of Interval_T with
-- Interval_Q.
--
--
-- interval_q_reverse Third Minor == Just 3
-- interval_q_reverse Unison Diminished == Just 11
--
interval_q_reverse :: Interval_T -> Interval_Q -> Maybe Int
-- | Semitone difference of Interval.
--
--
-- interval_semitones (interval (Pitch C Sharp 4) (Pitch E Sharp 5)) == 16
-- interval_semitones (interval (Pitch C Natural 4) (Pitch D Sharp 3)) == -9
--
interval_semitones :: Interval -> Int
-- | Inclusive set of Note_T within indicated interval. This is not
-- equal to enumFromTo which is not circular.
--
--
-- note_span E B == [E,F,G,A,B]
-- note_span B D == [B,C,D]
-- enumFromTo B D == []
--
note_span :: Note_T -> Note_T -> [Note_T]
-- | Invert Ordering, ie. GT becomes LT and vice
-- versa.
--
--
-- map invert_ordering [LT,EQ,GT] == [GT,EQ,LT]
--
invert_ordering :: Ordering -> Ordering
-- | Determine Interval between two Pitches.
--
--
-- interval (Pitch C Sharp 4) (Pitch D Flat 4) == Interval Second Diminished EQ 0
-- interval (Pitch C Sharp 4) (Pitch E Sharp 5) == Interval Third Major LT 1
--
interval :: Pitch -> Pitch -> Interval
-- | Apply invert_ordering to interval_direction of
-- Interval.
--
--
-- invert_interval (Interval Third Major LT 1) == Interval Third Major GT 1
--
invert_interval :: Interval -> Interval
-- | The signed difference in semitones between two Interval_Q
-- values when applied to the same Interval_T. Can this be written
-- correctly without knowing the Interval_T?
--
--
-- quality_difference_m Minor Augmented == Just 2
-- quality_difference_m Augmented Diminished == Just (-3)
-- quality_difference_m Major Perfect == Nothing
--
quality_difference_m :: Interval_Q -> Interval_Q -> Maybe Int
-- | Erroring variant of quality_difference_m.
quality_difference :: Interval_Q -> Interval_Q -> Int
-- | Transpose a Pitch by an Interval.
--
--
-- transpose (Interval Third Diminished LT 0) (Pitch C Sharp 4) == Pitch E Flat 4
--
pitch_transpose :: Interval -> Pitch -> Pitch
-- | Make leftwards (perfect fourth) and and rightwards (perfect fifth)
-- circles from Pitch.
--
--
-- let c = circle_of_fifths (Pitch F Sharp 4)
-- in map pitch_to_pc (snd c) == [6,1,8,3,10,5,12,7,2,9,4,11]
--
circle_of_fifths :: Pitch -> ([Pitch], [Pitch])
-- | Parse a positive integer into interval type and octave displacement.
--
--
-- mapMaybe parse_interval_type (map show [1 .. 15])
--
parse_interval_type :: String -> Maybe (Interval_T, Octave)
-- | Parse interval quality notation.
--
--
-- mapMaybe parse_interval_quality "dmPMA" == [minBound .. maxBound]
--
parse_interval_quality :: Char -> Maybe Interval_Q
-- | Degree of interval type and octave displacement. Inverse of
-- parse_interval_type.
--
--
-- map interval_type_degree [(Third,0),(Second,1),(Unison,2)] == [3,9,15]
--
interval_type_degree :: (Interval_T, Octave) -> Int
-- | Inverse of 'parse_interval_quality.
interval_quality_pp :: Interval_Q -> Char
-- | Parse standard common music interval notation.
--
--
-- let i = mapMaybe parse_interval (words "P1 d2 m2 M2 A3 P8 +M9 -M2")
-- in unwords (map interval_pp i) == "P1 d2 m2 M2 A3 P8 M9 -M2"
--
--
--
-- mapMaybe (fmap interval_octave . parse_interval) (words "d1 d8 d15") == [-1,0,1]
--
parse_interval :: String -> Maybe Interval
-- | Pretty printer for intervals, inverse of parse_interval.
interval_pp :: Interval -> String
-- | Standard names for the intervals within the octave, divided into
-- perfect, major and minor at the left, and diminished and augmented at
-- the right.
--
--
-- let {bimap f (p,q) = (f p,f q)
-- ;f = mapMaybe (fmap interval_semitones . parse_interval)}
-- in bimap f std_interval_names
--
std_interval_names :: ([String], [String])
instance Eq Interval_T
instance Enum Interval_T
instance Bounded Interval_T
instance Ord Interval_T
instance Show Interval_T
instance Eq Interval_Q
instance Enum Interval_Q
instance Bounded Interval_Q
instance Ord Interval_Q
instance Show Interval_Q
instance Eq Interval
instance Show Interval
-- | Constants names for ascending Interval values.
module Music.Theory.Interval.Name
perfect_fourth :: Interval
major_seventh :: Interval
perfect_fifth :: Interval
-- | Spelling rules for Interval values.
module Music.Theory.Interval.Spelling
-- | Simplest spelling for semitone intervals. This is ambiguous for
-- 6 which could be either aug.4 or dim.5.
--
--
-- i_to_interval 6 == Interval Fourth Augmented LT 0
-- map i_to_interval [0..11]
--
i_to_interval :: Int -> Interval
-- | Perform some interval simplifications. For non-tonal music some
-- spellings are poor, ie. (f,g#).
--
--
-- interval_simplify (Interval Second Augmented LT 0) == Interval Third Minor LT 0
-- interval_simplify (Interval Seventh Augmented GT 0) == Interval Unison Perfect GT 1
--
interval_simplify :: Interval -> Interval
-- | Common music keys.
module Music.Theory.Key
-- | Enumeration of common music notation modes.
data Mode_T
Minor_Mode :: Mode_T
Major_Mode :: Mode_T
-- | A common music notation key is a Note_T, Alteration_T,
-- Mode_T triple.
type Key = (Note_T, Alteration_T, Mode_T)
-- | Distance along circle of fifths path of indicated Key. A
-- positive number indicates the number of sharps, a negative number the
-- number of flats.
--
--
-- key_fifths (A,Natural,Minor_Mode) == 0
-- key_fifths (A,Natural,Major_Mode) == 3
-- key_fifths (C,Natural,Minor_Mode) == -3
--
key_fifths :: Key -> Int
instance Eq Mode_T
instance Ord Mode_T
instance Show Mode_T
-- | Spelling for chromatic clusters.
module Music.Theory.Pitch.Spelling.Cluster
-- | Spelling table for chromatic clusters.
--
--
-- let f (p,q) = p == sort (map (snd . pitch_to_octpc) q)
-- in all f spell_cluster_c4_table == True
--
spell_cluster_c4_table :: [([PitchClass], [Pitch])]
-- | Spelling for chromatic clusters. Sequence must be ascending. Pitch
-- class 0 maps to c4, if there is no 0 then all
-- notes are in octave 4.
--
--
-- let f = fmap (map pitch_pp) . spell_cluster_c4
-- in map f [[11,0],[11]] == [Just ["B3","C4"],Just ["B4"]]
--
--
--
-- fmap (map pitch_pp) (spell_cluster_c4 [10,11]) == Just ["A♯4","B4"]
--
spell_cluster_c4 :: [PitchClass] -> Maybe [Pitch]
-- | Variant of spell_cluster_c4 that runs pitch_edit_octave.
-- An octave of 4 is the identitiy, 3 an octave below,
-- 5 an octave above.
--
--
-- fmap (map pitch_pp) (spell_cluster_c 3 [11,0]) == Just ["B2","C3"]
-- fmap (map pitch_pp) (spell_cluster_c 3 [10,11]) == Just ["A♯3","B3"]
--
spell_cluster_c :: Octave -> [PitchClass] -> Maybe [Pitch]
-- | Variant of spell_cluster_c4 that runs pitch_edit_octave
-- so that the left-most note is in the octave given by f.
--
--
-- import Data.Maybe
--
--
--
-- let {f n = if n >= 11 then 3 else 4
-- ;g = map pitch_pp .fromJust . spell_cluster_f f
-- ;r = [["B3","C4"],["B3"],["C4"],["A♯4","B4"]]}
-- in map g [[11,0],[11],[0],[10,11]] == r
--
spell_cluster_f :: (PitchClass -> Octave) -> [PitchClass] -> Maybe [Pitch]
-- | Variant of spell_cluster_c4 that runs pitch_edit_octave
-- so that the left-most note is in octave o.
--
--
-- fmap (map pitch_pp) (spell_cluster_left 3 [11,0]) == Just ["B3","C4"]
-- fmap (map pitch_pp) (spell_cluster_left 3 [10,11]) == Just ["A♯3","B3"]
--
spell_cluster_left :: Octave -> [PitchClass] -> Maybe [Pitch]
-- | Permutation functions.
module Music.Theory.Permutations
-- | Factorial function.
--
--
-- (factorial 13,maxBound::Int)
--
factorial :: (Ord a, Num a) => a -> a
-- | Number of k element permutations of a set of n elements.
--
--
-- (nk_permutations 4 3,nk_permutations 13 3) == (24,1716)
--
nk_permutations :: Integral a => a -> a -> a
-- | Number of nk permutations where n == k.
--
--
-- map n_permutations [1..8] == [1,2,6,24,120,720,5040,40320]
-- n_permutations 16 `div` 1000000 == 20922789
--
n_permutations :: Integral a => a -> a
-- | Generate the permutation from p to q, ie. the
-- permutation that, when applied to p, gives q.
--
--
-- apply_permutation (permutation [0,1,3] [1,0,3]) [0,1,3] == [1,0,3]
--
permutation :: Eq a => [a] -> [a] -> Permute
-- | Apply permutation f to p.
--
--
-- let p = permutation [1..4] [4,3,2,1]
-- in apply_permutation p [1..4] == [4,3,2,1]
--
apply_permutation :: Eq a => Permute -> [a] -> [a]
-- | Composition of apply_permutation and from_cycles.
--
--
-- apply_permutation_c [[0,3],[1,2]] [1..4] == [4,3,2,1]
-- apply_permutation_c [[0,2],[1],[3,4]] [1..5] == [3,2,1,5,4]
-- apply_permutation_c [[0,1,4],[2,3]] [1..5] == [2,5,4,3,1]
-- apply_permutation_c [[0,1,3],[2,4]] [1..5] == [2,4,5,1,3]
--
apply_permutation_c :: Eq a => [[Int]] -> [a] -> [a]
-- | True if the inverse of p is p.
--
--
-- non_invertible (permutation [0,1,3] [1,0,3]) == True
--
--
--
-- let p = permutation [1..4] [4,3,2,1]
-- in non_invertible p == True && P.cycles p == [[0,3],[1,2]]
--
non_invertible :: Permute -> Bool
-- | Generate a permutation from the cycles c.
--
--
-- apply_permutation (from_cycles [[0,1,2,3]]) [1..4] == [2,3,4,1]
--
from_cycles :: [[Int]] -> Permute
-- | Generate all permutations of size n.
--
--
-- map one_line (permutations_n 3) == [[1,2,3],[1,3,2]
-- ,[2,1,3],[2,3,1]
-- ,[3,1,2],[3,2,1]]
--
permutations_n :: Int -> [Permute]
-- | Composition of q then p.
--
--
-- let {p = from_cycles [[0,2],[1],[3,4]]
-- ;q = from_cycles [[0,1,4],[2,3]]
-- ;r = p `compose` q}
-- in apply_permutation r [1,2,3,4,5] == [2,4,5,1,3]
--
compose :: Permute -> Permute -> Permute
-- | Two line notation of p.
--
--
-- two_line (permutation [0,1,3] [1,0,3]) == ([1,2,3],[2,1,3])
--
two_line :: Permute -> ([Int], [Int])
-- | One line notation of p.
--
--
-- one_line (permutation [0,1,3] [1,0,3]) == [2,1,3]
--
--
--
-- map one_line (permutations_n 3) == [[1,2,3],[1,3,2]
-- ,[2,1,3],[2,3,1]
-- ,[3,1,2],[3,2,1]]
--
one_line :: Permute -> [Int]
-- | Variant of one_line that produces a compact string.
--
--
-- one_line_compact (permutation [0,1,3] [1,0,3]) == "213"
--
--
--
-- let p = permutations_n 3
-- in unwords (map one_line_compact p) == "123 132 213 231 312 321"
--
one_line_compact :: Permute -> String
-- | Multiplication table of symmetric group n.
--
--
-- unlines (map (unwords . map one_line_compact) (multiplication_table 3))
--
--
--
-- ==> 123 132 213 231 312 321
-- 132 123 312 321 213 231
-- 213 231 123 132 321 312
-- 231 213 321 312 123 132
-- 312 321 132 123 231 213
-- 321 312 231 213 132 123
--
multiplication_table :: Int -> [[Permute]]
-- | Combination functions.
module Music.Theory.Combinations
-- | Number of k element combinations of a set of n elements.
--
--
-- (nk_combinations 6 3,nk_combinations 13 3) == (20,286)
--
nk_combinations :: Integral a => a -> a -> a
-- | k element subsets of s.
--
--
-- combinations 3 [1..4] == [[1,2,3],[1,2,4],[1,3,4],[2,3,4]]
-- length (combinations 3 [1..5]) == nk_combinations 5 3
--
combinations :: Integral t => t -> [a] -> [[a]]
-- | List permutation functions.
module Music.Theory.Permutations.List
-- | Generate all permutations.
--
--
-- permutations [0,3] == [[0,3],[3,0]]
-- length (permutations [1..5]) == P.n_permutations 5
--
permutations :: Eq a => [a] -> [[a]]
-- | Generate all distinct permutations of a multi-set.
--
--
-- multiset_permutations [0,1,1] == [[0,1,1],[1,1,0],[1,0,1]]
--
multiset_permutations :: Ord a => [a] -> [[a]]
-- | Polansky, Larry and Bassein, Richard "Possible and Impossible Melody:
-- Some Formal Aspects of Contour" Journal of Music Theory 36/2,
-- 1992 (pp.259-284) (http://www.jstor.org/pss/843933)
module Music.Theory.Contour.Polansky_1992
-- | Replace the ith value at ns with x.
--
--
-- replace "test" 2 'n' == "tent"
--
replace :: Integral i => [a] -> i -> a -> [a]
-- | Are all elements equal.
--
--
-- all_equal "aaa" == True
--
all_equal :: Eq a => [a] -> Bool
-- | Compare adjacent elements (p.262) left to right.
--
--
-- compare_adjacent [0,1,3,2] == [LT,LT,GT]
--
compare_adjacent :: Ord a => [a] -> [Ordering]
-- | Construct set of n - 1 adjacent indices, left
-- right order.
--
--
-- adjacent_indices 5 == [(0,1),(1,2),(2,3),(3,4)]
--
adjacent_indices :: Integral i => i -> [(i, i)]
-- | All (i,j) indices, in half matrix order.
--
--
-- all_indices 4 == [(0,1),(0,2),(0,3),(1,2),(1,3),(2,3)]
--
all_indices :: Integral i => i -> [(i, i)]
-- | Generic variant of fromEnum (p.263).
genericFromEnum :: (Integral i, Enum e) => e -> i
-- | Generic variant of toEnum (p.263).
genericToEnum :: (Integral i, Enum e) => i -> e
-- | Specialised genericFromEnum.
ord_to_int :: Integral a => Ordering -> a
-- | Specialised genericToEnum.
int_to_ord :: Integral a => a -> Ordering
-- | Invert Ordering.
--
--
-- map ord_invert [LT,EQ,GT] == [GT,EQ,LT]
--
ord_invert :: Ordering -> Ordering
-- | A list notation for matrices.
type Matrix a = [[a]]
-- | Apply f to construct Matrix from sequence.
--
--
-- matrix_f (,) [1..3] == [[(1,1),(1,2),(1,3)]
-- ,[(2,1),(2,2),(2,3)]
-- ,[(3,1),(3,2),(3,3)]]
--
matrix_f :: (a -> a -> b) -> [a] -> Matrix b
-- | Construct matrix_f with compare (p.263).
--
--
-- contour_matrix [1..3] == [[EQ,LT,LT],[GT,EQ,LT],[GT,GT,EQ]]
--
contour_matrix :: Ord a => [a] -> Matrix Ordering
-- | Half matrix notation for contour.
data Contour_Half_Matrix
Contour_Half_Matrix :: Int -> Matrix Ordering -> Contour_Half_Matrix
contour_half_matrix_n :: Contour_Half_Matrix -> Int
contour_half_matrix_m :: Contour_Half_Matrix -> Matrix Ordering
-- | Half Matrix of contour given comparison function f.
--
--
-- half_matrix_f (flip (-)) [2,10,6,7] == [[8,4,5],[-4,-3],[1]]
-- half_matrix_f (flip (-)) [5,0,3,2] == [[-5,-2,-3],[3,2],[-1]]
-- half_matrix_f compare [5,0,3,2] == [[GT,GT,GT],[LT,LT],[GT]]
--
half_matrix_f :: (a -> a -> b) -> [a] -> Matrix b
-- | Construct Contour_Half_Matrix (p.264)
contour_half_matrix :: Ord a => [a] -> Contour_Half_Matrix
-- | Show function for Contour_Half_Matrix.
contour_half_matrix_str :: Contour_Half_Matrix -> String
-- | Description notation of contour.
data Contour_Description
Contour_Description :: Int -> Map (Int, Int) Ordering -> Contour_Description
contour_description_n :: Contour_Description -> Int
contour_description_m :: Contour_Description -> Map (Int, Int) Ordering
-- | Construct Contour_Description of contour (p.264).
--
--
-- let c = [[3,2,4,1],[3,2,1,4]]
-- in map (show.contour_description) c == ["202 02 2","220 20 0"]
--
contour_description :: Ord a => [a] -> Contour_Description
-- | Show function for Contour_Description (p.264).
contour_description_str :: Contour_Description -> String
-- | Convert from Contour_Half_Matrix notation to
-- Contour_Description.
half_matrix_to_description :: Contour_Half_Matrix -> Contour_Description
-- | Ordering from ith to jth element of sequence described
-- at d.
--
--
-- contour_description_ix (contour_description "abdc") (0,3) == LT
--
contour_description_ix :: Contour_Description -> (Int, Int) -> Ordering
-- | True if contour is all descending, equal or ascending.
--
--
-- let c = ["abc","bbb","cba"]
-- in map (uniform.contour_description) c == [True,True,True]
--
uniform :: Contour_Description -> Bool
-- | True if contour does not containt any EQ elements.
--
--
-- let c = ["abc","bbb","cba"]
-- map (no_equalities.contour_description) c == [True,False,True]
--
no_equalities :: Contour_Description -> Bool
-- | Set of all contour descriptions.
--
--
-- map (length.all_contours) [3,4,5] == [27,729,59049]
--
all_contours :: Int -> [Contour_Description]
-- | A sequence of orderings (i,j) and (j,k) may imply
-- ordering for (i,k).
--
--
-- map implication [(LT,EQ),(EQ,EQ),(EQ,GT)] == [Just LT,Just EQ,Just GT]
--
implication :: (Ordering, Ordering) -> Maybe Ordering
-- | List of all violations at a Contour_Description (p.266).
violations :: Contour_Description -> [(Int, Int, Int, Ordering)]
-- | Is the number of violations zero.
is_possible :: Contour_Description -> Bool
-- | All possible contour descriptions
--
--
-- map (length.possible_contours) [3,4,5] == [13,75,541]
--
possible_contours :: Int -> [Contour_Description]
-- | All impossible contour descriptions
--
--
-- map (length.impossible_contours) [3,4,5] == [14,654,58508]
--
impossible_contours :: Int -> [Contour_Description]
-- | Calculate number of contours of indicated degree (p.263).
--
--
-- map contour_description_lm [2..7] == [1,3,6,10,15,21]
--
--
--
-- let r = [3,27,729,59049,14348907]
-- in map (\n -> 3 ^ n) (map contour_description_lm [2..6]) == r
--
contour_description_lm :: Integral a => a -> a
-- | Truncate a Contour_Description to have at most n
-- elements.
--
--
-- let c = contour_description [3,2,4,1]
-- in contour_truncate c 3 == contour_description [3,2,4]
--
contour_truncate :: Contour_Description -> Int -> Contour_Description
-- | Is Contour_Description p a prefix of q.
--
--
-- let {c = contour_description [3,2,4,1]
-- ;d = contour_description [3,2,4]}
-- in d `contour_is_prefix_of` c == True
--
contour_is_prefix_of :: Contour_Description -> Contour_Description -> Bool
-- | Are Contour_Descriptions p and q equal at column
-- n.
--
--
-- let {c = contour_description [3,2,4,1,5]
-- ;d = contour_description [3,2,4,1]}
-- in map (contour_eq_at c d) [0..4] == [True,True,True,True,False]
--
contour_eq_at :: Contour_Description -> Contour_Description -> Int -> Bool
-- | Derive an Integral contour that would be described by
-- Contour_Description. Diverges for impossible contours.
--
--
-- draw_contour (contour_description "abdc") == [0,1,3,2]
--
draw_contour :: Integral i => Contour_Description -> [i]
-- | Invert Contour_Description.
--
--
-- let c = contour_description "abdc"
-- in draw_contour (contour_description_invert c) == [3,2,0,1]
--
contour_description_invert :: Contour_Description -> Contour_Description
-- | Function to perhaps generate an element and a new state from an
-- initial state. This is the function provided to unfoldr.
type Build_f st e = st -> Maybe (e, st)
-- | Function to test is a partial sequence conforms to the target
-- sequence.
type Conforms_f e = Int -> [e] -> Bool
-- | Transform a Build_f to produce at most n elements.
--
--
-- let f i = Just (i,succ i)
-- in unfoldr (build_f_n f) (5,'a') == "abcde"
--
build_f_n :: Build_f st e -> Build_f (Int, st) e
-- | Attempt to construct a sequence of n elements given a
-- Build_f to generate possible elements, a Conforms_f that
-- the result sequence must conform to at each step, an Int to
-- specify the maximum number of elements to generate when searching for
-- a solution, and an initial state.
--
--
-- let {b_f i = Just (i,i+1)
-- ;c_f i x = odd (sum x `div` i)}
-- in build_sequence 6 b_f c_f 20 0 == (Just [1,2,6,11,15,19],20)
--
build_sequence :: Int -> Build_f st e -> Conforms_f e -> Int -> st -> (Maybe [e], st)
-- | Attempt to construct a sequence that has a specified contour. The
-- arguments are a Build_f to generate possible elements, a
-- Contour_Description that the result sequence must conform to,
-- an Int to specify the maximum number of elements to generate
-- when searching for a solution, and an initial state.
--
--
-- import System.Random
--
--
--
-- let {f = Just . randomR ('a','z')
-- ;c = contour_description "atdez"
-- ;st = mkStdGen 2347}
-- in fst (build_contour f c 1024 st) == Just "nvruy"
--
build_contour :: Ord e => Build_f st e -> Contour_Description -> Int -> st -> (Maybe [e], st)
-- | A variant on build_contour that retries a specified number of
-- times using the final state of the failed attempt as the state for the
-- next try.
--
--
-- let {f = Just . randomR ('a','z')
-- ;c = contour_description "atdezjh"
-- ;st = mkStdGen 2347}
-- in fst (build_contour_retry f c 64 8 st) == Just "nystzvu"
--
build_contour_retry :: Ord e => Build_f st e -> Contour_Description -> Int -> Int -> st -> (Maybe [e], st)
-- | A variant on build_contour_retry that returns the set of all
-- sequences constructed.
--
--
-- let {f = Just . randomR ('a','z')
-- ;c = contour_description "atdezjh"
-- ;st = mkStdGen 2347}
-- in length (build_contour_set f c 64 64 st) == 60
--
build_contour_set :: Ord e => Build_f st e -> Contour_Description -> Int -> Int -> st -> [[e]]
-- | Variant of build_contour_set that halts when an generated
-- sequence is a duplicate of an already generated sequence.
--
--
-- let {f = randomR ('a','f')
-- ;c = contour_description "cafe"
-- ;st = mkStdGen 2346836
-- ;r = build_contour_set_nodup f c 64 64 st}
-- in filter ("c" `isPrefixOf`) r == ["cafe","cbed","caed"]
--
build_contour_set_nodup :: Ord e => Build_f st e -> Contour_Description -> Int -> Int -> st -> [[e]]
-- | Example from p.262 (quarter-note durations)
--
--
-- ex_1 == [2,3/2,1/2,1,2]
-- compare_adjacent ex_1 == [GT,GT,LT,LT]
-- show (contour_half_matrix ex_1) == "2221 220 00 0"
-- draw_contour (contour_description ex_1) == [3,2,0,1,3]
--
--
--
-- let d = contour_description_invert (contour_description ex_1)
-- in (show d,is_possible d) == ("0001 002 22 2",True)
--
ex_1 :: [Rational]
-- | Example on p.265 (pitch)
--
--
-- ex_2 == [0,5,3]
-- show (contour_description ex_2) == "00 2"
--
ex_2 :: [Integer]
-- | Example on p.265 (pitch)
--
--
-- ex_3 == [12,7,6,7,8,7]
-- show (contour_description ex_3) == "22222 2101 000 01 2"
-- contour_description_ix (contour_description ex_3) (0,5) == GT
-- is_possible (contour_description ex_3) == True
--
ex_3 :: [Integer]
-- | Example on p.266 (impossible)
--
--
-- show ex_4 == "2221 220 00 1"
-- is_possible ex_4 == False
-- violations ex_4 == [(0,3,4,GT),(1,3,4,GT)]
--
ex_4 :: Contour_Description
instance Eq Contour_Half_Matrix
instance Eq Contour_Description
instance Show Contour_Description
instance Show Contour_Half_Matrix
-- | Symetric Group S4 as related to the composition "Nomos Alpha" by
-- Iannis Xenakis. In particular in relation to the discussion in
-- "Towards a Philosophy of Music", Formalized Music pp. 219 --
-- 221
module Music.Theory.Xenakis.S4
-- | Labels for elements of the symmetric group P4.
data Label
A :: Label
B :: Label
C :: Label
D :: Label
D2 :: Label
E :: Label
E2 :: Label
G :: Label
G2 :: Label
I :: Label
L :: Label
L2 :: Label
Q1 :: Label
Q2 :: Label
Q3 :: Label
Q4 :: Label
Q5 :: Label
Q6 :: Label
Q7 :: Label
Q8 :: Label
Q9 :: Label
Q10 :: Label
Q11 :: Label
Q12 :: Label
-- | Initial half of Seq (ie. #4). The complete Seq is formed
-- by appending the complement of the Half_Seq.
type Half_Seq = [Int]
-- | Complete sequence (ie. #8).
type Seq = [Int]
-- | Complement of a Half_Seq.
--
--
-- map complement [[4,1,3,2],[6,7,8,5]] == [[8,5,7,6],[2,3,4,1]]
--
complement :: Half_Seq -> Half_Seq
-- | Form Seq from Half_Seq.
--
--
-- full_seq [3,2,4,1] == [3,2,4,1,7,6,8,5]
-- label_of (full_seq [3,2,4,1]) == G2
-- label_of (full_seq [1,4,2,3]) == L
--
full_seq :: Half_Seq -> Seq
-- | Lower Half_Seq, ie. complement or id.
--
--
-- map lower [[4,1,3,2],[6,7,8,5]] == [[4,1,3,2],[2,3,4,1]]
--
lower :: Half_Seq -> Half_Seq
-- | Application of Label p on q.
--
--
-- l_on Q1 I == Q1
-- l_on D A == G
-- [l_on L L,l_on E D,l_on D E] == [L2,C,B]
--
l_on :: Label -> Label -> Label
-- | Seq of Label, inverse of label_of.
--
--
-- seq_of Q1 == [8,7,5,6,4,3,1,2]
--
seq_of :: Label -> Seq
-- | Half_Seq of Label, ie. half_seq .
-- seq_of.
--
--
-- half_seq_of Q1 == [8,7,5,6]
--
half_seq_of :: Label -> Seq
-- | Half_Seq of Seq, ie. take 4.
--
--
-- complement (half_seq (seq_of Q7)) == [3,4,2,1]
--
half_seq :: Seq -> Half_Seq
-- | Reverse table lookup.
--
--
-- reverse_lookup 'b' (zip [1..] ['a'..]) == Just 2
-- lookup 2 (zip [1..] ['a'..]) == Just 'b'
--
reverse_lookup :: Eq a => a -> [(b, a)] -> Maybe b
-- | Label of Seq, inverse of seq_of.
--
--
-- label_of [8,7,5,6,4,3,1,2] == Q1
-- label_of (seq_of Q4) == Q4
--
label_of :: Seq -> Label
-- | True if two Half_Seqs are complementary, ie. form a
-- Seq.
--
--
-- complementary [4,2,1,3] [8,6,5,7] == True
--
complementary :: Half_Seq -> Half_Seq -> Bool
-- | Relation between to Half_Seq values as a
-- (complementary,permutation) pair.
type Rel = (Bool, Permute)
-- | Determine Rel of Half_Seqs.
--
--
-- relate [1,4,2,3] [1,3,4,2] == (False,P.listPermute 4 [0,3,1,2])
-- relate [1,4,2,3] [8,5,6,7] == (True,P.listPermute 4 [1,0,2,3])
--
relate :: Half_Seq -> Half_Seq -> Rel
-- | Rel from Label p to q.
--
--
-- relate_l L L2 == (False,P.listPermute 4 [0,3,1,2])
--
relate_l :: Label -> Label -> Rel
-- | relate adjacent Half_Seq, see also relations_l.
relations :: [Half_Seq] -> [Rel]
-- | relate adjacent Labels.
--
--
-- relations_l [L2,L,A] == [(False,P.listPermute 4 [0,2,3,1])
-- ,(False,P.listPermute 4 [2,0,1,3])]
--
relations_l :: [Label] -> [Rel]
-- | Apply Rel to Half_Seq.
--
--
-- apply_relation (False,P.listPermute 4 [0,3,1,2]) [1,4,2,3] == [1,3,4,2]
--
apply_relation :: Rel -> Half_Seq -> Half_Seq
-- | Apply sequence of Rel to initial Half_Seq.
apply_relations :: [Rel] -> Half_Seq -> [Half_Seq]
-- | Variant of apply_relations.
--
--
-- apply_relations_l (relations_l [L2,L,A,Q1]) L2 == [L2,L,A,Q1]
--
apply_relations_l :: [Rel] -> Label -> [Label]
-- | Enumeration of set of faces of a cube.
data Face
F_Back :: Face
F_Front :: Face
F_Right :: Face
F_Left :: Face
F_Bottom :: Face
F_Top :: Face
-- | Table indicating set of faces of cubes as drawn in Fig. VIII-6
-- (p.220).
--
--
-- lookup [1,4,6,7] faces == Just F_Left
-- reverse_lookup F_Right faces == Just [2,3,5,8]
--
faces :: [([Int], Face)]
-- | Fig. VIII-6. Hexahedral (Octahedral) Group (p. 220)
--
--
-- length viii_6_l == 24
-- take 7 viii_6_l == [L2,L,A,Q1,Q7,Q3,Q9]
--
viii_6_l :: [Label]
-- | Fig. VIII-7 (p.221)
--
--
-- map (take 4) (take 4 viii_7) == [[I,A,B,C]
-- ,[A,I,C,B]
-- ,[B,C,I,A]
-- ,[C,B,A,I]]
--
viii_7 :: [[Label]]
-- | Fig. VIII-6/b Labels (p.221)
--
--
-- length viii_6b_l == length viii_6_l
-- take 8 viii_6b_l == [I,A,B,C,D2,D,E2,E]
--
viii_6b_l :: [Label]
-- | Fig. VIII-6/b Half_Seq.
--
--
-- viii_6b_p' == map half_seq_of viii_6b_l
-- nub (map (length . nub) viii_6b_p') == [4]
--
viii_6b_p' :: [Half_Seq]
-- | Variant of viii_6b with Half_Seq.
viii_6b' :: [(Label, Half_Seq)]
-- | Fig. VIII-6/b.
--
--
-- map (viii_6b !!) [0,8,16] == [(I,[1,2,3,4,5,6,7,8])
-- ,(G2,[3,2,4,1,7,6,8,5])
-- ,(Q8,[6,8,5,7,2,4,1,3])]
--
viii_6b :: [(Label, Seq)]
-- | The sequence of Rel to give viii_6_l from L2.
--
--
-- apply_relations_l viii_6_relations L2 == viii_6_l
-- length (nub viii_6_relations) == 14
--
viii_6_relations :: [Rel]
-- | The sequence of Rel to give viii_6b_l from I.
--
--
-- apply_relations_l viii_6b_relations I == viii_6b_l
-- length (nub viii_6b_relations) == 10
--
viii_6b_relations :: [Rel]
instance Eq Label
instance Ord Label
instance Enum Label
instance Bounded Label
instance Show Label
instance Eq Face
instance Enum Face
instance Bounded Face
instance Ord Face
instance Show Face
-- | Functions to generate a click track from a metric structure.
module Music.Theory.Duration.CT
-- | 1-indexed.
type Measure = Int
-- | 1-indexed.
type Pulse = Int
-- | Transform measures given as RQ divisions to absolute RQ
-- locations. mdv abbreviates measure divisions.
--
--
-- mdv_to_mrq [[1,2,1],[3,2,1]] == [[0,1,3],[4,7,9]]
--
mdv_to_mrq :: [[RQ]] -> [[RQ]]
-- | Lookup function for (Measure,Pulse) indexed structure.
mp_lookup_err :: [[a]] -> (Measure, Pulse) -> a
-- | Comparison for (Measure,Pulse) indices.
mp_compare :: (Measure, Pulse) -> (Measure, Pulse) -> Ordering
-- | Latch measures (ie. make measures contiguous, hold previous value).
--
--
-- unzip (ct_ext 10 'a' [(3,'b'),(8,'c')]) == ([1..10],"aabbbbbccc")
--
ct_ext :: Int -> a -> [(Measure, a)] -> [(Measure, a)]
-- | Variant that requires a value at measure one (first measure).
ct_ext1 :: Int -> [(Measure, a)] -> [(Measure, a)]
-- | rts_divisions of ct_ext1.
ct_dv_seq :: Int -> Tseq Measure Rational_Time_Signature -> [(Measure, [[RQ]])]
-- | ct_dv_seq without measures numbers.
ct_mdv_seq :: Int -> Tseq Measure Rational_Time_Signature -> [[RQ]]
-- | mdv_to_mrq of ct_mdv_seq.
ct_rq :: Int -> Tseq Measure Rational_Time_Signature -> [[RQ]]
ct_mp_lookup :: [[RQ]] -> (Measure, Pulse) -> RQ
ct_m_to_rq :: [[RQ]] -> [(Measure, t)] -> [(RQ, t)]
-- | Latch rehearsal mark sequence, only indicating marks. Initial mark is
-- ..
--
--
-- ct_mark_seq 2 [] == [(1,Just '.'),(2,Nothing)]
--
--
--
-- let r = [(1,Just '.'),(3,Just 'A'),(8,Just 'B')]
-- in filter (isJust . snd) (ct_mark_seq 10 [(3,'A'),(8,'B')]) == r
--
ct_mark_seq :: Int -> Tseq Measure Char -> Tseq Measure (Maybe Char)
-- | Indicate measures prior to marks.
--
--
-- ct_pre_mark [] == []
-- ct_pre_mark [(1,'A')] == []
-- ct_pre_mark [(3,'A'),(8,'B')] == [(2,Just ()),(7,Just ())]
--
ct_pre_mark :: [(Measure, a)] -> [(Measure, Maybe ())]
-- | Contiguous pre-mark sequence.
--
--
-- ct_pre_mark_seq 1 [(1,'A')] == [(1,Nothing)]
-- ct_pre_mark_seq 10 [(3,'A'),(8,'B')]
--
ct_pre_mark_seq :: Measure -> Tseq Measure Char -> Tseq Measure (Maybe ())
ct_tempo_lseq_rq :: [[RQ]] -> Lseq (Measure, Pulse) RQ -> Lseq RQ RQ
-- | Interpolating lookup of tempo sequence (lseq_lookup_err).
ct_tempo_at :: Lseq RQ RQ -> RQ -> Rational
-- | Types of nodes.
data CT_Node
-- | The start of a measure with a rehearsal mark.
CT_Mark :: RQ -> CT_Node
-- | The start of a regular measure.
CT_Start :: RQ -> CT_Node
-- | A regular pulse.
CT_Normal :: RQ -> CT_Node
-- | The start of a pulse group within a measure.
CT_Edge :: RQ -> CT_Node
-- | A regular pulse in a measure prior to a rehearsal mark.
CT_Pre :: RQ -> CT_Node
-- | The end of the track.
CT_End :: CT_Node
-- | Lead-in of (pulse,tempo,count).
ct_leadin :: (RQ, Double, Int) -> Dseq Double CT_Node
-- | Prepend initial element to start of list.
--
--
-- delay1 "abc" == "aabc"
--
delay1 :: [a] -> [a]
ct_measure :: Lseq RQ RQ -> ([RQ], Maybe Char, Maybe (), [[RQ]]) -> [(Rational, CT_Node)]
-- | Click track definition.
data CT
CT :: Int -> [(Measure, Rational_Time_Signature)] -> [(Measure, Char)] -> Lseq (Measure, Pulse) RQ -> (RQ, Int) -> CT
ct_len :: CT -> Int
ct_ts :: CT -> [(Measure, Rational_Time_Signature)]
ct_mark :: CT -> [(Measure, Char)]
ct_tempo :: CT -> Lseq (Measure, Pulse) RQ
ct_count :: CT -> (RQ, Int)
-- | Initial tempo, if given.
ct_tempo0 :: CT -> Maybe RQ
-- | Erroring variant.
ct_tempo0_err :: CT -> RQ
ct_measures :: CT -> [Dseq Rational CT_Node]
ct_dseq' :: CT -> Dseq Rational CT_Node
ct_dseq :: CT -> Dseq Double CT_Node
ct_rq_measure :: [[RQ]] -> RQ -> Maybe Measure
ct_rq_mp :: [[RQ]] -> RQ -> Maybe (Measure, Pulse)
ct_rq_mp_err :: [[RQ]] -> RQ -> (Measure, Pulse)
ct_mp_to_rq :: [[RQ]] -> [((Measure, Pulse), t)] -> [(RQ, t)]
instance Eq CT_Node
instance Show CT_Node
instance Show CT
-- | RQ values with tie right qualifier.
module Music.Theory.Duration.RQ.Tied
-- | Boolean.
type Tied_Right = Bool
-- | RQ with tie right.
type RQ_T = (RQ, Tied_Right)
-- | Construct RQ_T.
rqt :: Tied_Right -> RQ -> RQ_T
-- | RQ field of RQ_T.
rqt_rq :: RQ_T -> RQ
-- | Tied field of RQ_T.
rqt_tied :: RQ_T -> Tied_Right
-- | Is RQ_T tied right.
is_tied_right :: RQ_T -> Bool
-- | RQ_T variant of rq_un_tuplet.
--
--
-- rqt_un_tuplet (3,2) (1,T) == (3/2,T)
--
--
--
-- let f = rqt_un_tuplet (7,4)
-- in map f [(2/7,F),(4/7,T),(1/7,F)] == [(1/2,F),(1,T),(1/4,F)]
--
rqt_un_tuplet :: (Integer, Integer) -> RQ_T -> RQ_T
-- | Transform RQ to untied RQ_T.
--
--
-- rq_rqt 3 == (3,F)
--
rq_rqt :: RQ -> RQ_T
-- | Tie last element only of list of RQ.
--
--
-- rq_tie_last [1,2,3] == [(1,F),(2,F),(3,T)]
--
rq_tie_last :: [RQ] -> [RQ_T]
-- | Transform a list of RQ_T to a list of Duration_A. The
-- flag indicates if the initial value is tied left.
--
--
-- rqt_to_duration_a False [(1,T),(1/4,T),(3/4,F)]
--
rqt_to_duration_a :: Bool -> [RQ_T] -> [Duration_A]
-- | RQ_T variant of rq_can_notate.
rqt_can_notate :: [RQ_T] -> Bool
-- | RQ_T variant of rq_to_cmn.
--
--
-- rqt_to_cmn (5,T) == Just ((4,T),(1,T))
-- rqt_to_cmn (5/4,T) == Just ((1,T),(1/4,T))
-- rqt_to_cmn (5/7,F) == Just ((4/7,T),(1/7,F))
--
rqt_to_cmn :: RQ_T -> Maybe (RQ_T, RQ_T)
-- | List variant of rqt_to_cmn.
--
--
-- rqt_to_cmn_l (5,T) == [(4,T),(1,T)]
--
rqt_to_cmn_l :: RQ_T -> [RQ_T]
-- | concatMap rqt_to_cmn_l.
--
--
-- rqt_set_to_cmn [(1,T),(5/4,F)] == [(1,T),(1,T),(1/4,F)]
--
--
--
-- rqt_set_to_cmn [(1/5,True),(1/20,False),(1/2,False),(1/4,True)]
--
rqt_set_to_cmn :: [RQ_T] -> [RQ_T]
-- | RQ sub-divisions.
module Music.Theory.Duration.RQ.Division
-- | Divisions of n RQ into i equal parts grouped as
-- j. A quarter and eighth note triplet is written
-- (1,1,[2,1],False).
type RQ_Div = (Rational, Integer, [Integer], Tied_Right)
-- | Variant of RQ_Div where n is 1.
type RQ1_Div = (Integer, [Integer], Tied_Right)
-- | Lift RQ1_Div to RQ_Div.
rq1_div_to_rq_div :: RQ1_Div -> RQ_Div
-- | Verify that grouping j sums to the divisor i.
rq_div_verify :: RQ_Div -> Bool
rq_div_mm_verify :: Int -> [RQ_Div] -> [(Integer, [RQ])]
-- | Translate from RQ_Div to a sequence of RQ values.
--
--
-- rq_div_to_rq_set_t (1,5,[1,3,1],True) == ([1/5,3/5,1/5],True)
-- rq_div_to_rq_set_t (1/2,6,[3,1,2],False) == ([1/4,1/12,1/6],False)
--
rq_div_to_rq_set_t :: RQ_Div -> ([RQ], Tied_Right)
-- | Translate from result of rq_div_to_rq_set_t to seqeunce of
-- RQ_T.
--
--
-- rq_set_t_to_rqt ([1/5,3/5,1/5],True) == [(1/5,_f),(3/5,_f),(1/5,_t)]
--
rq_set_t_to_rqt :: ([RQ], Tied_Right) -> [RQ_T]
-- | Transform sequence of RQ_Div into sequence of RQ,
-- discarding any final tie.
--
--
-- let q = [(1,5,[1,3,1],True),(1/2,6,[3,1,2],True)]
-- in rq_div_seq_rq q == [1/5,3/5,9/20,1/12,1/6]
--
rq_div_seq_rq :: [RQ_Div] -> [RQ]
-- | Partitions of an Integral that sum to n. This includes
-- the two 'trivial paritions, into a set n 1, and a set
-- of 1 n.
--
--
-- partitions_sum 4 == [[1,1,1,1],[2,1,1],[2,2],[3,1],[4]]
--
--
--
-- map (length . partitions_sum) [9..15] == [30,42,56,77,101,135,176]
--
partitions_sum :: Integral i => i -> [[i]]
-- | The multiset_permutations of partitions_sum.
--
--
-- map (length . partitions_sum_p) [9..12] == [256,512,1024,2048]
--
partitions_sum_p :: Integral i => i -> [[i]]
-- | The set of all RQ1_Div that sum to n, a variant on
-- partitions_sum_p.
--
--
-- map (length . rq1_div_univ) [3..5] == [8,16,32]
-- map (length . rq1_div_univ) [9..12] == [512,1024,2048,4096]
--
rq1_div_univ :: Integer -> [RQ1_Div]
-- | Notation of a sequence of RQ values as annotated
-- Duration values.
--
--
-- - Separate input sequence into measures, adding tie annotations as
-- required (see to_measures_ts). Ensure all RQ_T values
-- can be notated as common music notation durations.
-- - Separate each measure into pulses (see m_divisions_ts).
-- Further subdivides pulses to ensure cmn tuplet notation. See
-- to_divisions_ts for a composition of to_measures_ts and
-- m_divisions_ts.
-- - Simplify each measure (see m_simplify and
-- default_rule). Coalesces tied durations where appropriate.
-- - Notate measures (see m_notate or mm_notate).
-- - Ascribe values to notated durations, see ascribe.
--
module Music.Theory.Duration.Sequence.Notate
-- | Variant of catMaybes. If all elements of the list are Just
-- a, then gives Just [a] else gives Nothing.
--
--
-- all_just (map Just [1..3]) == Just [1..3]
-- all_just [Just 1,Nothing,Just 3] == Nothing
--
all_just :: [Maybe a] -> Maybe [a]
-- | Variant of rights that preserves first Left.
--
--
-- all_right (map Right [1..3]) == Right [1..3]
-- all_right [Right 1,Left 'a',Left 'b'] == Left 'a'
--
all_right :: [Either a b] -> Either a [b]
-- | Applies a join function to the first two elements of the list.
-- If the join function succeeds the joined element is considered
-- for further coalescing.
--
--
-- coalesce (\p q -> Just (p + q)) [1..5] == [15]
--
--
--
-- let jn p q = if even p then Just (p + q) else Nothing
-- in coalesce jn [1..5] == map sum [[1],[2,3],[4,5]]
--
coalesce :: (a -> a -> Maybe a) -> [a] -> [a]
-- | Variant of coalesce with accumulation parameter.
--
--
-- coalesce_accum (\i p q -> Left (p + q)) 0 [1..5] == [(0,15)]
--
--
--
-- let jn i p q = if even p then Left (p + q) else Right (p + i)
-- in coalesce_accum jn 0 [1..7] == [(0,1),(1,5),(6,9),(15,13)]
--
--
--
-- let jn i p q = if even p then Left (p + q) else Right [p,q]
-- in coalesce_accum jn [] [1..5] == [([],1),([1,2],5),([5,4],9)]
--
coalesce_accum :: (b -> a -> a -> Either a b) -> b -> [a] -> [(b, a)]
-- | Variant of coalesce_accum that accumulates running sum.
--
--
-- let f i p q = if i == 1 then Just (p + q) else Nothing
-- in coalesce_sum (+) 0 f [1,1/2,1/4,1/4] == [1,1]
--
coalesce_sum :: (b -> a -> b) -> b -> (b -> a -> a -> Maybe a) -> [a] -> [a]
-- | Lower Either to Maybe by discarding Left.
either_to_maybe :: Either a b -> Maybe b
-- | Take elements while the sum of the prefix is less than or equal to the
-- indicated value. Returns also the difference between the prefix sum
-- and the requested sum. Note that zero elements are kept left.
--
--
-- take_sum_by id 3 [2,1] == ([2,1],0,[])
-- take_sum_by id 3 [2,2] == ([2],1,[2])
-- take_sum_by id 3 [2,1,0,1] == ([2,1,0],0,[1])
-- take_sum_by id 3 [4] == ([],3,[4])
-- take_sum_by id 0 [1..5] == ([],0,[1..5])
--
take_sum_by :: (Ord n, Num n) => (a -> n) -> n -> [a] -> ([a], n, [a])
-- | Variant of take_sum_by with id function.
take_sum :: (Ord a, Num a) => a -> [a] -> ([a], a, [a])
-- | Variant of take_sum that requires the prefix to sum to value.
--
--
-- take_sum_by_eq id 3 [2,1,0,1] == Just ([2,1,0],[1])
-- take_sum_by_eq id 3 [2,2] == Nothing
--
take_sum_by_eq :: (Ord n, Num n) => (a -> n) -> n -> [a] -> Maybe ([a], [a])
-- | Recursive variant of take_sum_by_eq.
--
--
-- split_sum_by_eq id [3,3] [2,1,0,3] == Just [[2,1,0],[3]]
-- split_sum_by_eq id [3,3] [2,2,2] == Nothing
--
split_sum_by_eq :: (Ord n, Num n) => (a -> n) -> [n] -> [a] -> Maybe [[a]]
-- | Split sequence such that the prefix sums to precisely m. The
-- third element of the result indicates if it was required to divide an
-- element. Note that zero elements are kept left. If the required sum is
-- non positive, or the input list does not sum to at least the required
-- sum, gives nothing.
--
--
-- split_sum 5 [2,3,1] == Just ([2,3],[1],Nothing)
-- split_sum 5 [2,1,3] == Just ([2,1,2],[1],Just (2,1))
-- split_sum 2 [3/2,3/2,3/2] == Just ([3/2,1/2],[1,3/2],Just (1/2,1))
-- split_sum 6 [1..10] == Just ([1..3],[4..10],Nothing)
-- fmap (\(a,_,c)->(a,c)) (split_sum 5 [1..]) == Just ([1,2,2],Just (2,1))
-- split_sum 0 [1..] == Nothing
-- split_sum 3 [1,1] == Nothing
-- split_sum 3 [2,1,0] == Just ([2,1,0],[],Nothing)
-- split_sum 3 [2,1,0,1] == Just ([2,1,0],[1],Nothing)
--
split_sum :: (Ord a, Num a) => a -> [a] -> Maybe ([a], [a], Maybe (a, a))
-- | Alias for True, used locally for documentation.
_t :: Bool
-- | Alias for False, used locally for documentation.
_f :: Bool
-- | Variant of split_sum that operates at RQ_T sequences.
--
--
-- let r = Just ([(3,_f),(2,_t)],[(1,_f)])
-- in rqt_split_sum 5 [(3,_f),(2,_t),(1,_f)] == r
--
--
--
-- let r = Just ([(3,_f),(1,_t)],[(1,_t),(1,_f)])
-- in rqt_split_sum 4 [(3,_f),(2,_t),(1,_f)] == r
--
--
--
-- rqt_split_sum 4 [(5/2,False)] == Nothing
--
rqt_split_sum :: RQ -> [RQ_T] -> Maybe ([RQ_T], [RQ_T])
-- | Separate RQ_T values in sequences summing to RQ values.
-- This is a recursive variant of rqt_split_sum. Note that is does
-- not ensure cmn notation of values.
--
--
-- let d = [(2,_f),(2,_f),(2,_f)]
-- in rqt_separate [3,3] d == Right [[(2,_f),(1,_t)]
-- ,[(1,_f),(2,_f)]]
--
--
--
-- let d = [(5/8,_f),(1,_f),(3/8,_f)]
-- in rqt_separate [1,1] d == Right [[(5/8,_f),(3/8,_t)]
-- ,[(5/8,_f),(3/8,_f)]]
--
--
--
-- let d = [(4/7,_t),(1/7,_f),(1,_f),(6/7,_f),(3/7,_f)]
-- in rqt_separate [1,1,1] d == Right [[(4/7,_t),(1/7,_f),(2/7,_t)]
-- ,[(5/7,_f),(2/7,_t)]
-- ,[(4/7,_f),(3/7,_f)]]
--
rqt_separate :: [RQ] -> [RQ_T] -> Either String [[RQ_T]]
rqt_separate_m :: [RQ] -> [RQ_T] -> Maybe [[RQ_T]]
-- | If the input RQ_T sequence cannot be notated (see
-- rqt_can_notate) separate into equal parts, so long as each part
-- is not less than i.
--
--
-- rqt_separate_tuplet undefined [(1/3,_f),(1/6,_f)]
-- rqt_separate_tuplet undefined [(4/7,_t),(1/7,_f),(2/7,_f)]
--
--
--
-- let d = map rq_rqt [1/3,1/6,2/5,1/10]
-- in rqt_separate_tuplet (1/8) d == Right [[(1/3,_f),(1/6,_f)]
-- ,[(2/5,_f),(1/10,_f)]]
--
--
--
-- let d = [(1/5,True),(1/20,False),(1/2,False),(1/4,True)]
-- in rqt_separate_tuplet (1/16) d
--
--
--
-- let d = [(2/5,_f),(1/5,_f),(1/5,_f),(1/5,_t),(1/2,_f),(1/2,_f)]
-- in rqt_separate_tuplet (1/2) d
--
--
--
-- let d = [(4/10,True),(1/10,False),(1/2,True)]
-- in rqt_separate_tuplet (1/2) d
--
rqt_separate_tuplet :: RQ -> [RQ_T] -> Either String [[RQ_T]]
-- | Recursive variant of rqt_separate_tuplet.
--
--
-- let d = map rq_rqt [1,1/3,1/6,2/5,1/10]
-- in rqt_tuplet_subdivide (1/8) d == [[(1/1,_f)]
-- ,[(1/3,_f),(1/6,_f)]
-- ,[(2/5,_f),(1/10,_f)]]
--
rqt_tuplet_subdivide :: RQ -> [RQ_T] -> [[RQ_T]]
-- | Sequence variant of rqt_tuplet_subdivide.
--
--
-- let d = [(1/5,True),(1/20,False),(1/2,False),(1/4,True)]
-- in rqt_tuplet_subdivide_seq (1/2) [d]
--
rqt_tuplet_subdivide_seq :: RQ -> [[RQ_T]] -> [[RQ_T]]
-- | If a tuplet is all tied, it ought to be a plain value?!
--
--
-- rqt_tuplet_sanity_ [(4/10,_t),(1/10,_f)] == [(1/2,_f)]
--
rqt_tuplet_sanity_ :: [RQ_T] -> [RQ_T]
rqt_tuplet_subdivide_seq_sanity_ :: RQ -> [[RQ_T]] -> [[RQ_T]]
-- | Separate RQ sequence into measures given by RQ length.
--
--
-- to_measures_rq [3,3] [2,2,2] == Right [[(2,_f),(1,_t)],[(1,_f),(2,_f)]]
-- to_measures_rq [3,3] [6] == Right [[(3,_t)],[(3,_f)]]
-- to_measures_rq [1,1,1] [3] == Right [[(1,_t)],[(1,_t)],[(1,_f)]]
-- to_measures_rq [3,3] [2,2,1]
-- to_measures_rq [3,2] [2,2,2]
--
--
--
-- let d = [4/7,33/28,9/20,4/5]
-- in to_measures_rq [3] d == Right [[(4/7,_f),(33/28,_f),(9/20,_f),(4/5,_f)]]
--
to_measures_rq :: [RQ] -> [RQ] -> Either String [[RQ_T]]
-- | Variant of to_measures_rq that ensures RQ_T are
-- cmn durations. This is not a good composition.
--
--
-- to_measures_rq_cmn [6,6] [5,5,2] == Right [[(4,_t),(1,_f),(1,_t)]
-- ,[(4,_f),(2,_f)]]
--
--
--
-- let r = [[(4/7,_t),(1/7,_f),(1,_f),(6/7,_f),(3/7,_f)]]
-- in to_measures_rq_cmn [3] [5/7,1,6/7,3/7] == Right r
--
--
--
-- to_measures_rq_cmn [1,1,1] [5/7,1,6/7,3/7] == Right [[(4/7,_t),(1/7,_f),(2/7,_t)]
-- ,[(4/7,_t),(1/7,_f),(2/7,_t)]
-- ,[(4/7,_f),(3/7,_f)]]
--
to_measures_rq_cmn :: [RQ] -> [RQ] -> Either String [[RQ_T]]
-- | Variant of to_measures_rq with measures given by
-- Time_Signature values. Does not ensure RQ_T are
-- cmn durations.
--
--
-- to_measures_ts [(1,4)] [5/8,3/8] /= Right [[(1/2,_t),(1/8,_f),(3/8,_f)]]
-- to_measures_ts [(1,4)] [5/7,2/7] /= Right [[(4/7,_t),(1/7,_f),(2/7,_f)]]
--
--
--
-- let {m = replicate 18 (1,4)
-- ;x = [3/4,2,5/4,9/4,1/4,3/2,1/2,7/4,1,5/2,11/4,3/2]}
-- in to_measures_ts m x == Right [[(3/4,_f),(1/4,_t)],[(1/1,_t)]
-- ,[(3/4,_f),(1/4,_t)],[(1/1,_f)]
-- ,[(1/1,_t)],[(1/1,_t)]
-- ,[(1/4,_f),(1/4,_f),(1/2,_t)],[(1/1,_f)]
-- ,[(1/2,_f),(1/2,_t)],[(1/1,_t)]
-- ,[(1/4,_f),(3/4,_t)],[(1/4,_f),(3/4,_t)]
-- ,[(1/1,_t)],[(3/4,_f),(1/4,_t)]
-- ,[(1/1,_t)],[(1/1,_t)]
-- ,[(1/2,_f),(1/2,_t)],[(1/1,_f)]]
--
--
--
-- to_measures_ts [(3,4)] [4/7,33/28,9/20,4/5]
-- to_measures_ts (replicate 3 (1,4)) [4/7,33/28,9/20,4/5]
--
to_measures_ts :: [Time_Signature] -> [RQ] -> Either String [[RQ_T]]
-- | Variant of to_measures_ts that allows for duration field
-- operation but requires that measures be well formed. This is useful
-- for re-grouping measures after notation and ascription.
to_measures_ts_by_eq :: (a -> RQ) -> [Time_Signature] -> [a] -> Maybe [[a]]
-- | Divide measure into pulses of indicated RQ durations. Measure
-- must be of correct length but need not contain only cmn
-- durations. Pulses are further subdivided if required to notate tuplets
-- correctly, see rqt_tuplet_subdivide_seq.
--
--
-- let d = [(1/4,_f),(1/4,_f),(2/3,_t),(1/6,_f),(16/15,_f),(1/5,_f)
-- ,(1/5,_f),(2/5,_t),(1/20,_f),(1/2,_f),(1/4,_t)]
-- in m_divisions_rq [1,1,1,1] d
--
--
--
-- m_divisions_rq [1,1,1] [(4/7,_f),(33/28,_f),(9/20,_f),(4/5,_f)]
--
m_divisions_rq :: [RQ] -> [RQ_T] -> Either String [[RQ_T]]
-- | Variant of m_divisions_rq that determines pulse divisions from
-- Time_Signature.
--
--
-- let d = [(4/7,_t),(1/7,_f),(2/7,_f)]
-- in m_divisions_ts (1,4) d == Just [d]
--
--
--
-- let d = map rq_rqt [1/3,1/6,2/5,1/10]
-- in m_divisions_ts (1,4) d == Just [[(1/3,_f),(1/6,_f)]
-- ,[(2/5,_f),(1/10,_f)]]
--
--
--
-- let d = map rq_rqt [4/7,33/28,9/20,4/5]
-- in m_divisions_ts (3,4) d == Just [[(4/7,_f),(3/7,_t)]
-- ,[(3/4,_f),(1/4,_t)]
-- ,[(1/5,_f),(4/5,_f)]]
--
m_divisions_ts :: Time_Signature -> [RQ_T] -> Either String [[RQ_T]]
-- | Composition of to_measures_rq and m_divisions_rq, where
-- measures are initially given as sets of divisions.
--
--
-- let m = [[1,1,1],[1,1,1]]
-- in to_divisions_rq m [2,2,2] == Right [[[(1,_t)],[(1,_f)],[(1,_t)]]
-- ,[[(1,_f)],[(1,_t)],[(1,_f)]]]
--
--
--
-- let d = [2/7,1/7,4/7,5/7,8/7,1,1/7]
-- in to_divisions_rq [[1,1,1,1]] d == Right [[[(2/7,_f),(1/7,_f),(4/7,_f)]
-- ,[(4/7,_t),(1/7,_f),(2/7,_t)]
-- ,[(6/7,_f),(1/7,_t)]
-- ,[(6/7,_f),(1/7,_f)]]]
--
--
--
-- let d = [5/7,1,6/7,3/7]
-- in to_divisions_rq [[1,1,1]] d == Right [[[(4/7,_t),(1/7,_f),(2/7,_t)]
-- ,[(4/7,_t),(1/7,_f),(2/7,_t)]
-- ,[(4/7,_f),(3/7,_f)]]]
--
--
--
-- let d = [2/7,1/7,4/7,5/7,1,6/7,3/7]
-- in to_divisions_rq [[1,1,1,1]] d == Right [[[(2/7,_f),(1/7,_f),(4/7,_f)]
-- ,[(4/7,_t),(1/7,_f),(2/7,_t)]
-- ,[(4/7,_t),(1/7,_f),(2/7,_t)]
-- ,[(4/7,_f),(3/7,_f)]]]
--
--
--
-- let d = [4/7,33/28,9/20,4/5]
-- in to_divisions_rq [[1,1,1]] d == Right [[[(4/7,_f),(3/7,_t)]
-- ,[(3/4,_f),(1/4,_t)]
-- ,[(1/5,_f),(4/5,_f)]]]
--
--
--
-- let {p = [[1/2,1,1/2],[1/2,1]]
-- ;d = map (/6) [1,1,1,1,1,1,4,1,2,1,1,2,1,3]}
-- in to_divisions_rq p d == Right [[[(1/6,_f),(1/6,_f),(1/6,_f)]
-- ,[(1/6,_f),(1/6,_f),(1/6,_f),(1/2,True)]
-- ,[(1/6,_f),(1/6,_f),(1/6,True)]]
-- ,[[(1/6,_f),(1/6,_f),(1/6,_f)]
-- ,[(1/3,_f),(1/6,_f),(1/2,_f)]]]
--
to_divisions_rq :: [[RQ]] -> [RQ] -> Either String [[[RQ_T]]]
-- | Variant of to_divisions_rq with measures given as set of
-- Time_Signature.
--
--
-- let d = [3/5,2/5,1/3,1/6,7/10,17/15,1/2,1/6]
-- in to_divisions_ts [(4,4)] d == Just [[[(3/5,_f),(2/5,_f)]
-- ,[(1/3,_f),(1/6,_f),(1/2,_t)]
-- ,[(1/5,_f),(4/5,_t)]
-- ,[(1/3,_f),(1/2,_f),(1/6,_f)]]]
--
--
--
-- let d = [3/5,2/5,1/3,1/6,7/10,29/30,1/2,1/3]
-- in to_divisions_ts [(4,4)] d == Just [[[(3/5,_f),(2/5,_f)]
-- ,[(1/3,_f),(1/6,_f),(1/2,_t)]
-- ,[(1/5,_f),(4/5,_t)]
-- ,[(1/6,_f),(1/2,_f),(1/3,_f)]]]
--
--
--
-- let d = [3/5,2/5,1/3,1/6,7/10,4/5,1/2,1/2]
-- in to_divisions_ts [(4,4)] d == Just [[[(3/5,_f),(2/5,_f)]
-- ,[(1/3,_f),(1/6,_f),(1/2,_t)]
-- ,[(1/5,_f),(4/5,_f)]
-- ,[(1/2,_f),(1/2,_f)]]]
--
--
--
-- let d = [4/7,33/28,9/20,4/5]
-- in to_divisions_ts [(3,4)] d == Just [[[(4/7,_f),(3/7,_t)]
-- ,[(3/4,_f),(1/4,_t)]
-- ,[(1/5,_f),(4/5,_f)]]]
--
to_divisions_ts :: [Time_Signature] -> [RQ] -> Either String [[[RQ_T]]]
-- | Pulse tuplet derivation.
--
--
-- p_tuplet_rqt [(2/3,_f),(1/3,_t)] == Just ((3,2),[(1,_f),(1/2,_t)])
-- p_tuplet_rqt (map rq_rqt [1/3,1/6]) == Just ((3,2),[(1/2,_f),(1/4,_f)])
-- p_tuplet_rqt (map rq_rqt [2/5,1/10]) == Just ((5,4),[(1/2,_f),(1/8,_f)])
-- p_tuplet_rqt (map rq_rqt [1/3,1/6,2/5,1/10])
--
p_tuplet_rqt :: [RQ_T] -> Maybe ((Integer, Integer), [RQ_T])
-- | Notate pulse, ie. derive tuplet if neccesary. The flag indicates if
-- the initial value is tied left.
--
--
-- p_notate False [(2/3,_f),(1/3,_t)]
-- p_notate False [(2/5,_f),(1/10,_t)]
-- p_notate False [(1/4,_t),(1/8,_f),(1/8,_f)]
-- p_notate False (map rq_rqt [1/3,1/6])
-- p_notate False (map rq_rqt [2/5,1/10])
-- p_notate False (map rq_rqt [1/3,1/6,2/5,1/10]) == Nothing
--
p_notate :: Bool -> [RQ_T] -> Either String [Duration_A]
-- | Notate measure.
--
--
-- m_notate True [[(2/3,_f),(1/3,_t)],[(1,_t)],[(1,_f)]]
--
--
--
-- let f = m_notate False . concat
--
--
--
-- fmap f (to_divisions_ts [(4,4)] [3/5,2/5,1/3,1/6,7/10,17/15,1/2,1/6])
-- fmap f (to_divisions_ts [(4,4)] [3/5,2/5,1/3,1/6,7/10,29/30,1/2,1/3])
--
m_notate :: Bool -> [[RQ_T]] -> Either String [Duration_A]
-- | Multiple measure notation.
--
--
-- let d = [2/7,1/7,4/7,5/7,8/7,1,1/7]
-- in fmap mm_notate (to_divisions_ts [(4,4)] d)
--
--
--
-- let d = [2/7,1/7,4/7,5/7,1,6/7,3/7]
-- in fmap mm_notate (to_divisions_ts [(4,4)] d)
--
--
--
-- let d = [3/5,2/5,1/3,1/6,7/10,4/5,1/2,1/2]
-- in fmap mm_notate (to_divisions_ts [(4,4)] d)
--
--
--
-- let {p = [[1/2,1,1/2],[1/2,1]]
-- ;d = map (/6) [1,1,1,1,1,1,4,1,2,1,1,2,1,3]}
-- in fmap mm_notate (to_divisions_rq p d)
--
mm_notate :: [[[RQ_T]]] -> Either String [[Duration_A]]
-- | Structure given to Simplify_P to decide simplification. The
-- structure is (ts,start-rq,(left-rq,right-rq)).
type Simplify_T = (Time_Signature, RQ, (RQ, RQ))
-- | Predicate function at Simplify_T.
type Simplify_P = Simplify_T -> Bool
-- | Variant of Simplify_T allowing multiple rules.
type Simplify_M = ([Time_Signature], [RQ], [(RQ, RQ)])
-- | Transform Simplify_M to Simplify_P.
meta_table_p :: Simplify_M -> Simplify_P
-- | Transform Simplify_M to set of Simplify_T.
meta_table_t :: Simplify_M -> [Simplify_T]
-- | The default table of simplifiers.
--
--
-- default_table ((3,4),1,(1,1)) == True
--
default_table :: Simplify_P
-- | The default eighth-note pulse simplifier rule.
--
--
-- default_8_rule ((3,8),0,(1/2,1/2)) == True
-- default_8_rule ((3,8),1/2,(1/2,1/2)) == True
-- default_8_rule ((3,8),1,(1/2,1/2)) == True
-- default_8_rule ((2,8),0,(1/2,1/2)) == True
-- default_8_rule ((5,8),0,(1,1/2)) == True
-- default_8_rule ((5,8),0,(2,1/2)) == True
--
default_8_rule :: Simplify_P
-- | The default quarter note pulse simplifier rule.
--
--
-- default_4_rule ((3,4),0,(1,1/2)) == True
-- default_4_rule ((3,4),0,(1,3/4)) == True
-- default_4_rule ((4,4),1,(1,1)) == False
-- default_4_rule ((4,4),2,(1,1)) == True
-- default_4_rule ((4,4),2,(1,2)) == True
-- default_4_rule ((4,4),0,(2,1)) == True
-- default_4_rule ((3,4),1,(1,1)) == False
--
default_4_rule :: Simplify_P
-- | The default simplifier rule. To extend provide a list of
-- Simplify_T.
default_rule :: [Simplify_T] -> Simplify_P
-- | Measure simplifier. Apply given Simplify_P.
m_simplify :: Simplify_P -> Time_Signature -> [Duration_A] -> [Duration_A]
-- | Pulse simplifier predicate, which is const True.
p_simplify_rule :: Simplify_P
-- | Pulse simplifier.
--
--
-- import Music.Theory.Duration.Name.Abbreviation
-- p_simplify [(q,[Tie_Right]),(e,[Tie_Left])] == [(q',[])]
-- p_simplify [(e,[Tie_Right]),(q,[Tie_Left])] == [(q',[])]
-- p_simplify [(q,[Tie_Right]),(e',[Tie_Left])] == [(q'',[])]
-- p_simplify [(q'',[Tie_Right]),(s,[Tie_Left])] == [(h,[])]
-- p_simplify [(e,[Tie_Right]),(s,[Tie_Left]),(e',[])] == [(e',[]),(e',[])]
--
--
--
-- let f = rqt_to_duration_a False
-- in p_simplify (f [(1/8,_t),(1/4,_t),(1/8,_f)]) == f [(1/2,_f)]
--
p_simplify :: [Duration_A] -> [Duration_A]
-- | Notate RQ duration sequence. Derive pulse divisions from
-- Time_Signature if not given directly. Composition of
-- to_divisions_ts, mm_notate m_simplify.
--
--
-- let ts = [(4,8),(3,8)]
-- ts_p = [[1/2,1,1/2],[1/2,1]]
-- rq = map (/6) [1,1,1,1,1,1,4,1,2,1,1,2,1,3]
-- sr x = T.default_rule [] x
-- in T.notate_rqp sr ts (Just ts_p) rq
--
notate_rqp :: Simplify_P -> [Time_Signature] -> Maybe [[RQ]] -> [RQ] -> Either String [[Duration_A]]
-- | Variant of notate_rqp without pulse divisions (derive).
--
--
-- notate (default_rule [((3,2),0,(2,2)),((3,2),0,(4,2))]) [(3,2)] [6]
--
notate :: Simplify_P -> [Time_Signature] -> [RQ] -> Either String [[Duration_A]]
-- | Variant of zip that retains elements of the right hand (rhs)
-- list where elements of the left hand (lhs) list meet the given lhs
-- predicate. If the right hand side is longer the remaining elements to
-- be processed are given. It is an error for the right hand side to be
-- short.
--
--
-- zip_hold_lhs even [1..5] "abc" == ([],zip [1..6] "abbcc")
-- zip_hold_lhs odd [1..6] "abc" == ([],zip [1..6] "aabbcc")
-- zip_hold_lhs even [1] "ab" == ("b",[(1,'a')])
-- zip_hold_lhs even [1,2] "a" == undefined
--
zip_hold_lhs :: (Show t, Show x) => (x -> Bool) -> [x] -> [t] -> ([t], [(x, t)])
-- | Variant of zip_hold that requires the right hand side to be
-- precisely the required length.
--
--
-- zip_hold_lhs_err even [1..5] "abc" == zip [1..6] "abbcc"
-- zip_hold_lhs_err odd [1..6] "abc" == zip [1..6] "aabbcc"
-- zip_hold_lhs_err id [False,False] "a" == undefined
-- zip_hold_lhs_err id [False] "ab" == undefined
--
zip_hold_lhs_err :: (Show t, Show x) => (x -> Bool) -> [x] -> [t] -> [(x, t)]
-- | Variant of zip that retains elements of the right hand (rhs)
-- list where elements of the left hand (lhs) list meet the given lhs
-- predicate, and elements of the lhs list where elements of the rhs meet
-- the rhs predicate. If the right hand side is longer the remaining
-- elements to be processed are given. It is an error for the right hand
-- side to be short.
--
--
-- zip_hold even (const False) [1..5] "abc" == ([],zip [1..6] "abbcc")
-- zip_hold odd (const False) [1..6] "abc" == ([],zip [1..6] "aabbcc")
-- zip_hold even (const False) [1] "ab" == ("b",[(1,'a')])
-- zip_hold even (const False) [1,2] "a" == undefined
--
--
--
-- zip_hold odd even [1,2,6] [1..5] == ([4,5],[(1,1),(2,1),(6,2),(6,3)])
--
zip_hold :: (Show t, Show x) => (x -> Bool) -> (t -> Bool) -> [x] -> [t] -> ([t], [(x, t)])
-- | Zip a list of Duration_A elements duplicating elements of the
-- right hand sequence for tied durations.
--
--
-- let {Just d = to_divisions_ts [(4,4),(4,4)] [3,3,2]
-- ;f = map snd . snd . flip m_ascribe "xyz"}
-- in fmap f (notate d) == Just "xxxyyyzz"
--
m_ascribe :: Show x => [Duration_A] -> [x] -> ([x], [(Duration_A, x)])
-- | snd . m_ascribe.
ascribe :: Show x => [Duration_A] -> [x] -> [(Duration_A, x)]
-- | Variant of m_ascribe for a set of measures.
mm_ascribe :: Show x => [[Duration_A]] -> [x] -> [[(Duration_A, x)]]
-- | 'mm_ascribe of notate.
notate_mm_ascribe :: Show a => [Simplify_T] -> [Time_Signature] -> Maybe [[RQ]] -> [RQ] -> [a] -> Either String [[(Duration_A, a)]]
notate_mm_ascribe_err :: Show a => [Simplify_T] -> [Time_Signature] -> Maybe [[RQ]] -> [RQ] -> [a] -> [[(Duration_A, a)]]
-- | Group elements as chords where a chord element is indicated by
-- the given predicate.
--
--
-- group_chd even [1,2,3,4,4,5,7,8] == [[1,2],[3,4,4],[5],[7,8]]
--
group_chd :: (x -> Bool) -> [x] -> [[x]]
-- | Variant of ascribe that groups the rhs elements using
-- group_chd and with the indicated chord function, then
-- rejoins the resulting sequence.
ascribe_chd :: Show x => (x -> Bool) -> [Duration_A] -> [x] -> [(Duration_A, x)]
-- | Variant of mm_ascribe using group_chd
mm_ascribe_chd :: Show x => (x -> Bool) -> [[Duration_A]] -> [x] -> [[(Duration_A, x)]]
-- | Common music notation dynamic marks.
module Music.Theory.Dynamic_Mark
-- | Enumeration of dynamic mark symbols.
data Dynamic_Mark_T
Niente :: Dynamic_Mark_T
PPPPP :: Dynamic_Mark_T
PPPP :: Dynamic_Mark_T
PPP :: Dynamic_Mark_T
PP :: Dynamic_Mark_T
P :: Dynamic_Mark_T
MP :: Dynamic_Mark_T
MF :: Dynamic_Mark_T
F :: Dynamic_Mark_T
FF :: Dynamic_Mark_T
FFF :: Dynamic_Mark_T
FFFF :: Dynamic_Mark_T
FFFFF :: Dynamic_Mark_T
FP :: Dynamic_Mark_T
SF :: Dynamic_Mark_T
SFP :: Dynamic_Mark_T
SFPP :: Dynamic_Mark_T
SFZ :: Dynamic_Mark_T
SFFZ :: Dynamic_Mark_T
-- | Lookup MIDI velocity for Dynamic_Mark_T. The range is linear in
-- 0-127.
--
--
-- let r = [0,6,17,28,39,50,61,72,83,94,105,116,127]
-- in mapMaybe dynamic_mark_midi [Niente .. FFFFF] == r
--
--
--
-- map dynamic_mark_midi [FP,SF,SFP,SFPP,SFZ,SFFZ] == replicate 6 Nothing
--
dynamic_mark_midi :: (Num n, Enum n) => Dynamic_Mark_T -> Maybe n
-- | Error variant.
dynamic_mark_midi_err :: Integral n => Dynamic_Mark_T -> n
-- | Map midi velocity (0-127) to dynamic mark.
--
--
-- histogram (mapMaybe midi_dynamic_mark [0 .. 127])
--
midi_dynamic_mark :: (Ord n, Eq n, Num n, Enum n) => n -> Maybe Dynamic_Mark_T
-- | Translate fixed Dynamic_Mark_Ts to db amplitude
-- over given range.
--
--
-- mapMaybe (dynamic_mark_db 120) [Niente,P,F,FFFFF] == [-120,-70,-40,0]
-- mapMaybe (dynamic_mark_db 60) [Niente,P,F,FFFFF] == [-60,-35,-20,0]
--
dynamic_mark_db :: Fractional n => n -> Dynamic_Mark_T -> Maybe n
-- | http://www.csounds.com/manual/html/ampmidid.html
--
--
-- import Sound.SC3.Plot
-- plotTable [map (ampmidid 20) [0 .. 127],map (ampmidid 60) [0 .. 127]]
--
ampmidid :: Floating a => a -> a -> a
-- | JMcC (SC3) equation.
--
--
-- plotTable1 (map amp_db [0,0.005 .. 1])
--
amp_db :: Floating a => a -> a
-- | JMcC (SC3) equation.
--
--
-- plotTable1 (map db_amp [-60,-59 .. 0])
--
db_amp :: Floating a => a -> a
-- | Enumeration of hairpin indicators.
data Hairpin_T
Crescendo :: Hairpin_T
Diminuendo :: Hairpin_T
End_Hairpin :: Hairpin_T
-- | The Hairpin_T implied by a ordered pair of
-- Dynamic_Mark_Ts.
--
--
-- map (implied_hairpin MF) [MP,F] == [Just Diminuendo,Just Crescendo]
--
implied_hairpin :: Dynamic_Mark_T -> Dynamic_Mark_T -> Maybe Hairpin_T
-- | A node in a dynamic sequence.
type Dynamic_Node = (Maybe Dynamic_Mark_T, Maybe Hairpin_T)
-- | The empty Dynamic_Node.
empty_dynamic_node :: Dynamic_Node
-- | Calculate a Dynamic_Node sequence from a sequence of
-- Dynamic_Mark_Ts.
--
--
-- dynamic_sequence [PP,MP,MP,PP] == [(Just PP,Just Crescendo)
-- ,(Just MP,Just End_Hairpin)
-- ,(Nothing,Just Diminuendo)
-- ,(Just PP,Just End_Hairpin)]
--
dynamic_sequence :: [Dynamic_Mark_T] -> [Dynamic_Node]
-- | Delete redundant (unaltered) dynamic marks.
--
--
-- let s = [Just P,Nothing,Just P,Just P,Just F]
-- in delete_redundant_marks s == [Just P,Nothing,Nothing,Nothing,Just F]
--
delete_redundant_marks :: [Maybe Dynamic_Mark_T] -> [Maybe Dynamic_Mark_T]
-- | Variant of dynamic_sequence for sequences of
-- Dynamic_Mark_T with holes (ie. rests). Runs
-- delete_redundant_marks.
--
--
-- let r = [Just (Just P,Just Crescendo),Just (Just F,Just End_Hairpin)
-- ,Nothing,Just (Just P,Nothing)]
-- in dynamic_sequence_sets [Just P,Just F,Nothing,Just P] == r
--
--
--
-- let s = [Just P,Nothing,Just P]
-- in dynamic_sequence_sets s = [Just (Just P,Nothing),Nothing,Nothing]
--
dynamic_sequence_sets :: [Maybe Dynamic_Mark_T] -> [Maybe Dynamic_Node]
-- | Apply Hairpin_T and Dynamic_Mark_T functions in that
-- order as required by Dynamic_Node.
--
--
-- let f _ x = show x
-- in apply_dynamic_node f f (Nothing,Just Crescendo) undefined
--
apply_dynamic_node :: (a -> Dynamic_Mark_T -> a) -> (a -> Hairpin_T -> a) -> Dynamic_Node -> a -> a
-- | ASCII pretty printer for Dynamic_Mark_T.
dynamic_mark_ascii :: Dynamic_Mark_T -> String
-- | ASCII pretty printer for Hairpin_T.
hairpin_ascii :: Hairpin_T -> String
-- | ASCII pretty printer for Dynamic_Node.
dynamic_node_ascii :: Dynamic_Node -> String
-- | ASCII pretty printer for Dynamic_Node sequence.
dynamic_sequence_ascii :: [Dynamic_Node] -> String
instance Eq Dynamic_Mark_T
instance Ord Dynamic_Mark_T
instance Enum Dynamic_Mark_T
instance Bounded Dynamic_Mark_T
instance Show Dynamic_Mark_T
instance Eq Hairpin_T
instance Ord Hairpin_T
instance Enum Hairpin_T
instance Bounded Hairpin_T
instance Show Hairpin_T
-- | Tuning theory
module Music.Theory.Tuning
-- | An approximation of a ratio.
type Approximate_Ratio = Double
-- | A real valued division of a semi-tone into one hundred parts, and
-- hence of the octave into 1200 parts.
type Cents = Double
-- | A tuning specified Either as a sequence of exact ratios, or as
-- a sequence of possibly inexact Cents.
data Tuning
Tuning :: Either [Rational] [Cents] -> Rational -> Tuning
ratios_or_cents :: Tuning -> Either [Rational] [Cents]
octave_ratio :: Tuning -> Rational
-- | Divisions of octave.
--
--
-- divisions ditone == 12
--
divisions :: Tuning -> Int
-- | Maybe exact ratios of Tuning.
ratios :: Tuning -> Maybe [Rational]
-- | erroring variant.
ratios_err :: Tuning -> [Rational]
-- | Possibly inexact Cents of tuning.
cents :: Tuning -> [Cents]
-- | map round . cents.
cents_i :: Integral i => Tuning -> [i]
-- | Variant of cents that includes octave at right.
cents_octave :: Tuning -> [Cents]
-- | Convert from interval in cents to frequency ratio.
--
--
-- map cents_to_ratio [0,701.9550008653874,1200] == [1,3/2,2]
--
cents_to_ratio :: Floating a => a -> a
-- | Possibly inexact Approximate_Ratios of tuning.
approximate_ratios :: Tuning -> [Approximate_Ratio]
-- | Cyclic form, taking into consideration octave_ratio.
approximate_ratios_cyclic :: Tuning -> [Approximate_Ratio]
-- | Maybe exact ratios reconstructed from possibly inexact
-- Cents of Tuning.
--
--
-- let r = [1,17/16,9/8,13/11,5/4,4/3,7/5,3/2,11/7,5/3,16/9,15/8]
-- in reconstructed_ratios 1e-2 werckmeister_iii == Just r
--
reconstructed_ratios :: Double -> Tuning -> Maybe [Rational]
-- | Convert from a Floating ratio to cents.
--
--
-- let r = [0,498,702,1200]
-- in map (round . fratio_to_cents) [1,4/3,3/2,2] == r
--
fratio_to_cents :: (Real r, Floating n) => r -> n
-- | Type specialised fratio_to_cents.
approximate_ratio_to_cents :: Approximate_Ratio -> Cents
-- | Type specialised fromRational.
approximate_ratio :: Rational -> Approximate_Ratio
-- | approximate_ratio_to_cents . approximate_ratio.
ratio_to_cents :: Rational -> Cents
-- | Construct an exact Rational that approximates Cents to
-- within epsilon.
--
--
-- map (reconstructed_ratio 1e-5) [0,700,1200] == [1,442/295,2]
--
--
--
-- ratio_to_cents (442/295) == 699.9976981706734
--
reconstructed_ratio :: Double -> Cents -> Rational
-- | Frequency n cents from f.
--
--
-- import Music.Theory.Pitch
-- map (cps_shift_cents 440) [-100,100] == map octpc_to_cps [(4,8),(4,10)]
--
cps_shift_cents :: Floating a => a -> a -> a
-- | Interval in cents from p to q, ie.
-- ratio_to_cents of p / q.
--
--
-- cps_difference_cents 440 (octpc_to_cps (5,2)) == 500
--
--
--
-- let abs_dif i j = abs (i - j)
-- in cps_difference_cents 440 (fmidi_to_cps 69.1) `abs_dif` 10 < 1e9
--
cps_difference_cents :: (Real r, Fractional r, Floating n) => r -> r -> n
-- | The Syntonic comma.
--
--
-- syntonic_comma == 81/80
--
syntonic_comma :: Rational
-- | The Pythagorean comma.
--
--
-- pythagorean_comma == 3^12 / 2^19
--
pythagorean_comma :: Rational
-- | Mercators comma.
--
--
-- mercators_comma == 3^53 / 2^84
--
mercators_comma :: Rational
-- | Calculate nth root of x.
--
--
-- 12 `nth_root` 2 == twelve_tone_equal_temperament_comma
--
nth_root :: (Floating a, Eq a) => a -> a -> a
-- | 12-tone equal temperament comma (ie. 12th root of 2).
--
--
-- twelve_tone_equal_temperament_comma == 1.0594630943592953
--
twelve_tone_equal_temperament_comma :: (Floating a, Eq a) => a
-- | Make n division equal temperament.
equal_temperament :: Integral n => n -> Tuning
-- | 12-tone equal temperament.
--
--
-- cents equal_temperament_12 == [0,100..1100]
--
equal_temperament_12 :: Tuning
-- | 19-tone equal temperament.
equal_temperament_19 :: Tuning
-- | 31-tone equal temperament.
equal_temperament_31 :: Tuning
-- | 53-tone equal temperament.
equal_temperament_53 :: Tuning
-- | 72-tone equal temperament.
--
--
-- let r = [0,17,33,50,67,83,100]
-- in take 7 (map round (cents equal_temperament_72)) == r
--
equal_temperament_72 :: Tuning
-- | Raise or lower the frequency q by octaves until it is in the
-- octave starting at p.
--
--
-- fold_cps_to_octave_of 55 392 == 98
--
fold_cps_to_octave_of :: (Ord a, Fractional a) => a -> a -> a
-- | Harmonic series on n.
harmonic_series_cps :: (Num t, Enum t) => t -> [t]
-- | n elements of harmonic_series_cps.
--
--
-- let r = [55,110,165,220,275,330,385,440,495,550,605,660,715,770,825,880,935]
-- in harmonic_series_cps_n 17 55 == r
--
harmonic_series_cps_n :: (Num a, Enum a) => Int -> a -> [a]
-- | Sub-harmonic series on n.
subharmonic_series_cps :: (Fractional t, Enum t) => t -> [t]
-- | n elements of harmonic_series_cps.
--
--
-- let r = [1760,880,587,440,352,293,251,220,196,176,160,147,135,126,117,110,104]
-- in map round (subharmonic_series_cps_n 17 1760) == r
--
subharmonic_series_cps_n :: (Fractional t, Enum t) => Int -> t -> [t]
-- | nth partial of f1, ie. one indexed.
--
--
-- map (partial 55) [1,5,3] == [55,275,165]
--
partial :: (Num a, Enum a) => a -> Int -> a
-- | Fold ratio until within an octave, ie. 1 < n
-- <= 2.
--
--
-- map fold_ratio_to_octave [2/3,3/4] == [4/3,3/2]
--
fold_ratio_to_octave :: Integral i => Ratio i -> Ratio i
-- | The interval between two pitches p and q given as ratio
-- multipliers of a fundamental is q / p. The
-- classes over such intervals consider the fold_ratio_to_octave
-- of both p to q and q to p.
--
--
-- map ratio_interval_class [2/3,3/2,3/4,4/3] == [3/2,3/2,3/2,3/2]
--
ratio_interval_class :: Integral i => Ratio i -> Ratio i
-- | Derivative harmonic series, based on kth partial of f1.
--
--
-- import Music.Theory.Pitch
--
--
--
-- let {r = [52,103,155,206,258,309,361,412,464,515,567,618,670,721,773]
-- ;d = harmonic_series_cps_derived 5 (octpc_to_cps (1,4))}
-- in map round (take 15 d) == r
--
harmonic_series_cps_derived :: (Ord a, Fractional a, Enum a) => Int -> a -> [a]
-- | Harmonic series to nth harmonic (folded).
--
--
-- harmonic_series_folded 17 == [1,17/16,9/8,5/4,11/8,3/2,13/8,7/4,15/8]
--
--
--
-- let r = [0,105,204,386,551,702,841,969,1088]
-- in map (round . ratio_to_cents) (harmonic_series_folded 17) == r
--
harmonic_series_folded :: Integer -> [Rational]
-- | ratio_to_cents variant of harmonic_series_folded.
--
--
-- map round (harmonic_series_folded_c 21) == [0,105,204,298,386,471,551,702,841,969,1088]
--
harmonic_series_folded_c :: Integer -> [Cents]
-- | 12-tone tuning of first 21 elements of the harmonic
-- series.
--
--
-- cents_i harmonic_series_folded_21 == [0,105,204,298,386,471,551,702,841,969,1088]
-- divisions harmonic_series_folded_21 == 11
--
harmonic_series_folded_21 :: Tuning
-- | Give cents difference from nearest 12ET tone.
--
--
-- let r = [50,-49,-2,0,2,49,50]
-- in map cents_et12_diff [650,651,698,700,702,749,750] == r
--
cents_et12_diff :: Integral n => n -> n
-- | Fractional form of cents_et12_diff.
fcents_et12_diff :: Real n => n -> n
-- | The class of cents intervals has range (0,600).
--
--
-- map cents_interval_class [50,1150,1250] == [50,50,50]
--
--
--
-- let r = concat [[0,50 .. 550],[600],[550,500 .. 0]]
-- in map cents_interval_class [1200,1250 .. 2400] == r
--
cents_interval_class :: Integral a => a -> a
-- | Fractional form of cents_interval_class.
fcents_interval_class :: Real a => a -> a
-- | Always include the sign, elide 0.
cents_diff_pp :: (Num a, Ord a, Show a) => a -> String
-- | Given brackets, print cents difference.
cents_diff_br :: (Num a, Ord a, Show a) => (String, String) -> a -> String
-- | cents_diff_br with parentheses.
--
--
-- map cents_diff_text [-1,0,1] == ["(-1)","","(+1)"]
--
cents_diff_text :: (Num a, Ord a, Show a) => a -> String
-- | cents_diff_br with markdown superscript (^).
cents_diff_md :: (Num a, Ord a, Show a) => a -> String
-- | cents_diff_br with HTML superscript (sup).
cents_diff_html :: (Num a, Ord a, Show a) => a -> String
-- | (n -> dt). Function from midi note number n to
-- Midi_Detune dt. The incoming note number is the key
-- pressed, which may be distant from the note sounded.
type Midi_Tuning_F = Int -> Midi_Detune
-- | (t,c,k) where t=tuning (must have 12 divisions of octave), c=cents
-- deviation (ie. constant detune offset), k=midi offset (ie. value to be
-- added to incoming midi note number).
type D12_Midi_Tuning = (Tuning, Cents, Int)
-- | Midi_Tuning_F for D12_Midi_Tuning.
--
--
-- import Music.Theory.Tuning.Gann
-- let f = d12_midi_tuning_f (la_monte_young,-74.7,-3)
-- octpc_to_midi (-1,11) == 11
-- map (round . midi_detune_to_cps . f) [62,63,69] == [293,298,440]
--
d12_midi_tuning_f :: D12_Midi_Tuning -> Midi_Tuning_F
-- | (t,f0,k) where t=tuning, f0=fundamental frequency, k=midi note number
-- for f0, n=gamut
type CPS_Midi_Tuning = (Tuning, Double, Int, Int)
-- | Midi_Tuning_F for CPS_Midi_Tuning.
cps_midi_tuning_f :: CPS_Midi_Tuning -> Midi_Tuning_F
instance Eq Tuning
instance Show Tuning
-- | Clarence Barlow. "Two Essays on Theory". Computer Music
-- Journal, 11(1):44-60, 1987. Translated by Henning Lohner.
module Music.Theory.Interval.Barlow_1987
-- | 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
-- | Generate list of factors of n from x.
--
--
-- factor primes 315 == [3,3,5,7]
--
factor :: Integral a => [a] -> a -> [a]
-- | factor n from primes.
--
--
-- prime_factors 315 == [3,3,5,7]
--
prime_factors :: Integral a => a -> [a]
-- | Collect number of occurences of each element of a sorted list.
--
--
-- multiplicities [1,1,1,2,2,3] == [(1,3),(2,2),(3,1)]
--
multiplicities :: (Eq a, Integral n) => [a] -> [(a, n)]
-- | multiplicities . prime_factors.
--
--
-- prime_factors_m 315 == [(3,2),(5,1),(7,1)]
--
prime_factors_m :: Integral a => a -> [(a, a)]
-- | Merging function for rational_prime_factors_m.
merge :: (Ord a, Num b, Eq b) => [(a, b)] -> [(a, b)] -> [(a, b)]
-- | Collect the prime factors in a rational number given as a numerator/
-- denominator pair (n,m). Prime factors are listed in ascending order
-- with their positive or negative multiplicities, depending on whether
-- the prime factor occurs in the numerator or the denominator (after
-- cancelling out common factors).
--
--
-- rational_prime_factors_m (16,15) == [(2,4),(3,-1),(5,-1)]
-- rational_prime_factors_m (10,9) == [(2,1),(3,-2),(5,1)]
-- rational_prime_factors_m (81,64) == [(2,-6),(3,4)]
-- rational_prime_factors_m (27,16) == [(2,-4),(3,3)]
-- rational_prime_factors_m (12,7) == [(2,2),(3,1),(7,-1)]
--
rational_prime_factors_m :: Integral b => (b, b) -> [(b, b)]
-- | Variant of rational_prime_factors_m giving results in a table
-- up to the nth prime.
--
--
-- rational_prime_factors_t 6 (12,7) == [2,1,0,-1,0,0]
--
rational_prime_factors_t :: Integral b => Int -> (b, b) -> [b]
-- | Compute the disharmonicity of the interval (p,q) using the
-- prime valuation function pv.
--
--
-- map (disharmonicity barlow) [(9,10),(8,9)] ~= [12.733333,8.333333]
--
disharmonicity :: (Integral a, Num b) => (a -> b) -> (a, a) -> b
-- | The reciprocal of disharmonicity.
--
--
-- map (harmonicity barlow) [(9,10),(8,9)] ~= [0.078534,0.120000]
--
harmonicity :: (Integral a, Fractional b) => (a -> b) -> (a, a) -> b
-- | Variant of harmonicity with Ratio input.
harmonicity_r :: (Integral a, Fractional b) => (a -> b) -> Ratio a -> b
-- | uncurry (%).
to_rational :: Integral a => (a, a) -> Ratio a
-- | Make numerator denominator pair of n.
from_rational :: Integral t => Ratio t -> (t, t)
-- | 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, [Integer], Rational, Double)
-- | Table 2 (p.45)
--
--
-- length (table_2 0.06) == 24
--
table_2 :: Double -> [Table_2_Row]
-- | 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
-- | Bill Alves.
module Music.Theory.Tuning.Alves
-- | Ratios for harrison_ditone.
--
--
-- let c = [0,114,204,294,408,498,612,702,816,906,996,1110]
-- in map (round . ratio_to_cents) harrison_ditone_r == c
--
harrison_ditone_r :: [Rational]
-- | Ditone/pythagorean tuning, see
-- http://www.billalves.com/porgitaro/ditonesettuning.html
--
--
-- cents_i harrison_ditone == [0,114,204,294,408,498,612,702,816,906,996,1110]
--
harrison_ditone :: Tuning
-- | Bill Alves. "Pleng: Composing for a Justly Tuned Gender Barung". 1/1:
-- Journal of the Just Intonation Network, 1:4-11, Spring 1997.
-- http://www2.hmc.edu/~alves/pleng.html
module Music.Theory.Tuning.Alves_1997
alves_slendro_r :: [Rational]
-- | HMC slendro tuning.
--
--
-- cents_i alves_slendro == [0,231,498,765,996]
--
alves_slendro :: Tuning
alves_pelog_bem_r :: [Rational]
-- | HMC pelog bem tuning.
--
--
-- cents_i alves_pelog_bem == [0,231,316,702,814]
--
alves_pelog_bem :: Tuning
alves_pelog_barang_r :: [Rational]
-- | HMC pelog 2,3,4,6,7 tuning.
--
--
-- cents_i alves_pelog_barang == [0,386,471,857,969]
--
alves_pelog_barang :: Tuning
alves_pelog_23467_r :: [Rational]
-- | HMC pelog barang tuning.
--
--
-- cents_i alves_pelog_23467 == [0,386,471,702,969]
--
alves_pelog_23467 :: Tuning
-- | Kyle Gann.
module Music.Theory.Tuning.Gann
-- | Cents for pietro_aaron_1523.
--
--
-- let c = [0,76,193,310,386,503,580,697,773,890,1007,1083]
-- in map round pietro_aaron_1523_c == c
--
pietro_aaron_1523_c :: [Cents]
-- | Pietro Aaron (1523) meantone temperament, see
-- http://www.kylegann.com/histune.html
--
--
-- cents_i pietro_aaron_1523 == [0,76,193,310,386,503,580,697,773,890,1007,1083]
--
pietro_aaron_1523 :: Tuning
-- | Andreas Werckmeister (1645-1706),
-- http://www.kylegann.com/histune.html.
werckmeister_iii_c :: [Cents]
-- | Cents for thomas_young_1799.
--
--
-- let c = [0,94,196,298,392,500,592,698,796,894,1000,1092]
-- in map round thomas_young_1799_c == c
--
thomas_young_1799_c :: [Cents]
-- | Thomas Young (1799), Well Temperament,
-- http://www.kylegann.com/histune.html.
--
--
-- cents_i thomas_young_1799 == [0,94,196,298,392,500,592,698,796,894,1000,1092]
--
thomas_young_1799 :: Tuning
-- | Ratios for zarlino.
zarlino_r :: [Rational]
-- | Gioseffo Zarlino, 1588, see
-- http://www.kylegann.com/tuning.html.
--
--
-- divisions zarlino == 16
-- cents_i zarlino == [0,71,182,204,294,316,386,498,569,590,702,773,884,996,1018,1088]
--
zarlino :: Tuning
-- | Ratios for la_monte_young.
--
--
-- let c = [0,177,204,240,471,444,675,702,738,969,942,1173]
-- in map (round . ratio_to_cents) la_monte_young_r == c
--
la_monte_young_r :: [Rational]
-- | La Monte Young's "The Well-Tuned Piano", see
-- http://www.kylegann.com/wtp.html.
--
--
-- cents_i la_monte_young == [0,177,204,240,471,444,675,702,738,969,942,1173]
--
la_monte_young :: Tuning
-- | Ratios for ben_johnston.
--
--
-- let c = [0,105,204,298,386,471,551,702,841,906,969,1088]
-- in map (round . ratio_to_cents) ben_johnston_r == c
--
ben_johnston_r :: [Rational]
-- | Ben Johnston's "Suite for Microtonal Piano" (1977), see
-- http://www.kylegann.com/tuning.html
--
--
-- cents_i ben_johnston == [0,105,204,298,386,471,551,702,841,906,969,1088]
--
ben_johnston :: Tuning
-- | Ratios for gann_arcana_xvi.
gann_arcana_xvi_r :: [Rational]
-- | Kyle Gann, _Arcana XVI_, see
-- http://www.kylegann.com/Arcana.html.
--
--
-- let r = [0,84,112,204,267,316,347,386,471,498,520,583,663,702,734,814,845,884,898,969,1018,1049,1088,1161]
-- in cents_i gann_arcana_xvi == r
--
gann_arcana_xvi :: Tuning
-- | Ratios for gann_superparticular.
gann_superparticular_r :: [Rational]
-- | Kyle Gann, _Superparticular_, see
-- http://www.kylegann.com/Super.html.
--
--
-- divisions gann_superparticular == 22
--
--
--
-- let r = [0,165,182,204,231,267,316,386,435,498,551,583,617,702,782,765,814,884,933,969,996,1018]
-- in cents_i gann_superparticular == r
--
gann_superparticular :: Tuning
-- | Max Meyer. "The musician's arithmetic: drill problems for an
-- introduction to the scientific study of musical composition." The
-- University of Missouri, 1929. p.22
module Music.Theory.Tuning.Meyer_1929
-- | Odd numbers to n.
--
--
-- odd_to 7 == [1,3,5,7]
--
odd_to :: (Num t, Enum t) => t -> [t]
-- | Generate initial row for n.
--
--
-- row 7 == [1,5/4,3/2,7/4]
--
row :: Integral i => i -> [Ratio i]
-- | Generate initial column for n.
--
--
-- column 7 == [1,8/5,4/3,8/7]
--
column :: Integral i => i -> [Ratio i]
-- | fold_to_octave . *.
in_oct_mul :: Integral i => Ratio i -> Ratio i -> Ratio i
-- | Given row and column generate matrix value at
-- (i,j).
--
--
-- inner (row 7,column 7) (1,2) == 6/5
--
inner :: Integral i => ([Ratio i], [Ratio i]) -> (i, i) -> Ratio i
meyer_table_rck :: Integral i => i -> ([Ratio i], [Ratio i], i)
-- | Meyer table in form (r,c,n).
--
--
-- meyer_table_indices 7 == [(0,0,1/1),(0,1,5/4),(0,2,3/2),(0,3,7/4)
-- ,(1,0,8/5),(1,1,1/1),(1,2,6/5),(1,3,7/5)
-- ,(2,0,4/3),(2,1,5/3),(2,2,1/1),(2,3,7/6)
-- ,(3,0,8/7),(3,1,10/7),(3,2,12/7),(3,3,1/1)]
--
meyer_table_indices :: Integral i => i -> [(i, i, Ratio i)]
-- | Meyer table as set of rows.
--
--
-- meyer_table_rows 7 == [[1/1, 5/4, 3/2,7/4]
-- ,[8/5, 1/1, 6/5,7/5]
-- ,[4/3, 5/3, 1/1,7/6]
-- ,[8/7,10/7,12/7,1/1]]
--
--
--
-- let r = [[ 1/1, 9/8, 5/4, 11/8, 3/2, 13/8, 7/4, 15/8]
-- ,[16/9, 1/1, 10/9, 11/9, 4/3, 13/9, 14/9, 5/3]
-- ,[ 8/5, 9/5, 1/1, 11/10, 6/5, 13/10, 7/5, 3/2]
-- ,[16/11, 18/11, 20/11, 1/1, 12/11, 13/11, 14/11, 15/11]
-- ,[ 4/3, 3/2, 5/3, 11/6, 1/1, 13/12, 7/6, 5/4]
-- ,[16/13, 18/13, 20/13, 22/13, 24/13, 1/1, 14/13, 15/13]
-- ,[ 8/7, 9/7, 10/7, 11/7, 12/7, 13/7, 1/1, 15/14]
-- ,[16/15, 6/5, 4/3, 22/15, 8/5, 26/15, 28/15, 1/1]]
-- in meyer_table_rows 15 == r
--
meyer_table_rows :: Integral a => a -> [[Ratio a]]
-- | Third element of three-tuple.
t3_3 :: (t1, t2, t3) -> t3
-- | Set of unique ratios in n table.
--
--
-- elements 7 == [1,8/7,7/6,6/5,5/4,4/3,7/5,10/7,3/2,8/5,5/3,12/7,7/4]
--
--
--
-- elements 9 == [1,10/9,9/8,8/7,7/6,6/5,5/4,9/7,4/3,7/5,10/7
-- ,3/2,14/9,8/5,5/3,12/7,7/4,16/9,9/5]
--
elements :: Integral i => i -> [Ratio i]
-- | Number of unique elements at n table.
--
--
-- map degree [7,9,11,13,15] == [13,19,29,41,49]
--
degree :: Integral i => i -> i
-- | http://en.wikipedia.org/wiki/Farey_sequence
--
--
-- let r = [[0,1/2,1]
-- ,[0,1/3,1/2,2/3,1]
-- ,[0,1/4,1/3,1/2,2/3,3/4,1]
-- ,[0,1/5,1/4,1/3,2/5,1/2,3/5,2/3,3/4,4/5,1]
-- ,[0,1/6,1/5,1/4,1/3,2/5,1/2,3/5,2/3,3/4,4/5,5/6,1]]
-- in map farey_sequence [2..6] == r
--
farey_sequence :: Integral a => a -> [Ratio a]
-- | http://www.microtonal-synthesis.com/scales.html
module Music.Theory.Tuning.Microtonal_Synthesis
-- | Ratios for pythagorean.
--
--
-- let c = [0,90,204,294,408,498,612,702,792,906,996,1110]
-- in map (round . ratio_to_cents) pythagorean_r == c
--
pythagorean_r :: [Rational]
-- | Pythagorean tuning,
-- http://www.microtonal-synthesis.com/scale_pythagorean.html.
--
--
-- divisions pythagorean == 12
-- cents_i pythagorean == [0,90,204,294,408,498,612,702,792,906,996,1110]
--
pythagorean :: Tuning
-- | Ratios for five_limit_tuning.
--
--
-- let c = [0,112,204,316,386,498,590,702,814,884,996,1088]
-- in map (round . ratio_to_cents) five_limit_tuning_r == c
--
five_limit_tuning_r :: [Rational]
-- | Five-limit tuning (five limit just intonation).
--
--
-- cents_i five_limit_tuning == [0,112,204,316,386,498,590,702,814,884,996,1088]
--
five_limit_tuning :: Tuning
-- | Ratios for septimal_tritone_just_intonation.
--
--
-- let c = [0,112,204,316,386,498,583,702,814,884,1018,1088]
-- in map (round . ratio_to_cents) septimal_tritone_just_intonation == c
--
septimal_tritone_just_intonation_r :: [Rational]
-- | Septimal tritone Just Intonation, see
-- http://www.microtonal-synthesis.com/scale_just_intonation.html
--
--
-- cents_i septimal_tritone_just_intonation == [0,112,204,316,386,498,583,702,814,884,1018,1088]
--
septimal_tritone_just_intonation :: Tuning
-- | Ratios for seven_limit_just_intonation.
--
--
-- let c = [0,112,204,316,386,498,583,702,814,884,969,1088]
-- in map (round . ratio_to_cents) seven_limit_just_intonation == c
--
seven_limit_just_intonation_r :: [Rational]
-- | Seven limit Just Intonation.
--
--
-- cents_i seven_limit_just_intonation == [0,112,204,316,386,498,583,702,814,884,969,1088]
--
seven_limit_just_intonation :: Tuning
-- | Approximate ratios for kirnberger_iii.
--
--
-- let c = [0,90,193,294,386,498,590,697,792,890,996,1088]
-- in map (round.to_cents) kirnberger_iii_ar == c
--
kirnberger_iii_ar :: [Approximate_Ratio]
-- | http://www.microtonal-synthesis.com/scale_kirnberger.html.
--
--
-- cents_i kirnberger_iii == [0,90,193,294,386,498,590,697,792,890,996,1088]
--
kirnberger_iii :: Tuning
vallotti_c :: [Cents]
-- | Vallotti & Young scale (Vallotti version), see
-- http://www.microtonal-synthesis.com/scale_vallotti_young.html.
--
--
-- cents_i vallotti == [0,94,196,298,392,502,592,698,796,894,1000,1090]
--
vallotti :: Tuning
mayumi_reinhard_r :: [Rational]
-- | Mayumi Reinhard 13-limit Just Intonation scale,
-- http://www.microtonal-synthesis.com/scale_reinhard.html.
--
--
-- cents_i mayumi_reinhard == [0,128,139,359,454,563,637,746,841,911,1072,1183]
--
mayumi_reinhard :: Tuning
-- | Ratios for lou_harrison_16.
--
--
-- length lou_harrison_16_r == 16
--
--
--
-- let c = [0,112,182,231,267,316,386,498,603,702,814,884,933,969,1018,1088]
-- in map (round . ratio_to_cents) lou_harrison_16_r == c
--
lou_harrison_16_r :: [Rational]
-- | Lou Harrison 16 tone Just Intonation scale, see
-- http://www.microtonal-synthesis.com/scale_harrison_16.html
--
--
-- let r = [0,112,182,231,267,316,386,498,603,702,814,884,933,969,1018,1088]
-- in cents_i lou_harrison_16 == r
--
lou_harrison_16 :: Tuning
-- | Ratios for partch_43.
partch_43_r :: [Rational]
-- | Harry Partch 43 tone scale, see
-- http://www.microtonal-synthesis.com/scale_partch.html
--
--
-- cents_i partch_43 == [0,22,53,84,112,151,165
-- ,182,204,231,267,294,316
-- ,347,386,418,435
-- ,471,498,520,551,583,617,649
-- ,680,702,729,765,782,814,853,884,906,933
-- ,969,996,1018,1035,1049,1088,1116,1147,1178]
--
partch_43 :: Tuning
-- | Ratios for ben_johnston_25.
ben_johnston_25_r :: [Rational]
-- | Ben Johnston 25 note just enharmonic scale, see
-- http://www.microtonal-synthesis.com/scale_johnston_25.html
ben_johnston_25 :: Tuning
-- | Larry Polansky. "Psaltery (for Lou Harrison)". Frog Peak Music, 1978.
module Music.Theory.Tuning.Polansky_1978
-- | Three interlocking harmonic series on 1:5:3, by Larry Polansky in
-- "Psaltery".
--
--
-- import qualified Music.Theory.Tuning.Scala as T
-- let fn = "/home/rohan/opt/scala/scl/polansky_ps.scl"
-- s <- T.load fn
-- T.scale_pitch_representations s == (0,50)
-- 1 : Data.Either.rights (T.scale_pitches s) == psaltery
--
psaltery :: [Rational]
-- | fold_ratio_to_octave of psaltery.
--
--
-- length psaltery == 51 && length psaltery_o == 21
-- psaltery_o == [1,65/64,33/32,17/16,35/32,9/8,75/64,39/32
-- ,5/4,21/16,85/64,11/8,45/32
-- ,3/2,25/16,51/32,13/8,27/16,55/32,7/4,15/8]
--
psaltery_o :: [Rational]
-- | Larry Polansky. "Tuning Systems in American Gamelan, Part I: Interval
-- Sizes in Javanese Slendro". Balungan, 1(2):9-11, 1984
module Music.Theory.Tuning.Polansky_1984
k_manisrenga :: Fractional n => [n]
k_kanjutmesem :: Fractional n => [n]
k_udanriris :: Fractional n => [n]
k_pengawesari :: Fractional n => [n]
k_rarasrum :: Fractional n => [n]
k_hardjanagara :: Fractional n => [n]
k_madukentir :: Fractional n => [n]
k_surak :: Fractional n => [n]
-- | The set of K slendro tunings.
--
--
-- map length k_set == replicate (length k_set) 5
-- minimum (concat k_set) == 206
-- maximum (concat k_set) == 268.5
--
k_set :: Fractional n => [[n]]
-- | Given a set of equal length lists calculate the average value of each
-- position.
--
--
-- calculate_averages [[1,2,3],[3,2,1]] == [2,2,2]
--
calculate_averages :: Fractional n => [[n]] -> [n]
-- | Averages of K set, p. 10.
--
--
-- k_averages == [233.8125,245.0625,234.0,240.8125,251.875]
--
k_averages :: Fractional n => [n]
gm_1 :: Fractional n => [n]
gm_8 :: Fractional n => [n]
gm_7 :: Fractional n => [n]
gm_6 :: Fractional n => [n]
gm_5 :: Fractional n => [n]
gm_4 :: Fractional n => [n]
gm_3 :: Fractional n => [n]
gm_2 :: Fractional n => [n]
-- | The set of GM (Gadja Mada University) slendro tunings.
--
--
-- map length gm_set == replicate (length gm_set) 5
-- minimum (concat gm_set) == 218
-- maximum (concat gm_set) == 262
--
gm_set :: Fractional n => [[n]]
-- | Averages of GM set, p. 10.
--
--
-- gm_averages == [234.0,240.25,247.625,243.125,254.0625]
--
gm_averages :: Fractional n => [n]
-- | Association list giving interval boundaries for interval class
-- categories (pp.10-11).
i_categories :: Num n => [((n, n), String)]
-- | Categorise an interval.
i_category :: (Ord a, Num a) => a -> String
-- | Pad String to right with spaces until at least n
-- characters.
--
--
-- map (pad 3) ["S","E-L"] == ["S ","E-L"]
--
pad :: Int -> String -> String
-- | Pretty interval category table (pp. 10-11).
--
--
-- i_category_table k_set ==
-- ["S L S S L "
-- ,"S L S S L "
-- ,"L L S S S "
-- ,"L S S S L "
-- ,"S S L S L "
-- ,"S E-L S L L "
-- ,"L E E S S "
-- ,"S S S-E L L "]
--
--
--
-- i_category_table gm_set ==
-- ["S L E-L E L "
-- ,"L S-E E S L "
-- ,"S S-E S L S-E"
-- ,"S L L S L "
-- ,"S S-E E-L S L "
-- ,"S S-E E E L "
-- ,"S-E S L E L "
-- ,"S S E-L L L "]
--
i_category_table :: (Ord a, Num a) => [[a]] -> [String]
-- | Rational tuning derived from gm_averages, p.11.
--
--
-- polansky_1984_r == sort polansky_1984_r
-- polansky_1984_r == [1/1,8/7,21/16,512/343,12/7,96/49]
--
--
--
-- import Music.Theory.List
-- d_dx polansky_1984_r == [1/7,19/112,989/5488,76/343,12/49]
--
polansky_1984_r :: [Rational]
-- | ratio_to_cents of polansky_1984_r.
--
--
-- import Music.Theory.List
-- map round (d_dx polansky_1984_c) == [231,240,223,240,231]
--
polansky_1984_c :: [Cents]
-- | Larry Polansky. "Notes on Piano Study #5". _1/1, The Journal of the
-- Just Intonation Newtork_, 1(4), Autumn 1985.
module Music.Theory.Tuning.Polansky_1985c
-- | The tuning has four octaves, these ratios are per-octave.
ps5_jpr_r :: [[Rational]]
-- | Four-octave tuning.
--
--
-- import Data.List.Split
--
--
--
-- let r = [[ 0, 84, 204, 316, 386, 498, 583, 702, 814, 884, 969,1088]
-- ,[1200,1284,1404,1516,1586,1698,1783,1902,2014,2084,2169,2288]
-- ,[2400,2453,2604,2716,2786,2871,2951,3102,3214,3241,3369,3488]
-- ,[3600,3684,3804,3867,3986,4098,4151,4302,4414,4506,4569,4688]]
-- in chunksOf 12 (cents_i ps5_jpr) == r
--
--
--
-- let r = [[0,84,204,316,386,498,583,702,814,884,969,1088]
-- ,[0,84,204,316,386,498,583,702,814,884,969,1088]
-- ,[0,53,204,316,386,471,551,702,814,841,969,1088]
-- ,[0,84,204,267,386,498,551,702,814,906,969,1088]]
-- chunksOf 12 (map (`mod` 1200) (cents_i ps5_jpr))
--
ps5_jpr :: Tuning
-- | Terry Riley.
module Music.Theory.Tuning.Riley
-- | Ratios for riley_albion.
--
--
-- let r = [0,112,204,316,386,498,610,702,814,884,996,1088]
-- in map (round . ratio_to_cents) riley_albion_r == r
--
riley_albion_r :: [Rational]
-- | Riley's five-limit tuning as used in _The Harp of New Albion_, see
-- http://www.ex-tempore.org/Volx1/hudson/hudson.htm.
--
--
-- cents_i riley_albion == [0,112,204,316,386,498,610,702,814,884,996,1088]
--
riley_albion :: Tuning
-- | Parser for the Scala scale file format. See
-- http://www.huygens-fokker.org/scala/scl_format.html for
-- details. This module succesfully parses all 4496 scales in v.81 of the
-- scale library.
module Music.Theory.Tuning.Scala
-- | A .scl pitch is either in Cents or is a
-- Ratio.
type Pitch i = Either Cents (Ratio i)
-- | A scale has a description, a degree, and a list of Pitches.
type Scale i = (String, i, [Pitch i])
-- | Text description of scale.
scale_description :: Scale i -> String
-- | The degree of the scale (number of Pitches).
scale_degree :: Scale i -> i
-- | The Pitches at Scale.
scale_pitches :: Scale i -> [Pitch i]
-- | The last Pitch element of the scale (ie. the ocatve).
scale_octave :: Scale i -> Maybe (Pitch i)
-- | Is scale_octave perfect, ie. Ratio of 2 or
-- Cents of 1200.
perfect_octave :: Integral i => Scale i -> Bool
-- | A pair giving the number of Cents and number of Ratio
-- pitches at Scale.
scale_pitch_representations :: Integral t => Scale i -> (t, t)
-- | Pitch as Cents, conversion by to_cents_r if necessary.
pitch_cents :: Pitch Integer -> Cents
type Epsilon = Double
-- | Pitch as Rational, conversion by reconstructed_ratio if
-- necessary, hence epsilon.
pitch_ratio :: Epsilon -> Pitch Integer -> Rational
-- | Make scale pitches uniform, conforming to the most promininent pitch
-- type.
scale_uniform :: Epsilon -> Scale Integer -> Scale Integer
-- | Scale as list of Cents (ie. pitch_cents) with 0
-- prefix.
scale_cents :: Scale Integer -> [Cents]
-- | Scale as list of Rational (ie. pitch_ratio) with
-- 1 prefix.
scale_ratios :: Epsilon -> Scale Integer -> [Rational]
-- | Comment lines being with !.
comment_p :: String -> Bool
-- | Remove r.
filter_cr :: String -> String
-- | Logical or of list of predicates.
p_or :: [a -> Bool] -> a -> Bool
-- | Remove to end of line ! comments.
remove_eol_comments :: String -> String
-- | Remove comments and null lines.
--
--
-- filter_comments ["!a","b","","c"] == ["b","c"]
--
filter_comments :: [String] -> [String]
-- | Delete trailing ., read fails for 700..
delete_trailing_point :: String -> String
-- | Pitches are either cents (with decimal point) or ratios (with
-- /).
--
--
-- map pitch ["700.0","3/2","2"] == [Left 700,Right (3/2),Right 2]
--
pitch :: (Read i, Integral i) => String -> Pitch i
-- | Pitch lines may contain commentary.
pitch_ln :: (Read i, Integral i) => String -> Pitch i
-- | Parse .scl file.
parse :: (Read i, Integral i) => String -> Scale i
-- | Load .scl file.
--
--
-- s <- load "/home/rohan/data/scala/81/scl/xenakis_chrom.scl"
-- scale_pitch_representations s == (6,1)
-- scale_ratios 1e-3 s == [1,21/20,29/23,179/134,280/187,11/7,100/53,2]
--
load :: (Read i, Integral i) => FilePath -> IO (Scale i)
-- | Subset of files in dir with an extension in ext.
dir_subset :: [String] -> FilePath -> IO [FilePath]
-- | Load all .scl files at dir.
--
--
-- db <- load_dir "/home/rohan/data/scala/81/scl"
-- length db == 4496
-- length (filter ((== 0) . scale_degree) db) == 0
-- length (filter (== Just (Right 2)) (map scale_octave db)) == 3855
--
--
--
-- let r = [2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24
-- ,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44
-- ,45,46,47,48,49,50,51,53,54,55,56,57,58,59,60,61,62,63,64
-- ,65,66,67,68,69,70,71,72,74,75,77,78,79,80,81,84,87,88
-- ,90,91,92,95,96,99,100,101,105,110,112,117,118,130,140,171
-- ,180,271,311,342,366,441,612]
-- in nub (sort (map scale_degree db)) == r
--
--
--
-- let r = ["Xenakis's Byzantine Liturgical mode, 5 + 19 + 6 parts"
-- ,"Xenakis's Byzantine Liturgical mode, 12 + 11 + 7 parts"
-- ,"Xenakis's Byzantine Liturgical mode, 7 + 16 + 7 parts"]
-- in filter (isInfixOf "Xenakis") (map scale_description db) == r
--
--
--
-- length (filter (not . perfect_octave) db) == 544
--
--
--
-- mapM_ (putStrLn.scale_description) (filter (not . perfect_octave) db)
--
load_dir :: (Read i, Integral i) => FilePath -> IO [Scale i]
-- | Syntonic tuning.
module Music.Theory.Tuning.Syntonic
-- | Construct an isomorphic layout of r rows and c columns
-- with an upper left value of (i,j).
mk_isomorphic_layout :: Integral a => a -> a -> (a, a) -> [[(a, a)]]
-- | A minimal isomorphic note layout.
--
--
-- let [i,j,k] = mk_isomorphic_layout 3 5 (3,-4)
-- in [i,take 4 j,(2,-4):take 4 k] == minimal_isomorphic_note_layout
--
minimal_isomorphic_note_layout :: [[(Int, Int)]]
-- | Make a rank two regular temperament from a list of (i,j)
-- positions by applying the scalars a and b.
rank_two_regular_temperament :: Integral a => a -> a -> [(a, a)] -> [a]
-- | Syntonic tuning system based on mk_isomorphic_layout of
-- 5 rows and 7 columns starting at (3,-4) and
-- a rank_two_regular_temperament with a of 1200
-- and indicated b.
mk_syntonic_tuning :: Int -> [Cents]
-- | mk_syntonic_tuning of 697.
--
--
-- divisions syntonic_697 == 17
--
--
--
-- let c = [0,79,194,273,309,388,467,503,582,697,776,812,891,970,1006,1085,1164]
-- in cents_i syntonic_697 == c
--
syntonic_697 :: Tuning
-- | mk_syntonic_tuning of 702.
--
--
-- divisions syntonic_702 == 17
--
--
--
-- let c = [0,24,114,204,294,318,408,498,522,612,702,792,816,906,996,1020,1110]
-- in cents_i syntonic_702 == c
--
syntonic_702 :: Tuning
-- | Andreas Werckmeister (1645-1706).
module Music.Theory.Tuning.Werckmeister
-- | Approximate ratios for werckmeister_iii.
--
--
-- let c = [0,90,192,294,390,498,588,696,792,888,996,1092]
-- in map (round . ratio_to_cents) werckmeister_iii_ar == c
--
werckmeister_iii_ar :: [Approximate_Ratio]
-- | Cents for werckmeister_iii.
werckmeister_iii_ar_c :: [Cents]
-- | Werckmeister III, Andreas Werckmeister (1645-1706)
--
--
-- cents_i werckmeister_iii == [0,90,192,294,390,498,588,696,792,888,996,1092]
--
werckmeister_iii :: Tuning
-- | Approximate ratios for werckmeister_iv.
--
--
-- let c = [0,82,196,294,392,498,588,694,784,890,1004,1086]
-- in map (round . ratio_to_cents) werckmeister_iv_ar == c
--
werckmeister_iv_ar :: [Approximate_Ratio]
-- | Cents for werckmeister_iv.
werckmeister_iv_c :: [Cents]
-- | Werckmeister IV, Andreas Werckmeister (1645-1706)
--
--
-- cents_i werckmeister_iv == [0,82,196,294,392,498,588,694,784,890,1004,1086]
--
werckmeister_iv :: Tuning
-- | Approximate ratios for werckmeister_v.
--
--
-- let c = [0,96,204,300,396,504,600,702,792,900,1002,1098]
-- in map (round . ratio_to_cents) werckmeister_v_ar == c
--
werckmeister_v_ar :: [Approximate_Ratio]
-- | Cents for werckmeister_v.
werckmeister_v_c :: [Cents]
-- | Werckmeister V, Andreas Werckmeister (1645-1706)
--
--
-- cents_i werckmeister_v == [0,96,204,300,396,504,600,702,792,900,1002,1098]
--
werckmeister_v :: Tuning
-- | Ratios for werckmeister_vi.
--
--
-- let c = [0,91,196,298,395,498,595,698,793,893,1000,1097]
-- in map (round . ratio_to_cents) werckmeister_vi_r == c
--
werckmeister_vi_r :: [Rational]
-- | Werckmeister VI, Andreas Werckmeister (1645-1706)
--
--
-- cents_i werckmeister_vi == [0,91,196,298,395,498,595,698,793,893,1000,1097]
--
werckmeister_vi :: Tuning
-- | Larry Polansky. "Morphological Metrics". Journal of New Music
-- Research, 25(4):289-368, 1996.
module Music.Theory.Metric.Polansky_1996
-- | Distance function, ordinarily n below is in Num,
-- Fractional or Real.
type Interval a n = a -> a -> n
-- | fromIntegral . -.
dif_i :: (Integral a, Num b) => a -> a -> b
-- | realToFrac . -.
dif_r :: (Real a, Fractional b) => a -> a -> b
-- | abs . f.
abs_dif :: Num n => Interval a n -> a -> a -> n
-- | Square.
sqr :: Num a => a -> a
-- | sqr . f.
sqr_dif :: Num n => Interval a n -> a -> a -> n
-- | sqr . abs . f.
sqr_abs_dif :: Num n => Interval a n -> a -> a -> n
-- | sqrt . abs . f.
sqrt_abs_dif :: Floating c => Interval a c -> a -> a -> c
-- | City block metric, p.296
--
--
-- city_block_metric (-) (1,2) (3,5) == 2+3
--
city_block_metric :: Num n => Interval a n -> (a, a) -> (a, a) -> n
-- | Two-dimensional euclidean metric, p.297.
--
--
-- euclidean_metric_2 (-) (1,2) (3,5) == sqrt (4+9)
--
euclidean_metric_2 :: Floating n => Interval a n -> (a, a) -> (a, a) -> n
-- | n-dimensional euclidean metric
--
--
-- euclidean_metric_l (-) [1,2] [3,5] == sqrt (4+9)
-- euclidean_metric_l (-) [1,2,3] [2,4,6] == sqrt (1+4+9)
--
euclidean_metric_l :: Floating c => Interval b c -> [b] -> [b] -> c
-- | Cube root.
--
--
-- map cbrt [1,8,27] == [1,2,3]
--
cbrt :: Floating a => a -> a
-- | n-th root
--
--
-- map (nthrt 4) [1,16,81] == [1,2,3]
--
nthrt :: Floating a => a -> a -> a
-- | Two-dimensional Minkowski metric, p.297
--
--
-- minkowski_metric_2 (-) 1 (1,2) (3,5) == 5
-- minkowski_metric_2 (-) 2 (1,2) (3,5) == sqrt (4+9)
-- minkowski_metric_2 (-) 3 (1,2) (3,5) == cbrt (8+27)
--
minkowski_metric_2 :: Floating a => Interval t a -> a -> (t, t) -> (t, t) -> a
-- | n-dimensional Minkowski metric
--
--
-- minkowski_metric_l (-) 2 [1,2,3] [2,4,6] == sqrt (1+4+9)
-- minkowski_metric_l (-) 3 [1,2,3] [2,4,6] == cbrt (1+8+27)
--
minkowski_metric_l :: Floating a => Interval t a -> a -> [t] -> [t] -> a
-- | Integration with f.
--
--
-- d_dx (-) [0,2,4,1,0] == [2,2,-3,-1]
-- d_dx (-) [2,3,0,4,1] == [1,-3,4,-3]
--
d_dx :: Interval a n -> [a] -> [n]
-- | map abs . d_dx.
--
--
-- d_dx_abs (-) [0,2,4,1,0] == [2,2,3,1]
-- d_dx_abs (-) [2,3,0,4,1] == [1,3,4,3]
--
d_dx_abs :: Num n => Interval a n -> [a] -> [n]
-- | Ordered linear magnitude (no delta), p.300
--
--
-- olm_no_delta' [0,2,4,1,0] [2,3,0,4,1] == 1.25
--
olm_no_delta' :: Fractional a => [a] -> [a] -> a
-- | Ordered linear magintude (general form) p.302
--
--
-- olm_general (abs_dif (-)) [0,2,4,1,0] [2,3,0,4,1] == 1.25
-- olm_general (abs_dif (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 4.6
--
olm_general :: (Fractional a, Enum a, Fractional n) => Interval a n -> [a] -> [a] -> n
-- | Delta (Δ) determines an interval given a sequence and an index.
type Delta n a = [n] -> Int -> a
-- | f at indices i and i+1 of x.
--
--
-- map (ix_dif (-) [0,1,3,6,10]) [0..3] == [-1,-2,-3,-4]
--
ix_dif :: Interval a t -> Delta a t
-- | abs . ix_dif
--
--
-- map (abs_ix_dif (-) [0,2,4,1,0]) [0..3] == [2,2,3,1]
--
abs_ix_dif :: Num n => Interval a n -> Delta a n
-- | sqr . abs_ix_dif
--
--
-- map (sqr_abs_ix_dif (-) [0,2,4,1,0]) [0..3] == [4,4,9,1]
-- map (sqr_abs_ix_dif (-) [2,3,0,4,1]) [0..3] == [1,9,16,9]
--
sqr_abs_ix_dif :: Num n => Interval a n -> Delta a n
-- | Psi (Ψ) joins Delta equivalent intervals from
-- morphologies m and n.
type Psi a = a -> a -> a
-- | Ordered linear magintude (generalised-interval form) p.305
--
--
-- olm (abs_dif dif_r) (abs_ix_dif dif_r) (const 1) [1,5,12,2,9,6] [7,6,4,9,8,1] == 4.6
-- olm (abs_dif dif_r) (abs_ix_dif dif_r) maximum [1,5,12,2,9,6] [7,6,4,9,8,1] == 0.46
--
olm :: (Fractional a, Enum a) => Psi a -> Delta n a -> ([a] -> a) -> [n] -> [n] -> a
olm_no_delta :: (Real a, Real n, Enum n, Fractional n) => [a] -> [a] -> n
olm_no_delta_squared :: (Enum a, Floating a) => [a] -> [a] -> a
second_order :: Num n => ([n] -> [n] -> t) -> [n] -> [n] -> t
olm_no_delta_second_order :: (Real a, Enum a, Fractional a) => [a] -> [a] -> a
olm_no_delta_squared_second_order :: (Enum a, Floating a) => [a] -> [a] -> a
-- | Second order binomial coefficient, p.307
--
--
-- map second_order_binonial_coefficient [2..10] == [1,3,6,10,15,21,28,36,45]
--
second_order_binonial_coefficient :: Fractional a => a -> a
-- | d_dx of flip compare.
--
--
-- direction_interval [5,9,3,2] == [LT,GT,GT]
-- direction_interval [2,5,6,6] == [LT,LT,EQ]
--
direction_interval :: Ord i => [i] -> [Ordering]
-- | Histogram of list of Orderings.
--
--
-- ord_hist [LT,GT,GT] == (1,0,2)
--
ord_hist :: Integral t => [Ordering] -> (t, t, t)
-- | Histogram of directions of adjacent elements, p.312.
--
--
-- direction_vector [5,9,3,2] == (1,0,2)
-- direction_vector [2,5,6,6] == (2,1,0)
--
direction_vector :: Integral i => Ord a => [a] -> (i, i, i)
-- | Unordered linear direction, p.311 (Fig. 5)
--
--
-- uld [5,9,3,2] [2,5,6,6] == 2/3
-- uld [5,3,6,1,4] [3,6,1,4,2] == 0
--
uld :: (Integral n, Ord a) => [a] -> [a] -> Ratio n
-- | Ordered linear direction, p.312
--
--
-- direction_interval [5,3,6,1,4] == [GT,LT,GT,LT]
-- direction_interval [3,6,1,4,2] == [LT,GT,LT,GT]
-- old [5,3,6,1,4] [3,6,1,4,2] == 1
--
old :: (Ord i, Integral a) => [i] -> [i] -> Ratio a
-- | Ordered combinatorial direction, p.314
--
--
-- ocd [5,9,3,2] [2,5,6,6] == 5/6
-- ocd [5,3,6,1,4] [3,6,1,4,2] == 4/5
--
ocd :: (Ord a, Integral i) => [a] -> [a] -> Ratio i
-- | Unordered combinatorial direction, p.314
--
--
-- ucd [5,9,3,2] [2,5,6,6] == 5/6
-- ucd [5,3,6,1,4] [3,6,1,4,2] == 0
-- ucd [5,3,7,6] [2,1,2,1] == 1/2
-- ucd [2,1,2,1] [8,3,5,4] == 1/3
-- ucd [5,3,7,6] [8,3,5,4] == 1/3
--
ucd :: (Integral n, Ord a) => [a] -> [a] -> Ratio n
-- | half_matrix_f, Fig.9, p.318
--
--
-- let r = [[2,3,1,4]
-- ,[1,3,6]
-- ,[4,7]
-- ,[3]]
-- in combinatorial_magnitude_matrix (abs_dif (-)) [5,3,2,6,9] == r
--
combinatorial_magnitude_matrix :: Interval a n -> [a] -> [[n]]
-- | Unordered linear magnitude (simplified), p.320-321
--
--
-- let r = abs (sum [5,4,3,6] - sum [12,2,11,7]) / 4
-- in ulm_simplified (abs_dif (-)) [1,6,2,5,11] [3,15,13,2,9] == r
--
--
--
-- ulm_simplified (abs_dif (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 3
--
ulm_simplified :: Fractional n => Interval a n -> [a] -> [a] -> n
ocm_zcm :: (Fractional n, Num a) => Interval a n -> [a] -> [a] -> (n, n, [n])
-- | Ordered combinatorial magnitude (OCM), p.323
--
--
-- ocm (abs_dif (-)) [1,6,2,5,11] [3,15,13,2,9] == 5.2
-- ocm (abs_dif (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 3.6
--
ocm :: (Fractional a, Enum a, Fractional n) => Interval a n -> [a] -> [a] -> n
-- | Ordered combinatorial magnitude (OCM), p.323
--
--
-- ocm_absolute_scaled (abs_dif (-)) [1,6,2,5,11] [3,15,13,2,9] == 0.4
-- ocm_absolute_scaled (abs_dif (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 54/(15*11)
--
ocm_absolute_scaled :: (Ord a, Fractional a, Enum a, Ord n, Fractional n) => Interval a n -> [a] -> [a] -> n
-- | Place notation (method ringing).
--
-- Morris, R. G. T. "Place Notation" Central Council of Church Bell
-- Ringers (1984). http://www.cccbr.org.uk/bibliography/
module Music.Theory.Permutations.Morris_1984
-- | A change either swaps all adjacent bells, or holds a subset of bells.
data Change
Swap_All :: Change
Hold :: [Int] -> Change
-- | A method is a sequence of changes, if symmetrical only have the
-- changes are given and the lead end.
data Method
Method :: [Change] -> (Maybe Change) -> Method
-- | Compete list of Changes at Method, writing out
-- symmetries.
method_changes :: Method -> [Change]
-- | Parse a change notation.
--
--
-- map parse_change ["-","x","38"] == [Swap_All,Swap_All,Hold [3,8]]
--
parse_change :: String -> Change
-- | Separate changes.
--
--
-- split_changes "-38-14-1258-36-14-58-16-78"
-- split_changes "345.145.5.1.345" == ["345","145","5","1","345"]
--
split_changes :: String -> [String]
-- | Parse Method from the sequence of changes with possible lead
-- end.
--
--
-- parse_method ("-38-14-1258-36-14-58-16-78",Just "12")
--
parse_method :: (String, Maybe String) -> Method
is_swap_all :: String -> Bool
-- | Swap elemets of two-tuple (pair).
--
--
-- swap_pair (1,2) == (2,1)
--
swap_pair :: (s, t) -> (t, s)
-- | Flatten list of pairs.
--
--
-- flatten_pairs [(1,2),(3,4)] == [1..4]
--
flatten_pairs :: [(a, a)] -> [a]
-- | Swap all adjacent pairs at list.
--
--
-- swap_all [1 .. 8] == [2,1,4,3,6,5,8,7]
--
swap_all :: [a] -> [a]
-- | Parse abbreviated Hold notation, characters are hexedecimal.
--
--
-- to_abbrev "38A" == [3,8,10]
--
to_abbrev :: String -> [Int]
-- | Given a Hold notation, generate permutation cycles.
--
--
-- let r = [Right (1,2),Left 3,Right (4,5),Right (6,7),Left 8]
-- in gen_swaps 8 [3,8] == r
--
--
--
-- let r = [Left 1,Left 2,Right (3,4),Right (5,6),Right (7,8)]
-- gen_swaps 8 [1,2] == r
--
gen_swaps :: (Num t, Ord t) => t -> [t] -> [Either t (t, t)]
-- | Two-tuple to two element list.
pair_to_list :: (t, t) -> [t]
-- | Swap notation to plain permutation cycles notation.
--
--
-- let n = [Left 1,Left 2,Right (3,4),Right (5,6),Right (7,8)]
-- in swaps_to_cycles n == [[1],[2],[3,4],[5,6],[7,8]]
--
swaps_to_cycles :: [Either t (t, t)] -> [[t]]
-- | One-indexed permutation cycles to zero-indexed.
--
--
-- let r = [[0],[1],[2,3],[4,5],[6,7]]
-- in to_zero_indexed [[1],[2],[3,4],[5,6],[7,8]] == r
--
to_zero_indexed :: Enum t => [[t]] -> [[t]]
-- | Apply abbreviated Hold notation, given cardinality.
--
--
-- swap_abbrev 8 [3,8] [2,1,4,3,6,5,8,7] == [1,2,4,6,3,8,5,7]
--
swap_abbrev :: Eq a => Int -> [Int] -> [a] -> [a]
-- | Apply a Change.
apply_change :: Eq a => Int -> Change -> [a] -> [a]
-- | Apply a Method, gives next starting sequence and the course of
-- the method.
--
--
-- let r = ([1,2,4,5,3]
-- ,[[1,2,3,4,5],[2,1,3,4,5],[2,3,1,4,5],[3,2,4,1,5],[3,4,2,5,1]
-- ,[4,3,2,5,1],[4,2,3,1,5],[2,4,1,3,5],[2,1,4,3,5],[1,2,4,3,5]])
-- in apply_method cambridgeshire_slow_course_doubles [1..5] == r
--
apply_method :: Eq a => Method -> [a] -> ([a], [[a]])
-- | Iteratively apply a Method until it closes (ie. arrives back at
-- the starting sequence).
--
--
-- length (closed_method cambridgeshire_slow_course_doubles [1..5]) == 3
--
closed_method :: Eq a => Method -> [a] -> [[[a]]]
-- | concat of closed_method with initial sequence appended.
closed_method' :: Eq a => Method -> [a] -> [[a]]
-- | Cambridgeshire Slow Course Doubles.
--
--
-- https://rsw.me.uk/blueline/methods/view/Cambridgeshire_Slow_Course_Doubles
--
--
-- length (closed_method cambridgeshire_slow_course_doubles [1..5]) == 3
--
cambridgeshire_slow_course_doubles :: Method
-- | Double Cambridge Cyclic Bob Minor.
--
--
-- https://rsw.me.uk/blueline/methods/view/Double_Cambridge_Cyclic_Bob_Minor
--
--
-- length (closed_method double_cambridge_cyclic_bob_minor [1..6]) == 5
--
double_cambridge_cyclic_bob_minor :: Method
-- | Hammersmith Bob Triples
--
-- https://rsw.me.uk/blueline/methods/view/Hammersmith_Bob_Triples
--
--
-- length (closed_method hammersmith_bob_triples [1..7]) == 6
--
hammersmith_bob_triples :: Method
-- | Cambridge Surprise Major.
--
--
-- https://rsw.me.uk/blueline/methods/view/Cambridge_Surprise_Major
--
--
-- length (closed_method cambridge_surprise_major [1..8]) == 7
--
cambridge_surprise_major :: Method
-- | Smithsonian Surprise Royal.
--
--
-- https://rsw.me.uk/blueline/methods/view/Smithsonian_Surprise_Royal
--
--
-- length (closed_method smithsonian_surprise_royal [1..10]) == 9
--
smithsonian_surprise_royal :: Method
instance Eq Change
instance Show Change
instance Eq Method
instance Show Method
-- | Bel(R) is a simplified form of the Bel notation
-- described in:
--
--
--
-- For patterns without tempo indications, the two notations should give
-- equivalent phase diagrams, for instance (Bel 1990, §11, p.24):
--
--
-- > bel_ascii_pp "ab{ab,cde}cd"
--
-- Bel(R): "ab{ab,cde}cd", Dur: 7
--
-- a _ b _ a _ _ b _ _ c _ d _
-- c _ d _ e _
--
--
-- and:
--
--
-- > bel_ascii_pp "{a{bc,def},ghijk}"
--
-- Bel(R): "{a{bc,def},ghijk}", Dur: 5
--
-- a _ _ _ _ _ _ _ _ _ b _ _ _ _ _ _ _ _ _ _ _ _ _ _ c _ _ _ _ _ _ _ _ _ _ _ _ _ _
-- d _ _ _ _ _ _ _ _ _ e _ _ _ _ _ _ _ _ _ f _ _ _ _ _ _ _ _ _
-- g _ _ _ _ _ _ _ h _ _ _ _ _ _ _ i _ _ _ _ _ _ _ j _ _ _ _ _ _ _ k _ _ _ _ _ _ _
--
--
-- The Bel notation allows n-ary parallel structures, ie.
-- {a_bcd_e,a_f_gh_,ji_a_i_} (Bel 1992, p.29), however
-- Bel(R) allows only binary structures. The parallel
-- interpretation rules are associative:
--
--
-- > bel_ascii_pp "{a_bcd_e,{a_f_gh_,ji_a_i_}}"
--
-- Bel(R): "{a_bcd_e,{a_f_gh_,ji_a_i_}}", Dur: 7
--
-- a _ b c d _ e
-- a _ f _ g h _
-- j i _ a _ i _
--
--
-- Bel(R) does allow unary parallel structures (see Iso),
-- which can be used to isolate tempo changes:
--
--
-- > bel_ascii_pp "ab{*2cd}ef{*2/3gh}ij"
--
-- Bel(R): "ab{*2cd}ef{*2/3gh}ij", Dur: 10
--
-- a _ b _ c d e _ f _ g _ _ h _ _ i _ j _
--
--
-- Patterns with tempo indications have completely different meanings in
-- Bel and Bel(R), though in both cases parallel nodes
-- delimit the scope of tempo markings.
--
-- Bel(R) replaces the /n notation for explicit tempo
-- marks with a *n notation to indicate a tempo multiplier, and
-- a set of bracketing notations to specify interpretation rules for
-- parallel (concurrent) temporal structures.
--
-- The tempo indication /1 in the expression
-- ab{/1ab,cde}cd (Bel 1990, p.24) requires that the inner
-- ab have the same tempo as the outer ab, which is
-- implicitly /1. Setting the tempo of one part of a parallel
-- structure requires assigning a tempo to the other part in order that
-- the two parts have equal duration. Here the tempo assigned to
-- cde is /1.5, but since fractional tempi are not
-- allowed the expression is re-written as /2ab{/2ab,/3cde}/2cd.
--
-- Importantly the explicit tempo indications make it possible to write
-- syntactically correct expressions in Bel that do not have a
-- coherent interpretation, ie. {/1ab,/1cde}. Determining if a
-- coherent set of tempos can be assigned, and assigning these tempos, is
-- the object of the interpretation system.
--
-- In comparison, all syntactically valid Bel(R) strings have an
-- interpretation. The expression {*1ab,*1cde} is trivially
-- equal to {ab,cde}, and tempo marks in parallel parts do not
-- interact:
--
--
-- > bel_ascii_pp "{a*2b,*3c/2d/3e}"
--
-- Bel(R): "{a*2b,*3c*1/2d*1/3e}", Dur: 3
--
-- a _ _ _ _ _ b _ _
-- c d _ e _ _ _ _ _
--
--
-- Here a is twice the duration of b, and e is
-- three times the duration of d, which is twice the duration of
-- c (in Bel(R) /n is equivalent to
-- *1/n). The duration of any Bel(R) expression can be
-- calculated directly, given an initial Tempo:
--
--
-- bel_dur 1 (bel_char_parse "a*2b") == 3/2
-- bel_dur 1 (bel_char_parse "*3c/2d/3e") == 3
--
--
-- Therefore in the composite expression the left part is slowed by a
-- factor of two to align with the right part.
--
-- The Bel string ab{/1ab,cde}cd can be re-written in
-- Bel(R) as either ab~{ab,cde}cd or
-- ab(ab,cde)cd. The absolute tempo indication is replaced by
-- notations giving alternate modes of interpretation for the parallel
-- structure.
--
-- In the first case the ~ indicates the opposite of the
-- normal rule for parallel nodes. The normal rule is the same as for
-- Bel and is that the duration of the whole is equal to duration
-- of the longer of the two parts. The ~ inverts this so that
-- the whole has the duration of the shorter of the two parts, and the
-- longer part is scaled to have equal duration.
--
-- In the second case the parentheses () replacing the braces
-- {} indicates that the duration of the whole is equal to the
-- duration of the left side, and that the right is to be scaled.
-- Similarly, a ~ preceding parentheses indicates the duration
-- of the whole should be the duration of the right side, and the left
-- scaled.
--
--
-- > bel_ascii_pp "ab~{ab,cde}cd"
--
-- Bel(R): "ab~{ab,cde}cd", Dur: 6
--
-- a _ _ b _ _ a _ _ b _ _ c _ _ d _ _
-- c _ d _ e _
--
--
-- There is one other parallel mode that has no equivalent in Bel
-- notation. It is a mode that does not scale either part, leaving a
-- hole at the end of the shorter part, and is indicated by square
-- brackets:
--
--
-- > bel_ascii_pp "ab[ab,cde]cd"
--
-- Bel(R): "ab[ab,cde]cd", Dur: 7
--
-- a b a b c d
-- c d e
--
--
-- The Bel string /2abc/3de (Bel 1992, p.53) can be
-- written as *2abc*1/2*3de, or equivalently as
-- *2abc*3/2de:
--
--
-- > bel_ascii_pp "*2abc*3/2de"
--
-- Bel(R): "*2abc*3/2de", Dur: 13/6
--
-- a _ _ b _ _ c _ _ d _ e _
--
--
-- It can also be written using the shorthand notation for rest
-- sequences, where an integer n indicates a sequence of n
-- rests, as:
--
--
-- > bel_ascii_pp "(9,abc)(4,de)"
--
-- Bel(R): "(---------,abc)(----,de)", Dur: 13
--
-- - - - - - - - - - - - - -
-- a _ _ b _ _ c _ _ d _ e _
--
--
-- In the Bel string {ab{/3abc,de},fghijk} (Bel 1992,
-- p.20) the tempo indication does not change the inter-relation of the
-- parts but rather scales the parallel node altogether, and can be
-- re-written in Bel(R) notation as:
--
--
-- > bel_ascii_pp "{ab*3{abc,de},fghijk}"
--
-- Bel(R): "{ab*3{abc,de},fghijk}", Dur: 6
--
-- a _ _ _ _ _ b _ _ _ _ _ a _ b _ c _
-- d _ _ e _ _
-- f _ _ g _ _ h _ _ i _ _ j _ _ k _ _
--
--
-- Curiously the following example (Bel 1990, p. 24) does not correspond
-- to the phase diagram given:
--
--
-- > bel_ascii_pp "{i{ab,cde},jk}"
--
-- Bel(R): "{i{ab,cde},jk}", Dur: 4
--
-- i _ a _ _ b _ _
-- c _ d _ e _
-- j _ _ _ k _ _ _
--
--
-- The paper assigns tempi of /6 to both i and
-- ab, which in Bel(R) could be written:
--
--
-- > bel_ascii_pp "{i~{ab,cde},jk}"
--
-- Bel(R): "{i~{ab,cde},jk}", Dur: 3
--
-- i _ _ _ _ _ a _ _ _ _ _ b _ _ _ _ _
-- c _ _ _ d _ _ _ e _ _ _
-- j _ _ _ _ _ _ _ _ k _ _ _ _ _ _ _ _
--
module Music.Theory.Time.Bel1990.R
-- | Types of Par nodes.
data Par_Mode
Par_Left :: Par_Mode
Par_Right :: Par_Mode
Par_Min :: Par_Mode
Par_Max :: Par_Mode
Par_None :: Par_Mode
-- | The different Par modes are indicated by bracket types.
par_mode_brackets :: Par_Mode -> (String, String)
bel_brackets_match :: (Char, Char) -> Bool
-- | Tempo is rational. The duration of a Term is the reciprocal of
-- the Tempo that is in place at the Term.
type Tempo = Rational
-- | Terms are the leaf nodes of the temporal structure.
data Term a
Value :: a -> Term a
Rest :: Term a
Continue :: Term a
-- | Recursive temporal structure.
data Bel a
-- | Leaf node
Node :: (Term a) -> Bel a
-- | Isolate
Iso :: (Bel a) -> Bel a
-- | Sequence
Seq :: (Bel a) -> (Bel a) -> Bel a
-- | Parallel
Par :: Par_Mode -> (Bel a) -> (Bel a) -> Bel a
-- | Tempo multiplier
Mul :: Tempo -> Bel a
-- | Pretty printer for Bel, given pretty printer for the term type.
bel_pp :: (a -> String) -> Bel a -> String
-- | bel_pp of return.
bel_char_pp :: Bel Char -> String
-- | Analyse a Par node giving (duration,LHS-tempo-*,RHS-tempo-*).
--
--
-- par_analyse 1 Par_Left (nseq "cd") (nseq "efg") == (2,1,3/2)
-- par_analyse 1 Par_Right (nseq "cd") (nseq "efg") == (3,2/3,1)
-- par_analyse 1 Par_Min (nseq "cd") (nseq "efg") == (2,1,3/2)
-- par_analyse 1 Par_Max (nseq "cd") (nseq "efg") == (3,2/3,1)
-- par_analyse 1 Par_None (nseq "cd") (nseq "efg") == (3,1,1)
--
par_analyse :: Tempo -> Par_Mode -> Bel a -> Bel a -> (Rational, Rational, Rational)
-- | Duration element of par_analyse.
par_dur :: Tempo -> Par_Mode -> Bel a -> Bel a -> Rational
-- | Calculate final tempo and duration of Bel.
bel_tdur :: Tempo -> Bel a -> (Tempo, Rational)
-- | snd of bel_tdur.
bel_dur :: Tempo -> Bel a -> Rational
-- | Time point.
type Time = Rational
-- | Voices are named as a sequence of left and right directions within
-- nested Par structures.
type Voice = [Char]
-- | Linear state. Time is the start time of the term, Tempo
-- is the active tempo & therefore the reciprocal of the duration,
-- Voice is the part label.
type L_St = (Time, Tempo, Voice)
-- | Linear term.
type L_Term a = (L_St, Term a)
-- | Start time of L_Term.
lterm_time :: L_Term a -> Time
-- | Duration of L_Term (reciprocal of tempo).
lterm_duration :: L_Term a -> Time
-- | End time of L_Term.
lterm_end_time :: L_Term a -> Time
-- | Linear form of Bel, an ascending sequence of L_Term.
type L_Bel a = [L_Term a]
-- | Linearise Bel given initial L_St, ascending by
-- construction.
bel_linearise :: L_St -> Bel a -> (L_Bel a, L_St)
-- | Merge two ascending L_Bel.
lbel_merge :: L_Bel a -> L_Bel a -> L_Bel a
-- | Set of unique Tempo at L_Bel.
lbel_tempi :: L_Bel a -> [Tempo]
-- | Multiply Tempo by n, and divide Time by n.
lbel_tempo_mul :: Rational -> L_Bel a -> L_Bel a
-- | After normalisation all start times and durations are integral.
lbel_normalise :: L_Bel a -> L_Bel a
-- | All leftmost voices are re-written to the last non-left turning point.
--
--
-- map voice_normalise ["","l","ll","lll"] == replicate 4 ""
-- voice_normalise "lllrlrl" == "rlrl"
--
voice_normalise :: Voice -> Voice
-- | == on voice_normalise
voice_eq :: Voice -> Voice -> Bool
-- | Unique Voices at L_Bel.
lbel_voices :: L_Bel a -> [Voice]
-- | The duration of L_Bel.
lbel_duration :: L_Bel a -> Time
-- | Locate an L_Term that is active at the indicated Time
-- and in the indicated Voice.
lbel_lookup :: (Time, Voice) -> L_Bel a -> Maybe (L_Term a)
-- | Calculate grid (phase diagram) for L_Bel.
lbel_grid :: L_Bel a -> [[Maybe (Term a)]]
-- | lbel_grid of bel_linearise.
bel_grid :: Bel a -> [[Maybe (Term a)]]
-- | Bel type phase diagram for Bel of Char.
-- Optionally print whitespace between columns.
bel_ascii :: Bool -> Bel Char -> String
-- | putStrLn of bel_ascii.
bel_ascii_pr :: Bel Char -> IO ()
-- | Infix form for Seq.
(~>) :: Bel a -> Bel a -> Bel a
-- | foldl1 of Seq.
--
--
-- lseq [Node Rest] == Node Rest
-- lseq [Node Rest,Node Continue] == Seq (Node Rest) (Node Continue)
--
lseq :: [Bel a] -> Bel a
-- | Node of Value.
node :: a -> Bel a
-- | lseq of Node
nseq :: [a] -> Bel a
-- | Variant of nseq where _ is read as Continue and
-- - as Rest.
cseq :: String -> Bel Char
-- | Par of Par_Max, this is the default Par_Mode.
par :: Bel a -> Bel a -> Bel a
-- | Node of Rest.
rest :: Bel a
-- | lseq of replicate of rest.
nrests :: Integral n => n -> Bel a
-- | Verify that bel_char_pp of bel_char_parse is id.
bel_parse_pp_ident :: String -> Bool
-- | Run bel_char_parse, and print both bel_char_pp and
-- bel_ascii.
--
--
-- bel_ascii_pp "{i{ab,{c[d,oh]e,sr{p,qr}}},{jk,ghjkj}}"
--
bel_ascii_pp :: String -> IO ()
-- | A Char parser.
type P a = GenParser Char () a
-- | Parse Rest Term.
--
--
-- P.parse p_rest "" "-"
--
p_rest :: P (Term a)
-- | Parse Rest Term.
--
--
-- P.parse p_nrests "" "3"
--
p_nrests :: P (Bel a)
-- | Parse Continue Term.
--
--
-- P.parse p_continue "" "_"
--
p_continue :: P (Term a)
-- | Parse Char Value Term.
--
--
-- P.parse p_char_value "" "a"
--
p_char_value :: P (Term Char)
-- | Parse Char Term.
--
--
-- P.parse (P.many1 p_char_term) "" "-_a"
--
p_char_term :: P (Term Char)
-- | Parse Char Node.
--
--
-- P.parse (P.many1 p_char_node) "" "-_a"
--
p_char_node :: P (Bel Char)
-- | Parse positive Integer.
--
--
-- P.parse p_integer "" "3"
--
p_integer :: P Integer
-- | Parse positive Rational.
--
--
-- P.parse (p_rational `P.sepBy` (P.char ',')) "" "3%5,2/3"
--
p_rational :: P Rational
-- | Parse positive Double.
--
--
-- P.parse p_double "" "3.5"
-- P.parse (p_double `P.sepBy` (P.char ',')) "" "3.5,7.2,1.0"
--
p_double :: P Double
-- | Parse positive number as Rational.
--
--
-- P.parse (p_number `P.sepBy` (P.char ',')) "" "7%2,3.5,3"
--
p_number :: P Rational
-- | Parse Mul.
--
--
-- P.parse (P.many1 p_mul) "" "/3*3/2"
--
p_mul :: P (Bel a)
-- | Given parser for Bel a, generate Iso parser.
p_iso :: P (Bel a) -> P (Bel a)
-- | p_iso of p_char_bel.
--
--
-- P.parse p_char_iso "" "{abcde}"
--
p_char_iso :: P (Bel Char)
-- | Given parser for Bel a, generate Par parser.
p_par :: P (Bel a) -> P (Bel a)
-- | p_par of p_char_bel.
--
--
-- P.parse p_char_par "" "{ab,{c,de}}"
-- P.parse p_char_par "" "{ab,~(c,de)}"
--
p_char_par :: P (Bel Char)
-- | Parse Bel Char.
--
--
-- P.parse (P.many1 p_char_bel) "" "-_a*3"
--
p_char_bel :: P (Bel Char)
-- | Run parser for Bel of Char.
bel_char_parse :: String -> Bel Char
instance Eq Par_Mode
instance Show Par_Mode
instance Eq a => Eq (Term a)
instance Show a => Show (Term a)
instance Eq a => Eq (Bel a)
instance Show a => Show (Bel a)
-- | Equal temperament tuning tables.
module Music.Theory.Tuning.ET
-- | octpc_to_pitch and octpc_to_cps.
octpc_to_pitch_cps :: Floating n => OctPC -> (Pitch, n)
-- | 12-tone equal temperament table equating Pitch and frequency
-- over range of human hearing, where A4 = 440hz.
--
--
-- length tbl_12et == 132
-- let min_max l = (minimum l,maximum l)
-- min_max (map (round . snd) tbl_12et) == (16,31609)
--
tbl_12et :: [(Pitch, Double)]
-- | 24-tone equal temperament variant of tbl_12et.
--
--
-- length tbl_24et == 264
-- min_max (map (round . snd) tbl_24et) == (16,32535)
--
tbl_24et :: [(Pitch, Double)]
-- | Given an ET table (or like) find bounds of frequency.
--
--
-- let r = Just (at_pair octpc_to_pitch_cps ((3,11),(4,0)))
-- in bounds_et_table tbl_12et 256 == r
--
bounds_et_table :: Ord s => [(t, s)] -> s -> Maybe ((t, s), (t, s))
-- | bounds_et_table of tbl_12et.
--
--
-- map bounds_12et_tone (hsn 17 55)
--
bounds_12et_tone :: Double -> Maybe ((Pitch, Double), (Pitch, Double))
-- | Tuple indicating nearest Pitch to frequency with
-- ET frequency, and deviation in hertz and Cents.
type HS_R p = (Double, p, Double, Double, Cents)
-- | n-decimal places.
--
--
-- ndp 3 (1/3) == "0.333"
--
ndp :: Int -> Double -> String
-- | Pretty print HS_R.
hs_r_pp :: (p -> String) -> Int -> HS_R p -> [String]
hs_r_pitch_pp :: Int -> HS_R Pitch -> [String]
-- | Form HS_R for frequency by consulting table.
--
--
-- let {f = 256
-- ;f' = octpc_to_cps (4,0)
-- ;r = (f,Pitch C Natural 4,f',f-f',fratio_to_cents (f/f'))}
-- in nearest_et_table_tone tbl_12et 256 == r
--
nearest_et_table_tone :: [(p, Double)] -> Double -> HS_R p
-- | nearest_et_table_tone for tbl_12et.
nearest_12et_tone :: Double -> HS_R Pitch
-- | nearest_et_table_tone for tbl_24et.
--
--
-- let r = "55.0 A1 55.0 0.0 0.0"
-- in unwords (hs_r_pitch_pp 1 (nearest_24et_tone 55)) == r
--
nearest_24et_tone :: Double -> HS_R Pitch
-- | Monzo 72-edo HEWM notation. The domain is (-9,9).
-- http://www.tonalsoft.com/enc/number/72edo.aspx
--
--
-- let r = ["+",">","^","#<","#-","#","#+","#>","#^"]
-- in map alteration_72et_monzo [1 .. 9] == r
--
--
--
-- let r = ["-","<","v","b>","b+","b","b-","b<","bv"]
-- in map alteration_72et_monzo [-1,-2 .. -9] == r
--
alteration_72et_monzo :: Integral n => n -> String
-- | Given a midi note number and 1/6 deviation determine
-- Pitch' and frequency.
--
--
-- let {f = pitch'_pp . fst . pitch_72et
-- ;r = "C4 C+4 C>4 C^4 C#<4 C#-4 C#4 C#+4 C#>4 C#^4"}
-- in unwords (map f (zip (repeat 60) [0..9])) == r
--
--
--
-- let {f = pitch'_pp . fst . pitch_72et
-- ;r = "A4 A+4 A>4 A^4 Bb<4 Bb-4 Bb4 Bb+4 Bb>4 Bv4"}
-- in unwords (map f (zip (repeat 69) [0..9]))
--
--
--
-- let {f = pitch'_pp . fst . pitch_72et
-- ;r = "Bb4 Bb+4 Bb>4 Bv4 B<4 B-4 B4 B+4 B>4 B^4"}
-- in unwords (map f (zip (repeat 70) [0..9])) == r
--
pitch_72et :: (Int, Int) -> (Pitch', Double)
-- | 72-tone equal temperament table equating Pitch' and frequency
-- over range of human hearing, where A4 = 440hz.
--
--
-- length tbl_72et == 792
-- min_max (map (round . snd) tbl_72et) == (16,33167)
--
tbl_72et :: [(Pitch', Double)]
-- | nearest_et_table_tone for tbl_72et.
--
--
-- let r = "324.0 E<4 323.3 0.7 3.5"
-- in unwords (hs_r_pp pitch'_pp 1 (nearest_72et_tone 324))
--
--
--
-- let {f = take 2 . hs_r_pp pitch'_pp 1 . nearest_72et_tone . snd}
-- in mapM_ (print . unwords . f) tbl_72et
--
nearest_72et_tone :: Double -> HS_R Pitch'
-- | Pitch with 12-ET/24-ET tuning deviation given in Cents.
type Pitch_Detune = (Pitch, Cents)
-- | Exract Pitch_Detune from HS_R.
hsr_to_pitch_detune :: HS_R Pitch -> Pitch_Detune
-- | Nearest 12-ET Pitch_Detune to indicated frequency (hz).
--
--
-- nearest_pitch_detune_12et 452.8929841231365
--
nearest_pitch_detune_12et :: Double -> Pitch_Detune
-- | Nearest 24-ET Pitch_Detune to indicated frequency (hz).
--
--
-- nearest_pitch_detune_24et 452.8929841231365
--
nearest_pitch_detune_24et :: Double -> Pitch_Detune
-- | Given near function, f0 and ratio derive
-- Pitch_Detune.
ratio_to_pitch_detune :: (Double -> HS_R Pitch) -> OctPC -> Rational -> Pitch_Detune
-- | Frequency (hz) of Pitch_Detune.
--
--
-- pitch_detune_to_cps (octpc_to_pitch pc_spell_ks (4,9),50)
--
pitch_detune_to_cps :: Floating n => Pitch_Detune -> n
-- | ratio_to_pitch_detune of nearest_12et_tone
ratio_to_pitch_detune_12et :: OctPC -> Rational -> Pitch_Detune
-- | ratio_to_pitch_detune of nearest_24et_tone
ratio_to_pitch_detune_24et :: OctPC -> Rational -> Pitch_Detune
pitch_detune_in_octave_nearest :: Pitch -> Pitch_Detune -> Pitch_Detune
-- | Markdown pretty-printer for Pitch_Detune.
pitch_detune_md :: Pitch_Detune -> String
-- | HTML pretty-printer for Pitch_Detune.
pitch_detune_html :: Pitch_Detune -> String
-- | No-octave variant of pitch_detune_md.
pitch_class_detune_md :: Pitch_Detune -> String
-- | No-octave variant of pitch_detune_html.
pitch_class_detune_html :: Pitch_Detune -> String
-- | Larry Polansky. "Notes on the Tunings of Three Central Javanese
-- Slendro/Pelog Pairs". Experimental Musical Instruments,
-- 6(2):12-13,16-17, 1990.
module Music.Theory.Tuning.Polansky_1990
-- | Kanjutmesem Slendro (S1,S2,S3,S5,S6,S1')
--
--
-- L.d_dx kanjutmesem_s == [252,238,241,236,253]
--
kanjutmesem_s :: Num n => [n]
-- | Kanjutmesem Pelog (P1,P2,P3,P4,P5,P6,P7,P1')
--
--
-- L.d_dx kanjutmesem_p == [141,141,272,140,115,172,246]
--
kanjutmesem_p :: Num n => [n]
-- | Darius Slendro (S1,S2,S3,S5,S6,S1')
--
--
-- L.d_dx darius_s == [204,231,267,231,267]
-- ax_r darius_s == [9/8,8/7,7/6,8/7,7/6]
--
darius_s :: Num n => [n]
-- | Madeleine Pelog (P1,P2,P3,P4,P5,P6,P7,P1')
--
--
-- L.d_dx madeleine_p == [139,128,336,99,94,173,231]
-- ax_r madeleine_p == [13/12,14/13,17/14,18/17,19/18,21/19,8/7]
--
madeleine_p :: Num n => [n]
-- | Lipur Sih Slendro (S1,S2,S3,S5,S6,S1')
--
--
-- L.d_dx lipur_sih_s == [273,236,224,258,256]
--
lipur_sih_s :: Num n => [n]
-- | Lipur Sih Pelog (P1,P2,P3,P4,P5,P6,P7,P1')
--
--
-- L.d_dx lipur_sih_p == [110,153,253,146,113,179]
--
lipur_sih_p :: Num n => [n]
-- | Idealized ET Slendro, 5-tone equal temperament (p.17)
--
--
-- L.d_dx idealized_et_s == [240,240,240,240,240]
--
idealized_et_s :: Num n => [n]
-- | Idealized ET Pelog, subset of 9-tone equal temperament (p.17)
--
--
-- L.d_dx idealized_et_p == [400/3,800/3,400/3,400/3,400/3,400/3,800/3]
--
idealized_et_p :: Integral n => [Ratio n]
-- | Reconstruct approximate ratios to within 1e-3 from intervals.
ax_r :: Real n => [n] -> [Rational]
-- | "Sieves" by Iannis Xenakis and John Rahn Perspectives of New
-- Music Vol. 28, No. 1 (Winter, 1990), pp. 58-78
module Music.Theory.Xenakis.Sieve
-- | Synonym for Integer
type I = Integer
-- | A Sieve.
data Sieve
-- | Empty Sieve
Empty :: Sieve
-- | Primitive Sieve of modulo and index
L :: (I, I) -> Sieve
-- | Union of two Sieves
Union :: Sieve -> Sieve -> Sieve
-- | Intersection of two Sieves
Intersection :: Sieve -> Sieve -> Sieve
-- | The Union of a list of Sieves, ie. foldl1
-- Union.
union :: [Sieve] -> Sieve
-- | The Intersection of a list of Sieves, ie. foldl1
-- Intersection.
intersection :: [Sieve] -> Sieve
-- | Unicode synonym for Union.
(∪) :: Sieve -> Sieve -> Sieve
-- | Unicode synonym for Intersection.
(∩) :: Sieve -> Sieve -> Sieve
-- | Variant of L, ie. curry L.
--
--
-- l 15 19 == L (15,19)
--
l :: I -> I -> Sieve
-- | unicode synonym for l.
(⋄) :: I -> I -> Sieve
-- | In a normal Sieve m is > i.
--
--
-- normalise (L (15,19)) == L (15,4)
--
normalise :: Sieve -> Sieve
-- | Predicate to test if a Sieve is normal.
--
--
-- is_normal (L (15,4)) == True
--
is_normal :: Sieve -> Bool
-- | Predicate to determine if an I is an element of the
-- Sieve.
--
--
-- map (element (L (3,1))) [1..4] == [True,False,False,True]
-- map (element (L (15,4))) [4,19 .. 49] == [True,True,True,True]
--
element :: Sieve -> I -> Bool
-- | Construct the sequence defined by a Sieve. Note that building a
-- sieve that contains an intersection clause that has no elements gives
-- _|_.
--
--
-- let {d = [0,2,4,5,7,9,11]
-- ;r = d ++ map (+ 12) d}
-- in take 14 (build (union (map (l 12) d))) == r
--
build :: Sieve -> [I]
-- | Variant of build that gives the first n places of the
-- reduce of Sieve.
--
--
-- buildn 6 (union (map (l 8) [0,3,6])) == [0,3,6,8,11,14]
-- buildn 12 (L (3,2)) == [2,5,8,11,14,17,20,23,26,29,32,35]
-- buildn 9 (L (8,0)) == [0,8,16,24,32,40,48,56,64]
-- buildn 3 (L (3,2) ∩ L (8,0)) == [8,32,56]
-- buildn 12 (L (3,1) ∪ L (4,0)) == [0,1,4,7,8,10,12,13,16,19,20,22]
-- buildn 14 (5⋄4 ∪ 3⋄2 ∪ 7⋄3) == [2,3,4,5,8,9,10,11,14,17,19,20,23,24]
-- buildn 6 (3⋄0 ∪ 4⋄0) == [0,3,4,6,8,9]
-- buildn 8 (5⋄2 ∩ 2⋄0 ∪ 7⋄3) == [2,3,10,12,17,22,24,31]
-- buildn 12 (5⋄1 ∪ 7⋄2) == [1,2,6,9,11,16,21,23,26,30,31,36]
--
--
--
-- buildn 10 (3⋄2 ∩ 4⋄7 ∪ 6⋄9 ∩ 15⋄18) == [3,11,23,33,35,47,59,63,71,83]
--
--
--
-- let {s = 3⋄2∩4⋄7∩6⋄11∩8⋄7 ∪ 6⋄9∩15⋄18 ∪ 13⋄5∩8⋄6∩4⋄2 ∪ 6⋄9∩15⋄19
-- ;s' = 24⋄23 ∪ 30⋄3 ∪ 104⋄70}
-- in buildn 16 s == buildn 16 s'
--
--
--
-- buildn 10 (24⋄23 ∪ 30⋄3 ∪ 104⋄70) == [3,23,33,47,63,70,71,93,95,119]
--
--
--
-- let r = [2,3,4,5,8,9,10,11,14,17,19,20,23,24,26,29,31]
-- in buildn 17 (5⋄4 ∪ 3⋄2 ∪ 7⋄3) == r
--
--
--
-- let r = [0,1,3,6,9,10,11,12,15,16,17,18,21,24,26,27,30]
-- in buildn 17 (5⋄1 ∪ 3⋄0 ∪ 7⋄3) == r
--
--
--
-- let r = [0,2,3,4,6,7,9,11,12,15,17,18,21,22,24,25,27,30,32]
-- in buildn 19 (5⋄2 ∪ 3⋄0 ∪ 7⋄4) == r
--
buildn :: Int -> Sieve -> [I]
-- | Standard differentiation function.
--
--
-- differentiate [1,3,6,10] == [2,3,4]
-- differentiate [0,2,4,5,7,9,11,12] == [2,2,1,2,2,2,1]
--
differentiate :: Num a => [a] -> [a]
-- | Euclid's algorithm for computing the greatest common divisor.
--
--
-- euclid 1989 867 == 51
--
euclid :: Integral a => a -> a -> a
-- | Bachet De Méziriac's algorithm.
--
--
-- de_meziriac 15 4 == 3 && euclid 15 4 == 1
--
de_meziriac :: Integral a => a -> a -> a
-- | Attempt to reduce the Intersection of two L nodes to a
-- singular L node.
--
--
-- reduce_intersection (3,2) (4,7) == Just (12,11)
-- reduce_intersection (12,11) (6,11) == Just (12,11)
-- reduce_intersection (12,11) (8,7) == Just (24,23)
--
reduce_intersection :: Integral t => (t, t) -> (t, t) -> Maybe (t, t)
-- | Reduce the number of nodes at a Sieve.
--
--
-- reduce (L (3,2) ∪ Empty) == L (3,2)
-- reduce (L (3,2) ∩ Empty) == L (3,2)
-- reduce (L (3,2) ∩ L (4,7)) == L (12,11)
-- reduce (L (6,9) ∩ L (15,18)) == L (30,3)
--
--
--
-- let s = 3⋄2∩4⋄7∩6⋄11∩8⋄7 ∪ 6⋄9∩15⋄18 ∪ 13⋄5∩8⋄6∩4⋄2 ∪ 6⋄9∩15⋄19
-- in reduce s == (24⋄23 ∪ 30⋄3 ∪ 104⋄70)
--
--
--
-- let s = 3⋄2∩4⋄7∩6⋄11∩8⋄7 ∪ 6⋄9∩15⋄18 ∪ 13⋄5∩8⋄6∩4⋄2 ∪ 6⋄9∩15⋄19
-- in reduce s == (24⋄23 ∪ 30⋄3 ∪ 104⋄70)
--
reduce :: Sieve -> Sieve
instance Eq Sieve
instance Show Sieve
-- | Allen Forte. The Structure of Atonal Music. Yale University
-- Press, New Haven, 1973.
module Music.Theory.Z.Forte_1973
-- | T-related rotations of p.
--
--
-- t_rotations 12 [0,1,3] == [[0,1,3],[0,2,11],[0,9,10]]
--
t_rotations :: Integral a => a -> [a] -> [[a]]
-- | T/I-related rotations of p.
--
--
-- ti_rotations 12 [0,1,3] == [[0,1,3],[0,2,11],[0,9,10]
-- ,[0,9,11],[0,2,3],[0,1,10]]
--
ti_rotations :: Integral a => a -> [a] -> [[a]]
-- | Variant with default value for empty input list case.
minimumBy_or :: a -> (a -> a -> Ordering) -> [a] -> a
-- | Prime form rule requiring comparator, considering t_rotations.
t_cmp_prime :: Integral a => a -> ([a] -> [a] -> Ordering) -> [a] -> [a]
-- | Prime form rule requiring comparator, considering ti_rotations.
ti_cmp_prime :: Integral a => a -> ([a] -> [a] -> Ordering) -> [a] -> [a]
-- | Forte comparison function (rightmost first then leftmost outwards).
--
--
-- forte_cmp [0,1,3,6,8,9] [0,2,3,6,7,9] == LT
--
forte_cmp :: Ord t => [t] -> [t] -> Ordering
-- | Forte prime form, ie. cmp_prime of forte_cmp.
--
--
-- forte_prime 12 [0,1,3,6,8,9] == [0,1,3,6,8,9]
-- forte_prime 5 [0,1,4] == [0,1,2]
--
--
--
-- S.set (map (forte_prime 5) (S.powerset [0..4]))
--
forte_prime :: Integral a => a -> [a] -> [a]
-- | Transpositional equivalence prime form, ie. t_cmp_prime of
-- forte_cmp.
--
--
-- (forte_prime 12 [0,2,3],t_prime 12 [0,2,3]) == ([0,1,3],[0,2,3])
--
t_prime :: Integral a => a -> [a] -> [a]
-- | Interval class of i interval i.
--
--
-- map (ic 5) [1,2,3,4] == [1,2,2,1]
-- map (ic 12) [5,6,7] == [5,6,5]
-- map (ic 12 . to_Z 12) [-13,-1,0,1,13] == [1,1,0,1,1]
--
ic :: Integral a => a -> a -> a
-- | Forte notation for interval class vector.
--
--
-- icv 12 [0,1,2,4,7,8] == [3,2,2,3,3,2]
--
icv :: (Integral i, Num n) => i -> [i] -> [n]
-- | Basic interval pattern, see Allen Forte "The Basic Interval Patterns"
-- JMT 17/2 (1973):234-272
--
--
-- >>> bip 0t95728e3416
-- 11223344556
--
--
--
-- bip 12 [0,10,9,5,7,2,8,11,3,4,1,6] == [1,1,2,2,3,3,4,4,5,5,6]
--
bip :: Integral a => a -> [a] -> [a]
-- | Allen Forte. The Structure of Atonal Music. Yale University
-- Press, New Haven, 1973.
module Music.Theory.Z12.Forte_1973
-- | T-related rotations of p.
--
--
-- t_rotations [0,1,3] == [[0,1,3],[0,2,11],[0,9,10]]
--
t_rotations :: [Z12] -> [[Z12]]
-- | T/I-related rotations of p.
--
--
-- ti_rotations [0,1,3] == [[0,1,3],[0,2,11],[0,9,10]
-- ,[0,9,11],[0,2,3],[0,1,10]]
--
ti_rotations :: [Z12] -> [[Z12]]
-- | Forte prime form, ie. cmp_prime of forte_cmp.
--
--
-- forte_prime [0,1,3,6,8,9] == [0,1,3,6,8,9]
--
forte_prime :: [Z12] -> [Z12]
-- | Transpositional equivalence prime form, ie. t_cmp_prime of
-- forte_cmp.
--
--
-- (forte_prime [0,2,3],t_prime [0,2,3]) == ([0,1,3],[0,2,3])
--
t_prime :: [Z12] -> [Z12]
-- | Synonym for String.
type SC_Name = String
-- | The set-class table (Forte prime forms).
--
--
-- length sc_table == 224
--
sc_table :: [(SC_Name, [Z12])]
-- | Lookup a set-class name. The input set is subject to
-- forte_prime before lookup.
--
--
-- sc_name [0,2,3,6,7] == "5-Z18"
-- sc_name [0,1,4,6,7,8] == "6-Z17"
--
sc_name :: [Z12] -> SC_Name
-- | Lookup a set-class given a set-class name.
--
--
-- sc "6-Z17" == [0,1,2,4,7,8]
--
sc :: SC_Name -> [Z12]
-- | List of set classes (the set class universe).
--
--
-- let r = [("0-1",[0,0,0,0,0,0])
-- ,("1-1",[0,0,0,0,0,0])
-- ,("2-1",[1,0,0,0,0,0])
-- ,("2-2",[0,1,0,0,0,0])
-- ,("2-3",[0,0,1,0,0,0])
-- ,("2-4",[0,0,0,1,0,0])
-- ,("2-5",[0,0,0,0,1,0])
-- ,("2-6",[0,0,0,0,0,1])
-- ,("3-1",[2,1,0,0,0,0])
-- ,("3-2",[1,1,1,0,0,0])
-- ,("3-3",[1,0,1,1,0,0])
-- ,("3-4",[1,0,0,1,1,0])
-- ,("3-5",[1,0,0,0,1,1])
-- ,("3-6",[0,2,0,1,0,0])
-- ,("3-7",[0,1,1,0,1,0])
-- ,("3-8",[0,1,0,1,0,1])
-- ,("3-9",[0,1,0,0,2,0])
-- ,("3-10",[0,0,2,0,0,1])
-- ,("3-11",[0,0,1,1,1,0])
-- ,("3-12",[0,0,0,3,0,0])
-- ,("4-1",[3,2,1,0,0,0])
-- ,("4-2",[2,2,1,1,0,0])
-- ,("4-3",[2,1,2,1,0,0])
-- ,("4-4",[2,1,1,1,1,0])
-- ,("4-5",[2,1,0,1,1,1])
-- ,("4-6",[2,1,0,0,2,1])
-- ,("4-7",[2,0,1,2,1,0])
-- ,("4-8",[2,0,0,1,2,1])
-- ,("4-9",[2,0,0,0,2,2])
-- ,("4-10",[1,2,2,0,1,0])
-- ,("4-11",[1,2,1,1,1,0])
-- ,("4-12",[1,1,2,1,0,1])
-- ,("4-13",[1,1,2,0,1,1])
-- ,("4-14",[1,1,1,1,2,0])
-- ,("4-Z15",[1,1,1,1,1,1])
-- ,("4-16",[1,1,0,1,2,1])
-- ,("4-17",[1,0,2,2,1,0])
-- ,("4-18",[1,0,2,1,1,1])
-- ,("4-19",[1,0,1,3,1,0])
-- ,("4-20",[1,0,1,2,2,0])
-- ,("4-21",[0,3,0,2,0,1])
-- ,("4-22",[0,2,1,1,2,0])
-- ,("4-23",[0,2,1,0,3,0])
-- ,("4-24",[0,2,0,3,0,1])
-- ,("4-25",[0,2,0,2,0,2])
-- ,("4-26",[0,1,2,1,2,0])
-- ,("4-27",[0,1,2,1,1,1])
-- ,("4-28",[0,0,4,0,0,2])
-- ,("4-Z29",[1,1,1,1,1,1])
-- ,("5-1",[4,3,2,1,0,0])
-- ,("5-2",[3,3,2,1,1,0])
-- ,("5-3",[3,2,2,2,1,0])
-- ,("5-4",[3,2,2,1,1,1])
-- ,("5-5",[3,2,1,1,2,1])
-- ,("5-6",[3,1,1,2,2,1])
-- ,("5-7",[3,1,0,1,3,2])
-- ,("5-8",[2,3,2,2,0,1])
-- ,("5-9",[2,3,1,2,1,1])
-- ,("5-10",[2,2,3,1,1,1])
-- ,("5-11",[2,2,2,2,2,0])
-- ,("5-Z12",[2,2,2,1,2,1])
-- ,("5-13",[2,2,1,3,1,1])
-- ,("5-14",[2,2,1,1,3,1])
-- ,("5-15",[2,2,0,2,2,2])
-- ,("5-16",[2,1,3,2,1,1])
-- ,("5-Z17",[2,1,2,3,2,0])
-- ,("5-Z18",[2,1,2,2,2,1])
-- ,("5-19",[2,1,2,1,2,2])
-- ,("5-20",[2,1,1,2,3,1])
-- ,("5-21",[2,0,2,4,2,0])
-- ,("5-22",[2,0,2,3,2,1])
-- ,("5-23",[1,3,2,1,3,0])
-- ,("5-24",[1,3,1,2,2,1])
-- ,("5-25",[1,2,3,1,2,1])
-- ,("5-26",[1,2,2,3,1,1])
-- ,("5-27",[1,2,2,2,3,0])
-- ,("5-28",[1,2,2,2,1,2])
-- ,("5-29",[1,2,2,1,3,1])
-- ,("5-30",[1,2,1,3,2,1])
-- ,("5-31",[1,1,4,1,1,2])
-- ,("5-32",[1,1,3,2,2,1])
-- ,("5-33",[0,4,0,4,0,2])
-- ,("5-34",[0,3,2,2,2,1])
-- ,("5-35",[0,3,2,1,4,0])
-- ,("5-Z36",[2,2,2,1,2,1])
-- ,("5-Z37",[2,1,2,3,2,0])
-- ,("5-Z38",[2,1,2,2,2,1])
-- ,("6-1",[5,4,3,2,1,0])
-- ,("6-2",[4,4,3,2,1,1])
-- ,("6-Z3",[4,3,3,2,2,1])
-- ,("6-Z4",[4,3,2,3,2,1])
-- ,("6-5",[4,2,2,2,3,2])
-- ,("6-Z6",[4,2,1,2,4,2])
-- ,("6-7",[4,2,0,2,4,3])
-- ,("6-8",[3,4,3,2,3,0])
-- ,("6-9",[3,4,2,2,3,1])
-- ,("6-Z10",[3,3,3,3,2,1])
-- ,("6-Z11",[3,3,3,2,3,1])
-- ,("6-Z12",[3,3,2,2,3,2])
-- ,("6-Z13",[3,2,4,2,2,2])
-- ,("6-14",[3,2,3,4,3,0])
-- ,("6-15",[3,2,3,4,2,1])
-- ,("6-16",[3,2,2,4,3,1])
-- ,("6-Z17",[3,2,2,3,3,2])
-- ,("6-18",[3,2,2,2,4,2])
-- ,("6-Z19",[3,1,3,4,3,1])
-- ,("6-20",[3,0,3,6,3,0])
-- ,("6-21",[2,4,2,4,1,2])
-- ,("6-22",[2,4,1,4,2,2])
-- ,("6-Z23",[2,3,4,2,2,2])
-- ,("6-Z24",[2,3,3,3,3,1])
-- ,("6-Z25",[2,3,3,2,4,1])
-- ,("6-Z26",[2,3,2,3,4,1])
-- ,("6-27",[2,2,5,2,2,2])
-- ,("6-Z28",[2,2,4,3,2,2])
-- ,("6-Z29",[2,2,4,2,3,2])
-- ,("6-30",[2,2,4,2,2,3])
-- ,("6-31",[2,2,3,4,3,1])
-- ,("6-32",[1,4,3,2,5,0])
-- ,("6-33",[1,4,3,2,4,1])
-- ,("6-34",[1,4,2,4,2,2])
-- ,("6-35",[0,6,0,6,0,3])
-- ,("6-Z36",[4,3,3,2,2,1])
-- ,("6-Z37",[4,3,2,3,2,1])
-- ,("6-Z38",[4,2,1,2,4,2])
-- ,("6-Z39",[3,3,3,3,2,1])
-- ,("6-Z40",[3,3,3,2,3,1])
-- ,("6-Z41",[3,3,2,2,3,2])
-- ,("6-Z42",[3,2,4,2,2,2])
-- ,("6-Z43",[3,2,2,3,3,2])
-- ,("6-Z44",[3,1,3,4,3,1])
-- ,("6-Z45",[2,3,4,2,2,2])
-- ,("6-Z46",[2,3,3,3,3,1])
-- ,("6-Z47",[2,3,3,2,4,1])
-- ,("6-Z48",[2,3,2,3,4,1])
-- ,("6-Z49",[2,2,4,3,2,2])
-- ,("6-Z50",[2,2,4,2,3,2])
-- ,("7-1",[6,5,4,3,2,1])
-- ,("7-2",[5,5,4,3,3,1])
-- ,("7-3",[5,4,4,4,3,1])
-- ,("7-4",[5,4,4,3,3,2])
-- ,("7-5",[5,4,3,3,4,2])
-- ,("7-6",[5,3,3,4,4,2])
-- ,("7-7",[5,3,2,3,5,3])
-- ,("7-8",[4,5,4,4,2,2])
-- ,("7-9",[4,5,3,4,3,2])
-- ,("7-10",[4,4,5,3,3,2])
-- ,("7-11",[4,4,4,4,4,1])
-- ,("7-Z12",[4,4,4,3,4,2])
-- ,("7-13",[4,4,3,5,3,2])
-- ,("7-14",[4,4,3,3,5,2])
-- ,("7-15",[4,4,2,4,4,3])
-- ,("7-16",[4,3,5,4,3,2])
-- ,("7-Z17",[4,3,4,5,4,1])
-- ,("7-Z18",[4,3,4,4,4,2])
-- ,("7-19",[4,3,4,3,4,3])
-- ,("7-20",[4,3,3,4,5,2])
-- ,("7-21",[4,2,4,6,4,1])
-- ,("7-22",[4,2,4,5,4,2])
-- ,("7-23",[3,5,4,3,5,1])
-- ,("7-24",[3,5,3,4,4,2])
-- ,("7-25",[3,4,5,3,4,2])
-- ,("7-26",[3,4,4,5,3,2])
-- ,("7-27",[3,4,4,4,5,1])
-- ,("7-28",[3,4,4,4,3,3])
-- ,("7-29",[3,4,4,3,5,2])
-- ,("7-30",[3,4,3,5,4,2])
-- ,("7-31",[3,3,6,3,3,3])
-- ,("7-32",[3,3,5,4,4,2])
-- ,("7-33",[2,6,2,6,2,3])
-- ,("7-34",[2,5,4,4,4,2])
-- ,("7-35",[2,5,4,3,6,1])
-- ,("7-Z36",[4,4,4,3,4,2])
-- ,("7-Z37",[4,3,4,5,4,1])
-- ,("7-Z38",[4,3,4,4,4,2])
-- ,("8-1",[7,6,5,4,4,2])
-- ,("8-2",[6,6,5,5,4,2])
-- ,("8-3",[6,5,6,5,4,2])
-- ,("8-4",[6,5,5,5,5,2])
-- ,("8-5",[6,5,4,5,5,3])
-- ,("8-6",[6,5,4,4,6,3])
-- ,("8-7",[6,4,5,6,5,2])
-- ,("8-8",[6,4,4,5,6,3])
-- ,("8-9",[6,4,4,4,6,4])
-- ,("8-10",[5,6,6,4,5,2])
-- ,("8-11",[5,6,5,5,5,2])
-- ,("8-12",[5,5,6,5,4,3])
-- ,("8-13",[5,5,6,4,5,3])
-- ,("8-14",[5,5,5,5,6,2])
-- ,("8-Z15",[5,5,5,5,5,3])
-- ,("8-16",[5,5,4,5,6,3])
-- ,("8-17",[5,4,6,6,5,2])
-- ,("8-18",[5,4,6,5,5,3])
-- ,("8-19",[5,4,5,7,5,2])
-- ,("8-20",[5,4,5,6,6,2])
-- ,("8-21",[4,7,4,6,4,3])
-- ,("8-22",[4,6,5,5,6,2])
-- ,("8-23",[4,6,5,4,7,2])
-- ,("8-24",[4,6,4,7,4,3])
-- ,("8-25",[4,6,4,6,4,4])
-- ,("8-26",[4,5,6,5,6,2])
-- ,("8-27",[4,5,6,5,5,3])
-- ,("8-28",[4,4,8,4,4,4])
-- ,("8-Z29",[5,5,5,5,5,3])
-- ,("9-1",[8,7,6,6,6,3])
-- ,("9-2",[7,7,7,6,6,3])
-- ,("9-3",[7,6,7,7,6,3])
-- ,("9-4",[7,6,6,7,7,3])
-- ,("9-5",[7,6,6,6,7,4])
-- ,("9-6",[6,8,6,7,6,3])
-- ,("9-7",[6,7,7,6,7,3])
-- ,("9-8",[6,7,6,7,6,4])
-- ,("9-9",[6,7,6,6,8,3])
-- ,("9-10",[6,6,8,6,6,4])
-- ,("9-11",[6,6,7,7,7,3])
-- ,("9-12",[6,6,6,9,6,3])
-- ,("10-1",[9,8,8,8,8,4])
-- ,("10-2",[8,9,8,8,8,4])
-- ,("10-3",[8,8,9,8,8,4])
-- ,("10-4",[8,8,8,9,8,4])
-- ,("10-5",[8,8,8,8,9,4])
-- ,("10-6",[8,8,8,8,8,5])
-- ,("11-1",[10,10,10,10,10,5])
-- ,("12-1",[12,12,12,12,12,6])]
-- in let icvs = map icv scs in zip (map sc_name scs) icvs == r
--
scs :: [[Z12]]
-- | Cardinality n subset of scs.
--
--
-- map (length . scs_n) [1..11] == [1,6,12,29,38,50,38,29,12,6,1]
--
scs_n :: Integral i => i -> [[Z12]]
-- | Basic interval pattern, see Allen Forte "The Basic Interval Patterns"
-- JMT 17/2 (1973):234-272
--
--
-- >>> bip 0t95728e3416
-- 11223344556
--
--
--
-- bip [0,10,9,5,7,2,8,11,3,4,1,6] == [1,1,2,2,3,3,4,4,5,5,6]
-- bip (pco "0t95728e3416") == [1,1,2,2,3,3,4,4,5,5,6]
--
bip :: [Z12] -> [Z12]
-- | Interval class of Z12 interval i.
--
--
-- map ic [5,6,7] == [5,6,5]
-- map ic [-13,-1,0,1,13] == [1,1,0,1,1]
--
ic :: Z12 -> Z12
-- | Forte notation for interval class vector.
--
--
-- icv [0,1,2,4,7,8] == [3,2,2,3,3,2]
--
icv :: Integral i => [Z12] -> [i]
-- | Michael Buchler. "Relative Saturation of Subsets and Interval Cycles
-- as a Means for Determining Set-Class Similarity". PhD thesis,
-- University of Rochester, 1998
module Music.Theory.Metric.Buchler_1998
-- | Predicate for list with cardinality n.
of_c :: Integral n => n -> [a] -> Bool
-- | Set classes of cardinality n.
--
--
-- sc_table_n 2 == [[0,1],[0,2],[0,3],[0,4],[0,5],[0,6]]
--
sc_table_n :: Integral n => n -> [[Z12]]
-- | Minima and maxima of ICV of SCs of cardinality n.
--
--
-- icv_minmax 5 == ([0,0,0,1,0,0],[4,4,4,4,4,2])
--
icv_minmax :: (Integral n, Integral b) => n -> ([b], [b])
data R
MIN :: R
MAX :: R
type D n = (R, n)
-- | Pretty printer for R.
--
--
-- map r_pp [MIN,MAX] == ["+","-"]
--
r_pp :: R -> String
-- | SATV element measure with given funtion.
satv_f :: Integral n => ((n, n, n) -> D n) -> [Z12] -> [D n]
-- | Pretty printer for SATV element.
--
--
-- satv_e_pp (satv_a [0,1,2,6,7,8]) == "<-1,+2,+0,+0,-1,-0>"
--
satv_e_pp :: Show i => [D i] -> String
type SATV i = ([D i], [D i])
-- | Pretty printer for SATV.
satv_pp :: Show i => SATV i -> String
-- | SATVa measure.
--
--
-- satv_e_pp (satv_a [0,1,2,6,7,8]) == "<-1,+2,+0,+0,-1,-0>"
-- satv_e_pp (satv_a [0,1,2,3,4]) == "<-0,-1,-2,+0,+0,+0>"
--
satv_a :: Integral i => [Z12] -> [D i]
-- | SATVb measure.
--
--
-- satv_e_pp (satv_b [0,1,2,6,7,8]) == "<+4,-4,-5,-4,+4,+3>"
-- satv_e_pp (satv_b [0,1,2,3,4]) == "<+4,+3,+2,-3,-4,-2>"
--
satv_b :: Integral i => [Z12] -> [D i]
-- | SATV measure.
--
--
-- satv_pp (satv [0,3,6,9]) == "(<+0,+0,-0,+0,+0,-0>,<-3,-3,+4,-3,-3,+2>)"
-- satv_pp (satv [0,1,3,4,8]) == "(<-2,+1,-2,-1,-2,+0>,<+2,-3,+2,+2,+2,-2>)"
-- satv_pp (satv [0,1,2,6,7,8]) == "(<-1,+2,+0,+0,-1,-0>,<+4,-4,-5,-4,+4,+3>)"
-- satv_pp (satv [0,4]) == "(<+0,+0,+0,-0,+0,+0>,<-1,-1,-1,+1,-1,-1>)"
-- satv_pp (satv [0,1,3,4,6,9]) == "(<+2,+2,-0,+0,+2,-1>,<-3,-4,+5,-4,-3,+2>)"
-- satv_pp (satv [0,1,3,6,7,9]) == "(<+2,+2,-1,+0,+2,-0>,<-3,-4,+4,-4,-3,+3>)"
-- satv_pp (satv [0,1,2,3,6]) == "(<-1,-2,-2,+0,+1,-1>,<+3,+2,+2,-3,-3,+1>)"
-- satv_pp (satv [0,1,2,3,4,6]) == "(<-1,-2,-2,+0,+1,+1>,<+4,+4,+3,-4,-4,-2>)"
-- satv_pp (satv [0,1,3,6,8]) == "(<+1,-2,-2,+0,-1,-1>,<-3,+2,+2,-3,+3,+1>)"
-- satv_pp (satv [0,2,3,5,7,9]) == "(<+1,-2,-2,+0,-1,+1>,<-4,+4,+3,-4,+4,-2>)"
--
satv :: Integral i => [Z12] -> SATV i
-- | SATV reorganised by R.
--
--
-- satv_minmax (satv [0,1,2,6,7,8]) == ([4,2,0,0,4,3],[1,4,5,4,1,0])
--
satv_minmax :: SATV i -> ([i], [i])
-- | Absolute difference.
abs_dif :: Num a => a -> a -> a
-- | Sum of numerical components of a and b parts of
-- SATV.
--
--
-- satv_n_sum (satv [0,1,2,6,7,8]) == [5,6,5,4,5,3]
-- satv_n_sum (satv [0,3,6,9]) = [3,3,4,3,3,2]
--
satv_n_sum :: Num c => SATV c -> [c]
two_part_difference_vector :: Integral i => [D i] -> SATV i -> [i]
two_part_difference_vector_set :: Integral i => SATV i -> SATV i -> ([i], [i])
-- | SATSIM metric.
--
--
-- satsim [0,1,2,6,7,8] [0,3,6,9] == 25/46
-- satsim [0,4] [0,1,3,4,6,9] == 25/34
-- satsim [0,4] [0,1,3,6,7,9] == 25/34
-- satsim [0,1,2,3,6] [0,1,2,3,4,6] == 1/49
-- satsim [0,1,3,6,8] [0,2,3,5,7,9] == 1/49
-- satsim [0,1,2,3,4] [0,1,4,5,7] == 8/21
-- satsim [0,1,2,3,4] [0,2,4,6,8] == 4/7
-- satsim [0,1,4,5,7] [0,2,4,6,8] == 4/7
--
satsim :: Integral a => [Z12] -> [Z12] -> Ratio a
-- | Table of satsim measures for all SC pairs.
--
--
-- length satsim_table == 24310
--
satsim_table :: Integral i => [(([Z12], [Z12]), Ratio i)]
-- | Histogram of values at satsim_table.
--
--
-- satsim_table_histogram == T.histogram (map snd satsim_table)
--
satsim_table_histogram :: Integral i => [(Ratio i, i)]
instance Eq R
instance Show R
-- | Robert Morris. "A Similarity Index for Pitch-Class Sets". Perspectives
-- of New Music, 18(2):445-460, 1980.
module Music.Theory.Metric.Morris_1980
-- | SIM
--
--
-- icv [0,1,3,6] == [1,1,2,0,1,1] && icv [0,2,4,7] == [0,2,1,1,2,0]
-- sim [0,1,3,6] [0,2,4,7] == 6
-- sim [0,1,2,4,5,8] [0,1,3,7] == 9
--
sim :: Integral a => [Z12] -> [Z12] -> a
-- | ASIM
--
--
-- asim [0,1,3,6] [0,2,4,7] == 6/12
-- asim [0,1,2,4,5,8] [0,1,3,7] == 9/21
-- asim [0,1,2,3,4] [0,1,4,5,7] == 2/5
-- asim [0,1,2,3,4] [0,2,4,6,8] == 3/5
-- asim [0,1,4,5,7] [0,2,4,6,8] == 3/5
--
asim :: Integral n => [Z12] -> [Z12] -> Ratio n
-- | John Rahn. Basic Atonal Theory. Longman, New York, 1980.
module Music.Theory.Z12.Rahn_1980
-- | Rahn prime form (comparison is rightmost inwards).
--
--
-- rahn_cmp [0,1,3,6,8,9] [0,2,3,6,7,9] == GT
--
rahn_cmp :: Ord a => [a] -> [a] -> Ordering
-- | Rahn prime form, ie. ti_cmp_prime of rahn_cmp.
--
--
-- rahn_prime [0,1,3,6,8,9] == [0,2,3,6,7,9]
--
--
--
-- import Music.Theory.Z12.Forte_1973
--
--
--
-- let s = [[0,1,3,7,8]
-- ,[0,1,3,6,8,9],[0,1,3,5,8,9]
-- ,[0,1,2,4,7,8,9]
-- ,[0,1,2,4,5,7,9,10]]
-- in all (\p -> forte_prime p /= rahn_prime p) s == True
--
rahn_prime :: [Z12] -> [Z12]
-- | Marcus Castrén. RECREL: A Similarity Measure for Set-Classes.
-- PhD thesis, Sibelius Academy, Helsinki, 1994.
module Music.Theory.Z12.Castren_1994
-- | Is p symmetrical under inversion.
--
--
-- import Music.Theory.Z12.Forte_1973
-- map inv_sym (scs_n 2) == [True,True,True,True,True,True]
-- map (fromEnum.inv_sym) (scs_n 3) == [1,0,0,0,0,1,0,0,1,1,0,1]
--
inv_sym :: [Z12] -> Bool
-- | If p is not inv_sym then (p,invert 0 p) else
-- Nothing.
--
--
-- sc_t_ti [0,2,4] == Nothing
-- sc_t_ti [0,1,3] == Just ([0,1,3],[0,2,3])
--
sc_t_ti :: [Z12] -> Maybe ([Z12], [Z12])
-- | Transpositional equivalence variant of Forte's sc_table. The
-- inversionally related classes are distinguished by labels A
-- and B; the class providing the best normal order
-- (Forte 1973) is always the A class. If neither A nor
-- B appears in the name of a set-class, it is inversionally
-- symmetrical.
--
--
-- (length sc_table,length t_sc_table) == (224,352)
-- lookup "5-Z18B" t_sc_table == Just [0,2,3,6,7]
--
t_sc_table :: [(SC_Name, [Z12])]
-- | Lookup a set-class name. The input set is subject to t_prime
-- before lookup.
--
--
-- t_sc_name [0,2,3,6,7] == "5-Z18B"
-- t_sc_name [0,1,4,6,7,8] == "6-Z17B"
--
t_sc_name :: [Z12] -> SC_Name
-- | Lookup a set-class given a set-class name.
--
--
-- t_sc "6-Z17A" == [0,1,2,4,7,8]
--
t_sc :: SC_Name -> [Z12]
-- | List of set classes.
t_scs :: [[Z12]]
-- | Cardinality n subset of t_scs.
--
--
-- map (length . t_scs_n) [2..10] == [6,19,43,66,80,66,43,19,6]
--
t_scs_n :: Integral i => i -> [[Z12]]
-- | T-related q that are subsets of p.
--
--
-- t_subsets [0,1,2,3,4] [0,1] == [[0,1],[1,2],[2,3],[3,4]]
-- t_subsets [0,1,2,3,4] [0,1,4] == [[0,1,4]]
-- t_subsets [0,2,3,6,7] [0,1,4] == [[2,3,6]]
--
t_subsets :: [Z12] -> [Z12] -> [[Z12]]
-- | T/I-related q that are subsets of p.
--
--
-- ti_subsets [0,1,2,3,4] [0,1] == [[0,1],[1,2],[2,3],[3,4]]
-- ti_subsets [0,1,2,3,4] [0,1,4] == [[0,1,4],[0,3,4]]
-- ti_subsets [0,2,3,6,7] [0,1,4] == [[2,3,6],[3,6,7]]
--
ti_subsets :: [Z12] -> [Z12] -> [[Z12]]
-- | Trivial run length encoder.
--
--
-- rle "abbcccdde" == [(1,'a'),(2,'b'),(3,'c'),(2,'d'),(1,'e')]
--
rle :: (Eq a, Integral i) => [a] -> [(i, a)]
-- | Inverse of rle.
--
--
-- rle_decode [(5,'a'),(4,'b')] == "aaaaabbbb"
--
rle_decode :: Integral i => [(i, a)] -> [a]
-- | Length of rle encoded sequence.
--
--
-- rle_length [(5,'a'),(4,'b')] == 9
--
rle_length :: Integral i => [(i, a)] -> i
-- | T-equivalence n-class vector (subset-class vector, nCV).
--
--
-- t_n_class_vector 2 [0..4] == [4,3,2,1,0,0]
-- rle (t_n_class_vector 3 [0..4]) == [(1,3),(2,2),(2,1),(4,0),(1,1),(9,0)]
-- rle (t_n_class_vector 4 [0..4]) == [(1,2),(3,1),(39,0)]
--
t_n_class_vector :: (Num a, Integral i) => i -> [Z12] -> [a]
-- | T/I-equivalence n-class vector (subset-class vector, nCV).
--
--
-- ti_n_class_vector 2 [0..4] == [4,3,2,1,0,0]
-- ti_n_class_vector 3 [0,1,2,3,4] == [3,4,2,0,0,1,0,0,0,0,0,0]
-- rle (ti_n_class_vector 4 [0,1,2,3,4]) == [(2,2),(1,1),(26,0)]
--
ti_n_class_vector :: (Num b, Integral i) => i -> [Z12] -> [b]
-- | icv scaled by sum of icv.
--
--
-- dyad_class_percentage_vector [0,1,2,3,4] == [40,30,20,10,0,0]
-- dyad_class_percentage_vector [0,1,4,5,7] == [20,10,20,20,20,10]
--
dyad_class_percentage_vector :: Integral i => [Z12] -> [i]
-- | rel metric.
--
--
-- rel [0,1,2,3,4] [0,1,4,5,7] == 40
-- rel [0,1,2,3,4] [0,2,4,6,8] == 60
-- rel [0,1,4,5,7] [0,2,4,6,8] == 60
--
rel :: Integral i => [Z12] -> [Z12] -> Ratio i
-- | David Lewin. "A Response to a Response: On PC Set Relatedness".
-- Perspectives of New Music, 18(1-2):498-502, 1980.
module Music.Theory.Z12.Lewin_1980
-- | REL function with given ncv function (see t_rel and
-- ti_rel).
rel :: Floating n => (Int -> [a] -> [n]) -> [a] -> [a] -> n
-- | T-equivalence REL function.
--
-- Kuusi 2001, 7.5.2
--
--
-- let (~=) p q = abs (p - q) < 1e-2
-- t_rel [0,1,2,3,4] [0,2,3,6,7] ~= 0.44
-- t_rel [0,1,2,3,4] [0,2,4,6,8] ~= 0.28
-- t_rel [0,2,3,6,7] [0,2,4,6,8] ~= 0.31
--
t_rel :: Floating n => [Z12] -> [Z12] -> n
-- | T/I-equivalence REL function.
--
-- Buchler 1998, Fig. 3.38
--
--
-- let (~=) p q = abs (p - q) < 1e-3
-- let a = [0,2,3,5,7]::[Z12]
-- let b = [0,2,3,4,5,8]::[Z12]
-- let g = [0,1,2,3,5,6,8,10]::[Z12]
-- let j = [0,2,3,4,5,6,8]::[Z12]
-- ti_rel a b ~= 0.593
-- ti_rel a g ~= 0.648
-- ti_rel a j ~= 0.509
-- ti_rel b g ~= 0.712
-- ti_rel b j ~= 0.892
-- ti_rel g j ~= 0.707
--
ti_rel :: Floating n => [Z12] -> [Z12] -> n
-- | Serial (ordered) pitch-class operations on Z12.
module Music.Theory.Z12.SRO
-- | Transpose p by n.
--
--
-- tn 4 [1,5,6] == [5,9,10]
--
tn :: Z12 -> [Z12] -> [Z12]
-- | Invert p about n.
--
--
-- invert 6 [4,5,6] == [8,7,6]
-- invert 0 [0,1,3] == [0,11,9]
--
invert :: Z12 -> [Z12] -> [Z12]
-- | Composition of invert about 0 and tn.
--
--
-- tni 4 [1,5,6] == [3,11,10]
-- (invert 0 . tn 4) [1,5,6] == [7,3,2]
--
tni :: Z12 -> [Z12] -> [Z12]
-- | Modulo 12 multiplication
--
--
-- mn 11 [0,1,4,9] == tni 0 [0,1,4,9]
--
mn :: Z12 -> [Z12] -> [Z12]
-- | M5, ie. mn 5.
--
--
-- m5 [0,1,3] == [0,5,3]
--
m5 :: [Z12] -> [Z12]
-- | T-related sequences of p.
--
--
-- length (t_related [0,3,6,9]) == 12
--
t_related :: [Z12] -> [[Z12]]
-- | T/I-related sequences of p.
--
--
-- length (ti_related [0,1,3]) == 24
-- length (ti_related [0,3,6,9]) == 24
-- ti_related [0] == map return [0..11]
--
ti_related :: [Z12] -> [[Z12]]
-- | R/T/I-related sequences of p.
--
--
-- length (rti_related [0,1,3]) == 48
-- length (rti_related [0,3,6,9]) == 24
--
rti_related :: [Z12] -> [[Z12]]
-- | T/M/I-related sequences of p.
tmi_related :: [Z12] -> [[Z12]]
-- | R/T/M/I-related sequences of p.
rtmi_related :: [Z12] -> [[Z12]]
-- | r/R/T/M/I-related sequences of p.
rrtmi_related :: [Z12] -> [[Z12]]
-- | Variant of tn, transpose p so first element is n.
--
--
-- tn_to 5 [0,1,3] == [5,6,8]
-- map (tn_to 0) [[0,1,3],[1,3,0],[3,0,1]] == [[0,1,3],[0,2,11],[0,9,10]]
--
tn_to :: Z12 -> [Z12] -> [Z12]
-- | Variant of invert, inverse about nth element.
--
--
-- map (invert_ix 0) [[0,1,3],[3,4,6]] == [[0,11,9],[3,2,0]]
-- map (invert_ix 1) [[0,1,3],[3,4,6]] == [[2,1,11],[5,4,2]]
--
invert_ix :: Int -> [Z12] -> [Z12]
-- | The standard t-matrix of p.
--
--
-- tmatrix [0,1,3] == [[0,1,3]
-- ,[11,0,2]
-- ,[9,10,0]]
--
tmatrix :: [Z12] -> [[Z12]]
-- | Robert Morris. /Composition with Pitch-Classes: A Theory of
-- Compositional Design/. Yale University Press, New Haven, 1987.
module Music.Theory.Z12.Morris_1987
-- | INT operator.
--
--
-- int [0,1,3,6,10] == [1,2,3,4]
--
int :: [Z12] -> [Z12]
-- | Serial Operator,of the form rRTMI.
data SRO
SRO :: Z12 -> Bool -> Z12 -> Bool -> Bool -> SRO
-- | Serial operation.
--
--
-- >>> sro T4 156
-- 59A
--
--
--
-- sro (rnrtnmi "T4") (pco "156") == [5,9,10]
--
--
--
-- >>> echo 024579 | sro RT4I
-- 79B024
--
--
--
-- sro (SRO 0 True 4 False True) [0,2,4,5,7,9] == [7,9,11,0,2,4]
--
--
--
-- >>> sro T4I 156
-- 3BA
--
--
--
-- sro (rnrtnmi "T4I") (pco "156") == [3,11,10]
-- sro (SRO 0 False 4 False True) [1,5,6] == [3,11,10]
--
--
--
-- >>> echo 156 | sro T4 | sro T0I
-- 732
--
--
--
-- (sro (rnrtnmi "T0I") . sro (rnrtnmi "T4")) (pco "156") == [7,3,2]
--
--
--
-- >>> echo 024579 | sro RT4I
-- 79B024
--
--
--
-- sro (rnrtnmi "RT4I") (pco "024579") == [7,9,11,0,2,4]
--
--
--
-- sro (SRO 1 True 1 True False) [0,1,2,3] == [11,6,1,4]
-- sro (SRO 1 False 4 True True) [0,1,2,3] == [11,6,1,4]
--
sro :: SRO -> [Z12] -> [Z12]
-- | The total set of serial operations.
sros :: [Z12] -> [(SRO, [Z12])]
-- | The set of transposition SROs.
sro_Tn :: [SRO]
-- | The set of transposition and inversion SROs.
sro_TnI :: [SRO]
-- | The set of retrograde and transposition and inversion SROs.
sro_RTnI :: [SRO]
-- | The set of transposition,M5 and inversion SROs.
sro_TnMI :: [SRO]
-- | The set of retrograde,transposition,M5 and inversion
-- SROs.
sro_RTnMI :: [SRO]
instance Eq SRO
instance Show SRO
-- | Haskell implementations of pct operations. See
-- http://slavepianos.org/rd/?t=pct.
module Music.Theory.Z12.Drape_1999
-- | Cardinality filter
--
--
-- cf [0,3] (cg [1..4]) == [[1,2,3],[1,2,4],[1,3,4],[2,3,4],[]]
--
cf :: Integral n => [n] -> [[a]] -> [[a]]
-- | Combinatorial sets formed by considering each set as possible values
-- for slot.
--
--
-- cgg [[0,1],[5,7],[3]] == [[0,5,3],[0,7,3],[1,5,3],[1,7,3]]
--
cgg :: [[a]] -> [[a]]
-- | Combinations generator, ie. synonym for powerset.
--
--
-- sort (cg [0,1,3]) == [[],[0],[0,1],[0,1,3],[0,3],[1],[1,3],[3]]
--
cg :: [a] -> [[a]]
-- | Powerset filtered by cardinality.
--
--
-- >>> cg -r3 0159
-- 015
-- 019
-- 059
-- 159
--
--
--
-- cg_r 3 [0,1,5,9] == [[0,1,5],[0,1,9],[0,5,9],[1,5,9]]
--
cg_r :: Integral n => n -> [a] -> [[a]]
-- | Cyclic interval segment.
ciseg :: [Z12] -> [Z12]
-- | Synonynm for complement.
--
--
-- >>> cmpl 02468t
-- 13579B
--
--
--
-- cmpl [0,2,4,6,8,10] == [1,3,5,7,9,11]
--
cmpl :: [Z12] -> [Z12]
-- | Form cycle.
--
--
-- >>> cyc 056
-- 0560
--
--
--
-- cyc [0,5,6] == [0,5,6,0]
--
cyc :: [a] -> [a]
-- | Diatonic set name. d for diatonic set, m for melodic
-- minor set, o for octotonic set.
d_nm :: Integral a => [a] -> Maybe Char
-- | Diatonic implications.
dim :: [Z12] -> [(Z12, [Z12])]
-- | Variant of dim that is closer to the pct form.
--
--
-- >>> dim 016
-- T1d
-- T1m
-- T0o
--
--
--
-- dim_nm [0,1,6] == [(1,'d'),(1,'m'),(0,'o')]
--
dim_nm :: [Z12] -> [(Z12, Char)]
-- | Diatonic interval set to interval set.
--
--
-- >>> dis 24
-- 1256
--
--
--
-- dis [2,4] == [1,2,5,6]
--
dis :: Integral t => [Int] -> [t]
-- | Degree of intersection.
--
--
-- >>> echo 024579e | doi 6 | sort -u
-- 024579A
-- 024679B
--
--
--
-- let p = [0,2,4,5,7,9,11]
-- in doi 6 p p == [[0,2,4,5,7,9,10],[0,2,4,6,7,9,11]]
--
--
--
-- >>> echo 01234 | doi 2 7-35 | sort -u
-- 13568AB
--
--
--
-- doi 2 (T.sc "7-35") [0,1,2,3,4] == [[1,3,5,6,8,10,11]]
--
doi :: Int -> [Z12] -> [Z12] -> [[Z12]]
-- | Forte name.
fn :: [Z12] -> String
-- | p has_ess q is true iff p can embed q in sequence.
has_ess :: [Z12] -> [Z12] -> Bool
-- | Embedded segment search.
--
--
-- >>> echo 23a | ess 0164325
-- 2B013A9
-- 923507A
--
--
--
-- ess [2,3,10] [0,1,6,4,3,2,5] == [[9,2,3,5,0,7,10],[2,11,0,1,3,10,9]]
--
ess :: [Z12] -> [Z12] -> [[Z12]]
-- | Can the set-class q (under prime form algorithm pf) be drawn from the
-- pcset p.
has_sc_pf :: Integral a => ([a] -> [a]) -> [a] -> [a] -> Bool
-- | Can the set-class q be drawn from the pcset p.
has_sc :: [Z12] -> [Z12] -> Bool
-- | Interval cycle filter.
--
--
-- >>> echo 22341 | icf
-- 22341
--
--
--
-- icf [[2,2,3,4,1]] == [[2,2,3,4,1]]
--
icf :: (Num a, Eq a) => [[a]] -> [[a]]
-- | Interval class set to interval sets.
--
--
-- >>> ici -c 123
-- 123
-- 129
-- 1A3
-- 1A9
--
--
--
-- ici_c [1,2,3] == [[1,2,3],[1,2,9],[1,10,3],[1,10,9]]
--
ici :: Num t => [Int] -> [[t]]
-- | Interval class set to interval sets, concise variant.
--
--
-- ici_c [1,2,3] == [[1,2,3],[1,2,9],[1,10,3],[1,10,9]]
--
ici_c :: [Int] -> [[Int]]
-- | Interval-class segment.
--
--
-- >>> icseg 013265e497t8
-- 12141655232
--
--
--
-- icseg [0,1,3,2,6,5,11,4,9,7,10,8] == [1,2,1,4,1,6,5,5,2,3,2]
--
icseg :: [Z12] -> [Z12]
-- | Interval segment (INT).
iseg :: [Z12] -> [Z12]
-- | Imbrications.
imb :: Integral n => [n] -> [a] -> [[a]]
-- | issb gives the set-classes that can append to p to
-- give q.
--
--
-- >>> issb 3-7 6-32
-- 3-7
-- 3-2
-- 3-11
--
--
--
-- issb (T.sc "3-7") (T.sc "6-32") == ["3-2","3-7","3-11"]
--
issb :: [Z12] -> [Z12] -> [String]
-- | Matrix search.
--
--
-- >>> mxs 024579 642 | sort -u
-- 6421B9
-- B97642
--
--
--
-- T.set (mxs [0,2,4,5,7,9] [6,4,2]) == [[6,4,2,1,11,9],[11,9,7,6,4,2]]
--
mxs :: [Z12] -> [Z12] -> [[Z12]]
-- | Normalize.
--
--
-- >>> nrm 0123456543210
-- 0123456
--
--
--
-- nrm [0,1,2,3,4,5,6,5,4,3,2,1,0] == [0,1,2,3,4,5,6]
--
nrm :: Ord a => [a] -> [a]
-- | Normalize, retain duplicate elements.
nrm_r :: Ord a => [a] -> [a]
-- | Pitch-class invariances (called pi at pct).
--
--
-- >>> pi 0236 12
-- 0236
-- 6320
-- 532B
-- B235
--
--
--
-- pci [0,2,3,6] [1,2] == [[0,2,3,6],[5,3,2,11],[6,3,2,0],[11,2,3,5]]
--
pci :: [Z12] -> [Z12] -> [[Z12]]
-- | Relate sets.
--
--
-- >>> rs 0123 641e
-- T1M
--
--
--
-- import Music.Theory.Z12.Morris_1987.Parse
-- rs [0,1,2,3] [6,4,1,11] == [(rnrtnmi "T1M",[1,6,11,4])
-- ,(rnrtnmi "T4MI",[4,11,6,1])]
--
rs :: [Z12] -> [Z12] -> [(SRO, [Z12])]
-- | Relate segments.
--
--
-- >>> rsg 156 3BA
-- T4I
--
--
--
-- rsg [1,5,6] [3,11,10] == [rnrtnmi "T4I",rnrtnmi "r1RT4MI"]
--
--
--
-- >>> rsg 0123 05t3
-- T0M
--
--
--
-- rsg [0,1,2,3] [0,5,10,3] == [rnrtnmi "T0M",rnrtnmi "RT3MI"]
--
--
--
-- >>> rsg 0123 4e61
-- RT1M
--
--
--
-- rsg [0,1,2,3] [4,11,6,1] == [rnrtnmi "T4MI",rnrtnmi "RT1M"]
--
--
--
-- >>> echo e614 | rsg 0123
-- r3RT1M
--
--
--
-- rsg [0,1,2,3] [11,6,1,4] == [rnrtnmi "r1T4MI",rnrtnmi "r1RT1M"]
--
rsg :: [Z12] -> [Z12] -> [SRO]
-- | Subsets.
sb :: [[Z12]] -> [[Z12]]
-- | Super set-class.
--
--
-- >>> spsc 4-11 4-12
-- 5-26[02458]
--
--
--
-- spsc [T.sc "4-11",T.sc "4-12"] == ["5-26"]
--
--
--
-- >>> spsc 3-11 3-8
-- 4-27[0258]
-- 4-Z29[0137]
--
--
--
-- spsc [T.sc "3-11",T.sc "3-8"] == ["4-27","4-Z29"]
--
--
--
-- >>> spsc `fl 3`
-- 6-Z17[012478]
--
--
--
-- spsc (cf [3] T.scs) == ["6-Z17"]
--
spsc :: [[Z12]] -> [String]
-- | Parsers for pitch class sets and sequences, and for SROs.
module Music.Theory.Z12.Morris_1987.Parse
-- | Parse a Morris format serial operator descriptor.
--
--
-- rnrtnmi "r2RT3MI" == SRO 2 True 3 True True
--
rnrtnmi :: String -> SRO
-- | Parse a pitch class object string. Each Char is either a
-- number, a space which is ignored, or a letter name for the numbers 10
-- (t or a or A) or 11 (e or
-- B or b).
--
--
-- pco "13te" == [1,3,10,11]
-- pco "13te" == pco "13ab"
--
pco :: String -> [Z12]
-- | Regular matrix array data, CSV, column & row indexing.
module Music.Theory.Array.CSV
-- | A indexed case-insensitive column references. The column
-- following Z is AA.
data Column_Ref
Column_Ref :: String -> Column_Ref
column_ref_string :: Column_Ref -> String
-- | Inclusive range of column references.
type Column_Range = (Column_Ref, Column_Ref)
-- | 1-indexed row reference.
type Row_Ref = Int
-- | Zero index of Row_Ref.
row_index :: Row_Ref -> Int
-- | Inclusive range of row references.
type Row_Range = (Row_Ref, Row_Ref)
-- | Cell reference, column then row.
type Cell_Ref = (Column_Ref, Row_Ref)
-- | Inclusive range of cell references.
type Cell_Range = (Cell_Ref, Cell_Ref)
-- | Case folding letter to index function. Only valid for ASCII letters.
--
--
-- map letter_index ['A' .. 'Z'] == [0 .. 25]
-- map letter_index ['a','d' .. 'm'] == [0,3 .. 12]
--
letter_index :: Char -> Int
-- | Inverse of letter_index.
--
--
-- map index_letter [0,3 .. 12] == ['A','D' .. 'M']
--
index_letter :: Int -> Char
-- | Translate column reference to 0-index.
--
--
-- :set -XOverloadedStrings
-- map column_index ["A","c","z","ac","XYZ"] == [0,2,25,28,17575]
--
column_index :: Column_Ref -> Int
-- | Column reference to interior index within specified range. Type
-- specialised index.
--
--
-- map (Data.Ix.index ('A','Z')) ['A','C','Z'] == [0,2,25]
-- map (interior_column_index ("A","Z")) ["A","C","Z"] == [0,2,25]
--
--
--
-- map (Data.Ix.index ('B','C')) ['B','C'] == [0,1]
-- map (interior_column_index ("B","C")) ["B","C"] == [0,1]
--
interior_column_index :: Column_Range -> Column_Ref -> Int
-- | Inverse of column_index.
--
--
-- let c = ["A","Z","AA","AZ","BA","BZ","CA"]
-- in map column_ref [0,25,26,51,52,77,78] == c
--
--
--
-- column_ref (0+25+1+25+1+25+1) == "CA"
--
column_ref :: Int -> Column_Ref
-- | Type specialised pred.
--
--
-- column_ref_pred "DF" == "DE"
--
column_ref_pred :: Column_Ref -> Column_Ref
-- | Type specialised succ.
--
--
-- column_ref_succ "DE" == "DF"
--
column_ref_succ :: Column_Ref -> Column_Ref
-- | Bimap of column_index.
--
--
-- column_indices ("b","p") == (1,15)
-- column_indices ("B","IT") == (1,253)
--
column_indices :: Column_Range -> (Int, Int)
-- | Type specialised range.
--
--
-- column_range ("L","R") == ["L","M","N","O","P","Q","R"]
-- Data.Ix.range ('L','R') == "LMNOPQR"
--
column_range :: Column_Range -> [Column_Ref]
-- | Type specialised inRange.
--
--
-- map (column_in_range ("L","R")) ["A","N","Z"] == [False,True,False]
-- map (column_in_range ("L","R")) ["L","N","R"] == [True,True,True]
--
--
--
-- map (Data.Ix.inRange ('L','R')) ['A','N','Z'] == [False,True,False]
-- map (Data.Ix.inRange ('L','R')) ['L','N','R'] == [True,True,True]
--
column_in_range :: Column_Range -> Column_Ref -> Bool
-- | Type specialised rangeSize.
--
--
-- map column_range_size [("A","Z"),("AA","ZZ")] == [26,26 * 26]
-- Data.Ix.rangeSize ('A','Z') == 26
--
column_range_size :: Column_Range -> Int
-- | Type specialised range.
row_range :: Row_Range -> [Row_Ref]
-- | The standard uppermost leftmost cell reference, A1.
--
--
-- Just cell_ref_minima == parse_cell_ref "A1"
--
cell_ref_minima :: Cell_Ref
-- | Cell reference parser for standard notation of (column,row).
--
--
-- parse_cell_ref "CC348" == Just ("CC",348)
--
parse_cell_ref :: String -> Maybe Cell_Ref
-- | Cell reference pretty printer.
--
--
-- cell_ref_pp ("CC",348) == "CC348"
--
cell_ref_pp :: Cell_Ref -> String
-- | Translate cell reference to 0-indexed pair.
--
--
-- cell_index ("CC",348) == (80,347)
-- Data.Ix.index (("AA",1),("ZZ",999)) ("CC",348) == 54293
--
cell_index :: Cell_Ref -> (Int, Int)
-- | Type specialised range, cells are in column-order.
--
--
-- cell_range (("AA",1),("AC",1)) == [("AA",1),("AB",1),("AC",1)]
--
--
--
-- let r = [("AA",1),("AA",2),("AB",1),("AB",2),("AC",1),("AC",2)]
-- in cell_range (("AA",1),("AC",2)) == r
--
--
--
-- Data.Ix.range (('A',1),('C',1)) == [('A',1),('B',1),('C',1)]
--
--
--
-- let r = [('A',1),('A',2),('B',1),('B',2),('C',1),('C',2)]
-- in Data.Ix.range (('A',1),('C',2)) == r
--
cell_range :: Cell_Range -> [Cell_Ref]
-- | Variant of cell_range in row-order.
--
--
-- let r = [(AA,1),(AB,1),(AC,1),(AA,2),(AB,2),(AC,2)]
-- in cell_range_row_order (("AA",1),("AC",2)) == r
--
cell_range_row_order :: Cell_Range -> [Cell_Ref]
-- | When reading a CSV file is the first row a header?
type CSV_Has_Header = Bool
type CSV_Delimiter = Char
type CSV_Allow_Linebreaks = Bool
-- | When writing a CSV file should the delimiters be aligned, ie. should
-- columns be padded with spaces, and if so at which side of the data?
data CSV_Align_Columns
CSV_No_Align :: CSV_Align_Columns
CSV_Align_Left :: CSV_Align_Columns
CSV_Align_Right :: CSV_Align_Columns
-- | CSV options.
type CSV_Opt = (CSV_Has_Header, CSV_Delimiter, CSV_Allow_Linebreaks, CSV_Align_Columns)
-- | Default CSV options, no header, comma delimiter, no linebreaks, no
-- alignment.
def_csv_opt :: CSV_Opt
-- | Plain list representation of a two-dimensional table of a in
-- row-order. Tables are regular, ie. all rows have equal numbers of
-- columns.
type Table a = [[a]]
-- | CSV table, ie. a table with perhaps a header.
type CSV_Table a = (Maybe [String], Table a)
-- | Read Table from CSV file.
csv_table_read :: CSV_Opt -> (String -> a) -> FilePath -> IO (CSV_Table a)
-- | Read Table only with def_csv_opt.
csv_table_read' :: (String -> a) -> FilePath -> IO (Table a)
-- | Read and process CSV Table.
csv_table_with :: CSV_Opt -> (String -> a) -> FilePath -> (CSV_Table a -> b) -> IO b
csv_table_align :: CSV_Align_Columns -> Table String -> Table String
-- | Write Table to CSV file.
csv_table_write :: (a -> String) -> CSV_Opt -> FilePath -> CSV_Table a -> IO ()
-- | Write Table only (no header).
csv_table_write' :: (a -> String) -> CSV_Opt -> FilePath -> Table a -> IO ()
-- | 0-indexed (row,column) cell lookup.
table_lookup :: Table a -> (Int, Int) -> a
-- | Row data.
table_row :: Table a -> Row_Ref -> [a]
-- | Column data.
table_column :: Table a -> Column_Ref -> [a]
-- | Lookup value across columns.
table_column_lookup :: Eq a => Table a -> (Column_Ref, Column_Ref) -> a -> Maybe a
-- | Table cell lookup.
table_cell :: Table a -> Cell_Ref -> a
-- | 0-indexed (row,column) cell lookup over column range.
table_lookup_row_segment :: Table a -> (Int, (Int, Int)) -> [a]
-- | Range of cells from row.
table_row_segment :: Table a -> (Row_Ref, Column_Range) -> [a]
-- | Translate Table to Array. It is assumed that the
-- Table is regular, ie. all rows have an equal number of columns.
--
--
-- let a = table_to_array [[0,1,3],[2,4,5]]
-- in (bounds a,indices a,elems a)
--
--
--
-- > (((A,1),(C,2))
-- > ,[(A,1),(A,2),(B,1),(B,2),(C,1),(C,2)]
-- > ,[0,2,1,4,3,5])
--
table_to_array :: Table a -> Array Cell_Ref a
-- | table_to_array of csv_table_read.
csv_array_read :: CSV_Opt -> (String -> a) -> FilePath -> IO (Array Cell_Ref a)
instance Ix Column_Ref
instance Enum Column_Ref
instance Ord Column_Ref
instance Eq Column_Ref
instance Show Column_Ref
instance Read Column_Ref
instance IsString Column_Ref
-- | Functions for reading midi note data from CSV files.
module Music.Theory.Array.CSV.Midi
-- | Variant of reads requiring exact match.
reads_exact :: Read a => String -> Maybe a
-- | Variant of reads_exact that errors on failure.
reads_err :: Read a => String -> a
-- | The required header field.
csv_midi_note_data_hdr :: [String]
-- | Midi note data, header is time,on/off,note,velocity.
-- Translation values for on/off are consulted.
--
--
-- let fn = "/home/rohan/cvs/uc/uc-26/daily-practice/2014-08-13.1.csv"
-- csv_midi_note_data_read' ("ON","OFF") fn :: IO [(Double,Either String String,Double,Double)]
--
csv_midi_note_data_read' :: (Read t, Real t, Read n, Real n) => (m, m) -> FilePath -> IO [(t, Either m String, n, n)]
-- | Variant of csv_midi_note_data_read' that errors on non on/off
-- data.
csv_midi_note_data_read :: (Read t, Real t, Read n, Real n) => (m, m) -> FilePath -> IO [(t, m, n, n)]
-- | Tseq form of csv_read_midi_note_data.
midi_tseq_read :: (Read t, Real t, Read n, Real n) => FilePath -> IO (Tseq t (On_Off (n, n)))
-- | Translate from Tseq form to Wseq form.
midi_tseq_to_midi_wseq :: (Num t, Eq n) => Tseq t (On_Off (n, n)) -> Wseq t (n, n)
-- | Off-velocity is zero.
midi_wseq_to_midi_tseq :: (Num t, Ord t) => Wseq t (n, n) -> Tseq t (On_Off (n, n))
-- | Writer.
csv_midi_note_data_write :: (Eq m, Show t, Real t, Show n, Real n) => (m, m) -> FilePath -> [(t, m, n, n)] -> IO ()
-- | Tseq form of csv_midi_note_data_write.
midi_tseq_write :: (Show t, Real t, Show n, Real n) => FilePath -> Tseq t (On_Off (n, n)) -> IO ()