-- Hoogle documentation, generated by Haddock
-- See Hoogle, http://www.haskell.org/hoogle/
-- | Haskell Music Theory
--
-- Haskell music theory library
@package hmt
@version 0.16
-- | 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.
--
--
-- L.observeAll (fromList [1..7]) == [1..7]
--
fromList :: MonadPlus m => [a] -> m a
-- | MonadLogic all-interval series.
--
--
-- map (length . L.observeAll . all_interval_m) [4,6,8,10] == [2,4,24,288]
-- [0,1,3,2,9,5,10,4,7,11,8,6] `elem` L.observeAll (all_interval_m 12)
-- length (L.observeAll (all_interval_m 12)) == 3856
--
all_interval_m :: MonadLogic 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)]
-- | 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_from_list :: [t] -> T2 t
t2_to_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_from_list :: [t] -> T3 t
t3_to_list :: T3 a -> [a]
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_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_from_list :: [t] -> T4 t
t4_to_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
p5_from_list :: (t -> t1, t -> t2, t -> t3, t -> t4, t -> t5) -> [t] -> (t1, t2, t3, t4, t5)
p5_to_list :: (t1 -> t, t2 -> t, t3 -> t, t4 -> t, t5 -> t) -> (t1, t2, t3, t4, t5) -> [t]
type T5 a = (a, a, a, a, a)
t5_from_list :: [t] -> T5 t
t5_to_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_from_list :: [t] -> T6 t
t6_to_list :: T6 t -> [t]
t6_map :: (p -> q) -> T6 p -> T6 q
type T7 a = (a, a, a, a, a, a, a)
t7_to_list :: T7 t -> [t]
t7_map :: (p -> q) -> T7 p -> T7 q
type T8 a = (a, a, a, a, a, a, a, a)
t8_to_list :: T8 t -> [t]
t8_map :: (p -> q) -> T8 p -> T8 q
p8_third :: (a, b, c, d, e, f, g, h) -> c
type T9 a = (a, a, a, a, a, a, a, a, a)
t9_to_list :: T9 t -> [t]
t9_map :: (p -> q) -> T9 p -> T9 q
type T10 a = (a, a, a, a, a, a, a, a, a, a)
t10_to_list :: T10 t -> [t]
t10_map :: (p -> q) -> T10 p -> T10 q
type T11 a = (a, a, a, a, a, a, a, a, a, a, a)
t11_to_list :: T11 t -> [t]
t11_map :: (p -> q) -> T11 p -> T11 q
type T12 t = (t, t, t, t, t, t, t, t, t, t, t, t)
t12_to_list :: T12 t -> [t]
t12_from_list :: [t] -> T12 t
-- | foldr1 of t12_to_list.
--
--
-- t12_foldr1 (+) (1,2,3,4,5,6,7,8,9,10,11,12) == 78
--
t12_foldr1 :: (t -> t -> t) -> T12 t -> t
-- | sum of t12_to_list.
--
--
-- t12_sum (1,2,3,4,5,6,7,8,9,10,11,12) == 78
--
t12_sum :: Num n => T12 n -> n
module Music.Theory.Time.Notation
-- | Fractional seconds.
type FSEC = Double
-- | Minutes, seconds as (min,sec)
type MinSec n = (n, n)
-- | Type specialised.
type MINSEC = (Int, Int)
-- | Minutes, seconds, centi-seconds as (min,sec,csec)
type MinCsec n = (n, n, n)
-- | Type specialised.
type MINCSEC = (Int, Int, Int)
-- | divMod by 60.
--
--
-- sec_to_minsec 123 == (2,3)
--
sec_to_minsec :: Integral n => n -> MinSec n
-- | Inverse of sec_minsec.
--
--
-- minsec_to_sec (2,3) == 123
--
minsec_to_sec :: Num n => MinSec n -> n
minsec_binop :: Integral t => (t -> t -> t) -> MinSec t -> MinSec t -> MinSec t
-- | minsec_binop -, assumes q precedes p.
--
--
-- minsec_sub (2,35) (1,59) == (0,36)
--
minsec_sub :: Integral n => MinSec n -> MinSec n -> MinSec n
-- | minsec_binop subtract, assumes p precedes
-- q.
--
--
-- minsec_diff (1,59) (2,35) == (0,36)
--
minsec_diff :: Integral n => MinSec n -> MinSec n -> MinSec n
-- | minsec_binop +.
--
--
-- minsec_add (1,59) (2,35) == (4,34)
--
minsec_add :: Integral n => MinSec n -> MinSec n -> MinSec n
-- | foldl of minsec_add
--
--
-- minsec_sum [(1,59),(2,35),(4,34)] == (9,08)
--
minsec_sum :: Integral n => [MinSec n] -> MinSec n
-- | 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
minsec_parse :: (Num n, Read n) => String -> MinSec n
-- | Fractional seconds to (min,sec,csec), csec value is
-- rounded.
--
--
-- map fsec_to_mincsec [1,1.5,4/3] == [(0,1,0),(0,1,50),(0,1,33)]
--
fsec_to_mincsec :: FSEC -> MINCSEC
-- | Inverse of fsec_mincsec.
mincsec_to_fsec :: Real n => MinCsec n -> FSEC
mincsec_to_csec :: Num n => MinCsec n -> n
-- | Centi-seconds to MinCsec.
--
--
-- map csec_to_mincsec [123,12345] == [(0,1,23),(2,3,45)]
--
csec_to_mincsec :: Integral n => n -> MinCsec n
-- | MINCSEC pretty printer, concise mode omits centiseconds when
-- zero.
--
--
-- map (mincsec_pp_opt True . fsec_to_mincsec) [1,60.5] == ["00:01","01:00.50"]
--
mincsec_pp_opt :: Bool -> MINCSEC -> String
-- | MINCSEC pretty printer.
--
--
-- let r = ["00:01.00","00:06.67","02:03.45"]
-- map (mincsec_pp . fsec_to_mincsec) [1,6+2/3,123.45] == r
--
mincsec_pp :: MINCSEC -> String
mincsec_binop :: Integral t => (t -> t -> t) -> MinCsec t -> MinCsec t -> MinCsec t
-- | Given printer, pretty print time span.
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 GHC.Classes.Eq Music.Theory.Time.Duration.Duration
instance GHC.Read.Read Music.Theory.Time.Duration.Duration
instance GHC.Show.Show Music.Theory.Time.Duration.Duration
-- | String functions.
module Music.Theory.String
-- | Remove r.
filter_cr :: String -> String
-- | Delete trailing Char where isSpace holds.
--
--
-- delete_trailing_whitespace " str " == " str"
--
delete_trailing_whitespace :: String -> String
-- | Show functions.
module Music.Theory.Show
-- | Read functions.
module Music.Theory.Read
-- | Transform ReadS function into precise Read function.
-- Requires using all the input to produce a single token. The only
-- exception is a singular trailing white space character.
reads_to_read_precise :: ReadS t -> (String -> Maybe t)
-- | Error variant of reads_to_read_precise.
reads_to_read_precise_err :: String -> ReadS t -> String -> t
-- | reads_to_read_precise of reads. space character.
read_maybe :: Read a => String -> Maybe a
-- | Variant of read_maybe with default value.
--
--
-- map (read_def 0) ["2","2:","2\n"] == [2,0,2]
--
read_def :: Read a => a -> String -> a
-- | Variant of read_maybe that errors on Nothing.
read_err :: Read a => String -> a
-- | Variant of reads requiring exact match, no trailing white
-- space.
--
--
-- map reads_exact ["1.5","2,5"] == [Just 1.5,Nothing]
--
reads_exact :: Read a => String -> Maybe a
-- | Variant of reads_exact that errors on failure.
reads_exact_err :: Read a => String -> String -> a
-- | Allow commas as thousand separators.
--
--
-- let r = [Just 123456,Just 123456,Nothing,Just 123456789]
-- in map read_integral_allow_commas_maybe ["123456","123,456","1234,56","123,456,789"]
--
read_integral_allow_commas_maybe :: Read i => String -> Maybe i
read_integral_allow_commas_err :: (Integral i, Read i) => String -> i
read_int_allow_commas :: String -> Int
-- | Read a ratio where the division is given by / instead of
-- % and the integers allow commas.
--
--
-- map read_ratio_with_div_err ["123,456/7","123,456,789"] == [123456/7,123456789]
--
read_ratio_with_div_err :: (Integral i, Read i) => String -> Ratio i
-- | Read Ratio, allow commas for thousand separators.
--
--
-- read_ratio_allow_commas_err "327,680" "177,147" == 327680 / 177147
--
read_ratio_allow_commas_err :: (Integral i, Read i) => String -> String -> Ratio i
-- | Delete trailing ., read fails for 700..
delete_trailing_point :: String -> String
-- | read_err disallows trailing decimal points.
--
--
-- map read_fractional_allow_trailing_point_err ["123.","123.4"] == [123.0,123.4]
--
read_fractional_allow_trailing_point_err :: Read n => String -> n
-- | Type specialised read_maybe.
--
--
-- map read_maybe_int ["2","2:","2\n"] == [Just 2,Nothing,Just 2]
--
read_maybe_int :: String -> Maybe Int
-- | Type specialised read_err.
read_int :: String -> Int
-- | Type specialised read_maybe.
read_maybe_double :: String -> Maybe Double
-- | Type specialised read_err.
read_double :: String -> Double
-- | Type specialised read_maybe.
--
--
-- map read_maybe_rational ["1","1%2","1/2"] == [Nothing,Just (1/2),Nothing]
--
read_maybe_rational :: String -> Maybe Rational
-- | Type specialised read_err.
--
--
-- read_rational "1%4"
--
read_rational :: String -> Rational
-- | Error variant of readHex.
--
--
-- read_hex_err "F0B0" == 61616
--
read_hex_err :: (Eq n, Num n) => String -> n
module Music.Theory.Parse
-- | A Char parser.
type P a = GenParser Char () a
-- | Boolean P for given Char.
is_char :: Char -> P Bool
-- | Parse Integral.
parse_int :: Integral i => P i
-- | Ordering functions
module Music.Theory.Ord
-- | Specialised fromEnum.
ord_to_int :: Ordering -> Int
-- | Specialised toEnum.
int_to_ord :: Int -> Ordering
-- | Invert Ordering.
--
--
-- map ord_invert [LT,EQ,GT] == [GT,EQ,LT]
--
ord_invert :: Ordering -> Ordering
-- | Given Ordering, re-order pair,
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)
-- | Variant where the comparison function may not compute a value.
sort_pair_m :: (t -> t -> Maybe Ordering) -> (t, t) -> Maybe (t, t)
-- | Monad functions.
module Music.Theory.Monad
repeatM_ :: (Monad m) => m a -> m ()
iterateM_ :: (Monad m) => st -> (st -> m st) -> m ()
-- | Extensions to Data.Maybe.
module Music.Theory.Maybe
-- | Variant with error text.
from_just :: String -> Maybe a -> a
-- | 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]
-- | The On-Line Encyclopedia of Integer Sequences, http://oeis.org/
module Music.Theory.Math.OEIS
-- | http://oeis.org/A000290
--
-- The squares of the non-negative integers.
--
--
-- import Data.List
-- [0,1,4,9,16,25,36,49,64,81,100] `isInfixOf` a000290
--
a000290 :: Integral n => [n]
-- | http://oeis.org/A002267
a002267 :: Num n => [n]
-- | http://oeis.org/A126709
--
-- Loh-Shu magic square, attributed to the legendary Fu Xi (Fuh-Hi).
a126709 :: Num n => [n]
-- | http://oeis.org/A126710
--
-- Jaina inscription of the twelfth or thirteenth century, Khajuraho,
-- India.
a126710 :: Num n => [n]
-- | Specialised type conversions, see mk/mk-convert.hs
--
--
-- map int_to_word8 [-1,0,255,256] == [255,0,255,0]
-- map int_to_word8_maybe [-1,0,255,256] == [Nothing,Just 0,Just 255,Nothing]
--
--
--
-- map integer_to_int64_maybe [-2 ^ 63 - 1,2 ^ 63] == [Nothing,Nothing]
-- map integer_to_word64_maybe [2 ^64 - 1,2 ^ 64] == [Just 18446744073709551615,Nothing]
--
--
--
-- map int16_to_float [-1,0,1] == [-1,0,1]
--
module Music.Theory.Math.Convert
-- | Type specialised realToFrac
real_to_float :: Real t => t -> Float
-- | Type specialised realToFrac
real_to_double :: Real t => t -> Double
-- | Type specialised realToFrac
double_to_float :: Double -> Float
-- | Type specialised realToFrac
float_to_double :: Float -> Double
-- | Type specialised fromIntegral
word8_to_word16 :: Word8 -> Word16
-- | Type specialised fromIntegral
word8_to_word32 :: Word8 -> Word32
-- | Type specialised fromIntegral
word8_to_word64 :: Word8 -> Word64
-- | Type specialised fromIntegral
word8_to_int8 :: Word8 -> Int8
-- | Type specialised fromIntegral
word8_to_int16 :: Word8 -> Int16
-- | Type specialised fromIntegral
word8_to_int32 :: Word8 -> Int32
-- | Type specialised fromIntegral
word8_to_int64 :: Word8 -> Int64
-- | Type specialised fromIntegral
word8_to_int :: Word8 -> Int
-- | Type specialised fromIntegral
word8_to_integer :: Word8 -> Integer
-- | Type specialised fromIntegral
word8_to_float :: Word8 -> Float
-- | Type specialised fromIntegral
word8_to_double :: Word8 -> Double
-- | Type specialised fromIntegral
word16_to_word8 :: Word16 -> Word8
-- | Type specialised fromIntegral
word16_to_word32 :: Word16 -> Word32
-- | Type specialised fromIntegral
word16_to_word64 :: Word16 -> Word64
-- | Type specialised fromIntegral
word16_to_int8 :: Word16 -> Int8
-- | Type specialised fromIntegral
word16_to_int16 :: Word16 -> Int16
-- | Type specialised fromIntegral
word16_to_int32 :: Word16 -> Int32
-- | Type specialised fromIntegral
word16_to_int64 :: Word16 -> Int64
-- | Type specialised fromIntegral
word16_to_int :: Word16 -> Int
-- | Type specialised fromIntegral
word16_to_integer :: Word16 -> Integer
-- | Type specialised fromIntegral
word16_to_float :: Word16 -> Float
-- | Type specialised fromIntegral
word16_to_double :: Word16 -> Double
-- | Type specialised fromIntegral
word32_to_word8 :: Word32 -> Word8
-- | Type specialised fromIntegral
word32_to_word16 :: Word32 -> Word16
-- | Type specialised fromIntegral
word32_to_word64 :: Word32 -> Word64
-- | Type specialised fromIntegral
word32_to_int8 :: Word32 -> Int8
-- | Type specialised fromIntegral
word32_to_int16 :: Word32 -> Int16
-- | Type specialised fromIntegral
word32_to_int32 :: Word32 -> Int32
-- | Type specialised fromIntegral
word32_to_int64 :: Word32 -> Int64
-- | Type specialised fromIntegral
word32_to_int :: Word32 -> Int
-- | Type specialised fromIntegral
word32_to_integer :: Word32 -> Integer
-- | Type specialised fromIntegral
word32_to_float :: Word32 -> Float
-- | Type specialised fromIntegral
word32_to_double :: Word32 -> Double
-- | Type specialised fromIntegral
word64_to_word8 :: Word64 -> Word8
-- | Type specialised fromIntegral
word64_to_word16 :: Word64 -> Word16
-- | Type specialised fromIntegral
word64_to_word32 :: Word64 -> Word32
-- | Type specialised fromIntegral
word64_to_int8 :: Word64 -> Int8
-- | Type specialised fromIntegral
word64_to_int16 :: Word64 -> Int16
-- | Type specialised fromIntegral
word64_to_int32 :: Word64 -> Int32
-- | Type specialised fromIntegral
word64_to_int64 :: Word64 -> Int64
-- | Type specialised fromIntegral
word64_to_int :: Word64 -> Int
-- | Type specialised fromIntegral
word64_to_integer :: Word64 -> Integer
-- | Type specialised fromIntegral
word64_to_float :: Word64 -> Float
-- | Type specialised fromIntegral
word64_to_double :: Word64 -> Double
-- | Type specialised fromIntegral
int8_to_word8 :: Int8 -> Word8
-- | Type specialised fromIntegral
int8_to_word16 :: Int8 -> Word16
-- | Type specialised fromIntegral
int8_to_word32 :: Int8 -> Word32
-- | Type specialised fromIntegral
int8_to_word64 :: Int8 -> Word64
-- | Type specialised fromIntegral
int8_to_int16 :: Int8 -> Int16
-- | Type specialised fromIntegral
int8_to_int32 :: Int8 -> Int32
-- | Type specialised fromIntegral
int8_to_int64 :: Int8 -> Int64
-- | Type specialised fromIntegral
int8_to_int :: Int8 -> Int
-- | Type specialised fromIntegral
int8_to_integer :: Int8 -> Integer
-- | Type specialised fromIntegral
int8_to_float :: Int8 -> Float
-- | Type specialised fromIntegral
int8_to_double :: Int8 -> Double
-- | Type specialised fromIntegral
int16_to_word8 :: Int16 -> Word8
-- | Type specialised fromIntegral
int16_to_word16 :: Int16 -> Word16
-- | Type specialised fromIntegral
int16_to_word32 :: Int16 -> Word32
-- | Type specialised fromIntegral
int16_to_word64 :: Int16 -> Word64
-- | Type specialised fromIntegral
int16_to_int8 :: Int16 -> Int8
-- | Type specialised fromIntegral
int16_to_int32 :: Int16 -> Int32
-- | Type specialised fromIntegral
int16_to_int64 :: Int16 -> Int64
-- | Type specialised fromIntegral
int16_to_int :: Int16 -> Int
-- | Type specialised fromIntegral
int16_to_integer :: Int16 -> Integer
-- | Type specialised fromIntegral
int16_to_float :: Int16 -> Float
-- | Type specialised fromIntegral
int16_to_double :: Int16 -> Double
-- | Type specialised fromIntegral
int32_to_word8 :: Int32 -> Word8
-- | Type specialised fromIntegral
int32_to_word16 :: Int32 -> Word16
-- | Type specialised fromIntegral
int32_to_word32 :: Int32 -> Word32
-- | Type specialised fromIntegral
int32_to_word64 :: Int32 -> Word64
-- | Type specialised fromIntegral
int32_to_int8 :: Int32 -> Int8
-- | Type specialised fromIntegral
int32_to_int16 :: Int32 -> Int16
-- | Type specialised fromIntegral
int32_to_int64 :: Int32 -> Int64
-- | Type specialised fromIntegral
int32_to_int :: Int32 -> Int
-- | Type specialised fromIntegral
int32_to_integer :: Int32 -> Integer
-- | Type specialised fromIntegral
int32_to_float :: Int32 -> Float
-- | Type specialised fromIntegral
int32_to_double :: Int32 -> Double
-- | Type specialised fromIntegral
int64_to_word8 :: Int64 -> Word8
-- | Type specialised fromIntegral
int64_to_word16 :: Int64 -> Word16
-- | Type specialised fromIntegral
int64_to_word32 :: Int64 -> Word32
-- | Type specialised fromIntegral
int64_to_word64 :: Int64 -> Word64
-- | Type specialised fromIntegral
int64_to_int8 :: Int64 -> Int8
-- | Type specialised fromIntegral
int64_to_int16 :: Int64 -> Int16
-- | Type specialised fromIntegral
int64_to_int32 :: Int64 -> Int32
-- | Type specialised fromIntegral
int64_to_int :: Int64 -> Int
-- | Type specialised fromIntegral
int64_to_integer :: Int64 -> Integer
-- | Type specialised fromIntegral
int64_to_float :: Int64 -> Float
-- | Type specialised fromIntegral
int64_to_double :: Int64 -> Double
-- | Type specialised fromIntegral
int_to_word8 :: Int -> Word8
-- | Type specialised fromIntegral
int_to_word16 :: Int -> Word16
-- | Type specialised fromIntegral
int_to_word32 :: Int -> Word32
-- | Type specialised fromIntegral
int_to_word64 :: Int -> Word64
-- | Type specialised fromIntegral
int_to_int8 :: Int -> Int8
-- | Type specialised fromIntegral
int_to_int16 :: Int -> Int16
-- | Type specialised fromIntegral
int_to_int32 :: Int -> Int32
-- | Type specialised fromIntegral
int_to_int64 :: Int -> Int64
-- | Type specialised fromIntegral
int_to_integer :: Int -> Integer
-- | Type specialised fromIntegral
int_to_float :: Int -> Float
-- | Type specialised fromIntegral
int_to_double :: Int -> Double
-- | Type specialised fromIntegral
integer_to_word8 :: Integer -> Word8
-- | Type specialised fromIntegral
integer_to_word16 :: Integer -> Word16
-- | Type specialised fromIntegral
integer_to_word32 :: Integer -> Word32
-- | Type specialised fromIntegral
integer_to_word64 :: Integer -> Word64
-- | Type specialised fromIntegral
integer_to_int8 :: Integer -> Int8
-- | Type specialised fromIntegral
integer_to_int16 :: Integer -> Int16
-- | Type specialised fromIntegral
integer_to_int32 :: Integer -> Int32
-- | Type specialised fromIntegral
integer_to_int64 :: Integer -> Int64
-- | Type specialised fromIntegral
integer_to_int :: Integer -> Int
-- | Type specialised fromIntegral
integer_to_float :: Integer -> Float
-- | Type specialised fromIntegral
integer_to_double :: Integer -> Double
-- | Type specialised fromIntegral
word8_to_word16_maybe :: Word8 -> Maybe Word16
-- | Type specialised fromIntegral
word8_to_word32_maybe :: Word8 -> Maybe Word32
-- | Type specialised fromIntegral
word8_to_word64_maybe :: Word8 -> Maybe Word64
-- | Type specialised fromIntegral
word8_to_int8_maybe :: Word8 -> Maybe Int8
-- | Type specialised fromIntegral
word8_to_int16_maybe :: Word8 -> Maybe Int16
-- | Type specialised fromIntegral
word8_to_int32_maybe :: Word8 -> Maybe Int32
-- | Type specialised fromIntegral
word8_to_int64_maybe :: Word8 -> Maybe Int64
-- | Type specialised fromIntegral
word8_to_int_maybe :: Word8 -> Maybe Int
-- | Type specialised fromIntegral
word16_to_word8_maybe :: Word16 -> Maybe Word8
-- | Type specialised fromIntegral
word16_to_word32_maybe :: Word16 -> Maybe Word32
-- | Type specialised fromIntegral
word16_to_word64_maybe :: Word16 -> Maybe Word64
-- | Type specialised fromIntegral
word16_to_int8_maybe :: Word16 -> Maybe Int8
-- | Type specialised fromIntegral
word16_to_int16_maybe :: Word16 -> Maybe Int16
-- | Type specialised fromIntegral
word16_to_int32_maybe :: Word16 -> Maybe Int32
-- | Type specialised fromIntegral
word16_to_int64_maybe :: Word16 -> Maybe Int64
-- | Type specialised fromIntegral
word16_to_int_maybe :: Word16 -> Maybe Int
-- | Type specialised fromIntegral
word32_to_word8_maybe :: Word32 -> Maybe Word8
-- | Type specialised fromIntegral
word32_to_word16_maybe :: Word32 -> Maybe Word16
-- | Type specialised fromIntegral
word32_to_word64_maybe :: Word32 -> Maybe Word64
-- | Type specialised fromIntegral
word32_to_int8_maybe :: Word32 -> Maybe Int8
-- | Type specialised fromIntegral
word32_to_int16_maybe :: Word32 -> Maybe Int16
-- | Type specialised fromIntegral
word32_to_int32_maybe :: Word32 -> Maybe Int32
-- | Type specialised fromIntegral
word32_to_int64_maybe :: Word32 -> Maybe Int64
-- | Type specialised fromIntegral
word32_to_int_maybe :: Word32 -> Maybe Int
-- | Type specialised fromIntegral
word64_to_word8_maybe :: Word64 -> Maybe Word8
-- | Type specialised fromIntegral
word64_to_word16_maybe :: Word64 -> Maybe Word16
-- | Type specialised fromIntegral
word64_to_word32_maybe :: Word64 -> Maybe Word32
-- | Type specialised fromIntegral
word64_to_int8_maybe :: Word64 -> Maybe Int8
-- | Type specialised fromIntegral
word64_to_int16_maybe :: Word64 -> Maybe Int16
-- | Type specialised fromIntegral
word64_to_int32_maybe :: Word64 -> Maybe Int32
-- | Type specialised fromIntegral
word64_to_int64_maybe :: Word64 -> Maybe Int64
-- | Type specialised fromIntegral
word64_to_int_maybe :: Word64 -> Maybe Int
-- | Type specialised fromIntegral
int8_to_word8_maybe :: Int8 -> Maybe Word8
-- | Type specialised fromIntegral
int8_to_word16_maybe :: Int8 -> Maybe Word16
-- | Type specialised fromIntegral
int8_to_word32_maybe :: Int8 -> Maybe Word32
-- | Type specialised fromIntegral
int8_to_word64_maybe :: Int8 -> Maybe Word64
-- | Type specialised fromIntegral
int8_to_int16_maybe :: Int8 -> Maybe Int16
-- | Type specialised fromIntegral
int8_to_int32_maybe :: Int8 -> Maybe Int32
-- | Type specialised fromIntegral
int8_to_int64_maybe :: Int8 -> Maybe Int64
-- | Type specialised fromIntegral
int8_to_int_maybe :: Int8 -> Maybe Int
-- | Type specialised fromIntegral
int16_to_word8_maybe :: Int16 -> Maybe Word8
-- | Type specialised fromIntegral
int16_to_word16_maybe :: Int16 -> Maybe Word16
-- | Type specialised fromIntegral
int16_to_word32_maybe :: Int16 -> Maybe Word32
-- | Type specialised fromIntegral
int16_to_word64_maybe :: Int16 -> Maybe Word64
-- | Type specialised fromIntegral
int16_to_int8_maybe :: Int16 -> Maybe Int8
-- | Type specialised fromIntegral
int16_to_int32_maybe :: Int16 -> Maybe Int32
-- | Type specialised fromIntegral
int16_to_int64_maybe :: Int16 -> Maybe Int64
-- | Type specialised fromIntegral
int16_to_int_maybe :: Int16 -> Maybe Int
-- | Type specialised fromIntegral
int32_to_word8_maybe :: Int32 -> Maybe Word8
-- | Type specialised fromIntegral
int32_to_word16_maybe :: Int32 -> Maybe Word16
-- | Type specialised fromIntegral
int32_to_word32_maybe :: Int32 -> Maybe Word32
-- | Type specialised fromIntegral
int32_to_word64_maybe :: Int32 -> Maybe Word64
-- | Type specialised fromIntegral
int32_to_int8_maybe :: Int32 -> Maybe Int8
-- | Type specialised fromIntegral
int32_to_int16_maybe :: Int32 -> Maybe Int16
-- | Type specialised fromIntegral
int32_to_int64_maybe :: Int32 -> Maybe Int64
-- | Type specialised fromIntegral
int32_to_int_maybe :: Int32 -> Maybe Int
-- | Type specialised fromIntegral
int64_to_word8_maybe :: Int64 -> Maybe Word8
-- | Type specialised fromIntegral
int64_to_word16_maybe :: Int64 -> Maybe Word16
-- | Type specialised fromIntegral
int64_to_word32_maybe :: Int64 -> Maybe Word32
-- | Type specialised fromIntegral
int64_to_word64_maybe :: Int64 -> Maybe Word64
-- | Type specialised fromIntegral
int64_to_int8_maybe :: Int64 -> Maybe Int8
-- | Type specialised fromIntegral
int64_to_int16_maybe :: Int64 -> Maybe Int16
-- | Type specialised fromIntegral
int64_to_int32_maybe :: Int64 -> Maybe Int32
-- | Type specialised fromIntegral
int64_to_int_maybe :: Int64 -> Maybe Int
-- | Type specialised fromIntegral
int_to_word8_maybe :: Int -> Maybe Word8
-- | Type specialised fromIntegral
int_to_word16_maybe :: Int -> Maybe Word16
-- | Type specialised fromIntegral
int_to_word32_maybe :: Int -> Maybe Word32
-- | Type specialised fromIntegral
int_to_word64_maybe :: Int -> Maybe Word64
-- | Type specialised fromIntegral
int_to_int8_maybe :: Int -> Maybe Int8
-- | Type specialised fromIntegral
int_to_int16_maybe :: Int -> Maybe Int16
-- | Type specialised fromIntegral
int_to_int32_maybe :: Int -> Maybe Int32
-- | Type specialised fromIntegral
int_to_int64_maybe :: Int -> Maybe Int64
-- | Type specialised fromIntegral
integer_to_word8_maybe :: Integer -> Maybe Word8
-- | Type specialised fromIntegral
integer_to_word16_maybe :: Integer -> Maybe Word16
-- | Type specialised fromIntegral
integer_to_word32_maybe :: Integer -> Maybe Word32
-- | Type specialised fromIntegral
integer_to_word64_maybe :: Integer -> Maybe Word64
-- | Type specialised fromIntegral
integer_to_int8_maybe :: Integer -> Maybe Int8
-- | Type specialised fromIntegral
integer_to_int16_maybe :: Integer -> Maybe Int16
-- | Type specialised fromIntegral
integer_to_int32_maybe :: Integer -> Maybe Int32
-- | Type specialised fromIntegral
integer_to_int64_maybe :: Integer -> Maybe Int64
-- | Type specialised fromIntegral
integer_to_int_maybe :: Integer -> Maybe Int
-- | 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 1.5 == (1,0.5)
--
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
-- | floor of real_to_double.
real_floor :: (Real r, Integral i) => r -> i
-- | Type specialised real_floor.
real_floor_int :: Real r => r -> Int
-- | round of real_to_double.
real_round :: (Real r, Integral i) => r -> i
-- | Type specialised real_round.
real_round_int :: Real r => r -> Int
-- | Is r zero to k decimal places.
--
--
-- map (flip zero_to_precision 0.00009) [4,5] == [True,False]
-- zero_to_precision 4 1.00009 == False
--
zero_to_precision :: Real r => Int -> r -> Bool
-- | Is r whole to k decimal places.
--
--
-- map (flip whole_to_precision 1.00009) [4,5] == [True,False]
--
whole_to_precision :: Real r => Int -> r -> Bool
-- | 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 :: 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
-- | Show rational to n decimal places.
--
--
-- let r = approxRational pi 1e-100
-- r == 884279719003555 / 281474976710656
-- show_rational_decimal 12 r == "3.141592653590"
--
show_rational_decimal :: Int -> Rational -> String
-- | 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
-- | Show r as float to k places.
real_pp :: Real t => Int -> t -> 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
-- | fromInteger . floor.
floor_f :: (RealFrac a, Num b) => a -> b
-- | Round b to nearest multiple of a.
--
--
-- map (round_to 0.25) [0,0.1 .. 1] == [0.0,0.0,0.25,0.25,0.5,0.5,0.5,0.75,0.75,1.0,1.0]
-- map (round_to 25) [0,10 .. 100] == [0,0,25,25,50,50,50,75,75,100,100]
--
round_to :: RealFrac n => n -> n -> n
-- | One-indexed mod function.
--
--
-- map (`oi_mod` 5) [1..10] == [1,2,3,4,5,1,2,3,4,5]
--
oi_mod :: Integral a => a -> a -> a
-- | One-indexed divMod function.
--
--
-- map (`oi_divMod` 5) [1,3 .. 9] == [(0,1),(0,3),(0,5),(1,2),(1,4)]
--
oi_divMod :: Integral t => t -> t -> (t, t)
-- | Integral square root function.
--
--
-- map i_square_root [0,1,4,9,16,25,36,49,64,81,100] == [0 .. 10]
-- map i_square_root [4 .. 16] == [2,2,2,2,2,3,3,3,3,3,3,3,4]
--
i_square_root :: Integral t => t -> t
-- | (0,1) = {x | 0 < x < 1}
in_open_interval :: Ord a => (a, a) -> a -> Bool
-- |
-- - 0,1 = {x | 0 ≤ x ≤ 1}
--
in_closed_interval :: Ord a => (a, a) -> a -> Bool
-- | (p,q] (0,1] = {x | 0 < x ≤ 1}
in_left_half_open_interval :: Ord a => (a, a) -> a -> Bool
-- | [p,q) [0,1) = {x | 0 ≤ x < 1}
in_right_half_open_interval :: Ord a => (a, a) -> a -> Bool
-- | 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 => 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 => 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
-- | Map functions.
module Music.Theory.Map
-- | Erroring lookup.
map_lookup_err :: Ord k => k -> Map k c -> c
-- | flip of lookup.
map_ix :: Ord k => Map k c -> k -> Maybe c
-- | flip of map_lookup_err.
map_ix_err :: Ord k => Map k c -> k -> c
-- | List functions.
module Music.Theory.List
-- | Data.Vector.slice, ie. starting index (zero-indexed) and number of
-- elements.
--
--
-- slice 4 5 [1..] == [5,6,7,8,9]
--
slice :: Int -> Int -> [a] -> [a]
-- | Variant of slice with start and end indices (zero-indexed).
--
--
-- section 4 8 [1..] == [5,6,7,8,9]
--
section :: Int -> Int -> [a] -> [a]
-- | Bracket sequence with left and right values.
--
--
-- bracket ('<','>') "1,2,3" == "<1,2,3>"
--
bracket :: (a, a) -> [a] -> [a]
unbracket' :: [a] -> (Maybe a, [a], Maybe a)
-- | The first & middle & last elements of a list.
--
--
-- unbracket "[12]" == Just ('[',"12",']')
--
unbracket :: [t] -> Maybe (t, [t], t)
unbracket_err :: [t] -> (t, [t], t)
-- | Variant where brackets are sequences.
--
--
-- bracket_l ("<:",":>") "1,2,3" == "<:1,2,3:>"
--
bracket_l :: ([a], [a]) -> [a] -> [a]
-- | Relative of splitOn, but only makes first separation.
--
--
-- splitOn "//" "lhs//rhs//rem" == ["lhs","rhs","rem"]
-- separate_at "//" "lhs//rhs//rem" == Just ("lhs","rhs//rem")
--
separate_at :: Eq a => [a] -> [a] -> Maybe ([a], [a])
-- | Splitter comparing single element.
on_elem :: Eq a => a -> Splitter a
-- | Split before the indicated element.
--
--
-- split_before 'x' "axbcxdefx" == ["a","xbc","xdef","x"]
-- split_before 'x' "xa" == ["","xa"]
--
--
--
-- map (flip split_before "abcde") "ae_" == [["","abcde"],["abcd","e"],["abcde"]]
-- map (flip break "abcde" . (==)) "ae_" == [("","abcde"),("abcd","e"),("abcde","")]
--
split_before :: Eq 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]]
-- | Rotate list so that is starts at indicated element.
--
--
-- rotate_starting_from 'c' "abcde" == Just "cdeab"
-- rotate_starting_from '_' "abc" == Nothing
--
rotate_starting_from :: Eq a => a -> [a] -> Maybe [a]
-- | Erroring variant.
rotate_starting_from_err :: Eq a => a -> [a] -> [a]
-- | Sequence of n adjacent elements, moving forward by k
-- places. The last element may have fewer than n places, but will
-- reach the end of the input sequence.
--
--
-- adj 3 2 "adjacent" == ["adj","jac","cen","nt"]
--
adj :: Int -> Int -> [a] -> [[a]]
-- | Variant of adj where the last element has n places but
-- may not reach the end of the input sequence.
--
--
-- adj' 3 2 "adjacent" == ["adj","jac","cen"]
--
adj' :: Int -> Int -> [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)]
-- let l = [1..5] in zip l (tail l) == adj2 1 l
-- 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 :: [a] -> [a] -> [a]
-- | Interleave list of lists. Allows lists to be of non-equal lenghts.
--
--
-- interleave_set ["abcd","efgh","ijkl"] == "aeibfjcgkdhl"
-- interleave_set ["abc","defg","hijkl"] == "adhbeicfjgkl"
--
interleave_set :: [[a]] -> [a]
-- | De-interleave n lists.
--
--
-- deinterleave 2 ".a+b-c" == [".+-","abc"]
-- deinterleave 3 "aeibfjcgkdhl" == ["abcd","efgh","ijkl"]
--
deinterleave :: Int -> [a] -> [[a]]
-- | Special case for two-part deinterleaving.
--
--
-- deinterleave2 ".a+b-c" == (".+-","abc")
--
deinterleave2 :: [t] -> ([t], [t])
-- | 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]
generic_histogram :: (Ord a, Integral i) => [a] -> [(a, i)]
histogram_by :: Ord a => (a -> a -> Bool) -> [a] -> [(a, Int)]
-- | Count occurences of elements in list.
--
--
-- map histogram ["","hohoh"] == [[],[('h',3),('o',2)]]
--
histogram :: Ord a => [a] -> [(a, Int)]
duplicates_by :: Ord a => (a -> a -> Bool) -> [a] -> [a]
-- | Elements that appear more than once in the input.
--
--
-- map duplicates ["duplicates","redundant"] == ["","dn"]
--
duplicates :: Ord a => [a] -> [a]
-- | 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]]
-- | Variant of filter that has a predicate to halt processing, ie.
-- filter of takeWhile.
--
--
-- filter_halt (even . fst) ((< 5) . snd) (zip [1..] [0..])
--
filter_halt :: (a -> Bool) -> (a -> Bool) -> [a] -> [a]
-- | Replace all p with q in s.
--
--
-- replace "_x_" "-X-" "an _x_ string" == "an -X- string"
-- replace "ab" "cd" "ab ab cd ab" == "cd cd cd cd"
--
replace :: Eq a => [a] -> [a] -> [a] -> [a]
-- | Replace the ith value at ns with x.
--
--
-- replace_at "test" 2 'n' == "tent"
--
replace_at :: Integral i => [a] -> i -> a -> [a]
-- | Equivalent to groupBy == on f.
--
--
-- let r = [[(1,'a'),(1,'b')],[(2,'c')],[(3,'d'),(3,'e')],[(4,'f')]]
-- in group_on fst (zip [1,1,2,3,3,4] "abcdef") == r
--
group_on :: Eq x => (a -> x) -> [a] -> [[a]]
-- | Given accesors for key and value collate adjacent
-- values.
collate_on_adjacent :: (Eq k, Ord k) => (a -> k) -> (a -> v) -> [a] -> [(k, [v])]
-- | collate_on_adjacent of fst and snd.
--
--
-- collate_adjacent (zip "TDD" "xyz") == [('T',"x"),('D',"yz")]
--
collate_adjacent :: Ord a => [(a, b)] -> [(a, [b])]
-- | sortOn prior to collate_on_adjacent.
--
--
-- let r = [('A',"a"),('B',"bd"),('C',"ce"),('D',"f")]
-- in collate_on fst snd (zip "ABCBCD" "abcdef") == r
--
collate_on :: Ord k => (a -> k) -> (a -> v) -> [a] -> [(k, [v])]
-- | collate_on of fst and snd.
--
--
-- collate (zip "TDD" "xyz") == [('D',"yz"),('T',"x")]
-- collate (zip [1,2,1] "abc") == [(1,"ac"),(2,"b")]
--
collate :: Ord a => [(a, b)] -> [(a, [b])]
-- | Reverse of collate, inverse if order is not considered.
--
--
-- uncollate [(1,"ac"),(2,"b")] == zip [1,1,2] "acb"
--
uncollate :: [(k, [v])] -> [(k, v)]
-- | 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])
-- | Apply flip of f between elements of l.
--
--
-- d_dx_by (,) "abcd" == [('b','a'),('c','b'),('d','c')]
--
d_dx_by :: (t -> t -> u) -> [t] -> [u]
-- | Integrate, d_dx_by -, 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
-- | Lookup that errors and prints message.
lookup_err_msg :: (Eq k, Show k) => String -> k -> [(k, v)] -> v
-- | Error variant.
lookup_err :: Eq k => k -> [(k, v)] -> v
-- | lookup variant with default value.
lookup_def :: Eq k => k -> v -> [(k, v)] -> v
-- | Reverse lookup.
--
--
-- reverse_lookup 'c' [] == Nothing
-- reverse_lookup 'c' (zip [0..4] ['a'..]) == Just 2
--
reverse_lookup :: Eq b => b -> [(a, b)] -> Maybe a
-- | Basis of find_bounds_scl, indicates if x is to the left
-- or right of the list, and it to the right whether equal or not.
-- Right values will be correct if the list is not ascending,
-- however Left values only make sense for ascending ranges.
--
--
-- map (find_bounds' compare [(0,1),(1,2)]) [-1,0,1,2,3]
--
find_bounds' :: (t -> s -> Ordering) -> [(t, t)] -> s -> Either ((t, t), Ordering) (t, t)
decide_nearest' :: Ord o => (p -> o) -> (p, p) -> p
-- | Decide if value is nearer the left or right value of a range.
decide_nearest :: (Num o, Ord o) => o -> (o, o) -> o
-- | Find the number that is nearest the requested value in an ascending
-- list of numbers.
--
--
-- map (find_nearest_err [0,3.5,4,7]) [-1,1,3,5,7,9] == [0,0,3.5,4,7,7]
--
find_nearest_err :: (Num n, Ord n) => [n] -> n -> n
find_nearest :: (Num n, Ord n) => [n] -> n -> Maybe n
-- | 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_scl :: 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)
-- | Special case of dropRight.
--
--
-- map drop_last ["","?","remove"] == ["","","remov"]
--
drop_last :: [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]
-- | take from right.
--
--
-- take_right 3 "taking" == "ing"
--
take_right :: Int -> [a] -> [a]
-- | takeWhile from right.
--
--
-- take_while_right Data.Char.isDigit "A440" == "440"
--
take_while_right :: (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 perhaps the last element tuple.
--
--
-- separate_last' [] == ([],Nothing)
--
separate_last' :: [a] -> ([a], Maybe a)
-- | Error on null input.
--
--
-- 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]
-- | zipWith of list and it's own tail.
--
--
-- zip_with_adj (,) "abcde" == [('a','b'),('b','c'),('c','d'),('d','e')]
--
zip_with_adj :: (a -> a -> b) -> [a] -> [b]
-- | Type-specialised zip_with_adj.
compare_adjacent_by :: (a -> a -> Ordering) -> [a] -> [Ordering]
-- | compare_adjacent_by of compare.
--
--
-- compare_adjacent [0,1,3,2] == [LT,LT,GT]
--
compare_adjacent :: Ord a => [a] -> [Ordering]
-- | 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]]
-- | Reduce sequences of consecutive values to ranges.
--
--
-- group_ranges [-1,0,3,4,5,8,9,12] == [(-1,0),(3,5),(8,9),(12,12)]
-- group_ranges [3,2,3,4,3] == [(3,3),(2,4),(3,3)]
--
group_ranges :: (Num t, Eq t) => [t] -> [(t, t)]
-- | 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_equal "aaa" == True
--
all_equal :: Eq a => [a] -> Bool
-- | Variant using nub.
all_eq :: Eq n => [n] -> Bool
-- | group_on of sortOn.
--
--
-- 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
-- | Sequence of comparison functions, continue comparing until not EQ.
--
--
-- compare (1,0) (0,1) == GT
-- n_stage_compare [compare `on` snd,compare `on` fst] (1,0) (0,1) == LT
--
n_stage_compare :: [Compare_F a] -> Compare_F a
-- | 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]
-- | sortBy of n_stage_compare.
sort_by_n_stage :: Ord b => [a -> b] -> [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]
-- | merge_by compare on.
merge_on :: Ord x => (a -> x) -> [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]
-- | First non-ascending pair of elements.
find_non_ascending :: (a -> a -> Ordering) -> [a] -> Maybe (a, a)
-- | isNothing of find_non_ascending.
is_ascending_by :: (a -> a -> Ordering) -> [a] -> Bool
-- | is_ascending_by compare.
is_ascending :: Ord a => [a] -> Bool
-- | Variant of elem that operates on a sorted list, halting. This
-- is member.
--
--
-- 16 `elem_ordered` [1,3 ..] == False
-- 16 `elem` [1,3 ..] == undefined
--
elem_ordered :: Ord t => t -> [t] -> Bool
-- | Variant of elemIndex that operates on a sorted list, halting.
--
--
-- 16 `elemIndex_ordered` [1,3 ..] == Nothing
-- 16 `elemIndex_ordered` [0,1,4,9,16,25,36,49,64,81,100] == Just 4
--
elemIndex_ordered :: Ord t => t -> [t] -> Maybe Int
-- | Keep right variant of zipWith, where 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])
-- | A zipWith variant that always consumes an element from the left
-- hand side (lhs), but only consumes an element from the right hand side
-- (rhs) if the zip function is Right and not if Left.
-- There's also a secondary function to continue if the rhs ends before
-- the lhs.
zip_with_perhaps_rhs :: (a -> b -> Either c c) -> (a -> c) -> [a] -> [b] -> [c]
-- | Fill gaps in a sorted association list, range is inclusive at both
-- ends.
--
--
-- let r = [(1,'a'),(2,'x'),(3,'x'),(4,'x'),(5,'b'),(6,'x'),(7,'c'),(8,'x'),(9,'x')]
-- in fill_gaps_ascending' 'x' (1,9) (zip [1,5,7] "abc") == r
--
fill_gaps_ascending :: (Enum n, Ord n) => t -> (n, n) -> [(n, t)] -> [(n, t)]
-- | Direct definition.
fill_gaps_ascending' :: (Num n, Enum n, Ord n) => t -> (n, n) -> [(n, t)] -> [(n, t)]
-- | minimum and maximum in one pass.
--
--
-- minmax "minimumandmaximum" == ('a','x')
--
minmax :: Ord t => [t] -> (t, t)
-- | Apply f to both elements of a two-tuple, ie. bimap
-- f f.
bimap1 :: (t -> u) -> (t, t) -> (u, u)
-- | Append k to the right of l until result has n
-- places.
--
--
-- map (pad_right '0' 2 . return) ['0' .. '9']
-- pad_right '0' 12 "1101" == "110100000000"
-- map (pad_right ' '3) ["S","E-L"] == ["S ","E-L"]
--
pad_right :: a -> Int -> [a] -> [a]
-- | Append k to the left of l until result has n
-- places.
--
--
-- map (pad_left '0' 2 . return) ['0' .. '9']
--
pad_left :: a -> Int -> [a] -> [a]
-- | Locate first (leftmost) embedding of q in p. Return
-- partial indices for failure at Left.
--
--
-- embedding ("embedding","ming") == Right [1,6,7,8]
-- embedding ("embedding","mind") == Left [1,6,7]
--
embedding :: Eq t => ([t], [t]) -> Either [Int] [Int]
embedding_err :: Eq t => ([t], [t]) -> [Int]
-- | Does q occur in sequence, though not necessarily adjacently, in
-- p.
--
--
-- is_embedding [1 .. 9] [1,3,7] == True
-- is_embedding "embedding" "ming" == True
-- is_embedding "embedding" "mind" == False
--
is_embedding :: Eq t => [t] -> [t] -> Bool
all_embeddings_m :: (Eq t, MonadLogic m) => [t] -> [t] -> m [Int]
-- | Enumerate indices for all embeddings of q in p.
--
--
-- all_embeddings "all_embeddings" "leg" == [[1,4,12],[1,7,12],[2,4,12],[2,7,12]]
--
all_embeddings :: Eq t => [t] -> [t] -> [[Int]]
-- | Unpack one element list.
unlist1 :: [t] -> Maybe t
-- | Erroring variant.
unlist1_err :: [t] -> t
-- | Replace elements at Traversable with result of joining with
-- elements from list.
--
--
-- let t = Node 0 [Node 1 [Node 2 [],Node 3 []],Node 4 []]
-- putStrLn $ drawTree (fmap show t)
-- let u = (adopt_shape (\_ x -> x) "abcde" t)
-- putStrLn $ drawTree (fmap return u)
--
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)
-- | 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 ((==) '{',(==) '}') l}
-- in catMaybes (flatten t) == l
--
--
--
-- let {d = putStrLn . drawTree . fmap show}
-- in d (group_tree ((==) '(',(==) ')') "a(b(cd)ef)ghi")
--
group_tree :: (a -> Bool, a -> Bool) -> [a] -> Tree (Maybe a)
-- | Remove element at index.
--
--
-- remove_ix 5 "remove" == "remov"
-- remove_ix 5 "short" == undefined
--
remove_ix :: Int -> [a] -> [a]
operate_ixs :: Bool -> [Int] -> [a] -> [a]
select_ixs :: [Int] -> [a] -> [a]
remove_ixs :: [Int] -> [a] -> [a]
-- | Replace element at i in p by application of f.
--
--
-- replace_ix negate 1 [1..3] == [1,-2,3]
--
replace_ix :: (a -> a) -> Int -> [a] -> [a]
-- | Cyclic indexing function.
--
--
-- map (at_cyclic "cycle") [0..9] == "cyclecycle"
--
at_cyclic :: [a] -> Int -> a
-- | 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 :: 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 :: [[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]]
-- | 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 :: [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]]
factorial :: (Enum a, Num a) => a -> a
-- | Calculate number of permutations of a multiset.
--
--
-- let r = factorial 11 `div` product (map factorial [1,4,4,2])
-- in multiset_permutations_n "MISSISSIPPI" == r
--
--
--
-- multiset_permutations_n "MISSISSIPPI" == 34650
-- length (multiset_permutations "MISSISSIPPI") == 34650
--
multiset_permutations_n :: Ord a => [a] -> Int
-- | 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 Q12 == Q4
-- [l_on L L,l_on E D,l_on D E] == [L2,C,B]
--
l_on :: Label -> Label -> Label
-- | Generalisation of Fibonnaci process, f is the binary operator
-- giving the next element, p and q are the initial
-- elements.
--
-- See discussion in: Carlos Agon, Moreno Andreatta, Gérard Assayag, and
-- Stéphan Schaub. _Formal Aspects of Iannis Xenakis' "Symbolic Music": A
-- Computer-Aided Exploration of Compositional Processes_. Journal of New
-- Music Research, 33(2):145-159, 2004.
--
-- Note that the article has an error, printing Q4 for Q11 in the
-- sequence below.
--
--
-- import qualified Music.Theory.List as T
--
--
--
-- let r = [D,Q12,Q4, E,Q8,Q2, E2,Q7,Q4, D2,Q3,Q11, L2,Q7,Q2, L,Q8,Q11]
-- in (take 18 (fib_proc l_on D Q12) == r,T.duplicates r == [Q2,Q4,Q7,Q8,Q11])
--
--
-- Beginning E then G2 no Q nodes are visited.
--
--
-- let r = [E,G2,L2,C,G,D,E,B,D2,L,G,C,L2,E2,D2,B]
-- in (take 16 (fib_proc l_on E G2) == r,T.duplicates r == [B,C,D2,E,G,L2])
--
--
--
-- import Music.Theory.List
-- let [a,b] = take 2 (segments 18 18 (fib_proc l_on D Q12)) in a == b
--
--
-- The prime numbers that are not factors of 18 are {1,5,7,11,13,17}.
-- They form a closed group under modulo 18 multiplication.
--
--
-- let {n = [5,7,11,13,17]
-- ;r = [(5,7,17),(5,11,1),(5,13,11),(5,17,13)
-- ,(7,11,5),(7,13,1),(7,17,11)
-- ,(11,13,17),(11,17,7)
-- ,(13,17,5)]}
-- in [(p,q,(p * q) `mod` 18) | p <- n, q <- n, p < q] == r
--
--
-- The article also omits the 5 after 5,1 in the sequence below.
--
--
-- let r = [11,13,17,5,13,11,17,7,11,5,1,5,5,7,17,11,7,5,17,13,5,11,1,11]
-- in take 24 (fib_proc (\p q -> (p * q) `mod` 18) 11 13) == r
--
fib_proc :: (a -> a -> a) -> a -> a -> [a]
-- | 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)]
-- | Label sequence of Fig. VIII-6. Hexahedral (Octahedral) Group (p. 220)
--
--
-- let r = [I,A,B,C,D,D2,E,E2,G,G2,L,L2,Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9,Q10,Q11,Q12]
-- in viii_6_lseq == r
--
viii_6_lseq :: [Label]
-- | Label sequence of Fig. VIII-7 (p.221)
--
--
-- let r = [I,A,B,C,D,D2,E,E2,G,G2,L,L2,Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9,Q10,Q11,Q12]
-- in viii_7_lseq == r
--
viii_7_lseq :: [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]]
--
--
--
-- import Music.Theory.Array.MD
--
--
--
-- let t = md_matrix_opt show (\x -> "_" ++ x ++ "_") (head viii_7,head viii_7) viii_7
-- putStrLn $ unlines $ md_table' t
--
viii_7 :: [[Label]]
-- | Label sequence of Fig. VIII-6/b (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_lseq :: [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 GHC.Show.Show Music.Theory.Xenakis.S4.Face
instance GHC.Classes.Ord Music.Theory.Xenakis.S4.Face
instance GHC.Enum.Bounded Music.Theory.Xenakis.S4.Face
instance GHC.Enum.Enum Music.Theory.Xenakis.S4.Face
instance GHC.Classes.Eq Music.Theory.Xenakis.S4.Face
instance GHC.Show.Show Music.Theory.Xenakis.S4.Label
instance GHC.Enum.Bounded Music.Theory.Xenakis.S4.Label
instance GHC.Enum.Enum Music.Theory.Xenakis.S4.Label
instance GHC.Classes.Ord Music.Theory.Xenakis.S4.Label
instance GHC.Classes.Eq Music.Theory.Xenakis.S4.Label
-- | 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]
numeric_spelling_tbl :: [(Char, Int)]
-- | Parse abbreviated Hold notation, characters are hexedecimal.
--
--
-- to_abbrev "380ETA" == [3,8,10,11,12,13]
--
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)]
-- | Given two sequences, derive the one-indexed "hold" list.
--
--
-- derive_holds ("12345","13254") == [1]
--
derive_holds :: (Eq a, Enum n, Num n) => ([a], [a]) -> [n]
-- | 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 :: Int -> [Int] -> [a] -> [a]
-- | Apply a Change.
apply_change :: 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 :: 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]]
-- |
-- 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
-- |
-- https://rsw.me.uk/blueline/methods/view/Cambridge_Surprise_Major
--
--
-- length (closed_method cambridge_surprise_major [1..8]) == 7
--
cambridge_surprise_major :: Method
-- |
-- https://rsw.me.uk/blueline/methods/view/Smithsonian_Surprise_Royal
--
--
-- let m = closed_method smithsonian_surprise_royal [1..10]
-- (length m,nub (map length m),sum (map length m)) == (9,[40],360)
--
smithsonian_surprise_royal :: Method
-- |
-- https://rsw.me.uk/blueline/methods/view/Ecumenical_Surprise_Maximus
--
--
-- let m = closed_method ecumenical_surprise_maximus [1..12]
-- (length m,nub (map length m),sum (map length m)) == (11,[48],528)
--
ecumenical_surprise_maximus :: Method
instance GHC.Show.Show Music.Theory.Permutations.Morris_1984.Method
instance GHC.Classes.Eq Music.Theory.Permutations.Morris_1984.Method
instance GHC.Show.Show Music.Theory.Permutations.Morris_1984.Change
instance GHC.Classes.Eq Music.Theory.Permutations.Morris_1984.Change
-- | 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
-- | Note sequence as usually understood, ie. C - B.
note_seq :: [Note_T]
-- | Char variant of show.
note_pp :: Note_T -> Char
-- | Table of Note_T and corresponding pitch-classes.
note_pc_tbl :: Num i => [(Note_T, i)]
-- | Transform Note_T to pitch-class number.
--
--
-- map note_to_pc [C,E,G] == [0,4,7]
--
note_to_pc :: Num i => Note_T -> i
-- | Inverse of note_to_pc.
--
--
-- mapMaybe pc_to_note [0,4,7] == [C,E,G]
--
pc_to_note :: (Eq i, Num i) => i -> Maybe Note_T
-- | Modal transposition of Note_T value.
--
--
-- note_t_transpose C 2 == E
--
note_t_transpose :: Note_T -> Int -> Note_T
-- | Parser from Char, case insensitive flag.
--
--
-- mapMaybe (parse_note True) "CDEFGab" == [C,D,E,F,G,A,B]
--
parse_note_t :: Bool -> Char -> Maybe Note_T
-- | 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]
-- | 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
alteration_symbol_tbl :: [(Alteration_T, Char)]
-- | 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
-- | Inverse of alteration_symbol.
--
--
-- mapMaybe symbol_to_alteration "♭♮♯" == [Flat,Natural,Sharp]
--
symbol_to_alteration :: Char -> Maybe Alteration_T
-- | Variant of symbol_to_alteration that also recognises
-- b for Flat and # for Sharp and
-- x for double sharp.
symbol_to_alteration_iso :: Char -> Maybe Alteration_T
alteration_iso_tbl :: [(Alteration_T, String)]
-- | The ISO ASCII spellings for alterations. Naturals are written
-- as the empty string.
--
--
-- mapMaybe alteration_iso_m [Flat .. Sharp] == ["b","","#"]
-- mapMaybe alteration_iso_m [DoubleFlat,DoubleSharp] == ["bb","x"]
--
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
note_alteration_to_pc :: (Note_T, Alteration_T) -> Maybe Int
note_alteration_to_pc_err :: (Note_T, Alteration_T) -> Int
-- | Note & alteration sequence in key-signature spelling.
note_alteration_ks :: [(Note_T, Alteration_T)]
-- | Table connecting pitch class number with note_alteration_ks.
pc_note_alteration_ks_tbl :: Integral i => [((Note_T, Alteration_T), i)]
-- | reverse_lookup of pc_note_alteration_ks_tbl.
pc_to_note_alteration_ks :: Integral i => i -> Maybe (Note_T, Alteration_T)
-- | Alteration given as a rational semitone difference and a string
-- representation of the alteration.
type Alteration_R = (Rational, String)
-- | Transform Alteration_T to Alteration_R.
--
--
-- let r = [(-1,"♭"),(0,"♮"),(1,"♯")]
-- in map alteration_t' [Flat,Natural,Sharp] == r
--
alteration_r :: Alteration_T -> Alteration_R
instance GHC.Show.Show Music.Theory.Pitch.Note.Alteration_T
instance GHC.Classes.Ord Music.Theory.Pitch.Note.Alteration_T
instance GHC.Enum.Bounded Music.Theory.Pitch.Note.Alteration_T
instance GHC.Enum.Enum Music.Theory.Pitch.Note.Alteration_T
instance GHC.Classes.Eq Music.Theory.Pitch.Note.Alteration_T
instance GHC.Show.Show Music.Theory.Pitch.Note.Note_T
instance GHC.Read.Read Music.Theory.Pitch.Note.Note_T
instance GHC.Classes.Ord Music.Theory.Pitch.Note.Note_T
instance GHC.Enum.Bounded Music.Theory.Pitch.Note.Note_T
instance GHC.Enum.Enum Music.Theory.Pitch.Note.Note_T
instance GHC.Classes.Eq Music.Theory.Pitch.Note.Note_T
-- | Common music notation pitch values.
module Music.Theory.Pitch
-- | Octave and PitchClass duple.
type Octave_PitchClass i = (i, i)
-- | Normalise Octave_PitchClass value, ie. ensure pitch-class is in
-- (0,11).
octave_pitchclass_nrm :: Integral i => Octave_PitchClass i -> Octave_PitchClass i
-- | Transpose Octave_PitchClass value.
octave_pitchclass_trs :: Integral i => i -> Octave_PitchClass i -> Octave_PitchClass i
-- | Octave_PitchClass value to integral midi note number.
octave_pitchclass_to_midi :: Integral i => Octave_PitchClass i -> i
-- | Inverse of octave_pitchclass_to_midi.
midi_to_octave_pitchclass :: Integral i => i -> Octave_PitchClass i
-- | 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 OctPC = (Octave, PitchClass)
-- | Translate from generic octave & pitch-class duple.
to_octpc :: (Integral pc, Integral oct) => (oct, pc) -> OctPC
-- | Normalise OctPC.
--
--
-- octpc_nrm (4,16) == (5,4)
--
octpc_nrm :: OctPC -> OctPC
-- | Transpose OctPC.
--
--
-- octpc_trs 7 (4,9) == (5,4)
-- octpc_trs (-11) (4,9) == (3,10)
--
octpc_trs :: Int -> OctPC -> OctPC
-- | 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
type Midi = Int
-- | OctPC value to integral midi note number.
--
--
-- map octpc_to_midi [(0,0),(2,6),(4,9),(9,0)] == [12,42,69,120]
-- map octpc_to_midi [(0,9),(8,0)] == [21,108]
--
octpc_to_midi :: OctPC -> Midi
-- | Inverse of octpc_to_midi.
--
--
-- map midi_to_octpc [40,69] == [(2,4),(4,9)]
--
midi_to_octpc :: Midi -> OctPC
-- | Fractional midi note number.
type FMidi = Double
-- | Fractional octave pitch-class (octave is integral, pitch-class is
-- fractional).
type FOctPC = (Int, Double)
-- | fromIntegral of octpc_to_midi.
octpc_to_fmidi :: (Integral i, Num n) => Octave_PitchClass i -> n
-- | Fractional midi to fractional octave pitch-class.
--
--
-- fmidi_to_foctpc 69.5 == (4,9.5)
--
fmidi_to_foctpc :: RealFrac f => f -> (Octave, f)
-- | Octave of fractional midi note number.
fmidi_octave :: RealFrac f => f -> Octave
foctpc_to_fmidi :: RealFrac f => (Octave, f) -> f
-- | Move fractional midi note number to indicated octave.
--
--
-- map (fmidi_in_octave 1) [59.5,60.5] == [35.5,24.5]
--
fmidi_in_octave :: RealFrac f => Octave -> f -> f
-- | 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
-- | 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
--
--
-- map pitch_to_pc [Pitch A Natural 4,Pitch F Sharp 4] == [9,6]
-- map pitch_to_pc [Pitch C Flat 4,Pitch B Sharp 5] == [11,0]
--
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
-- | Function to spell a PitchClass.
type Spelling n = n -> (Note_T, Alteration_T)
-- | Variant of Spelling for incomplete functions.
type Spelling_M i = i -> Maybe (Note_T, Alteration_T)
-- | Given Spelling function translate from OctPC notation to
-- Pitch.
--
--
-- octpc_to_pitch T.pc_spell_sharp (4,6) == Pitch T.F T.Sharp 4
--
octpc_to_pitch :: Integral i => Spelling i -> Octave_PitchClass i -> Pitch
-- | 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
-- | Print fractional midi note number as ET12 pitch with cents detune in
-- parentheses.
--
--
-- fmidi_et12_cents_pp 66.5 == "F♯4(+50)"
--
fmidi_et12_cents_pp :: Spelling PitchClass -> Double -> String
-- | Fractional midi note number to Pitch.
--
--
-- fmidi_to_pitch pc_spell_ks 69.25 == Nothing
--
fmidi_to_pitch :: RealFrac n => Spelling PitchClass -> n -> Maybe Pitch
-- | Erroring variant.
--
--
-- import Music.Theory.Pitch.Spelling
-- pitch_pp (fmidi_to_pitch_err pc_spell_ks 65.5) == "F𝄲4"
-- pitch_pp (fmidi_to_pitch_err pc_spell_ks 66.5) == "F𝄰4"
-- pitch_pp (fmidi_to_pitch_err pc_spell_ks 67.5) == "A𝄭4"
-- pitch_pp (fmidi_to_pitch_err pc_spell_ks 69.5) == "B𝄭4"
--
fmidi_to_pitch_err :: (Show n, 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, Show n) => Spelling Int -> n -> Pitch -> Pitch
-- | Displacement of q into octave of p.
fmidi_in_octave_of :: RealFrac f => f -> f -> f
-- | Octave displacement of m2 that is nearest m1.
--
--
-- let {p = octpc_to_fmidi (2,1);q = map octpc_to_fmidi [(4,11),(4,0),(4,1)]}
-- in map (fmidi_in_octave_nearest p) q == [35,36,37]
--
fmidi_in_octave_nearest :: RealFrac n => n -> n -> n
-- | Displacement of q into octave above p.
--
--
-- fmidi_in_octave_of 69 51 == 63
-- fmidi_in_octave_nearest 69 51 == 63
-- fmidi_in_octave_above 69 51 == 75
--
fmidi_in_octave_above :: RealFrac a => a -> a -> a
-- | Displacement of q into octave below p.
--
--
-- fmidi_in_octave_of 69 85 == 61
-- fmidi_in_octave_nearest 69 85 == 73
-- fmidi_in_octave_below 69 85 == 61
--
fmidi_in_octave_below :: RealFrac a => a -> a -> a
cps_in_octave' :: Floating f => (f -> f -> f) -> f -> f -> f
-- | CPS form of fmidi_in_octave_nearest.
--
--
-- map cps_octave [440,256] == [4,4]
-- round (cps_in_octave_nearest 440 256) == 512
--
cps_in_octave_nearest :: (Floating f, RealFrac f) => f -> f -> f
-- | Raise or lower the frequency q by octaves until it is in the
-- octave starting at p.
--
--
-- cps_in_octave_above 55.0 392.0 == 98.0
--
cps_in_octave_above :: (Ord a, Fractional a) => a -> a -> a
cps_in_octave_above' :: (Floating f, RealFrac f) => f -> f -> f
cps_in_octave_below :: (Floating f, RealFrac f) => f -> f -> f
-- | 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, given frequency of ISO
-- A4.
midi_to_cps_f0 :: (Integral i, Floating f) => f -> i -> f
-- | midi_to_cps_f0 440.
--
--
-- 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, given
-- frequency of ISO A4.
fmidi_to_cps_f0 :: Floating a => a -> a -> a
-- | fmidi_to_cps_f0 440.
--
--
-- 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, given frequency of ISO
-- A4.
pitch_to_cps_f0 :: Floating n => n -> Pitch -> n
-- | pitch_to_cps_f0 440.
pitch_to_cps :: Floating n => Pitch -> n
-- | Frequency (cps = cycles per second) to fractional midi note
-- number, given frequency of ISO A4 (mnn = 69).
cps_to_fmidi_f0 :: Floating a => a -> a -> a
-- | cps_to_fmidi_f0 440.
--
--
-- cps_to_fmidi 440 == 69
-- cps_to_fmidi (fmidi_to_cps 60.25) == 60.25
--
cps_to_fmidi :: Floating a => a -> a
-- | 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
-- | midi_to_cps_f0 of octpc_to_midi, given frequency of ISO
-- A4.
octpc_to_cps_f0 :: (Integral i, Floating n) => n -> Octave_PitchClass i -> n
-- | octpc_to_cps_f0 440.
--
--
-- 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
cps_octave :: (Floating f, RealFrac f) => f -> Octave
-- | Midi note number with cents detune.
type Midi_Detune' c = (Int, c)
-- | Is cents in (-50,+50].
--
--
-- map cents_is_normal [-250,-75,75,250] == replicate 4 False
--
cents_is_normal :: (Num c, Ord c) => c -> Bool
-- | cents_is_normal of snd.
midi_detune_is_normal :: (Num c, Ord c) => Midi_Detune' c -> Bool
-- | In normal form the detune is in the range (-50,+50] instead of [0,100)
-- or wider.
--
--
-- map midi_detune_normalise [(60,-250),(60,-75),(60,75),(60,250)]
--
midi_detune_normalise :: (Ord c, Num c) => Midi_Detune' c -> Midi_Detune' c
-- | Inverse of cps_to_midi_detune, given frequency of ISO
-- A4.
midi_detune_to_cps_f0 :: Real c => Double -> Midi_Detune' c -> Double
-- | Inverse of cps_to_midi_detune.
--
--
-- map midi_detune_to_cps [(69,0),(68,100)] == [440,440]
--
midi_detune_to_cps :: Real c => Midi_Detune' c -> Double
-- | Midi_Detune to fractional midi note number.
--
--
-- midi_detune_to_fmidi (60,50.0) == 60.50
--
midi_detune_to_fmidi :: Real c => Midi_Detune' c -> Double
-- | Midi_Detune to Pitch, detune must be precisely at a
-- notateable Pitch.
--
--
-- let p = Pitch {note = C, alteration = QuarterToneSharp, octave = 4}
-- in midi_detune_to_pitch T.pc_spell_ks (midi_detune_nearest_24et (60,35)) == p
--
midi_detune_to_pitch :: Real c => Spelling Int -> Midi_Detune' c -> Pitch
-- | Midi note number with real-valued cents detune.
type Midi_Detune = Midi_Detune' Double
-- | Fractional midi note number to Midi_Detune.
--
--
-- fmidi_to_midi_detune 60.50 == (60,50.0)
--
fmidi_to_midi_detune :: Double -> Midi_Detune
-- | 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
-- | Round detune value to nearest multiple of 50,
-- normalised.
--
--
-- map midi_detune_nearest_24et [(59,70),(59,80)] == [(59,50),(60,00)]
--
midi_detune_nearest_24et :: Midi_Detune -> Midi_Detune
-- | Midi note number with integral cents detune.
type Midi_Cents = Midi_Detune' Int
midi_detune_to_midi_cents :: Midi_Detune -> Midi_Cents
-- | Printed as fmidi value with cents to two places. Must be
-- normal.
--
--
-- map midi_cents_pp [(60,0),(60,25)] == ["60.00","60.25"]
--
midi_cents_pp :: Midi_Cents -> String
-- | Parse possible octave from single integer.
--
--
-- map (parse_octave 2) ["","4","x","11"]
--
parse_octave :: Num a => a -> String -> Maybe a
-- | 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
-- | error variant.
parse_iso_pitch_err :: String -> Pitch
-- | Pretty printer for Pitch (unicode, see
-- alteration_symbol). Option selects if Naturals are
-- printed.
--
--
-- pitch_pp_opt (True,True) (Pitch T.E T.Natural 4) == "E♮4"
--
pitch_pp_opt :: (Bool, Bool) -> Pitch -> String
-- | pitch_pp_opt with default options, ie. (False,True).
--
--
-- pitch_pp (Pitch T.E T.Natural 4) == "E4"
-- pitch_pp (Pitch T.E T.Flat 4) == "E♭4"
-- pitch_pp (Pitch T.F T.QuarterToneSharp 3) == "F𝄲3"
--
pitch_pp :: Pitch -> String
-- | pitch_pp_opt with options (False,False).
--
--
-- pitch_class_pp (Pitch T.C T.ThreeQuarterToneSharp 0) == "C𝄰"
--
pitch_class_pp :: Pitch -> String
-- | Sequential list of n pitch class names starting from k.
--
--
-- unwords (pitch_class_names_12et 0 12) == "C C♯ D E♭ E F F♯ G A♭ A B♭ B"
-- pitch_class_names_12et 11 2 == ["B","C"]
--
pitch_class_names_12et :: Integral n => Spelling 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 C ThreeQuarterToneSharp 4) -- error
--
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
pc24et_univ :: [Pitch]
-- | genericIndex into pc24et_univ.
--
--
-- pitch_class_pp (pc24et_to_pitch 13) == "F𝄰"
--
pc24et_to_pitch :: Integral i => i -> Pitch
-- | Generalised pitch, given by a generalised alteration.
data Pitch_R
Pitch_R :: Note_T -> Alteration_R -> Octave -> Pitch_R
-- | Pretty printer for Pitch_R.
pitch_r_pp :: Pitch_R -> String
-- | Pitch_R printed without octave.
pitch_r_class_pp :: Pitch_R -> String
instance GHC.Show.Show Music.Theory.Pitch.Pitch_R
instance GHC.Classes.Eq Music.Theory.Pitch.Pitch_R
instance GHC.Show.Show Music.Theory.Pitch.Pitch
instance GHC.Classes.Eq Music.Theory.Pitch.Pitch
instance GHC.Classes.Ord Music.Theory.Pitch.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
d1 :: Pitch
e1 :: Pitch
f1 :: Pitch
g1 :: Pitch
a1 :: Pitch
b1 :: Pitch
ces1 :: Pitch
des1 :: Pitch
ees1 :: Pitch
fes1 :: Pitch
ges1 :: Pitch
aes1 :: Pitch
bes1 :: Pitch
cis1 :: Pitch
dis1 :: Pitch
eis1 :: Pitch
fis1 :: Pitch
gis1 :: Pitch
ais1 :: Pitch
bis1 :: Pitch
c2 :: Pitch
d2 :: Pitch
e2 :: Pitch
f2 :: Pitch
g2 :: Pitch
a2 :: Pitch
b2 :: Pitch
ces2 :: Pitch
des2 :: Pitch
ees2 :: Pitch
fes2 :: Pitch
ges2 :: Pitch
aes2 :: Pitch
bes2 :: Pitch
cis2 :: Pitch
dis2 :: Pitch
eis2 :: Pitch
fis2 :: Pitch
gis2 :: Pitch
ais2 :: Pitch
bis2 :: Pitch
cisis2 :: Pitch
disis2 :: Pitch
eisis2 :: Pitch
fisis2 :: Pitch
gisis2 :: Pitch
aisis2 :: Pitch
bisis2 :: Pitch
ceseh2 :: Pitch
deseh2 :: Pitch
eeseh2 :: Pitch
feseh2 :: Pitch
geseh2 :: Pitch
aeseh2 :: Pitch
beseh2 :: Pitch
ceh2 :: Pitch
deh2 :: Pitch
eeh2 :: Pitch
feh2 :: Pitch
geh2 :: Pitch
aeh2 :: Pitch
beh2 :: Pitch
cih2 :: Pitch
dih2 :: Pitch
eih2 :: Pitch
fih2 :: Pitch
gih2 :: Pitch
aih2 :: Pitch
bih2 :: Pitch
cisih2 :: Pitch
disih2 :: Pitch
eisih2 :: Pitch
fisih2 :: Pitch
gisih2 :: Pitch
aisih2 :: Pitch
bisih2 :: Pitch
c3 :: Pitch
d3 :: Pitch
e3 :: Pitch
f3 :: Pitch
g3 :: Pitch
a3 :: Pitch
b3 :: Pitch
ces3 :: Pitch
des3 :: Pitch
ees3 :: Pitch
fes3 :: Pitch
ges3 :: Pitch
aes3 :: Pitch
bes3 :: Pitch
cis3 :: Pitch
dis3 :: Pitch
eis3 :: Pitch
fis3 :: Pitch
gis3 :: Pitch
ais3 :: Pitch
bis3 :: Pitch
ceses3 :: Pitch
deses3 :: Pitch
eeses3 :: Pitch
feses3 :: Pitch
geses3 :: Pitch
aeses3 :: Pitch
beses3 :: Pitch
cisis3 :: Pitch
disis3 :: Pitch
eisis3 :: Pitch
fisis3 :: Pitch
gisis3 :: Pitch
aisis3 :: Pitch
bisis3 :: Pitch
ceseh3 :: Pitch
deseh3 :: Pitch
eeseh3 :: Pitch
feseh3 :: Pitch
geseh3 :: Pitch
aeseh3 :: Pitch
beseh3 :: Pitch
ceh3 :: Pitch
deh3 :: Pitch
eeh3 :: Pitch
feh3 :: Pitch
geh3 :: Pitch
aeh3 :: Pitch
beh3 :: Pitch
cih3 :: Pitch
dih3 :: Pitch
eih3 :: Pitch
fih3 :: Pitch
gih3 :: Pitch
aih3 :: Pitch
bih3 :: Pitch
cisih3 :: Pitch
disih3 :: Pitch
eisih3 :: Pitch
fisih3 :: Pitch
gisih3 :: Pitch
aisih3 :: Pitch
bisih3 :: Pitch
c4 :: Pitch
d4 :: Pitch
e4 :: Pitch
f4 :: Pitch
g4 :: Pitch
a4 :: Pitch
b4 :: Pitch
ces4 :: Pitch
des4 :: Pitch
ees4 :: Pitch
fes4 :: Pitch
ges4 :: Pitch
aes4 :: Pitch
bes4 :: Pitch
cis4 :: Pitch
dis4 :: Pitch
eis4 :: Pitch
fis4 :: Pitch
gis4 :: Pitch
ais4 :: Pitch
bis4 :: Pitch
ceses4 :: Pitch
deses4 :: Pitch
eeses4 :: Pitch
feses4 :: Pitch
geses4 :: Pitch
aeses4 :: Pitch
beses4 :: Pitch
cisis4 :: Pitch
disis4 :: Pitch
eisis4 :: Pitch
fisis4 :: Pitch
gisis4 :: Pitch
aisis4 :: Pitch
bisis4 :: Pitch
ceseh4 :: Pitch
deseh4 :: Pitch
eeseh4 :: Pitch
feseh4 :: Pitch
geseh4 :: Pitch
aeseh4 :: Pitch
beseh4 :: Pitch
ceh4 :: Pitch
deh4 :: Pitch
eeh4 :: Pitch
feh4 :: Pitch
geh4 :: Pitch
aeh4 :: Pitch
beh4 :: Pitch
cih4 :: Pitch
dih4 :: Pitch
eih4 :: Pitch
fih4 :: Pitch
gih4 :: Pitch
aih4 :: Pitch
bih4 :: Pitch
cisih4 :: Pitch
disih4 :: Pitch
eisih4 :: Pitch
fisih4 :: Pitch
gisih4 :: Pitch
aisih4 :: Pitch
bisih4 :: Pitch
c5 :: Pitch
d5 :: Pitch
e5 :: Pitch
f5 :: Pitch
g5 :: Pitch
a5 :: Pitch
b5 :: Pitch
ces5 :: Pitch
des5 :: Pitch
ees5 :: Pitch
fes5 :: Pitch
ges5 :: Pitch
aes5 :: Pitch
bes5 :: Pitch
cis5 :: Pitch
dis5 :: Pitch
eis5 :: Pitch
fis5 :: Pitch
gis5 :: Pitch
ais5 :: Pitch
bis5 :: Pitch
ceses5 :: Pitch
deses5 :: Pitch
eeses5 :: Pitch
feses5 :: Pitch
geses5 :: Pitch
aeses5 :: Pitch
beses5 :: Pitch
cisis5 :: Pitch
disis5 :: Pitch
eisis5 :: Pitch
fisis5 :: Pitch
gisis5 :: Pitch
aisis5 :: Pitch
bisis5 :: Pitch
ceseh5 :: Pitch
deseh5 :: Pitch
eeseh5 :: Pitch
feseh5 :: Pitch
geseh5 :: Pitch
aeseh5 :: Pitch
beseh5 :: Pitch
ceh5 :: Pitch
deh5 :: Pitch
eeh5 :: Pitch
feh5 :: Pitch
geh5 :: Pitch
aeh5 :: Pitch
beh5 :: Pitch
cih5 :: Pitch
dih5 :: Pitch
eih5 :: Pitch
fih5 :: Pitch
gih5 :: Pitch
aih5 :: Pitch
bih5 :: Pitch
cisih5 :: Pitch
disih5 :: Pitch
eisih5 :: Pitch
fisih5 :: Pitch
gisih5 :: Pitch
aisih5 :: Pitch
bisih5 :: Pitch
c6 :: Pitch
d6 :: Pitch
e6 :: Pitch
f6 :: Pitch
g6 :: Pitch
a6 :: Pitch
b6 :: Pitch
ces6 :: Pitch
des6 :: Pitch
ees6 :: Pitch
fes6 :: Pitch
ges6 :: Pitch
aes6 :: Pitch
bes6 :: Pitch
cis6 :: Pitch
dis6 :: Pitch
eis6 :: Pitch
fis6 :: Pitch
gis6 :: Pitch
ais6 :: Pitch
bis6 :: Pitch
ceseh6 :: Pitch
deseh6 :: Pitch
eeseh6 :: Pitch
feseh6 :: Pitch
geseh6 :: Pitch
aeseh6 :: Pitch
beseh6 :: Pitch
ceh6 :: Pitch
deh6 :: Pitch
eeh6 :: Pitch
feh6 :: Pitch
geh6 :: Pitch
aeh6 :: Pitch
beh6 :: Pitch
cih6 :: Pitch
dih6 :: Pitch
eih6 :: Pitch
fih6 :: Pitch
gih6 :: Pitch
aih6 :: Pitch
bih6 :: Pitch
cisih6 :: Pitch
disih6 :: Pitch
eisih6 :: Pitch
fisih6 :: Pitch
gisih6 :: Pitch
aisih6 :: Pitch
bisih6 :: Pitch
c7 :: Pitch
d7 :: Pitch
e7 :: Pitch
f7 :: Pitch
g7 :: Pitch
a7 :: Pitch
b7 :: Pitch
ces7 :: Pitch
des7 :: Pitch
ees7 :: Pitch
fes7 :: Pitch
ges7 :: Pitch
aes7 :: Pitch
bes7 :: Pitch
cis7 :: Pitch
dis7 :: Pitch
eis7 :: Pitch
fis7 :: Pitch
gis7 :: Pitch
ais7 :: Pitch
bis7 :: Pitch
c8 :: Pitch
cis8 :: Pitch
d8 :: Pitch
-- | Constants names for notes. 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.Note.Name
ceses :: (Note_T, Alteration_T)
deses :: (Note_T, Alteration_T)
eeses :: (Note_T, Alteration_T)
feses :: (Note_T, Alteration_T)
geses :: (Note_T, Alteration_T)
aeses :: (Note_T, Alteration_T)
beses :: (Note_T, Alteration_T)
ceseh :: (Note_T, Alteration_T)
deseh :: (Note_T, Alteration_T)
eeseh :: (Note_T, Alteration_T)
feseh :: (Note_T, Alteration_T)
geseh :: (Note_T, Alteration_T)
aeseh :: (Note_T, Alteration_T)
beseh :: (Note_T, Alteration_T)
ces :: (Note_T, Alteration_T)
des :: (Note_T, Alteration_T)
ees :: (Note_T, Alteration_T)
fes :: (Note_T, Alteration_T)
ges :: (Note_T, Alteration_T)
aes :: (Note_T, Alteration_T)
bes :: (Note_T, Alteration_T)
ceh :: (Note_T, Alteration_T)
deh :: (Note_T, Alteration_T)
eeh :: (Note_T, Alteration_T)
feh :: (Note_T, Alteration_T)
geh :: (Note_T, Alteration_T)
aeh :: (Note_T, Alteration_T)
beh :: (Note_T, Alteration_T)
c :: (Note_T, Alteration_T)
d :: (Note_T, Alteration_T)
e :: (Note_T, Alteration_T)
f :: (Note_T, Alteration_T)
g :: (Note_T, Alteration_T)
a :: (Note_T, Alteration_T)
b :: (Note_T, Alteration_T)
cih :: (Note_T, Alteration_T)
dih :: (Note_T, Alteration_T)
eih :: (Note_T, Alteration_T)
fih :: (Note_T, Alteration_T)
gih :: (Note_T, Alteration_T)
aih :: (Note_T, Alteration_T)
bih :: (Note_T, Alteration_T)
cis :: (Note_T, Alteration_T)
dis :: (Note_T, Alteration_T)
eis :: (Note_T, Alteration_T)
fis :: (Note_T, Alteration_T)
gis :: (Note_T, Alteration_T)
ais :: (Note_T, Alteration_T)
bis :: (Note_T, Alteration_T)
cisih :: (Note_T, Alteration_T)
disih :: (Note_T, Alteration_T)
eisih :: (Note_T, Alteration_T)
fisih :: (Note_T, Alteration_T)
gisih :: (Note_T, Alteration_T)
aisih :: (Note_T, Alteration_T)
bisih :: (Note_T, Alteration_T)
cisis :: (Note_T, Alteration_T)
disis :: (Note_T, Alteration_T)
eisis :: (Note_T, Alteration_T)
fisis :: (Note_T, Alteration_T)
gisis :: (Note_T, Alteration_T)
aisis :: (Note_T, Alteration_T)
bisis :: (Note_T, Alteration_T)
-- | Simple table based spelling rules for common music notation.
module Music.Theory.Pitch.Spelling.Table
type Spelling_Table i = [(i, (Note_T, Alteration_T))]
-- | Spelling table for natural (♮) notes only.
pc_spell_natural_tbl :: Integral i => Spelling_Table i
-- | Spelling table for sharp (♯) notes only.
pc_spell_sharp_tbl :: Integral i => Spelling_Table i
-- | Spelling table for flat (♭) notes only.
pc_spell_flat_tbl :: Integral i => Spelling_Table i
-- | Spelling table 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.
pc_spell_ks_tbl :: Integral i => Spelling_Table i
pc_spell_tbl :: Integral i => Spelling_Table i -> Spelling i
-- | Spell using indicated table prepended to and
-- pc_spell_natural_tbl and pc_spell_ks_tbl
pc_spell_tbl_ks :: Integral i => Spelling_Table i -> Spelling i
-- | 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
-- | Lookup pc_spell_ks_tbl.
--
--
-- 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]
--
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
octpc_to_pitch_ks :: Integral i => Octave_PitchClass i -> Pitch
-- | midi_to_pitch pc_spell_ks.
midi_to_pitch_ks :: Integral i => i -> Pitch
fmidi_to_pitch_ks :: (Show n, RealFrac n) => n -> Pitch
midi_detune_to_pitch_ks :: Real c => Midi_Detune' c -> Pitch
-- | Spelling for chromatic clusters.
module Music.Theory.Pitch.Spelling.Cluster
-- | Form of cluster with smallest outer boundary interval.
--
--
-- cluster_normal_order [0,1,11] == [11,0,1]
--
cluster_normal_order :: [PitchClass] -> [PitchClass]
-- | Normal order starting in indicated octave.
--
--
-- cluster_normal_order_octpc 3 [0,1,11] == [(3,11),(4,0),(4,1)]
--
cluster_normal_order_octpc :: Octave -> [PitchClass] -> [OctPC]
-- | True if sort of cluster is not equal to
-- cluster_normal_order.
--
--
-- map cluster_is_multiple_octave [[0,1,11],[1,2,3],[1,2,11]] == [True,False,True]
--
cluster_is_multiple_octave :: [PitchClass] -> Bool
-- | Spelling table for chromatic and near-chromatic clusters,
-- pitch-classes are in cluster order.
--
--
-- let f (p,q) = (p == map T.note_alteration_to_pc_err q)
-- in all f spell_cluster_table
--
spell_cluster_table :: [([PitchClass], [(Note_T, Alteration_T)])]
spell_cluster :: [PitchClass] -> Maybe [(Note_T, Alteration_T)]
-- | Spell an arbitrary sequence of OctPC values.
--
--
-- fmap (map T.pitch_pp_iso) (spell_cluster_octpc [(3,11),(4,3),(4,11),(5,1)])
--
spell_cluster_octpc :: [OctPC] -> Maybe [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 T.pitch_pp) . spell_cluster_c4)
-- in map f [[11,0],[11]] == [Just ["B3","C4"],Just ["B4"]]
--
--
--
-- fmap (map T.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 T.pitch_pp) (spell_cluster_c 3 [11,0]) == Just ["B2","C3"]
-- fmap (map T.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 T.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 T.pitch_pp) (spell_cluster_left 3 [11,0]) == Just ["B3","C4"]
-- fmap (map T.pitch_pp) (spell_cluster_left 3 [10,11]) == Just ["A♯3","B3"]
--
spell_cluster_left :: Octave -> [PitchClass] -> Maybe [Pitch]
-- | Set operations on lists.
module Music.Theory.Set.List
-- | sort then nub.
--
--
-- set [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]]
-- | Variant where result is sorted and the empty set is not given.
--
--
-- powerset' [1,2,3] == [[1],[2],[3],[1,2],[1,3],[2,3],[1,2,3]]
--
powerset' :: Ord a => [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 "abc" "" == []
--
cartesian_product :: [a] -> [b] -> [(a, b)]
-- | List form of n-fold cartesian product.
--
--
-- length (nfold_cartesian_product [[1..13],[1..4]]) == 52
-- length (nfold_cartesian_product ["abc","de","fgh"]) == 3 * 2 * 3
--
nfold_cartesian_product :: [[a]] -> [[a]]
-- | 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)
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
-- | Bel(R) is a simplified form of the Bel notation
-- described in:
--
--
--
-- For details see http://rd.slavepianos.org/t/hmt-texts.
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 non-negative Integer.
--
--
-- P.parse p_non_negative_integer "" "3"
--
p_non_negative_integer :: P Integer
-- | Parse non-negative Rational.
--
--
-- P.parse (p_non_negative_rational `P.sepBy` (P.char ',')) "" "3%5,2/3"
--
p_non_negative_rational :: P Rational
-- | Parse non-negative Double.
--
--
-- P.parse p_non_negative_double "" "3.5"
-- P.parse (p_non_negative_double `P.sepBy` (P.char ',')) "" "3.5,7.2,1.0"
--
p_non_negative_double :: P Double
-- | Parse non-negative number as Rational.
--
--
-- P.parse (p_non_negative_number `P.sepBy` (P.char ',')) "" "7%2,3.5,3"
--
p_non_negative_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 GHC.Show.Show a => GHC.Show.Show (Music.Theory.Time.Bel1990.R.Bel a)
instance GHC.Classes.Eq a => GHC.Classes.Eq (Music.Theory.Time.Bel1990.R.Bel a)
instance GHC.Show.Show a => GHC.Show.Show (Music.Theory.Time.Bel1990.R.Term a)
instance GHC.Classes.Eq a => GHC.Classes.Eq (Music.Theory.Time.Bel1990.R.Term a)
instance GHC.Show.Show Music.Theory.Time.Bel1990.R.Par_Mode
instance GHC.Classes.Eq Music.Theory.Time.Bel1990.R.Par_Mode
-- | http://www.ivan-wyschnegradsky.fr/en/chromatic-drawings/
module Music.Theory.Wyschnegradsky
-- | In a modulo m system, normalise step increments to be either -1
-- or 1. Non steps raise an error.
--
--
-- map (normalise_step 6) [-5,-1,1,5] == [1,-1,1,-1]
--
normalise_step :: (Eq n, Num n) => n -> n -> n
-- | Wyschnegradsky writes the direction sign at the end of the number.
--
--
-- map parse_num_sign ["2+","4-"] == [2,-4]
--
parse_num_sign :: (Num n, Read n) => String -> n
-- | Expand a chromatic (step-wise) sequence, sign indicates direction.
--
--
-- map vec_expand [2,-4] == [[1,1],[-1,-1,-1,-1]]
--
vec_expand :: Num n => Int -> [n]
-- | Parse the vector notation used in some drawings, a comma separated
-- list of chromatic sequences.
--
--
-- parse_vec Nothing 0 "4-,4+,4-,4+,4-,4+,4-,4+,4-"
-- parse_vec Nothing 0 "2+,2-,2+,2-,2+,2-,2+,2-,2+,18+"
--
parse_vec :: Num n => Maybe Int -> n -> String -> [n]
-- | Modulo addition.
add_m :: Integral a => a -> a -> a -> a
-- | Parse hex colour string, as standard in HTML5.
--
--
-- parse_hex_clr "#e14630" == (225,70,48)
--
parse_hex_clr :: (Read n, Num n) => String -> (n, n, n)
-- | Type specialised.
parse_hex_clr_int :: String -> (Int, Int, Int)
-- | Normalise colour by dividing each component by m.
--
--
-- clr_normalise 255 (parse_hex_clr "#ff0066") == (1,0,0.4)
--
clr_normalise :: (Real r, Fractional f) => f -> (r, r, r) -> (f, f, f)
-- | Sequences are either in Radial or Circumferential order.
data Seq a
Radial :: [a] -> Seq a
Circumferential :: [a] -> Seq a
-- | Group sequence into normal (ie. Circumferential) order given
-- drawing dimensions.
seq_group :: Int -> Int -> Seq a -> [[a]]
-- | Printer for pitch-class segments.
iw_pc_pp :: Integral n => String -> [[n]] -> IO ()
-- | Index to colour name abbreviation.
--
--
-- map u3_ix_ch [0..5] == "ROYGBV"
--
u3_ix_ch :: Integral i => i -> Char
-- | Inverse of u3_ix_ch.
--
--
-- map u3_ch_ix "ROYGBV" == [0..5]
--
u3_ch_ix :: Char -> Int
-- | Drawing definition, as written by Wyschnegradsky.
--
--
-- mapM_ (\(c,r) -> putStrLn (unlines ["C: " ++ c,"R: " ++ r])) u3_vec_text_iw
--
u3_vec_text_iw :: [(String, String)]
-- | Re-written for local parser and to correct ambiguities and errors (to
-- align with actual drawing).
--
--
-- let f = parse_vec Nothing 0 in map (\(p,q) -> (f p,f q)) u3_vec_text_rw
--
--
--
-- let f (c,r) = putStrLn (unlines ["C: " ++ c,"R: " ++ r])
-- in mapM_ f (interleave u3_vec_text_iw u3_vec_text_rw)
--
u3_vec_text_rw :: [(String, String)]
-- | Parse of u3_vec_text_rw.
--
--
-- let {(c,r) = u3_vec_ix ; c' = map length c}
-- in (length c,c',sum c',length r,map length r)
--
u3_vec_ix :: Num n => ([[n]], [[n]])
-- | Radial indices (ie. each ray as an index sequence).
--
--
-- putStrLn $ unlines $ map (map u3_ix_ch) u3_ix_radial
--
u3_ix_radial :: Integral n => [[n]]
-- | Colour names in index sequence.
u3_clr_nm :: [String]
-- | Colour values (hex strings) in index sequence.
u3_clr_hex :: [String]
-- | RGB form of u3_clr_hex.
u3_clr_rgb :: Fractional n => [(n, n, n)]
-- | Notated radial color sequence, transcribed from drawing.
--
--
-- map (\(n,c) -> let v = u3_ch_seq_to_vec c in (n,sum v,v)) u3_radial_ch
--
u3_radial_ch :: [(Int, [Char])]
-- | Notated circumferenctial color sequence, transcribed from drawing.
--
--
-- map (\(n,c) -> (n,u3_ch_seq_to_vec c)) u3_circ_ch
--
u3_circ_ch :: [(Int, [Char])]
-- | Translate notated sequence to "re-written" vector notation.
u3_ch_seq_to_vec :: [Char] -> [Int]
-- | Circumference pitch classes, C = 0.
--
--
-- let c' = map length dc9_circ in (sum c',c') == (72,[5,6,7,2,3,4,4,3,2,7,7,4,4,3,2,2,3,4])
--
--
--
-- iw_pc_pp " | " dc9_circ
--
dc9_circ :: Num n => [[n]]
-- | Rayon pitch classes, C = 0.
--
--
-- length dc9_rad == 18
-- putStrLn $ unwords $ map f dc9_rad
--
dc9_rad :: Num n => [n]
-- | Radial indices.
--
--
-- map length dc9_ix == replicate 72 18
--
dc9_ix :: Integral n => [[n]]
-- | Approximate colours, hex strings.
dc9_clr_hex :: [String]
-- | RGB form of colours.
dc9_clr_rgb :: Fractional n => [(n, n, n)]
u11_circ :: Num n => [[n]]
u11_gen_seq :: Integral i => i -> Int -> [i] -> [i]
u11_seq_rule :: Integral i => Maybe Int -> [i]
ull_rad_text :: [Char]
u11_rad :: Integral n => [[n]]
u11_clr_hex :: [String]
u11_clr_rgb :: Fractional n => [(n, n, n)]
-- | "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
-- | Complement of a Sieve
Complement :: 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
infixl 3 ∪
-- | Unicode synonym for Intersection.
(∩) :: Sieve -> Sieve -> Sieve
infixl 4 ∩
-- | Synonym for Complement.
c :: Sieve -> Sieve
-- | Pretty-print sieve. Fully parenthesised.
sieve_pp :: Sieve -> String
-- | Variant of L, ie. curry L.
--
--
-- l 15 19 == L (15,19)
--
l :: I -> I -> Sieve
-- | unicode synonym for l.
(⋄) :: I -> I -> Sieve
infixl 5 ⋄
-- | In a normal Sieve m is > i.
--
--
-- normalise (L (15,19)) == L (15,4)
-- normalise (L (11,13)) == L (11,2)
--
normalise :: Sieve -> Sieve
-- | Predicate to test if a Sieve is normal.
--
--
-- is_normal (L (15,4)) == True
-- is_normal (L (11,13)) == False
--
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
i_complement :: [I] -> [I]
-- | 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
--
--
-- Agon et. al. p.155
--
--
-- let {a = c (13⋄3 ∪ 13⋄5 ∪ 13⋄7 ∪ 13⋄9)
-- ;b = 11⋄2
-- ;c' = c (11⋄4 ∪ 11⋄8)
-- ;d = 13⋄9
-- ;e = 13⋄0 ∪ 13⋄1 ∪ 13⋄6
-- ;f = (a ∩ b) ∪ (c' ∩ d) ∪ e}
-- in buildn 13 f == [0,1,2,6,9,13,14,19,22,24,26,27,32]
--
--
--
-- differentiate [0,1,2,6,9,13,14,19,22,24,26,27,32] == [1,1,4,3,4,1,5,3,2,2,1,5]
--
--
--
-- import Music.Theory.Pitch
--
--
--
-- let {n = [0,1,2,6,9,13,14,19,22,24,26,27,32]
-- ;r = "C C𝄲 C♯ D♯ E𝄲 F𝄰 G A𝄲 B C C♯ C𝄰 E"}
-- in unwords (map (pitch_class_pp . pc24et_to_pitch . (`mod` 24)) n) == r
--
--
-- Jonchaies
--
--
-- let s = map (17⋄) [0,1,4,5,7,11,12,16]
-- in differentiate (buildn 25 (union s))
--
--
-- Nekuïa
--
--
-- let s = [24⋄0,14⋄2,22⋄3,31⋄4,28⋄7,29⋄9,19⋄10,25⋄13,24⋄14,26⋄17,23⋄21
-- ,24⋄10,30⋄9,35⋄17,29⋄24,32⋄25,30⋄29,26⋄21,30⋄17,31⋄16]
-- in differentiate (buildn 24 (union s))
--
--
-- Major scale:
--
--
-- let s = (c(3⋄2) ∩ 4⋄0) ∪ (c(3⋄1) ∩ 4⋄1) ∪ (3⋄2 ∩ 4⋄2) ∪ (c(3⋄0) ∩ 4⋄3)
-- in buildn 7 s == [0,2,4,5,7,9,11]
--
--
-- Nomos Alpha:
--
-- let {s = (c (13⋄3 ∪ 13⋄5 ∪ 13⋄7 ∪ 13⋄9) ∩ 11⋄2) ∪ (c (11⋄4 ∪ 11⋄8) ∩
-- 13⋄9) ∪ (13⋄0 ∪ 13⋄1 ∪ 13⋄6) ;r =
-- [0,1,2,6,9,13,14,19,22,24,26,27,32,35,39,40,45,52,53,58,61,65,66,71,78,79,84,87,90,91,92,97]}
-- in buildn 32 s == r
--
-- Psappha (Flint):
--
--
-- let {s = union [(8⋄0∪8⋄1∪8⋄7)∩(5⋄1∪5⋄3)
-- ,(8⋄0∪8⋄1∪8⋄2)∩5⋄0
-- ,8⋄3∩(5⋄0∪5⋄1∪5⋄2∪5⋄3∪5⋄4)
-- ,8⋄4∩(5⋄0∪5⋄1∪5⋄2∪5⋄3∪5⋄4)
-- ,(8⋄5∪8⋄6)∩(5⋄2∪5⋄3∪5⋄4)
-- ,8⋄1∩5⋄2
-- ,8⋄6∩5⋄1]
-- ;r = [0,1,3,4,6,8,10,11,12
-- ,13,14,16,17,19,20,22,23,25
-- ,27,28,29,31,33,35,36,37,38]}
-- in buildn 27 s == r
--
--
-- À R. (Hommage à Maurice Ravel) (Squibbs, 1996)
--
--
-- let {s = union [8⋄0∩(11⋄0∪11⋄4∪11⋄5∪11⋄6∪11⋄10)
-- ,8⋄1∩(11⋄2∪11⋄3∪11⋄6∪11⋄7∪11⋄9)
-- ,8⋄2∩(11⋄0∪11⋄1∪11⋄2∪11⋄3∪11⋄5∪11⋄10)
-- ,8⋄3∩(11⋄1∪11⋄2∪11⋄3∪11⋄4∪11⋄10)
-- ,8⋄4∩(11⋄0∪11⋄4∪11⋄8)
-- ,8⋄5∩(11⋄0∪11⋄2∪11⋄3∪11⋄7∪11⋄9∪11⋄10)
-- ,8⋄6∩(11⋄1∪11⋄3∪11⋄5∪11⋄7∪11⋄8∪11⋄9)
-- ,8⋄7∩(11⋄1∪11⋄3∪11⋄6∪11⋄7∪11⋄8∪11⋄10)]
-- ;r = [0,2,3,4,7,9,10,13,14,16
-- ,17,21,23,25,29,30,32,34,35,38
-- ,39,43,44,47,48,52,53,57,58,59
-- ,62,63,66,67,69,72,73,77,78,82
-- ,86,87]}
-- in buildn 42 s == 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)
--
--
--
-- putStrLn $ sieve_pp (reduce s)
--
--
--
-- 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 GHC.Show.Show Music.Theory.Xenakis.Sieve.Sieve
instance GHC.Classes.Eq Music.Theory.Xenakis.Sieve.Sieve
-- | Z-n functions with modulo function as parameter.
module Music.Theory.Z
-- | The modulo function for Z.
type Z t = t -> t
-- | Is n in (0,m-1).
is_z_n :: (Num a, Ord a) => a -> a -> Bool
mod5 :: Integral i => Z i
mod7 :: Integral i => Z i
mod12 :: Integral i => Z i
lift_unary_Z :: Z i -> (t -> i) -> t -> i
lift_binary_Z :: Z i -> (s -> t -> i) -> s -> t -> i
z_add :: Integral i => Z i -> i -> i -> i
-- | The underlying type i is presumed to be signed...
--
--
-- z_sub mod12 0 8 == 4
--
--
--
-- import Data.Word
-- z_sub mod12 (0::Word8) 8 == 8
-- ((0 - 8) :: Word8) == 248
-- 248 `mod` 12 == 8
--
z_sub :: Integral i => Z i -> i -> i -> i
-- | Allowing unsigned i is rather inefficient... z_sub :: Integral
-- i => Z i -> i -> i -> i z_sub z p q = if p > q then z
-- (p - q) else let m = z_modulus z in z (p + m - q)
z_mul :: Integral i => Z i -> i -> i -> i
z_negate :: Integral i => Z i -> i -> i
z_fromInteger :: Integral i => Z i -> Integer -> i
z_signum :: t -> u -> v
z_abs :: t -> u -> v
to_Z :: Integral i => Z i -> i -> i
from_Z :: (Integral i, Num n) => i -> n
-- | Modulus of z.
--
--
-- z_modulus mod12 == 12
--
z_modulus :: Integral i => Z i -> i
-- | Universe of Z.
--
--
-- z_univ mod12 == [0..11]
--
z_univ :: Integral i => Z i -> [i]
-- | Z of z_univ not in given set.
--
--
-- z_complement mod5 [0,2,3] == [1,4]
-- z_complement mod12 [0,2,4,5,7,9,11] == [1,3,6,8,10]
--
z_complement :: Integral i => Z i -> [i] -> [i]
z_quot :: Integral i => Z i -> i -> i -> i
z_rem :: Integral i => Z i -> i -> i -> i
div_err :: Integral i => String -> i -> i -> i
z_div :: Integral i => Z i -> i -> i -> i
z_mod :: Integral i => Z i -> i -> i -> i
z_quotRem :: Integral i => Z i -> i -> i -> (i, i)
z_divMod :: Integral i => Z i -> i -> i -> (i, i)
z_toInteger :: Integral i => Z i -> i -> i
mod16 :: Integral i => Z i
integral_to_digit :: Integral t => t -> Char
is_z16 :: Integral t => t -> Bool
z16_to_char :: Integral t => t -> Char
z16_set_pp :: Integral t => [t] -> String
z16_seq_pp :: Integral t => [t] -> String
z16_vec_pp :: Integral t => [t] -> String
module Music.Theory.Z.TTO
-- | Twelve-tone operator, of the form TMI.
data TTO t
TTO :: t -> Bool -> Bool -> TTO t
[tto_T] :: TTO t -> t
[tto_M] :: TTO t -> Bool
[tto_I] :: TTO t -> Bool
tto_identity :: Num t => TTO t
-- | Pretty printer.
tto_pp :: Show t => TTO t -> String
p_tto :: Integral t => GenParser Char () (TTO t)
-- | Parser, transposition must be decimal.
--
--
-- map (tto_pp . tto_parse) (words "T5 T3I T11M T9MI")
--
tto_parse :: Integral i => String -> TTO i
-- | The set of all TTO, given Z function.
--
--
-- length (z_tto_univ mod12) == 48
-- map tto_pp (z_tto_univ mod12)
--
z_tto_univ :: Integral t => Z t -> [TTO t]
-- | M is ordinarily 5, but can be specified here.
--
--
-- map (z_tto_f 5 mod12 (tto_parse "T1M")) [0,1,2,3] == [1,6,11,4]
--
z_tto_f :: Integral t => t -> Z t -> TTO t -> (t -> t)
-- | sort of map z_tto_f.
--
--
-- z_tto_apply 5 mod12 (tto_parse "T1M") [0,1,2,3] == [1,4,6,11]
--
z_tto_apply :: Integral t => t -> Z t -> TTO t -> [t] -> [t]
tto_apply :: Integral t => t -> TTO t -> [t] -> [t]
-- | Find TTO that that map x to y given m and
-- z.
--
--
-- map tto_pp (z_tto_rel 5 mod12 [0,1,2,3] [6,4,1,11]) == ["T1M","T4MI"]
--
z_tto_rel :: (Ord t, Integral t) => t -> Z t -> [t] -> [t] -> [TTO t]
-- | nub of sort of map z.
--
--
-- map (z_pcset mod12) [[0,6],[6,12],[12,18]] == replicate 3 [0,6]
--
z_pcset :: Ord t => Z t -> [t] -> [t]
instance GHC.Show.Show t => GHC.Show.Show (Music.Theory.Z.TTO.TTO t)
instance GHC.Classes.Eq t => GHC.Classes.Eq (Music.Theory.Z.TTO.TTO t)
-- | John Clough. "Aspects of Diatonic Sets". _Journal of Music Theory_,
-- 23(1):45--61, 1979.
module Music.Theory.Z.Clough_1979
transpose_to_zero :: Num n => [n] -> [n]
-- | Diatonic pitch class (Z7) set to chord.
--
--
-- map dpcset_to_chord [[0,1],[0,2,4],[2,3,4,5,6]] == [[1,6],[2,2,3],[1,1,1,1,3]]
--
dpcset_to_chord :: Integral n => [n] -> [n]
-- | Inverse of dpcset_to_chord.
--
--
-- map chord_to_dpcset [[1,6],[2,2,3]] == [[0,1],[0,2,4]]
--
chord_to_dpcset :: Integral n => [n] -> [n]
-- | Complement, ie. in relation to z7_univ.
--
--
-- map dpcset_complement [[0,1],[0,2,4]] == [[2,3,4,5,6],[1,3,5,6]]
--
dpcset_complement :: Integral n => [n] -> [n]
-- | Interval class predicate (ie. is_z4).
is_ic :: Integral n => n -> Bool
-- | Interval to interval class.
--
--
-- map i_to_ic [0..7] == [0,1,2,3,3,2,1,0]
--
i_to_ic :: Integral n => n -> n
-- | Is chord, ie. is sum 7.
--
--
-- is_chord [2,2,3]
--
is_chord :: Integral n => [n] -> Bool
-- | Interval vector.
--
--
-- iv [2,2,3] == [0,2,1]
--
iv :: Integral n => [n] -> [n]
-- | Comparison function for inv.
inf_cmp :: Ord a => [a] -> [a] -> Ordering
-- | Interval normal form.
--
--
-- map inf [[2,2,3],[1,2,4],[2,1,4]] == [[2,2,3],[1,2,4],[2,1,4]]
--
inf :: Integral n => [n] -> [n]
-- | Inverse of chord (retrograde).
--
--
-- let p = [1,2,4] in (inf p,invert p,inf (invert p)) == ([1,2,4],[4,2,1],[2,1,4])
--
invert :: [n] -> [n]
-- | Complement of chord.
--
--
-- let r = [[1,1,1,1,3],[1,1,1,2,2],[1,1,2,1,2],[1,1,1,4],[2,1,1,3],[1,2,1,3],[1,2,2,2]]
-- in map complement [[1,6],[2,5],[3,4],[1,1,5],[1,2,4],[1,3,3],[2,2,3]] == r
--
complement :: Integral n => [n] -> [n]
-- | Z7 pitch sequence to Z7 interval sequence, ie. mod7 of
-- d_dx.
--
--
-- map iseq (permutations [0,1,2]) == [[1,1],[6,2],[6,6],[1,5],[5,1],[2,6]]
-- map iseq (permutations [0,1,3]) == [[1,2],[6,3],[5,6],[2,4],[4,1],[3,5]]
-- map iseq (permutations [0,2,3]) == [[2,1],[5,3],[6,5],[1,4],[4,2],[3,6]]
-- map iseq (permutations [0,1,4]) == [[1,3],[6,4],[4,6],[3,3],[3,1],[4,4]]
-- map iseq (permutations [0,2,4]) == [[2,2],[5,4],[5,5],[2,3],[3,2],[4,5]]
--
iseq :: Integral n => [n] -> [n]
is_z_n :: Integral n => n -> n -> Bool
is_z4 :: Integral n => n -> Bool
z_n_univ :: Integral n => n -> [n]
z7_univ :: Integral n => [n]
is_z7 :: Integral n => n -> Bool
mod7 :: Integral n => n -> n
-- | Serial (ordered) pitch-class operations on Z.
module Music.Theory.Z.SRO
-- | Serial operator,of the form rRTMI.
data SRO t
SRO :: Int -> Bool -> t -> Bool -> Bool -> SRO t
[sro_r] :: SRO t -> Int
[sro_R] :: SRO t -> Bool
[sro_T] :: SRO t -> t
[sro_M] :: SRO t -> Bool
[sro_I] :: SRO t -> Bool
-- | Printer in rnRTnMI form.
sro_pp :: Show t => SRO t -> String
p_sro :: Integral t => GenParser Char () (SRO t)
-- | Parse a Morris format serial operator descriptor.
--
--
-- sro_parse "r2RT3MI" == SRO 2 True 3 True True
--
sro_parse :: Integral i => String -> SRO i
-- | The total set of serial operations.
--
--
-- let u = z_sro_univ 3 mod12
-- zip (map sro_pp u) (map (\o -> z_sro_apply 5 mod12 o [0,1,3]) u)
--
z_sro_univ :: Integral i => Int -> Z i -> [SRO i]
-- | The set of transposition SROs.
z_sro_Tn :: Integral i => Z i -> [SRO i]
-- | The set of transposition and inversion SROs.
z_sro_TnI :: Integral i => Z i -> [SRO i]
-- | The set of retrograde and transposition and inversion SROs.
z_sro_RTnI :: Integral i => Z i -> [SRO i]
-- | The set of transposition, M5 and inversion SROs.
z_sro_TnMI :: Integral i => Z i -> [SRO i]
-- | The set of retrograde,transposition,M5 and inversion
-- SROs.
z_sro_RTnMI :: Integral i => Z i -> [SRO i]
-- | Apply SRO. M is ordinarily 5, but can be specified here.
--
--
-- z_sro_apply 5 mod12 (SRO 1 True 1 True False) [0,1,2,3] == [11,6,1,4]
-- z_sro_apply 5 mod12 (SRO 1 False 4 True True) [0,1,2,3] == [11,6,1,4]
--
z_sro_apply :: Integral i => i -> Z i -> SRO i -> [i] -> [i]
-- | Transpose p by n.
--
--
-- z_sro_tn mod5 4 [0,1,4] == [4,0,3]
-- z_sro_tn mod12 4 [1,5,6] == [5,9,10]
--
z_sro_tn :: (Integral i, Functor f) => Z i -> i -> f i -> f i
-- | Invert p about n.
--
--
-- z_sro_invert mod5 0 [0,1,4] == [0,4,1]
-- z_sro_invert mod12 6 [4,5,6] == [8,7,6]
-- z_sro_invert mod12 0 [0,1,3] == [0,11,9]
--
--
--
-- import Data.Word {- base -}
-- z_sro_invert mod12 (0::Word8) [1,4,8]
--
z_sro_invert :: (Integral i, Functor f) => Z i -> i -> f i -> f i
-- | Composition of invert about 0 and tn.
--
--
-- z_sro_tni mod5 1 [0,1,3] == [1,0,3]
-- z_sro_tni mod12 4 [1,5,6] == [3,11,10]
-- (z_sro_invert mod12 0 . z_sro_tn mod12 4) [1,5,6] == [7,3,2]
--
z_sro_tni :: (Integral i, Functor f) => Z i -> i -> f i -> f i
-- | Modulo multiplication.
--
--
-- z_sro_mn mod12 11 [0,1,4,9] == z_tni mod12 0 [0,1,4,9]
--
z_sro_mn :: (Integral i, Functor f) => Z i -> i -> f i -> f i
-- | T-related sequences of p.
--
--
-- length (z_sro_t_related mod12 [0,3,6,9]) == 12
-- z_sro_t_related mod5 [0,2] == [[0,2],[1,3],[2,4],[3,0],[4,1]]
--
z_sro_t_related :: (Integral i, Functor f) => Z i -> f i -> [f i]
-- | T/I-related sequences of p.
--
--
-- length (z_sro_ti_related mod12 [0,1,3]) == 24
-- length (z_sro_ti_related mod12 [0,3,6,9]) == 24
-- z_sro_ti_related mod12 [0] == map return [0..11]
--
z_sro_ti_related :: (Eq (f i), Integral i, Functor f) => Z i -> f i -> [f i]
-- | R/T/I-related sequences of p.
--
--
-- length (z_sro_rti_related mod12 [0,1,3]) == 48
-- length (z_sro_rti_related mod12 [0,3,6,9]) == 24
--
z_sro_rti_related :: Integral i => Z i -> [i] -> [[i]]
-- | Variant of tn, transpose p so first element is
-- n.
--
--
-- z_sro_tn_to mod12 5 [0,1,3] == [5,6,8]
-- map (z_sro_tn_to mod12 0) [[0,1,3],[1,3,0],[3,0,1]]
--
z_sro_tn_to :: Integral i => Z i -> i -> [i] -> [i]
-- | Variant of invert, inverse about nth element.
--
--
-- map (z_sro_invert_ix mod12 0) [[0,1,3],[3,4,6]] == [[0,11,9],[3,2,0]]
-- map (z_sro_invert_ix mod12 1) [[0,1,3],[3,4,6]] == [[2,1,11],[5,4,2]]
--
z_sro_invert_ix :: Integral i => Z i -> Int -> [i] -> [i]
-- | The standard t-matrix of p.
--
--
-- z_tmatrix mod12 [0,1,3] == [[0,1,3],[11,0,2],[9,10,0]]
--
z_tmatrix :: Integral i => Z i -> [i] -> [[i]]
instance GHC.Show.Show t => GHC.Show.Show (Music.Theory.Z.SRO.SRO t)
instance GHC.Classes.Eq t => GHC.Classes.Eq (Music.Theory.Z.SRO.SRO t)
module Music.Theory.Z.Drape_1999
-- | Relate sets (TnMI).
--
--
-- >>> $ pct rs 0123 641B
--
-- >>> T1M
--
--
--
-- map tto_pp (rs 5 mod12 [0,1,2,3] [6,4,1,11]) == ["T1M","T4MI"]
--
rs :: Integral t => t -> Z t -> [t] -> [t] -> [TTO t]
-- | Relate segments.
--
--
-- >>> $ pct rsg 156 3BA
--
-- >>> T4I
--
-- >>> $ pct rsg 0123 05A3
--
-- >>> T0M
--
-- >>> $ pct rsg 0123 4B61
--
-- >>> RT1M
--
-- >>> $ pct rsg 0123 B614
--
-- >>> r3RT1M
--
--
--
-- let sros = map sro_parse . words
-- rsg 5 mod12 [1,5,6] [3,11,10] == sros "T4I r1RT4MI"
-- rsg 5 mod12 [0,1,2,3] [0,5,10,3] == sros "T0M RT3MI"
-- rsg 5 mod12 [0,1,2,3] [4,11,6,1] == sros "T4MI RT1M"
-- rsg 5 mod12 [0,1,2,3] [11,6,1,4] == sros "r1T4MI r1RT1M"
--
rsg :: Integral i => i -> Z i -> [i] -> [i] -> [SRO 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]
-- 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] == 2880
-- map (set_to_code 12) (T.z_ti_related (flip mod 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 Z.mod12 [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 => Z i -> [i] -> [i]
-- | Z12
--
-- Z12 are modulo 12 integers.
--
--
-- map signum [-1,0::Z12,1] == [1,0,1]
-- map abs [-1,0::Z12,1] == [11,0,1]
--
--
-- Aspects of the Enum instance are cyclic.
--
--
-- pred (0::Z12) == 11
-- succ (11::Z12) == 0
--
--
-- Bounded works
--
--
-- [minBound::Z12 .. maxBound] == [0::Z12 .. 11]
--
module Music.Theory.Z12
-- | Mod Int.
type Z n = Mod Int n
-- | Z 12.
--
--
-- map negate [0::Z12 .. 0xB] == [0,0xB,0xA,9,8,7,6,5,4,3,2,1]
-- map (+ 5) [0::Z12 .. 11] == [5,6,7,8,9,0xA,0xB,0,1,2,3,4]
--
type Z12 = Mod Int 12
-- | Cyclic form of enumFromThenTo.
--
--
-- [9::Z12,11 .. 3] == []
-- enumFromThenTo_cyc (9::Z12) 11 3 == [9,11,1,3]
--
enumFromThenTo_cyc :: KnownNat n => Z n -> Z n -> Z n -> [Z n]
-- | Cyclic form of enumFromTo.
--
--
-- [9::Z12 .. 3] == []
-- enumFromTo_cyc (9::Z12) 3 == [9,10,11,0,1,2,3]
--
enumFromTo_cyc :: KnownNat n => Z n -> Z n -> [Z n]
-- | Convert integral to Z12.
--
--
-- map to_Z12 [-9,-3,0,13] == [3,9,0,1]
--
to_Z12 :: Integral i => i -> Z12
int_to_Z12 :: Int -> Z12
-- | Convert Z12 to integral.
from_Z12 :: Integral i => Z12 -> i
int_from_Z12 :: Z12 -> Int
-- | Z12 not in set.
--
--
-- complement [0,2,4,5,7,9,11] == [1,3,6,8,10]
--
complement :: [Z12] -> [Z12]
-- | Z12 to character (10 -> A, 11 -> B).
--
--
-- map z12_to_char [0 .. 11] == "0123456789AB"
--
z12_to_char :: Z12 -> Char
-- | Z12 to character (10 -> A, 11 -> B).
--
--
-- map char_to_z12 "0123456789AB" == [0..11]
--
char_to_z12 :: Char -> Z12
-- | Unordered set notation (braces).
--
--
-- z12_set_pp [0,1,3] == "{013}"
--
z12_set_pp :: [Z12] -> String
-- | Ordered sequence notation (angle brackets).
--
--
-- z12_seq_pp [0,1,3] == "<013>"
--
z12_seq_pp :: [Z12] -> String
-- | Ordered vector notation (square brackets).
--
--
-- z12_vec_pp [0,1,3] == "[013]"
--
z12_vec_pp :: [Z12] -> String
-- | Parsers for pitch class sets and sequences, and for SROs.
module Music.Theory.Z12.Morris_1987.Parse
-- | 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]
-- | 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]
-- | 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.
--
--
-- tto_tn 4 [1,5,6] == [5,9,10]
-- tto_tn 4 [0,4,8] == [0,4,8]
--
tto_tn :: Z12 -> [Z12] -> [Z12]
-- | Invert about n.
--
--
-- tto_invert 6 [4,5,6] == [6,7,8]
-- tto_invert 0 [0,1,3] == [0,9,11]
--
tto_invert :: Z12 -> [Z12] -> [Z12]
-- | Composition of invert about 0 and tn.
--
--
-- tto_tni 4 [1,5,6] == [3,10,11]
-- (tto_invert 0 . tto_tn 4) [1,5,6] == [2,3,7]
--
tto_tni :: Z12 -> [Z12] -> [Z12]
-- | Modulo 12 multiplication
--
--
-- tto_mn 11 [0,1,4,9] == tto_invert 0 [0,1,4,9]
--
tto_mn :: Z12 -> [Z12] -> [Z12]
-- | M5, ie. mn 5.
--
--
-- tto_m5 [0,1,3] == [0,3,5]
--
tto_m5 :: [Z12] -> [Z12]
-- | T-related sets of p.
--
--
-- length (tto_t_related [0,1,3]) == 12
-- tto_t_related [0,3,6,9] == [[0,3,6,9],[1,4,7,10],[2,5,8,11]]
--
tto_t_related :: [Z12] -> [[Z12]]
-- | T/I-related set of p.
--
--
-- length (tto_ti_related [0,1,3]) == 24
-- tto_ti_related [0,3,6,9] == [[0,3,6,9],[1,4,7,10],[2,5,8,11]]
--
tto_ti_related :: [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 (ordered) pitch-class operations on Z12.
module Music.Theory.Z12.SRO
-- | Transpose p by n.
--
--
-- sro_tn 4 [1,5,6] == [5,9,10]
--
sro_tn :: Z12 -> [Z12] -> [Z12]
-- | Invert p about n.
--
--
-- sro_invert 6 [4,5,6] == [8,7,6]
-- sro_invert 0 [0,1,3] == [0,11,9]
--
sro_invert :: Z12 -> [Z12] -> [Z12]
-- | Composition of invert about 0 and tn.
--
--
-- tni 4 [1,5,6] == [3,11,10]
-- (sro_invert 0 . sro_tn 4) [1,5,6] == [7,3,2]
--
sro_tni :: Z12 -> [Z12] -> [Z12]
-- | Modulo 12 multiplication
--
--
-- sro_mn 11 [0,1,4,9] == sro_tni 0 [0,1,4,9]
--
sro_mn :: Z12 -> [Z12] -> [Z12]
-- | M5, ie. mn 5.
--
--
-- sro_m5 [0,1,3] == [0,5,3]
--
sro_m5 :: [Z12] -> [Z12]
-- | T-related sequences of p.
--
--
-- length (sro_t_related [0,3,6,9]) == 12
--
sro_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]
--
sro_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
--
sro_rti_related :: [Z12] -> [[Z12]]
-- | T/M/I-related sequences of p, duplicates removed.
sro_tmi_related :: [Z12] -> [[Z12]]
-- | R/T/M/I-related sequences of p, duplicates removed.
sro_rtmi_related :: [Z12] -> [[Z12]]
-- | r/R/T/M/I-related sequences of p, duplicates removed.
sro_rrtmi_related :: [Z12] -> [[Z12]]
-- | Variant of tn, transpose p so first element is
-- n.
--
--
-- sro_tn_to 5 [0,1,3] == [5,6,8]
-- map (sro_tn_to 0) [[0,1,3],[1,3,0],[3,0,1]] == [[0,1,3],[0,2,11],[0,9,10]]
--
sro_tn_to :: Z12 -> [Z12] -> [Z12]
-- | Variant of invert, inverse about nth element.
--
--
-- map (sro_invert_ix 0) [[0,1,3],[3,4,6]] == [[0,11,9],[3,2,0]]
-- map (sro_invert_ix 1) [[0,1,3],[3,4,6]] == [[2,1,11],[5,4,2]]
--
sro_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]]
-- | 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
-- | 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 ord_invert 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
-- | error variant.
parse_interval_err :: String -> 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 GHC.Show.Show Music.Theory.Interval.Interval
instance GHC.Classes.Eq Music.Theory.Interval.Interval
instance GHC.Show.Show Music.Theory.Interval.Interval_Q
instance GHC.Classes.Ord Music.Theory.Interval.Interval_Q
instance GHC.Enum.Bounded Music.Theory.Interval.Interval_Q
instance GHC.Enum.Enum Music.Theory.Interval.Interval_Q
instance GHC.Classes.Eq Music.Theory.Interval.Interval_Q
instance GHC.Show.Show Music.Theory.Interval.Interval_T
instance GHC.Classes.Ord Music.Theory.Interval.Interval_T
instance GHC.Enum.Bounded Music.Theory.Interval.Interval_T
instance GHC.Enum.Enum Music.Theory.Interval.Interval_T
instance GHC.Classes.Eq Music.Theory.Interval.Interval_T
-- | Constants names for ascending Interval values.
module Music.Theory.Interval.Name
perfect_fourth :: Interval
perfect_fifth :: Interval
major_seventh :: 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
-- | Pretty printer for Mode_T.
mode_pp :: Mode_T -> String
-- | Lower-cased mode_pp.
mode_identifier_pp :: Mode_T -> String
-- | There are two modes, given one return the other.
mode_parallel :: Mode_T -> Mode_T
mode_pc_seq :: Num t => Mode_T -> [t]
-- | A common music notation key is a Note_T,
-- Alteration_T, Mode_T triple.
type Key = (Note_T, Alteration_T, Mode_T)
-- | Mode_T of Key.
key_mode :: Key -> Mode_T
-- | Enumeration of 42 CMN keys.
--
--
-- length key_sequence_42 == 7 * 3 * 2
--
key_sequence_42 :: [Key]
-- | Subset of key_sequence not including very eccentric keys
-- (where there are more than 7 alterations).
--
--
-- length key_sequence_30 == 30
--
key_sequence_30 :: [Key]
-- | Parallel key, ie. mode_parallel of Key.
key_parallel :: Key -> Key
-- | Transposition of Key.
key_transpose :: Key -> Int -> Key
-- | Relative key (ie. mode_parallel with the same number of and
-- type of alterations.
--
--
-- let k = [(T.C,T.Natural,Major_Mode),(T.E,T.Natural,Minor_Mode)]
-- in map (key_lc_uc_pp . key_relative) k == ["a♮","G♮"]
--
key_relative :: Key -> Key
-- | Mediant minor of major key.
--
--
-- key_mediant (T.C,T.Natural,Major_Mode) == Just (T.E,T.Natural,Minor_Mode)
--
key_mediant :: Key -> Maybe Key
key_pc_set :: Integral i => Key -> [i]
-- | Pretty-printer where Minor_Mode is written in lower case (lc)
-- and alteration symbol is shown using indicated function.
key_lc_pp :: (Alteration_T -> String) -> Key -> String
-- | key_lc_pp with unicode (uc) alteration.
--
--
-- map key_lc_uc_pp [(C,Sharp,Minor_Mode),(E,Flat,Major_Mode)] == ["c♯","E♭"]
--
key_lc_uc_pp :: Key -> String
-- | key_lc_pp with ISO alteration.
key_lc_iso_pp :: Key -> String
-- | key_lc_pp with tonh alteration.
--
--
-- map key_lc_tonh_pp [(T.C,T.Sharp,Minor_Mode),(T.E,T.Flat,Major_Mode)]
--
key_lc_tonh_pp :: Key -> String
key_identifier_pp :: (Show a, Show a1) => (a, a1, Mode_T) -> [Char]
note_char_to_key :: Char -> Maybe Key
-- | Parse Key from lc-uc string.
--
--
-- import Data.Maybe
--
--
--
-- let k = mapMaybe key_lc_uc_parse ["c","E","f♯","ab","G#"]
-- in map key_lc_uc_pp k == ["c♮","E♮","f♯","a♭","G♯"]
--
key_lc_uc_parse :: String -> Maybe Key
-- | 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 (T.A,T.Natural,Minor_Mode) == Just 0
-- key_fifths (T.A,T.Natural,Major_Mode) == Just 3
-- key_fifths (T.C,T.Natural,Minor_Mode) == Just (-3)
-- key_fifths (T.B,T.Sharp,Minor_Mode) == Just 9
-- key_fifths (T.E,T.Sharp,Major_Mode) == Just 11
-- key_fifths (T.B,T.Sharp,Major_Mode) == Nothing
--
--
--
-- zip (map key_lc_iso_pp key_sequence_42) (map key_fifths key_sequence_42)
--
key_fifths :: Key -> Maybe Int
-- | Table mapping Key to key_fifths value.
key_fifths_tbl :: [(Key, Int)]
-- | Lookup key_fifths value in key_fifths_tbl.
--
--
-- let a = [0,1,-1,2,-2,3,-3,4,-4,5,-5]
-- let f md = map key_lc_iso_pp . mapMaybe (fifths_to_key md)
-- f Minor_Mode a
-- f Major_Mode a
--
fifths_to_key :: Mode_T -> Int -> Maybe Key
-- | Given sorted pitch-class set, find simplest implied key in given mode.
--
--
-- mapMaybe (implied_key Major_Mode) [[0,2,4],[1,3],[4,10],[3,9],[8,9]]
-- map (implied_key Major_Mode) [[0,1,2],[0,1,3,4]] == [Nothing,Nothing]
--
implied_key :: Integral i => Mode_T -> [i] -> Maybe Key
-- | key_fifths of implied_key.
implied_fifths :: Integral i => Mode_T -> [i] -> Maybe Int
implied_key_err :: Integral i => Mode_T -> [i] -> Key
implied_fifths_err :: Integral i => Mode_T -> [i] -> Int
instance GHC.Show.Show Music.Theory.Key.Mode_T
instance GHC.Classes.Ord Music.Theory.Key.Mode_T
instance GHC.Classes.Eq Music.Theory.Key.Mode_T
module Music.Theory.Pitch.Chord
type PC = (Note_T, Alteration_T)
pc_pp :: (Note_T, Alteration_T) -> [Char]
-- | D = dominant, M = major
data Extension
D7 :: Extension
M7 :: Extension
extension_tbl :: Num n => [(Extension, (String, n))]
extension_dat :: Num n => Extension -> (String, n)
extension_pp :: Extension -> String
extension_to_pc :: Num n => Extension -> n
data Chord_Type
Major :: Chord_Type
Minor :: Chord_Type
Augmented :: Chord_Type
Diminished :: Chord_Type
Diminished_7 :: Chord_Type
Half_Diminished :: Chord_Type
Suspended_2 :: Chord_Type
Suspended_4 :: Chord_Type
is_suspended :: Chord_Type -> Bool
-- | Names and pc-sets for chord types. The name used here is in the first
-- position, alternates follow.
chord_type_tbl :: Num n => [(Chord_Type, ([String], [n]))]
chord_type_dat :: Num n => Chord_Type -> ([String], [n])
chord_type_pp :: Chord_Type -> String
chord_type_pcset :: Num n => Chord_Type -> [n]
data Chord
CH :: PC -> Chord_Type -> (Maybe Extension) -> (Maybe PC) -> Chord
chord_pcset :: Chord -> (Maybe Int, [Int])
bass_pp :: PC -> String
chord_pp :: Chord -> String
type P a = GenParser Char () a
m_error :: String -> Maybe a -> a
p_note_t :: P Note_T
p_alteration_t_iso :: P Alteration_T
p_pc :: P PC
p_mode_m :: P Mode_T
p_chord_type :: P Chord_Type
p_extension :: P Extension
p_bass :: P (Maybe PC)
p_chord :: P Chord
parse_chord :: String -> Chord
instance GHC.Show.Show Music.Theory.Pitch.Chord.Chord
instance GHC.Show.Show Music.Theory.Pitch.Chord.Chord_Type
instance GHC.Classes.Eq Music.Theory.Pitch.Chord.Chord_Type
instance GHC.Show.Show Music.Theory.Pitch.Chord.Extension
instance GHC.Classes.Eq Music.Theory.Pitch.Chord.Extension
module Music.Theory.Pitch.Spelling.Key
pcset_spell_implied_key_f :: Integral i => [i] -> Maybe (Spelling i)
pcset_spell_implied_key :: Integral i => [i] -> Maybe [(Note_T, Alteration_T)]
octpc_spell_implied_key :: [OctPC] -> Maybe [Pitch]
midi_spell_implied_key :: [Midi] -> Maybe [Pitch]
-- | Spelling rules for common music notation.
module Music.Theory.Pitch.Spelling
spell_octpc_set :: [OctPC] -> [Pitch]
spell_midi_set :: [Midi] -> [Pitch]
module Music.Theory.Instrument.Names
instrument_db' :: [(String, String, String, String)]
instrument_db :: [(String, [String], [String], [String])]
-- | System.IO related functions.
module Music.Theory.IO
-- | decodeUtf8 of readFile.
read_file_utf8_text :: FilePath -> IO Text
-- | Read (strictly) a UTF-8 encoded text file, implemented via
-- Data.Text.
read_file_utf8 :: FilePath -> IO String
-- | read_file_utf8, or a default value if the file doesn't exist.
read_file_utf8_or :: String -> FilePath -> IO String
-- | Write UTF8 string as file, via Data.Text.
write_file_utf8 :: FilePath -> String -> IO ()
-- | readFile variant using Text for ISO 8859-1
-- (Latin 1) encoding.
read_file_iso_8859_1 :: FilePath -> IO String
-- | readFile variant using Text for local encoding.
read_file_locale :: FilePath -> IO String
-- | http://www.unicode.org/charts/PDF/U1D100.pdf
--
-- These symbols are in http://www.gnu.org/software/freefont/,
-- debian=ttf-freefont.
module Music.Theory.Unicode
-- | Unicode non breaking hypen character.
--
--
-- non_breaking_hypen == '‑'
--
non_breaking_hypen :: Char
-- | Unicode non breaking space character.
--
--
-- non_breaking_space == ' '
--
non_breaking_space :: Char
type Unicode_Index = Int
type Unicode_Range = (Unicode_Index, Unicode_Index)
type Unicode_Point = (Unicode_Index, String)
type Unicode_Table = [Unicode_Point]
unicode :: [Unicode_Table]
accidentals_rng_set :: [Unicode_Range]
-- | UNICODE accidental symbols.
--
--
-- let r = "♭♮♯𝄪𝄫𝄬𝄭𝄮𝄯𝄰𝄱𝄲𝄳" in map (toEnum . fst) accidentals == r
--
accidentals :: Unicode_Table
notes_rng :: Unicode_Range
-- | UNICODE note duration symbols.
--
--
-- let r = "𝅜𝅝𝅗𝅥𝅘𝅥𝅘𝅥𝅮𝅘𝅥𝅯𝅘𝅥𝅰𝅘𝅥𝅱𝅘𝅥𝅲" in map (toEnum . fst) notes == r
--
notes :: Unicode_Table
rests_rng :: Unicode_Range
-- | UNICODE rest symbols.
--
--
-- let r = "𝄻𝄼𝄽𝄾𝄿𝅀𝅁𝅂" in map (toEnum . fst) rests == r
--
rests :: Unicode_Table
augmentation_dot :: Unicode_Point
clefs_rng :: Unicode_Range
-- | UNICODE clef symbols.
--
--
-- let r = "𝄞𝄟𝄠𝄡𝄢𝄣𝄤𝄥𝄦" in map (toEnum . fst) clefs == r
--
clefs :: Unicode_Table
notehead_rng :: Unicode_Range
-- | UNICODE notehead symbols.
--
--
-- let r = "𝅃𝅄𝅅𝅆𝅇𝅈𝅉𝅊𝅋𝅌𝅍𝅎𝅏𝅐𝅑𝅒𝅓𝅔𝅕𝅖𝅗𝅘𝅙𝅚𝅛" in map (toEnum . fst) noteheads == r
--
noteheads :: Unicode_Table
stem :: Unicode_Point
dynamics_rng :: Unicode_Range
dynamics :: Unicode_Table
articulations_rng :: Unicode_Range
articulations :: Unicode_Table
type Unicode_Block = (Unicode_Range, String)
unicode_blocks :: [Unicode_Block]
-- | http://unicode.org/Public/8.0.0/ucd/UnicodeData.txt
--
--
-- let fn = "/home/rohan/data/unicode.org/Public/8.0.0/ucd/UnicodeData.txt"
-- tbl <- unicode_data_table_read fn
-- length tbl == 29215
--
unicode_data_table_read :: FilePath -> IO Unicode_Table
unicode_table_block :: (Int, Int) -> Unicode_Table -> Unicode_Table
unicode_point_hs :: Unicode_Point -> String
unicode_table_hs :: Unicode_Table -> String
-- | 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 mod12 [0,1,3] == [[0,1,3],[0,2,11],[0,9,10]]
--
t_rotations :: Integral i => Z i -> [i] -> [[i]]
-- | T/I-related rotations of p.
--
--
-- ti_rotations mod12 [0,1,3] == [[0,1,3],[0,2,11],[0,9,10]
-- ,[0,9,11],[0,2,3],[0,1,10]]
--
ti_rotations :: Integral i => Z i -> [i] -> [[i]]
-- | Variant with default value for empty input list case.
minimumBy_or :: t -> (t -> t -> Ordering) -> [t] -> t
-- | Prime form rule requiring comparator, considering t_rotations.
t_cmp_prime :: Integral i => Z i -> ([i] -> [i] -> Ordering) -> [i] -> [i]
-- | Prime form rule requiring comparator, considering ti_rotations.
ti_cmp_prime :: Integral i => Z i -> ([i] -> [i] -> Ordering) -> [i] -> [i]
-- | 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 mod12 [0,1,3,6,8,9] == [0,1,3,6,8,9]
-- forte_prime mod5 [0,1,4] == [0,1,2]
--
--
--
-- S.set (map (forte_prime mod5) (S.powerset [0..4]))
-- S.set (map (forte_prime mod7) (S.powerset [0..6]))
--
forte_prime :: Integral i => Z i -> [i] -> [i]
-- | Transpositional equivalence prime form, ie. t_cmp_prime of
-- forte_cmp.
--
--
-- (forte_prime mod12 [0,2,3],t_prime mod12 [0,2,3]) == ([0,1,3],[0,2,3])
--
t_prime :: Integral i => Z i -> [i] -> [i]
-- | Interval class of interval i.
--
--
-- map (ic 12) [0..11] == [0,1,2,3,4,5,6,5,4,3,2,1]
-- map (ic 7) [0..6] == [0,1,2,3,3,2,1]
-- 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 mod12) [-13,-1,0,1,13] == [1,1,0,1,1]
--
ic :: Integral i => i -> i -> i
-- | 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]
-- | Generate SC universe, though not in order of the Forte table.
--
--
-- let r = [[]
-- ,[0]
-- ,[0,1],[0,2],[0,3]
-- ,[0,1,2],[0,1,3],[0,1,4],[0,2,4]
-- ,[0,1,2,3],[0,1,2,4],[0,1,3,4],[0,1,3,5]
-- ,[0,1,2,3,4],[0,1,2,3,5],[0,1,2,4,5]
-- ,[0,1,2,3,4,5]
-- ,[0,1,2,3,4,5,6]]
-- in sc_univ mod7 == r
--
--
--
-- sort (sc_univ mod12) == sort (map snd sc_table)
--
--
--
-- zipWith (\p q -> (p == q,p,q)) (sc_univ mod12) (map snd sc_table)
--
sc_univ :: Integral i => Z i -> [[i]]
-- | Synonym for String.
type SC_Name = String
-- | The set-class table (Forte prime forms).
--
--
-- length sc_table == 224
--
sc_table :: Num n => [(SC_Name, [n])]
-- | Unicode (non-breaking hyphen) variant.
sc_table_unicode :: Num n => [(SC_Name, [n])]
-- | Lookup name of prime form of set class. It is an error for the input
-- not to be a forte prime form.
--
--
-- forte_prime_name [0,1,4,6] == ("4-Z15",[0,1,4,6])
--
forte_prime_name :: (Num n, Eq n) => [n] -> (SC_Name, [n])
sc_tbl_lookup :: Integral i => Z i -> [(SC_Name, [i])] -> [i] -> Maybe (SC_Name, [i])
sc_tbl_lookup_err :: Integral i => Z i -> [(SC_Name, [i])] -> [i] -> (SC_Name, [i])
sc_name' :: Integral i => Z i -> [(SC_Name, [i])] -> [i] -> SC_Name
-- | Lookup a set-class name. The input set is subject to
-- forte_prime before lookup.
--
--
-- sc_name mod12 [0,2,3,6,7] == "5-Z18"
-- sc_name mod12 [0,1,4,6,7,8] == "6-Z17"
--
sc_name :: Integral i => Z i -> [i] -> SC_Name
-- | Long name (ie. with enumeration of prime form).
--
--
-- sc_name_long mod12 [0,1,4,6,7,8] == "6-Z17[012478]"
--
sc_name_long :: Integral i => Z i -> [i] -> SC_Name
-- | Unicode (non-breaking hyphen) variant.
sc_name_unicode :: Integral i => Z i -> [i] -> SC_Name
-- | Lookup a set-class given a set-class name.
--
--
-- sc "6-Z17" == [0,1,2,4,7,8]
--
sc :: Num n => SC_Name -> [n]
scs :: Num n => [[n]]
-- | 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, Num n) => i -> [[n]]
-- | Vector indicating degree of intersection with inversion at each
-- transposition.
--
--
-- tics mod12 [0,2,4,5,7,9] == [3,2,5,0,5,2,3,4,1,6,1,4]
--
tics :: Integral i => Z i -> [i] -> [Int]
-- | Locate Z relation of set class.
--
--
-- fmap (sc_name mod12) (z_relation_of 12 (sc "7-Z12")) == Just "7-Z36"
--
z_relation_of :: Integral i => i -> [i] -> Maybe [i]
-- | Marcus Castrén. RECREL: A Similarity Measure for Set-Classes.
-- PhD thesis, Sibelius Academy, Helsinki, 1994.
module Music.Theory.Z12.Castren_1994
type Z12 = Int
-- | Is p symmetrical under inversion.
--
--
-- map inv_sym (T.scs_n 2) == [True,True,True,True,True,True]
-- map (fromEnum.inv_sym) (T.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 T.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
type Z12 = Int
-- | 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
-- | 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 [0,2,3,6,7] == [0,1,4,5,7]
--
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]
type SC_Name = SC_Name
-- | 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
sc_name_long :: [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
--
--
-- >>> pct 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]
-- | Type specialise...
icv' :: [Z12] -> [Int]
-- | Locate Z relation of set class.
--
--
-- fmap sc_name (z_relation_of (sc "7-Z12")) == Just "7-Z36"
--
z_relation_of :: [Z12] -> Maybe [Z12]
-- | 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 GHC.Show.Show Music.Theory.Metric.Buchler_1998.R
instance GHC.Classes.Eq Music.Theory.Metric.Buchler_1998.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
-- | 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]]
-- let n = "01" in cgg [n,n,n] == ["000","001","010","011","100","101","110","111"]
--
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.
--
--
-- >>> pct 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]]
-- | Chain pcsegs.
--
--
-- >>> echo 024579 | pct chn T0 3 | sort -u
-- 579468 (RT8M)
-- 579A02 (T5)
--
--
--
-- chn_t0 3 [0,2,4,5,7,9] == [[5,7,9,10,0,2],[5,7,9,4,6,8]]
--
--
--
-- >>> echo 02457t | pct chn T0 2
-- 7A0135 (RT5I)
-- 7A81B9 (RT9MI)
--
--
--
-- chn_t0 2 [0,2,4,5,7,10] == [[7,10,0,1,3,5],[7,10,8,1,11,9]]
--
chn_t0 :: Int -> [Z12] -> [[Z12]]
-- | Cyclic interval segment.
--
--
-- >>> echo 014295e38t76 | pct cisg
-- 13A7864529B6
--
--
--
-- ciseg [0,1,4,2,9,5,11,3,8,10,7,6] == [1,3,10,7,8,6,4,5,2,9,11,6]
--
ciseg :: [Z12] -> [Z12]
-- | Synonynm for complement.
--
--
-- >>> pct cmpl 02468t
-- 13579B
--
--
--
-- cmpl [0,2,4,6,8,10] == [1,3,5,7,9,11]
--
cmpl :: [Z12] -> [Z12]
-- | Form cycle.
--
--
-- >>> echo 056 | pct cyc
-- 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.
--
--
-- >>> pct 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.
--
--
-- >>> pct dis 24
-- 1256
--
--
--
-- dis [2,4] == [1,2,5,6]
--
dis :: (Integral t) => [Int] -> [t]
-- | Degree of intersection.
--
--
-- >>> echo 024579e | pct 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 | pct 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
-- | Z12 cycles.
frg_cyc :: T6 [[Z12]]
-- | Fragmentation of cycles.
frg :: [Z12] -> T6 [String]
ic_cycle_vector :: [Z12] -> T6 [Int]
-- | Pretty printer for ic_cycle_vector.
--
--
-- let r = "IC cycle vector: <1> <22> <111> <1100> <5> <000000>"
-- in ic_cycle_vector_pp (ic_cycle_vector [0,2,4,5,7,9]) == r
--
ic_cycle_vector_pp :: T6 [Int] -> String
frg_hdr :: [String]
-- | Fragmentation of cycles.
--
--
-- >>> pct frg 024579
-- Fragmentation of 1-cycle(s): [0-2-45-7-9--]
-- Fragmentation of 2-cycle(s): [024---] [--579-]
-- Fragmentation of 3-cycle(s): [0--9] [-47-] [25--]
-- Fragmentation of 4-cycle(s): [04-] [-59] [2--] [-7-]
-- Fragmentation of 5-cycle(s): [05------4927]
-- Fragmentation of 6-cycle(s): [0-] [-7] [2-] [-9] [4-] [5-]
-- IC cycle vector: <1> <22> <111> <1100> <5> <000000>
--
--
--
-- putStrLn $ frg_pp [0,2,4,5,7,9]
--
frg_pp :: [Z12] -> String
-- | Embedded segment search.
--
--
-- >>> echo 23A | pct ess 0164325
-- 2B013A9
-- 923507A
--
--
--
-- ess [0,1,6,4,3,2,5] [2,3,10] == [[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.
--
--
-- let d = [0,2,4,5,7,9,11] in has_sc d (complement d) == True
-- has_sc [] [] == True
--
has_sc :: [Z12] -> [Z12] -> Bool
-- | Interval cycle filter.
--
--
-- >>> echo 22341 | pct 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.
--
--
-- >>> pct 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.
--
--
-- >>> pct 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.
--
--
-- let r = [[[0,2,4],[2,4,5],[4,5,7],[5,7,9]]
-- ,[[0,2,4,5],[2,4,5,7],[4,5,7,9]]]
-- in imb [3,4] [0,2,4,5,7,9] == r
--
imb :: (Integral n) => [n] -> [a] -> [[[a]]]
-- | issb gives the set-classes that can append to p to
-- give q.
--
--
-- >>> pct 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.
--
--
-- >>> pct 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.
--
--
-- >>> pct 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).
--
--
-- >>> pct pi 0236 12
-- pcseg 0236
-- pcseg 6320
-- pcseg 532B
-- pcseg B235
--
--
--
-- pci [1,2] [0,2,3,6] == [[0,2,3,6],[5,3,2,11],[6,3,2,0],[11,2,3,5]]
--
pci :: [Int] -> [Z12] -> [[Z12]]
-- | Relate sets (TnMI).
--
--
-- >>> pct rs 0123 641e
-- T1M
--
--
--
-- rs [0,1,2,3] [6,4,1,11] == [(Z.tto_parse "T1M",[1,6,11,4])
-- ,(Z.tto_parse "T4MI",[4,11,6,1])]
--
rs :: [Z12] -> [Z12] -> [(TTO Z12, [Z12])]
rs1 :: [Z12] -> [Z12] -> Maybe (TTO Z12)
-- | Relate segments.
--
--
-- >>> pct rsg 156 3BA
-- T4I
--
--
--
-- rsg [1,5,6] [3,11,10] == [Z.sro_parse "T4I",Z.sro_parse "r1RT4MI"]
--
--
--
-- >>> pct rsg 0123 05t3
-- T0M
--
--
--
-- rsg [0,1,2,3] [0,5,10,3] == [Z.sro_parse "T0M",Z.sro_parse "RT3MI"]
--
--
--
-- >>> pct rsg 0123 4e61
-- RT1M
--
--
--
-- rsg [0,1,2,3] [4,11,6,1] == [Z.sro_parse "T4MI",Z.sro_parse "RT1M"]
--
--
--
-- >>> echo e614 | pct rsg 0123
-- r3RT1M
--
--
--
-- rsg [0,1,2,3] [11,6,1,4] == [Z.sro_parse "r1T4MI",Z.sro_parse "r1RT1M"]
--
rsg :: [Z12] -> [Z12] -> [SRO Z12]
-- | Subsets.
sb :: [[Z12]] -> [[Z12]]
-- | scc = set class completion
--
--
-- >>> pct scc 6-32 168
-- 35A
-- 49B
-- 3AB
-- 34B
--
--
--
-- scc (Z12.sc "6-32") [1,6,8] == [[3,5,10],[4,9,11],[3,10,11],[3,4,11]]
--
scc :: [Z12] -> [Z12] -> [[Z12]]
si_hdr :: [String]
type SI = ([Z12], TTO Z12, [Z12])
si_raw :: [Z12] -> (SI, [Z12], [Int], SI, SI)
si_raw_pp :: [Z12] -> [String]
-- | Set information.
--
--
-- putStr $ unlines $ si [0,5,3,11]
--
si :: [Z12] -> [String]
-- | Super set-class.
--
--
-- >>> pct spsc 4-11 4-12
-- 5-26[02458]
--
--
--
-- spsc [Z12.sc "4-11",Z12.sc "4-12"] == [[0,2,4,5,8]]
--
--
--
-- >>> pct spsc 3-11 3-8
-- 4-27[0258]
-- 4-Z29[0137]
--
--
--
-- spsc [Z12.sc "3-11",Z12.sc "3-8"] == [[0,2,5,8],[0,1,3,7]]
--
--
--
-- >>> pct spsc `pct fl 3`
-- 6-Z17[012478]
--
--
--
-- spsc (cf [3] Z12.scs) == [[0,1,2,4,7,8]]
--
spsc :: [[Z12]] -> [[Z12]]
-- | sra = stravinsky rotational array
--
--
-- >>> echo 019BA7 | pct sra
-- 019BA7
-- 08A96B
-- 021A34
-- 0B812A
-- 0923B1
-- 056243
--
--
--
-- let r = [[0,1,9,11,10,7],[0,8,10,9,6,11],[0,2,1,10,3,4]
-- ,[0,11,8,1,2,10],[0,9,2,3,11,1],[0,5,6,2,4,3]]
-- in sra [0,1,9,11,10,7] == r
--
sra :: [Z12] -> [[Z12]]
-- | Serial operation.
--
--
-- >>> echo 156 | pct sro T4
-- 59A
--
--
--
-- sro (Z.sro_parse "T4") [1,5,6] == [5,9,10]
--
--
--
-- >>> echo 024579 | pct sro RT4I
-- 79B024
--
--
--
-- sro (Z.SRO 0 True 4 False True) [0,2,4,5,7,9] == [7,9,11,0,2,4]
--
--
--
-- >>> echo 156 | pct sro T4I
-- 3BA
--
--
--
-- sro (Z.sro_parse "T4I") [1,5,6] == [3,11,10]
-- sro (Z.SRO 0 False 4 False True) [1,5,6] == [3,11,10]
--
--
--
-- >>> echo 156 | pct sro T4 | pct sro T0I
-- 732
--
--
--
-- (sro (Z.sro_parse "T0I") . sro (Z.sro_parse "T4")) [1,5,6] == [7,3,2]
--
--
--
-- >>> echo 024579 | pct sro RT4I
-- 79B024
--
--
--
-- sro (Z.sro_parse "RT4I") [0,2,4,5,7,9] == [7,9,11,0,2,4]
--
sro :: SRO Z12 -> [Z12] -> [Z12]
-- | Vector indicating degree of intersection with inversion at each
-- transposition.
--
--
-- tics [0,2,4,5,7,9] == [3,2,5,0,5,2,3,4,1,6,1,4]
-- map tics Z12.scs
--
tics :: [Z12] -> [Int]
-- | tmatrix
--
--
-- >>> pct tmatrix 1258
--
--
-- 1258 0147 9A14 67A1
--
--
-- tmatrix [1,2,5,8] == [[1,2,5,8],[0,1,4,7],[9,10,1,4],[6,7,10,1]]
--
tmatrix :: [Z12] -> [[Z12]]
-- | trs = transformations search. Search all RTnMI of p for
-- q.
--
--
-- >>> echo 642 | pct trs 024579 | sort -u
-- 531642
-- 6421B9
-- 642753
-- B97642
--
--
--
-- let r = [[5,3,1,6,4,2],[6,4,2,1,11,9],[6,4,2,7,5,3],[11,9,7,6,4,2]]
-- in sort (trs [0,2,4,5,7,9] [6,4,2]) == r
--
trs :: [Z12] -> [Z12] -> [[Z12]]
trs_m :: [Z12] -> [Z12] -> [[Z12]]
-- | 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]
-- | Graph (fgl) functions.
module Music.Theory.Graph.FGL
-- | Synonym for noNodes.
g_degree :: Gr v e -> Int
-- | subgraph of each of components.
g_partition :: Gr v e -> [Gr v e]
-- | Find first Node with given label.
g_node_lookup :: (Eq v, Graph gr) => gr v e -> v -> Maybe Node
-- | Erroring variant.
g_node_lookup_err :: (Eq v, Graph gr) => gr v e -> v -> Node
-- | Set of nodes with given labels, plus all neighbours of these nodes.
-- (impl = implications)
ug_node_set_impl :: (Eq v, DynGraph gr) => gr v e -> [v] -> [Node]
type G_NODE_SEL_F v e = Gr v e -> Node -> [Node]
-- | msum . map return.
ml_from_list :: MonadLogic m => [t] -> m t
-- | Use sel_f of pre for directed graphs and
-- neighbors for undirected.
g_hamiltonian_path_ml :: MonadLogic m => G_NODE_SEL_F v e -> Gr v e -> Node -> m [Node]
ug_hamiltonian_path_ml_0 :: MonadLogic m => Gr v e -> m [Node]
-- | Edge, no label.
type EDGE v = (v, v)
-- | Graph as set of edges.
type GRAPH v = [EDGE v]
-- | Edge, with label.
type EDGE_L v l = (EDGE v, l)
-- | Graph as set of labeled edges.
type GRAPH_L v l = [EDGE_L v l]
-- | Generate a graph given a set of labelled edges.
g_from_edges_l :: (Eq v, Ord v) => GRAPH_L v e -> Gr v e
-- | Variant that supplies '()' as the (constant) edge label.
--
--
-- let g = G.mkGraph [(0,'a'),(1,'b'),(2,'c')] [(0,1,()),(1,2,())]
-- in g_from_edges_ul [('a','b'),('b','c')] == g
--
g_from_edges :: Ord v => GRAPH v -> Gr v ()
-- | Label sequence of edges starting at one.
e_label_seq :: [EDGE v] -> [EDGE_L v Int]
-- | Normalised undirected labeled edge (ie. order nodes).
e_normalise_l :: Ord v => EDGE_L v l -> EDGE_L v l
-- | Collate labels for edges that are otherwise equal.
e_collate_l :: Ord v => [EDGE_L v l] -> [EDGE_L v [l]]
-- | e_collate_l of e_normalise_l.
e_collate_normalised_l :: Ord v => [EDGE_L v l] -> [EDGE_L v [l]]
-- | Apply predicate to universe of possible edges.
e_univ_select_edges :: (t -> t -> Bool) -> [t] -> [EDGE t]
-- | Consider only edges (p,q) where p < q.
e_univ_select_u_edges :: Ord t => (t -> t -> Bool) -> [t] -> [EDGE t]
-- | Sequence of connected vertices to edges.
--
--
-- e_path_to_edges "abcd" == [('a','b'),('b','c'),('c','d')]
--
e_path_to_edges :: [t] -> [EDGE t]
-- | Undirected edge equality.
e_undirected_eq :: Eq t => EDGE t -> EDGE t -> Bool
elem_by :: (p -> q -> Bool) -> p -> [q] -> Bool
-- | Is the sequence of vertices a path at the graph, ie. are all
-- adjacencies in the sequence edges.
e_is_path :: Eq t => GRAPH t -> [t] -> Bool
-- | Graph (dot) functions.
module Music.Theory.Graph.Dot
-- | Separate at element.
--
--
-- sep1 ':' "graph:layout"
--
sep1 :: Eq t => t -> [t] -> ([t], [t])
-- | Quote s if it includes white space.
--
--
-- map maybe_quote ["abc","a b c"] == ["abc","\"a b c\""]
--
maybe_quote :: String -> String
-- | Left biased union of association lists p and q.
--
--
-- assoc_union [(5,"a"),(3,"b")] [(5,"A"),(7,"C")] == [(5,"a"),(3,"b"),(7,"C")]
--
assoc_union :: Eq k => [(k, v)] -> [(k, v)] -> [(k, v)]
-- | area:opt (area = graph|node|edge)
type DOT_KEY = String
type DOT_OPT = String
type DOT_VALUE = String
type DOT_ATTR = (DOT_OPT, DOT_VALUE)
type DOT_ATTR_SET = (String, [DOT_ATTR])
dot_key_sep :: String -> (String, String)
dot_attr_pp :: DOT_ATTR -> String
dot_attr_set_pp :: DOT_ATTR_SET -> String
dot_attr_collate :: [DOT_ATTR] -> [DOT_ATTR_SET]
dot_attr_ext :: [DOT_ATTR] -> [DOT_ATTR] -> [DOT_ATTR]
dot_attr_def :: [DOT_ATTR]
-- | Graph pretty-printer, (node->shape,node->label,edge->label)
type GR_PP v e = (v -> Maybe String, v -> Maybe String, e -> Maybe String)
gr_pp_lift_node_f :: (v -> String) -> GR_PP v e
gr_pp_id_show :: Show e => GR_PP String e
-- | br = brace, csl = comma separated list
br_csl_pp :: Show t => [t] -> String
gr_pp_id_br_csl :: Show e => GR_PP String [e]
-- | Graph type, directed or un-directed.
data G_TYPE
G_DIGRAPH :: G_TYPE
G_UGRAPH :: G_TYPE
g_type_to_string :: G_TYPE -> String
g_type_to_edge_symbol :: G_TYPE -> String
-- | Vertex position function.
type POS_FN v = v -> (Int, Int)
g_to_dot :: G_TYPE -> [DOT_ATTR] -> GR_PP v e -> Maybe (POS_FN v) -> Gr v e -> [String]
g_to_udot :: [DOT_ATTR] -> GR_PP v e -> Gr v e -> [String]
-- | Data.Function related functions.
module Music.Theory.Function
-- | const of const.
--
--
-- const2 5 undefined undefined == 5
-- const (const 5) undefined undefined == 5
--
const2 :: a -> b -> c -> a
-- | && 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, ie. logical or of list 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)
infixr 8 .:
-- | 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))
infixr 8 .::
-- | fmap . .::.
(.:::) :: (Functor f, Functor g, Functor h, Functor i) => (a -> b) -> f (g (h (i a))) -> f (g (h (i b)))
infixr 8 .:::
-- | 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))))
infixr 8 .::::
-- | 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)))))
infixr 8 .:::::
-- | 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
-- a 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 an
-- empty value. To indicate the duration of the final value
-- a must have a 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)
-- | Start time of sequence.
--
--
-- wseq_start [((1,2),'a')] == 1
-- wseq_start [] == 0
--
wseq_start :: Num t => Wseq t a -> t
-- | End time of sequence.
--
--
-- wseq_end [((1,2),'a')] == 3
-- wseq_end (useq_to_wseq 0 (1,"linear")) == 6
--
wseq_end :: Num t => Wseq t a -> 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
-- | Prefix of sequence where the start time precedes or is at the indicate
-- time.
wseq_until :: Ord t => t -> Wseq t a -> Wseq t a
-- | Keep only elements that are entirely contained within the indicated
-- temporal window, which is inclusive at the left & right edges, ie.
-- [t0,t1]. Halts processing at end of window.
--
--
-- let r = [((5,1),'e'),((6,1),'f'),((7,1),'g'),((8,1),'h')]
-- in wseq_twindow (5,9) (zip (zip [1..] (repeat 1)) ['a'..]) == r
--
--
--
-- wseq_twindow (1,2) [((1,1),'a'),((1,2),'b')] == [((1,1),'a')]
--
wseq_twindow :: (Num t, Ord t) => (t, t) -> Wseq t a -> Wseq t a
-- | Select nodes that are active at indicated time, comparison is
-- inclusive at left and exclusive at right. Halts processing at end of
-- window.
--
--
-- let sq = [((1,1),'a'),((1,2),'b')]
-- in map (wseq_at sq) [1,2] == [sq,[((1,2),'b')]]
--
--
--
-- wseq_at (zip (zip [1..] (repeat 1)) ['a'..]) 3 == [((3,1),'c')]
--
wseq_at :: (Num t, Ord t) => Wseq t a -> t -> Wseq t a
-- | Select nodes that are active within the indicated window, comparison
-- is inclusive at left and exclusive at right. Halts processing at end
-- of window.
--
--
-- let sq = [((0,2),'a'),((0,4),'b'),((2,4),'c')]
-- in wseq_at_window sq (1,3) == sq
--
--
--
-- wseq_at_window (zip (zip [1..] (repeat 1)) ['a'..]) (3,4) == [((3,1),'c'),((4,1),'d')]
--
wseq_at_window :: (Num t, Ord t) => Wseq t a -> (t, t) -> 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
-- | Compare first by start time, then by duration.
w_compare :: Ord t => ((t, t), a) -> ((t, t), a) -> Ordering
-- | Merge considering only start times.
wseq_merge :: Ord t => Wseq t a -> Wseq t a -> Wseq t a
-- | Merge set considering both start times & durations.
wseq_merge_set :: Ord t => [Wseq t a] -> Wseq t a
-- | Locate nodes to the left and right of indicated time.
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 [(1,'a'),(1,'b')] == [(1,"ab")]
-- tseq_group [(1,'a'),(2,'b'),(2,'c')] == [(1,"a"),(2,"bc")]
--
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
-- | Sort Wseq by start time, Wseq ought never to be out of
-- order.
--
--
-- wseq_sort [((3,1),'a'),((1,3),'b')] == [((1,3),'b'),((3,1),'a')]
--
wseq_sort :: Ord t => Wseq t a -> Wseq t a
-- | Transform Wseq to Tseq by discaring durations.
wseq_discard_dur :: Wseq t a -> Tseq t a
wseq_overlap_f :: (Eq e, Ord t, Num t) => (e -> e -> Bool) -> (t -> t) -> ((t, t), e) -> Wseq t e -> Maybe (Wseq t e)
-- | Determine if sequence has overlapping equal nodes.
wseq_has_overlaps :: (Ord t, Num t, Eq e) => (e -> e -> Bool) -> Wseq t e -> Bool
-- | Edit durations to ensure that nodes don't overlap. If equal nodes
-- begin simultaneously delete the shorter node. If a node extends into a
-- later node shorten the initial duration (apply dur_fn to iot).
--
--
-- let sq = [((0,1),'a'),((0,5),'a'),((1,5),'a'),((3,1),'a')]
-- let r = [((0,1),'a'),((1,2),'a'),((3,1),'a')]
-- wseq_has_overlaps (==) sq == True
-- wseq_remove_overlaps (==) id sq == r
-- wseq_has_overlaps (==) (wseq_remove_overlaps (==) id sq) == False
--
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
-- | Shift (displace) onset times by i.
--
--
-- wseq_shift 3 [((1,2),'a')] == [((4,2),'a')]
--
wseq_shift :: Num t => t -> Wseq t a -> Wseq t a
-- | Shift q to end of p and append.
--
--
-- wseq_append [((1,2),'a')] [((1,2),'b')] == [((1,2),'a'),((4,2),'b')]
--
wseq_append :: Num t => Wseq t a -> Wseq t a -> Wseq t a
-- | foldl1 of wseq_append
--
--
-- wseq_concat [[((1,2),'a')],[((1,2),'b')]] == [((1,2),'a'),((4,2),'b')]
--
wseq_concat :: Num t => [Wseq t a] -> Wseq t a
-- | Container to mark the begin and end of a value.
data Begin_End a
Begin :: a -> Begin_End a
End :: a -> Begin_End a
-- | Functor instance.
begin_end_map :: (t -> u) -> Begin_End t -> Begin_End u
-- | Structural comparison at Begin_End, Begin compares less
-- than End.
cmp_begin_end :: Begin_End a -> Begin_End b -> Ordering
-- | Translate container types.
either_to_begin_end :: Either a a -> Begin_End a
-- | Translate container types.
begin_end_to_either :: Begin_End a -> Either a a
begin_end_partition :: [Begin_End a] -> ([a], [a])
-- | Add or delete element from accumulated state.
begin_end_track :: Eq a => [a] -> Begin_End a -> [a]
-- | Convert Wseq to Tseq transforming elements to
-- Begin_End. When merging, end elements precede
-- begin elements at equal times.
--
--
-- let {sq = [((0,5),'a'),((2,2),'b')]
-- ;r = [(0,Begin 'a'),(2,Begin 'b'),(4,End 'b'),(5,End 'a')]}
-- in wseq_begin_end sq == r
--
--
--
-- let {sq = [((0,1),'a'),((1,1),'b'),((2,1),'c')]
-- ;r = [(0,Begin 'a'),(1,End 'a')
-- ,(1,Begin 'b'),(2,End 'b')
-- ,(2,Begin 'c'),(3,End 'c')]}
-- in wseq_begin_end sq == r
--
wseq_begin_end :: (Num t, Ord t) => Wseq t a -> Tseq t (Begin_End a)
-- | begin_end_to_either of wseq_begin_end.
wseq_begin_end_either :: (Num t, Ord t) => Wseq t a -> Tseq t (Either a a)
-- | Variant that applies begin and end functions to nodes.
--
--
-- let {sq = [((0,5),'a'),((2,2),'b')]
-- ;r = [(0,'A'),(2,'B'),(4,'b'),(5,'a')]}
-- in wseq_begin_end_f Data.Char.toUpper id sq == r
--
wseq_begin_end_f :: (Ord t, Num t) => (a -> b) -> (a -> b) -> Wseq t a -> Tseq t b
-- | Result for each time-point the triple (begin-list,end-list,hold-list).
-- The elements of the end-list have been deleted from the hold list.
tseq_begin_end_accum :: Eq a => Tseq t [Begin_End a] -> Tseq t ([a], [a], [a])
tseq_accumulate :: Eq a => Tseq t [Begin_End a] -> Tseq t [a]
-- | The transition sequence of active elements.
--
--
-- let w = [((0,3),'a'),((1,2),'b'),((2,1),'c'),((3,3),'d')]
-- wseq_accumulate w == [(0,"a"),(1,"ba"),(2,"cba"),(3,"d"),(6,"")]
--
wseq_accumulate :: (Eq a, Ord t, Num t) => Wseq t a -> Tseq t [a]
-- | Inverse of wseq_begin_end given a predicate function for
-- locating the end node of a begin node.
--
--
-- let {sq = [(0,Begin 'a'),(2,Begin 'b'),(4,End 'b'),(5,End 'a')]
-- ;r = [((0,5),'a'),((2,2),'b')]}
-- in tseq_begin_end_to_wseq (==) sq == r
--
tseq_begin_end_to_wseq :: Num t => (a -> a -> Bool) -> Tseq t (Begin_End a) -> Wseq t a
useq_to_dseq :: Useq t a -> Dseq t a
useq_to_wseq :: Num t => t -> Useq t a -> Wseq 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 value is taken from 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. A
-- nil value is required in case the Tseq does not begin
-- at 0.
--
--
-- 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])
wseq_cycle' :: Num t => Wseq t a -> [Wseq t a]
-- | Only finite Wseq can be cycled, the resulting Wseq is infinite.
--
--
-- take 5 (wseq_cycle [((0,1),'a'),((3,3),'b')])
--
wseq_cycle :: Num t => Wseq t a -> Wseq t a
-- | Variant cycling only n times.
--
--
-- wseq_cycle_n 3 [((0,1),'a'),((3,3),'b')]
--
wseq_cycle_n :: Num t => Int -> Wseq t a -> Wseq t a
-- | wseq_until of wseq_cycle.
wseq_cycle_until :: (Num t, Ord t) => t -> Wseq t a -> Wseq 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 GHC.Show.Show a => GHC.Show.Show (Music.Theory.Time.Seq.Begin_End a)
instance GHC.Classes.Eq a => GHC.Classes.Eq (Music.Theory.Time.Seq.Begin_End a)
instance GHC.Show.Show Music.Theory.Time.Seq.Interpolation_T
instance GHC.Enum.Enum Music.Theory.Time.Seq.Interpolation_T
instance GHC.Classes.Eq Music.Theory.Time.Seq.Interpolation_T
-- | Enumeration functions.
module Music.Theory.Enum
-- | 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
-- | Variant of enumFromTo that, if p is after q,
-- cycles from maxBound to minBound.
--
--
-- import Data.Word
-- enum_from_to_cyclic (254 :: Word8) 1 == [254,255,0,1]
--
enum_from_to_cyclic :: (Bounded a, Enum a) => a -> a -> [a]
-- | Variant of enumFromTo that, if p is after q,
-- enumerates from q to p.
--
--
-- enum_from_to_reverse 5 1 == [5,4,3,2,1]
-- enum_from_to_reverse 1 5 == enumFromTo 1 5
--
enum_from_to_reverse :: Enum a => a -> a -> [a]
-- | All elements in sequence.
--
--
-- (enum_univ :: [Data.Word.Word8]) == [0 .. 255]
--
enum_univ :: (Bounded t, Enum t) => [t]
-- | 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
-- | 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.
--
-- In both cases, the values are given in relation to the first degree of
-- the scale, which for ratios is 1 and for cents 0.
data Tuning
Tuning :: Either [Rational] [Cents] -> Rational -> Tuning
[tn_ratios_or_cents] :: Tuning -> Either [Rational] [Cents]
[tn_octave_ratio] :: Tuning -> Rational
-- | Divisions of octave.
--
--
-- tn_divisions (equal_temperament 12) == 12
--
tn_divisions :: Tuning -> Int
-- | Maybe exact ratios of Tuning.
tn_ratios :: Tuning -> Maybe [Rational]
-- | erroring variant.
tn_ratios_err :: Tuning -> [Rational]
-- | Possibly inexact Cents of tuning.
tn_cents :: Tuning -> [Cents]
-- | map round . cents.
tn_cents_i :: Integral i => Tuning -> [i]
-- | Variant of cents that includes octave at right.
tn_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.
tn_approximate_ratios :: Tuning -> [Approximate_Ratio]
-- | Cyclic form, taking into consideration octave_ratio.
tn_approximate_ratios_cyclic :: Tuning -> [Approximate_Ratio]
-- | Iterate the function f n times, the inital value is
-- x.
--
--
-- recur_n 5 (* 2) 1 == 32
-- take (5 + 1) (iterate (* 2) 1) == [1,2,4,8,16,32]
--
recur_n :: Integral n => n -> (t -> t) -> t -> t
-- | Convert a (signed) number of octaves difference of given ratio to a
-- ratio.
--
--
-- map (oct_diff_to_ratio 2) [-3 .. 3] == [1/8,1/4,1/2,1,2,4,8]
-- map (oct_diff_to_ratio (9/8)) [-3 .. 3] == [512/729,64/81,8/9,1/1,9/8,81/64,729/512]
--
oct_diff_to_ratio :: Integral a => Ratio a -> Int -> Ratio a
-- | Lookup function that allows both negative & multiple octave
-- indices.
--
--
-- let map_zip f l = zip l (map f l)
-- map_zip (tn_ratios_lookup werckmeister_vi) [-24 .. 24]
--
tn_ratios_lookup :: Tuning -> Int -> Maybe Rational
-- | Lookup function that allows both negative & multiple octave
-- indices.
--
--
-- map_zip (tn_approximate_ratios_lookup werckmeister_v) [-24 .. 24]
--
tn_approximate_ratios_lookup :: Tuning -> Int -> Approximate_Ratio
-- | Maybe exact ratios reconstructed from possibly inexact
-- Cents of Tuning.
--
--
-- :l Music.Theory.Tuning.Werckmeister
-- 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]
-- tn_reconstructed_ratios 1e-2 werckmeister_iii == Just r
--
tn_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.
--
--
-- map (\n -> (n,round (ratio_to_cents (fold_ratio_to_octave_err (n % 1))))) [1..21]
--
ratio_to_cents :: Integral i => Ratio i -> 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.9976981706735
--
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
-- | 96-tone equal temperament.
equal_temperament_96 :: Tuning
-- | Harmonic series to nth partial, with indicated octave.
--
--
-- harmonic_series 17 2
--
harmonic_series :: Integer -> Rational -> Tuning
-- | 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_to_octave' :: Integral i => Ratio i -> Ratio i
-- | Error if input is less than or equal to zero.
--
--
-- map fold_ratio_to_octave_err [2/3,3/4] == [4/3,3/2]
--
fold_ratio_to_octave_err :: Integral i => Ratio i -> Ratio i
-- | Fold ratio until within an octave, ie. 1 < n
-- <= 2.
--
--
-- map fold_ratio_to_octave [0,1] == [Nothing,Just 1]
--
fold_ratio_to_octave :: Integral i => Ratio i -> Maybe (Ratio i)
-- | Sun of numerator & denominator.
ratio_nd_sum :: Num a => Ratio a -> a
min_by :: Ord a => (t -> a) -> t -> t -> t
-- | 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]
-- map ratio_interval_class [7/6,12/7] == [7/6,7/6]
--
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, duplicated removed).
--
--
-- harmonic_series_folded_r 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_r 17) == r
--
harmonic_series_folded_r :: Integer -> [Rational]
-- | ratio_to_cents variant of harmonic_series_folded.
harmonic_series_folded_c :: Integer -> [Cents]
harmonic_series_folded :: Integer -> Rational -> Tuning
-- | 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
-- | Variant for tunings that are incomplete.
type Sparse_Midi_Tuning_F = Int -> Maybe Midi_Detune
-- | Variant for sparse tunings that require state.
type Sparse_Midi_Tuning_ST_F st = st -> Int -> (st, Maybe Midi_Detune)
-- | Lift Midi_Tuning_F to Sparse_Midi_Tuning_F.
lift_tuning_f :: Midi_Tuning_F -> Sparse_Midi_Tuning_F
-- | Lift Sparse_Midi_Tuning_F to Sparse_Midi_Tuning_ST_F.
lift_sparse_tuning_f :: Sparse_Midi_Tuning_F -> Sparse_Midi_Tuning_ST_F st
-- | (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.
--
--
-- let f = d12_midi_tuning_f (equal_temperament 12,0,0)
-- map f [0..127] == zip [0..127] (repeat 0)
--
d12_midi_tuning_f :: D12_Midi_Tuning -> Midi_Tuning_F
-- | (t,f0,k,g) where t=tuning, f0=fundamental frequency, k=midi note
-- number for f0, g=gamut
type CPS_Midi_Tuning = (Tuning, Double, Int, Int)
-- | Midi_Tuning_F for CPS_Midi_Tuning. The function is
-- sparse, it is only valid for g values from k.
--
--
-- let f = cps_midi_tuning_f (equal_temperament 72,T.midi_to_cps 59,59,72 * 4)
-- map f [59 .. 59 + 72]
--
cps_midi_tuning_f :: CPS_Midi_Tuning -> Sparse_Midi_Tuning_F
-- | Midi-note-number -> CPS table, possibly sparse.
type MNN_CPS_Table = [(Int, Double)]
-- | Generates MNN_CPS_Table given Midi_Tuning_F with keys
-- for all valid MNN.
--
--
-- import Sound.SC3.Plot
-- plot_p2_ln [map (fmap round) (gen_cps_tuning_tbl f)]
--
gen_cps_tuning_tbl :: Sparse_Midi_Tuning_F -> MNN_CPS_Table
-- | Given an MNN_CPS_Table tbl, a list of CPS
-- c, and a MNN m find the CPS in
-- c that is nearest to the CPS in t for m.
dtt_lookup :: (Eq k, Num v, Ord v) => [(k, v)] -> [v] -> k -> (Maybe v, Maybe v)
-- | Require table be non-sparse.
dtt_lookup_err :: (Eq k, Num v, Ord v) => [(k, v)] -> [v] -> k -> (k, v, v)
-- | Given two tuning tables generate the dtt table.
gen_dtt_lookup_tbl :: MNN_CPS_Table -> MNN_CPS_Table -> MNN_CPS_Table
gen_dtt_lookup_f :: MNN_CPS_Table -> MNN_CPS_Table -> Midi_Tuning_F
-- | Normal form, value with occurences count (ie. exponent in notation
-- above).
type EFG i = [(i, Int)]
-- | Degree of EFG, ie. sum of exponents.
--
--
-- efg_degree [(3,3),(7,2)] == 3 + 2
--
efg_degree :: EFG i -> Int
-- | Number of tones of EFG, ie. product of increment of exponents.
--
--
-- efg_tones [(3,3),(7,2)] == (3 + 1) * (2 + 1)
--
efg_tones :: EFG i -> Int
-- | Collate a genus given as a multiset into standard form, ie. histogram.
--
--
-- efg_collate [3,3,3,7,7] == [(3,3),(7,2)]
--
efg_collate :: Ord i => [i] -> EFG i
-- | Factors of EFG given with co-ordinate of grid location.
--
--
-- efg_factors [(3,3)]
--
--
--
-- let r = [([0,0],[]),([0,1],[7]),([0,2],[7,7])
-- ,([1,0],[3]),([1,1],[3,7]),([1,2],[3,7,7])
-- ,([2,0],[3,3]),([2,1],[3,3,7]),([2,2],[3,3,7,7])
-- ,([3,0],[3,3,3]),([3,1],[3,3,3,7]),([3,2],[3,3,3,7,7])]
-- in efg_factors [(3,3),(7,2)] == r
--
efg_factors :: EFG i -> [([Int], [i])]
-- | Ratios of EFG, taking n as the 1:1 ratio, with indices, folded
-- into one octave.
--
--
-- let r = sort $ map snd $ efg_ratios 7 [(3,3),(7,2)]
-- r == [1/1,9/8,8/7,9/7,21/16,189/128,3/2,27/16,12/7,7/4,27/14,63/32]
-- map (round . ratio_to_cents) r == [0,204,231,435,471,675,702,906,933,969,1137,1173]
--
--
-- 0: 1/1 C 0.000 cents 1: 9/8 D 203.910 cents 2: 8/7 D+ 231.174 cents 3:
-- 9/7 E+ 435.084 cents 4: 21/16 F- 470.781 cents 5: 189/128 G- 674.691
-- cents 6: 3/2 G 701.955 cents 7: 27/16 A 905.865 cents 8: 12/7 A+
-- 933.129 cents 9: 7/4 Bb- 968.826 cents 10: 27/14 B+ 1137.039 cents 11:
-- 63/32 C- 1172.736 cents 12: 2/1 C 1200.000 cents
--
--
-- let r' = sort $ map snd $ efg_ratios 5 [(5,2),(7,3)]
-- r' == [1/1,343/320,35/32,49/40,5/4,343/256,7/5,49/32,8/5,1715/1024,7/4,245/128]
-- map (round . ratio_to_cents) r' == [0,120,155,351,386,506,583,738,814,893,969,1124]
--
--
--
-- let r'' = sort $ map snd $ efg_ratios 3 [(3,1),(5,1),(7,1)]
-- r'' == [1/1,35/32,7/6,5/4,4/3,35/24,5/3,7/4]
-- map (round . ratio_to_cents) r'' == [0,155,267,386,498,653,884,969]
--
--
--
-- let c0 = [0,204,231,435,471,675,702,906,933,969,1137,1173,1200]
-- let c1 = [0,120,155,351,386,506,583,738,814,893,969,1124,1200]
-- let c2 = [0,155,267,386,498,653,884,969,1200]
-- let f (c',y) = map (\x -> (x,y,x,y + 10)) c'
-- map f (zip [c0,c1,c2] [0,20,40])
--
efg_ratios :: Real r => Rational -> EFG r -> [([Int], Rational)]
-- | Generate a line drawing, as a set of (x0,y0,x1,y1) 4-tuples. h=row
-- height, m=distance of vertical mark from row edge, k=distance between
-- rows
--
--
-- let e = [[3,3,3],[3,3,5],[3,5,5],[3,5,7],[3,7,7],[5,5,5],[5,5,7],[3,3,7],[5,7,7],[7,7,7]]
-- let e = [[3,3,3],[5,5,5],[7,7,7],[3,3,5],[3,5,5],[5,5,7],[5,7,7],[3,7,7],[3,3,7],[3,5,7]]
-- let e' = map efg_collate e
-- efg_diagram_set (round,25,4,75) e'
--
efg_diagram_set :: (Enum n, Real n) => (Cents -> n, n, n, n) -> [EFG n] -> [(n, n, n, n)]
instance GHC.Show.Show Music.Theory.Tuning.Tuning
instance GHC.Classes.Eq Music.Theory.Tuning.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 P.primes 315 == [3,3,5,7]
-- P.primeFactors 315 == [3,3,5,7]
--
factor :: Integral a => [a] -> a -> [a]
-- | factor n from primes.
--
--
-- map prime_factors [1,4,231,315] == [[],[2,2],[3,7,11],[3,3,5,7]]
-- map P.primeFactors [1,4,231,315] == [[],[2,2],[3,7,11],[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 . primeFactors.
--
--
-- 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 6 (32,9) == [5,-2,0,0,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 :: 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
-- length (table_2 0.04) == 66
--
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. "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]
--
--
--
-- scl <- scl_load "slendro_alves"
-- cents_i (scale_tuning 0.01 scl) == cents_i alves_slendro
--
alves_slendro :: Tuning
alves_pelog_bem_r :: [Rational]
-- | HMC pelog bem tuning.
--
--
-- cents_i alves_pelog_bem == [0,231,316,702,814]
--
--
--
-- scl <- scl_load "pelog_alves"
-- cents_i (scale_tuning 0.01 scl) == [0,231,316,471,702,814,969]
--
alves_pelog_bem :: Tuning
alves_pelog_barang_r :: [Rational]
-- | HMC pelog barang tuning.
--
--
-- cents_i alves_pelog_barang == [0,386,471,857,969]
--
alves_pelog_barang :: Tuning
alves_pelog_23467_r :: [Rational]
-- | HMC pelog 2,3,4,6,7 tuning.
--
--
-- cents_i alves_pelog_23467 == [0,386,471,702,969]
--
alves_pelog_23467 :: Tuning
-- | Bill Alves.
module Music.Theory.Tuning.DB.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
--
--
-- tn_divisions harrison_ditone == 12
-- tn_cents_i harrison_ditone == [0,114,204,294,408,498,612,702,816,906,996,1110]
--
harrison_ditone :: Tuning
-- | Kyle Gann.
module Music.Theory.Tuning.DB.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
--
--
--
-- map ((+ 60) . (/ 100)) pietro_aaron_1523_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]
--
--
--
-- import Music.Theory.Tuning.Scala
-- scl <- scl_load "meanquar"
-- cents_i (scale_tuning 0.01 scl) == [0,76,193,310,386,503,579,697,773,890,1007,1083]
--
pietro_aaron_1523 :: Tuning
-- | 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]
--
--
--
-- scl <- scl_load "young2"
-- cents_i (scale_tuning 0.01 scl) == cents_i thomas_young_1799
--
thomas_young_1799 :: Tuning
-- | Ratios for zarlino.
--
--
-- length zarlino_1588_r == 16
--
zarlino_1588_r :: [Rational]
-- | Gioseffo Zarlino, 1588, see
-- http://www.kylegann.com/tuning.html.
--
--
-- divisions zarlino_1588 == 16
-- cents_i zarlino_1588 == [0,71,182,204,294,316,386,498,569,590,702,773,884,996,1018,1088]
--
--
--
-- scl <- scl_load "zarlino2"
-- cents_i (scale_tuning 0.01 scl) == cents_i zarlino_1588
--
zarlino_1588 :: Tuning
-- | Ratios for ben_johnston_mtp_1977.
--
--
-- let c = [0,105,204,298,386,471,551,702,841,906,969,1088]
-- in map (round . ratio_to_cents) ben_johnston_mtp_1977_r == c
--
ben_johnston_mtp_1977_r :: [Rational]
-- | Ben Johnston's "Suite for Microtonal Piano" (1977), see
-- http://www.kylegann.com/tuning.html
--
--
-- cents_i ben_johnston_mtp_1977 == [0,105,204,298,386,471,551,702,841,906,969,1088]
--
ben_johnston_mtp_1977 :: 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
--
--
--
-- scl <- scl_load "gann_super"
-- cents_i (scale_tuning 0.01 scl) == cents_i gann_superparticular
--
gann_superparticular :: Tuning
-- | http://www.microtonal-synthesis.com/scales.html
module Music.Theory.Tuning.DB.Microtonal_Synthesis
-- | Ratios for pythagorean.
pythagorean_12_r :: [Rational]
-- | Pythagorean tuning,
-- http://www.microtonal-synthesis.com/scale_pythagorean.html.
--
--
-- cents_i pythagorean_12 == [0,114,204,294,408,498,612,702,816,906,996,1110]
--
--
--
-- scl <- scl_load "pyth_12"
-- cents_i (scale_tuning 0.1 scl) == cents_i pythagorean_12
--
pythagorean_12 :: 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), Alexander Malcolm's
-- Monochord (1721).
--
--
-- cents_i five_limit_tuning == [0,112,204,316,386,498,590,702,814,884,996,1088]
--
--
--
-- scl <- scl_load "malcolm"
-- cents_i (scale_tuning 0.1 scl) == cents_i five_limit_tuning
--
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
--
--
-- let c = [0,112,204,316,386,498,583,702,814,884,1018,1088]
-- in cents_i septimal_tritone_just_intonation == c
--
--
--
-- scl <- scl_load "ji_12"
-- cents_i (scale_tuning 0.1 scl) == cents_i septimal_tritone_just_intonation
--
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]
--
--
--
-- scl <- scl_load "kirnberger"
-- cents_i (scale_tuning 0.1 scl) == cents_i kirnberger_iii
--
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]
--
--
--
-- scl <- scl_load "vallotti"
-- cents_i (scale_tuning 0.1 scl) == cents_i vallotti
--
vallotti :: Tuning
mayumi_tsuda_r :: [Rational]
-- | Mayumi Tsuda 13-limit Just Intonation scale,
-- http://www.microtonal-synthesis.com/scale_reinhard.html.
--
--
-- cents_i mayumi_tsuda == [0,128,139,359,454,563,637,746,841,911,1072,1183]
--
--
--
-- scl <- scl_load "tsuda13"
-- cents_i (scale_tuning 0.1 scl) == cents_i mayumi_tsuda
--
mayumi_tsuda :: 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
--
--
--
-- import Music.Theory.Tuning.Scala
-- scl <- scl_load "harrison_16"
-- cents_i (scale_tuning 0.1 scl) == cents_i lou_harrison_16
--
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]
--
--
--
-- scl <- scl_load "partch_43"
-- cents_i (scale_tuning 0.1 scl) == cents_i partch_43
--
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
--
--
-- scl <- scl_load "johnston_25"
-- cents_i (scale_tuning 0.1 scl) == cents_i ben_johnston_25
--
ben_johnston_25 :: Tuning
-- | Terry Riley.
module Music.Theory.Tuning.DB.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]
--
--
--
-- import Music.Theory.Tuning.Scala
-- scl <- scl_load "riley_albion"
-- cents_i (scale_tuning 0.01 scl) == cents_i riley_albion
--
riley_albion :: Tuning
-- | Andreas Werckmeister (1645-1706).
module Music.Theory.Tuning.DB.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]
--
--
--
-- import Music.Theory.Tuning.Scala
-- scl <- scl_load "werck3"
-- cents_i (scale_tuning 0.01 scl) == cents_i werckmeister_iii
--
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]
--
--
--
-- scl <- scl_load "werck4"
-- cents_i (scale_tuning 0.01 scl) == cents_i werckmeister_iv
--
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]
--
--
--
-- scl <- scl_load "werck5"
-- cents_i (scale_tuning 0.01 scl) == cents_i werckmeister_v
--
werckmeister_v :: Tuning
-- | Ratios for werckmeister_vi, with supposed correction of 2825
-- to 4944.
--
--
-- let c = [0,91,186,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,186,298,395,498,595,698,793,893,1000,1097]
--
--
--
-- scl <- scl_load "werck6"
-- cents_i (scale_tuning 0.01 scl) == cents_i werckmeister_vi
--
werckmeister_vi :: Tuning
-- | Equal temperament tuning tables.
module Music.Theory.Tuning.ET
-- | octpc_to_pitch and octpc_to_cps.
octpc_to_pitch_cps_f0 :: (Floating n) => n -> OctPC -> (Pitch, n)
-- | 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 has given frequency.
--
--
-- tbl_12et_f0 415
--
tbl_12et_f0 :: Double -> [(Pitch, Double)]
-- | tbl_12et_f0 440hz.
--
--
-- length tbl_12et == 132
-- minmax (map (round . snd) tbl_12et) == (16,31609)
--
tbl_12et :: [(Pitch, Double)]
-- | 24-tone equal temperament variant of tbl_12et_f0.
tbl_24et_f0 :: Double -> [(Pitch, Double)]
-- | tbl_24et_f0 440.
--
--
-- length tbl_24et == 264
-- minmax (map (round . snd) tbl_24et) == (16,32535)
--
tbl_24et :: [(Pitch, Double)]
-- | Given an ET table (or like) find bounds of frequency.
--
-- import qualified Music.Theory.Tuple as T
--
--
-- let r = Just (T.t2_map 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.
--
-- (cps,nearest-pitch,cps-of-nearest-pitch,cps-deviation,cents-deviation)
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_R, 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_R, 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_R
-- | Pitch with 12-ET/24-ET tuning deviation given in Cents.
type Pitch_Detune = (Pitch, Cents)
-- | Extract 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
-- | Euler plane diagrams as dot language graph.
module Music.Theory.Tuning.Euler
-- | fold_ratio_to_octave of *.
rat_mul :: Rational -> Rational -> Rational
-- | fold_ratio_to_octave of /.
rat_div :: Rational -> Rational -> Rational
-- | n = length, m equals multiplier, r = initial
-- ratio.
--
--
-- tun_seq 5 (3/2) 1 == [1/1,3/2,9/8,27/16,81/64]
--
tun_seq :: Int -> Rational -> Rational -> [Rational]
mod12 :: Integral a => a -> a
-- | ratio_to_cents rounded to nearest multiple of 100, modulo 12.
--
--
-- map (ratio_to_pc 0) [1,4/3,3/2,2] == [0,5,7,0]
--
ratio_to_pc :: Int -> Rational -> Int
all_pairs :: [t] -> [u] -> [(t, u)]
-- | Give all pairs from (l2,l1) and (l3,l2) that are at interval ratios r1
-- and r2 respectively.
euler_align_rat :: T2 Rational -> T3 [Rational] -> T2 [T2 Rational]
-- | Pretty printer for pitch class.
--
--
-- unwords (map pc_pp [0..11]) == "C♮ C♯ D♮ E♭ E♮ F♮ F♯ G♮ A♭ A♮ B♭ B♮"
--
pc_pp :: (Integral i, Show i) => i -> String
cents_pp :: Rational -> String
rat_label :: (Int, Bool) -> Rational -> String
rat_id :: Rational -> String
rat_edge_label :: (Rational, Rational) -> String
-- | Zip start-middle-end.
--
--
-- zip_sme (0,1,2) "abcd" == [(0,'a'),(1,'b'),(1,'c'),(2,'d')]
--
zip_sme :: (t, t, t) -> [u] -> [(t, u)]
type Euler_Plane t = ([[t]], [(t, t)])
euler_plane_to_dot :: (t -> String, t -> String, (t, t) -> String) -> Euler_Plane t -> [String]
euler_plane_to_dot_rat :: (Int, Bool) -> Euler_Plane Rational -> [String]
-- | Kyle Gann. "La Monte Young's The Well-Tuned Piano". Perspectives of
-- New Music, 31(1):134--162, Winter 1993.
module Music.Theory.Tuning.Gann_1993
-- | Ratios for lmy_wtp. lmy = La Monte Young. wtp = Well-Tuned
-- Piano.
--
--
-- let c = [0,177,204,240,471,444,675,702,738,969,942,1173]
-- in map (round . T.ratio_to_cents) lmy_wtp_r == c
--
lmy_wtp_r :: [Rational]
-- | The pitch-class of the key associated with each ratio of the tuning.
--
--
-- mapMaybe lmy_wtp_ratio_to_pc [1,1323/1024,7/4] == [3,8,0]
--
lmy_wtp_ratio_to_pc :: Rational -> Maybe PitchClass
lmy_wtp_ratio_to_pc_err :: Rational -> PitchClass
-- | The list of all non-unison ascending intervals possible in
-- lmy_wtp_r.
--
--
-- length lmy_wtp_univ == 66
--
lmy_wtp_univ :: [(Rational, (PitchClass, PitchClass))]
-- | Collated and sorted lmy_wtp_univ.
--
--
-- let r_cents_pp = show . round . T.ratio_to_cents
--
--
--
-- import qualified Music.Theory.Math as T
--
--
--
-- let f (r,i) = concat [T.ratio_pp r," = "
-- ,r_cents_pp r," = #"
-- ,show (length i)," = "
-- ,unwords (map show i)]
--
--
--
-- putStrLn $ unlines $ map f lmy_wtp_uniq
--
--
-- 3:2 = 702 = #9 = (3,10) (4,9) (5,10) (6,11) (6,1) (7,0) (7,2) (8,1)
-- (9,2) 7:4 = 969 = #7 = (3,0) (5,2) (6,7) (7,10) (8,9) (11,0) (1,2) 7:6
-- = 267 = #6 = (4,8) (5,7) (6,2) (7,11) (9,1) (10,0) 9:7 = 435 = #4 =
-- (4,1) (5,0) (6,9) (11,2) 9:8 = 204 = #6 = (3,5) (4,2) (6,8) (7,9)
-- (11,1) (0,2) 21:16 = 471 = #6 = (3,7) (5,9) (6,0) (7,1) (8,2) (10,2)
-- 27:14 = 1137 = #2 = (4,6) (9,11) 27:16 = 906 = #3 = (4,7) (8,11) (9,0)
-- 49:32 = 738 = #3 = (3,11) (5,1) (6,10) 49:36 = 534 = #1 = (5,11) 63:32
-- = 1173 = #5 = (3,2) (4,5) (8,7) (9,10) (1,0) 49:48 = 36 = #2 = (5,6)
-- (10,11) 81:56 = 639 = #1 = (4,11) 81:64 = 408 = #1 = (4,0) 147:128 =
-- 240 = #3 = (3,6) (5,8) (10,1) 189:128 = 675 = #3 = (3,9) (4,10) (8,0)
-- 441:256 = 942 = #2 = (3,1) (8,10) 567:512 = 177 = #1 = (3,4) 1323:1024
-- = 444 = #1 = (3,8)
lmy_wtp_uniq :: [(Rational, [(PitchClass, PitchClass)])]
-- | Gann, 1993, p.137.
--
--
-- cents_i lmy_wtp == [0,177,204,240,471,444,675,702,738,969,942,1173]
--
--
--
-- import Data.List
-- import Music.Theory.Tuning.Scala
-- scl <- scl_load "young-lm_piano"
-- cents_i (scale_to_tuning 0.01 scl) == cents_i lmy_wtp
--
--
--
-- let f = d12_midi_tuning_f (lmy_wtp,-74.7,-3)
-- import qualified Music.Theory.Pitch as T
-- T.octpc_to_midi (-1,11) == 11
-- map (round . T.midi_detune_to_cps . f) [62,63,69] == [293,298,440]
-- map (fmap round . T.midi_detune_normalise . f) [0 .. 127]
--
lmy_wtp :: Tuning
-- | Ratios for 'lmy_wtp_1964.
lmy_wtp_1964_r :: [Rational]
-- | La Monte Young's initial 1964 tuning for "The Well-Tuned Piano" (Gann,
-- 1993, p.141).
--
--
-- cents_i lmy_wtp_1964 == [0,149,204,240,471,647,675,702,738,969,1145,1173]
--
--
--
-- import Music.Theory.Tuning.Scala
-- let nm = ("young-lm_piano_1964","LaMonte Young's Well-Tuned Piano (1964)")
-- let scl = tuning_to_scale nm lmy_wtp_1964
-- putStr $ unlines $ scale_pp scl
--
lmy_wtp_1964 :: Tuning
-- | Euler diagram for lmy_wtp.
--
-- let dir = "homerohanswhmtdatadot/" let f =
-- unlines . T.euler_plane_to_dot_rat (3,True) writeFile (dir ++
-- "euler-wtp.dot") (f lmy_wtp_euler)
lmy_wtp_euler :: Euler_Plane Rational
-- | 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]
-- | 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
-- scl <- T.scl_load "polansky_ps"
-- T.pitch_representations (T.scale_pitches scl) == (0,50)
-- 1 : Data.Either.rights (T.scale_pitches scl) == psaltery_r
--
psaltery_r :: [Rational]
-- | fold_ratio_to_octave' of psaltery.
--
--
-- length psaltery_r == 51 && length psaltery_o_r == 21
--
--
--
-- psaltery_o_r == [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_r :: [Rational]
-- | Tuning derived from psaltery_o with
-- octave_ratio of 2.
--
--
-- cents_i psaltery_o == [0,27,53,105,155,204,275,342,386,471,491,551,590
--
--
-- ,702,773,807,841,906,938,969,1088]
--
--
-- let r = [0,1200,1902,2400,2786,3102,3369,3600,3804,3986,4151,4302,4441,4569,4688,4800,4905
--
--
--
-- ,386,1586,2288,2786,3173,3488,3755,3986,4190,4373,4538,4688,4827,4955,5075,5186,5291
-- ,702,1902,2604,3102,3488,3804,4071,4302,4506,4688,4853,5004,5142,5271,5390,5502]
-- > in cents_i (T.scale_tuning 0.01 scl) == r
psaltery_o :: Tuning
-- | 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_2 :: Fractional n => [n]
gm_3 :: Fractional n => [n]
gm_4 :: Fractional n => [n]
gm_5 :: Fractional n => [n]
gm_6 :: Fractional n => [n]
gm_7 :: Fractional n => [n]
gm_8 :: 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
-- | 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
-- | DB of locally defined tunings, but for ordinary use see
-- Music.Theory.Tuning.Scala.
module Music.Theory.Tuning.DB
-- | (last-name,first-name,title,year,hmttuning,scalaname)
type Named_Tuning = (String, String, String, String, Tuning, String)
named_tuning_t :: Named_Tuning -> Tuning
tuning_db :: [Named_Tuning]
tuning_db_lookup_scl :: String -> Maybe Tuning
-- | 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]
-- | William A. Sethares. "Adaptive Tunings for Musical Scales". Journal
-- of the Acoustical Society of America, 96(1), July 1994.
--
-- http://sethares.engr.wisc.edu/consemi.html
module Music.Theory.Tuning.Sethares_1994
d :: (Floating n, Ord n) => (n, n) -> (n, n) -> n
fig_1 :: (Floating n, Enum n, Ord n) => [[n]]
d_h :: (Floating n, Ord n) => [(n, n)] -> [(n, n)] -> n
-- | 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
-- | 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, 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 GHC.Show.Show Music.Theory.Dynamic_Mark.Hairpin_T
instance GHC.Enum.Bounded Music.Theory.Dynamic_Mark.Hairpin_T
instance GHC.Enum.Enum Music.Theory.Dynamic_Mark.Hairpin_T
instance GHC.Classes.Ord Music.Theory.Dynamic_Mark.Hairpin_T
instance GHC.Classes.Eq Music.Theory.Dynamic_Mark.Hairpin_T
instance GHC.Show.Show Music.Theory.Dynamic_Mark.Dynamic_Mark_T
instance GHC.Enum.Bounded Music.Theory.Dynamic_Mark.Dynamic_Mark_T
instance GHC.Enum.Enum Music.Theory.Dynamic_Mark.Dynamic_Mark_T
instance GHC.Classes.Ord Music.Theory.Dynamic_Mark.Dynamic_Mark_T
instance GHC.Classes.Eq Music.Theory.Dynamic_Mark.Dynamic_Mark_T
-- | 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
-- | Is multiplier the identity (ie. 1)?
duration_m1 :: 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.
-- | 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_err :: Duration -> Duration -> Duration
-- | Standard divisions (from 0 to 256). MusicXML allows -1 as a
-- division (for long).
divisions_set :: [Integer]
-- | Durations set derived from divisions_set with up to k
-- dots. Multiplier of 1.
duration_set :: Integer -> [Duration]
-- | Table of number of beams at notated division.
beam_count_tbl :: [(Integer, Integer)]
-- | Lookup beam_count_tbl.
--
--
-- 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 [Duration 2 0 1,Duration 16 0 1] == [0,2]
--
duration_beam_count :: Duration -> Integer
-- | Table giving MusicXML types for divisions.
division_musicxml_tbl :: [(Integer, String)]
-- | Lookup division_musicxml_tbl.
--
--
-- 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, dots & multipler are
-- ignored.
--
--
-- duration_to_musicxml_type (Duration 4 0 1) == "quarter"
--
duration_to_musicxml_type :: Duration -> String
-- | Table giving Unicode symbols for divisions.
division_unicode_tbl :: [(Integer, Char)]
-- | Lookup division_unicode_tbl.
--
--
-- map whole_note_division_to_unicode_symbol [1,2,4,8] == "𝅝𝅗𝅥𝅘𝅥𝅘𝅥𝅮"
--
whole_note_division_to_unicode_symbol :: Integer -> Char
-- | Give Unicode string for Duration. The duration multiplier is
-- not written.
--
--
-- map duration_to_unicode [Duration 1 2 1,Duration 4 1 1] == ["𝅝𝅭𝅭","𝅘𝅥𝅭"]
--
duration_to_unicode :: Duration -> String
-- | Give Lilypond notation for Duration. Note that the
-- duration multiplier is not written.
--
--
-- map duration_to_lilypond_type [Duration 2 0 1,Duration 4 1 1] == ["2","4."]
--
duration_to_lilypond_type :: Duration -> 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
whole_note_division_letter_pp :: Integer -> Maybe Char
duration_letter_pp :: Duration -> Maybe String
instance GHC.Show.Show Music.Theory.Duration.Duration
instance GHC.Classes.Eq Music.Theory.Duration.Duration
instance GHC.Classes.Ord Music.Theory.Duration.Duration
-- | Names for common music notation durations.
module Music.Theory.Duration.Name
breve :: Duration
whole_note :: Duration
half_note :: Duration
quarter_note :: Duration
eighth_note :: Duration
sixteenth_note :: Duration
thirtysecond_note :: Duration
dotted_breve :: Duration
dotted_whole_note :: Duration
dotted_half_note :: Duration
dotted_quarter_note :: Duration
dotted_eighth_note :: Duration
dotted_sixteenth_note :: Duration
dotted_thirtysecond_note :: Duration
double_dotted_breve :: Duration
double_dotted_whole_note :: Duration
double_dotted_half_note :: Duration
double_dotted_quarter_note :: Duration
double_dotted_eighth_note :: Duration
double_dotted_sixteenth_note :: Duration
double_dotted_thirtysecond_note :: Duration
-- | 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. The prefix is _ not d since
-- d4 etc. are also note names.
--
--
-- 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
h :: Duration
q :: Duration
e :: Duration
s :: Duration
w' :: Duration
h' :: Duration
q' :: Duration
e' :: Duration
s' :: Duration
w'' :: Duration
h'' :: Duration
q'' :: Duration
e'' :: Duration
s'' :: Duration
_1 :: Duration
_2 :: Duration
_4 :: Duration
_8 :: Duration
_16 :: Duration
_32 :: Duration
_1' :: Duration
_2' :: Duration
_4' :: Duration
_8' :: Duration
_16' :: Duration
_32' :: Duration
_1'' :: Duration
_2'' :: Duration
_4'' :: Duration
_8'' :: Duration
_16'' :: Duration
_32'' :: Duration
-- | Rational quarter-note notation for durations.
module Music.Theory.Duration.RQ
-- | Rational Quarter-Note
type RQ = Rational
rq_duration_tbl :: Integer -> [(Rational, Duration)]
-- | 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]
-- | 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 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]]
-- | 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 GHC.Show.Show Music.Theory.Duration.Annotation.D_Annotation
instance GHC.Classes.Eq Music.Theory.Duration.Annotation.D_Annotation
-- | 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]
-- | 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
-- | compare on ts_rq.
ts_compare :: Time_Signature -> Time_Signature -> Ordering
-- | 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 :: RQ -> 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 (7,4) == [1,1,1,1,1,1,1]
--
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)
-- | 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 GHC.Show.Show Music.Theory.Duration.CT.CT
instance GHC.Show.Show Music.Theory.Duration.CT.CT_Node
instance GHC.Classes.Eq Music.Theory.Duration.CT.CT_Node
-- | 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]
-- | Run simplifier until it reaches a fix-point, or for at most
-- limit passes.
m_simplify_fix :: Int -> 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 4 sr ts (Just ts_p) rq
--
notate_rqp :: Int -> Simplify_P -> [Time_Signature] -> Maybe [[RQ]] -> [RQ] -> Either String [[Duration_A]]
-- | Variant of notate_rqp without pulse divisions (derive).
--
--
-- notate 4 (default_rule [((3,2),0,(2,2)),((3,2),0,(4,2))]) [(3,2)] [6]
--
notate :: Int -> 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 => Int -> [Simplify_T] -> [Time_Signature] -> Maybe [[RQ]] -> [RQ] -> [a] -> Either String [[(Duration_A, a)]]
notate_mm_ascribe_err :: Show a => Int -> [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 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 :: Ord a => [(String, (a, a))] -> a -> Maybe String
-- | Directory functions.
module Music.Theory.Directory
-- | Scan a list of directories until a file is located, or not.
path_scan :: [FilePath] -> FilePath -> IO (Maybe FilePath)
path_scan_err :: [FilePath] -> FilePath -> IO FilePath
-- | Subset of files in dir with an extension in ext.
dir_subset :: [String] -> FilePath -> IO [FilePath]
-- | If path is not absolute, prepend current working directory.
--
--
-- to_absolute_cwd "x"
--
to_absolute_cwd :: FilePath -> IO FilePath
-- | Parser for the Scala scale file format. See
-- http://www.huygens-fokker.org/scala/scl_format.html for
-- details. This module succesfully parses all 4671 scales in v.85 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)
-- | An enumeration type for .scl pitch classification.
data Pitch_Type
Pitch_Cents :: Pitch_Type
Pitch_Ratio :: Pitch_Type
-- | A nearness value for deriving approximate rationals.
type Epsilon = Double
-- | Derive Pitch_Type from Pitch.
pitch_type :: Pitch i -> Pitch_Type
-- | Pitch as Cents, conversion by ratio_to_cents if
-- necessary.
pitch_cents :: Integral i => Pitch i -> Cents
-- | Pitch as Rational, conversion by reconstructed_ratio if
-- necessary, hence epsilon.
pitch_ratio :: Epsilon -> Pitch Integer -> Rational
-- | A pair giving the number of Cents and number of Ratio
-- pitches.
pitch_representations :: Integral t => [Pitch i] -> (t, t)
-- | If scale is uniform, give type.
uniform_pitch_type :: [Pitch i] -> Maybe Pitch_Type
-- | The predominant type of the pitches for Scale.
pitch_type_predominant :: [Pitch i] -> Pitch_Type
-- | A scale has a name, a description, a degree, and a list of
-- Pitches.
type Scale i = (String, String, Int, [Pitch i])
-- | The name of a scale.
scale_name :: Scale i -> String
-- | Text description of a scale.
scale_description :: Scale i -> String
-- | The degree of the scale (number of Pitches).
scale_degree :: Scale i -> Int
-- | The Pitches at Scale.
scale_pitches :: Scale i -> [Pitch i]
-- | Ensure degree and number of pitches align.
scale_verify :: Scale i -> Bool
-- | Raise error if scale doesn't verify, else id.
scale_verify_err :: Scale i -> Scale 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
-- | Are all pitches of the same type.
is_scale_uniform :: Scale i -> Bool
-- | 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 :: Integral i => Scale i -> [Cents]
-- | map round of scale_cents.
scale_cents_i :: Integral i => Scale i -> [i]
-- | Scale as list of Rational (ie. pitch_ratio) with
-- 1 prefix.
scale_ratios :: Epsilon -> Scale Integer -> [Rational]
-- | Require that Scale be uniformlay of Ratios.
scale_ratios_req :: Integral i => Scale i -> [Ratio i]
-- | Translate Scale to Tuning. If Scale is uniformly
-- rational, Tuning is rational, else Tuning is in
-- Cents. Epsilon is used to recover the Rational
-- octave if required.
scale_to_tuning :: Epsilon -> Scale Integer -> Tuning
-- | Convert Tuning to Scale.
--
--
-- tuning_to_scale ("et12","12 tone equal temperament") (T.equal_temperament 12)
--
tuning_to_scale :: (String, String) -> Tuning -> Scale Integer
-- | Are scales equal (==) at degree and tuning data.
--
--
-- db <- scl_load_db
-- let r = [2187/2048,9/8,32/27,81/64,4/3,729/512,3/2,6561/4096,27/16,16/9,243/128,2/1]
-- let Just py = find (scale_eq ("","",12,map Right r)) db
-- scale_name py == "pyth_12"
--
--
--
-- let c = map T.ratio_to_cents r
-- let Just py' = find (scale_eqv ("","",12,map Left c)) db
-- scale_name py' == "pyth_12"
--
scale_eq :: Eq n => Scale n -> Scale n -> Bool
-- | Are scales equal (==) at degree and tuning data after
-- pitch_cents.
scale_eqv :: Integral n => Scale n -> Scale n -> Bool
-- | Comment lines begin with !.
is_comment :: String -> Bool
-- | Remove to end of line ! comments.
--
--
-- remove_eol_comments " 1 ! comment" == " 1 "
--
remove_eol_comments :: String -> String
-- | Remove comments and null lines and trailing comments.
--
--
-- filter_comments ["!a","b","","c","d!e"] == ["b","c","d"]
--
filter_comments :: [String] -> [String]
-- | Pitches are either cents (with decimal point, possibly trailing) or
-- ratios (with /).
--
--
-- map parse_pitch ["700.0","350.","3/2","2"] == [Left 700,Left 350,Right (3/2),Right 2]
--
parse_pitch :: (Read i, Integral i) => String -> Pitch i
-- | Pitch lines may contain commentary.
parse_pitch_ln :: (Read i, Integral i) => String -> Pitch i
-- | Parse .scl file.
parse_scl :: (Read i, Integral i) => String -> String -> Scale i
-- | Read the environment variable SCALA_SCL_DIR, which is a
-- sequence of directories used to locate scala files on.
--
--
-- setEnv "SCALA_DIST_DIR" "/home/rohan/data/scala/85/scl"
--
scl_get_dir :: IO [String]
-- | Lookup the SCALA_SCL_DIR environment variable, which must
-- exist, and derive the filepath. It is an error if the name has a file
-- extension.
--
--
-- mapM scl_derive_filename ["young-lm_piano","et12"]
--
scl_derive_filename :: FilePath -> IO FilePath
-- | If the name is an absolute file path and has a .scl
-- extension, then return it, else run scl_derive_filename.
--
--
-- scl_resolve_name "young-lm_piano"
-- scl_resolve_name "/home/rohan/data/scala/85/scl/young-lm_piano.scl"
-- scl_resolve_name "/home/rohan/data/scala/85/scl/unknown-tuning.scl"
--
scl_resolve_name :: String -> IO FilePath
-- | Load .scl file, runs resolve_scl.
--
--
-- s <- scl_load "xenakis_chrom"
-- pitch_representations (scale_pitches s) == (6,1)
-- scale_ratios 1e-3 s == [1,21/20,29/23,179/134,280/187,11/7,100/53,2]
--
scl_load :: (Read i, Integral i) => String -> IO (Scale i)
-- | scale_to_tuning of scl_load.
scl_load_tuning :: Epsilon -> String -> IO Tuning
-- | Load all .scl files at dir.
--
--
-- dir <- scl_get_dir
-- dir == ["/home/rohan/data/scala/85/scl","/home/rohan/sw/hmt/data/scl"]
-- let [scl_85_dir,ext_dir] = dir
-- db <- scl_load_dir scl_85_dir
-- length db == 4671
-- length (filter ((== 0) . scale_degree) db) == 0
-- length (filter ((/= 1) . head . scale_ratios 1e-3) db) == 0
-- length (filter ((/= 0) . head . scale_cents) db) == 0
-- length (filter (== Just (Right 2)) (map scale_octave db)) == 4003
-- length (filter is_scale_uniform db) == 2816
--
--
--
-- let na = filter (not . T.is_ascending . scale_cents) db
-- length na == 121
-- mapM_ (putStrLn . unlines . scale_stat) na
--
--
--
-- import qualified Music.Theory.List as T
-- import Sound.SC3.Plot
-- plot_p2_stp [T.histogram (map scale_degree db)]
--
--
--
-- import Data.List
--
--
--
-- 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
--
--
--
-- let r = ["LaMonte Young, tuning of For Guitar '58. 1/1 March '92, inv.of Mersenne lute 1"
-- ,"LaMonte Young's Well-Tuned Piano"]
-- in filter (isInfixOf "LaMonte Young") (map scale_description db) == r
--
--
--
-- length (filter (not . perfect_octave) db) == 663
--
scl_load_dir :: (Read i, Integral i) => FilePath -> IO [Scale i]
-- | Load Scala data base at scl_get_dir.
--
--
-- db <- scl_load_db
-- mapM_ (putStrLn.unlines.scale_stat) (filter (not . perfect_octave) db)
--
scl_load_db :: (Read i, Integral i) => IO [Scale i]
scale_stat :: (Integral i, Show i) => Scale i -> [String]
-- | Pretty print Pitch in Scala format.
pitch_pp :: Show i => Pitch i -> String
-- | Pretty print Scale in Scala format.
--
--
-- s <- scl_load "et19"
-- s <- scl_load "young-lm_piano"
-- putStr $ unlines $ scale_pp s
--
scale_pp :: Show i => Scale i -> [String]
-- | scala distribution directory, given at
-- SCALA_DIST_DIR.
--
--
-- fmap (== "/home/rohan/opt/build/scala-22-pc64-linux") dist_get_dir
--
dist_get_dir :: IO String
-- | Load file from dist_get_dir.
--
--
-- s <- load_dist_file "intnam.par"
-- length s == 473
--
load_dist_file :: FilePath -> IO [String]
instance GHC.Show.Show Music.Theory.Tuning.Scala.Pitch_Type
instance GHC.Classes.Eq Music.Theory.Tuning.Scala.Pitch_Type
-- | David Rosenboom, "In the Beginning: Etude I (Trombones)", 1979
-- http://davidrosenboom.com/media/beginning-etude-i-trombones
--
-- kw: subharmonics, difference tones
module Music.Theory.Tuning.Rosenboom_1979
t2_to_ratio :: (Integer, Integer) -> Rational
-- | Tuning, ratios for each octave.
--
--
-- length (concat dr_tuning_oct) == 19
-- import qualified Music.Theory.Tuning as T
-- map (map (T.ratio_to_cents . t2_to_ratio)) dr_tuning_oct
--
dr_tuning_oct :: Num n => [[(n, n)]]
-- | Tuning, actual ratios.
dr_tuning :: [Rational]
-- | Actual scale, in CPS.
--
--
-- let r = [52,69,76,83,92,104,119,138,156,166,185,208,234,260,277,286,311,332,363]
-- in map round dr_scale == r
--
dr_scale :: [Double]
dr_scale_tbl_12et :: [HS_R Pitch]
dr_scale_scala :: Scale Integer
dr_scale_tbl_24et :: [HS_R Pitch]
dr_chords :: [[Pitch]]
dr_ratio_seq :: Num n => [[(n, n)]]
dr_ratio_seq_hist :: (Ord n, Num n) => [((n, n), Int)]
dr_nt :: Integral i => [([i], [i])]
dr_nt_pitch :: ([Int], [Int]) -> ([Pitch], [Pitch])
-- | Parser for the intnam.par file.
module Music.Theory.Tuning.Scala.Interval
-- | Interval and name, ie. (3/2,"perfect fifth")
type INTERVAL = (Rational, String)
-- | Length prefixed list of INTERVAL.
type INTNAM = (Int, [INTERVAL])
-- | Lookup ratio in INTNAM.
--
--
-- db <- load_intnam
-- intnam_search_ratio db (3/2) == Just (3/2,"perfect fifth")
-- intnam_search_ratio db (2/3) == Nothing
-- intnam_search_ratio db (4/3) == Just (4/3,"perfect fourth")
-- map (intnam_search_ratio db) [3/2,4/3,7/4,7/6,9/7,12/7,14/9]
-- intnam_search_ratio db (31/16) == Just (31/16,"31st harmonic")
--
intnam_search_ratio :: INTNAM -> Rational -> Maybe INTERVAL
-- | Lookup interval name in INTNAM, ci = case-insensitive.
--
--
-- db <- load_intnam
-- intnam_search_description_ci db "didymus"
--
intnam_search_description_ci :: INTNAM -> String -> [INTERVAL]
parse_intnam_entry :: [String] -> INTERVAL
parse_intnam :: [String] -> INTNAM
-- | parse_intnam of load_dist_file of "intnam.par".
--
--
-- intnam <- load_intnam
-- fst intnam == length (snd intnam)
--
load_intnam :: IO INTNAM
-- | Parser for the modename.par file.
module Music.Theory.Tuning.Scala.Mode
-- | (start-degree,intervals,description)
type MODE = (Int, [Int], String)
mode_starting_degree :: MODE -> Int
mode_intervals :: MODE -> [Int]
mode_description :: MODE -> String
mode_degree :: MODE -> Int
-- | (mode-count,_,mode-list)
type MODENAM = (Int, Int, [MODE])
modenam_modes :: MODENAM -> [MODE]
-- | Search for mode by interval list.
modenam_search_seq :: MODENAM -> [Int] -> [MODE]
-- | Expect one result.
--
--
-- mn <- load_modenam
-- let sq = putStrLn . unlines . mode_stat . fromJust . modenam_search_seq1 mn
-- sq [2,2,1,2,2,2,1]
-- sq [2,1,2,2,1,2,2]
-- sq [2,1,2,2,1,3,1]
-- sq (replicate 6 2)
-- sq [1,2,1,2,1,2,1,2]
-- sq [2,1,2,1,2,1,2,1]
-- sq (replicate 12 1)
--
modenam_search_seq1 :: MODENAM -> [Int] -> Maybe MODE
-- | Search for mode by description text.
--
--
-- map (modenam_search_description mn) ["Messiaen","Xenakis","Raga"]
--
modenam_search_description :: MODENAM -> String -> [MODE]
-- | Pretty printer.
mode_stat :: MODE -> [String]
-- | Bracketed integers are a non-implicit starting degree.
--
--
-- map non_implicit_degree ["4","[4]"] == [Nothing,Just 4]
--
non_implicit_degree :: String -> Maybe Int
is_non_implicit_degree :: String -> Bool
is_integer :: String -> Bool
parse_modenam_entry :: [String] -> MODE
-- | Lines ending with @@ continue to next line.
join_long_lines :: [String] -> [String]
parse_modenam :: [String] -> MODENAM
-- | parse_modenam of load_dist_file of modenam.par.
--
--
-- mn <- load_modenam
-- let (n,x,m) = mn
-- n == 2125 && x == 15 && length m == n
--
load_modenam :: IO MODENAM
-- | key: value database, allows duplicate keys.
module Music.Theory.DB.Plain
-- | (RECORD-SEPARATOR,FIELD-SEPARATOR,ENTRY-SEPARATOR)
type SEP = (String, String, String)
type Key = String
type Value = String
type Entry = (Key, [Value])
type Record = [Entry]
type DB = [Record]
sep_plain :: SEP
record_parse :: (String, String) -> String -> Record
record_lookup :: Key -> Record -> [Value]
record_lookup_at :: (Key, Int) -> Record -> Maybe Value
record_has_key :: Key -> Record -> Bool
record_lookup_uniq :: Key -> Record -> Maybe Value
db_parse :: SEP -> String -> [Record]
db_sort :: [(Key, Int)] -> [Record] -> [Record]
db_load_utf8 :: SEP -> FilePath -> IO [Record]
record_pp :: (String, String) -> Record -> String
db_store_utf8 :: SEP -> FilePath -> [Record] -> IO ()
module Music.Theory.DB.Common
type Entry k v = (k, v)
type Record k v = [Entry k v]
type DB k v = [Record k v]
type Key = String
type Value = String
type Entry' = Entry Key Value
type Record' = Record Key Value
type DB' = DB Key Value
-- | The sequence of keys at Record.
record_key_seq :: Record k v -> [k]
-- | True if Key is present in Entity.
record_has_key :: Eq k => k -> Record k v -> Bool
-- | histogram of record_key_seq.
record_key_histogram :: Ord k => Record k v -> [(k, Int)]
-- | Duplicate keys predicate.
record_has_duplicate_keys :: Ord k => Record k v -> Bool
-- | Find all associations for key using given equality function.
record_lookup_by :: (k -> k -> Bool) -> k -> Record k v -> [v]
-- | record_lookup_by of ==.
record_lookup :: Eq k => k -> Record k v -> [v]
-- | nth element of record_lookup.
record_lookup_at :: Eq k => (k, Int) -> Record k v -> Maybe v
-- | Variant of record_lookup requiring a unique key. Nothing
-- indicates there is no entry, it is an error if duplicate keys
-- are present.
record_lookup_uniq :: Eq k => k -> Record k v -> Maybe v
-- | True if key exists and is unique.
record_has_key_uniq :: Eq k => k -> Record k v -> Bool
-- | Error variant.
record_lookup_uniq_err :: Eq k => k -> Record k v -> v
-- | Default value variant.
record_lookup_uniq_def :: Eq k => v -> k -> Record k v -> v
-- | Remove all associations for key using given equality function.
record_delete_by :: (k -> k -> Bool) -> k -> Record k v -> Record k v
-- | record_delete_by of ==.
record_delete :: Eq k => k -> Record k v -> Record k v
-- | Preserves order of occurence.
db_key_set :: Ord k => DB k v -> [k]
db_lookup_by :: (k -> k -> Bool) -> (v -> v -> Bool) -> k -> v -> DB k v -> [Record k v]
db_lookup :: (Eq k, Eq v) => k -> v -> DB k v -> [Record k v]
db_has_duplicate_keys :: Ord k => DB k v -> Bool
db_key_histogram :: Ord k => DB k v -> [(k, Int)]
db_to_table :: Ord k => (Maybe v -> e) -> DB k v -> ([k], [[e]])
record_collate' :: Eq k => (k, [v]) -> Record k v -> Record k [v]
-- | Collate adjacent entries of existing sequence with equal key.
record_collate :: Eq k => Record k v -> Record k [v]
record_uncollate :: Record k [v] -> Record k v
-- | JSON string association database. JSON objects do no allow multiple
-- keys. Here multiple keys are read & written as arrays.
module Music.Theory.DB.JSON
-- | Load DB from FilePath.
db_load_utf8 :: FilePath -> IO DB'
-- | Store DB to FilePath.
--
--
-- let fn = "/home/rohan/ut/www-spr/data/db.js"
-- db <- db_load_utf8 fn
-- length db == 1334
-- db_store_utf8 "/tmp/sp.js" db
--
db_store_utf8 :: FilePath -> DB' -> IO ()
data Maybe_List_Of_String
S :: String -> Maybe_List_Of_String
L :: [String] -> Maybe_List_Of_String
maybe_list_to_list :: Maybe_List_Of_String -> [String]
list_to_maybe_list :: [String] -> Maybe_List_Of_String
instance GHC.Show.Show Music.Theory.DB.JSON.Maybe_List_Of_String
instance GHC.Classes.Eq Music.Theory.DB.JSON.Maybe_List_Of_String
instance Data.Aeson.Types.ToJSON.ToJSON Music.Theory.DB.JSON.Maybe_List_Of_String
instance Data.Aeson.Types.FromJSON.FromJSON Music.Theory.DB.JSON.Maybe_List_Of_String
-- | Keys are given in the header, empty fields are omitted from records.
module Music.Theory.DB.CSV
-- | Load DB from FilePath.
db_load_utf8 :: FilePath -> IO DB'
db_store_utf8 :: FilePath -> DB' -> IO ()
-- | 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
-- | 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)]
-- | 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 GHC.Classes.Eq Music.Theory.Contour.Polansky_1992.Contour_Description
instance GHC.Classes.Ord Music.Theory.Contour.Polansky_1992.Contour_Half_Matrix
instance GHC.Classes.Eq Music.Theory.Contour.Polansky_1992.Contour_Half_Matrix
instance GHC.Show.Show Music.Theory.Contour.Polansky_1992.Contour_Half_Matrix
instance GHC.Show.Show Music.Theory.Contour.Polansky_1992.Contour_Description
-- | 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 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 => Psi a -> Delta n a -> ([a] -> a) -> [n] -> [n] -> a
olm_no_delta :: (Real a, Real n, Fractional n) => [a] -> [a] -> n
olm_no_delta_squared :: Floating a => [a] -> [a] -> a
second_order :: (Num n) => ([n] -> [n] -> t) -> [n] -> [n] -> t
olm_no_delta_second_order :: (Real a, Fractional a) => [a] -> [a] -> a
olm_no_delta_squared_second_order :: 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 => 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 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 n, Fractional n) => Interval a n -> [a] -> [a] -> n
-- | 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 :: Int -> [a] -> [[a]]
-- | Tom Johnson. Other Harmony: Beyond Tonal and Atonal. Editions
-- 75, 2014.
module Music.Theory.Graph.Johnson_2014
type Z12 = Int
mod12 :: Integral a => a -> a
dif :: Num a => (a, a) -> a
absdif :: Num a => (a, a) -> a
-- | interval (0,11) to interval class (0,6)
i_to_ic :: (Num a, Ord a) => a -> a
p2_and :: (t -> u -> Bool) -> (t -> u -> Bool) -> t -> u -> Bool
-- | degree of intersection
doi :: Eq t => [t] -> [t] -> Int
doi_of :: Eq t => Int -> [t] -> [t] -> Bool
-- | The sum of the pointwise absolute difference.
loc_dif :: Num t => [t] -> [t] -> t
loc_dif_of :: (Eq t, Num t) => t -> [t] -> [t] -> Bool
loc_dif_in :: (Eq t, Num t) => [t] -> [t] -> [t] -> Bool
-- | The number of places that are, pointwise, not equal.
--
--
-- loc_dif_n "test" "pest" == 1
--
loc_dif_n :: (Eq t, Num i) => [t] -> [t] -> i
loc_dif_n_of :: Eq t => Int -> [t] -> [t] -> Bool
min_vl :: (Num a, Ord a) => [a] -> [a] -> a
min_vl_of :: (Num a, Ord a) => a -> [a] -> [a] -> Bool
min_vl_in :: (Num a, Ord a) => [a] -> [a] -> [a] -> Bool
combinations2 :: Ord t => [t] -> [(t, t)]
set_pp :: Show t => [t] -> String
m_get :: Ord k => Map k v -> k -> v
-- | degree of intersection
m_doi_of :: Map Int [Z12] -> Int -> Int -> Int -> Bool
gen_graph_ul :: Ord v => [DOT_ATTR] -> (v -> String) -> [EDGE v] -> [String]
gen_graph_ul_ty :: Ord v => String -> (v -> String) -> [EDGE v] -> [String]
gen_flt_graph :: (Ord t, Show t) => [DOT_ATTR] -> ([t] -> [t] -> Bool) -> [[t]] -> [String]
-- | http://localhost/rd/?t=j&e=2016-04-04.md
p12_euler_plane :: Euler_Plane Rational
p12_euler_plane_gr :: [String]
p14_edges :: [(Key, Key)]
p14_gr :: [String]
p31_f_4_22 :: [Z12]
p31_e_set :: [([Z12], [Z12])]
p31_gr :: [String]
p114_f_3_7 :: [Z12]
p114_mk_gr :: Double -> ([Z12] -> [Z12] -> Bool) -> [String]
p114_gr_set :: [(String, [String])]
p125_gr :: [String]
p131_gr :: [String]
p148_mk_gr :: ([Int] -> [Int] -> Bool) -> [String]
p148_gr_set :: [(String, [String])]
p162_gr :: [String]
p172_nd_map :: Map Int [Z12]
p172_set_pp :: Int -> String
p172_gr_set :: [(String, [String])]
partition_ic :: (Num t, Ord t, Show t) => t -> [t] -> ([t], [t])
p177_gr_set :: [(String, [String])]
wr_graphs :: IO ()
-- | 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 GHC.Show.Show i => GHC.Show.Show (Music.Theory.Clef.Clef i)
instance GHC.Classes.Ord i => GHC.Classes.Ord (Music.Theory.Clef.Clef i)
instance GHC.Classes.Eq i => GHC.Classes.Eq (Music.Theory.Clef.Clef i)
instance GHC.Show.Show Music.Theory.Clef.Clef_T
instance GHC.Classes.Ord Music.Theory.Clef.Clef_T
instance GHC.Classes.Eq Music.Theory.Clef.Clef_T
module Music.Theory.Gamelan
-- | fromJust with error message.
fromJust_err :: String -> Maybe a -> a
-- | approxRational of 0.01.
near_rat :: Double -> Rational
-- | Enumeration of gamelan instrument families.
data Instrument_Family
Bonang :: Instrument_Family
Gender :: Instrument_Family
Gong :: Instrument_Family
Saron :: Instrument_Family
-- | Universe
instrument_family_set :: [Instrument_Family]
-- | Enumeration of Gamelan instruments.
data Instrument_Name
-- | Bonang Barung (horizontal gong, middle)
Bonang_Barung :: Instrument_Name
-- | Bonang Panerus (horizontal gong, high)
Bonang_Panerus :: Instrument_Name
-- | Gender Barung (key&resonator, middle)
Gender_Barung :: Instrument_Name
-- | Gender Panembung (key&resonator, high)
Gender_Panerus :: Instrument_Name
-- | Gender Panembung, Slenthem (key&resonator, low)
Gender_Panembung :: Instrument_Name
-- | Gong Ageng (hanging gong, low)
Gong_Ageng :: Instrument_Name
-- | Gong Suwukan (hanging gong, middle)
Gong_Suwukan :: Instrument_Name
-- | Kempul (hanging gong, middle)
Kempul :: Instrument_Name
-- | Kempyang (horizontal gong, high)
Kempyang :: Instrument_Name
-- | Kenong (horizontal gong, low)
Kenong :: Instrument_Name
-- | Ketuk (horizontal gong, middle)
Ketuk :: Instrument_Name
-- | Saron Barung, Saron (key, middle)
Saron_Barung :: Instrument_Name
-- | Saron Demung, Demung (key, low)
Saron_Demung :: Instrument_Name
-- | Saron Panerus, Peking (key, high)
Saron_Panerus :: Instrument_Name
instrument_family :: Instrument_Name -> Maybe Instrument_Family
instrument_name_pp :: Instrument_Name -> String
-- | Clef appropriate for Instrument_Name.
instrument_name_clef :: Integral i => Instrument_Name -> Clef i
instrument_name_clef_plain :: Integral i => Instrument_Name -> Clef i
-- | Enumeration of Gamelan scales.
data Scale
Pelog :: Scale
Slendro :: Scale
type Octave = Integer
type Degree = Integer
type Frequency = Double
type Annotation = String
data Pitch
Pitch :: Octave -> Degree -> Pitch
[pitch_octave] :: Pitch -> Octave
[pitch_degree] :: Pitch -> Degree
pitch_pp_ascii :: Pitch -> String
pitch_pp_duple :: Pitch -> String
data Note
Note :: Scale -> Pitch -> Note
[note_scale] :: Note -> Scale
[note_pitch] :: Note -> Pitch
note_degree :: Note -> Degree
data Tone
Tone :: Instrument_Name -> Maybe Note -> Maybe Frequency -> Maybe Annotation -> Tone
[tone_instrument_name] :: Tone -> Instrument_Name
[tone_note] :: Tone -> Maybe Note
[tone_frequency] :: Tone -> Maybe Frequency
[tone_annotation] :: Tone -> Maybe Annotation
tone_frequency_err :: Tone -> Frequency
-- | Orderable if frequency is given.
-- | Constructor for Tone without frequency or
-- annotation.
plain_tone :: Instrument_Name -> Scale -> Octave -> Degree -> Tone
-- | Tones are considered equivalent if they have the same
-- Instrument_Name and Note.
tone_equivalent :: Tone -> Tone -> Bool
tone_24et_pitch :: Tone -> Maybe Pitch
tone_24et_pitch' :: Tone -> Pitch
tone_24et_pitch_detune :: Tone -> Maybe Pitch_Detune
tone_24et_pitch_detune' :: Tone -> Pitch_Detune
tone_fmidi :: Tone -> Double
-- | Fractional (rational) 24-et midi note number of Tone.
tone_24et_fmidi :: Tone -> Rational
tone_12et_pitch :: Tone -> Maybe Pitch
tone_12et_pitch' :: Tone -> Pitch
tone_12et_pitch_detune :: Tone -> Maybe Pitch_Detune
tone_12et_pitch_detune' :: Tone -> Pitch_Detune
-- | Fractional (rational) 24-et midi note number of Tone.
tone_12et_fmidi :: Tone -> Rational
tone_family :: Tone -> Maybe Instrument_Family
tone_family_err :: Tone -> Instrument_Family
tone_in_family :: Instrument_Family -> Tone -> Bool
select_tones :: Instrument_Family -> [Tone] -> [Maybe Tone]
-- | Specify subset as list of families and scales.
type Tone_Subset = ([Instrument_Family], [Scale])
-- | Extract subset of Tone_Set.
tone_subset :: Tone_Subset -> Tone_Set -> Tone_Set
data Instrument
Instrument :: Instrument_Name -> Maybe Scale -> Maybe [Pitch] -> Maybe [Frequency] -> Instrument
[instrument_name] :: Instrument -> Instrument_Name
[instrument_scale] :: Instrument -> Maybe Scale
[instrument_pitches] :: Instrument -> Maybe [Pitch]
[instrument_frequencies] :: Instrument -> Maybe [Frequency]
type Tone_Set = [Tone]
type Tone_Group = [Tone_Set]
type Gamelan = [Instrument]
tone_scale :: Tone -> Maybe Scale
tone_pitch :: Tone -> Maybe Pitch
tone_degree :: Tone -> Maybe Degree
tone_degree' :: Tone -> Degree
tone_octave :: Tone -> Maybe Octave
tone_class :: Tone -> (Instrument_Name, Maybe Scale)
instrument_class :: Instrument -> (Instrument_Name, Maybe Scale)
tone_class_p :: (Instrument_Name, Scale) -> Tone -> Bool
tone_family_class_p :: (Instrument_Family, Scale) -> Tone -> Bool
-- | Given a Tone_Set, find those Tones that are within
-- Cents of Frequency.
tone_set_near_frequency :: Tone_Set -> Cents -> Frequency -> Tone_Set
-- | Compare Tones by frequency. Tones without frequency
-- compare as if at frequency 0.
tone_compare_frequency :: Tone -> Tone -> Ordering
-- | If all f of a are Just b, then Just
-- [b], else Nothing.
map_maybe_uniform :: (a -> Maybe b) -> [a] -> Maybe [b]
instrument :: Tone_Set -> Instrument
instruments :: Tone_Set -> [Instrument]
instrument_gamut :: Instrument -> Maybe (Pitch, Pitch)
scale_degrees :: Scale -> [Degree]
degree_index :: Scale -> Degree -> Maybe Int
tone_set_gamut :: Tone_Set -> Maybe (Pitch, Pitch)
tone_set_instrument :: Tone_Set -> (Instrument_Name, Maybe Scale) -> Tone_Set
instance GHC.Show.Show Music.Theory.Gamelan.Instrument
instance GHC.Classes.Eq Music.Theory.Gamelan.Instrument
instance GHC.Show.Show Music.Theory.Gamelan.Tone
instance GHC.Classes.Eq Music.Theory.Gamelan.Tone
instance GHC.Show.Show Music.Theory.Gamelan.Note
instance GHC.Classes.Ord Music.Theory.Gamelan.Note
instance GHC.Classes.Eq Music.Theory.Gamelan.Note
instance GHC.Show.Show Music.Theory.Gamelan.Pitch
instance GHC.Classes.Ord Music.Theory.Gamelan.Pitch
instance GHC.Classes.Eq Music.Theory.Gamelan.Pitch
instance GHC.Read.Read Music.Theory.Gamelan.Scale
instance GHC.Show.Show Music.Theory.Gamelan.Scale
instance GHC.Classes.Ord Music.Theory.Gamelan.Scale
instance GHC.Classes.Eq Music.Theory.Gamelan.Scale
instance GHC.Enum.Enum Music.Theory.Gamelan.Scale
instance GHC.Read.Read Music.Theory.Gamelan.Instrument_Name
instance GHC.Show.Show Music.Theory.Gamelan.Instrument_Name
instance GHC.Classes.Ord Music.Theory.Gamelan.Instrument_Name
instance GHC.Classes.Eq Music.Theory.Gamelan.Instrument_Name
instance GHC.Enum.Bounded Music.Theory.Gamelan.Instrument_Name
instance GHC.Enum.Enum Music.Theory.Gamelan.Instrument_Name
instance GHC.Read.Read Music.Theory.Gamelan.Instrument_Family
instance GHC.Show.Show Music.Theory.Gamelan.Instrument_Family
instance GHC.Classes.Ord Music.Theory.Gamelan.Instrument_Family
instance GHC.Classes.Eq Music.Theory.Gamelan.Instrument_Family
instance GHC.Enum.Bounded Music.Theory.Gamelan.Instrument_Family
instance GHC.Enum.Enum Music.Theory.Gamelan.Instrument_Family
instance GHC.Classes.Ord Music.Theory.Gamelan.Tone
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 GHC.Show.Show Music.Theory.Instrument.Choir.Voice
instance GHC.Enum.Bounded Music.Theory.Instrument.Choir.Voice
instance GHC.Enum.Enum Music.Theory.Instrument.Choir.Voice
instance GHC.Classes.Ord Music.Theory.Instrument.Choir.Voice
instance GHC.Classes.Eq Music.Theory.Instrument.Choir.Voice
-- | Byte functions.
module Music.Theory.Byte
-- | Given n in (0,255) make two character hex string.
--
--
-- mapMaybe byte_hex_pp [0x0F,0xF0,0xF0F] == ["0F","F0"]
--
byte_hex_pp :: (Integral i, Show i) => i -> Maybe String
-- | Erroring variant.
byte_hex_pp_err :: (Integral i, Show i) => i -> String
-- | unwords of map of byte_hex_pp_err.
--
--
-- byte_seq_hex_pp [0x0F,0xF0] == "0F F0"
--
byte_seq_hex_pp :: (Integral i, Show i) => [i] -> String
-- | Read two character hexadecimal string.
read_hex_byte :: (Eq t, Num t) => String -> t
read_hex_byte_seq :: (Eq t, Num t) => String -> [t]
-- | Load binary U8 sequence from file.
load_byte_seq :: Integral i => FilePath -> IO [i]
store_byte_seq :: Integral i => FilePath -> [i] -> IO ()
-- | Load hexadecimal text U8 sequence from file.
load_hex_byte_seq :: Integral i => FilePath -> IO [i]
-- | Store U8 sequence as hexadecimal text, 16 words per line.
store_hex_byte_seq :: (Integral i, Show i) => FilePath -> [i] -> IO ()
-- | http://en.wikipedia.org/wiki/Braille_Patterns
module Music.Theory.Braille
-- | Braille coding data. Elements are: (ASCII HEX,ASCII CHAR,DOT
-- LIST,UNICODE CHAR,MEANING). The dot numbers are in column order.
type BRAILLE = (Int, Char, [Int], Char, String)
-- | ASCII Char of BRAILLE.
braille_ascii :: BRAILLE -> Char
-- | Unicode Char of BRAILLE.
braille_unicode :: BRAILLE -> Char
-- | Dot list of BRAILLE.
braille_dots :: BRAILLE -> [Int]
-- | ASCII Braille table.
--
--
-- all id (map (\(x,c,_,_,_) -> x == fromEnum c) braille_table) == True
--
braille_table :: [BRAILLE]
-- | Lookup BRAILLE value for unicode character.
--
--
-- braille_lookup_unicode '⠝' == Just (0x4E,'N',[1,3,4,5],'⠝',"n")
--
braille_lookup_unicode :: Char -> Maybe BRAILLE
-- | Lookup BRAILLE value for ascii character (case invariant).
--
--
-- braille_lookup_ascii 'N' == Just (0x4E,'N',[1,3,4,5],'⠝',"n")
--
braille_lookup_ascii :: Char -> Maybe BRAILLE
-- | The arrangement of the 6-dot patterns into decades, sequences
-- of (1,10,3) cells. The cell to the left of the decade is the empty
-- cell, the two cells to the right are the first two cells of the decade
-- shifted right.
--
-- For each decade there are two extra cells that shift the first two
-- cells of the decade right one place. Subsequent decades are derived by
-- simple transformation of the first. The second is the first with the
-- addition of dot 3, the third adds dots 3 and
-- 6, the fourth adds dot 6 and the fifth shifts the
-- first down one row.
--
-- The first decade has the 13 of the 16 4-dot patterns, the remaining 3
-- are in the fifth decade, that is they are the three 4-dot patterns
-- that are down shifts of a 4-dot pattern.
--
--
-- let trimap f (p,q,r) = (f p,f q,f r)
-- let f = map (fromJust . decode) in map (trimap f) braille_64
--
braille_64 :: [(String, String, String)]
-- | Transcribe ASCII to unicode braille.
--
--
-- transcribe_unicode "BRAILLE ASCII CHAR GRID" == "⠃⠗⠁⠊⠇⠇⠑⠀⠁⠎⠉⠊⠊⠀⠉⠓⠁⠗⠀⠛⠗⠊⠙"
-- transcribe_unicode "BRAILLE HTML TABLE GRID" == "⠃⠗⠁⠊⠇⠇⠑⠀⠓⠞⠍⠇⠀⠞⠁⠃⠇⠑⠀⠛⠗⠊⠙"
--
transcribe_unicode :: String -> String
-- | Generate a character grid using inidicated values for filled and empty
-- cells.
--
--
-- let ch = (' ','.')
-- putStrLn$ transcribe_char_grid ch "BRAILLE ASCII CHAR GRID"
--
--
--
-- let ch = (white_circle,black_circle)
-- putStrLn$ string_html_table $ transcribe_char_grid ch "BRAILLE HTML TABLE GRID"
--
transcribe_char_grid :: (Char, Char) -> String -> String
-- | Generate 6-dot grid given (white,black) values.
--
--
-- dots_grid (0,1) [1,2,3,5] == [[1,0],[1,1],[1,0]]
--
dots_grid :: (c, c) -> [Int] -> [[c]]
string_html_table :: String -> String
-- | Decoding.
--
--
-- let t0 = ["⠠⠁⠇⠇⠀⠓⠥⠍⠁⠝⠀⠆⠬⠎⠀⠜⠑⠀⠃⠕⠗⠝⠀⠋⠗⠑⠑⠀⠯⠀⠑⠟⠥⠁⠇⠀⠔⠀⠙⠊⠛⠝⠰⠽⠀⠯⠀⠐⠗⠎⠲"
-- ,"⠠⠮⠽⠀⠜⠑⠀⠢⠙⠪⠫⠀⠾⠀⠗⠂⠎⠕⠝⠀⠯⠀⠒⠎⠉⠊⠰⠑⠀⠯⠀⠩⠙⠀⠁⠉⠞⠀⠞⠪⠜⠙⠎⠀⠐⠕⠀⠁⠝⠕⠤"
-- ,"⠮⠗⠀⠔⠀⠁⠀⠸⠎⠀⠷⠀⠃⠗⠕⠮⠗⠓⠕⠕⠙⠲"]
--
--
--
-- concatMap (fromMaybe "#" . decode) (concat t0)
--
decode :: Char -> Maybe String
-- | Start and end unicode indices.
braille_rng :: Integral i => (i, i)
-- | All characters, in sequence.
--
--
-- length braille_seq == 256
-- putStrLn braille_seq
--
braille_seq :: [Char]
-- | The nth character, zero indexed.
braille_char :: Int -> Char
-- | Two element index, 255 * 255 = 65025 places.
--
--
-- map braille_ix [100,300]
--
braille_ix :: Int -> (Char, Char)
-- | HTML character encoding (as hex integer).
--
--
-- unwords $ map unicode_html braille_seq
--
unicode_html :: Char -> String
-- | White (empty) circle.
white_circle :: Char
-- | Black (filled) circle.
black_circle :: Char
-- | Shaded (hatched) circle.
shaded_circle :: Char
-- | Table of one letter contractions.
one_letter_contractions :: [(Char, 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)]
-- | 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
type STEP a = ((Int, Int), ([[a]], [[a]]))
left :: STEP a -> STEP a
right :: STEP a -> STEP a
bjorklund' :: STEP a -> STEP a
-- | 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]
-- map xdot (bjorklund (5,9)) == "x.x.x.x.x"
--
--
--
-- let {es = [(2,[3,5]),(3,[4,5,8]),(4,[7,9,12,15]),(5,[6,7,8,9,11,12,13,16])
-- ,(6,[7,13]),(7,[8,9,10,12,15,16,17,18]),(8,[17,19])
-- ,(9,[14,16,22,23]),(11,[12,24]),(13,[24]),(15,[34])]
-- ;es' = concatMap (\(i,j) -> map ((,) i) j) es}
-- in mapM_ (putStrLn . euler_pp') es'
--
--
--
-- > E(2,3) [××·] (12)
-- > E(2,5) [×·×··] (23)
-- > E(3,4) [×××·] (112)
-- > E(3,5) [×·×·×] (221)
-- > E(3,8) [×··×··×·] (332)
-- > E(4,7) [×·×·×·×] (2221)
-- > E(4,9) [×·×·×·×··] (2223)
-- > E(4,12) [×··×··×··×··] (3333)
-- > E(4,15) [×···×···×···×··] (4443)
-- > E(5,6) [×××××·] (11112)
-- > E(5,7) [×·××·××] (21211)
-- > E(5,8) [×·××·××·] (21212)
-- > E(5,9) [×·×·×·×·×] (22221)
-- > E(5,11) [×·×·×·×·×··] (22223)
-- > E(5,12) [×··×·×··×·×·] (32322)
-- > E(5,13) [×··×·×··×·×··] (32323)
-- > E(5,16) [×··×··×··×··×···] (33334)
-- > E(6,7) [××××××·] (111112)
-- > E(6,13) [×·×·×·×·×·×··] (222223)
-- > E(7,8) [×××××××·] (1111112)
-- > E(7,9) [×·×××·×××] (2112111)
-- > E(7,10) [×·××·××·××] (2121211)
-- > E(7,12) [×·××·×·××·×·] (2122122)
-- > E(7,15) [×·×·×·×·×·×·×··] (2222223)
-- > E(7,16) [×··×·×·×··×·×·×·] (3223222)
-- > E(7,17) [×··×·×··×·×··×·×·] (3232322)
-- > E(7,18) [×··×·×··×·×··×·×··] (3232323)
-- > E(8,17) [×·×·×·×·×·×·×·×··] (22222223)
-- > E(8,19) [×··×·×·×··×·×·×··×·] (32232232)
-- > E(9,14) [×·××·××·××·××·] (212121212)
-- > E(9,16) [×·××·×·×·××·×·×·] (212221222)
-- > E(9,22) [×··×·×··×·×··×·×··×·×·] (323232322)
-- > E(9,23) [×··×·×··×·×··×·×··×·×··] (323232323)
-- > E(11,12) [×××××××××××·] (11111111112)
-- > E(11,24) [×··×·×·×·×·×··×·×·×·×·×·] (32222322222)
-- > E(13,24) [×·××·×·×·×·×·××·×·×·×·×·] (2122222122222)
-- > E(15,34) [×··×·×·×·×··×·×·×·×··×·×·×·×··×·×·] (322232223222322)
--
bjorklund :: (Int, Int) -> [Bool]
-- | rotate_right of bjorklund.
--
--
-- map xdot' (bjorklund_r 2 (5,16)) == "··×··×··×··×··×·"
--
bjorklund_r :: Int -> (Int, Int) -> [Bool]
-- | Pretty printer, generalise.
euler_pp_f :: (Bool -> Char) -> (Int, Int) -> String
-- | Unicode form, ie. ×·.
--
--
-- euler_pp' (7,12) == "E(7,12) [×·××·×·××·×·] (2122122)"
--
euler_pp' :: (Int, Int) -> String
-- | ASCII form, ie. x..
--
--
-- euler_pp (7,12) == "E(7,12) [x.xx.x.xx.x.] (2122122)"
--
euler_pp :: (Int, Int) -> String
-- | xdot notation for pattern.
--
--
-- map xdot (bjorklund (5,9)) == "x.x.x.x.x"
--
xdot :: Bool -> Char
-- | Unicode variant.
--
--
-- map xdot' (bjorklund (5,12)) == "×··×·×··×·×·"
-- map xdot' (bjorklund (5,16)) == "×··×··×··×··×···"
--
xdot' :: Bool -> Char
-- | 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
-- | Bits functions.
module Music.Theory.Bits
bit_pp :: Bool -> Char
bits_pp :: [Bool] -> String
-- | Generate n place bit sequence for x.
gen_bitseq :: FiniteBits b => Int -> b -> [Bool]
-- | Given bit sequence (most to least significant) generate Bits
-- value.
--
--
-- :set -XBinaryLiterals
-- pack_bitseq [True,False,True,False] == 0b1010
-- pack_bitseq [True,False,False,True,False,False] == 0b100100
-- 0b100100 == 36
--
pack_bitseq :: Bits i => [Bool] -> i
-- | bits_pp of gen_bitseq.
--
--
-- :set -XBinaryLiterals
-- 0xF0 == 0b11110000
-- gen_bitseq_pp 8 (0xF0::Int) == "11110000"
--
gen_bitseq_pp :: FiniteBits b => Int -> b -> String
module Music.Theory.Random.I_Ching
-- | Line, indicated as sum.
data Line
L6 :: Line
L7 :: Line
L8 :: Line
L9 :: Line
-- | (sum={6,7,8,9}, (yarrow probablity={1,3,5,7}/16, three-coin
-- probablity={2,6}/16, name,signification,symbol))
type Line_Stat = (Line, (Rational, Rational, String, String, String))
i_ching_chart :: [Line_Stat]
-- | Lines L6 and L7 are unbroken (since L6 is becoming L7).
line_unbroken :: Line -> Bool
line_from_bit :: Bool -> Line
-- | Seven character ASCII string for line.
line_ascii_pp :: Line -> String
-- | Is line (ie. sum) moving (ie. 6 or 9).
line_is_moving :: Line -> Bool
-- | Old yin (L6) becomes yang (L7), and old yang (L9) becomes yin (L8).
line_complement :: Line -> Maybe Line
type Hexagram = [Line]
-- | Hexagrams are drawn upwards.
hexagram_pp :: Hexagram -> String
-- | Sequence of sum values assigned to ascending four bit numbers.
--
--
-- import Music.Theory.Bits
-- zip (map (gen_bitseq_pp 4) [0::Int .. 15]) (map line_ascii_pp_err four_coin_sequence)
--
four_coin_sequence :: [Line]
-- | Generate hexagram (ie. sequence of six lines given by sum) using
-- four_coin_sequence.
--
--
-- four_coin_gen_hexagram >>= putStrLn . hexagram_pp
--
four_coin_gen_hexagram :: IO Hexagram
-- | any of line_is_moving.
hexagram_has_complement :: Hexagram -> Bool
-- | If hexagram_has_complement then derive it.
--
--
-- h <- four_coin_gen_hexagram
-- putStrLn (hexagram_pp h)
-- maybe (return ()) (putStrLn . hexagram_pp) (hexagram_complement h)
--
hexagram_complement :: Hexagram -> Maybe Hexagram
-- | Names of hexagrams, in King Wen order.
--
--
-- length hexagram_names == 64
--
hexagram_names :: [(String, String)]
-- | Unicode hexagram characters, in King Wen order.
--
--
-- import Data.List.Split {- split -}
-- mapM_ putStrLn (chunksOf 8 hexagram_unicode_sequence)
--
hexagram_unicode_sequence :: [Char]
hexagram_to_binary :: Hexagram -> Int
hexagram_from_binary :: Int -> Hexagram
trigram_unicode_sequence :: [Char]
trigram_chart :: Num i => [(i, Char, i, Char, String, Char, String, Char)]
instance GHC.Show.Show Music.Theory.Random.I_Ching.Line
instance GHC.Classes.Eq Music.Theory.Random.I_Ching.Line
-- | Cell references & indexing.
module Music.Theory.Array.Cell_Ref
-- | 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
is_cell_ref :: String -> Bool
parse_cell_ref_err :: String -> 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)
-- | Inverse of cell_index.
--
--
-- index_to_cell (80,347) == (Column_Ref "CC",348)
-- index_to_cell (4,5) == (Column_Ref "E",6)
--
index_to_cell :: (Int, Int) -> Cell_Ref
parse_cell_index :: String -> (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]
instance Data.String.IsString Music.Theory.Array.Cell_Ref.Column_Ref
instance GHC.Read.Read Music.Theory.Array.Cell_Ref.Column_Ref
instance GHC.Show.Show Music.Theory.Array.Cell_Ref.Column_Ref
instance GHC.Classes.Eq Music.Theory.Array.Cell_Ref.Column_Ref
instance GHC.Classes.Ord Music.Theory.Array.Cell_Ref.Column_Ref
instance GHC.Enum.Enum Music.Theory.Array.Cell_Ref.Column_Ref
instance GHC.Arr.Ix Music.Theory.Array.Cell_Ref.Column_Ref
-- | Directions in an array.
module Music.Theory.Array.Direction
-- | (column,row)
type LOC n = (n, n)
-- | (Δcolumn,Δrow), rows descend, ie. down is positive, up is
-- negative.
type VEC n = (n, n)
vector_add :: Num n => VEC n -> VEC n -> VEC n
vector_sub :: Num n => VEC n -> VEC n -> VEC n
vector_sum :: Num n => [VEC n] -> VEC n
apply_vec :: Num n => LOC n -> VEC n -> LOC n
-- | Segment VEC into a sequence of unit steps.
--
--
-- let r = [[(0,0)],[(0,1)],[(0,1),(-1,0)],[(0,1),(0,1),(0,1),(-1,0),(-1,0)]]
-- in map segment_vec [(0,0),(0,1),(-1,1),(-2,3)] == r
--
segment_vec :: Integral n => VEC n -> [VEC n]
derive_vec :: Num n => LOC n -> LOC n -> VEC n
unfold_path :: Num n => LOC n -> [VEC n] -> [LOC n]
type DIRECTION_S = String
-- | Directions are D=down, L=left, R=right, U=up.
is_direction :: String -> Bool
type DIRECTION_C = Char
-- | Reads either S|D W|L E|R N|U, reverse lookup gives SWEN. A period
-- indicates (0,0). S=south, W=west, E=east, N=north.
direction_char_to_vector_tbl :: Num n => [(DIRECTION_C, VEC n)]
direction_char_to_vector :: Num n => DIRECTION_C -> VEC n
direction_to_vector :: Num n => [DIRECTION_C] -> VEC n
vector_to_direction_char :: (Eq n, Num n) => VEC n -> DIRECTION_C
-- | Direction sequence to cell references.
dir_seq_to_cell_seq :: (String, [String]) -> [String]
-- | Geometrical Drawings
--
-- A. Bernard Deacon and Camilla H. Wedgwood. “Geometrical Drawings from
-- Malekula and Other Islands of the New Hebrides”. The Journal of the
-- Royal Anthropological Institute of Great Britain and Ireland,
-- 64:129—175, 1934.
module Music.Theory.Graph.Deacon_1934
gen_graph :: Ord v => [DOT_ATTR] -> GR_PP v e -> [EDGE_L v e] -> [String]
gen_graph_ul :: Ord v => [DOT_ATTR] -> (v -> String) -> [EDGE v] -> [String]
gen_digraph :: Ord v => [DOT_ATTR] -> GR_PP v e -> [EDGE_L v e] -> [String]
type G = (GRAPH String, [DOT_ATTR], FilePath)
g1 :: G
g2 :: G
g4 :: G
g6 :: G
g8 :: G
g9 :: G
g10 :: G
g11 :: G
g12 :: G
g13 :: G
g_all :: [G]
wr :: G -> IO ()
wr_all :: IO ()
-- | Regular matrix array data, CSV, column & row indexing.
module Music.Theory.Array.CSV
-- | When reading a CSV file is the first row a header?
type CSV_Has_Header = Bool
-- | Alias for Char, allow characters other than , as
-- delimiter.
type CSV_Delimiter = Char
-- | Alias for Bool, allow linebreaks in fields.
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 Maybe a header.
type CSV_Table a = (Maybe [String], Table a)
-- | Read CSV_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_def :: (String -> a) -> FilePath -> IO (Table a)
-- | Read and process CSV CSV_Table.
csv_table_with :: CSV_Opt -> (String -> a) -> FilePath -> (CSV_Table a -> b) -> IO b
-- | Align table according to CSV_Align_Columns.
--
--
-- csv_table_align CSV_No_Align [["a","row","and"],["then","another","one"]]
--
csv_table_align :: CSV_Align_Columns -> Table String -> Table String
-- | Pretty-print CSV_Table.
csv_table_pp :: (a -> String) -> CSV_Opt -> CSV_Table a -> String
-- | write_file_utf8 of csv_table_pp.
csv_table_write :: (a -> String) -> CSV_Opt -> FilePath -> CSV_Table a -> IO ()
-- | Write Table only (no header) with def_csv_opt.
csv_table_write_def :: (a -> String) -> 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)
csv_field_str :: CSVField -> String
csv_error_recover :: CSVError -> CSVRow
csv_row_recover :: Either [CSVError] CSVRow -> CSVRow
-- | Read irregular CSV file, ie. rows may have any number of
-- columns, including no columns.
csv_load_irregular :: (String -> a) -> FilePath -> IO [[a]]
type P5_Parser t1 t2 t3 t4 t5 = (String -> t1, String -> t2, String -> t3, String -> t4, String -> t5)
type P5_Writer t1 t2 t3 t4 t5 = (t1 -> String, t2 -> String, t3 -> String, t4 -> String, t5 -> String)
csv_table_read_p5 :: P5_Parser t1 t2 t3 t4 t5 -> CSV_Opt -> FilePath -> IO (Maybe [String], [(t1, t2, t3, t4, t5)])
csv_table_write_p5 :: P5_Writer t1 t2 t3 t4 t5 -> CSV_Opt -> FilePath -> (Maybe [String], [(t1, t2, t3, t4, t5)]) -> IO ()
-- | Functions for reading midi note data (MND) from CSV files. This is
-- not a generic text midi notation. The defined commands are
-- on and off, but others may be present. Non-integral
-- note number and key velocity data are allowed.
module Music.Theory.Array.CSV.Midi.MND
-- | If r is whole to k places then show as integer, else as
-- float to k places.
data_value_pp :: Real t => Int -> t -> String
-- | Channel values are 4-bit (0-15).
type Channel = Word8
-- | The required header field.
csv_mnd_hdr :: [String]
type Param = (String, Double)
param_parse :: String -> [Param]
param_pp :: Int -> [Param] -> String
-- | Midi note data, the type parameters are to allow for fractional note
-- & velocity values. The command is a string, on and
-- off are standard, other commands may be present.
--
--
-- unwords csv_mnd_hdr == "time on/off note velocity channel param"
--
type MND t n = (t, String, n, n, Channel, [Param])
csv_mnd_parse :: (Read t, Real t, Read n, Real n) => CSV_Table String -> [MND t n]
load_csv :: FilePath -> IO (CSV_Table String)
-- | Midi note data.
--
--
-- let fn = "/home/rohan/cvs/uc/uc-26/daily-practice/2014-08-13.1.csv"
-- m <- csv_mnd_read fn :: IO [MND Double Double]
-- length m == 17655
-- csv_mnd_write 4 "/tmp/t.csv" m
--
csv_mnd_read :: (Read t, Real t, Read n, Real n) => FilePath -> IO [MND t n]
-- | Writer.
csv_mnd_write :: (Real t, Real n) => Int -> FilePath -> [MND t n] -> IO ()
-- | (p0=midi-note,p1=velocity,channel,param)
type Event n = (n, n, Channel, [Param])
-- | Translate from Tseq form to Wseq form.
midi_tseq_to_midi_wseq :: (Num t, Eq n) => Tseq t (Begin_End (Event n)) -> Wseq t (Event n)
midi_wseq_to_midi_tseq :: (Num t, Ord t) => Wseq t x -> Tseq t (Begin_End x)
-- | Ignores non on/off messages.
mnd_to_tseq :: Num n => [MND t n] -> Tseq t (Begin_End (Event n))
-- | Tseq form of csv_mnd_read, channel information is
-- retained, off-velocity is zero.
csv_mnd_read_tseq :: (Read t, Real t, Read n, Real n) => FilePath -> IO (Tseq t (Begin_End (Event n)))
-- | Tseq form of csv_mnd_write, data is .
csv_mnd_write_tseq :: (Real t, Real n) => Int -> FilePath -> Tseq t (Begin_End (Event n)) -> IO ()
-- | Message should be note for note data.
csv_mndd_hdr :: [String]
type MNDD t n = (t, t, String, n, n, Channel, [Param])
csv_mndd_parse :: (Read t, Real t, Read n, Real n) => CSV_Table String -> [MNDD t n]
-- | Midi note/duration data.
csv_mndd_read :: (Read t, Real t, Read n, Real n) => FilePath -> IO [MNDD t n]
-- | Writer.
csv_mndd_write :: (Real t, Real n) => Int -> FilePath -> [MNDD t n] -> IO ()
-- | Ignores non note messages.
mndd_to_wseq :: [MNDD t n] -> Wseq t (Event n)
-- | Wseq form of csv_mndd_read.
csv_mndd_read_wseq :: (Read t, Real t, Read n, Real n) => FilePath -> IO (Wseq t (Event n))
-- | Wseq form of csv_mndd_write.
csv_mndd_write_wseq :: (Real t, Real n) => Int -> FilePath -> Wseq t (Event n) -> IO ()
-- | Parse either MND or MNDD data to Wseq, CSV type is decided by header.
csv_midi_parse_wseq :: (Read t, Real t, Read n, Real n) => CSV_Table String -> Wseq t (Event n)
csv_midi_read_wseq :: (Read t, Real t, Read n, Real n) => FilePath -> IO (Wseq t (Event n))
-- | Functions to load a tuning definition and transform it into a sparse
-- tuning function.
module Music.Theory.Tuning.Load
-- | Load possibly sparse and possibly one-to-many
-- (midi-note-number,cps-frequency) table from CSV file.
--
--
-- load_cps_tbl "/home/rohan/dr.csv"
--
load_cps_tbl :: FilePath -> IO [(Int, Double)]
-- | Load scala scl file as Tuning.
load_tuning_scl :: String -> IO Tuning
-- | Load scala file and apply cps_midi_tuning_f.
load_tuning_cps :: (String, Double, Int) -> IO Sparse_Midi_Tuning_F
-- | Load scala file and apply d12_midi_tuning_f.
load_tuning_d12 :: (String, Double, Int) -> IO Sparse_Midi_Tuning_F
-- | Lookup first matching element in table.
load_tuning_tbl :: (String, Double, Int) -> IO Sparse_Midi_Tuning_F
type Choose_f st t = [t] -> st -> (t, st)
-- | Randomly choose from elements in table, equal weighting.
default_choose_f :: RandomGen g => Choose_f g t
-- | Load tuning table with stateful selection function for one-to-many
-- entries.
load_tuning_tbl_st :: Choose_f st (Int, Double) -> (String, Double, Int) -> IO (Sparse_Midi_Tuning_ST_F st)
load_tuning_ty :: String -> (String, Double, Int) -> IO Sparse_Midi_Tuning_F
load_tuning_st_ty :: String -> (String, Double, Int) -> IO (Sparse_Midi_Tuning_ST_F StdGen)
module Music.Theory.Array
larray_bounds :: Ord k => [(k, v)] -> (k, k)
larray :: Ix k => [(k, v)] -> Array k v
-- | Append a sequence of nil (or default) values to each row of
-- tbl so to make it regular (ie. all rows of equal length).
make_regular :: t -> [[t]] -> [[t]]
-- | Matrix dimensions are written (rows,columns).
type Dimensions i = (i, i)
-- | Matrix indices are written (row,column) & are here _zero_ indexed.
type Ix i = (i, i)
-- | Translate Ix by row and column delta.
--
--
-- ix_translate (1,2) (3,4) == (4,6)
--
ix_translate :: Num t => (t, t) -> Ix t -> Ix t
-- | Modulo Ix by Dimensions.
--
--
-- ix_modulo (4,4) (3,7) == (3,3)
--
ix_modulo :: Integral t => Dimensions t -> Ix t -> Ix t
-- | Given number of columns and row index, list row indices.
--
--
-- row_indices 3 1 == [(1,0),(1,1),(1,2)]
--
row_indices :: (Enum t, Num t) => t -> t -> [Ix t]
-- | Given number of rows and column index, list column indices.
--
--
-- column_indices 3 1 == [(0,1),(1,1),(2,1)]
--
column_indices :: (Enum t, Num t) => t -> t -> [Ix t]
-- | All zero-indexed matrix indices, in row order. This is the order given
-- by sort.
--
--
-- matrix_indices (2,3) == [(0,0),(0,1),(0,2),(1,0),(1,1),(1,2)]
-- sort (matrix_indices (2,3)) == matrix_indices (2,3)
--
matrix_indices :: (Enum t, Num t) => Dimensions t -> [Ix t]
-- | Corner indices of given Dimensions, in row order.
--
--
-- matrix_corner_indices (2,3) == [(0,0),(0,2),(1,0),(1,2)]
--
matrix_corner_indices :: Num t => Dimensions t -> [Ix t]
-- | Parallelogram corner indices, given as rectangular Dimensions
-- with an offset for the lower indices.
--
--
-- parallelogram_corner_indices ((2,3),2) == [(0,0),(0,2),(1,2),(1,4)]
--
parallelogram_corner_indices :: Num t => (Dimensions t, t) -> [Ix t]
-- | Apply ix_modulo and ix_translate for all
-- matrix_indices, ie. all translations of a shape in row
-- order. The resulting Ix sets are not sorted and may have
-- duplicates.
--
--
-- concat (all_ix_translations (2,3) [(0,0)]) == matrix_indices (2,3)
--
all_ix_translations :: Integral t => Dimensions t -> [Ix t] -> [[Ix t]]
-- | Sort sets into row order and remove duplicates.
all_ix_translations_uniq :: Integral t => Dimensions t -> [Ix t] -> [[Ix t]]
-- | Regular array data as markdown (MD) tables.
module Music.Theory.Array.MD
-- | 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 and eq_width.
--
--
-- let tbl = [["a","bc","def"],["ghij","klm","no","p"]]
-- putStrLn$unlines$"": md_table_opt (True,True," · ") (Nothing,tbl)
--
md_table_opt :: (Bool, Bool, String) -> 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 h = (map return "abc",map return "efgh")
-- let t = md_matrix "" h (map (map show) [[1,2,3,4],[2,3,4,1],[3,4,1,2]])
--
--
--
-- >>> putStrLn $ unlines $ md_table' t
-- - - - - -
-- e f g h
-- a 1 2 3 4
-- b 2 3 4 1
-- c 3 4 1 2
-- - - - - -
--
md_matrix :: a -> ([a], [a]) -> [[a]] -> MD_Table a
-- | Variant that takes a show function and a header
-- decoration function.
md_matrix_opt :: (a -> String) -> (String -> String) -> ([a], [a]) -> [[a]] -> MD_Table String
-- | MD embolden function.
md_embolden :: String -> String
-- | md_matrix_opt with show and markdown bold
-- annotations for header. the header cells are in bold.
md_matrix_bold :: Show a => ([a], [a]) -> [[a]] -> MD_Table String
-- | James Boros. "Some Properties of the All-Trichord Hexachord". _In
-- Theory Only_, 11(6):19--41, 1990.
module Music.Theory.Z.Boros_1990
singular :: String -> [t] -> t
set_eq :: Ord t => [t] -> [t] -> Bool
elem_by :: (t -> t -> Bool) -> t -> [t] -> Bool
tto_tni_univ :: Integral i => [TTO i]
all_tn :: Integral i => [i] -> [[i]]
all_tni :: Integral i => [i] -> [[i]]
uniq_tni :: Integral i => [i] -> [[i]]
type PC = Int
type PCSET = [PC]
type SC = PCSET
pcset_trs :: Int -> PCSET -> PCSET
-- | Forte prime forms of the twelve trichordal set classes.
--
--
-- length trichords == 12
--
trichords :: [PCSET]
-- | Is a pcset self-inversional, ie. is the inversion of p a
-- transposition of p.
--
--
-- map (\p -> (p,self_inv p)) trichords
--
self_inv :: PCSET -> Bool
-- | Pretty printer, comma separated.
--
--
-- pcset_pp [0,3,7,10] == "0,3,7,10"
--
pcset_pp :: PCSET -> String
-- | Pretty printer, hexadecimal, no separator.
--
--
-- pcset_pp_hex [0,3,7,10] == "037A"
--
pcset_pp_hex :: PCSET -> String
-- | Forte prime form of the all-trichord hexachord.
--
--
-- T.sc_name T.mod12 ath == "6-Z17"
-- T.sc "6-Z17" == ath
--
ath :: PCSET
-- | Is p an instance of ath.
is_ath :: PCSET -> Bool
-- | Table 1, p.20
--
--
-- length ath_univ == 24
--
ath_univ :: [PCSET]
-- | Calculate TTO of pcset, which must be an instance of
-- ath.
--
--
-- ath_tni [1,2,3,7,8,11] == T.TTO 3 False True
--
ath_tni :: PCSET -> TTO PC
-- | Give label for instance of ath, prime forms are written H and
-- inversions h.
--
--
-- ath_pp [1,2,3,7,8,11] == "h3"
--
ath_pp :: PCSET -> String
-- | The twenty three-element subsets of ath.
--
--
-- length ath_trichords == 20
--
ath_trichords :: [PCSET]
-- | \\ of ath and p, ie. the pitch classes that are
-- in ath and not in p.
--
--
-- ath_complement [0,1,2] == [4,7,8]
--
ath_complement :: PCSET -> PCSET
-- | p is a pcset, q a sc, calculate pcsets in q that
-- with p form ath.
--
--
-- ath_completions [0,1,2] (T.sc "3-3") == [[6,7,10],[4,7,8]]
-- ath_completions [6,7,10] (T.sc "3-5") == [[1,2,8]]
--
ath_completions :: PCSET -> SC -> [PCSET]
realise_ath_seq :: [PCSET] -> [[PCSET]]
ath_gr_extend :: GRAPH PCSET -> PCSET -> [EDGE PCSET]
gr_trs :: Int -> GRAPH PCSET -> GRAPH PCSET
table_3 :: [((PCSET, SC, SC_Name), (PCSET, SC, SC_Name))]
table_3_md :: [String]
table_4 :: [((PCSET, PCSET, SC_Name), (PCSET, PCSET, SC_Name))]
table_4_md :: [String]
table_5 :: [(PCSET, Int)]
table_5_md :: [String]
table_6 :: [(PCSET, Int, Int)]
table_6_md :: [String]
fig_1 :: GRAPH PCSET
fig_1_gr :: Gr PCSET ()
fig_2 :: [[PCSET]]
fig_3 :: [GRAPH PCSET]
fig_3_gr :: [Gr PCSET ()]
fig_4 :: [GRAPH PCSET]
fig_5 :: [GRAPH PCSET]
uedge_set :: Ord v => [EDGE v] -> [EDGE v]
-- | Self-inversional pcsets are drawn in a double circle, other pcsets in
-- a circle.
set_shape :: PCSET -> String
type GR = Gr PCSET ()
gr_pp' :: (PCSET -> String) -> GR_PP PCSET ()
gr_pp :: GR_PP PCSET ()
d_fig_1 :: [String]
d_fig_3_g :: GR
d_fig_3 :: [String]
d_fig_3' :: [[String]]
d_fig_4_g :: GR
d_fig_4 :: [String]
d_fig_5_g :: GR
d_fig_5 :: [String]
d_fig_5_e :: [EDGE_L PCSET PCSET]
d_fig_5_g' :: Gr PCSET PCSET
d_fig_5' :: [String]