-- Hoogle documentation, generated by Haddock
-- See Hoogle, http://www.haskell.org/hoogle/
-- | Haskell Music Theory
--
-- Haskell music theory library
@package hmt
@version 0.14
-- | Robert Morris and D. Starr. "The Structure of All-Interval Series".
-- Journal of Music Theory, 18:364-389, 1974.
module Music.Theory.Z12.Morris_1974
-- | msum . map return.
--
--
-- observeAll (fromList [1..7]) == [1..7]
--
fromList :: MonadPlus m => [a] -> m a
-- | MonadPlus all-interval series.
--
--
-- [0,1,3,2,9,5,10,4,7,11,8,6] `elem` observeAll (all_interval_m 12)
-- length (observeAll (all_interval_m 12)) == 3856
-- map (length . observeAll . all_interval_m) [4,6,8,10] == [2,4,24,288]
--
all_interval_m :: MonadPlus m => Int -> m [Int]
-- | observeAll of all_interval_m.
--
--
-- let r = [[0,1,5,2,4,3],[0,2,1,4,5,3],[0,4,5,2,1,3],[0,5,1,4,2,3]]
-- in all_interval 6 == r
--
all_interval :: Int -> [[Int]]
-- | Z12 set class database.
module Music.Theory.Z12.Literature
-- | Set class database with descriptors for historically and theoretically
-- significant set classes, indexed by Forte name.
--
--
-- lookup "6-Z17" sc_db == Just "All-Trichord Hexachord"
-- lookup "7-35" sc_db == Just "diatonic collection (d)"
--
sc_db :: [(String, String)]
-- | Tuning theory
module Music.Theory.Tuning
-- | Maybe Left of Either.
fromLeft :: Either a b -> Maybe a
-- | Maybe Right of Either.
fromRight :: Either a b -> Maybe b
-- | An approximation of a ratio.
type Approximate_Ratio = Double
-- | A real valued division of a tone into one hundred parts.
type Cents = Double
-- | A tuning specified Either as a sequence of exact ratios, or as
-- a sequence of possibly inexact Cents.
data Tuning
Tuning :: Either [Rational] [Cents] -> Rational -> Tuning
ratios_or_cents :: Tuning -> Either [Rational] [Cents]
octave_ratio :: Tuning -> Rational
-- | Divisions of octave.
--
--
-- divisions ditone == 12
--
divisions :: Tuning -> Int
-- | Maybe exact ratios of Tuning.
ratios :: Tuning -> Maybe [Rational]
-- | Possibly inexact Cents of tuning.
cents :: Tuning -> [Cents]
-- | map round . cents.
cents_i :: Integral i => Tuning -> [i]
-- | Convert from cents invterval to frequency ratio.
--
--
-- map cents_to_ratio [0,701.9550008653874,1200] == [1,3/2,2]
--
cents_to_ratio :: Floating a => a -> a
-- | Convert from frequency ratio to cents interval.
--
--
-- map ratio_to_cents [1,4/3,2] == [0.0,498.04499913461245,1200.0]
--
ratio_to_cents :: Floating a => a -> a
-- | Possibly inexact Approximate_Ratios of tuning.
approximate_ratios :: Tuning -> [Approximate_Ratio]
-- | Maybe exact ratios reconstructued from possibly inexact
-- Cents of Tuning.
--
--
-- let r = [1,17/16,9/8,13/11,5/4,4/3,7/5,3/2,11/7,5/3,16/9,15/8]
-- in reconstructed_ratios 1e-2 werckmeister_iii == Just r
--
reconstructed_ratios :: Double -> Tuning -> Maybe [Rational]
-- | Convert from an Approximate_Ratio to Cents.
--
--
-- round (to_cents (3/2)) == 702
--
to_cents :: Approximate_Ratio -> Cents
-- | Convert from Rational to Approximate_Ratio, ie.
-- fromRational.
approximate_ratio :: Rational -> Approximate_Ratio
-- | to_cents . approximate_ratio.
to_cents_r :: Rational -> Cents
-- | Construct an exact Rational that approximates Cents to
-- within epsilon.
--
--
-- map (reconstructed_ratio 1e-5) [0,700,1200] == [1,442/295,2]
--
--
--
-- to_cents_r (442/295) == 699.9976981706735
--
reconstructed_ratio :: Double -> Cents -> Rational
-- | Frequency n cents from f.
--
--
-- 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 :: Floating a => a -> a -> a
-- | 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
ditone_r :: [Rational]
-- | Ditone/pythagorean tuning, see
-- http://www.billalves.com/porgitaro/ditonesettuning.html
--
--
-- cents_i ditone == [0,114,204,294,408,498,612,702,816,906,996,1110]
--
ditone :: Tuning
pythagorean_r :: [Rational]
-- | Pythagorean tuning.
--
--
-- cents_i pythagorean == [0,90,204,294,408,498,612,702,792,906,996,1110]
--
pythagorean :: Tuning
werckmeister_iii_ar :: [Approximate_Ratio]
werckmeister_iii_c :: [Cents]
-- | Werckmeister III, Andreas Werckmeister (1645-1706)
--
--
-- cents_i werckmeister_iii == [0,90,192,294,390,498,588,696,792,888,996,1092]
--
werckmeister_iii :: Tuning
werckmeister_iv_ar :: [Approximate_Ratio]
werckmeister_iv_c :: [Cents]
-- | Werckmeister IV, Andreas Werckmeister (1645-1706)
--
--
-- cents_i werckmeister_iv == [0,82,196,294,392,498,588,694,784,890,1004,1086]
--
werckmeister_iv :: Tuning
werckmeister_v_ar :: [Approximate_Ratio]
werckmeister_v_c :: [Cents]
-- | Werckmeister V, Andreas Werckmeister (1645-1706)
--
--
-- cents_i werckmeister_v == [0,96,204,300,396,504,600,702,792,900,1002,1098]
--
werckmeister_v :: Tuning
werckmeister_vi_r :: [Rational]
-- | Werckmeister VI, Andreas Werckmeister (1645-1706)
--
--
-- cents_i werckmeister_vi == [0,91,196,298,395,498,595,698,793,893,1000,1097]
--
werckmeister_vi :: Tuning
pietro_aaron_1523_c :: [Cents]
-- | Pietro Aaron (1523) meantone temperament, see
-- http://www.kylegann.com/histune.html
--
--
-- cents_i pietro_aaron_1523 == [0,76,193,310,386,503,580,697,773,890,1007,1083]
--
pietro_aaron_1523 :: Tuning
thomas_young_1799_c :: [Cents]
-- | Thomas Young (1799) - Well Temperament
--
--
-- cents_i thomas_young_1799 == [0,94,196,298,392,500,592,698,796,894,1000,1092]
--
thomas_young_1799 :: Tuning
five_limit_tuning_r :: [Rational]
-- | Five-limit tuning (five limit just intonation).
--
--
-- cents_i five_limit_tuning == [0,112,204,316,386,498,590,702,814,884,996,1088]
--
five_limit_tuning :: Tuning
equal_temperament_c :: [Cents]
-- | Equal temperament.
--
--
-- cents equal_temperament == [0,100..1100]
--
equal_temperament :: Tuning
septimal_tritone_just_intonation_r :: [Rational]
septimal_tritone_just_intonation :: Tuning
seven_limit_just_intonation_r :: [Rational]
seven_limit_just_intonation :: Tuning
kirnberger_iii_ar :: [Approximate_Ratio]
kirnberger_iii :: Tuning
vallotti_c :: [Cents]
vallotti :: Tuning
mayumi_reinhard_r :: [Rational]
mayumi_reinhard :: Tuning
la_monte_young_r :: [Rational]
-- | La Monte Young's "The Well-Tuned Piano", see
-- http://www.kylegann.com/tuning.html.
--
--
-- cents_i la_monte_young == [0,177,204,240,471,444,675,702,738,969,942,1173]
--
la_monte_young :: Tuning
ben_johnston_r :: [Rational]
-- | Ben Johnston's "Suite for Microtonal Piano" (1977), see
-- http://www.kylegann.com/tuning.html
--
--
-- cents_i ben_johnston == [0,105,204,298,386,471,551,702,841,906,969,1088]
--
ben_johnston :: Tuning
lou_harrison_16_r :: [Rational]
-- | Lou Harrison 16 tone Just Intonation scale, see
-- http://www.microtonal-synthesis.com/scale_harrison_16.html
--
--
-- cents_i lou_harrison_16 == [0,112,182,231,267,316,386,498,603,702,814,884,933,969,1018,1088]
--
lou_harrison_16 :: Tuning
partch_43_r :: [Rational]
-- | Harry Partch 43 tone scale, see
-- http://www.microtonal-synthesis.com/scale_partch.html
--
--
-- cents_i partch_43 == [0,22,53,84,112,151,165
-- ,182,204,231,267,294,316
-- ,347,386,418,435
-- ,471,498,520,551,583,617,649
-- ,680,702,729,765,782,814,853,884,906,933
-- ,969,996,1018,1035,1049,1088,1116,1147,1178]
--
partch_43 :: Tuning
-- | 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
-- cents_i syntonic_697 == [0,79,194,273,309,388,467,503,582,697,776,812,891,970,1006,1085,1164]
--
syntonic_697 :: Tuning
-- | mk_syntonic_tuning of 702.
--
--
-- divisions syntonic_702 == 17
-- cents_i syntonic_702 == [0,24,114,204,294,318,408,498,522,612,702,792,816,906,996,1020,1110]
--
syntonic_702 :: Tuning
-- | Raise or lower the frequency q by octaves until it is in the
-- octave starting at p.
--
--
-- fold_to_octave_of 55 392 == 98
--
fold_cps_to_octave_of :: (Ord a, Fractional a) => a -> a -> a
-- | Harmonic series on n.
harmonic_series_cps :: (Num t, Enum t) => t -> [t]
-- | n elements of harmonic_series_cps.
--
--
-- harmonic_series_cps_n 14 55 == [55,110,165,220,275,330,385,440,495,550,605,660,715,770]
--
harmonic_series_cps_n :: (Num a, Enum a) => Int -> a -> [a]
-- | nth partial of f1, ie. one indexed.
--
--
-- map (partial 55) [1,5,3] == [55,275,165]
--
partial :: (Num a, Enum a) => a -> Int -> a
-- | Fold ratio until within an octave, ie. 1 < n
-- <= 2.
fold_ratio_to_octave :: Integral i => Ratio i -> Ratio i
-- | Derivative harmonic series, based on kth partial of f1.
--
--
-- let {r = [52,103,155,206,258,309,361,412,464,515,567,618,670,721,773]
-- ;d = harmonic_series_cps_derived 5 (octpc_to_cps (1,4))}
-- in map round (take 15 d) == r
--
harmonic_series_cps_derived :: (Ord a, Fractional a, Enum a) => Int -> a -> [a]
-- | Harmonic series to nth harmonic (folded).
--
--
-- harmonic_series_folded 17 == [1,17/16,9/8,5/4,11/8,3/2,13/8,7/4,15/8]
--
harmonic_series_folded :: Integer -> [Rational]
-- | to_cents_r variant of harmonic_series_folded.
--
--
-- map round (harmonic_series_folded_c 21) == [0,105,204,298,386,471,551,702,841,969,1088]
--
harmonic_series_folded_c :: Integer -> [Cents]
-- | 12-tone tuning of first 21 elements of the harmonic
-- series.
--
--
-- cents_i harmonic_series_folded_21 == [0,105,204,298,386,471,551,702,841,969,1088]
--
harmonic_series_folded_21 :: Tuning
instance Eq Tuning
instance Show Tuning
-- | Bill Alves. "Pleng: Composing for a Justly Tuned Gender Barung". 1/1:
-- Journal of the Just Intonation Network, 1:4-11, Spring 1997.
-- http://www2.hmc.edu/~alves/pleng.html
module Music.Theory.Tuning.Alves_1997
alves_slendro_r :: [Rational]
-- | HMC slendro tuning.
--
--
-- cents_i alves_slendro == [0,231,498,765,996]
--
alves_slendro :: Tuning
alves_pelog_bem_r :: [Rational]
-- | HMC pelog bem tuning.
--
--
-- cents_i alves_pelog_bem == [0,231,316,702,814]
--
alves_pelog_bem :: Tuning
alves_pelog_barang_r :: [Rational]
-- | HMC pelog 2,3,4,6,7 tuning.
--
--
-- cents_i alves_pelog_barang == [0,386,471,857,969]
--
alves_pelog_barang :: Tuning
alves_pelog_23467_r :: [Rational]
-- | HMC pelog barang tuning.
--
--
-- cents_i alves_pelog_23467 == [0,386,471,702,969]
--
alves_pelog_23467 :: Tuning
-- | 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
-- let fn = "/home/rohan/opt/scala/scl/polansky_ps.scl"
-- s <- T.load fn
-- T.scale_pitch_representations s == (0,50)
-- 1 : Data.Either.rights (T.scale_pitches s) == psaltery
--
psaltery :: [Rational]
-- | fold_ratio_to_octave of psaltery.
--
--
-- length psaltery == 51 && length psaltery_o == 21
-- psaltery_o == [1,65/64,33/32,17/16,35/32,9/8,75/64,39/32
-- ,5/4,21/16,85/64,11/8,45/32
-- ,3/2,25/16,51/32,13/8,27/16,55/32,7/4,15/8]
--
psaltery_o :: [Rational]
-- | Larry Polansky. "Tuning Systems in American Gamelan, Part I: Interval
-- Sizes in Javanese Slendro". Balungan, 1(2):9-11, 1984
module Music.Theory.Tuning.Polansky_1984
k_manisrenga :: Fractional n => [n]
k_kanjutmesem :: Fractional n => [n]
k_udanriris :: Fractional n => [n]
k_pengawesari :: Fractional n => [n]
k_rarasrum :: Fractional n => [n]
k_hardjanagara :: Fractional n => [n]
k_madukentir :: Fractional n => [n]
k_surak :: Fractional n => [n]
-- | The set of K slendro tunings.
--
--
-- map length k_set == replicate (length k_set) 5
-- minimum (concat k_set) == 206
-- maximum (concat k_set) == 268.5
--
k_set :: Fractional n => [[n]]
-- | Given a set of equal length lists calculate the average value of each
-- position.
--
--
-- calculate_averages [[1,2,3],[3,2,1]] == [2,2,2]
--
calculate_averages :: Fractional n => [[n]] -> [n]
-- | Averages of K set, p. 10.
--
--
-- k_averages == [233.8125,245.0625,234.0,240.8125,251.875]
--
k_averages :: Fractional n => [n]
gm_1 :: Fractional n => [n]
gm_8 :: Fractional n => [n]
gm_7 :: Fractional n => [n]
gm_6 :: Fractional n => [n]
gm_5 :: Fractional n => [n]
gm_4 :: Fractional n => [n]
gm_3 :: Fractional n => [n]
gm_2 :: Fractional n => [n]
-- | The set of GM (Gadja Mada University) slendro tunings.
--
--
-- map length gm_set == replicate (length gm_set) 5
-- minimum (concat gm_set) == 218
-- maximum (concat gm_set) == 262
--
gm_set :: Fractional n => [[n]]
-- | Averages of GM set, p. 10.
--
--
-- gm_averages == [234.0,240.25,247.625,243.125,254.0625]
--
gm_averages :: Fractional n => [n]
-- | Association list giving interval boundaries for interval class
-- categories (pp.10-11).
i_categories :: Num n => [((n, n), String)]
-- | Categorise an interval.
i_category :: (Ord a, Num a) => a -> String
-- | Pad String to right with spaces until at least n
-- characters.
--
--
-- map (pad 3) ["S","E-L"] == ["S ","E-L"]
--
pad :: Int -> String -> String
-- | Pretty interval category table (pp. 10-11).
--
--
-- i_category_table k_set ==
-- ["S L S S L "
-- ,"S L S S L "
-- ,"L L S S S "
-- ,"L S S S L "
-- ,"S S L S L "
-- ,"S E-L S L L "
-- ,"L E E S S "
-- ,"S S S-E L L "]
--
--
--
-- i_category_table gm_set ==
-- ["S L E-L E L "
-- ,"L S-E E S L "
-- ,"S S-E S L S-E"
-- ,"S L L S L "
-- ,"S S-E E-L S L "
-- ,"S S-E E E L "
-- ,"S-E S L E L "
-- ,"S S E-L L L "]
--
i_category_table :: (Ord a, Num a) => [[a]] -> [String]
-- | Rational tuning derived from gm_averages, p.11.
--
--
-- polansky_1984_r == sort polansky_1984_r
-- polansky_1984_r == [1/1,8/7,21/16,512/343,12/7,96/49]
--
--
--
-- import Music.Theory.List
-- d_dx polansky_1984_r == [1/7,19/112,989/5488,76/343,12/49]
--
polansky_1984_r :: [Rational]
-- | to_cents_r of polansky_1984_r.
--
--
-- import Music.Theory.List
-- map round (d_dx polansky_1984_c) == [231,240,223,240,231]
--
polansky_1984_c :: [Cents]
-- | Parser for the Scala scale file format. See
-- http://www.huygens-fokker.org/scala/scl_format.html for
-- details. This module succesfully parses all 4115 scales in v.77 of the
-- scale library.
module Music.Theory.Tuning.Scala
-- | A .scl pitch is either in Cents or is a
-- Ratio.
type Pitch i = Either Cents (Ratio i)
-- | A scale has a description, a degree, and a list of Pitches.
type Scale i = (String, i, [Pitch i])
-- | Text description of scale.
scale_description :: Scale i -> String
-- | The degree of the scale (number of Pitches).
scale_degree :: Scale i -> i
-- | The Pitches at Scale.
scale_pitches :: Scale i -> [Pitch i]
-- | The last Pitch element of the scale (ie. the ocatve).
scale_octave :: Scale i -> Maybe (Pitch i)
-- | Is scale_octave perfect, ie. Ratio of 2 or
-- Cents of 1200.
perfect_octave :: Integral i => Scale i -> Bool
-- | A pair giving the number of Cents and number of Ratio
-- pitches at Scale.
scale_pitch_representations :: Integral t => Scale i -> (t, t)
-- | Pitch as Cents, conversion by to_cents_r if necessary.
pitch_cents :: Pitch Integer -> Cents
type Epsilon = Double
-- | Pitch as Rational, conversion by reconstructed_ratio if
-- necessary, hence epsilon.
pitch_ratio :: Epsilon -> Pitch Integer -> Rational
-- | Make scale pitches uniform, conforming to the most promininent pitch
-- type.
scale_uniform :: Epsilon -> Scale Integer -> Scale Integer
-- | Scale as list of Cents (ie. pitch_cents) with 0
-- prefix.
scale_cents :: Scale Integer -> [Cents]
-- | Scale as list of Rational (ie. pitch_ratio) with
-- 1 prefix.
scale_ratios :: Epsilon -> Scale Integer -> [Rational]
-- | Comment lines being with !.
comment_p :: String -> Bool
-- | Remove r.
filter_cr :: String -> String
-- | Logical or of list of predicates.
p_or :: [a -> Bool] -> a -> Bool
-- | Remove to end of line ! comments.
remove_eol_comments :: String -> String
-- | Remove comments and null lines.
--
--
-- filter_comments ["!a","b","","c"] == ["b","c"]
--
filter_comments :: [String] -> [String]
-- | Delete trailing ., read fails for 700..
delete_trailing_point :: String -> String
-- | Pitches are either cents (with decimal point) or ratios (with
-- /).
--
--
-- map pitch ["700.0","3/2","2"] == [Left 700,Right (3/2),Right 2]
--
pitch :: (Read i, Integral i) => String -> Pitch i
-- | Pitch lines may contain commentary.
pitch_ln :: (Read i, Integral i) => String -> Pitch i
-- | Parse .scl file.
parse :: (Read i, Integral i) => String -> Scale i
-- | Load .scl file.
--
--
-- s <- load "/home/rohan/opt/scala/scl/xenakis_chrom.scl"
-- scale_pitch_representations s == (6,1)
-- scale_ratios 1e-3 s == [1,21/20,29/23,179/134,280/187,11/7,100/53,2]
--
load :: (Read i, Integral i) => FilePath -> IO (Scale i)
-- | Subset of files in dir with an extension in ext.
dir_subset :: [String] -> FilePath -> IO [FilePath]
-- | Load all .scl files at dir.
--
--
-- db <- load_dir "/home/rohan/opt/scala/scl"
-- length db == 4115
-- length (filter ((== 0) . scale_degree) db) == 1
-- length (filter (== Just (Right 2)) (map scale_octave db)) == 3562
--
--
--
-- let r = [0,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24
-- ,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44
-- ,45,46,47,48,49,50,51,53,54,55,56,57,58,59,60,61,62,63,64
-- ,65,66,67,68,69,70,71,72,74,75,77,78,79,80,81,84,87,88
-- ,90,91,92,95,96,99,100,101,105,110,112,117,118,130,140,171
-- ,180,271,311,342,366,441,612]
-- in nub (sort (map scale_degree db)) == r
--
--
--
-- let r = ["Xenakis's Byzantine Liturgical mode, 5 + 19 + 6 parts"
-- ,"Xenakis's Byzantine Liturgical mode, 12 + 11 + 7 parts"
-- ,"Xenakis's Byzantine Liturgical mode, 7 + 16 + 7 parts"]
-- in filter (isInfixOf "Xenakis") (map scale_description db) == r
--
--
--
-- length (filter (not . perfect_octave) db) == 544
--
--
--
-- mapM_ (putStrLn.scale_description) (filter (not . perfect_octave) db)
--
load_dir :: (Read i, Integral i) => FilePath -> IO [Scale i]
module Music.Theory.Tiling.Canon
-- | Sequence.
type S = [Int]
-- | Canon of (period,sequence,multipliers,displacements).
type R = (Int, S, [Int], [Int])
-- | Voice.
type V = [Int]
-- | Tiling (sequence)
type T = [[Int]]
-- | Cycle at period.
--
--
-- take 9 (p_cycle 18 [0,2,5]) == [0,2,5,18,20,23,36,38,41]
--
p_cycle :: Int -> [Int] -> [Int]
-- | Element of (sequence,multiplier,displacement).
type E = (S, Int, Int)
-- | Resolve sequence from E.
--
--
-- e_to_seq ([0,2,5],2,1) == [1,5,11]
-- e_to_seq ([0,1],3,4) == [4,7]
-- e_to_seq ([0],1,2) == [2]
--
e_to_seq :: E -> [Int]
-- | Infer E from sequence.
--
--
-- e_from_seq [1,5,11] == ([0,2,5],2,1)
-- e_from_seq [4,7] == ([0,1],3,4)
-- e_from_seq [2] == ([0],1,2)
--
e_from_seq :: [Int] -> E
-- | Set of V from R.
r_voices :: R -> [V]
-- | concatMap of r_voices.
rr_voices :: [R] -> [V]
-- | Retrograde of T, the result T is sorted.
--
--
-- let r = [[0,7,14],[1,5,9],[2,4,6],[3,8,13],[10,11,12]]
-- in t_retrograde [[0,7,14],[1,6,11],[2,3,4],[5,9,13],[8,10,12]] == r
--
t_retrograde :: T -> T
-- | The normal form of T is the min of t and it's
-- t_retrograde.
--
--
-- let r = [[0,7,14],[1,5,9],[2,4,6],[3,8,13],[10,11,12]]
-- in t_normal [[0,7,14],[1,6,11],[2,3,4],[5,9,13],[8,10,12]] == r
--
t_normal :: T -> T
-- | Derive set of R from T.
--
--
-- let {r = [(21,[0,1,2],[10,8,2,4,7,5,1],[0,1,2,3,5,8,14])]
-- ;t = [[0,10,20],[1,9,17],[2,4,6],[3,7,11],[5,12,19],[8,13,18],[14,15,16]]}
-- in r_from_t t == r
--
r_from_t :: T -> [R]
-- | msum . map return.
--
--
-- observeAll (fromList [1..7]) == [1..7]
--
fromList :: MonadPlus m => [a] -> m a
-- | Search for perfect tilings of the sequence S using
-- multipliers from m to degree n with k parts.
perfect_tilings_m :: MonadPlus m => [S] -> [Int] -> Int -> Int -> m T
-- | t_normal of observeAll of perfect_tilings_m.
--
--
-- perfect_tilings [[0,1]] [1..3] 6 3 == []
--
--
--
-- let r = [[[0,7,14],[1,5,9],[2,4,6],[3,8,13],[10,11,12]]]
-- in perfect_tilings [[0,1,2]] [1,2,4,5,7] 15 5 == r
--
--
--
-- length (perfect_tilings [[0,1,2]] [1..12] 15 5) == 1
--
--
--
-- let r = [[[0,1],[2,5],[3,7],[4,6]]
-- ,[[0,1],[2,6],[3,5],[4,7]]
-- ,[[0,2],[1,4],[3,7],[5,6]]]
-- in perfect_tilings [[0,1]] [1..4] 8 4 == r
--
--
--
-- let r = [[[0,1],[2,5],[3,7],[4,9],[6,8]]
-- ,[[0,1],[2,7],[3,5],[4,8],[6,9]]
-- ,[[0,2],[1,4],[3,8],[5,9],[6,7]]
-- ,[[0,2],[1,5],[3,6],[4,9],[7,8]]
-- ,[[0,3],[1,6],[2,4],[5,9],[7,8]]]
-- in perfect_tilings [[0,1]] [1..5] 10 5 == r
--
--
-- Johnson 2004, p.2
--
--
-- let r = [[0,6,12],[1,8,15],[2,11,20],[3,5,7],[4,9,14],[10,13,16],[17,18,19]]
-- in perfect_tilings [[0,1,2]] [1,2,3,5,6,7,9] 21 7 == [r]
--
--
--
-- let r = [[0,10,20],[1,9,17],[2,4,6],[3,7,11],[5,12,19],[8,13,18],[14,15,16]]
-- in perfect_tilings [[0,1,2]] [1,2,4,5,7,8,10] 21 7 == [t_retrograde r]
--
perfect_tilings :: [S] -> [Int] -> Int -> Int -> [T]
-- | Variant of elem for ordered sequences, which can therefore
-- return False when searching infinite sequences.
--
--
-- 5 `elemOrd` [0,2..] == False && 10 `elemOrd` [0,2..] == True
--
elemOrd :: Ord a => a -> [a] -> Bool
-- | A .* diagram of n places of V.
--
--
-- v_dot_star 18 [0,2..] == "*.*.*.*.*.*.*.*.*."
--
v_dot_star :: Int -> V -> String
-- | A white space and index diagram of n places of V.
--
--
-- >>> mapM_ (putStrLn . v_space_ix 9) [[0,2..],[1,3..]]
-- >
-- > 0 2 4 6 8
-- > 1 3 5 7
--
v_space_ix :: Int -> V -> String
-- | Insert | every n places.
--
--
-- with_bars 6 (v_dot_star 18 [0,2..]) == "*.*.*.|*.*.*.|*.*.*."
--
with_bars :: Int -> String -> String
-- | Variant with measure length m and number of measures n.
--
--
-- v_dot_star_m 6 3 [0,2..] == "*.*.*.|*.*.*.|*.*.*."
--
v_dot_star_m :: Int -> Int -> V -> String
-- | Print .* diagram.
v_print :: Int -> [V] -> IO ()
-- | Variant to print | at measures.
v_print_m :: Int -> Int -> [V] -> IO ()
-- | Variant that discards first k measures.
v_print_m_from :: Int -> Int -> Int -> [V] -> IO ()
-- | Tom Johnson. "Perfect Rhythmic Tilings". Technical report, IRCAM, 24
-- January 2004. MaMuX Lecture.
module Music.Theory.Tiling.Johnson_2004
-- | {0,1,2} order 5, p.1
--
--
-- >>> v_print 15 (r_voices p1)
-- >
-- > ..***..........
-- > ........*.*.*..
-- > .....*...*...*.
-- > .*....*....*...
-- > *......*......*
--
p1 :: R
-- | {0,1,2} order 7, p.2
--
--
-- >>> v_print 21 (r_voices p2)
-- >
-- > ..............***....
-- > ..*.*.*..............
-- > ...*...*...*.........
-- > ........*....*....*..
-- > .....*......*......*.
-- > .*.......*.......*...
-- > *.........*.........*
--
p2 :: R
-- | {0,1} order 4, p.3
--
--
-- >>> v_print 8 (r_voices p3)
-- >
-- > *...*...
-- > .**.....
-- > ...*..*.
-- > .....*.*
--
p3 :: R
-- | {0,1} order 5, p.4
--
--
-- >>> mapM_ (v_print 10 . r_voices) p4
-- >
-- > *...*.....
-- > .**.......
-- > ...*....*.
-- > .....*.*..
-- > ......*..*
-- >
-- > *....*....
-- > .**.......
-- > ...*..*...
-- > ....*...*.
-- > .......*.*
-- >
-- > *...*.....
-- > .*....*...
-- > ..**......
-- > .....*..*.
-- > .......*.*
--
p4 :: [R]
-- | Open {1,2,3} order 5, p.4
--
--
-- >>> v_print 18 (r_voices p4_b)
-- >
-- > ...***............
-- > ........*.*.*.....
-- > .........*...*...*
-- > .*....*....*......
-- > *......*......*...
--
p4_b :: R
-- | Tom Johnson. "Tiling in my Music". The Experimental Music
-- Yearbook, 1, 2009.
module Music.Theory.Tiling.Johnson_2009
-- | Tilework for Clarinet, p.3
--
--
-- >>> v_print 36 (rr_voices p3)
-- >
-- > *.*..*............*.*..*............
-- > .*.*..*............*.*..*...........
-- > ........*.*..*............*.*..*....
-- > ....*..*.*............*..*.*........
-- > ...........*..*.*............*..*.*.
-- > ............*..*.*............*..*.*
--
p3 :: [R]
-- | Tilework for String Quartet, p.5
--
--
-- >>> mapM_ (v_print 24 . r_voices) p5
-- >
-- > ******......******......
-- > ......******......******
-- >
-- > *.****.*....*.****.*....
-- > ......*.****.*....*.****
-- >
-- > **.***..*...**.***..*...
-- > ......**.***..*...**.***
-- >
-- > *..***.**...*..***.**...
-- > ......*..***.**...*..***
--
p5 :: [R]
-- | Extra Perfect (p.7)
--
--
-- >>> v_print_m_from 18 6 6 (r_voices p7)
-- >
-- > **.*..|......|......|......|......|......
-- > ......|.*.*..|.*....|......|......|......
-- > ......|......|......|......|.*..*.|....*.
-- > ......|......|...*..|.*....|...*..|......
-- > ......|......|....*.|...*..|......|.*....
-- > ......|*.....|*.....|......|*.....|......
-- > ....*.|......|......|*.....|......|...*..
-- > ......|......|......|....*.|......|*.....
--
p7 :: R
-- | Tilework for Log Drums (2005), p.10
--
--
-- >>> v_print 18 (r_voices p10)
-- >
-- > *.*.*.............
-- > .*...*...*........
-- > ...*...*...*......
-- > ......*...*...*...
-- > ........*...*...*.
-- > .............*.*.*
--
p10 :: R
-- | Self-Similar Melodies (1996), p.11
--
--
-- >>> v_print_m 20 5 (r_voices p11)
-- >
-- > *.....*.....*..*..*.|....*.....*.....*...|..*..*..*.....*.....|*.....*.....*..*..*.|....*.....*.....*...
-- > ....................|*.....*.....*..*..*.|....*.....*.....*...|..*..*..*.....*.....|*.....*.....*..*..*.
-- > ....................|....................|*.....*.....*..*..*.|....*.....*.....*...|..*..*..*.....*.....
--
p11 :: R
module Music.Theory.Z12
newtype Z12
Z12 :: Int -> Z12
liftUZ12 :: (Int -> Int) -> Z12 -> Z12
liftBZ12 :: (Int -> Int -> Int) -> Z12 -> Z12 -> Z12
toZ12 :: Integral i => i -> Z12
fromZ12 :: Integral i => Z12 -> i
-- | Z12 not in set.
--
--
-- complement [0,2,4,5,7,9,11] == [1,3,6,8,10]
--
complement :: [Z12] -> [Z12]
instance Eq Z12
instance Ord Z12
instance Enum Z12
instance Bounded Z12
instance Integral Z12
instance Real Z12
instance Num Z12
instance Show Z12
-- | Pitch-class set (unordered) operations on Z12.
module Music.Theory.Z12.TTO
-- | Map to pitch-class and reduce to set.
--
--
-- pcset [1,13] == [1]
--
pcset :: Integral a => [a] -> [Z12]
-- | Transpose by n.
--
--
-- tn 4 [1,5,6] == [5,9,10]
-- tn 4 [0,4,8] == [0,4,8]
--
tn :: Z12 -> [Z12] -> [Z12]
-- | Invert about n.
--
--
-- invert 6 [4,5,6] == [6,7,8]
-- invert 0 [0,1,3] == [0,9,11]
--
invert :: Z12 -> [Z12] -> [Z12]
-- | Composition of invert about 0 and tn.
--
--
-- tni 4 [1,5,6] == [3,10,11]
-- (invert 0 . tn 4) [1,5,6] == [2,3,7]
--
tni :: Z12 -> [Z12] -> [Z12]
-- | Modulo 12 multiplication
--
--
-- mn 11 [0,1,4,9] == invert 0 [0,1,4,9]
--
mn :: Z12 -> [Z12] -> [Z12]
-- | M5, ie. mn 5.
--
--
-- m5 [0,1,3] == [0,3,5]
--
m5 :: [Z12] -> [Z12]
-- | T-related sets of p.
--
--
-- length (t_related [0,1,3]) == 12
-- t_related [0,3,6,9] == [[0,3,6,9],[1,4,7,10],[2,5,8,11]]
--
t_related :: [Z12] -> [[Z12]]
-- | T/I-related set of p.
--
--
-- length (ti_related [0,1,3]) == 24
-- ti_related [0,3,6,9] == [[0,3,6,9],[1,4,7,10],[2,5,8,11]]
--
ti_related :: [Z12] -> [[Z12]]
-- | 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
-- | Alias for Double (quieten compiler).
type R = Double
-- | Specialised variant of fromIntegral.
to_r :: (Integral n, Show n) => n -> R
-- | Variant on div with input constraints.
div' :: (Integral a, Show a) => String -> a -> a -> a
-- | A stratification is a tree of integral subdivisions.
type Stratification t = [t]
-- | Indispensibilities from stratification.
--
--
-- indispensibilities [3,2,2] == [11,0,6,3,9,1,7,4,10,2,8,5]
-- indispensibilities [2,3,2] == [11,0,6,2,8,4,10,1,7,3,9,5]
-- indispensibilities [2,2,3] == [11,0,4,8,2,6,10,1,5,9,3,7]
-- indispensibilities [3,5] == [14,0,9,3,6,12,1,10,4,7,13,2,11,5,8]
--
indispensibilities :: (Integral n, Show n) => Stratification n -> [n]
-- | The indispensibility measure (ψ).
--
--
-- map (lower_psi [2] 1) [1..2] == [1,0]
-- map (lower_psi [3] 1) [1..3] == [2,0,1]
-- map (lower_psi [2,2] 2) [1..4] == [3,0,2,1]
-- map (lower_psi [5] 1) [1..5] == [4,0,3,1,2]
-- map (lower_psi [3,2] 2) [1..6] == [5,0,3,1,4,2]
-- map (lower_psi [2,3] 2) [1..6] == [5,0,2,4,1,3]
--
lower_psi :: (Integral a, Show a) => Stratification a -> a -> a -> a
-- | The first nth primes, reversed.
--
--
-- reverse_primes 14 == [43,41,37,31,29,23,19,17,13,11,7,5,3,2]
--
reverse_primes :: (Integral n, Show n) => n -> [n]
-- | Generate prime stratification for n.
--
--
-- map prime_stratification [2,3,5,7,11] == [[2],[3],[5],[7],[11]]
-- map prime_stratification [6,8,9,12] == [[3,2],[2,2,2],[3,3],[3,2,2]]
-- map prime_stratification [22,10,4,1] == [[11,2],[5,2],[2,2],[]]
-- map prime_stratification [18,16,12] == [[3,3,2],[2,2,2,2],[3,2,2]]
--
prime_stratification :: (Integral n, Show n) => n -> Stratification n
-- | Fundamental indispensibilities for prime numbers (Ψ).
--
--
-- map (upper_psi 2) [1..2] == [1,0]
-- map (upper_psi 3) [1..3] == [2,0,1]
-- map (upper_psi 5) [1..5] == [4,0,3,1,2]
-- map (upper_psi 7) [1..7] == [6,0,4,2,5,1,3]
-- map (upper_psi 11) [1..11] == [10,0,6,4,9,1,7,3,8,2,5]
-- map (upper_psi 13) [1..13] == [12,0,7,4,10,1,8,5,11,2,9,3,6]
--
upper_psi :: (Integral a, Show a) => a -> a -> a
-- | Table such that each subsequent row deletes the least indispensibile
-- pulse.
--
--
-- thinning_table [3,2] == [[True,True,True,True,True,True]
-- ,[True,False,True,True,True,True]
-- ,[True,False,True,False,True,True]
-- ,[True,False,True,False,True,False]
-- ,[True,False,False,False,True,False]
-- ,[True,False,False,False,False,False]]
--
thinning_table :: (Integral n, Show n) => Stratification n -> [[Bool]]
-- | Trivial pretty printer for thinning_table.
--
--
-- putStrLn (thinning_table_pp [3,2])
-- putStrLn (thinning_table_pp [2,3])
--
--
--
-- ****** ******
-- *.**** *.****
-- *.*.** *.**.*
-- *.*.*. *..*.*
-- *...*. *..*..
-- *..... *.....
--
thinning_table_pp :: (Integral n, Show n) => Stratification n -> String
-- | Scale values against length of list minus one.
--
--
-- relative_to_length [0..5] == [0.0,0.2,0.4,0.6,0.8,1.0]
--
relative_to_length :: (Real a, Fractional b) => [a] -> [b]
-- | Variant of indispensibilities that scales value to lie in
-- (0,1).
--
-- relative_indispensibilities [3,2] == [1,0,0.6,0.2,0.8,0.4]
relative_indispensibilities :: (Integral n, Show n) => Stratification n -> [R]
-- | Align two meters (given as stratifications) to least common multiple
-- of their degrees. The indispensibilities function is given as
-- an argument so that it may be relative if required. This generates
-- Table 7 (p.58).
--
--
-- let r = [(5,5),(0,0),(2,3),(4,1),(1,4),(3,2)]
-- in align_meters indispensibilities [2,3] [3,2] == r
--
--
--
-- let r = [(1,1),(0,0),(0.4,0.6),(0.8,0.2),(0.2,0.8),(0.6,0.4)]
-- in align_meters relative_indispensibilities [2,3] [3,2] == r
--
--
--
-- align_meters indispensibilities [2,2,3] [3,5]
-- align_meters relative_indispensibilities [2,2,3] [3,5]
--
align_meters :: (t -> [b]) -> t -> t -> [(b, b)]
-- | Type pairing a stratification and a tempo.
type S_MM t = ([t], t)
-- | Variant of div that requires mod be 0.
whole_div :: Integral a => a -> a -> a
-- | Variant of quot that requires rem be 0.
whole_quot :: Integral a => a -> a -> a
-- | Rule to prolong stratification of two S_MM values such that
-- pulse at the deeper level are aligned. (Paragraph 2, p.58)
--
--
-- let x = ([2,2,2],1)
-- in prolong_stratifications x x == (fst x,fst x)
--
--
--
-- let r = ([2,5,3,3,2],[3,2,5,5])
-- in prolong_stratifications ([2,5],50) ([3,2],60) == r
--
--
--
-- prolong_stratifications ([2,2,3],5) ([3,5],4) == ([2,2,3],[3,5])
--
prolong_stratifications :: (Integral n, Show n) => S_MM n -> S_MM n -> ([n], [n])
-- | Arithmetic mean (average) of a list.
--
--
-- mean [0..5] == 2.5
--
mean :: Fractional a => [a] -> a
-- | Square of n.
--
--
-- square 5 == 25
--
square :: Num a => a -> a
-- | Composition of prolong_stratifications and align_meters.
--
--
-- align_s_mm indispensibilities ([2,2,3],5) ([3,5],4)
--
align_s_mm :: (Integral n, Show n) => ([n] -> [t]) -> S_MM n -> S_MM n -> [(t, t)]
-- | An attempt at Equation 5 of the CMJ paper. When n is
-- h-1 the output is incorrect (it is the product of the correct
-- values for n at h-1 and h).
--
--
-- map (upper_psi' 5) [1..5] /= [4,0,3,1,2]
-- map (upper_psi' 7) [1..7] /= [6,0,4,2,5,1,3]
-- map (upper_psi' 11) [1..11] /= [10,0,6,4,9,1,7,3,8,2,5]
-- map (upper_psi' 13) [1..13] /= [12,0,7,4,10,1,8,5,11,2,9,3,6]
--
upper_psi' :: (Integral a, Show a) => a -> a -> a
-- | The MPS limit equation given on p.58.
--
--
-- mps_limit 3 == 21 + 7/9
--
mps_limit :: Floating a => a -> a
-- | The square of the product of the input sequence is summed, then
-- divided by the square of the sequence length.
--
--
-- mean_square_product [(0,0),(1,1),(2,2),(3,3)] == 6.125
-- mean_square_product [(2,3),(4,5)] == (6^2 + 20^2) / 2^2
--
mean_square_product :: Fractional n => [(n, n)] -> n
-- | An incorrect attempt at the description in paragraph two of p.58 of
-- the CMJ paper.
--
--
-- let p ~= q = abs (p - q) < 1e-4
-- metrical_affinity [2,3] 1 [3,2] 1 ~= 0.0324
-- metrical_affinity [2,2,3] 20 [3,5] 16 ~= 0.0028
--
metrical_affinity :: (Integral n, Show n) => [n] -> n -> [n] -> n -> R
-- | An incorrect attempt at Equation 6 of the CMJ paper, see
-- omega_z.
--
--
-- let p ~= q = abs (p - q) < 1e-4
-- metrical_affinity' [2,2,2] 1 [2,2,2] 1 ~= 1.06735
-- metrical_affinity' [2,2,2] 1 [2,2,3] 1 ~= 0.57185
-- metrical_affinity' [2,2,2] 1 [2,3,2] 1 ~= 0.48575
-- metrical_affinity' [2,2,2] 1 [3,2,2] 1 ~= 0.45872
--
--
--
-- metrical_affinity' [3,2,2] 3 [2,2,3] 2 ~= 0.10282
--
metrical_affinity' :: (Integral t, Show t) => [t] -> t -> [t] -> t -> R
-- | Clarence Barlow. "Two Essays on Theory". Computer Music
-- Journal, 11(1):44-60, 1987. Translated by Henning Lohner.
module Music.Theory.Interval.Barlow_1987
-- | Barlow's indigestibility function for prime numbers.
--
--
-- map barlow [1,2,3,5,7,11,13] == [0,1,8/3,32/5,72/7,200/11,288/13]
--
barlow :: (Integral a, Fractional b) => a -> b
-- | Generate list of factors of n from x.
--
--
-- factor primes 315 == [3,3,5,7]
--
factor :: Integral a => [a] -> a -> [a]
-- | factor n from primes.
--
--
-- prime_factors 315 == [3,3,5,7]
--
prime_factors :: Integral a => a -> [a]
-- | Collect number of occurences of each element of a sorted list.
--
--
-- multiplicities [1,1,1,2,2,3] == [(1,3),(2,2),(3,1)]
--
multiplicities :: (Eq a, Integral n) => [a] -> [(a, n)]
-- | multiplicities . prime_factors.
--
--
-- prime_factors_m 315 == [(3,2),(5,1),(7,1)]
--
prime_factors_m :: Integral a => a -> [(a, a)]
-- | Merging function for rational_prime_factors_m.
merge :: (Ord a, Num b, Eq b) => [(a, b)] -> [(a, b)] -> [(a, b)]
-- | Collect the prime factors in a rational number given as a numerator/
-- denominator pair (n,m). Prime factors are listed in ascending order
-- with their positive or negative multiplicities, depending on whether
-- the prime factor occurs in the numerator or the denominator (after
-- cancelling out common factors).
--
--
-- rational_prime_factors_m (16,15) == [(2,4),(3,-1),(5,-1)]
-- rational_prime_factors_m (10,9) == [(2,1),(3,-2),(5,1)]
-- rational_prime_factors_m (81,64) == [(2,-6),(3,4)]
-- rational_prime_factors_m (27,16) == [(2,-4),(3,3)]
-- rational_prime_factors_m (12,7) == [(2,2),(3,1),(7,-1)]
--
rational_prime_factors_m :: Integral b => (b, b) -> [(b, b)]
-- | Variant of rational_prime_factors_m giving results in a table
-- up to the nth prime.
--
--
-- rational_prime_factors_t 6 (12,7) == [2,1,0,-1,0,0]
--
rational_prime_factors_t :: Integral b => Int -> (b, b) -> [b]
-- | Compute the disharmonicity of the interval (p,q) using the
-- prime valuation function pv.
--
--
-- map (disharmonicity barlow) [(9,10),(8,9)] ~= [12.733333,8.333333]
--
disharmonicity :: (Integral a, Num b) => (a -> b) -> (a, a) -> b
-- | The reciprocal of disharmonicity.
--
--
-- map (harmonicity barlow) [(9,10),(8,9)] ~= [0.078534,0.120000]
--
harmonicity :: (Integral a, Fractional b) => (a -> b) -> (a, a) -> b
-- | Variant of harmonicity with Ratio input.
harmonicity_r :: (Integral a, Fractional b) => (a -> b) -> Ratio a -> b
-- | Interval ratio to cents.
--
--
-- map cents [16%15,16%9] == [111.73128526977776,996.0899982692251]
--
cents :: (Real a, Floating b) => a -> b
-- | uncurry (%).
to_rational :: Integral a => (a, a) -> Ratio a
-- | Make numerator denominator pair of n.
from_rational :: Integral t => Ratio t -> (t, t)
-- | Set of 1. interval size (cents), 2. intervals as product of powers of
-- primes, 3. frequency ratio and 4. harmonicity value.
type Table_2_Row = (Double, [Integer], Rational, Double)
-- | Table 2 (p.45)
--
--
-- length (table_2 0.06) == 24
--
table_2 :: Double -> [Table_2_Row]
-- | Pretty printer for Table_2_Row values.
--
--
-- mapM_ (putStrLn . table_2_pp) (table_2 0.06)
--
--
--
-- 0.000 | 0 0 0 0 0 0 | 1:1 | Infinity
-- 111.731 | 4 -1 -1 0 0 0 | 15:16 | 0.076531
-- 182.404 | 1 -2 1 0 0 0 | 9:10 | 0.078534
-- 203.910 | -3 2 0 0 0 0 | 8:9 | 0.120000
-- 231.174 | 3 0 0 -1 0 0 | 7:8 | 0.075269
-- 266.871 | -1 -1 0 1 0 0 | 6:7 | 0.071672
-- 294.135 | 5 -3 0 0 0 0 | 27:32 | 0.076923
-- 315.641 | 1 1 -1 0 0 0 | 5:6 | 0.099338
-- 386.314 | -2 0 1 0 0 0 | 4:5 | 0.119048
-- 407.820 | -6 4 0 0 0 0 | 64:81 | 0.060000
-- 435.084 | 0 2 0 -1 0 0 | 7:9 | 0.064024
-- 498.045 | 2 -1 0 0 0 0 | 3:4 | 0.214286
-- 519.551 | -2 3 -1 0 0 0 | 20:27 | 0.060976
-- 701.955 | -1 1 0 0 0 0 | 2:3 | 0.272727
-- 764.916 | 1 -2 0 1 0 0 | 9:14 | 0.060172
-- 813.686 | 3 0 -1 0 0 0 | 5:8 | 0.106383
-- 884.359 | 0 -1 1 0 0 0 | 3:5 | 0.110294
-- 905.865 | -4 3 0 0 0 0 | 16:27 | 0.083333
-- 933.129 | 2 1 0 -1 0 0 | 7:12 | 0.066879
-- 968.826 | -2 0 0 1 0 0 | 4:7 | 0.081395
-- 996.090 | 4 -2 0 0 0 0 | 9:16 | 0.107143
-- 1017.596 | 0 2 -1 0 0 0 | 5:9 | 0.085227
-- 1088.269 | -3 1 1 0 0 0 | 8:15 | 0.082873
-- 1200.000 | 1 0 0 0 0 0 | 1:2 | 1.000000
--
table_2_pp :: Table_2_Row -> String
-- | Common music notation duration model.
module Music.Theory.Duration
-- | Common music notation durational model
data Duration
Duration :: Integer -> Integer -> Rational -> Duration
-- | division of whole note
division :: Duration -> Integer
-- | number of dots
dots :: Duration -> Integer
-- | tuplet modifier
multiplier :: Duration -> Rational
-- | Are multipliers equal?
duration_meq :: Duration -> Duration -> Bool
-- | Compare durations with equal multipliers.
duration_compare_meq :: Duration -> Duration -> Maybe Ordering
-- | Erroring variant of duration_compare_meq.
duration_compare_meq_err :: Duration -> Duration -> Ordering
order_pair :: Ordering -> (t, t) -> (t, t)
-- | Sort a pair of equal type values using given comparison function.
--
--
-- sort_pair compare ('b','a') == ('a','b')
--
sort_pair :: (t -> t -> Ordering) -> (t, t) -> (t, t)
sort_pair_m :: (t -> t -> Maybe Ordering) -> (t, t) -> Maybe (t, t)
-- | True if neither duration is dotted.
no_dots :: (Duration, Duration) -> Bool
-- | Sum undotted divisions, input is required to be sorted.
sum_dur_undotted :: (Integer, Integer) -> Maybe Duration
-- | Sum dotted divisions, input is required to be sorted.
--
--
-- sum_dur_dotted (4,1,4,1) == Just (Duration 2 1 1)
-- sum_dur_dotted (4,0,2,1) == Just (Duration 1 0 1)
-- sum_dur_dotted (8,1,4,0) == Just (Duration 4 2 1)
-- sum_dur_dotted (16,0,4,2) == Just (Duration 2 0 1)
--
sum_dur_dotted :: (Integer, Integer, Integer, Integer) -> Maybe Duration
-- | Sum durations. Not all durations can be summed, and the present
-- algorithm is not exhaustive.
--
--
-- import Music.Theory.Duration.Name
-- sum_dur quarter_note eighth_note == Just dotted_quarter_note
-- sum_dur dotted_quarter_note eighth_note == Just half_note
-- sum_dur quarter_note dotted_eighth_note == Just double_dotted_quarter_note
--
sum_dur :: Duration -> Duration -> Maybe Duration
-- | Erroring variant of sum_dur.
sum_dur' :: Duration -> Duration -> Duration
-- | Give MusicXML type for division.
--
--
-- map whole_note_division_to_musicxml_type [2,4] == ["half","quarter"]
--
whole_note_division_to_musicxml_type :: Integer -> String
-- | Variant of whole_note_division_to_musicxml_type extracting
-- division from Duration.
--
--
-- duration_to_musicxml_type quarter_note == "quarter"
--
duration_to_musicxml_type :: Duration -> String
-- | Give Lilypond notation for Duration. Note that the
-- duration multiplier is not written.
--
--
-- import Music.Theory.Duration.Name
-- map duration_to_lilypond_type [half_note,dotted_quarter_note] == ["2","4."]
--
duration_to_lilypond_type :: Duration -> String
-- | Calculate number of beams at notated division.
--
--
-- whole_note_division_to_beam_count 32 == Just 3
--
whole_note_division_to_beam_count :: Integer -> Maybe Integer
-- | Calculate number of beams at Duration.
--
--
-- map duration_beam_count [half_note,sixteenth_note] == [0,2]
--
duration_beam_count :: Duration -> Integer
whole_note_division_pp :: Integer -> Maybe Char
duration_pp :: Duration -> Maybe String
instance Eq Duration
instance Show Duration
instance Ord Duration
-- | Names for common music notation durations.
module Music.Theory.Duration.Name
breve :: Duration
thirtysecond_note :: Duration
sixteenth_note :: Duration
eighth_note :: Duration
quarter_note :: Duration
half_note :: Duration
whole_note :: Duration
dotted_breve :: Duration
dotted_thirtysecond_note :: Duration
dotted_sixteenth_note :: Duration
dotted_eighth_note :: Duration
dotted_quarter_note :: Duration
dotted_half_note :: Duration
dotted_whole_note :: Duration
double_dotted_breve :: Duration
double_dotted_thirtysecond_note :: Duration
double_dotted_sixteenth_note :: Duration
double_dotted_eighth_note :: Duration
double_dotted_quarter_note :: Duration
double_dotted_half_note :: Duration
double_dotted_whole_note :: Duration
-- | Rational quarter-note notation for durations.
module Music.Theory.Duration.RQ
-- | Rational Quarter-Note
type RQ = Rational
-- | Rational quarter note to duration value. It is a mistake to hope this
-- could handle tuplets directly since, for instance, a 3:2
-- dotted note will be of the same duration as a plain undotted note.
--
--
-- rq_to_duration (3/4) == Just dotted_eighth_note
--
rq_to_duration :: RQ -> Maybe Duration
-- | Is RQ a cmn duration.
--
--
-- map rq_is_cmn [1/4,1/5,1/8] == [True,False,True]
--
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.
--
--
-- map duration_to_rq [half_note,dotted_quarter_note] == [2,3/2]
--
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 :: [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 being a tuplet?
da_begins_tuplet :: Duration_A -> Bool
-- | Does Duration_A end a tuplet?
da_ends_tuplet :: Duration_A -> Bool
-- | Is Duration_A tied to the the right?
da_tied_right :: Duration_A -> Bool
-- | Annotate a sequence of Duration_A as a tuplet.
--
--
-- import Music.Theory.Duration.Name
-- da_tuplet (3,2) [(quarter_note,[Tie_Left]),(eighth_note,[Tie_Right])]
--
da_tuplet :: (Integer, Integer) -> [Duration_A] -> [Duration_A]
-- | Transform predicates into Ordering predicate such that if
-- f holds then LT, if g holds then GT else
-- EQ.
--
--
-- map (begin_end_cmp (== '{') (== '}')) "{a}" == [LT,EQ,GT]
--
begin_end_cmp :: (t -> Bool) -> (t -> Bool) -> t -> Ordering
-- | Variant of begin_end_cmp, predicates are constructed by
-- ==.
--
--
-- map (begin_end_cmp_eq '{' '}') "{a}" == [LT,EQ,GT]
--
begin_end_cmp_eq :: Eq t => t -> t -> t -> Ordering
-- | Given an Ordering predicate where LT opens a group,
-- GT closes a group, and EQ continues current group,
-- construct tree from list.
--
--
-- let {l = "a {b {c d} e f} g h i"
-- ;t = group_tree (begin_end_cmp_eq '{' '}') l}
-- in catMaybes (flatten t) == l
--
--
--
-- let d = putStrLn . drawTree . fmap show
-- in d (group_tree (begin_end_cmp_eq '(' ')') "a(b(cd)ef)ghi")
--
group_tree :: (a -> Ordering) -> [a] -> Tree (Maybe a)
-- | Group tuplets into a Tree. Branch nodes have label
-- Nothing, leaf nodes label Just Duration_A.
--
--
-- import Music.Theory.Duration.Name.Abbreviation
--
--
--
-- let d = [(q,[])
-- ,(e,[Begin_Tuplet (3,2,e)])
-- ,(s,[Begin_Tuplet (3,2,s)]),(s,[]),(s,[End_Tuplet])
-- ,(e,[End_Tuplet])
-- ,(q,[])]
-- in catMaybes (flatten (da_group_tuplets d)) == d
--
da_group_tuplets :: [Duration_A] -> Tree (Maybe Duration_A)
-- | Variant of break that places separator at left.
--
--
-- break_left (== 3) [1..6] == ([1..3],[4..6])
-- break_left (== 3) [1..3] == ([1..3],[])
--
break_left :: (a -> Bool) -> [a] -> ([a], [a])
-- | Variant of break_left that balances begin & end predicates.
--
--
-- break_left (== ')') "test (sep) _) balanced"
-- sep_balanced True (== '(') (== ')') "test (sep) _) balanced"
-- sep_balanced False (== '(') (== ')') "(test (sep) _) balanced"
--
sep_balanced :: Bool -> (a -> Bool) -> (a -> Bool) -> [a] -> ([a], [a])
-- | Group non-nested tuplets, ie. groups nested tuplets at one level.
da_group_tuplets_nn :: [Duration_A] -> [Either Duration_A [Duration_A]]
-- | Keep right variant of zipWith, unused rhs values are returned.
--
--
-- zip_with_kr (,) [1..3] ['a'..'e'] == ([(1,'a'),(2,'b'),(3,'c')],"de")
--
zip_with_kr :: (a -> b -> c) -> [a] -> [b] -> ([c], [b])
-- | Keep right variant of zip, unused rhs values are returned.
--
--
-- zip_kr [1..4] ['a'..'f'] == ([(1,'a'),(2,'b'),(3,'c'),(4,'d')],"ef")
--
zip_kr :: [a] -> [b] -> ([(a, b)], [b])
-- | zipWith variant that adopts the shape of the lhs.
--
--
-- let {p = [Left 1,Right [2,3],Left 4]
-- ;q = "abcd"}
-- in nn_reshape (,) p q == [Left (1,'a'),Right [(2,'b'),(3,'c')],Left (4,'d')]
--
nn_reshape :: (a -> b -> c) -> [Either a [a]] -> [b] -> [Either c [c]]
-- | Replace elements at Traversable with result of joining with
-- elements from list.
adopt_shape :: Traversable t => (a -> b -> c) -> [b] -> t a -> t c
-- | Variant of adopt_shape that considers only Just elements
-- at Traversable.
--
--
-- let {s = "a(b(cd)ef)ghi"
-- ;t = group_tree (begin_end_cmp_eq '(' ')') s}
-- in adopt_shape_m (,) [1..13] t
--
adopt_shape_m :: Traversable t => (a -> b -> c) -> [b] -> t (Maybe a) -> t (Maybe c)
-- | Does a have Tie_Left and Tie_Right?
d_annotated_tied_lr :: [D_Annotation] -> (Bool, Bool)
-- | Does d have Tie_Left and Tie_Right?
duration_a_tied_lr :: Duration_A -> (Bool, Bool)
instance Eq D_Annotation
instance Show D_Annotation
-- | Abbreviated names for Duration values when written as literals.
-- There are letter names where w is whole_note and
-- so on, and numerical names where _4 is
-- quarter_note and so on. In both cases a ' extension
-- means a dot so that e'' is a double dotted
-- eighth_note.
--
--
-- zipWith duration_compare_meq [e,e,e,e'] [e,s,q,e] == [EQ,GT,LT,GT]
-- zipWith sum_dur [e,q,q'] [e,e,e] == [Just q,Just q',Just h]
-- zipWith sum_dur' [e,q,q'] [e,e,e] == [q,q',h]
--
module Music.Theory.Duration.Name.Abbreviation
w :: Duration
s :: Duration
e :: Duration
q :: Duration
h :: Duration
w' :: Duration
s' :: Duration
e' :: Duration
q' :: Duration
h' :: Duration
w'' :: Duration
s'' :: Duration
e'' :: Duration
q'' :: Duration
h'' :: Duration
_1 :: Duration
_32 :: Duration
_16 :: Duration
_8 :: Duration
_4 :: Duration
_2 :: Duration
_1' :: Duration
_32' :: Duration
_16' :: Duration
_8' :: Duration
_4' :: Duration
_2' :: Duration
_1'' :: Duration
_32'' :: Duration
_16'' :: Duration
_8'' :: Duration
_4'' :: Duration
_2'' :: Duration
-- | 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
-- | Uniform division of time signature.
--
--
-- ts_divisions (3,4) == [1,1,1]
-- ts_divisions (3,8) == [1/2,1/2,1/2]
-- ts_divisions (2,2) == [2,2]
-- ts_divisions (1,1) == [4]
--
ts_divisions :: Time_Signature -> [RQ]
-- | Convert a duration to a pulse count in relation to the indicated time
-- signature.
--
--
-- ts_duration_pulses (3,8) quarter_note == 2
--
ts_duration_pulses :: Time_Signature -> Duration -> Rational
-- | Rewrite time signature to indicated denominator.
--
--
-- ts_rewrite 8 (3,4) == (6,8)
--
ts_rewrite :: Integer -> Time_Signature -> Time_Signature
-- | Sum time signatures.
--
--
-- ts_sum [(3,16),(1,2)] == (11,16)
--
ts_sum :: [Time_Signature] -> Time_Signature
-- | 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
-- | Set operations on lists.
module Music.Theory.Set.List
-- | Remove duplicate elements with nub and then sort.
--
--
-- set_l [3,3,3,2,2,1] == [1,2,3]
--
set :: Ord a => [a] -> [a]
-- | Size of powerset of set of cardinality n, ie. 2
-- ^ n.
--
--
-- map n_powerset [6..9] == [64,128,256,512]
--
n_powerset :: Integral n => n -> n
-- | Powerset, ie. set of all subsets.
--
--
-- sort (powerset [1,2]) == [[],[1],[1,2],[2]]
-- map length (map (\n -> powerset [1..n]) [6..9]) == [64,128,256,512]
--
powerset :: [a] -> [[a]]
-- | Two element subsets.
--
--
-- pairs [1,2,3] == [(1,2),(1,3),(2,3)]
--
pairs :: [a] -> [(a, a)]
-- | Three element subsets.
--
--
-- triples [1..4] == [(1,2,3),(1,2,4),(1,3,4),(2,3,4)]
--
--
--
-- let f n = genericLength (triples [1..n]) == nk_combinations n 3
-- in all f [1..15]
--
triples :: [a] -> [(a, a, a)]
-- | Set expansion (ie. to multiset of degree n).
--
--
-- expand_set 4 [1,2,3] == [[1,1,2,3],[1,2,2,3],[1,2,3,3]]
--
expand_set :: Ord a => Int -> [a] -> [[a]]
-- | All distinct multiset partitions, see partitions.
--
--
-- partitions "aab" == [["aab"],["a","ab"],["b","aa"],["b","a","a"]]
--
--
--
-- partitions "abc" == [["abc"]
-- ,["bc","a"],["b","ac"],["c","ab"]
-- ,["c","b","a"]]
--
partitions :: Eq a => [a] -> [[[a]]]
-- | Cartesian product of two sets.
--
--
-- let r = [('a',1),('a',2),('b',1),('b',2),('c',1),('c',2)]
-- in cartesian_product "abc" [1,2] == r
--
cartesian_product :: [a] -> [b] -> [(a, b)]
-- | Set operations on Sets.
module Music.Theory.Set.Set
set :: Ord a => [a] -> Set a
powerset :: Ord a => Set a -> Set (Set a)
pairs :: Ord a => Set a -> Set (a, a)
-- | Common music notation pitch values.
module Music.Theory.Pitch
-- | Pitch classes are modulo twelve integers.
type PitchClass = Integer
-- | Octaves are Integers, the octave of middle C is 4.
type Octave = Integer
-- | Octave and PitchClass duple.
type Octave_PitchClass i = (i, i)
type OctPC = (Octave, PitchClass)
-- | 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
-- | 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
-- | 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
-- | Pretty printer for Pitch (unicode, see
-- alteration_symbol).
--
--
-- pitch_pp (Pitch E Flat 4) == "E♭4"
-- pitch_pp (Pitch F QuarterToneSharp 3) == "F𝄲3"
--
pitch_pp :: Pitch -> String
-- | Pretty printer for Pitch (ASCII, see
-- alteration_ly_name).
--
--
-- pitch_pp_ascii (Pitch E Flat 4) == "ees4"
-- pitch_pp_ascii (Pitch F QuarterToneSharp 3) == "fih3"
--
pitch_pp_ascii :: Pitch -> String
-- | Transform Note_T to pitch-class number.
--
--
-- map note_to_pc [C,E,G] == [0,4,7]
--
note_to_pc :: Integral i => Note_T -> i
-- | Transform Alteration_T to semitone alteration. Returns
-- Nothing for non-semitone alterations.
--
--
-- map alteration_to_diff [Flat,QuarterToneSharp] == [Just (-1),Nothing]
--
alteration_to_diff :: Integral i => Alteration_T -> Maybe i
-- | 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
-- | Unicode has entries for Musical Symbols in the range
-- U+1D100 through U+1D1FF. The 3/4 symbols
-- are non-standard, here they correspond to MUSICAL SYMBOL FLAT
-- DOWN and MUSICAL SYMBOL SHARP UP.
--
--
-- map alteration_symbol [minBound .. maxBound] == "𝄫𝄭♭𝄳♮𝄲♯𝄰𝄪"
--
alteration_symbol :: Alteration_T -> Char
-- | The Lilypond ASCII spellings for alterations.
--
--
-- map alteration_ly_name [Flat .. Sharp] == ["es","eh","","ih","is"]
--
alteration_ly_name :: Alteration_T -> String
-- | 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.
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
-- | 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
-- | 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 :: Pitch -> Double
-- | Extract PitchClass of Pitch
--
--
-- pitch_to_pc (Pitch A Natural 4) == 9
-- pitch_to_pc (Pitch F Sharp 4) == 6
--
pitch_to_pc :: Pitch -> PitchClass
-- | Pitch comparison, implemented via pitch_to_fmidi.
--
--
-- pitch_compare (Pitch A Natural 4) (Pitch A QuarterToneSharp 4) == LT
--
pitch_compare :: Pitch -> Pitch -> Ordering
-- | Function to spell a PitchClass.
type Spelling n = n -> (Note_T, Alteration_T)
-- | Given Spelling function translate from OctPC notation to
-- Pitch.
octpc_to_pitch :: Integral i => Spelling i -> Octave_PitchClass i -> Pitch
-- | Normalise OctPC value, ie. ensure PitchClass is in
-- (0,11).
--
--
-- octpc_nrm (4,16) == (5,4)
--
octpc_nrm :: Integral i => Octave_PitchClass i -> Octave_PitchClass i
-- | Transpose OctPC value.
--
--
-- octpc_trs 7 (4,9) == (5,4)
-- octpc_trs (-11) (4,9) == (3,10)
--
octpc_trs :: Integral i => i -> Octave_PitchClass i -> Octave_PitchClass i
-- | OctPC value to integral midi note number.
--
--
-- octpc_to_midi (4,9) == 69
--
octpc_to_midi :: Integral i => Octave_PitchClass i -> i
-- | Inverse of octpc_to_midi.
--
--
-- midi_to_octpc 69 == (4,9)
--
midi_to_octpc :: Integral i => i -> Octave_PitchClass i
-- | Midi note number to Pitch.
--
--
-- let r = ["C4","E♭4","F♯4"]
-- in map (pitch_pp . midi_to_pitch pc_spell_ks) [60,63,66] == r
--
midi_to_pitch :: Integral i => Spelling i -> i -> Pitch
-- | Fractional midi note number to Pitch.
--
--
-- import Music.Theory.Pitch.Spelling
-- pitch_pp (fmidi_to_pitch pc_spell_ks 65.5) == "F𝄲4"
-- pitch_pp (fmidi_to_pitch pc_spell_ks 66.5) == "F𝄰4"
-- pitch_pp (fmidi_to_pitch pc_spell_ks 67.5) == "A𝄭4"
-- pitch_pp (fmidi_to_pitch pc_spell_ks 69.5) == "B𝄭4"
--
fmidi_to_pitch :: RealFrac n => Spelling Integer -> n -> 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 :: (Integer -> Integer) -> Pitch -> Pitch
-- | Modal transposition of Note_T value.
--
--
-- note_t_transpose C 2 == E
--
note_t_transpose :: Note_T -> Int -> Note_T
-- | Midi note number to cycles per second.
--
--
-- map midi_to_cps [60,69] == [261.6255653005986,440.0]
--
midi_to_cps :: (Integral i, Floating f) => i -> f
-- | Fractional midi note number to cycles per second.
--
--
-- map fmidi_to_cps [69,69.1] == [440.0,442.5488940698553]
--
fmidi_to_cps :: Floating a => a -> a
-- | Frequency (cycles per second) to midi note number.
--
--
-- map cps_to_midi [261.6,440] == [60,69]
--
cps_to_midi :: (Integral i, Floating f, RealFrac f) => f -> i
-- | Frequency (cycles per second) to fractional midi note number.
--
--
-- cps_to_fmidi 440 == 69
-- cps_to_fmidi (fmidi_to_cps 60.25) == 60.25
--
cps_to_fmidi :: Floating a => a -> a
-- | midi_to_cps of octpc_to_midi.
--
--
-- octpc_to_cps (4,9) == 440
--
octpc_to_cps :: (Integral i, Floating n) => Octave_PitchClass i -> n
instance Eq Note_T
instance Enum Note_T
instance Bounded Note_T
instance Ord Note_T
instance Show Note_T
instance Eq Alteration_T
instance Enum Alteration_T
instance Bounded Alteration_T
instance Ord Alteration_T
instance Show Alteration_T
instance Eq Pitch
instance Show Pitch
instance Ord Pitch
-- | Constants names for Pitch values. eses indicates double
-- flat, eseh three quarter tone flat, es flat, eh
-- quarter tone flat, ih quarter tone sharp, is sharp,
-- isih three quarter tone sharp and isis double sharp.
module Music.Theory.Pitch.Name
a0 :: Pitch
b0 :: Pitch
bes0 :: Pitch
ais0 :: Pitch
bis0 :: Pitch
c1 :: Pitch
b1 :: Pitch
a1 :: Pitch
g1 :: Pitch
f1 :: Pitch
e1 :: Pitch
d1 :: Pitch
ces1 :: Pitch
bes1 :: Pitch
aes1 :: Pitch
ges1 :: Pitch
fes1 :: Pitch
ees1 :: Pitch
des1 :: Pitch
cis1 :: Pitch
bis1 :: Pitch
ais1 :: Pitch
gis1 :: Pitch
fis1 :: Pitch
eis1 :: Pitch
dis1 :: Pitch
c2 :: Pitch
b2 :: Pitch
a2 :: Pitch
g2 :: Pitch
f2 :: Pitch
e2 :: Pitch
d2 :: Pitch
ces2 :: Pitch
bes2 :: Pitch
aes2 :: Pitch
ges2 :: Pitch
fes2 :: Pitch
ees2 :: Pitch
des2 :: Pitch
cis2 :: Pitch
bis2 :: Pitch
ais2 :: Pitch
gis2 :: Pitch
fis2 :: Pitch
eis2 :: Pitch
dis2 :: Pitch
cisis2 :: Pitch
bisis2 :: Pitch
aisis2 :: Pitch
gisis2 :: Pitch
fisis2 :: Pitch
eisis2 :: Pitch
disis2 :: Pitch
c3 :: Pitch
b3 :: Pitch
a3 :: Pitch
g3 :: Pitch
f3 :: Pitch
e3 :: Pitch
d3 :: Pitch
ces3 :: Pitch
bes3 :: Pitch
aes3 :: Pitch
ges3 :: Pitch
fes3 :: Pitch
ees3 :: Pitch
des3 :: Pitch
cis3 :: Pitch
bis3 :: Pitch
ais3 :: Pitch
gis3 :: Pitch
fis3 :: Pitch
eis3 :: Pitch
dis3 :: Pitch
ceses3 :: Pitch
beses3 :: Pitch
aeses3 :: Pitch
geses3 :: Pitch
feses3 :: Pitch
eeses3 :: Pitch
deses3 :: Pitch
cisis3 :: Pitch
bisis3 :: Pitch
aisis3 :: Pitch
gisis3 :: Pitch
fisis3 :: Pitch
eisis3 :: Pitch
disis3 :: Pitch
ceseh3 :: Pitch
beseh3 :: Pitch
aeseh3 :: Pitch
geseh3 :: Pitch
feseh3 :: Pitch
eeseh3 :: Pitch
deseh3 :: Pitch
ceh3 :: Pitch
beh3 :: Pitch
aeh3 :: Pitch
geh3 :: Pitch
feh3 :: Pitch
eeh3 :: Pitch
deh3 :: Pitch
cih3 :: Pitch
bih3 :: Pitch
aih3 :: Pitch
gih3 :: Pitch
fih3 :: Pitch
eih3 :: Pitch
dih3 :: Pitch
cisih3 :: Pitch
bisih3 :: Pitch
aisih3 :: Pitch
gisih3 :: Pitch
fisih3 :: Pitch
eisih3 :: Pitch
disih3 :: Pitch
c4 :: Pitch
b4 :: Pitch
a4 :: Pitch
g4 :: Pitch
f4 :: Pitch
e4 :: Pitch
d4 :: Pitch
ces4 :: Pitch
bes4 :: Pitch
aes4 :: Pitch
ges4 :: Pitch
fes4 :: Pitch
ees4 :: Pitch
des4 :: Pitch
cis4 :: Pitch
bis4 :: Pitch
ais4 :: Pitch
gis4 :: Pitch
fis4 :: Pitch
eis4 :: Pitch
dis4 :: Pitch
ceses4 :: Pitch
beses4 :: Pitch
aeses4 :: Pitch
geses4 :: Pitch
feses4 :: Pitch
eeses4 :: Pitch
deses4 :: Pitch
cisis4 :: Pitch
bisis4 :: Pitch
aisis4 :: Pitch
gisis4 :: Pitch
fisis4 :: Pitch
eisis4 :: Pitch
disis4 :: Pitch
ceseh4 :: Pitch
beseh4 :: Pitch
aeseh4 :: Pitch
geseh4 :: Pitch
feseh4 :: Pitch
eeseh4 :: Pitch
deseh4 :: Pitch
ceh4 :: Pitch
beh4 :: Pitch
aeh4 :: Pitch
geh4 :: Pitch
feh4 :: Pitch
eeh4 :: Pitch
deh4 :: Pitch
cih4 :: Pitch
bih4 :: Pitch
aih4 :: Pitch
gih4 :: Pitch
fih4 :: Pitch
eih4 :: Pitch
dih4 :: Pitch
cisih4 :: Pitch
bisih4 :: Pitch
aisih4 :: Pitch
gisih4 :: Pitch
fisih4 :: Pitch
eisih4 :: Pitch
disih4 :: Pitch
c5 :: Pitch
b5 :: Pitch
a5 :: Pitch
g5 :: Pitch
f5 :: Pitch
e5 :: Pitch
d5 :: Pitch
ces5 :: Pitch
bes5 :: Pitch
aes5 :: Pitch
ges5 :: Pitch
fes5 :: Pitch
ees5 :: Pitch
des5 :: Pitch
cis5 :: Pitch
bis5 :: Pitch
ais5 :: Pitch
gis5 :: Pitch
fis5 :: Pitch
eis5 :: Pitch
dis5 :: Pitch
ceses5 :: Pitch
beses5 :: Pitch
aeses5 :: Pitch
geses5 :: Pitch
feses5 :: Pitch
eeses5 :: Pitch
deses5 :: Pitch
cisis5 :: Pitch
bisis5 :: Pitch
aisis5 :: Pitch
gisis5 :: Pitch
fisis5 :: Pitch
eisis5 :: Pitch
disis5 :: Pitch
ceseh5 :: Pitch
beseh5 :: Pitch
aeseh5 :: Pitch
geseh5 :: Pitch
feseh5 :: Pitch
eeseh5 :: Pitch
deseh5 :: Pitch
ceh5 :: Pitch
beh5 :: Pitch
aeh5 :: Pitch
geh5 :: Pitch
feh5 :: Pitch
eeh5 :: Pitch
deh5 :: Pitch
cih5 :: Pitch
bih5 :: Pitch
aih5 :: Pitch
gih5 :: Pitch
fih5 :: Pitch
eih5 :: Pitch
dih5 :: Pitch
cisih5 :: Pitch
bisih5 :: Pitch
aisih5 :: Pitch
gisih5 :: Pitch
fisih5 :: Pitch
eisih5 :: Pitch
disih5 :: Pitch
c6 :: Pitch
b6 :: Pitch
a6 :: Pitch
g6 :: Pitch
f6 :: Pitch
e6 :: Pitch
d6 :: Pitch
ces6 :: Pitch
bes6 :: Pitch
aes6 :: Pitch
ges6 :: Pitch
fes6 :: Pitch
ees6 :: Pitch
des6 :: Pitch
cis6 :: Pitch
bis6 :: Pitch
ais6 :: Pitch
gis6 :: Pitch
fis6 :: Pitch
eis6 :: Pitch
dis6 :: Pitch
ceseh6 :: Pitch
beseh6 :: Pitch
aeseh6 :: Pitch
geseh6 :: Pitch
feseh6 :: Pitch
eeseh6 :: Pitch
deseh6 :: Pitch
ceh6 :: Pitch
beh6 :: Pitch
aeh6 :: Pitch
geh6 :: Pitch
feh6 :: Pitch
eeh6 :: Pitch
deh6 :: Pitch
cih6 :: Pitch
bih6 :: Pitch
aih6 :: Pitch
gih6 :: Pitch
fih6 :: Pitch
eih6 :: Pitch
dih6 :: Pitch
cisih6 :: Pitch
bisih6 :: Pitch
aisih6 :: Pitch
gisih6 :: Pitch
fisih6 :: Pitch
eisih6 :: Pitch
disih6 :: Pitch
c7 :: Pitch
b7 :: Pitch
a7 :: Pitch
g7 :: Pitch
f7 :: Pitch
e7 :: Pitch
d7 :: Pitch
ces7 :: Pitch
bes7 :: Pitch
aes7 :: Pitch
ges7 :: Pitch
fes7 :: Pitch
ees7 :: Pitch
des7 :: Pitch
cis7 :: Pitch
bis7 :: Pitch
ais7 :: Pitch
gis7 :: Pitch
fis7 :: Pitch
eis7 :: Pitch
dis7 :: Pitch
c8 :: Pitch
d8 :: Pitch
cis8 :: Pitch
-- | Common music notation 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 Integer
-- | 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 -> Integer
-- | Inclusive set of Note_T within indicated interval. This is not
-- equal to enumFromTo which is not circular.
--
--
-- note_span E B == [E,F,G,A,B]
-- note_span B D == [B,C,D]
-- enumFromTo B D == []
--
note_span :: Note_T -> Note_T -> [Note_T]
-- | Invert Ordering, ie. GT becomes LT and vice
-- versa.
--
--
-- map invert_ordering [LT,EQ,GT] == [GT,EQ,LT]
--
invert_ordering :: Ordering -> Ordering
-- | Determine Interval between two Pitches.
--
--
-- interval (Pitch C Sharp 4) (Pitch D Flat 4) == Interval Second Diminished EQ 0
-- interval (Pitch C Sharp 4) (Pitch E Sharp 5) == Interval Third Major LT 1
--
interval :: Pitch -> Pitch -> Interval
-- | Apply invert_ordering to interval_direction of
-- Interval.
--
--
-- invert_interval (Interval Third Major LT 1) == Interval Third Major GT 1
--
invert_interval :: Interval -> Interval
-- | The signed difference in semitones between two Interval_Q
-- values when applied to the same Interval_T. Can this be written
-- correctly without knowing the Interval_T?
--
--
-- quality_difference_m Minor Augmented == Just 2
-- quality_difference_m Augmented Diminished == Just (-3)
-- quality_difference_m Major Perfect == Nothing
--
quality_difference_m :: Interval_Q -> Interval_Q -> Maybe Int
-- | Erroring variant of quality_difference_m.
quality_difference :: Interval_Q -> Interval_Q -> Int
-- | Transpose a Pitch by an Interval.
--
--
-- transpose (Interval Third Diminished LT 0) (Pitch C Sharp 4) == Pitch E Flat 4
--
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])
instance Eq Interval_T
instance Enum Interval_T
instance Bounded Interval_T
instance Ord Interval_T
instance Show Interval_T
instance Eq Interval_Q
instance Enum Interval_Q
instance Bounded Interval_Q
instance Ord Interval_Q
instance Show Interval_Q
instance Eq Interval
instance Show Interval
-- | Constants names for ascending Interval values.
module Music.Theory.Interval.Name
perfect_fourth :: Interval
major_seventh :: Interval
perfect_fifth :: Interval
-- | Spelling rules for Interval values.
module Music.Theory.Interval.Spelling
-- | Simplest spelling for semitone intervals. This is ambiguous for
-- 6 which could be either aug.4 or dim.5.
--
--
-- i_to_interval 6 == Interval Fourth Augmented LT 0
-- map i_to_interval [0..11]
--
i_to_interval :: Int -> Interval
-- | Perform some interval simplifications. For non-tonal music some
-- spellings are poor, ie. (f,g#).
--
--
-- interval_simplify (Interval Second Augmented LT 0) == Interval Third Minor LT 0
--
interval_simplify :: Interval -> Interval
-- | Spelling rules for common music notation.
module Music.Theory.Pitch.Spelling
-- | Variant of Spelling for incomplete functions.
type Spelling_M i = i -> Maybe (Note_T, Alteration_T)
-- | Spelling for natural (♮) notes only.
--
--
-- map pc_spell_natural_m [0,1] == [Just (C,Natural),Nothing]
--
pc_spell_natural_m :: Integral i => Spelling_M i
-- | Erroring variant of pc_spell_natural_m.
--
--
-- map pc_spell_natural [0,5,7] == [(C,Natural),(F,Natural),(G,Natural)]
--
pc_spell_natural :: Integral i => Spelling i
-- | Use spelling from simplest key-signature. Note that this is ambiguous
-- for 8, which could be either G Sharp (♯) in A Major or
-- A Flat (♭) in E Flat (♭) Major.
--
--
-- map pc_spell_ks [6,8] == [(F,Sharp),(A,Flat)]
--
pc_spell_ks :: Integral i => Spelling i
-- | Use always sharp (♯) spelling.
--
--
-- map pc_spell_sharp [6,8] == [(F,Sharp),(G,Sharp)]
-- Data.List.nub (map (snd . pc_spell_sharp) [1,3,6,8,10]) == [Sharp]
-- octpc_to_pitch pc_spell_sharp (4,6) == Pitch F Sharp 4
--
pc_spell_sharp :: Integral i => Spelling i
-- | Use always flat (♭) spelling.
--
--
-- map pc_spell_flat [6,8] == [(G,Flat),(A,Flat)]
-- Data.List.nub (map (snd . pc_spell_flat) [1,3,6,8,10]) == [Flat]
--
pc_spell_flat :: Integral i => Spelling i
-- | Spelling for chromatic clusters.
module Music.Theory.Pitch.Spelling.Cluster
-- | Spelling table for chromatic clusters.
--
--
-- let f (p,q) = p == sort (map (snd . pitch_to_octpc) q)
-- in all f spell_cluster_c4_table == True
--
spell_cluster_c4_table :: [([PitchClass], [Pitch])]
-- | Spelling for chromatic clusters. Sequence must be ascending. Pitch
-- class 0 maps to c4, if there is no 0 then all
-- notes are in octave 4.
--
--
-- let f = fmap (map pitch_pp) . spell_cluster_c4
-- in map f [[11,0],[11]] == [Just ["B3","C4"],Just ["B4"]]
--
--
--
-- fmap (map pitch_pp) (spell_cluster_c4 [10,11]) == Just ["A♯4","B4"]
--
spell_cluster_c4 :: [PitchClass] -> Maybe [Pitch]
-- | Variant of spell_cluster_c4 that runs pitch_edit_octave.
-- An octave of 4 is the identitiy, 3 an octave below,
-- 5 an octave above.
--
--
-- fmap (map pitch_pp) (spell_cluster_c 3 [11,0]) == Just ["B2","C3"]
-- fmap (map pitch_pp) (spell_cluster_c 3 [10,11]) == Just ["A♯3","B3"]
--
spell_cluster_c :: Octave -> [PitchClass] -> Maybe [Pitch]
-- | Variant of spell_cluster_c4 that runs pitch_edit_octave
-- so that the left-most note is in the octave given by f.
--
--
-- import Data.Maybe
--
--
--
-- let {f n = if n >= 11 then 3 else 4
-- ;g = map pitch_pp .fromJust . spell_cluster_f f
-- ;r = [["B3","C4"],["B3"],["C4"],["A♯4","B4"]]}
-- in map g [[11,0],[11],[0],[10,11]] == r
--
spell_cluster_f :: (PitchClass -> Octave) -> [PitchClass] -> Maybe [Pitch]
-- | Variant of spell_cluster_c4 that runs pitch_edit_octave
-- so that the left-most note is in octave o.
--
--
-- fmap (map pitch_pp) (spell_cluster_left 3 [11,0]) == Just ["B3","C4"]
-- fmap (map pitch_pp) (spell_cluster_left 3 [10,11]) == Just ["A♯3","B3"]
--
spell_cluster_left :: Octave -> [PitchClass] -> Maybe [Pitch]
-- | Common music keys.
module Music.Theory.Key
-- | Enumeration of common music notation modes.
data Mode_T
Minor_Mode :: Mode_T
Major_Mode :: Mode_T
-- | A common music notation key is a Note_T, Alteration_T,
-- Mode_T triple.
type Key = (Note_T, Alteration_T, Mode_T)
-- | Distance along circle of fifths path of indicated Key. A
-- positive number indicates the number of sharps, a negative number the
-- number of flats.
--
--
-- key_fifths (A,Natural,Minor_Mode) == 0
-- key_fifths (A,Natural,Major_Mode) == 3
-- key_fifths (C,Natural,Minor_Mode) == -3
--
key_fifths :: Key -> Int
instance Eq Mode_T
instance Ord Mode_T
instance Show Mode_T
-- | 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 Integral i => 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
instance Eq Clef_T
instance Ord Clef_T
instance Show Clef_T
instance Integral i => Eq (Clef i)
instance Integral i => Ord (Clef i)
instance (Integral i, Show i) => Show (Clef i)
-- | Shared list functions.
module Music.Theory.List
-- | Bracket sequence with left and right values.
--
--
-- bracket ('<','>') "1,2,3" == "<1,2,3>"
--
bracket :: (a, a) -> [a] -> [a]
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]
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 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]]
genericAdj2 :: Integral n => n -> [t] -> [(t, t)]
-- | Adjacent elements of list, at indicated distance, as pairs.
--
--
-- adj2 1 [1..5] == [(1,2),(2,3),(3,4),(4,5)]
-- adj2 2 [1..4] == [(1,2),(3,4)]
-- adj2 3 [1..5] == [(1,2),(4,5)]
--
adj2 :: Int -> [t] -> [(t, t)]
-- | Append first element to end of list.
--
--
-- close [1..3] == [1,2,3,1]
--
close :: [a] -> [a]
-- | adj2 . close.
--
--
-- adj2_cyclic 1 [1..3] == [(1,2),(2,3),(3,1)]
--
adj2_cyclic :: Int -> [t] -> [(t, t)]
-- | Interleave elements of p and q.
--
--
-- interleave [1..3] [4..6] == [1,4,2,5,3,6]
--
interleave :: [b] -> [b] -> [b]
-- | interleave of rotate_left by i and j.
--
--
-- interleave_rotations 9 3 [1..13] == [10,4,11,5,12,6,13,7,1,8,2,9,3,10,4,11,5,12,6,13,7,1,8,2,9,3]
--
interleave_rotations :: Int -> Int -> [b] -> [b]
-- | Count occurences of elements in list.
--
--
-- histogram "hohoh" == [('h',3),('o',2)]
--
histogram :: (Ord a, Integral i) => [a] -> [(a, i)]
-- | List segments of length i at distance j.
--
--
-- segments 2 1 [1..5] == [[1,2],[2,3],[3,4],[4,5]]
-- segments 2 2 [1..5] == [[1,2],[3,4]]
--
segments :: Int -> Int -> [a] -> [[a]]
-- | foldl1 intersect.
--
--
-- intersect_l [[1,2],[1,2,3],[1,2,3,4]] == [1,2]
--
intersect_l :: Eq a => [[a]] -> [a]
-- | foldl1 union.
--
--
-- sort (union_l [[1,3],[2,3],[3]]) == [1,2,3]
--
union_l :: Eq a => [[a]] -> [a]
-- | Intersection of adjacent elements of list at distance n.
--
--
-- adj_intersect 1 [[1,2],[1,2,3],[1,2,3,4]] == [[1,2],[1,2,3]]
--
adj_intersect :: Eq a => Int -> [[a]] -> [[a]]
-- | List of cycles at distance n.
--
--
-- cycles 2 [1..6] == [[1,3,5],[2,4,6]]
-- cycles 3 [1..9] == [[1,4,7],[2,5,8],[3,6,9]]
-- cycles 4 [1..8] == [[1,5],[2,6],[3,7],[4,8]]
--
cycles :: Int -> [a] -> [[a]]
-- | Collate values of equal keys at assoc list.
--
--
-- collate [(1,'a'),(2,'b'),(1,'c')] == [(1,"ac"),(2,"b")]
--
collate :: Ord a => [(a, b)] -> [(a, [b])]
-- | Make assoc list with given key.
--
--
-- with_key 'a' [1..3] == [('a',1),('a',2),('a',3)]
--
with_key :: k -> [v] -> [(k, v)]
-- | Intervals to values, zero is n.
--
--
-- dx_d 5 [1,2,3] == [5,6,8,11]
--
dx_d :: Num a => a -> [a] -> [a]
-- | Integrate, ie. pitch class segment to interval sequence.
--
--
-- d_dx [5,6,8,11] == [1,2,3]
--
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
-- | Find adjacent elements of list that bound element under given
-- comparator.
--
--
-- let f = find_bounds compare (adj [1..5])
-- in map f [1,3.5,5] == [Just (1,2),Just (3,4),Nothing]
--
find_bounds :: (t -> s -> Ordering) -> [(t, t)] -> s -> Maybe (t, t)
-- | Variant of drop from right of list.
--
--
-- dropRight 1 [1..9] == [1..8]
--
dropRight :: Int -> [a] -> [a]
-- | Apply f at first element, and g at all other elements.
--
--
-- at_head negate id [1..5] == [-1,2,3,4,5]
--
at_head :: (a -> b) -> (a -> b) -> [a] -> [b]
-- | Apply f at all but last element, and g at last element.
--
--
-- at_last (* 2) negate [1..4] == [2,4,6,-4]
--
at_last :: (a -> b) -> (a -> b) -> [a] -> [b]
-- | Separate list into an initial list and a last element tuple.
--
--
-- separate_last [1..5] == ([1..4],5)
--
separate_last :: [a] -> ([a], a)
-- | Replace directly repeated elements with Nothing.
--
--
-- indicate_repetitions "abba" == [Just 'a',Just 'b',Nothing,Just 'a']
--
indicate_repetitions :: Eq a => [a] -> [Maybe a]
adjacent_groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
group_just :: [Maybe a] -> [[Maybe a]]
-- | Given a comparison function, merge two ascending lists.
--
--
-- mergeBy compare [1,3,5] [2,4] == [1..5]
--
mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
-- | mergeBy compare.
merge :: Ord a => [a] -> [a] -> [a]
-- | merge a set of ordered sequences.
--
--
-- merge_set [[1,3..9],[2,4..8],[10]] == [1..10]
--
merge_set :: Ord a => [[a]] -> [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 :: Eq a => Permute -> [a] -> [a]
-- | Composition of apply_permutation and from_cycles.
--
--
-- apply_permutation_c [[0,3],[1,2]] [1..4] == [4,3,2,1]
-- apply_permutation_c [[0,2],[1],[3,4]] [1..5] == [3,2,1,5,4]
-- apply_permutation_c [[0,1,4],[2,3]] [1..5] == [2,5,4,3,1]
-- apply_permutation_c [[0,1,3],[2,4]] [1..5] == [2,4,5,1,3]
--
apply_permutation_c :: Eq a => [[Int]] -> [a] -> [a]
-- | True if the inverse of p is p.
--
--
-- non_invertible (permutation [0,1,3] [1,0,3]) == True
--
--
--
-- let p = permutation [1..4] [4,3,2,1]
-- in non_invertible p == True && P.cycles p == [[0,3],[1,2]]
--
non_invertible :: Permute -> Bool
-- | Generate a permutation from the cycles c.
--
--
-- apply_permutation (from_cycles [[0,1,2,3]]) [1..4] == [2,3,4,1]
--
from_cycles :: [[Int]] -> Permute
-- | Generate all permutations of size n.
--
--
-- map one_line (permutations_n 3) == [[1,2,3],[1,3,2]
-- ,[2,1,3],[2,3,1]
-- ,[3,1,2],[3,2,1]]
--
permutations_n :: Int -> [Permute]
-- | Composition of q then p.
--
--
-- let {p = from_cycles [[0,2],[1],[3,4]]
-- ;q = from_cycles [[0,1,4],[2,3]]
-- ;r = p `compose` q}
-- in apply_permutation r [1,2,3,4,5] == [2,4,5,1,3]
--
compose :: Permute -> Permute -> Permute
-- | Two line notation of p.
--
--
-- two_line (permutation [0,1,3] [1,0,3]) == ([1,2,3],[2,1,3])
--
two_line :: Permute -> ([Int], [Int])
-- | One line notation of p.
--
--
-- one_line (permutation [0,1,3] [1,0,3]) == [2,1,3]
--
--
--
-- map one_line (permutations_n 3) == [[1,2,3],[1,3,2]
-- ,[2,1,3],[2,3,1]
-- ,[3,1,2],[3,2,1]]
--
one_line :: Permute -> [Int]
-- | Variant of one_line that produces a compact string.
--
--
-- one_line_compact (permutation [0,1,3] [1,0,3]) == "213"
--
--
--
-- let p = permutations_n 3
-- in unwords (map one_line_compact p) == "123 132 213 231 312 321"
--
one_line_compact :: Permute -> String
-- | Multiplication table of symmetric group n.
--
--
-- unlines (map (unwords . map one_line_compact) (multiplication_table 3))
--
--
--
-- ==> 123 132 213 231 312 321
-- 132 123 312 321 213 231
-- 213 231 123 132 321 312
-- 231 213 321 312 123 132
-- 312 321 132 123 231 213
-- 321 312 231 213 132 123
--
multiplication_table :: Int -> [[Permute]]
-- | Combination functions.
module Music.Theory.Combinations
-- | Number of k element combinations of a set of n elements.
--
--
-- (nk_combinations 6 3,nk_combinations 13 3) == (20,286)
--
nk_combinations :: Integral a => a -> a -> a
-- | k element subsets of s.
--
--
-- combinations 3 [1..4] == [[1,2,3],[1,2,4],[1,3,4],[2,3,4]]
-- length (combinations 3 [1..5]) == nk_combinations 5 3
--
combinations :: Integral t => t -> [a] -> [[a]]
-- | List permutation functions.
module Music.Theory.Permutations.List
-- | Generate all permutations.
--
--
-- permutations [0,3] == [[0,3],[3,0]]
-- length (permutations [1..5]) == P.n_permutations 5
--
permutations :: Eq a => [a] -> [[a]]
-- | Generate all distinct permutations of a multi-set.
--
--
-- multiset_permutations [0,1,1] == [[0,1,1],[1,1,0],[1,0,1]]
--
multiset_permutations :: Ord a => [a] -> [[a]]
-- | Polansky, Larry and Bassein, Richard "Possible and Impossible Melody:
-- Some Formal Aspects of Contour" Journal of Music Theory 36/2,
-- 1992 (pp.259-284) (http://www.jstor.org/pss/843933)
module Music.Theory.Contour.Polansky_1992
-- | Replace the ith value at ns with x.
--
--
-- replace "test" 2 'n' == "tent"
--
replace :: Integral i => [a] -> i -> a -> [a]
-- | Are all elements equal.
--
--
-- all_equal "aaa" == True
--
all_equal :: Eq a => [a] -> Bool
-- | Compare adjacent elements (p.262) left to right.
--
--
-- compare_adjacent [0,1,3,2] == [LT,LT,GT]
--
compare_adjacent :: Ord a => [a] -> [Ordering]
-- | Construct set of n - 1 adjacent indices, left
-- right order.
--
--
-- adjacent_indices 5 == [(0,1),(1,2),(2,3),(3,4)]
--
adjacent_indices :: Integral i => i -> [(i, i)]
-- | All (i,j) indices, in half matrix order.
--
--
-- all_indices 4 == [(0,1),(0,2),(0,3),(1,2),(1,3),(2,3)]
--
all_indices :: Integral i => i -> [(i, i)]
-- | Generic variant of fromEnum (p.263).
genericFromEnum :: (Integral i, Enum e) => e -> i
-- | Generic variant of toEnum (p.263).
genericToEnum :: (Integral i, Enum e) => i -> e
-- | Specialised genericFromEnum.
ord_to_int :: Integral a => Ordering -> a
-- | Specialised genericToEnum.
int_to_ord :: Integral a => a -> Ordering
-- | Invert Ordering.
--
--
-- map ord_invert [LT,EQ,GT] == [GT,EQ,LT]
--
ord_invert :: Ordering -> Ordering
-- | A list notation for matrices.
type Matrix a = [[a]]
-- | Apply f to construct Matrix from sequence.
--
--
-- matrix_f (,) [1..3] == [[(1,1),(1,2),(1,3)]
-- ,[(2,1),(2,2),(2,3)]
-- ,[(3,1),(3,2),(3,3)]]
--
matrix_f :: (a -> a -> b) -> [a] -> Matrix b
-- | Construct matrix_f with compare (p.263).
--
--
-- contour_matrix [1..3] == [[EQ,LT,LT],[GT,EQ,LT],[GT,GT,EQ]]
--
contour_matrix :: Ord a => [a] -> Matrix Ordering
-- | Half matrix notation for contour.
data Contour_Half_Matrix
Contour_Half_Matrix :: Int -> Matrix Ordering -> Contour_Half_Matrix
contour_half_matrix_n :: Contour_Half_Matrix -> Int
contour_half_matrix_m :: Contour_Half_Matrix -> Matrix Ordering
-- | Half Matrix of contour given comparison function f.
--
--
-- half_matrix_f (flip (-)) [2,10,6,7] == [[8,4,5],[-4,-3],[1]]
-- half_matrix_f (flip (-)) [5,0,3,2] == [[-5,-2,-3],[3,2],[-1]]
-- half_matrix_f compare [5,0,3,2] == [[GT,GT,GT],[LT,LT],[GT]]
--
half_matrix_f :: (a -> a -> b) -> [a] -> Matrix b
-- | Construct Contour_Half_Matrix (p.264)
contour_half_matrix :: Ord a => [a] -> Contour_Half_Matrix
-- | Show function for Contour_Half_Matrix.
contour_half_matrix_str :: Contour_Half_Matrix -> String
-- | Description notation of contour.
data Contour_Description
Contour_Description :: Int -> Map (Int, Int) Ordering -> Contour_Description
contour_description_n :: Contour_Description -> Int
contour_description_m :: Contour_Description -> Map (Int, Int) Ordering
-- | Construct Contour_Description of contour (p.264).
--
--
-- let c = [[3,2,4,1],[3,2,1,4]]
-- in map (show.contour_description) c == ["202 02 2","220 20 0"]
--
contour_description :: Ord a => [a] -> Contour_Description
-- | Show function for Contour_Description (p.264).
contour_description_str :: Contour_Description -> String
-- | Convert from Contour_Half_Matrix notation to
-- Contour_Description.
half_matrix_to_description :: Contour_Half_Matrix -> Contour_Description
-- | Ordering from ith to jth element of sequence described
-- at d.
--
--
-- contour_description_ix (contour_description "abdc") (0,3) == LT
--
contour_description_ix :: Contour_Description -> (Int, Int) -> Ordering
-- | True if contour is all descending, equal or ascending.
--
--
-- let c = ["abc","bbb","cba"]
-- in map (uniform.contour_description) c == [True,True,True]
--
uniform :: Contour_Description -> Bool
-- | True if contour does not containt any EQ elements.
--
--
-- let c = ["abc","bbb","cba"]
-- map (no_equalities.contour_description) c == [True,False,True]
--
no_equalities :: Contour_Description -> Bool
-- | Set of all contour descriptions.
--
--
-- map (length.all_contours) [3,4,5] == [27,729,59049]
--
all_contours :: Int -> [Contour_Description]
-- | A sequence of orderings (i,j) and (j,k) may imply
-- ordering for (i,k).
--
--
-- map implication [(LT,EQ),(EQ,EQ),(EQ,GT)] == [Just LT,Just EQ,Just GT]
--
implication :: (Ordering, Ordering) -> Maybe Ordering
-- | List of all violations at a Contour_Description (p.266).
violations :: Contour_Description -> [(Int, Int, Int, Ordering)]
-- | Is the number of violations zero.
is_possible :: Contour_Description -> Bool
-- | All possible contour descriptions
--
--
-- map (length.possible_contours) [3,4,5] == [13,75,541]
--
possible_contours :: Int -> [Contour_Description]
-- | All impossible contour descriptions
--
--
-- map (length.impossible_contours) [3,4,5] == [14,654,58508]
--
impossible_contours :: Int -> [Contour_Description]
-- | Calculate number of contours of indicated degree (p.263).
--
--
-- map contour_description_lm [2..7] == [1,3,6,10,15,21]
--
--
--
-- let r = [3,27,729,59049,14348907]
-- in map (\n -> 3 ^ n) (map contour_description_lm [2..6]) == r
--
contour_description_lm :: Integral a => a -> a
-- | Truncate a Contour_Description to have at most n
-- elements.
--
--
-- let c = contour_description [3,2,4,1]
-- in contour_truncate c 3 == contour_description [3,2,4]
--
contour_truncate :: Contour_Description -> Int -> Contour_Description
-- | Is Contour_Description p a prefix of q.
--
--
-- let {c = contour_description [3,2,4,1]
-- ;d = contour_description [3,2,4]}
-- in d `contour_is_prefix_of` c == True
--
contour_is_prefix_of :: Contour_Description -> Contour_Description -> Bool
-- | Are Contour_Descriptions p and q equal at column
-- n.
--
--
-- let {c = contour_description [3,2,4,1,5]
-- ;d = contour_description [3,2,4,1]}
-- in map (contour_eq_at c d) [0..4] == [True,True,True,True,False]
--
contour_eq_at :: Contour_Description -> Contour_Description -> Int -> Bool
-- | Derive an Integral contour that would be described by
-- Contour_Description. Diverges for impossible contours.
--
--
-- draw_contour (contour_description "abdc") == [0,1,3,2]
--
draw_contour :: Integral i => Contour_Description -> [i]
-- | Invert Contour_Description.
--
--
-- let c = contour_description "abdc"
-- in draw_contour (contour_description_invert c) == [3,2,0,1]
--
contour_description_invert :: Contour_Description -> Contour_Description
-- | Function to perhaps generate an element and a new state from an
-- initial state. This is the function provided to unfoldr.
type Build_f st e = st -> Maybe (e, st)
-- | Function to test is a partial sequence conforms to the target
-- sequence.
type Conforms_f e = Int -> [e] -> Bool
-- | Transform a Build_f to produce at most n elements.
--
--
-- let f i = Just (i,succ i)
-- in unfoldr (build_f_n f) (5,'a') == "abcde"
--
build_f_n :: Build_f st e -> Build_f (Int, st) e
-- | Attempt to construct a sequence of n elements given a
-- Build_f to generate possible elements, a Conforms_f that
-- the result sequence must conform to at each step, an Int to
-- specify the maximum number of elements to generate when searching for
-- a solution, and an initial state.
--
--
-- let {b_f i = Just (i,i+1)
-- ;c_f i x = odd (sum x `div` i)}
-- in build_sequence 6 b_f c_f 20 0 == (Just [1,2,6,11,15,19],20)
--
build_sequence :: Int -> Build_f st e -> Conforms_f e -> Int -> st -> (Maybe [e], st)
-- | Attempt to construct a sequence that has a specified contour. The
-- arguments are a Build_f to generate possible elements, a
-- Contour_Description that the result sequence must conform to,
-- an Int to specify the maximum number of elements to generate
-- when searching for a solution, and an initial state.
--
--
-- import System.Random
--
--
--
-- let {f = Just . randomR ('a','z')
-- ;c = contour_description "atdez"
-- ;st = mkStdGen 2347}
-- in fst (build_contour f c 1024 st) == Just "nvruy"
--
build_contour :: Ord e => Build_f st e -> Contour_Description -> Int -> st -> (Maybe [e], st)
-- | A variant on build_contour that retries a specified number of
-- times using the final state of the failed attempt as the state for the
-- next try.
--
--
-- let {f = Just . randomR ('a','z')
-- ;c = contour_description "atdezjh"
-- ;st = mkStdGen 2347}
-- in fst (build_contour_retry f c 64 8 st) == Just "nystzvu"
--
build_contour_retry :: Ord e => Build_f st e -> Contour_Description -> Int -> Int -> st -> (Maybe [e], st)
-- | A variant on build_contour_retry that returns the set of all
-- sequences constructed.
--
--
-- let {f = Just . randomR ('a','z')
-- ;c = contour_description "atdezjh"
-- ;st = mkStdGen 2347}
-- in length (build_contour_set f c 64 64 st) == 60
--
build_contour_set :: Ord e => Build_f st e -> Contour_Description -> Int -> Int -> st -> [[e]]
-- | Variant of build_contour_set that halts when an generated
-- sequence is a duplicate of an already generated sequence.
--
--
-- let {f = randomR ('a','f')
-- ;c = contour_description "cafe"
-- ;st = mkStdGen 2346836
-- ;r = build_contour_set_nodup f c 64 64 st}
-- in filter ("c" `isPrefixOf`) r == ["cafe","cbed","caed"]
--
build_contour_set_nodup :: Ord e => Build_f st e -> Contour_Description -> Int -> Int -> st -> [[e]]
-- | Example from p.262 (quarter-note durations)
--
--
-- ex_1 == [2,3/2,1/2,1,2]
-- compare_adjacent ex_1 == [GT,GT,LT,LT]
-- show (contour_half_matrix ex_1) == "2221 220 00 0"
-- draw_contour (contour_description ex_1) == [3,2,0,1,3]
--
--
--
-- let d = contour_description_invert (contour_description ex_1)
-- in (show d,is_possible d) == ("0001 002 22 2",True)
--
ex_1 :: [Rational]
-- | Example on p.265 (pitch)
--
--
-- ex_2 == [0,5,3]
-- show (contour_description ex_2) == "00 2"
--
ex_2 :: [Integer]
-- | Example on p.265 (pitch)
--
--
-- ex_3 == [12,7,6,7,8,7]
-- show (contour_description ex_3) == "22222 2101 000 01 2"
-- contour_description_ix (contour_description ex_3) (0,5) == GT
-- is_possible (contour_description ex_3) == True
--
ex_3 :: [Integer]
-- | Example on p.266 (impossible)
--
--
-- show ex_4 == "2221 220 00 1"
-- is_possible ex_4 == False
-- violations ex_4 == [(0,3,4,GT),(1,3,4,GT)]
--
ex_4 :: Contour_Description
instance Eq Contour_Half_Matrix
instance Eq Contour_Description
instance Show Contour_Description
instance Show Contour_Half_Matrix
-- | Symetric Group S4 as related to the composition "Nomos Alpha" by
-- Iannis Xenakis. In particular in relation to the discussion in
-- "Towards a Philosophy of Music", Formalized Music pp. 219 --
-- 221
module Music.Theory.Xenakis.S4
-- | Labels for elements of the symmetric group P4.
data Label
A :: Label
B :: Label
C :: Label
D :: Label
D2 :: Label
E :: Label
E2 :: Label
G :: Label
G2 :: Label
I :: Label
L :: Label
L2 :: Label
Q1 :: Label
Q2 :: Label
Q3 :: Label
Q4 :: Label
Q5 :: Label
Q6 :: Label
Q7 :: Label
Q8 :: Label
Q9 :: Label
Q10 :: Label
Q11 :: Label
Q12 :: Label
-- | Initial half of Seq (ie. #4). The complete Seq is formed
-- by appending the complement of the Half_Seq.
type Half_Seq = [Int]
-- | Complete sequence (ie. #8).
type Seq = [Int]
-- | Complement of a Half_Seq.
--
--
-- map complement [[4,1,3,2],[6,7,8,5]] == [[8,5,7,6],[2,3,4,1]]
--
complement :: Half_Seq -> Half_Seq
-- | Form Seq from Half_Seq.
--
--
-- full_seq [3,2,4,1] == [3,2,4,1,7,6,8,5]
-- label_of (full_seq [3,2,4,1]) == G2
-- label_of (full_seq [1,4,2,3]) == L
--
full_seq :: Half_Seq -> Seq
-- | Lower Half_Seq, ie. complement or id.
--
--
-- map lower [[4,1,3,2],[6,7,8,5]] == [[4,1,3,2],[2,3,4,1]]
--
lower :: Half_Seq -> Half_Seq
-- | Application of Label p on q.
--
--
-- l_on Q1 I == Q1
-- l_on D A == G
-- [l_on L L,l_on E D,l_on D E] == [L2,C,B]
--
l_on :: Label -> Label -> Label
-- | Seq of Label, inverse of label_of.
--
--
-- seq_of Q1 == [8,7,5,6,4,3,1,2]
--
seq_of :: Label -> Seq
-- | Half_Seq of Label, ie. half_seq .
-- seq_of.
--
--
-- half_seq_of Q1 == [8,7,5,6]
--
half_seq_of :: Label -> Seq
-- | Half_Seq of Seq, ie. take 4.
--
--
-- complement (half_seq (seq_of Q7)) == [3,4,2,1]
--
half_seq :: Seq -> Half_Seq
-- | Reverse table lookup.
--
--
-- reverse_lookup 'b' (zip [1..] ['a'..]) == Just 2
-- lookup 2 (zip [1..] ['a'..]) == Just 'b'
--
reverse_lookup :: Eq a => a -> [(b, a)] -> Maybe b
-- | Label of Seq, inverse of seq_of.
--
--
-- label_of [8,7,5,6,4,3,1,2] == Q1
-- label_of (seq_of Q4) == Q4
--
label_of :: Seq -> Label
-- | True if two Half_Seqs are complementary, ie. form a
-- Seq.
--
--
-- complementary [4,2,1,3] [8,6,5,7] == True
--
complementary :: Half_Seq -> Half_Seq -> Bool
-- | Relation between to Half_Seq values as a
-- (complementary,permutation) pair.
type Rel = (Bool, Permute)
-- | Determine Rel of Half_Seqs.
--
--
-- relate [1,4,2,3] [1,3,4,2] == (False,P.listPermute 4 [0,3,1,2])
-- relate [1,4,2,3] [8,5,6,7] == (True,P.listPermute 4 [1,0,2,3])
--
relate :: Half_Seq -> Half_Seq -> Rel
-- | Rel from Label p to q.
--
--
-- relate_l L L2 == (False,P.listPermute 4 [0,3,1,2])
--
relate_l :: Label -> Label -> Rel
-- | relate adjacent Half_Seq, see also relations_l.
relations :: [Half_Seq] -> [Rel]
-- | relate adjacent Labels.
--
--
-- relations_l [L2,L,A] == [(False,P.listPermute 4 [0,2,3,1])
-- ,(False,P.listPermute 4 [2,0,1,3])]
--
relations_l :: [Label] -> [Rel]
-- | Apply Rel to Half_Seq.
--
--
-- apply_relation (False,P.listPermute 4 [0,3,1,2]) [1,4,2,3] == [1,3,4,2]
--
apply_relation :: Rel -> Half_Seq -> Half_Seq
-- | Apply sequence of Rel to initial Half_Seq.
apply_relations :: [Rel] -> Half_Seq -> [Half_Seq]
-- | Variant of apply_relations.
--
--
-- apply_relations_l (relations_l [L2,L,A,Q1]) L2 == [L2,L,A,Q1]
--
apply_relations_l :: [Rel] -> Label -> [Label]
-- | Enumeration of set of faces of a cube.
data Face
F_Back :: Face
F_Front :: Face
F_Right :: Face
F_Left :: Face
F_Bottom :: Face
F_Top :: Face
-- | Table indicating set of faces of cubes as drawn in Fig. VIII-6
-- (p.220).
--
--
-- lookup [1,4,6,7] faces == Just F_Left
-- reverse_lookup F_Right faces == Just [2,3,5,8]
--
faces :: [([Int], Face)]
-- | Fig. VIII-6. Hexahedral (Octahedral) Group (p. 220)
--
--
-- length viii_6_l == 24
-- take 7 viii_6_l == [L2,L,A,Q1,Q7,Q3,Q9]
--
viii_6_l :: [Label]
-- | Fig. VIII-7 (p.221)
--
--
-- map (take 4) (take 4 viii_7) == [[I,A,B,C]
-- ,[A,I,C,B]
-- ,[B,C,I,A]
-- ,[C,B,A,I]]
--
viii_7 :: [[Label]]
-- | Fig. VIII-6/b Labels (p.221)
--
--
-- length viii_6b_l == length viii_6_l
-- take 8 viii_6b_l == [I,A,B,C,D2,D,E2,E]
--
viii_6b_l :: [Label]
-- | Fig. VIII-6/b Half_Seq.
--
--
-- viii_6b_p' == map half_seq_of viii_6b_l
-- nub (map (length . nub) viii_6b_p') == [4]
--
viii_6b_p' :: [Half_Seq]
-- | Variant of viii_6b with Half_Seq.
viii_6b' :: [(Label, Half_Seq)]
-- | Fig. VIII-6/b.
--
--
-- map (viii_6b !!) [0,8,16] == [(I,[1,2,3,4,5,6,7,8])
-- ,(G2,[3,2,4,1,7,6,8,5])
-- ,(Q8,[6,8,5,7,2,4,1,3])]
--
viii_6b :: [(Label, Seq)]
-- | The sequence of Rel to give viii_6_l from L2.
--
--
-- apply_relations_l viii_6_relations L2 == viii_6_l
-- length (nub viii_6_relations) == 14
--
viii_6_relations :: [Rel]
-- | The sequence of Rel to give viii_6b_l from I.
--
--
-- apply_relations_l viii_6b_relations I == viii_6b_l
-- length (nub viii_6b_relations) == 10
--
viii_6b_relations :: [Rel]
instance Eq Label
instance Ord Label
instance Enum Label
instance Bounded Label
instance Show Label
instance Eq Face
instance Enum Face
instance Bounded Face
instance Ord Face
instance Show Face
-- | RQ values with tie right qualifier.
module Music.Theory.Duration.RQ.Tied
-- | Boolean.
type Tied_Right = Bool
-- | RQ with tie right.
type RQ_T = (RQ, Tied_Right)
-- | Construct RQ_T.
rqt :: Tied_Right -> RQ -> RQ_T
-- | RQ field of RQ_T.
rqt_rq :: RQ_T -> RQ
-- | Tied field of RQ_T.
rqt_tied :: RQ_T -> Tied_Right
-- | Is RQ_T tied right.
is_tied_right :: RQ_T -> Bool
-- | RQ_T variant of rq_un_tuplet.
--
--
-- rqt_un_tuplet (3,2) (1,T) == (3/2,T)
--
--
--
-- let f = rqt_un_tuplet (7,4)
-- in map f [(2/7,F),(4/7,T),(1/7,F)] == [(1/2,F),(1,T),(1/4,F)]
--
rqt_un_tuplet :: (Integer, Integer) -> RQ_T -> RQ_T
-- | Transform RQ to untied RQ_T.
--
--
-- rq_rqt 3 == (3,F)
--
rq_rqt :: RQ -> RQ_T
-- | Tie last element only of list of RQ.
--
--
-- rq_tie_last [1,2,3] == [(1,F),(2,F),(3,T)]
--
rq_tie_last :: [RQ] -> [RQ_T]
-- | Transform a list of RQ_T to a list of Duration_A. The
-- flag indicates if the initial value is tied left.
--
--
-- rqt_to_duration_a False [(1,T),(1/4,T),(3/4,F)]
--
rqt_to_duration_a :: Bool -> [RQ_T] -> [Duration_A]
-- | RQ_T variant of rq_can_notate.
rqt_can_notate :: [RQ_T] -> Bool
-- | RQ_T variant of rq_to_cmn.
--
--
-- rqt_to_cmn (5,T) == Just ((4,T),(1,T))
-- rqt_to_cmn (5/4,T) == Just ((1,T),(1/4,T))
-- rqt_to_cmn (5/7,F) == Just ((4/7,T),(1/7,F))
--
rqt_to_cmn :: RQ_T -> Maybe (RQ_T, RQ_T)
-- | List variant of rqt_to_cmn.
--
--
-- rqt_to_cmn_l (5,T) == [(4,T),(1,T)]
--
rqt_to_cmn_l :: RQ_T -> [RQ_T]
-- | concatMap rqt_to_cmn_l.
--
--
-- rqt_set_to_cmn [(1,T),(5/4,F)] == [(1,T),(1,T),(1/4,F)]
--
--
--
-- rqt_set_to_cmn [(1/5,True),(1/20,False),(1/2,False),(1/4,True)]
--
rqt_set_to_cmn :: [RQ_T] -> [RQ_T]
-- | RQ sub-divisions.
module Music.Theory.Duration.RQ.Division
-- | Divisions of n RQ into i equal parts grouped as
-- j. A quarter and eighth note triplet is written
-- (1,1,[2,1],False).
type RQ_Div = (Rational, Integer, [Integer], Tied_Right)
-- | Variant of RQ_Div where n is 1.
type RQ1_Div = (Integer, [Integer], Tied_Right)
-- | Lift RQ1_Div to RQ_Div.
rq1_div_to_rq_div :: RQ1_Div -> RQ_Div
-- | Verify that grouping j sums to the divisor i.
rq_div_verify :: RQ_Div -> Bool
rq_div_mm_verify :: Int -> [RQ_Div] -> [(Integer, [RQ])]
-- | Translate from RQ_Div to a sequence of RQ values.
--
--
-- rq_div_to_rq_set_t (1,5,[1,3,1],True) == ([1/5,3/5,1/5],True)
-- rq_div_to_rq_set_t (1/2,6,[3,1,2],False) == ([1/4,1/12,1/6],False)
--
rq_div_to_rq_set_t :: RQ_Div -> ([RQ], Tied_Right)
-- | Translate from result of rq_div_to_rq_set_t to seqeunce of
-- RQ_T.
--
--
-- rq_set_t_to_rqt ([1/5,3/5,1/5],True) == [(1/5,_f),(3/5,_f),(1/5,_t)]
--
rq_set_t_to_rqt :: ([RQ], Tied_Right) -> [RQ_T]
-- | Transform sequence of RQ_Div into sequence of RQ,
-- discarding any final tie.
--
--
-- let q = [(1,5,[1,3,1],True),(1/2,6,[3,1,2],True)]
-- in rq_div_seq_rq q == [1/5,3/5,9/20,1/12,1/6]
--
rq_div_seq_rq :: [RQ_Div] -> [RQ]
-- | Partitions of an Integral that sum to n. This includes
-- the two 'trivial paritions, into a set n 1, and a set
-- of 1 n.
--
--
-- partitions_sum 4 == [[1,1,1,1],[2,1,1],[2,2],[3,1],[4]]
--
--
--
-- map (length . partitions_sum) [9..15] == [30,42,56,77,101,135,176]
--
partitions_sum :: Integral i => i -> [[i]]
-- | The multiset_permutations of partitions_sum.
--
--
-- map (length . partitions_sum_p) [9..12] == [256,512,1024,2048]
--
partitions_sum_p :: Integral i => i -> [[i]]
-- | The set of all RQ1_Div that sum to n, a variant on
-- partitions_sum_p.
--
--
-- map (length . rq1_div_univ) [3..5] == [8,16,32]
-- map (length . rq1_div_univ) [9..12] == [512,1024,2048,4096]
--
rq1_div_univ :: Integer -> [RQ1_Div]
-- | Notation of a sequence of RQ values as annotated
-- Duration values.
--
--
-- - Separate input sequence into measures, adding tie annotations as
-- required (see to_measures_ts). Ensure all RQ_T values
-- can be notated as common music notation durations.
-- - Separate each measure into pulses (see m_divisions_ts).
-- Further subdivides pulses to ensure cmn tuplet notation. See
-- to_divisions_ts for a composition of to_measures_ts and
-- m_divisions_ts.
-- - Simplify each measure (see m_simplify and
-- default_rule). Coalesces tied durations where appropriate.
-- - Notate measures (see m_notate or mm_notate).
-- - Ascribe values to notated durations, see ascribe.
--
module Music.Theory.Duration.Sequence.Notate
-- | Variant of catMaybes. If all elements of the list are
-- Just a, then gives Just [a] else gives
-- Nothing.
--
--
-- all_just (map Just [1..3]) == Just [1..3]
-- all_just [Just 1,Nothing,Just 3] == Nothing
--
all_just :: [Maybe a] -> Maybe [a]
-- | Variant of rights that preserves first Left.
--
--
-- all_right (map Right [1..3]) == Right [1..3]
-- all_right [Right 1,Left 'a',Left 'b'] == Left 'a'
--
all_right :: [Either a b] -> Either a [b]
-- | Applies a join function to the first two elements of the list.
-- If the join function succeeds the joined element is considered
-- for further coalescing.
--
--
-- coalesce (\p q -> Just (p + q)) [1..5] == [15]
--
--
--
-- let jn p q = if even p then Just (p + q) else Nothing
-- in coalesce jn [1..5] == map sum [[1],[2,3],[4,5]]
--
coalesce :: (a -> a -> Maybe a) -> [a] -> [a]
-- | Variant of coalesce with accumulation parameter.
--
--
-- coalesce_accum (\i p q -> Left (p + q)) 0 [1..5] == [(0,15)]
--
--
--
-- let jn i p q = if even p then Left (p + q) else Right (p + i)
-- in coalesce_accum jn 0 [1..7] == [(0,1),(1,5),(6,9),(15,13)]
--
--
--
-- let jn i p q = if even p then Left (p + q) else Right [p,q]
-- in coalesce_accum jn [] [1..5] == [([],1),([1,2],5),([5,4],9)]
--
coalesce_accum :: (b -> a -> a -> Either a b) -> b -> [a] -> [(b, a)]
-- | Variant of coalesce_accum that accumulates running sum.
--
--
-- let f i p q = if i == 1 then Just (p + q) else Nothing
-- in coalesce_sum (+) 0 f [1,1/2,1/4,1/4] == [1,1]
--
coalesce_sum :: (b -> a -> b) -> b -> (b -> a -> a -> Maybe a) -> [a] -> [a]
-- | Lower Either to Maybe by discarding Left.
either_to_maybe :: Either a b -> Maybe b
-- | Take elements while the sum of the prefix is less than or equal to the
-- indicated value. Returns also the difference between the prefix sum
-- and the requested sum. Note that zero elements are kept left.
--
--
-- take_sum_by id 3 [2,1] == ([2,1],0,[])
-- take_sum_by id 3 [2,2] == ([2],1,[2])
-- take_sum_by id 3 [2,1,0,1] == ([2,1,0],0,[1])
-- take_sum_by id 3 [4] == ([],3,[4])
-- take_sum_by id 0 [1..5] == ([],0,[1..5])
--
take_sum_by :: (Ord n, Num n) => (a -> n) -> n -> [a] -> ([a], n, [a])
-- | Variant of take_sum_by with id function.
take_sum :: (Ord a, Num a) => a -> [a] -> ([a], a, [a])
-- | Variant of take_sum that requires the prefix to sum to value.
--
--
-- take_sum_by_eq id 3 [2,1,0,1] == Just ([2,1,0],[1])
-- take_sum_by_eq id 3 [2,2] == Nothing
--
take_sum_by_eq :: (Ord n, Num n) => (a -> n) -> n -> [a] -> Maybe ([a], [a])
-- | Recursive variant of take_sum_by_eq.
--
--
-- split_sum_by_eq id [3,3] [2,1,0,3] == Just [[2,1,0],[3]]
-- split_sum_by_eq id [3,3] [2,2,2] == Nothing
--
split_sum_by_eq :: (Ord n, Num n) => (a -> n) -> [n] -> [a] -> Maybe [[a]]
-- | Split sequence such that the prefix sums to precisely m. The
-- third element of the result indicates if it was required to divide an
-- element. Not 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 :: 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] == Just [[[(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 == Just [[[(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 == Just [[[(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 == Just [[[(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 == Just [[[(4/7,_f),(3/7,_t)]
-- ,[(3/4,_f),(1/4,_t)]
-- ,[(1/5,_f),(4/5,_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)
--
mm_notate :: [[[RQ_T]]] -> Either String [[Duration_A]]
-- | Structure given to Simplify_P to decide simplification. The
-- structure is (ts,start-rq,(left-rq,right-rq)).
type Simplify_T = (Time_Signature, RQ, (RQ, RQ))
-- | Predicate function at Simplify_T.
type Simplify_P = Simplify_T -> Bool
-- | Variant of Simplify_T allowing multiple rules.
type Simplify_M = ([Time_Signature], [RQ], [(RQ, RQ)])
-- | Transform Simplify_M to Simplify_P.
meta_table_p :: Simplify_M -> Simplify_P
-- | Transform Simplify_M to set of Simplify_T.
meta_table_t :: Simplify_M -> [Simplify_T]
-- | The default table of simplifiers.
--
--
-- default_table ((3,4),1,(1,1)) == True
--
default_table :: Simplify_P
-- | The default eighth-note pulse simplifier rule.
--
--
-- default_8_rule ((3,8),0,(1/2,1/2)) == True
-- default_8_rule ((3,8),1/2,(1/2,1/2)) == True
-- default_8_rule ((3,8),1,(1/2,1/2)) == True
-- default_8_rule ((2,8),0,(1/2,1/2)) == True
-- default_8_rule ((5,8),0,(1,1/2)) == True
-- default_8_rule ((5,8),0,(2,1/2)) == True
--
default_8_rule :: Simplify_P
-- | The default quarter note pulse simplifier rule.
--
--
-- default_4_rule ((3,4),0,(1,1/2)) == True
-- default_4_rule ((3,4),0,(1,3/4)) == True
-- default_4_rule ((4,4),1,(1,1)) == False
-- default_4_rule ((4,4),2,(1,1)) == True
-- default_4_rule ((4,4),2,(1,2)) == True
-- default_4_rule ((4,4),0,(2,1)) == True
-- default_4_rule ((3,4),1,(1,1)) == False
--
default_4_rule :: Simplify_P
-- | The default simplifier rule. To extend provide a list of
-- Simplify_T.
default_rule :: [Simplify_T] -> Simplify_P
-- | Measure simplifier. Apply given Simplify_P.
m_simplify :: Simplify_P -> Time_Signature -> [Duration_A] -> [Duration_A]
-- | Pulse simplifier predicate, which is const True.
p_simplify_rule :: Simplify_P
-- | Pulse simplifier.
--
--
-- import Music.Theory.Duration.Name.Abbreviation
-- p_simplify [(q,[Tie_Right]),(e,[Tie_Left])] == [(q',[])]
-- p_simplify [(e,[Tie_Right]),(q,[Tie_Left])] == [(q',[])]
-- p_simplify [(q,[Tie_Right]),(e',[Tie_Left])] == [(q'',[])]
-- p_simplify [(q'',[Tie_Right]),(s,[Tie_Left])] == [(h,[])]
-- p_simplify [(e,[Tie_Right]),(s,[Tie_Left]),(e',[])] == [(e',[]),(e',[])]
--
--
--
-- let f = rqt_to_duration_a False
-- in p_simplify (f [(1/8,_t),(1/4,_t),(1/8,_f)]) == f [(1/2,_f)]
--
p_simplify :: [Duration_A] -> [Duration_A]
-- | Composition of to_divisions_ts, mm_notate
-- m_simplify.
notate :: Simplify_P -> [Time_Signature] -> [RQ] -> Either String [[Duration_A]]
-- | Variant of zip that retains elements of the right hand (rhs)
-- list where elements of the left hand (lhs) list meet the given lhs
-- predicate. If the right hand side is longer the remaining elements to
-- be processed are given. It is an error for the right hand side to be
-- short.
--
--
-- zip_hold_lhs even [1..5] "abc" == ([],zip [1..6] "abbcc")
-- zip_hold_lhs odd [1..6] "abc" == ([],zip [1..6] "aabbcc")
-- zip_hold_lhs even [1] "ab" == ("b",[(1,'a')])
-- zip_hold_lhs even [1,2] "a" == undefined
--
zip_hold_lhs :: (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 :: (x -> Bool) -> [x] -> [a] -> [(x, 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, and elements of the lhs list where elements of the ths 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 :: (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 :: [Duration_A] -> [x] -> ([x], [(Duration_A, x)])
-- | snd . m_ascribe.
ascribe :: [Duration_A] -> [x] -> [(Duration_A, x)]
-- | Variant of m_ascribe for a set of measures.
mm_ascribe :: [[Duration_A]] -> [x] -> [[(Duration_A, x)]]
-- | Group elements as chords where a chord element is inidicated 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 :: (x -> Bool) -> [Duration_A] -> [x] -> [(Duration_A, x)]
-- | Variant of mm_ascribe using group_chd
mm_ascribe_chd :: (x -> Bool) -> [[Duration_A]] -> [x] -> [[(Duration_A, x)]]
-- | Common music notation dynamic marks.
module Music.Theory.Dynamic_Mark
-- | Enumeration of dynamic mark symbols.
data Dynamic_Mark_T
Niente :: Dynamic_Mark_T
PPPPP :: Dynamic_Mark_T
PPPP :: Dynamic_Mark_T
PPP :: Dynamic_Mark_T
PP :: Dynamic_Mark_T
P :: Dynamic_Mark_T
MP :: Dynamic_Mark_T
MF :: Dynamic_Mark_T
F :: Dynamic_Mark_T
FF :: Dynamic_Mark_T
FFF :: Dynamic_Mark_T
FFFF :: Dynamic_Mark_T
FFFFF :: Dynamic_Mark_T
FP :: Dynamic_Mark_T
SF :: Dynamic_Mark_T
SFP :: Dynamic_Mark_T
SFPP :: Dynamic_Mark_T
SFZ :: Dynamic_Mark_T
SFFZ :: Dynamic_Mark_T
-- | Lookup MIDI velocity for Dynamic_Mark_T. The range is linear in
-- 0-127.
--
--
-- let r = [0,6,17,28,39,50,61,72,83,94,105,116,127]
-- in mapMaybe dynamic_mark_midi [Niente .. FFFFF] == r
--
dynamic_mark_midi :: (Num n, Enum n) => Dynamic_Mark_T -> Maybe n
-- | 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
-- | 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
instance Eq Dynamic_Mark_T
instance Ord Dynamic_Mark_T
instance Enum Dynamic_Mark_T
instance Bounded Dynamic_Mark_T
instance Show Dynamic_Mark_T
instance Eq Hairpin_T
instance Ord Hairpin_T
instance Enum Hairpin_T
instance Bounded Hairpin_T
instance Show Hairpin_T
-- | Larry Polansky. "Morphological Metrics". Journal of New Music
-- Research, 25(4):289-368, 1996.
module Music.Theory.Metric.Polansky_1996
-- | Distance function, ordinarily n below is in Num,
-- Fractional or Real.
type Interval a n = a -> a -> n
-- | fromIntegral . -.
dif_i :: (Integral a, Num b) => a -> a -> b
-- | realToFrac . -.
dif_r :: (Real a, Fractional b) => a -> a -> b
-- | abs . f.
abs_dif :: Num n => Interval a n -> a -> a -> n
-- | Square.
sqr :: Num a => a -> a
-- | sqr . f.
sqr_dif :: Num n => Interval a n -> a -> a -> n
-- | sqr . abs . f.
sqr_abs_dif :: Num n => Interval a n -> a -> a -> n
-- | sqrt . abs . f.
sqrt_abs_dif :: Floating c => Interval a c -> a -> a -> c
-- | City block metric, p.296
--
--
-- city_block_metric (-) (1,2) (3,5) == 2+3
--
city_block_metric :: Num n => Interval a n -> (a, a) -> (a, a) -> n
-- | Two-dimensional euclidean metric, p.297.
--
--
-- euclidean_metric_2 (-) (1,2) (3,5) == sqrt (4+9)
--
euclidean_metric_2 :: Floating n => Interval a n -> (a, a) -> (a, a) -> n
-- | n-dimensional euclidean metric
--
--
-- euclidean_metric_l (-) [1,2] [3,5] == sqrt (4+9)
-- euclidean_metric_l (-) [1,2,3] [2,4,6] == sqrt (1+4+9)
--
euclidean_metric_l :: Floating c => Interval b c -> [b] -> [b] -> c
-- | Cube root.
--
--
-- map cbrt [1,8,27] == [1,2,3]
--
cbrt :: Floating a => a -> a
-- | n-th root
--
--
-- map (nthrt 4) [1,16,81] == [1,2,3]
--
nthrt :: Floating a => a -> a -> a
-- | Two-dimensional Minkowski metric, p.297
--
--
-- minkowski_metric_2 (-) 1 (1,2) (3,5) == 5
-- minkowski_metric_2 (-) 2 (1,2) (3,5) == sqrt (4+9)
-- minkowski_metric_2 (-) 3 (1,2) (3,5) == cbrt (8+27)
--
minkowski_metric_2 :: Floating a => Interval t a -> a -> (t, t) -> (t, t) -> a
-- | n-dimensional Minkowski metric
--
--
-- minkowski_metric_l (-) 2 [1,2,3] [2,4,6] == sqrt (1+4+9)
-- minkowski_metric_l (-) 3 [1,2,3] [2,4,6] == cbrt (1+8+27)
--
minkowski_metric_l :: Floating a => Interval t a -> a -> [t] -> [t] -> a
-- | Integration with f.
--
--
-- d_dx (-) [0,2,4,1,0] == [2,2,-3,-1]
-- d_dx (-) [2,3,0,4,1] == [1,-3,4,-3]
--
d_dx :: Interval a n -> [a] -> [n]
-- | map abs . d_dx.
--
--
-- d_dx_abs (-) [0,2,4,1,0] == [2,2,3,1]
-- d_dx_abs (-) [2,3,0,4,1] == [1,3,4,3]
--
d_dx_abs :: Num n => Interval a n -> [a] -> [n]
-- | Ordered linear magnitude (no delta), p.300
--
--
-- olm_no_delta' [0,2,4,1,0] [2,3,0,4,1] == 1.25
--
olm_no_delta' :: Fractional a => [a] -> [a] -> a
-- | Ordered linear magintude (general form) p.302
--
--
-- olm_general (abs_dif (-)) [0,2,4,1,0] [2,3,0,4,1] == 1.25
-- olm_general (abs_dif (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 4.6
--
olm_general :: (Fractional a, Enum a, Fractional n) => Interval a n -> [a] -> [a] -> n
-- | Delta (Δ) determines an interval given a sequence and an index.
type Delta n a = [n] -> Int -> a
-- | f at indices i and i+1 of x.
--
--
-- map (ix_dif (-) [0,1,3,6,10]) [0..3] == [-1,-2,-3,-4]
--
ix_dif :: Interval a t -> Delta a t
-- | abs . ix_dif
--
--
-- map (abs_ix_dif (-) [0,2,4,1,0]) [0..3] == [2,2,3,1]
--
abs_ix_dif :: Num n => Interval a n -> Delta a n
-- | sqr . abs_ix_dif
--
--
-- map (sqr_abs_ix_dif (-) [0,2,4,1,0]) [0..3] == [4,4,9,1]
-- map (sqr_abs_ix_dif (-) [2,3,0,4,1]) [0..3] == [1,9,16,9]
--
sqr_abs_ix_dif :: Num n => Interval a n -> Delta a n
-- | Psi (Ψ) joins Delta equivalent intervals from
-- morphologies m and n.
type Psi a = a -> a -> a
-- | Ordered linear magintude (generalised-interval form) p.305
--
--
-- olm (abs_dif dif_r) (abs_ix_dif dif_r) (const 1) [1,5,12,2,9,6] [7,6,4,9,8,1] == 4.6
-- olm (abs_dif dif_r) (abs_ix_dif dif_r) maximum [1,5,12,2,9,6] [7,6,4,9,8,1] == 0.46
--
olm :: (Fractional a, Enum a) => Psi a -> Delta n a -> ([a] -> a) -> [n] -> [n] -> a
olm_no_delta :: (Real a, Real n, Enum n, Fractional n) => [a] -> [a] -> n
olm_no_delta_squared :: (Enum a, Floating a) => [a] -> [a] -> a
second_order :: Num n => ([n] -> [n] -> t) -> [n] -> [n] -> t
olm_no_delta_second_order :: (Real a, Enum a, Fractional a) => [a] -> [a] -> a
olm_no_delta_squared_second_order :: (Enum a, Floating a) => [a] -> [a] -> a
-- | Second order binomial coefficient, p.307
--
--
-- map second_order_binonial_coefficient [2..10] == [1,3,6,10,15,21,28,36,45]
--
second_order_binonial_coefficient :: Fractional a => a -> a
-- | d_dx of flip compare.
--
--
-- direction_interval [5,9,3,2] == [LT,GT,GT]
-- direction_interval [2,5,6,6] == [LT,LT,EQ]
--
direction_interval :: Ord i => [i] -> [Ordering]
-- | Histogram of list of Orderings.
--
--
-- ord_hist [LT,GT,GT] == (1,0,2)
--
ord_hist :: Integral t => [Ordering] -> (t, t, t)
-- | Histogram of directions of adjacent elements, p.312.
--
--
-- direction_vector [5,9,3,2] == (1,0,2)
-- direction_vector [2,5,6,6] == (2,1,0)
--
direction_vector :: Integral i => Ord a => [a] -> (i, i, i)
-- | Unordered linear direction, p.311 (Fig. 5)
--
--
-- uld [5,9,3,2] [2,5,6,6] == 2/3
-- uld [5,3,6,1,4] [3,6,1,4,2] == 0
--
uld :: (Integral n, Ord a) => [a] -> [a] -> Ratio n
-- | Ordered linear direction, p.312
--
--
-- direction_interval [5,3,6,1,4] == [GT,LT,GT,LT]
-- direction_interval [3,6,1,4,2] == [LT,GT,LT,GT]
-- old [5,3,6,1,4] [3,6,1,4,2] == 1
--
old :: (Ord i, Integral a) => [i] -> [i] -> Ratio a
-- | Ordered combinatorial direction, p.314
--
--
-- ocd [5,9,3,2] [2,5,6,6] == 5/6
-- ocd [5,3,6,1,4] [3,6,1,4,2] == 4/5
--
ocd :: (Ord a, Integral i) => [a] -> [a] -> Ratio i
-- | Unordered combinatorial direction, p.314
--
--
-- ucd [5,9,3,2] [2,5,6,6] == 5/6
-- ucd [5,3,6,1,4] [3,6,1,4,2] == 0
-- ucd [5,3,7,6] [2,1,2,1] == 1/2
-- ucd [2,1,2,1] [8,3,5,4] == 1/3
-- ucd [5,3,7,6] [8,3,5,4] == 1/3
--
ucd :: (Integral n, Ord a) => [a] -> [a] -> Ratio n
-- | half_matrix_f, Fig.9, p.318
--
--
-- let r = [[2,3,1,4]
-- ,[1,3,6]
-- ,[4,7]
-- ,[3]]
-- in combinatorial_magnitude_matrix (abs_dif (-)) [5,3,2,6,9] == r
--
combinatorial_magnitude_matrix :: Interval a n -> [a] -> [[n]]
-- | Unordered linear magnitude (simplified), p.320-321
--
--
-- let r = abs (sum [5,4,3,6] - sum [12,2,11,7]) / 4
-- in ulm_simplified (abs_dif (-)) [1,6,2,5,11] [3,15,13,2,9] == r
--
--
--
-- ulm_simplified (abs_dif (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 3
--
ulm_simplified :: Fractional n => Interval a n -> [a] -> [a] -> n
ocm_zcm :: (Fractional n, Num a) => Interval a n -> [a] -> [a] -> (n, n, [n])
-- | Ordered combinatorial magnitude (OCM), p.323
--
--
-- ocm (abs_dif (-)) [1,6,2,5,11] [3,15,13,2,9] == 5.2
-- ocm (abs_dif (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 3.6
--
ocm :: (Fractional a, Enum a, Fractional n) => Interval a n -> [a] -> [a] -> n
-- | Ordered combinatorial magnitude (OCM), p.323
--
--
-- ocm_absolute_scaled (abs_dif (-)) [1,6,2,5,11] [3,15,13,2,9] == 0.4
-- ocm_absolute_scaled (abs_dif (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 54/(15*11)
--
ocm_absolute_scaled :: (Ord a, Fractional a, Enum a, Ord n, Fractional n) => Interval a n -> [a] -> [a] -> n
-- | Larry Polansky. "Notes on the Tunings of Three Central Javanese
-- Slendro/Pelog Pairs". Experimental Musical Instruments,
-- 6(2):12-13,16-17, 1990.
module Music.Theory.Tuning.Polansky_1990
-- | Kanjutmesem Slendro (S1,S2,S3,S5,S6,S1')
--
--
-- L.d_dx kanjutmesem_s == [252,238,241,236,253]
--
kanjutmesem_s :: Num n => [n]
-- | Kanjutmesem Pelog (P1,P2,P3,P4,P5,P6,P7,P1')
--
--
-- L.d_dx kanjutmesem_p == [141,141,272,140,115,172,246]
--
kanjutmesem_p :: Num n => [n]
-- | Darius Slendro (S1,S2,S3,S5,S6,S1')
--
--
-- L.d_dx darius_s == [204,231,267,231,267]
-- ax_r darius_s == [9/8,8/7,7/6,8/7,7/6]
--
darius_s :: Num n => [n]
-- | Madeleine Pelog (P1,P2,P3,P4,P5,P6,P7,P1')
--
--
-- L.d_dx madeleine_p == [139,128,336,99,94,173,231]
-- ax_r madeleine_p == [13/12,14/13,17/14,18/17,19/18,21/19,8/7]
--
madeleine_p :: Num n => [n]
-- | Lipur Sih Slendro (S1,S2,S3,S5,S6,S1')
--
--
-- L.d_dx lipur_sih_s == [273,236,224,258,256]
--
lipur_sih_s :: Num n => [n]
-- | Lipur Sih Pelog (P1,P2,P3,P4,P5,P6,P7,P1')
--
--
-- L.d_dx lipur_sih_p == [110,153,253,146,113,179]
--
lipur_sih_p :: Num n => [n]
-- | Idealized ET Slendro, 5-tone equal temperament (p.17)
--
--
-- L.d_dx idealized_et_s == [240,240,240,240,240]
--
idealized_et_s :: Num n => [n]
-- | Idealized ET Pelog, subset of 9-tone equal temperament (p.17)
--
--
-- L.d_dx idealized_et_p == [400/3,800/3,400/3,400/3,400/3,400/3,800/3]
--
idealized_et_p :: Integral n => [Ratio n]
-- | Reconstruct approximate ratios to within 1e-3 from intervals.
ax_r :: Real n => [n] -> [Rational]
-- | "Sieves" by Iannis Xenakis and John Rahn Perspectives of New
-- Music Vol. 28, No. 1 (Winter, 1990), pp. 58-78
module Music.Theory.Xenakis.Sieve
-- | Synonym for Integer
type I = Integer
-- | A Sieve.
data Sieve
-- | Empty Sieve
Empty :: Sieve
-- | Primitive Sieve of modulo and index
L :: (I, I) -> Sieve
-- | Union of two Sieves
Union :: Sieve -> Sieve -> Sieve
-- | Intersection of two Sieves
Intersection :: Sieve -> Sieve -> Sieve
-- | The Union of a list of Sieves, ie. foldl1
-- Union.
union :: [Sieve] -> Sieve
-- | The Intersection of a list of Sieves, ie. foldl1
-- Intersection.
intersection :: [Sieve] -> Sieve
-- | Unicode synonym for Union.
(∪) :: Sieve -> Sieve -> Sieve
-- | Unicode synonym for Intersection.
(∩) :: Sieve -> Sieve -> Sieve
-- | Variant of L, ie. curry L.
--
--
-- l 15 19 == L (15,19)
--
l :: I -> I -> Sieve
-- | unicode synonym for l.
(⋄) :: I -> I -> Sieve
-- | In a normal Sieve m is > i.
--
--
-- normalise (L (15,19)) == L (15,4)
--
normalise :: Sieve -> Sieve
-- | Predicate to test if a Sieve is normal.
--
--
-- is_normal (L (15,4)) == True
--
is_normal :: Sieve -> Bool
-- | Predicate to determine if an I is an element of the
-- Sieve.
--
--
-- map (element (L (3,1))) [1..4] == [True,False,False,True]
-- map (element (L (15,4))) [4,19 .. 49] == [True,True,True,True]
--
element :: Sieve -> I -> Bool
-- | Construct the sequence defined by a Sieve. Note that building a
-- sieve that contains an intersection clause that has no elements gives
-- _|_.
--
--
-- let d = [0,2,4,5,7,9,11]
-- in take 7 (build (union (map (l 12) d))) == d
--
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
-- in buildn 16 s == buildn 16 (24⋄23 ∪ 30⋄3 ∪ 104⋄70)
--
--
--
-- buildn 10 (24⋄23 ∪ 30⋄3 ∪ 104⋄70) == [3,23,33,47,63,70,71,93,95,119]
--
buildn :: Int -> Sieve -> [I]
-- | Standard differentiation function.
--
--
-- differentiate [1,3,6,10] == [2,3,4]
-- differentiate [0,2,4,5,7,9,11,12] == [2,2,1,2,2,2,1]
--
differentiate :: Num a => [a] -> [a]
-- | Euclid's algorithm for computing the greatest common divisor.
--
--
-- euclid 1989 867 == 51
--
euclid :: Integral a => a -> a -> a
-- | Bachet De Méziriac's algorithm.
--
--
-- de_meziriac 15 4 == 3 && euclid 15 4 == 1
--
de_meziriac :: Integral a => a -> a -> a
-- | Attempt to reduce the Intersection of two L nodes to a
-- singular L node.
--
--
-- reduce_intersection (3,2) (4,7) == Just (12,11)
-- reduce_intersection (12,11) (6,11) == Just (12,11)
-- reduce_intersection (12,11) (8,7) == Just (24,23)
--
reduce_intersection :: Integral t => (t, t) -> (t, t) -> Maybe (t, t)
-- | Reduce the number of nodes at a Sieve.
--
--
-- reduce (L (3,2) ∪ Empty) == L (3,2)
-- reduce (L (3,2) ∩ Empty) == L (3,2)
-- reduce (L (3,2) ∩ L (4,7)) == L (12,11)
-- reduce (L (6,9) ∩ L (15,18)) == L (30,3)
--
--
--
-- let s = 3⋄2∩4⋄7∩6⋄11∩8⋄7 ∪ 6⋄9∩15⋄18 ∪ 13⋄5∩8⋄6∩4⋄2 ∪ 6⋄9∩15⋄19
-- in reduce s == (24⋄23 ∪ 30⋄3 ∪ 104⋄70)
--
--
--
-- let s = 3⋄2∩4⋄7∩6⋄11∩8⋄7 ∪ 6⋄9∩15⋄18 ∪ 13⋄5∩8⋄6∩4⋄2 ∪ 6⋄9∩15⋄19
-- in reduce s == (24⋄23 ∪ 30⋄3 ∪ 104⋄70)
--
reduce :: Sieve -> Sieve
instance Eq Sieve
instance Show Sieve
-- | Serial (ordered) pitch-class operations on Z12.
module Music.Theory.Z12.SRO
-- | Transpose p by n.
--
--
-- tn 4 [1,5,6] == [5,9,10]
--
tn :: Z12 -> [Z12] -> [Z12]
-- | Invert p about n.
--
--
-- invert 6 [4,5,6] == [8,7,6]
-- invert 0 [0,1,3] == [0,11,9]
--
invert :: Z12 -> [Z12] -> [Z12]
-- | Composition of invert about 0 and tn.
--
--
-- tni 4 [1,5,6] == [3,11,10]
-- (invert 0 . tn 4) [1,5,6] == [7,3,2]
--
tni :: Z12 -> [Z12] -> [Z12]
-- | Modulo 12 multiplication
--
--
-- mn 11 [0,1,4,9] == tni 0 [0,1,4,9]
--
mn :: Z12 -> [Z12] -> [Z12]
-- | M5, ie. mn 5.
--
--
-- m5 [0,1,3] == [0,5,3]
--
m5 :: [Z12] -> [Z12]
-- | T-related sequences of p.
--
--
-- length (t_related [0,3,6,9]) == 12
--
t_related :: [Z12] -> [[Z12]]
-- | T/I-related sequences of p.
--
--
-- length (ti_related [0,1,3]) == 24
-- length (ti_related [0,3,6,9]) == 24
-- ti_related [0] == map return [0..11]
--
ti_related :: [Z12] -> [[Z12]]
-- | R/T/I-related sequences of p.
--
--
-- length (rti_related [0,1,3]) == 48
-- length (rti_related [0,3,6,9]) == 24
--
rti_related :: [Z12] -> [[Z12]]
-- | T/M/I-related sequences of p.
tmi_related :: [Z12] -> [[Z12]]
-- | R/T/M/I-related sequences of p.
rtmi_related :: [Z12] -> [[Z12]]
-- | r/R/T/M/I-related sequences of p.
rrtmi_related :: [Z12] -> [[Z12]]
-- | Variant of tn, transpose p so first element is n.
--
--
-- tn_to 5 [0,1,3] == [5,6,8]
--
tn_to :: Z12 -> [Z12] -> [Z12]
-- | Variant of invert, inverse about nth element.
--
--
-- map (invert_ix 0) [[0,1,3],[3,4,6]] == [[0,11,9],[3,2,0]]
-- map (invert_ix 1) [[0,1,3],[3,4,6]] == [[2,1,11],[5,4,2]]
--
invert_ix :: Int -> [Z12] -> [Z12]
-- | The standard t-matrix of p.
--
--
-- tmatrix [0,1,3] == [[0,1,3]
-- ,[11,0,2]
-- ,[9,10,0]]
--
tmatrix :: [Z12] -> [[Z12]]
-- | 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]]
-- | Variant with default value for empty input list case.
minimumBy_or :: a -> (a -> a -> Ordering) -> [a] -> a
-- | Prime form rule requiring comparator, considering t_rotations.
t_cmp_prime :: ([Z12] -> [Z12] -> Ordering) -> [Z12] -> [Z12]
-- | Prime form rule requiring comparator, considering ti_rotations.
ti_cmp_prime :: ([Z12] -> [Z12] -> Ordering) -> [Z12] -> [Z12]
-- | 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 [0,1,3,6,8,9] == [0,1,3,6,8,9]
--
forte_prime :: [Z12] -> [Z12]
-- | Synonym for String.
type SC_Name = String
-- | The set-class table (Forte prime forms).
sc_table :: [(SC_Name, [Z12])]
-- | Lookup a set-class name. The input set is subject to
-- forte_prime before lookup.
--
--
-- sc_name [0,2,3,6,7] == "5-Z18"
-- sc_name [0,1,4,6,7,8] == "6-Z17"
--
sc_name :: [Z12] -> SC_Name
-- | Lookup a set-class given a set-class name.
--
--
-- sc "6-Z17" == [0,1,2,4,7,8]
--
sc :: SC_Name -> [Z12]
-- | List of set classes.
scs :: [[Z12]]
-- | Cardinality n subset of scs.
--
--
-- map (length . scs_n) [2..10] == [6,12,29,38,50,38,29,12,6]
--
scs_n :: Integral i => i -> [[Z12]]
-- | Basic interval pattern, see Allen Forte "The Basic Interval Patterns"
-- JMT 17/2 (1973):234-272
--
--
-- >>> bip 0t95728e3416
-- 11223344556
--
--
--
-- bip [0,10,9,5,7,2,8,11,3,4,1,6] == [1,1,2,2,3,3,4,4,5,5,6]
-- bip (pco "0t95728e3416") == [1,1,2,2,3,3,4,4,5,5,6]
--
bip :: [Z12] -> [Z12]
-- | Interval class of Z12 interval i.
--
--
-- map ic [5,6,7] == [5,6,5]
--
ic :: Z12 -> Z12
-- | Forte notation for interval class vector.
--
--
-- icv [0,1,2,4,7,8] == [3,2,2,3,3,2]
--
icv :: Integral i => [Z12] -> [i]
-- | Michael Buchler. "Relative Saturation of Subsets and Interval Cycles
-- as a Means for Determining Set-Class Similarity". PhD thesis,
-- University of Rochester, 1998
module Music.Theory.Metric.Buchler_1998
-- | Predicate for list with cardinality n.
of_c :: Integral n => n -> [a] -> Bool
-- | Set classes of cardinality n.
--
--
-- sc_table_n 2 == [[0,1],[0,2],[0,3],[0,4],[0,5],[0,6]]
--
sc_table_n :: Integral n => n -> [[Z12]]
-- | Minima and maxima of ICV of SCs of cardinality n.
--
--
-- icv_minmax 5 == ([0,0,0,1,0,0],[4,4,4,4,4,2])
--
icv_minmax :: (Integral n, Integral b) => n -> ([b], [b])
data R
MIN :: R
MAX :: R
type D n = (R, n)
-- | Pretty printer for R.
--
--
-- map r_pp [MIN,MAX] == ["+","-"]
--
r_pp :: R -> String
-- | SATV element measure with given funtion.
satv_f :: Integral n => ((n, n, n) -> D n) -> [Z12] -> [D n]
-- | Pretty printer for SATV element.
--
--
-- satv_e_pp (satv_a [0,1,2,6,7,8]) == "<-1,+2,+0,+0,-1,-0>"
--
satv_e_pp :: Show i => [D i] -> String
type SATV i = ([D i], [D i])
-- | Pretty printer for SATV.
satv_pp :: Show i => SATV i -> String
-- | SATVa measure.
--
--
-- satv_e_pp (satv_a [0,1,2,6,7,8]) == "<-1,+2,+0,+0,-1,-0>"
-- satv_e_pp (satv_a [0,1,2,3,4]) == "<-0,-1,-2,+0,+0,+0>"
--
satv_a :: Integral i => [Z12] -> [D i]
-- | SATVb measure.
--
--
-- satv_e_pp (satv_b [0,1,2,6,7,8]) == "<+4,-4,-5,-4,+4,+3>"
-- satv_e_pp (satv_b [0,1,2,3,4]) == "<+4,+3,+2,-3,-4,-2>"
--
satv_b :: Integral i => [Z12] -> [D i]
-- | SATV measure.
--
--
-- satv_pp (satv [0,3,6,9]) == "(<+0,+0,-0,+0,+0,-0>,<-3,-3,+4,-3,-3,+2>)"
-- satv_pp (satv [0,1,3,4,8]) == "(<-2,+1,-2,-1,-2,+0>,<+2,-3,+2,+2,+2,-2>)"
-- satv_pp (satv [0,1,2,6,7,8]) == "(<-1,+2,+0,+0,-1,-0>,<+4,-4,-5,-4,+4,+3>)"
-- satv_pp (satv [0,4]) == "(<+0,+0,+0,-0,+0,+0>,<-1,-1,-1,+1,-1,-1>)"
-- satv_pp (satv [0,1,3,4,6,9]) == "(<+2,+2,-0,+0,+2,-1>,<-3,-4,+5,-4,-3,+2>)"
-- satv_pp (satv [0,1,3,6,7,9]) == "(<+2,+2,-1,+0,+2,-0>,<-3,-4,+4,-4,-3,+3>)"
-- satv_pp (satv [0,1,2,3,6]) == "(<-1,-2,-2,+0,+1,-1>,<+3,+2,+2,-3,-3,+1>)"
-- satv_pp (satv [0,1,2,3,4,6]) == "(<-1,-2,-2,+0,+1,+1>,<+4,+4,+3,-4,-4,-2>)"
-- satv_pp (satv [0,1,3,6,8]) == "(<+1,-2,-2,+0,-1,-1>,<-3,+2,+2,-3,+3,+1>)"
-- satv_pp (satv [0,2,3,5,7,9]) == "(<+1,-2,-2,+0,-1,+1>,<-4,+4,+3,-4,+4,-2>)"
--
satv :: Integral i => [Z12] -> SATV i
-- | SATV reorganised by R.
--
--
-- satv_minmax (satv [0,1,2,6,7,8]) == ([4,2,0,0,4,3],[1,4,5,4,1,0])
--
satv_minmax :: SATV i -> ([i], [i])
-- | Absolute difference.
abs_dif :: Num a => a -> a -> a
-- | Sum of numerical components of a and b parts of
-- SATV.
--
--
-- satv_n_sum (satv [0,1,2,6,7,8]) == [5,6,5,4,5,3]
-- satv_n_sum (satv [0,3,6,9]) = [3,3,4,3,3,2]
--
satv_n_sum :: Num c => SATV c -> [c]
two_part_difference_vector :: Integral i => [D i] -> SATV i -> [i]
two_part_difference_vector_set :: Integral i => SATV i -> SATV i -> ([i], [i])
-- | SATSIM metric.
--
--
-- satsim [0,1,2,6,7,8] [0,3,6,9] == 25/46
-- satsim [0,4] [0,1,3,4,6,9] == 25/34
-- satsim [0,4] [0,1,3,6,7,9] == 25/34
-- satsim [0,1,2,3,6] [0,1,2,3,4,6] == 1/49
-- satsim [0,1,3,6,8] [0,2,3,5,7,9] == 1/49
-- satsim [0,1,2,3,4] [0,1,4,5,7] == 8/21
-- satsim [0,1,2,3,4] [0,2,4,6,8] == 4/7
-- satsim [0,1,4,5,7] [0,2,4,6,8] == 4/7
--
satsim :: Integral a => [Z12] -> [Z12] -> Ratio a
-- | Table of satsim measures for all SC pairs.
--
--
-- length satsim_table == 24310
--
satsim_table :: Integral i => [(([Z12], [Z12]), Ratio i)]
-- | Histogram of values at satsim_table.
--
--
-- satsim_table_histogram == L.histogram (map snd satsim_table)
--
satsim_table_histogram :: Integral i => [(Ratio i, i)]
instance Eq R
instance Show R
-- | Robert Morris. "A Similarity Index for Pitch-Class Sets". Perspectives
-- of New Music, 18(2):445-460, 1980.
module Music.Theory.Metric.Morris_1980
-- | SIM
--
--
-- icv [0,1,3,6] == [1,1,2,0,1,1] && icv [0,2,4,7] == [0,2,1,1,2,0]
-- sim [0,1,3,6] [0,2,4,7] == 6
-- sim [0,1,2,4,5,8] [0,1,3,7] == 9
--
sim :: Integral a => [Z12] -> [Z12] -> a
-- | ASIM
--
--
-- asim [0,1,3,6] [0,2,4,7] == 6/12
-- asim [0,1,2,4,5,8] [0,1,3,7] == 9/21
-- asim [0,1,2,3,4] [0,1,4,5,7] == 2/5
-- asim [0,1,2,3,4] [0,2,4,6,8] == 3/5
-- asim [0,1,4,5,7] [0,2,4,6,8] == 3/5
--
asim :: Integral n => [Z12] -> [Z12] -> Ratio n
-- | Marcus Castrén. RECREL: A Similarity Measure for Set-Classes.
-- PhD thesis, Sibelius Academy, Helsinki, 1994.
module Music.Theory.Z12.Castren_1994
-- | 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]
-- | Is p symmetrical under inversion.
--
--
-- map inv_sym (scs_n 2) == [True,True,True,True,True,True]
-- map (fromEnum.inv_sym) (scs_n 3) == [1,0,0,0,0,1,0,0,1,1,0,1]
--
inv_sym :: [Z12] -> Bool
-- | If p is not inv_sym then (p,invert 0 p) else
-- Nothing.
--
--
-- sc_t_ti [0,2,4] == Nothing
-- sc_t_ti [0,1,3] == Just ([0,1,3],[0,2,3])
--
sc_t_ti :: [Z12] -> Maybe ([Z12], [Z12])
-- | Transpositional equivalence variant of Forte's sc_table. The
-- inversionally related classes are distinguished by labels A
-- and B; the class providing the best normal order
-- (Forte 1973) is always the A class. If neither A nor
-- B appears in the name of a set-class, it is inversionally
-- symmetrical.
--
--
-- (length sc_table,length t_sc_table) == (224,352)
-- lookup "5-Z18B" t_sc_table == Just [0,2,3,6,7]
--
t_sc_table :: [(SC_Name, [Z12])]
-- | Lookup a set-class name. The input set is subject to t_prime
-- before lookup.
--
--
-- t_sc_name [0,2,3,6,7] == "5-Z18B"
-- t_sc_name [0,1,4,6,7,8] == "6-Z17B"
--
t_sc_name :: [Z12] -> SC_Name
-- | Lookup a set-class given a set-class name.
--
--
-- t_sc "6-Z17A" == [0,1,2,4,7,8]
--
t_sc :: SC_Name -> [Z12]
-- | List of set classes.
t_scs :: [[Z12]]
-- | Cardinality n subset of t_scs.
--
--
-- map (length . t_scs_n) [2..10] == [6,19,43,66,80,66,43,19,6]
--
t_scs_n :: Integral i => i -> [[Z12]]
-- | T-related q that are subsets of p.
--
--
-- t_subsets [0,1,2,3,4] [0,1] == [[0,1],[1,2],[2,3],[3,4]]
-- t_subsets [0,1,2,3,4] [0,1,4] == [[0,1,4]]
-- t_subsets [0,2,3,6,7] [0,1,4] == [[2,3,6]]
--
t_subsets :: [Z12] -> [Z12] -> [[Z12]]
-- | T/I-related q that are subsets of p.
--
--
-- ti_subsets [0,1,2,3,4] [0,1] == [[0,1],[1,2],[2,3],[3,4]]
-- ti_subsets [0,1,2,3,4] [0,1,4] == [[0,1,4],[0,3,4]]
-- ti_subsets [0,2,3,6,7] [0,1,4] == [[2,3,6],[3,6,7]]
--
ti_subsets :: [Z12] -> [Z12] -> [[Z12]]
-- | Trivial run length encoder.
--
--
-- rle "abbcccdde" == [(1,'a'),(2,'b'),(3,'c'),(2,'d'),(1,'e')]
--
rle :: (Eq a, Integral i) => [a] -> [(i, a)]
-- | Inverse of rle.
--
--
-- rle_decode [(5,'a'),(4,'b')] == "aaaaabbbb"
--
rle_decode :: Integral i => [(i, a)] -> [a]
-- | Length of rle encoded sequence.
--
--
-- rle_length [(5,'a'),(4,'b')] == 9
--
rle_length :: Integral i => [(i, a)] -> i
-- | T-equivalence n-class vector (subset-class vector, nCV).
--
--
-- t_n_class_vector 2 [0..4] == [4,3,2,1,0,0]
-- rle (t_n_class_vector 3 [0..4]) == [(1,3),(2,2),(2,1),(4,0),(1,1),(9,0)]
-- rle (t_n_class_vector 4 [0..4]) == [(1,2),(3,1),(39,0)]
--
t_n_class_vector :: (Num a, Integral i) => i -> [Z12] -> [a]
-- | T/I-equivalence n-class vector (subset-class vector, nCV).
--
--
-- ti_n_class_vector 2 [0..4] == [4,3,2,1,0,0]
-- ti_n_class_vector 3 [0,1,2,3,4] == [3,4,2,0,0,1,0,0,0,0,0,0]
-- rle (ti_n_class_vector 4 [0,1,2,3,4]) == [(2,2),(1,1),(26,0)]
--
ti_n_class_vector :: (Num b, Integral i) => i -> [Z12] -> [b]
-- | icv scaled by sum of icv.
--
--
-- dyad_class_percentage_vector [0,1,2,3,4] == [40,30,20,10,0,0]
-- dyad_class_percentage_vector [0,1,4,5,7] == [20,10,20,20,20,10]
--
dyad_class_percentage_vector :: Integral i => [Z12] -> [i]
-- | rel metric.
--
--
-- rel [0,1,2,3,4] [0,1,4,5,7] == 40
-- rel [0,1,2,3,4] [0,2,4,6,8] == 60
-- rel [0,1,4,5,7] [0,2,4,6,8] == 60
--
rel :: Integral i => [Z12] -> [Z12] -> Ratio i
-- | David Lewin. "A Response to a Response: On PC Set Relatedness".
-- Perspectives of New Music, 18(1-2):498-502, 1980.
module Music.Theory.Z12.Lewin_1980
-- | REL function with given ncv function (see t_rel and
-- ti_rel).
rel :: Floating n => (Int -> [a] -> [n]) -> [a] -> [a] -> n
-- | T-equivalence REL function.
--
-- Kuusi 2001, 7.5.2
--
--
-- let (~=) p q = abs (p - q) < 1e-2
-- t_rel [0,1,2,3,4] [0,2,3,6,7] ~= 0.44
-- t_rel [0,1,2,3,4] [0,2,4,6,8] ~= 0.28
-- t_rel [0,2,3,6,7] [0,2,4,6,8] ~= 0.31
--
t_rel :: Floating n => [Z12] -> [Z12] -> n
-- | T/I-equivalence REL function.
--
-- Buchler 1998, Fig. 3.38
--
--
-- let (~=) p q = abs (p - q) < 1e-3
-- let a = [0,2,3,5,7]::[Z12]
-- let b = [0,2,3,4,5,8]::[Z12]
-- let g = [0,1,2,3,5,6,8,10]::[Z12]
-- let j = [0,2,3,4,5,6,8]::[Z12]
-- ti_rel a b ~= 0.593
-- ti_rel a g ~= 0.648
-- ti_rel a j ~= 0.509
-- ti_rel b g ~= 0.712
-- ti_rel b j ~= 0.892
-- ti_rel g j ~= 0.707
--
ti_rel :: Floating n => [Z12] -> [Z12] -> n
-- | 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]
--
--
--
-- 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]
-- | Robert Morris. /Composition with Pitch-Classes: A Theory of
-- Compositional Design/. Yale University Press, New Haven, 1987.
module Music.Theory.Z12.Morris_1987
-- | INT operator.
--
--
-- int [0,1,3,6,10] == [1,2,3,4]
--
int :: [Z12] -> [Z12]
-- | Serial Operator,of the form rRTMI.
data SRO
SRO :: Z12 -> Bool -> Z12 -> Bool -> Bool -> SRO
-- | Serial operation.
--
--
-- >>> sro T4 156
-- 59A
--
--
--
-- sro (rnrtnmi "T4") (pco "156") == [5,9,10]
--
--
--
-- >>> echo 024579 | sro RT4I
-- 79B024
--
--
--
-- sro (SRO 0 True 4 False True) [0,2,4,5,7,9] == [7,9,11,0,2,4]
--
--
--
-- >>> sro T4I 156
-- 3BA
--
--
--
-- sro (rnrtnmi "T4I") (pco "156") == [3,11,10]
-- sro (SRO 0 False 4 False True) [1,5,6] == [3,11,10]
--
--
--
-- >>> echo 156 | sro T4 | sro T0I
-- 732
--
--
--
-- (sro (rnrtnmi "T0I") . sro (rnrtnmi "T4")) (pco "156") == [7,3,2]
--
--
--
-- >>> echo 024579 | sro RT4I
-- 79B024
--
--
--
-- sro (rnrtnmi "RT4I") (pco "024579") == [7,9,11,0,2,4]
--
--
--
-- sro (SRO 1 True 1 True False) [0,1,2,3] == [11,6,1,4]
-- sro (SRO 1 False 4 True True) [0,1,2,3] == [11,6,1,4]
--
sro :: SRO -> [Z12] -> [Z12]
-- | The total set of serial operations.
sros :: [Z12] -> [(SRO, [Z12])]
-- | The set of transposition SROs.
sro_Tn :: [SRO]
-- | The set of transposition and inversion SROs.
sro_TnI :: [SRO]
-- | The set of retrograde and transposition and inversion SROs.
sro_RTnI :: [SRO]
-- | The set of transposition,M5 and inversion SROs.
sro_TnMI :: [SRO]
-- | The set of retrograde,transposition,M5 and inversion
-- SROs.
sro_RTnMI :: [SRO]
instance Eq SRO
instance Show SRO
-- | Haskell implementations of pct operations. See
-- http://slavepianos.org/rd/?t=pct.
module Music.Theory.Z12.Drape_1999
-- | Cardinality filter
--
--
-- cf [0,3] (cg [1..4]) == [[1,2,3],[1,2,4],[1,3,4],[2,3,4],[]]
--
cf :: Integral n => [n] -> [[a]] -> [[a]]
-- | Combinatorial sets formed by considering each set as possible values
-- for slot.
--
--
-- cgg [[0,1],[5,7],[3]] == [[0,5,3],[0,7,3],[1,5,3],[1,7,3]]
--
cgg :: [[a]] -> [[a]]
-- | Combinations generator, ie. synonym for powerset.
--
--
-- sort (cg [0,1,3]) == [[],[0],[0,1],[0,1,3],[0,3],[1],[1,3],[3]]
--
cg :: [a] -> [[a]]
-- | Powerset filtered by cardinality.
--
--
-- >>> cg -r3 0159
-- 015
-- 019
-- 059
-- 159
--
--
--
-- cg_r 3 [0,1,5,9] == [[0,1,5],[0,1,9],[0,5,9],[1,5,9]]
--
cg_r :: Integral n => n -> [a] -> [[a]]
-- | Cyclic interval segment.
ciseg :: [Z12] -> [Z12]
-- | Synonynm for complement.
--
--
-- >>> cmpl 02468t
-- 13579B
--
--
--
-- cmpl [0,2,4,6,8,10] == [1,3,5,7,9,11]
--
cmpl :: [Z12] -> [Z12]
-- | Form cycle.
--
--
-- >>> cyc 056
-- 0560
--
--
--
-- cyc [0,5,6] == [0,5,6,0]
--
cyc :: [a] -> [a]
-- | Diatonic set name. d for diatonic set, m for melodic
-- minor set, o for octotonic set.
d_nm :: Integral a => [a] -> Maybe Char
-- | Diatonic implications.
dim :: [Z12] -> [(Z12, [Z12])]
-- | Variant of dim that is closer to the pct form.
--
--
-- >>> dim 016
-- T1d
-- T1m
-- T0o
--
--
--
-- dim_nm [0,1,6] == [(1,'d'),(1,'m'),(0,'o')]
--
dim_nm :: [Z12] -> [(Z12, Char)]
-- | Diatonic interval set to interval set.
--
--
-- >>> dis 24
-- 1256
--
--
--
-- dis [2,4] == [1,2,5,6]
--
dis :: Integral t => [Int] -> [t]
-- | Degree of intersection.
--
--
-- >>> echo 024579e | doi 6 | sort -u
-- 024579A
-- 024679B
--
--
--
-- let p = [0,2,4,5,7,9,11]
-- in doi 6 p p == [[0,2,4,5,7,9,10],[0,2,4,6,7,9,11]]
--
--
--
-- >>> echo 01234 | doi 2 7-35 | sort -u
-- 13568AB
--
--
--
-- doi 2 (sc "7-35") [0,1,2,3,4] == [[1,3,5,6,8,10,11]]
--
doi :: Int -> [Z12] -> [Z12] -> [[Z12]]
-- | Forte name.
fn :: [Z12] -> String
-- | p has_ess q is true iff p can embed q in sequence.
has_ess :: [Z12] -> [Z12] -> Bool
-- | Embedded segment search.
--
--
-- >>> echo 23a | ess 0164325
-- 2B013A9
-- 923507A
--
--
--
-- ess [2,3,10] [0,1,6,4,3,2,5] == [[9,2,3,5,0,7,10],[2,11,0,1,3,10,9]]
--
ess :: [Z12] -> [Z12] -> [[Z12]]
-- | Can the set-class q (under prime form algorithm pf) be drawn from the
-- pcset p.
has_sc_pf :: Integral a => ([a] -> [a]) -> [a] -> [a] -> Bool
-- | Can the set-class q be drawn from the pcset p.
has_sc :: [Z12] -> [Z12] -> Bool
-- | Interval cycle filter.
--
--
-- >>> echo 22341 | icf
-- 22341
--
--
--
-- icf [[2,2,3,4,1]] == [[2,2,3,4,1]]
--
icf :: (Num a, Eq a) => [[a]] -> [[a]]
-- | Interval class set to interval sets.
--
--
-- >>> ici -c 123
-- 123
-- 129
-- 1A3
-- 1A9
--
--
--
-- ici_c [1,2,3] == [[1,2,3],[1,2,9],[1,10,3],[1,10,9]]
--
ici :: Num t => [Int] -> [[t]]
-- | Interval class set to interval sets, concise variant.
--
--
-- ici_c [1,2,3] == [[1,2,3],[1,2,9],[1,10,3],[1,10,9]]
--
ici_c :: [Int] -> [[Int]]
-- | Interval-class segment.
--
--
-- >>> icseg 013265e497t8
-- 12141655232
--
--
--
-- icseg [0,1,3,2,6,5,11,4,9,7,10,8] == [1,2,1,4,1,6,5,5,2,3,2]
--
icseg :: [Z12] -> [Z12]
-- | Interval segment (INT).
iseg :: [Z12] -> [Z12]
-- | Imbrications.
imb :: Integral n => [n] -> [a] -> [[a]]
-- | issb gives the set-classes that can append to p to
-- give q.
--
--
-- >>> issb 3-7 6-32
-- 3-7
-- 3-2
-- 3-11
--
--
--
-- issb (sc "3-7") (sc "6-32") == ["3-2","3-7","3-11"]
--
issb :: [Z12] -> [Z12] -> [String]
-- | Matrix search.
--
--
-- >>> mxs 024579 642 | sort -u
-- 6421B9
-- B97642
--
--
--
-- S.set (mxs [0,2,4,5,7,9] [6,4,2]) == [[6,4,2,1,11,9],[11,9,7,6,4,2]]
--
mxs :: [Z12] -> [Z12] -> [[Z12]]
-- | Normalize.
--
--
-- >>> nrm 0123456543210
-- 0123456
--
--
--
-- nrm [0,1,2,3,4,5,6,5,4,3,2,1,0] == [0,1,2,3,4,5,6]
--
nrm :: Ord a => [a] -> [a]
-- | Normalize, retain duplicate elements.
nrm_r :: Ord a => [a] -> [a]
-- | Pitch-class invariances (called pi at pct).
--
--
-- >>> pi 0236 12
-- 0236
-- 6320
-- 532B
-- B235
--
--
--
-- pci [0,2,3,6] [1,2] == [[0,2,3,6],[5,3,2,11],[6,3,2,0],[11,2,3,5]]
--
pci :: [Z12] -> [Z12] -> [[Z12]]
-- | Relate sets.
--
--
-- >>> rs 0123 641e
-- T1M
--
--
--
-- import Music.Theory.Z12.Morris_1987.Parse
-- rs [0,1,2,3] [6,4,1,11] == [(rnrtnmi "T1M",[1,6,11,4])
-- ,(rnrtnmi "T4MI",[4,11,6,1])]
--
rs :: [Z12] -> [Z12] -> [(SRO, [Z12])]
-- | Relate segments.
--
--
-- >>> rsg 156 3BA
-- T4I
--
--
--
-- rsg [1,5,6] [3,11,10] == [rnrtnmi "T4I",rnrtnmi "r1RT4MI"]
--
--
--
-- >>> rsg 0123 05t3
-- T0M
--
--
--
-- rsg [0,1,2,3] [0,5,10,3] == [rnrtnmi "T0M",rnrtnmi "RT3MI"]
--
--
--
-- >>> rsg 0123 4e61
-- RT1M
--
--
--
-- rsg [0,1,2,3] [4,11,6,1] == [rnrtnmi "T4MI",rnrtnmi "RT1M"]
--
--
--
-- >>> echo e614 | rsg 0123
-- r3RT1M
--
--
--
-- rsg [0,1,2,3] [11,6,1,4] == [rnrtnmi "r1T4MI",rnrtnmi "r1RT1M"]
--
rsg :: [Z12] -> [Z12] -> [SRO]
-- | Subsets.
sb :: [[Z12]] -> [[Z12]]
-- | Super set-class.
--
--
-- >>> spsc 4-11 4-12
-- 5-26[02458]
--
--
--
-- spsc [sc "4-11", sc "4-12"] == ["5-26"]
--
--
--
-- >>> spsc 3-11 3-8
-- 4-27[0258]
-- 4-Z29[0137]
--
--
--
-- spsc [sc "3-11", sc "3-8"] == ["4-27","4-Z29"]
--
--
--
-- >>> spsc `fl 3`
-- 6-Z17[012478]
--
--
--
-- spsc (cf [3] scs) == ["6-Z17"]
--
spsc :: [[Z12]] -> [String]
-- | Parsers for pitch class sets and sequences, and for SROs.
module Music.Theory.Z12.Morris_1987.Parse
-- | Parse a Morris format serial operator descriptor.
--
--
-- rnrtnmi "r2RT3MI" == SRO 2 True 3 True True
--
rnrtnmi :: String -> SRO
-- | Parse a pitch class object string. Each Char is either a
-- number, a space which is ignored, or a letter name for the numbers 10
-- (t or a or A) or 11 (e or
-- B or b).
--
--
-- pco "13te" == [1,3,10,11]
-- pco "13te" == pco "13ab"
--
pco :: String -> [Z12]
-- | 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
-- | Encoder for encode_prime.
--
--
-- encode [0,1,3,6,8,9] == 843
--
encode :: [Z12] -> Integer
-- | Decoder for encode_prime.
--
--
-- decode 843 == [0,1,3,6,8,9]
--
decode :: Integer -> [Z12]
-- | Binary encoding prime form algorithm, equalivalent to Rahn.
--
--
-- encode_prime [0,1,3,6,8,9] == rahn_prime [0,1,3,6,8,9]
--
encode_prime :: [Z12] -> [Z12]
-- | 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
-- | Bjorklund's algorithm to construct a binary sequence of n bits
-- with k ones such that the k ones are distributed as
-- evenly as possible among the (n - k) zeroes.
--
--
-- bjorklund (5,9) == [True,False,True,False,True,False,True,False,True]
-- xdot (bjorklund (5,9)) == "x.x.x.x.x"
--
--
--
-- let es = [(2,3),(2,5)
-- ,(3,4),(3,5),(3,8)
-- ,(4,7),(4,9),(4,12),(4,15)
-- ,(5,6),(5,7),(5,8),(5,9),(5,11),(5,12),(5,13),(5,16)
-- ,(6,7),(6,13)
-- ,(7,8),(7,9),(7,10),(7,12),(7,15),(7,16),(7,17),(7,18)
-- ,(8,17),(8,19)
-- ,(9,14),(9,16),(9,22),(9,23)
-- ,(11,12),(11,24)
-- ,(13,24)
-- ,(15,34)]
-- in map (\e -> let e' = bjorklund e in (e,xdot e',iseq_str e')) es
--
--
--
-- [((2,3),"xx.","(12)")
-- ,((2,5),"x.x..","(23)")
-- ,((3,4),"xxx.","(112)")
-- ,((3,5),"x.x.x","(221)")
-- ,((3,8),"x..x..x.","(332)")
-- ,((4,7),"x.x.x.x","(2221)")
-- ,((4,9),"x.x.x.x..","(2223)")
-- ,((4,12),"x..x..x..x..","(3333)")
-- ,((4,15),"x...x...x...x..","(4443)")
-- ,((5,6),"xxxxx.","(11112)")
-- ,((5,7),"x.xx.xx","(21211)")
-- ,((5,8),"x.xx.xx.","(21212)")
-- ,((5,9),"x.x.x.x.x","(22221)")
-- ,((5,11),"x.x.x.x.x..","(22223)")
-- ,((5,12),"x..x.x..x.x.","(32322)")
-- ,((5,13),"x..x.x..x.x..","(32323)")
-- ,((5,16),"x..x..x..x..x...","(33334)")
-- ,((6,7),"xxxxxx.","(111112)")
-- ,((6,13),"x.x.x.x.x.x..","(222223)")
-- ,((7,8),"xxxxxxx.","(1111112)")
-- ,((7,9),"x.xxx.xxx","(2112111)")
-- ,((7,10),"x.xx.xx.xx","(2121211)")
-- ,((7,12),"x.xx.x.xx.x.","(2122122)")
-- ,((7,15),"x.x.x.x.x.x.x..","(2222223)")
-- ,((7,16),"x..x.x.x..x.x.x.","(3223222)")
-- ,((7,17),"x..x.x..x.x..x.x.","(3232322)")
-- ,((7,18),"x..x.x..x.x..x.x..","(3232323)")
-- ,((8,17),"x.x.x.x.x.x.x.x..","(22222223)")
-- ,((8,19),"x..x.x.x..x.x.x..x.","(32232232)")
-- ,((9,14),"x.xx.xx.xx.xx.","(212121212)")
-- ,((9,16),"x.xx.x.x.xx.x.x.","(212221222)")
-- ,((9,22),"x..x.x..x.x..x.x..x.x.","(323232322)")
-- ,((9,23),"x..x.x..x.x..x.x..x.x..","(323232323)")
-- ,((11,12),"xxxxxxxxxxx.","(11111111112)")
-- ,((11,24),"x..x.x.x.x.x..x.x.x.x.x.","(32222322222)")
-- ,((13,24),"x.xx.x.x.x.x.xx.x.x.x.x.","(2122222122222)")
-- ,((15,34),"x..x.x.x.x..x.x.x.x..x.x.x.x..x.x.","(322232223222322)")]
--
bjorklund :: (Int, Int) -> [Bool]
-- | xdot notation for pattern.
--
--
-- xdot (bjorklund (5,9)) == "x.x.x.x.x"
--
xdot :: [Bool] -> String
-- | The iseq of a pattern is the distance between True
-- values.
--
--
-- iseq (bjorklund (5,9)) == [2,2,2,2,1]
--
iseq :: [Bool] -> [Int]
-- | iseq of pattern as compact string.
--
--
-- iseq_str (bjorklund (5,9)) == "(22221)"
--
iseq_str :: [Bool] -> String