packages feed

hmt 0.12 → 0.14

raw patch · 13 files changed

+38/−462 lines, 13 filesdep −hcg-minusdep −html-minimalistdep −xml

Dependencies removed: hcg-minus, html-minimalist, xml

Files

Help/hmt.help.lhs view
@@ -1,16 +1,17 @@ # Pct -> import Control.Arrow-> import Data.Function-> import Data.List-> import Data.Maybe-> import Music.Theory.Parse-> import Music.Theory.Pct-> import Music.Theory.Permutations-> import Music.Theory.PitchClass-> import Music.Theory.Prime-> import Music.Theory.Table-> import Music.Theory.Set+> import Control.Arrow {- base -}+> import Data.Function {- base -}+> import Data.List {- base -}+> import Data.Maybe {- base -}+> import Music.Theory.List {- hmt -}+> import Music.Theory.Permutations {- hmt -}+> import Music.Theory.Set.List {- hmt -}+> import Music.Theory.Z12.Drape_1999 {- hmt -}+> import Music.Theory.Z12.Forte_1973 {- hmt -}+> import Music.Theory.Z12.Morris_1987 {- hmt -}+> import Music.Theory.Z12.Morris_1987.Parse {- hmt -}+> import Music.Theory.Z12.SRO {- hmt -}  This file illustrates equivalent expressions in pct and hmt terms. @@ -31,9 +32,6 @@       comm 5-Z17.bip 5-Z37.bip -1 -2 | wc -l     16 -> let f g = sort (g [1..4])-> in f permutations_l == f permutations- > let f = nub . map bip . permutations . sc > in length (f "5-Z17" `intersect` f "5-Z37") == 16 @@ -82,7 +80,7 @@ >     ;a = filter (\p -> length p `elem` [8,9]) (map cyc scs) >     ;b = filter (\p -> set (int p) == [1,2]) a >     ;c = filter (\p -> not ([1,1] `isInfixOf` int p)) b}-> in map sc_name c == ["7-34","7-35","8-28"]+> in map (sc_name . nub) c == ["7-34","7-35","8-28"]      $ epmq < ~/src/pct/lib/univ "in cset 6" "in pcset 579t024" \     > "has sc 5-35" "hasnt sc 2-6" "notin pcset 024579e"@@ -133,7 +131,7 @@     11223     11123 -> se 5 [1,2,3]+> expand_set 5 [1,2,3]  > ici [1,2,3] > cgg [[0],[1,11],[2,10],[3,9],[4,8],[5,7],[6]]@@ -142,7 +140,7 @@       sort -u | epmq "in cset 6" | wc -l     42 -> let {a = se 5 [1,2,4,5]+> let {a = expand_set 5 [1,2,4,5] >     ;b = concatMap permutations a >     ;c = concatMap ici b >     ;d = map (forte_prime . dx_d 0) c
Music/Theory/Bjorklund.hs view
@@ -5,7 +5,7 @@ -- (<http://dx.doi.org/10.1016/j.comgeo.2008.04.005>) module Music.Theory.Bjorklund (bjorklund,xdot,iseq,iseq_str) where -import Data.List.Split+import Data.List.Split {- split -}  type STEP a = ((Int,Int),([[a]],[[a]]))
Music/Theory/Block_Design/Johnson_2007.hs view
@@ -2,8 +2,8 @@ -- Computation in Music, Berlin, May 2007. module Music.Theory.Block_Design.Johnson_2007 where -import Control.Arrow-import Data.List+import Control.Arrow {- base -}+import Data.List {- base -} import qualified Music.Theory.List as L  -- * Designs
Music/Theory/Contour/Polansky_1992.hs view
@@ -4,11 +4,11 @@ -- (<http://www.jstor.org/pss/843933>) module Music.Theory.Contour.Polansky_1992 where -import Data.List+import Data.List {- base -} import Data.List.Split {- split -} import qualified Data.Map as M {- containers -}-import Data.Maybe-import Data.Ratio+import Data.Maybe {- base -}+import Data.Ratio {- base -} import qualified Music.Theory.Set.List as S import qualified Music.Theory.Permutations.List as P
− Music/Theory/Diagram/Grid.hs 
@@ -1,123 +0,0 @@--- | Functions for drawing grid and table structure common in music--- theory and in compositions such as Morton Feldman's durational--- /grid/ music of the 1950's.-module Music.Theory.Diagram.Grid where--import Data.Maybe-import qualified Text.HTML.Light as H {- html-minimalist -}-import qualified Text.HTML.Light.Composite as H-import qualified Text.XML.Light as X {- xml -}---- * Grid---- | Real number, synonym for 'Double'.-type R = Double---- | Point given as pair of 'R'.-type P = (R,R)---- | Red, green and blue colour triple.-type C = (R,R,R)---- | Cell location as row and column indices.-type L = (Int,Int)---- | Cell-type Cell = (L,C,String)---- | Grid-type Grid = [Cell]---- | Given /(x,y)/ upper-left co-ordinate of grid, /(w,h)/ cell--- dimensions, and /(r,c)/ grid dimensions, make list of upper-left--- co-ordinates of cells.------ > grid (10,10) (50,10) (2,2) == [(10,10),(60,10),(10,20),(60,20)]-grid :: P -> (R,R) -> (Int,Int) -> [P]-grid (x,y) (w,h) (r,c) =-    let xs = take c [x, x + w ..]-        ys = take r [y, y + h ..]-    in concatMap (zip xs . repeat) ys---- | Variant on 'grid' that constructs a single point.------ > map (grid_pt (10,10) (50,10)) [(0,0),(1,1)] == [(10,10),(60,20)]-grid_pt :: (R,R) -> (R,R) -> L -> P-grid_pt (x,y) (w,h) (r,c) =-    let r' = fromIntegral r-        c' = fromIntegral c-    in (x + c' * w,y + r' * h)---- | Displace 'P' (pointwise addition).------ > displace (2,3) (1,1) == (3,4)-displace :: (R,R) -> P -> P-displace (dx,dy) (x,y) = (x+dx,y+dy)---- | Make a bounding box from /row/ and /column/ dimensions.-mk_bbox :: (Int,Int) -> (R,R)-mk_bbox (r,c) =-    let f n = (fromIntegral n + 2) * 10-    in (f c,f r)---- * Table---- | A table cell is an 'X.Attr' and 'X.Content' duple.-type Table_Cell = ([X.Attr],[X.Content])--type Caption = [X.Content]---- | Table of row order 'Table_Cell's.-type Table = (Caption,[[Table_Cell]])---- | Construct a 'Table' with one 'X.Content' per cell.-simple_table :: Caption -> [[X.Content]] -> Table-simple_table c z = (c,map (map (\x -> ([],[x]))) z)---- | Construct a 'Table' with one 'X.Content' per cell, and an--- associated class.-simple_table_class :: Caption -> [[(String,X.Content)]] -> Table-simple_table_class c z = (c,map (map (\(nm,x) -> ([H.class' nm],[x]))) z)--type Build_F = ((Int,Int) -> Maybe Table_Cell)---- | Build a table of @(rows,columns)@ dimensions given a function--- from @(row,column)@ to 'Maybe' 'Table_Cell'.  If the function is--- 'Nothing' the cell is skipped, becase another cell has claimed it's--- locations with 'H.colspan' or 'H.rowspan'.-build_table_m :: Caption -> (Int,Int) -> Build_F -> Table-build_table_m c (m,n) f =-    let mk_row i = mapMaybe (\j -> f (i,j)) [0 .. n - 1]-    in (c,map mk_row [0 .. m - 1])---- | Build a table of @(rows,columns)@ dimensions given a function--- from @(row,column)@ to 'Table_Cell'.-build_table :: Caption -> (Int,Int) -> ((Int,Int) -> Table_Cell) -> Table-build_table c (m,n) f = build_table_m c (m,n) (Just . f)---- | Render 'Table' as @HTML@ table.-table :: Table -> X.Content-table (c,z) =-    let mk_r = H.tr [] . map (uncurry H.td)-    in H.table [] (H.caption [] c : map mk_r z)---- | A set of related tables.-type Table_Set = [Table]---- | Render a 'Table_Set's in a @div@ with class @table-set@.-table_set :: Table_Set -> X.Content-table_set = H.div [H.class' "table-set"] . map table---- | Render set of 'Table_Set's as @HTML@.-page :: Maybe FilePath -> [Table_Set] -> String-page css xs = do-    let tb = map table_set xs-        bd = H.body [H.class' "table-page"] tb-        css' = H.link_css "all" (fromMaybe "css/grid.css" css)-        hd = H.head [] [css']-        e = H.html [H.lang "en"] [hd, bd]-    H.renderHTML5 e---- | Write set of 'Table_Set's to @HTML@ file.-to_html :: FilePath -> Maybe FilePath -> [Table_Set] -> IO ()-to_html o_fn css = writeFile o_fn . page css
− Music/Theory/Diagram/Path.hs 
@@ -1,196 +0,0 @@--- | Functions to make /path diagrams/ such as those in Fig. VIII-11--- on I.Xenakis /Formalized Music/.-module Music.Theory.Diagram.Path where--import Data.CG.Minus {- hcg-minus -}-import Data.Function-import Data.List-import Data.Maybe---- * Genera---- | Set of all /(pre,element,post)/ triples of a sequence.------ > parts "abc" == [("",'a',"bc"),("a",'b',"c"),("ab",'c',"")]-parts :: [a] -> [([a],a,[a])]-parts inp =-    let f p i q = let r = (p,i,q)-                  in case q of-                       [] -> [r]-                       (q':q'') -> r : f (p ++ [i]) q' q''-    in case inp of-         (x:xs) -> f [] x xs-         [] -> []---- | All /(element,remainder)/ pairs for a sequence.------ > parts' "abc" == [('a',"bc"),('b',"ac"),('c',"ab")]-parts' :: [a] -> [(a,[a])]-parts' = let f (p,i,q) = (i,p++q) in map f . parts---- | Gather elements with equal keys.------ > gather (zip "abcba" [0..]) == [('a',[0,4]),('b',[1,3]),('c',[2])]-gather :: (Ord a) => [(a,i)] -> [(a,[i])]-gather =-    let f xs = (fst (head xs),map snd xs)-    in map f . groupBy ((==) `on` fst) . sortBy (compare `on` fst)---- * Geometry---- | Does either endpoint of the /lhs/ 'Ln' lie on the /rhs/ 'Ln'.------ > ln_on (ln' (1/2,1/2) (1/2,1)) (ln' (0,0) (1,1)) == True--- > ln_on (ln' (1/2,0) (1/2,1)) (ln' (0,0) (1,1)) == False-ln_on :: Ln R -> Ln R -> Bool-ln_on l0 l1 =-    let (p,q) = ln_pt l0-    in pt_on_line l1 p || pt_on_line l1 q---- | Do 'Ln's overlap in the particular sense of being 'ln_parallel'--- and at least one endpoint of one line lying on the other.-overlap :: Ln R -> Ln R -> Bool-overlap p q = ln_parallel p q && (ln_on p q || ln_on q p)---- | Do both points of the /rhs/ 'Ln' lie on the /lhs/ 'Ln'.-includes :: Ln R -> Ln R -> Bool-includes l0 l1 =-    let (p,q) = ln_pt l1-        f = pt_on_line l0-    in f p && f q---- | 'flip' 'includes'.-is_included :: Ln R -> Ln R -> Bool-is_included = flip includes---- | Apply /f/ to /x/ and /y/ duple of 'Pt'.-pt_fn :: ((a,a) -> b) -> Pt a -> b-pt_fn f p = let (x,y) = pt_xy p in f (x,y)---- | Apply /f/ to /start/ and /end/ 'Pt' duple of 'Ln'.-ln_fn :: (Num a,Eq a) => ((Pt a,Pt a) -> b) -> Ln a -> b-ln_fn f l = let (p,q) = ln_pt l in f (p,q)---- | Apply /f/ to /start/ and /end/ 'Pt's of 'Ln' and construct 'Ln'.-ln_pt_fn :: (Num a,Eq a,Num b,Eq b) => (Pt a -> Pt b) -> Ln a -> Ln b-ln_pt_fn f = ln_fn (\(p,q) -> ln (f p) (f q))---- | Scale set of 'Ln' to lie in area given by /(0,n)/.-to_unit :: R -> [Ln R] -> [Ln R]-to_unit m p =-    let p' = concatMap (ln_fn (\(i,j) -> [i,j])) p-        x = maximum (map pt_x p')-        y = maximum (map pt_y p')-        f n = pt_fn (\(i,j) -> pt (i*m/n) (m - (j*m/n)))-        g n = ln_pt_fn (f n)-    in map (g (max x y)) p---- * Orientation---- | Enumeration of 'Vertical', 'Horizontal' and 'Diagonal'.-data Orientation a = Vertical | Horizontal | Diagonal a-                     deriving (Eq,Show)---- | Calculate 'Orientation' of 'Ln'.------ > orientation (ln' (0,0) (0,1)) == Vertical--- > orientation (ln' (0,0) (1,0)) == Horizontal--- > orientation (ln' (0,0) (1,1)) == Diagonal 1-orientation :: (Fractional a,Eq a) => Ln a -> Orientation a-orientation l =-    case ln_slope l of-      Nothing -> Vertical-      Just m -> if m == 0 then Horizontal else Diagonal m---- * Shift Map---- | A table 'Pt' and 'Orientation' set pairs.-type Shift_Map a = [(Pt a,[Orientation a])]---- | Construct a 'Shift_Map' from a set of 'Ln's.-mk_shift_map :: [Ln R] -> Shift_Map R-mk_shift_map =-    let f i l = if overlap i l then Just (i,orientation l) else Nothing-        g (x,i,_) = mapMaybe (f i) x-        h (l0,o) = let (p,q) = ln_pt l0 in [(p,o),(q,o)]-    in gather . concatMap h . concatMap g . parts---- | Apply 'Shift_Map' to a 'Pt'.-shift_map_pt :: Shift_Map R -> Pt R -> Pt R-shift_map_pt tbl i =-    let n = 0.1-        (x,y) = pt_xy i-        g o = let x' = if Vertical `elem` o then x+n else x-                  y' = if Horizontal `elem` o then y+n else y-              in pt x' y'-    in maybe i g (lookup i tbl)---- | Apply 'Shift_Map' to a 'Ln'.-shift_map_ln :: Shift_Map R -> Ln R -> Ln R-shift_map_ln tbl = ln_pt_fn (shift_map_pt tbl)---- * Shift table---- | A table of 'Pt' pairs.-type Shift_Table a = [(Pt a,Pt a)]---- | Make element of 'Shift_Table'.-mk_shift_tbl_m :: (Ln R,Bool) -> Maybe (Shift_Table R)-mk_shift_tbl_m (l,occ) =-    if occ-    then let (p1,p2) = ln_pt l-             ((x1,y1),(x2,y2)) = ln_pt' l-             n = 0.1-         in if x1 == x2-            then let x = x1 + n in Just [(p1,pt x y1),(p2,pt x y2)]-            else let y = y1 + n in Just [(p1,pt x1 y),(p2,pt x2 y)]-    else Nothing---- | Make complete 'Shift_Table'.-mk_shift_tbl :: Collision_Table -> Shift_Table R-mk_shift_tbl = concat . mapMaybe mk_shift_tbl_m---- | Apply 'Shift_Table' to 'Ln'.-shift_table_ln :: Shift_Table R -> Ln R -> Ln R-shift_table_ln tbl =-    let f i = fromMaybe i (lookup i tbl)-    in ln_fn (\(p,q) -> ln (f p) (f q))---- * Collision table---- | Table of 'Ln's indicating collisions.-type Collision_Table = [(Ln R,Bool)]---- | Construct 'Collision_Table' for a set of 'Ln'.-mk_collision_table :: [Ln R] -> Collision_Table-mk_collision_table =-    let f (x,xs) = (x,any (is_included x) xs)-    in map f . parts'---- | Construct 'Shift_Table' from 'Collision_Table' and shift all 'Ln'.-collision_table_rewrite :: Collision_Table -> [Ln R]-collision_table_rewrite xs =-    let tbl = mk_shift_tbl xs-    in map (shift_table_ln tbl . fst) xs---- * Path diagram---- | A diagram given as a set of 'Int' pairs.-type Path_Diagram = [(Int,Int)]---- | Construct set of 'Ln' from 'Path_Diagram'.-path_diagram_ln :: Path_Diagram -> [Ln R]-path_diagram_ln xs =-    let xs' = map (pt_from_i . pt') xs-    in zipWith ln xs' (tail xs')---- | 'Collision_Table' based resolution of 'Path_Diagram'.-mk_path_ct :: Path_Diagram -> [Ln R]-mk_path_ct = collision_table_rewrite . mk_collision_table . path_diagram_ln---- | 'Shift_Map' variant of 'mk_path_ct'.-mk_path_sm :: Path_Diagram -> [Ln R]-mk_path_sm p =-    let p' = path_diagram_ln p-    in map (shift_map_ln (mk_shift_map p')) p'-
Music/Theory/Duration.hs view
@@ -6,7 +6,7 @@ import Data.Maybe import Data.Ratio --- | Standard music notation durational model+-- | Common music notation durational model data Duration = Duration {division :: Integer -- ^ division of whole note                          ,dots :: Integer -- ^ number of dots                          ,multiplier :: Rational -- ^ tuplet modifier
Music/Theory/Tiling/Canon.hs view
@@ -1,10 +1,10 @@ module Music.Theory.Tiling.Canon where  import Control.Monad.Logic {- logict -}-import Data.Function-import Data.List+import Data.Function {- base -}+import Data.List {- base -} import Data.List.Split {- split -}-import Text.Printf+import Text.Printf {- base -}  -- | Sequence. type S = [Int]
− Music/Theory/Tuning/Table.hs 
@@ -1,103 +0,0 @@--- | Tuning tables-module Music.Theory.Tuning.Table where--import qualified Music.Theory.Diagram.Grid as G-import Music.Theory.List-import Music.Theory.Pitch-import Music.Theory.Pitch.Spelling-import Music.Theory.Tuning-import qualified Text.HTML.Light as H {- html-minimalist -}-import Text.Printf---- * Equal temperament---- | 'octpc_to_pitch' and 'octpc_to_cps'.-octpc_to_pitch_cps :: (Floating n) => OctPC -> (Pitch,n)-octpc_to_pitch_cps x = (octpc_to_pitch pc_spell_ks x,octpc_to_cps x)---- | 12-tone equal temperament table equating 'Pitch' and frequency--- over range of human hearing, where @A4@ = @440@hz.------ > length tbl_12et == 132--- > min_max (map (round . snd) tbl_12et) == (16,31609)-tbl_12et :: [(Pitch,Double)]-tbl_12et =-    let z = [(o,pc) | o <- [0..10], pc <- [0..11]]-    in map octpc_to_pitch_cps z---- | 24-tone equal temperament variant of 'tbl_12et'.------ > length tbl_24et == 264--- > min_max (map (round . snd) tbl_24et) == (16,32535)-tbl_24et :: [(Pitch, Double)]-tbl_24et =-    let f x = let p = fmidi_to_pitch pc_spell_ks x-                  p' = pitch_rewrite_threequarter_alteration p-              in (p',fmidi_to_cps x)-    in map f [12,12.5 .. 143.5]---- | Given an @ET@ table (or like) find bounds of frequency.------ > let r = Just (at_pair octpc_to_pitch_cps ((3,11),(4,0)))--- > in bounds_et_table tbl_12et 256 == r-bounds_et_table :: Ord s => [(t,s)] -> s -> Maybe ((t,s),(t,s))-bounds_et_table tbl =-    let f (_,p) = compare p-    in find_bounds f (adj2 1 tbl)---- | 'bounds_et_table' of 'tbl_12et'.------ > map bounds_12et_tone (hsn 17 55)-bounds_12et_tone :: Double -> Maybe ((Pitch,Double),(Pitch,Double))-bounds_12et_tone = bounds_et_table tbl_12et---- | Tuple indicating nearest 'Pitch' to /frequency/ with @ET@--- frequency, and deviation in hertz and 'Cents'.-type HS_R = (Double,Pitch,Double,Double,Cents)---- | Form 'HS_R' for /frequency/ by consulting table.------ > let {f = 256--- >     ;f' = octpc_to_cps (4,0)--- >     ;r = (f,Pitch C Natural 4,f',f-f',to_cents (f/f'))}--- > in nearest_et_table_tone tbl_12et 256 == r-nearest_et_table_tone :: [(Pitch,Double)] -> Double -> HS_R-nearest_et_table_tone tbl f =-    case bounds_et_table tbl f of-      Nothing -> undefined-      Just ((lp,lf),(rp,rf)) ->-          let ld = f - lf-              rd = f - rf-          in if abs ld < abs rd-             then (f,lp,lf,ld,to_cents (f/lf))-             else (f,rp,rf,rd,to_cents (f/rf))--nearest_12et_tone :: Double -> HS_R-nearest_12et_tone = nearest_et_table_tone tbl_12et--nearest_24et_tone :: Double -> HS_R-nearest_24et_tone = nearest_et_table_tone tbl_24et---- * Cell---- | /n/-decimal places.------ > ndp 3 (1/3) == "0.333"-ndp :: Int -> Double -> String-ndp = printf "%.*f"---- | 'G.Table_Cell' from set of 'HS_R'.-hs_r_cell :: Int -> (Int -> String) -> [HS_R] -> (Int,Int) -> G.Table_Cell-hs_r_cell n nm_f t (i,j) =-    let dp = ndp n-        (f,p,pf,fd,c) = t !! i-        e = case j of-              0 -> nm_f i-              1 -> dp f-              2 -> pitch_pp p-              3 -> dp pf-              4 -> dp fd-              5 -> dp c-              _ -> undefined-    in ([],[H.cdata e])-
Music/Theory/Z12/Drape_1999.hs view
@@ -101,7 +101,9 @@ dim_nm :: [Z12] -> [(Z12,Char)] dim_nm =     let pk f (i,j) = (i,f j)-    in nubBy ((==) `on` snd) . map (pk (fromJust.d_nm)) . dim+    in nubBy ((==) `on` snd) .+       map (pk (fromMaybe (error "dim_mn") . d_nm)) .+       dim  -- | Diatonic interval set to interval set. --
Music/Theory/Z12/Forte_1973.hs view
@@ -297,13 +297,13 @@ sc_name :: [Z12] -> SC_Name sc_name p =     let n = find (\(_,q) -> forte_prime p == q) sc_table-    in fst (fromJust n)+    in fst (fromMaybe (error "sc_name") n)  -- | Lookup a set-class given a set-class name. -- -- > sc "6-Z17" == [0,1,2,4,7,8] sc :: SC_Name -> [Z12]-sc n = snd (fromJust (find (\(m,_) -> n == m) sc_table))+sc n = snd (fromMaybe (error "sc") (find (\(m,_) -> n == m) sc_table))  -- | List of set classes. scs :: [[Z12]]
README view
@@ -4,8 +4,12 @@ Music theory operations in [haskell][hs], primarily focused on 'set theory' and 'common music notation'. -© [rohan drape][rd], 2006-2012, [gpl][gpl].+- [hmt-diagrams][hmt-diagrams]  [hs]: http://haskell.org/+[hmt-diagrams]:  http://rd.slavepianos.org/?t=hmt-diagrams++© [rohan drape][rd], 2006-2013, [gpl][gpl].+ [rd]:  http://rd.slavepianos.org/ [gpl]: http://gnu.org/copyleft/
hmt.cabal view
@@ -1,10 +1,10 @@ Name:              hmt-Version:           0.12+Version:           0.14 Synopsis:          Haskell Music Theory Description:       Haskell music theory library License:           GPL Category:          Music-Copyright:         Rohan Drape, 2006-2012+Copyright:         Rohan Drape, 2006-2013 Author:            Rohan Drape Maintainer:        rd@slavepianos.org Stability:         Experimental@@ -23,24 +23,19 @@                    containers,                    directory,                    filepath,-                   hcg-minus==0.12.*,-                   html-minimalist==0.12.*,                    logict,                    multiset-comb,                    parsec,                    permutation,                    primes,                    split,-                   utf8-string,-                   xml+                   utf8-string   GHC-Options:     -Wall -fwarn-tabs   Exposed-modules: Music.Theory.Bjorklund                    Music.Theory.Block_Design.Johnson_2007                    Music.Theory.Clef                    Music.Theory.Combinations                    Music.Theory.Contour.Polansky_1992-                   Music.Theory.Diagram.Grid-                   Music.Theory.Diagram.Path                    Music.Theory.Duration                    Music.Theory.Duration.Annotation                    Music.Theory.Duration.Name@@ -80,7 +75,6 @@                    Music.Theory.Tuning.Polansky_1984                    Music.Theory.Tuning.Polansky_1990                    Music.Theory.Tuning.Scala-                   Music.Theory.Tuning.Table                    Music.Theory.Xenakis.S4                    Music.Theory.Xenakis.Sieve                    Music.Theory.Z12