-- | Tuning theory module Music.Theory.Tuning where import Data.Fixed (mod') {- base -} import Data.List {- base -} import qualified Data.Map as M {- containers -} import Data.Maybe {- base -} import Data.Ratio {- base -} import Safe {- safe -} import qualified Music.Theory.Either as T {- hmt -} import qualified Music.Theory.List as T {- hmt -} import qualified Music.Theory.Map as T {- hmt -} import qualified Music.Theory.Pitch as T {- hmt -} import qualified Music.Theory.Set.List as T {- hmt -} import qualified Music.Theory.Tuple as T {- hmt -} -- * Types -- | An approximation of a ratio. type Approximate_Ratio = Double -- | A real valued division of a semi-tone into one hundred parts, and -- hence of the octave into @1200@ parts. type Cents = Double -- | A tuning specified 'Either' as a sequence of exact ratios, or as -- a sequence of possibly inexact 'Cents'. -- -- In both cases, the values are given in relation to the first degree -- of the scale, which for ratios is 1 and for cents 0. data Tuning = Tuning {tn_ratios_or_cents :: Either [Rational] [Cents] ,tn_octave_ratio :: Rational} deriving (Eq,Show) -- | Divisions of octave. -- -- > tn_divisions (equal_temperament 12) == 12 tn_divisions :: Tuning -> Int tn_divisions = either length length . tn_ratios_or_cents -- | 'Maybe' exact ratios of 'Tuning'. tn_ratios :: Tuning -> Maybe [Rational] tn_ratios = T.fromLeft . tn_ratios_or_cents -- | 'error'ing variant. tn_ratios_err :: Tuning -> [Rational] tn_ratios_err = fromMaybe (error "ratios") . tn_ratios -- | Possibly inexact 'Cents' of tuning. tn_cents :: Tuning -> [Cents] tn_cents = either (map ratio_to_cents) id . tn_ratios_or_cents -- | 'map' 'round' '.' 'cents'. tn_cents_i :: Integral i => Tuning -> [i] tn_cents_i = map round . tn_cents -- | Variant of 'cents' that includes octave at right. tn_cents_octave :: Tuning -> [Cents] tn_cents_octave t = tn_cents t ++ [ratio_to_cents (tn_octave_ratio t)] -- | Convert from interval in cents to frequency ratio. -- -- > map cents_to_ratio [0,701.9550008653874,1200] == [1,3/2,2] cents_to_ratio :: Floating a => a -> a cents_to_ratio n = 2 ** (n / 1200) -- | Possibly inexact 'Approximate_Ratio's of tuning. tn_approximate_ratios :: Tuning -> [Approximate_Ratio] tn_approximate_ratios = either (map approximate_ratio) (map cents_to_ratio) . tn_ratios_or_cents -- | Cyclic form, taking into consideration 'octave_ratio'. tn_approximate_ratios_cyclic :: Tuning -> [Approximate_Ratio] tn_approximate_ratios_cyclic t = let r = tn_approximate_ratios t m = realToFrac (tn_octave_ratio t) g = iterate (* m) 1 f n = map (* n) r in concatMap f g -- | Iterate the function /f/ /n/ times, the inital value is /x/. -- -- > recur_n 5 (* 2) 1 == 32 -- > take (5 + 1) (iterate (* 2) 1) == [1,2,4,8,16,32] recur_n :: Integral n => n -> (t -> t) -> t -> t recur_n n f x = if n < 1 then x else recur_n (n - 1) f (f x) -- | Convert a (signed) number of octaves difference of given ratio to a ratio. -- -- > map (oct_diff_to_ratio 2) [-3 .. 3] == [1/8,1/4,1/2,1,2,4,8] -- > map (oct_diff_to_ratio (9/8)) [-3 .. 3] == [512/729,64/81,8/9,1/1,9/8,81/64,729/512] oct_diff_to_ratio :: Integral a => Ratio a -> Int -> Ratio a oct_diff_to_ratio r n = if n >= 0 then recur_n n (* r) 1 else recur_n (negate n) (/ r) 1 -- | Lookup function that allows both negative & multiple octave indices. -- -- > let map_zip f l = zip l (map f l) -- > map_zip (tn_ratios_lookup werckmeister_vi) [-24 .. 24] tn_ratios_lookup :: Tuning -> Int -> Maybe Rational tn_ratios_lookup t n = let (o,pc) = n `divMod` tn_divisions t o_ratio = oct_diff_to_ratio (tn_octave_ratio t) o in fmap (\r -> o_ratio * (r !! pc)) (tn_ratios t) -- | Lookup function that allows both negative & multiple octave indices. -- -- > map_zip (tn_approximate_ratios_lookup werckmeister_v) [-24 .. 24] tn_approximate_ratios_lookup :: Tuning -> Int -> Approximate_Ratio tn_approximate_ratios_lookup t n = let (o,pc) = n `divMod` tn_divisions t o_ratio = fromRational (oct_diff_to_ratio (tn_octave_ratio t) o) in o_ratio * ((tn_approximate_ratios t) !! pc) -- | 'Maybe' exact ratios reconstructed from possibly inexact 'Cents' -- of 'Tuning'. -- -- > :l Music.Theory.Tuning.Werckmeister -- > let r = [1,17/16,9/8,13/11,5/4,4/3,7/5,3/2,11/7,5/3,16/9,15/8] -- > tn_reconstructed_ratios 1e-2 werckmeister_iii == Just r tn_reconstructed_ratios :: Double -> Tuning -> Maybe [Rational] tn_reconstructed_ratios epsilon = fmap (map (reconstructed_ratio epsilon)) . T.fromRight . tn_ratios_or_cents -- | Convert from a 'Floating' ratio to /cents/. -- -- > let r = [0,498,702,1200] -- > in map (round . fratio_to_cents) [1,4/3,3/2,2] == r fratio_to_cents :: (Real r,Floating n) => r -> n fratio_to_cents = (1200 *) . logBase 2 . realToFrac -- | Type specialised 'fratio_to_cents'. approximate_ratio_to_cents :: Approximate_Ratio -> Cents approximate_ratio_to_cents = fratio_to_cents -- | Type specialised 'fromRational'. approximate_ratio :: Rational -> Approximate_Ratio approximate_ratio = fromRational -- | 'approximate_ratio_to_cents' '.' 'approximate_ratio'. -- -- > map (\n -> (n,round (ratio_to_cents (fold_ratio_to_octave_err (n % 1))))) [1..21] ratio_to_cents :: Integral i => Ratio i -> Cents ratio_to_cents = approximate_ratio_to_cents . realToFrac -- | Construct an exact 'Rational' that approximates 'Cents' to within -- /epsilon/. -- -- > map (reconstructed_ratio 1e-5) [0,700,1200] == [1,442/295,2] -- -- > ratio_to_cents (442/295) == 699.9976981706735 reconstructed_ratio :: Double -> Cents -> Rational reconstructed_ratio epsilon c = approxRational (cents_to_ratio c) epsilon -- | Frequency /n/ cents from /f/. -- -- > import Music.Theory.Pitch -- > map (cps_shift_cents 440) [-100,100] == map octpc_to_cps [(4,8),(4,10)] cps_shift_cents :: Floating a => a -> a -> a cps_shift_cents f = (* f) . cents_to_ratio -- | Interval in /cents/ from /p/ to /q/, ie. 'ratio_to_cents' of /p/ -- '/' /q/. -- -- > cps_difference_cents 440 (octpc_to_cps (5,2)) == 500 -- -- > let abs_dif i j = abs (i - j) -- > in cps_difference_cents 440 (fmidi_to_cps 69.1) `abs_dif` 10 < 1e9 cps_difference_cents :: (Real r,Fractional r,Floating n) => r -> r -> n cps_difference_cents p q = fratio_to_cents (q / p) -- * Commas -- | The Syntonic comma. -- -- > syntonic_comma == 81/80 syntonic_comma :: Rational syntonic_comma = 81 % 80 -- | The Pythagorean comma. -- -- > pythagorean_comma == 3^12 / 2^19 pythagorean_comma :: Rational pythagorean_comma = 531441 / 524288 -- | Mercators comma. -- -- > mercators_comma == 3^53 / 2^84 mercators_comma :: Rational mercators_comma = 19383245667680019896796723 / 19342813113834066795298816 -- | Calculate /n/th root of /x/. -- -- > 12 `nth_root` 2 == twelve_tone_equal_temperament_comma nth_root :: (Floating a,Eq a) => a -> a -> a nth_root n x = let f (_,x0) = (x0, ((n-1)*x0+x/x0**(n-1))/n) e = uncurry (==) in fst (until e f (x, x/n)) -- | 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 twelve_tone_equal_temperament_comma = 12 `nth_root` 2 -- * Equal temperaments -- | Make /n/ division equal temperament. equal_temperament :: Integral n => n -> Tuning equal_temperament n = let c = genericTake n [0,1200 / fromIntegral n ..] in Tuning (Right c) 2 -- | 12-tone equal temperament. -- -- > cents equal_temperament_12 == [0,100..1100] equal_temperament_12 :: Tuning equal_temperament_12 = equal_temperament (12::Int) -- | 19-tone equal temperament. equal_temperament_19 :: Tuning equal_temperament_19 = equal_temperament (19::Int) -- | 31-tone equal temperament. equal_temperament_31 :: Tuning equal_temperament_31 = equal_temperament (31::Int) -- | 53-tone equal temperament. equal_temperament_53 :: Tuning equal_temperament_53 = equal_temperament (53::Int) -- | 72-tone equal temperament. -- -- > let r = [0,17,33,50,67,83,100] -- > in take 7 (map round (cents equal_temperament_72)) == r equal_temperament_72 :: Tuning equal_temperament_72 = equal_temperament (72::Int) -- | 96-tone equal temperament. equal_temperament_96 :: Tuning equal_temperament_96 = equal_temperament (96::Int) -- * Harmonic series -- | Harmonic series to /n/th partial, with indicated octave. -- -- > harmonic_series 17 2 harmonic_series :: Integer -> Rational -> Tuning harmonic_series n o = Tuning (Left [1 .. n%1]) o -- | Harmonic series on /n/. harmonic_series_cps :: (Num t, Enum t) => t -> [t] harmonic_series_cps n = [n,n * 2 ..] -- | /n/ elements of 'harmonic_series_cps'. -- -- > let r = [55,110,165,220,275,330,385,440,495,550,605,660,715,770,825,880,935] -- > in harmonic_series_cps_n 17 55 == r harmonic_series_cps_n :: (Num a, Enum a) => Int -> a -> [a] harmonic_series_cps_n n = take n . harmonic_series_cps -- | Sub-harmonic series on /n/. subharmonic_series_cps :: (Fractional t,Enum t) => t -> [t] subharmonic_series_cps n = map (* n) (map recip [1..]) -- | /n/ elements of 'harmonic_series_cps'. -- -- > let r = [1760,880,587,440,352,293,251,220,196,176,160,147,135,126,117,110,104] -- > in map round (subharmonic_series_cps_n 17 1760) == r subharmonic_series_cps_n :: (Fractional t,Enum t) => Int -> t -> [t] subharmonic_series_cps_n n = take n . subharmonic_series_cps -- | /n/th partial of /f1/, ie. one indexed. -- -- > map (partial 55) [1,5,3] == [55,275,165] partial :: (Num a, Enum a) => a -> Int -> a partial f1 k = harmonic_series_cps f1 `at` (k - 1) fold_ratio_to_octave' :: Integral i => Ratio i -> Ratio i fold_ratio_to_octave' = let rec_f n = if n >= 2 then rec_f (n / 2) else if n < 1 then rec_f (n * 2) else n in rec_f -- | Error if input is less than or equal to zero. -- -- > map fold_ratio_to_octave_err [2/3,3/4] == [4/3,3/2] fold_ratio_to_octave_err :: Integral i => Ratio i -> Ratio i fold_ratio_to_octave_err n = if n <= 0 then error "fold_ratio_to_octave" else fold_ratio_to_octave' n -- | Fold ratio until within an octave, ie. @1@ '<' /n/ '<=' @2@. -- -- > map fold_ratio_to_octave [0,1] == [Nothing,Just 1] fold_ratio_to_octave :: Integral i => Ratio i -> Maybe (Ratio i) fold_ratio_to_octave n = if n <= 0 then Nothing else Just (fold_ratio_to_octave' n) -- | Sun of numerator & denominator. ratio_nd_sum :: Num a => Ratio a -> a ratio_nd_sum r = numerator r + denominator r min_by :: Ord a => (t -> a) -> t -> t -> t min_by f p q = if f p <= f q then p else q -- | The interval between two pitches /p/ and /q/ given as ratio -- multipliers of a fundamental is /q/ '/' /p/. The classes over such -- intervals consider the 'fold_ratio_to_octave' of both /p/ to /q/ -- and /q/ to /p/. -- -- > map ratio_interval_class [2/3,3/2,3/4,4/3] == [3/2,3/2,3/2,3/2] -- > map ratio_interval_class [7/6,12/7] == [7/6,7/6] ratio_interval_class :: Integral i => Ratio i -> Ratio i ratio_interval_class i = let f = fold_ratio_to_octave_err in min_by ratio_nd_sum (f i) (f (recip i)) -- | Derivative harmonic series, based on /k/th partial of /f1/. -- -- > import Music.Theory.Pitch -- -- > let {r = [52,103,155,206,258,309,361,412,464,515,567,618,670,721,773] -- > ;d = harmonic_series_cps_derived 5 (octpc_to_cps (1,4))} -- > in map round (take 15 d) == r harmonic_series_cps_derived :: (Ord a, Fractional a, Enum a) => Int -> a -> [a] harmonic_series_cps_derived k f1 = let f0 = T.cps_in_octave_above f1 (partial f1 k) in harmonic_series_cps f0 -- | Harmonic series to /n/th harmonic (folded, duplicated removed). -- -- > harmonic_series_folded_r 17 == [1,17/16,9/8,5/4,11/8,3/2,13/8,7/4,15/8] -- -- > let r = [0,105,204,386,551,702,841,969,1088] -- > in map (round . ratio_to_cents) (harmonic_series_folded_r 17) == r harmonic_series_folded_r :: Integer -> [Rational] harmonic_series_folded_r n = nub (sort (map fold_ratio_to_octave_err [1 .. n%1])) -- | 'ratio_to_cents' variant of 'harmonic_series_folded'. harmonic_series_folded_c :: Integer -> [Cents] harmonic_series_folded_c = map ratio_to_cents . harmonic_series_folded_r harmonic_series_folded :: Integer -> Rational -> Tuning harmonic_series_folded n o = Tuning (Left (harmonic_series_folded_r n)) o -- | @12@-tone tuning of first @21@ elements of the harmonic series. -- -- > cents_i harmonic_series_folded_21 == [0,105,204,298,386,471,551,702,841,969,1088] -- > divisions harmonic_series_folded_21 == 11 harmonic_series_folded_21 :: Tuning harmonic_series_folded_21 = harmonic_series_folded 21 2 -- * Cents -- | Give cents difference from nearest 12ET tone. -- -- > let r = [50,-49,-2,0,2,49,50] -- > in map cents_et12_diff [650,651,698,700,702,749,750] == r cents_et12_diff :: Integral n => n -> n cents_et12_diff n = let m = n `mod` 100 in if m > 50 then m - 100 else m -- | Fractional form of 'cents_et12_diff'. fcents_et12_diff :: Real n => n -> n fcents_et12_diff n = let m = n `mod'` 100 in if m > 50 then m - 100 else m -- | The class of cents intervals has range @(0,600)@. -- -- > map cents_interval_class [50,1150,1250] == [50,50,50] -- -- > let r = concat [[0,50 .. 550],[600],[550,500 .. 0]] -- > in map cents_interval_class [1200,1250 .. 2400] == r cents_interval_class :: Integral a => a -> a cents_interval_class n = let n' = n `mod` 1200 in if n' > 600 then 1200 - n' else n' -- | Fractional form of 'cents_interval_class'. fcents_interval_class :: Real a => a -> a fcents_interval_class n = let n' = n `mod'` 1200 in if n' > 600 then 1200 - n' else n' -- | Always include the sign, elide @0@. cents_diff_pp :: (Num a, Ord a, Show a) => a -> String cents_diff_pp n = case compare n 0 of LT -> show n EQ -> "" GT -> '+' : show n -- | Given brackets, print cents difference. cents_diff_br :: (Num a, Ord a, Show a) => (String,String) -> a -> String cents_diff_br br = let f s = if null s then s else T.bracket_l br s in f . cents_diff_pp -- | 'cents_diff_br' with parentheses. -- -- > map cents_diff_text [-1,0,1] == ["(-1)","","(+1)"] cents_diff_text :: (Num a, Ord a, Show a) => a -> String cents_diff_text = cents_diff_br ("(",")") -- | 'cents_diff_br' with markdown superscript (@^@). cents_diff_md :: (Num a, Ord a, Show a) => a -> String cents_diff_md = cents_diff_br ("^","^") -- | 'cents_diff_br' with HTML superscript (@<sup>@). cents_diff_html :: (Num a, Ord a, Show a) => a -> String cents_diff_html = cents_diff_br ("<SUP>","</SUP>") -- * Midi -- | (/n/ -> /dt/). Function from midi note number /n/ to -- 'Midi_Detune' /dt/. The incoming note number is the key pressed, -- which may be distant from the note sounded. type Midi_Tuning_F = Int -> T.Midi_Detune -- | Variant for tunings that are incomplete. type Sparse_Midi_Tuning_F = Int -> Maybe T.Midi_Detune -- | Variant for sparse tunings that require state. type Sparse_Midi_Tuning_ST_F st = st -> Int -> (st,Maybe T.Midi_Detune) -- | Lift 'Midi_Tuning_F' to 'Sparse_Midi_Tuning_F'. lift_tuning_f :: Midi_Tuning_F -> Sparse_Midi_Tuning_F lift_tuning_f tn_f = Just . tn_f -- | Lift 'Sparse_Midi_Tuning_F' to 'Sparse_Midi_Tuning_ST_F'. lift_sparse_tuning_f :: Sparse_Midi_Tuning_F -> Sparse_Midi_Tuning_ST_F st lift_sparse_tuning_f tn_f st k = (st,tn_f k) -- | (t,c,k) where t=tuning (must have 12 divisions of octave), -- c=cents deviation (ie. constant detune offset), k=midi offset -- (ie. value to be added to incoming midi note number). type D12_Midi_Tuning = (Tuning,Cents,Int) -- | 'Midi_Tuning_F' for 'D12_Midi_Tuning'. -- -- > let f = d12_midi_tuning_f (equal_temperament 12,0,0) -- > map f [0..127] == zip [0..127] (repeat 0) d12_midi_tuning_f :: D12_Midi_Tuning -> Midi_Tuning_F d12_midi_tuning_f (t,c_diff,k) n = let (_,pc) = T.midi_to_octpc (n + k) dt = zipWith (-) (tn_cents t) [0,100 .. 1200] in if tn_divisions t /= 12 then error "d12_midi_tuning_f: not d12" else case dt `atMay` pc of Nothing -> error "d12_midi_tuning_f: pc?" Just c -> (n,c + c_diff) -- | (t,f0,k,g) where t=tuning, f0=fundamental frequency, k=midi note -- number for f0, g=gamut type CPS_Midi_Tuning = (Tuning,Double,Int,Int) -- | 'Midi_Tuning_F' for 'CPS_Midi_Tuning'. The function is sparse, it is only -- valid for /g/ values from /k/. -- -- > let f = cps_midi_tuning_f (equal_temperament 72,T.midi_to_cps 59,59,72 * 4) -- > map f [59 .. 59 + 72] cps_midi_tuning_f :: CPS_Midi_Tuning -> Sparse_Midi_Tuning_F cps_midi_tuning_f (t,f0,k,g) n = let r = tn_approximate_ratios_cyclic t m = take g (map (T.cps_to_midi_detune . (* f0)) r) in m `atMay` (n - k) -- * Midi tuning tables. -- | Midi-note-number -> CPS table, possibly sparse. type MNN_CPS_Table = [(Int,Double)] -- | Generates 'MNN_CPS_Table' given 'Midi_Tuning_F' with keys for all valid @MNN@. -- -- > import Sound.SC3.Plot -- > plot_p2_ln [map (fmap round) (gen_cps_tuning_tbl f)] gen_cps_tuning_tbl :: Sparse_Midi_Tuning_F -> MNN_CPS_Table gen_cps_tuning_tbl tn_f = let f n = case tn_f n of Just r -> Just (n,T.midi_detune_to_cps r) Nothing -> Nothing in mapMaybe f [0 .. 127] -- * Derived (secondary) tuning table (DTT) lookup. -- | Given an 'MNN_CPS_Table' /tbl/, a list of @CPS@ /c/, and a @MNN@ /m/ -- find the @CPS@ in /c/ that is nearest to the @CPS@ in /t/ for /m/. dtt_lookup :: (Eq k, Num v, Ord v) => [(k,v)] -> [v] -> k -> (Maybe v,Maybe v) dtt_lookup tbl cps n = let f = lookup n tbl in (f,fmap (T.find_nearest_err cps) f) -- | Require table be non-sparse. dtt_lookup_err :: (Eq k, Num v, Ord v) => [(k,v)] -> [v] -> k -> (k,v,v) dtt_lookup_err tbl cps n = case dtt_lookup tbl cps n of (Just f,Just g) -> (n,f,g) _ -> error "dtt_lookup" -- | Given two tuning tables generate the @dtt@ table. gen_dtt_lookup_tbl :: MNN_CPS_Table -> MNN_CPS_Table -> MNN_CPS_Table gen_dtt_lookup_tbl t0 t1 = let ix = [0..127] cps = sort (map (T.p3_third . dtt_lookup_err t0 (map snd t1)) ix) in zip ix cps gen_dtt_lookup_f :: MNN_CPS_Table -> MNN_CPS_Table -> Midi_Tuning_F gen_dtt_lookup_f t0 t1 = let m = M.fromList (gen_dtt_lookup_tbl t0 t1) in T.cps_to_midi_detune . T.map_ix_err m -- * Euler-Fokker genus <http://www.huygens-fokker.org/microtonality/efg.html> -- | Normal form, value with occurences count (ie. exponent in notation above). type EFG i = [(i,Int)] -- | Degree of EFG, ie. sum of exponents. -- -- > efg_degree [(3,3),(7,2)] == 3 + 2 efg_degree :: EFG i -> Int efg_degree = sum . map snd -- | Number of tones of EFG, ie. product of increment of exponents. -- -- > efg_tones [(3,3),(7,2)] == (3 + 1) * (2 + 1) efg_tones :: EFG i -> Int efg_tones = product . map ((+ 1) . snd) -- | Collate a genus given as a multiset into standard form, ie. histogram. -- -- > efg_collate [3,3,3,7,7] == [(3,3),(7,2)] efg_collate :: Ord i => [i] -> EFG i efg_collate = T.histogram . sort {- | Factors of EFG given with co-ordinate of grid location. > efg_factors [(3,3)] > let r = [([0,0],[]),([0,1],[7]),([0,2],[7,7]) > ,([1,0],[3]),([1,1],[3,7]),([1,2],[3,7,7]) > ,([2,0],[3,3]),([2,1],[3,3,7]),([2,2],[3,3,7,7]) > ,([3,0],[3,3,3]),([3,1],[3,3,3,7]),([3,2],[3,3,3,7,7])] > in efg_factors [(3,3),(7,2)] == r -} efg_factors :: EFG i -> [([Int],[i])] efg_factors efg = let k = map (\(_,n) -> [0 .. n]) efg k' = if length efg == 1 then concatMap (map return) k else T.nfold_cartesian_product k z = map fst efg f ix = (ix,concat (zipWith (\n m -> replicate n (z !! m)) ix [0..])) in map f k' {- | Ratios of EFG, taking /n/ as the 1:1 ratio, with indices, folded into one octave. > let r = sort $ map snd $ efg_ratios 7 [(3,3),(7,2)] > r == [1/1,9/8,8/7,9/7,21/16,189/128,3/2,27/16,12/7,7/4,27/14,63/32] > map (round . ratio_to_cents) r == [0,204,231,435,471,675,702,906,933,969,1137,1173] 0: 1/1 C 0.000 cents 1: 9/8 D 203.910 cents 2: 8/7 D+ 231.174 cents 3: 9/7 E+ 435.084 cents 4: 21/16 F- 470.781 cents 5: 189/128 G- 674.691 cents 6: 3/2 G 701.955 cents 7: 27/16 A 905.865 cents 8: 12/7 A+ 933.129 cents 9: 7/4 Bb- 968.826 cents 10: 27/14 B+ 1137.039 cents 11: 63/32 C- 1172.736 cents 12: 2/1 C 1200.000 cents > let r' = sort $ map snd $ efg_ratios 5 [(5,2),(7,3)] > r' == [1/1,343/320,35/32,49/40,5/4,343/256,7/5,49/32,8/5,1715/1024,7/4,245/128] > map (round . ratio_to_cents) r' == [0,120,155,351,386,506,583,738,814,893,969,1124] > let r'' = sort $ map snd $ efg_ratios 3 [(3,1),(5,1),(7,1)] > r'' == [1/1,35/32,7/6,5/4,4/3,35/24,5/3,7/4] > map (round . ratio_to_cents) r'' == [0,155,267,386,498,653,884,969] > let c0 = [0,204,231,435,471,675,702,906,933,969,1137,1173,1200] > let c1 = [0,120,155,351,386,506,583,738,814,893,969,1124,1200] > let c2 = [0,155,267,386,498,653,884,969,1200] > let f (c',y) = map (\x -> (x,y,x,y + 10)) c' > map f (zip [c0,c1,c2] [0,20,40]) -} efg_ratios :: Real r => Rational -> EFG r -> [([Int],Rational)] efg_ratios n = let to_r = fold_ratio_to_octave_err . (/ n) . toRational . product f (ix,i) = (ix,to_r i) in map f . efg_factors {- | Generate a line drawing, as a set of (x0,y0,x1,y1) 4-tuples. h=row height, m=distance of vertical mark from row edge, k=distance between rows > let e = [[3,3,3],[3,3,5],[3,5,5],[3,5,7],[3,7,7],[5,5,5],[5,5,7],[3,3,7],[5,7,7],[7,7,7]] > let e = [[3,3,3],[5,5,5],[7,7,7],[3,3,5],[3,5,5],[5,5,7],[5,7,7],[3,7,7],[3,3,7],[3,5,7]] > let e' = map efg_collate e > efg_diagram_set (round,25,4,75) e' -} efg_diagram_set :: (Enum n,Real n) => (Cents -> n,n,n,n) -> [EFG n] -> [(n,n,n,n)] efg_diagram_set (to_f,h,m,k) e = let f = (++ [1200]) . sort . map (to_f . ratio_to_cents . snd) . efg_ratios 1 g (c,y) = let y' = y + h b = [(0,y,1200,y),(0,y',1200,y')] in b ++ map (\x -> (x,y + m,x,y' - m)) c in concatMap g (zip (map f e) [0,k ..])