hmeap 0.8 → 0.9
raw patch · 18 files changed
+382/−362 lines, 18 filesdep +gnuplotdep +hmatrixdep +hmeapsetup-changednew-component:exe:hmeap-browsenew-component:exe:hmeap-parsernew-component:exe:hmeap-playnew-component:exe:hmeap-plotnew-component:exe:hmeap-stat
Dependencies added: gnuplot, hmatrix, hmeap, hosc, hsc3
Files
- Help/Makefile +0/−10
- Help/browse.hs +0/−35
- Help/parser.hs +0/−12
- Help/play.hs +0/−201
- Help/plot.hs +0/−41
- Help/stat.hs +0/−35
- README +2/−2
- Setup.hs +3/−0
- Setup.lhs +0/−3
- Sound/Analysis/Meapsoft.hs +2/−3
- Sound/Analysis/Meapsoft/Header.hs +2/−2
- cmd/browse.hs +35/−0
- cmd/parser.hs +12/−0
- cmd/play.hs +201/−0
- cmd/plot.hs +46/−0
- cmd/stat.hs +38/−0
- hmeap.cabal +28/−10
- sh/extract.sh +13/−8
− Help/Makefile
@@ -1,10 +0,0 @@-all:- ghc --make -Wall -O2 browse- ghc --make -Wall -O2 parser- ghc --make -Wall -O2 play- ghc --make -Wall -O2 plot- ghc --make -Wall -O2 stat--clean:- rm -f *.o *.hi browse parser play plot stat- rm curve*.gp curve*.dat
− Help/browse.hs
@@ -1,35 +0,0 @@-import Control.Monad-import qualified Sound.Analysis.Meapsoft as M-import System.Environment-import System.IO--readMaybe :: Read a => String -> Maybe a-readMaybe s = case reads s of- [(x, "")] -> Just x- _ -> Nothing--readDef :: (Read a) => a -> String -> a-readDef x s = maybe x id (readMaybe s)--browse :: M.MEAP -> IO ()-browse m = do- putStr "feature> "- i <- fmap (readDef 0) getLine- putStr "frame> "- j <- fmap (readDef 0) getLine- let f = M.features m !! i- l = M.feature_column f- r = l + M.feature_degree f - 1- putStrLn (show ( "feature", f))- putStrLn (show ("chunk", map (\c -> M.position m (j, c)) [l..r]))--main :: IO ()-main = do- hSetBuffering stdout NoBuffering- a <- getArgs- unless (length a == 1) (error "feature-file")- let [f] = a- (Right m) <- M.read_meap f- putStrLn (show ("nframes", M.n_frames m,- "nfeatures", length (M.features m)))- forever (browse m)
− Help/parser.hs
@@ -1,12 +0,0 @@-import Control.Monad-import qualified Sound.Analysis.Meapsoft as M-import System.Environment--main :: IO ()-main = do- a <- getArgs- unless (length a == 1)- (error "analysis-file")- let [fn] = a- (Right h) <- M.read_header fn- putStrLn (show h)
− Help/play.hs
@@ -1,201 +0,0 @@-import Control.Monad-import Data.Function-import Data.List-import qualified Sound.Analysis.Meapsoft as M-import Sound.OpenSoundControl-import Sound.SC3-import System.Environment--grain :: UGen -> UGen-grain b = p * e- where s = Control KR "start" 0.0- d = Control KR "dur" 1.0- g = Control KR "gain" 1.0- r = bufRateScale KR b- q = bufSampleRate KR b- z = envTrapezoid 0.95 0.5 d g- e = envGen KR 1 1 0 1 RemoveSynth z- p = playBuf 1 b r 1 (s * q) NoLoop DoNothing--mk_grain :: (Transport t) => t -> Double -> Double -> IO ()-mk_grain fd s d =- let xs = [ ("start", s)- , ("dur", d) ]- in send fd (s_new "grain" (-1) AddToTail 1 xs)--tone :: UGen-tone = p * e- where f = Control KR "freq" 0.0- d = Control KR "dur" 1.0- g = Control KR "gain" 0.1- z = envTrapezoid 0.95 0.5 d g- e = envGen KR 1 1 0 1 RemoveSynth z- p = saw AR (MCE [f, f*2, f*3]) * (MCE [0.5, 0.2, 0.1])--mk_tone :: (Transport t) => t -> Double -> Double -> IO ()-mk_tone fd f d =- let xs = [ ("freq", f)- , ("dur", d) ]- in send fd (s_new "tone" (-1) AddToTail 1 xs)---- (Temporal_Scalar, [Segments], [Freq])-type Spec = (Double, [(Double, Double)], [Double])--plyr :: Transport t => t -> Spec -> IO ()-plyr _ (_, [], _) = return ()-plyr fd (t, (s,d):xs, f:fs) = do mk_grain fd s d- mk_tone fd f (d * t * 0.25)- pauseThread (d * t)- plyr fd (t, xs, fs)-plyr _ _ = undefined--run_grn :: FilePath -> FilePath -> (M.MEAP -> Spec) -> IO ()-run_grn sf ff rule = withSC3 g- where g fd = do reset fd- let g0 = out 0 (grain 10)- g1 = out 0 tone- async fd (b_allocRead 10 sf 0 0)- async fd (d_recv (synthdef "grain" g0))- async fd (d_recv (synthdef "tone" g1))- (Right m) <- M.read_meap ff- plyr fd (rule m)--col :: String -> M.MEAP -> [Double]-col n m =- let f = M.required_feature n (M.features m)- j = M.feature_column f- in M.column_l m j--freq_1 :: M.MEAP -> [Double]-freq_1 = col "AvgFreqSimple"---- forwards-rule_1 :: M.MEAP -> Spec-rule_1 c = (0.75, M.segments_l c, freq_1 c)--freq_2 :: M.MEAP -> [Double]-freq_2 = col "AvgSpecCentroid"---- backwards-rule_2 :: M.MEAP -> Spec-rule_2 c = (0.5, reverse (M.segments_l c), reverse (freq_2 c))--gen_order_1 :: M.MEAP -> String -> [Int]-gen_order_1 m f =- let cs = zip [0..] (col f m)- cs' = sortBy (compare `on` snd) cs- in map fst cs'--apply_order :: [Int] -> [a] -> [a]-apply_order o xs = map (\i -> xs !! i) o--srt_rule :: String -> (M.MEAP -> [Double]) -> M.MEAP -> Spec-srt_rule n r m =- let o = gen_order_1 m n- s = apply_order o (M.segments_l m)- f = apply_order o (r m)- in (0.5, s, f)---- sorted by segment length (ascending)-rule_3 :: M.MEAP -> Spec-rule_3 = srt_rule "chunk_length" freq_1---- sorted by frequency (ascending)-rule_4 :: M.MEAP -> Spec-rule_4 = srt_rule "AvgFreqSimple" freq_1---- sorted by spectral centroid (ascending)-rule_5 :: M.MEAP -> Spec-rule_5 = srt_rule "AvgSpecCentroid" freq_2---- sorted by spectral stability (ascending)-rule_6 :: M.MEAP -> Spec-rule_6 = srt_rule "SpectralStability" freq_2--gen_sel_1 :: M.MEAP -> String -> (Double -> Bool) -> [Int]-gen_sel_1 m f p =- let cs = zip [0..] (col f m)- cs' = filter (p . snd) cs- in map fst cs'--sel_rule :: String -> (Double -> Bool) -> (M.MEAP -> [Double]) -> M.MEAP -> Spec-sel_rule n p r m =- let o = gen_sel_1 m n p- s = apply_order o (M.segments_l m)- f = apply_order o (r m)- in (0.5, s, f)---- filtered by frequency (> 600)-rule_7 :: M.MEAP -> Spec-rule_7 = sel_rule "AvgFreqSimple" (> 600) freq_1---- filtered by spectral centroid (> 1200)-rule_8 :: M.MEAP -> Spec-rule_8 = sel_rule "AvgSpecCentroid" (> 1200) freq_2--interleave :: [a] -> [a] -> [a]-interleave [] b = b-interleave a [] = a-interleave (a:as) (b:bs) = a : b : interleave as bs---- interleaving of rules 4 & 5-rule_9 :: M.MEAP -> Spec-rule_9 m =- let (_, s4, f4) = rule_4 m- (_, s5, f5) = rule_5 m- in (0.75, interleave s4 s5, interleave f4 f5)--reverse_spec :: Spec -> Spec-reverse_spec (t, x, f) = (t, reverse x, reverse f)---- reverse of rule 9-rule_10 :: M.MEAP -> Spec-rule_10 = reverse_spec . rule_9--scale_start_only :: Double -> Spec -> Spec-scale_start_only n (t, x, f) = (t, map g x, f)- where g (s, d) = (s * n, d)---- rule 10 with start times compressed but durations kept equal-rule_11 :: M.MEAP -> Spec-rule_11 = (scale_start_only 0.5) . rule_10--scale_dur_only :: Double -> Spec -> Spec-scale_dur_only n (t, x, f) = (t, map g x, f)- where g (s, d) = (s, d * n)---- rule 7 with durations compressed but start times retained-rule_12 :: M.MEAP -> Spec-rule_12 = (scale_dur_only 0.5) . rule_7--fix_dur :: Double -> Spec -> Spec-fix_dur n (t, x, f) = (t, map g x, f)- where g (s, _) = (s, n)---- rule 7 with durations fixed at 0.25 seconds-rule_13 :: M.MEAP -> Spec-rule_13 = (fix_dur 0.25) . rule_7--rules :: [M.MEAP -> Spec]-rules = [ rule_1- , rule_2- , rule_3- , rule_4- , rule_5- , rule_6- , rule_7- , rule_8- , rule_9- , rule_10- , rule_11- , rule_12- , rule_13 ]--main :: IO ()-main = do- a <- getArgs- unless (length a == 3) (error "audio-file feature-file rule-number")- let [w_fn, f_fn, r] = a- rn = read r - 1- unless (rn >= 0 && rn < length rules) (error "unknown rule")- run_grn w_fn f_fn ( rules !! rn )
− Help/plot.hs
@@ -1,41 +0,0 @@--- Use hmatrix and gnuplot bindings to plot unit dimensioned features.--import Control.Monad-import Data.List-import qualified Data.Packed.Convert as G-import qualified Data.Packed.Matrix as G-import qualified Data.Packed.Vector as G-import qualified Graphics.Gnuplot.Simple as P-import qualified Numeric.GSL.Vector as G-import qualified Sound.Analysis.Meapsoft as M-import System.Environment-import System.IO--normalize :: G.Vector Double -> G.Vector Double-normalize v =- let l = G.vectorMin v- r = G.vectorMax v- d = r - l- v' = G.vectorMapValR G.AddConstant (negate l) v- in G.vectorMapValR G.Scale (recip d) v'--main :: IO ()-main =- do a <- getArgs- unless (length a > 1)- (error ("feature-file feature ..\n" ++ - show M.feature_names))- let (fn:ns) = a- (Right mp) <- M.read_meap fn- let fs = M.features mp- uf = map (\n -> M.required_feature n fs) ("onset_time":ns)- ar = M.uarray_data mp- m = G.matrixFromArray ar- ufc = map M.feature_column uf- vs = G.toRows (G.extractRows ufc (G.trans m))- vs' = map normalize vs- (ot:ls) = map G.toList vs'- ls' = map (zip ot) ls- P.plotPaths - [P.XLabel "onset_time", P.YLabel (intercalate "," ns)]- ls'
− Help/stat.hs
@@ -1,35 +0,0 @@--- Use hmatrix GSL bindings to do basic statistical analysis.--import Control.Monad-import Data.Function-import Data.List-import qualified Data.Packed.Convert as G-import qualified Data.Packed.Matrix as G-import qualified Data.Packed.Vector as G-import qualified Numeric.GSL.Vector as G-import qualified Sound.Analysis.Meapsoft as M-import System.Environment-import System.IO--main :: IO ()-main =- do a <- getArgs- unless (length a == 1)- (error "feature-file")- let [fn] = a- (Right mp) <- M.read_meap fn- let nf = fromIntegral (M.n_frames mp)- uf = filter ((== 1) . M.feature_degree) (M.features mp)- ar = M.uarray_data mp- m = G.matrixFromArray ar- ufc = map M.feature_column uf- vs = G.toRows (G.extractRows ufc (G.trans m))- r = zip5 (map M.feature_name uf)- (zip (map G.vectorMin vs)- (map G.vectorMinIndex vs))- (zip (map G.vectorMax vs)- (map G.vectorMaxIndex vs))- (zip (map (G.toScalarR G.AbsSum) vs)- (map (G.toScalarR G.Norm2) vs))- (map ((/ nf) . G.toScalarR G.AbsSum) vs)- mapM_ (putStrLn . show) r
README view
@@ -1,4 +1,4 @@-hmeap - Haskell Parser for Meapsoft Analysis Files+hmeap - Haskell Parser for Meapsoft 2.0 Analysis Files Supports analysis files with any number of features extracted. The help files illustrate use with@@ -7,7 +7,7 @@ meapsoft: http://labrosa.ee.columbia.edu/meapsoft/ hmeap: http://slavepianos.org/rd/ -(c) rohan drape and others, 2007-2010+(c) rohan drape and others, 2007-2011 gpl.2, http://gnu.org/copyleft/ with contributions by stefan kersten see darcs history for details
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
− Setup.lhs
@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain
Sound/Analysis/Meapsoft.hs view
@@ -14,9 +14,7 @@ , module Sound.Analysis.Meapsoft.Data , module Sound.Analysis.Meapsoft.Header ) where -import Control.Monad import Data.Array.Unboxed-import Data.List import Sound.Analysis.Meapsoft.Data import Sound.Analysis.Meapsoft.Header @@ -31,7 +29,8 @@ -- Indices are of the form (row, column). , uarray_data :: UArray (Int, Int) Double } --- | Load a MEAPsoft analysis file.+-- | Load a MEAPsoft analysis file, either a segmentation file or a+-- feature file. read_meap :: FilePath -> IO (Either String MEAP) read_meap fn = do r <- read_header fn
Sound/Analysis/Meapsoft/Header.hs view
@@ -55,9 +55,9 @@ in_paren :: P a -> P a in_paren p =- do { char '('+ do { _ <- char '(' ; r <- p- ; char ')'+ ; _ <- char ')' ; return r } int :: P Int
+ cmd/browse.hs view
@@ -0,0 +1,35 @@+import Control.Monad+import qualified Sound.Analysis.Meapsoft as M+import System.Environment+import System.IO++readMaybe :: Read a => String -> Maybe a+readMaybe s = case reads s of+ [(x, "")] -> Just x+ _ -> Nothing++readDef :: (Read a) => a -> String -> a+readDef x s = maybe x id (readMaybe s)++browse :: M.MEAP -> IO ()+browse m = do+ putStr "feature> "+ i <- fmap (readDef 0) getLine+ putStr "frame> "+ j <- fmap (readDef 0) getLine+ let f = M.features m !! i+ l = M.feature_column f+ r = l + M.feature_degree f - 1+ putStrLn (show ( "feature", f))+ putStrLn (show ("chunk", map (\c -> M.position m (j, c)) [l..r]))++main :: IO ()+main = do+ hSetBuffering stdout NoBuffering+ a <- getArgs+ unless (length a == 1) (error "feature-file")+ let [f] = a+ (Right m) <- M.read_meap f+ putStrLn (show ("nframes", M.n_frames m,+ "nfeatures", length (M.features m)))+ forever (browse m)
+ cmd/parser.hs view
@@ -0,0 +1,12 @@+import Control.Monad+import qualified Sound.Analysis.Meapsoft as M+import System.Environment++main :: IO ()+main = do+ a <- getArgs+ unless (length a == 1)+ (error "analysis-file")+ let [fn] = a+ (Right h) <- M.read_header fn+ putStrLn (show h)
+ cmd/play.hs view
@@ -0,0 +1,201 @@+import Control.Monad+import Data.Function+import Data.List+import qualified Sound.Analysis.Meapsoft as M+import Sound.OpenSoundControl+import Sound.SC3+import System.Environment++grain :: UGen -> UGen+grain b = p * e+ where s = control KR "start" 0.0+ d = control KR "dur" 1.0+ g = control KR "gain" 1.0+ r = bufRateScale KR b+ q = bufSampleRate KR b+ z = envTrapezoid 0.95 0.5 d g+ e = envGen KR 1 1 0 1 RemoveSynth z+ p = playBuf 1 b r 1 (s * q) NoLoop DoNothing++mk_grain :: (Transport t) => t -> Double -> Double -> IO ()+mk_grain fd s d =+ let xs = [ ("start", s)+ , ("dur", d) ]+ in send fd (s_new "grain" (-1) AddToTail 1 xs)++tone :: UGen+tone = p * e+ where f = control KR "freq" 0.0+ d = control KR "dur" 1.0+ g = control KR "gain" 0.1+ z = envTrapezoid 0.95 0.5 d g+ e = envGen KR 1 1 0 1 RemoveSynth z+ p = saw AR (MCE [f, f*2, f*3]) * (MCE [0.5, 0.2, 0.1])++mk_tone :: (Transport t) => t -> Double -> Double -> IO ()+mk_tone fd f d =+ let xs = [ ("freq", f)+ , ("dur", d) ]+ in send fd (s_new "tone" (-1) AddToTail 1 xs)++-- (Temporal_Scalar, [Segments], [Freq])+type Spec = (Double, [(Double, Double)], [Double])++plyr :: Transport t => t -> Spec -> IO ()+plyr _ (_, [], _) = return ()+plyr fd (t, (s,d):xs, f:fs) = do mk_grain fd s d+ mk_tone fd f (d * t * 0.25)+ pauseThread (d * t)+ plyr fd (t, xs, fs)+plyr _ _ = undefined++run_grn :: FilePath -> FilePath -> (M.MEAP -> Spec) -> IO ()+run_grn sf ff rule = withSC3 g+ where g fd = do reset fd+ let g0 = out 0 (grain 10)+ g1 = out 0 tone+ _ <- async fd (b_allocRead 10 sf 0 0)+ _ <- async fd (d_recv (synthdef "grain" g0))+ _ <- async fd (d_recv (synthdef "tone" g1))+ (Right m) <- M.read_meap ff+ plyr fd (rule m)++col :: String -> M.MEAP -> [Double]+col n m =+ let f = M.required_feature n (M.features m)+ j = M.feature_column f+ in M.column_l m j++freq_1 :: M.MEAP -> [Double]+freq_1 = col "AvgFreqSimple"++-- forwards+rule_1 :: M.MEAP -> Spec+rule_1 c = (0.75, M.segments_l c, freq_1 c)++freq_2 :: M.MEAP -> [Double]+freq_2 = col "AvgSpecCentroid"++-- backwards+rule_2 :: M.MEAP -> Spec+rule_2 c = (0.5, reverse (M.segments_l c), reverse (freq_2 c))++gen_order_1 :: M.MEAP -> String -> [Int]+gen_order_1 m f =+ let cs = zip [0..] (col f m)+ cs' = sortBy (compare `on` snd) cs+ in map fst cs'++apply_order :: [Int] -> [a] -> [a]+apply_order o xs = map (\i -> xs !! i) o++srt_rule :: String -> (M.MEAP -> [Double]) -> M.MEAP -> Spec+srt_rule n r m =+ let o = gen_order_1 m n+ s = apply_order o (M.segments_l m)+ f = apply_order o (r m)+ in (0.5, s, f)++-- sorted by segment length (ascending)+rule_3 :: M.MEAP -> Spec+rule_3 = srt_rule "chunk_length" freq_1++-- sorted by frequency (ascending)+rule_4 :: M.MEAP -> Spec+rule_4 = srt_rule "AvgFreqSimple" freq_1++-- sorted by spectral centroid (ascending)+rule_5 :: M.MEAP -> Spec+rule_5 = srt_rule "AvgSpecCentroid" freq_2++-- sorted by spectral stability (ascending)+rule_6 :: M.MEAP -> Spec+rule_6 = srt_rule "SpectralStability" freq_2++gen_sel_1 :: M.MEAP -> String -> (Double -> Bool) -> [Int]+gen_sel_1 m f p =+ let cs = zip [0..] (col f m)+ cs' = filter (p . snd) cs+ in map fst cs'++sel_rule :: String -> (Double -> Bool) -> (M.MEAP -> [Double]) -> M.MEAP -> Spec+sel_rule n p r m =+ let o = gen_sel_1 m n p+ s = apply_order o (M.segments_l m)+ f = apply_order o (r m)+ in (0.5, s, f)++-- filtered by frequency (> 600)+rule_7 :: M.MEAP -> Spec+rule_7 = sel_rule "AvgFreqSimple" (> 600) freq_1++-- filtered by spectral centroid (> 1200)+rule_8 :: M.MEAP -> Spec+rule_8 = sel_rule "AvgSpecCentroid" (> 1200) freq_2++interleave :: [a] -> [a] -> [a]+interleave [] b = b+interleave a [] = a+interleave (a:as) (b:bs) = a : b : interleave as bs++-- interleaving of rules 4 & 5+rule_9 :: M.MEAP -> Spec+rule_9 m =+ let (_, s4, f4) = rule_4 m+ (_, s5, f5) = rule_5 m+ in (0.75, interleave s4 s5, interleave f4 f5)++reverse_spec :: Spec -> Spec+reverse_spec (t, x, f) = (t, reverse x, reverse f)++-- reverse of rule 9+rule_10 :: M.MEAP -> Spec+rule_10 = reverse_spec . rule_9++scale_start_only :: Double -> Spec -> Spec+scale_start_only n (t, x, f) = (t, map g x, f)+ where g (s, d) = (s * n, d)++-- rule 10 with start times compressed but durations kept equal+rule_11 :: M.MEAP -> Spec+rule_11 = (scale_start_only 0.5) . rule_10++scale_dur_only :: Double -> Spec -> Spec+scale_dur_only n (t, x, f) = (t, map g x, f)+ where g (s, d) = (s, d * n)++-- rule 7 with durations compressed but start times retained+rule_12 :: M.MEAP -> Spec+rule_12 = (scale_dur_only 0.5) . rule_7++fix_dur :: Double -> Spec -> Spec+fix_dur n (t, x, f) = (t, map g x, f)+ where g (s, _) = (s, n)++-- rule 7 with durations fixed at 0.25 seconds+rule_13 :: M.MEAP -> Spec+rule_13 = (fix_dur 0.25) . rule_7++rules :: [M.MEAP -> Spec]+rules = [ rule_1+ , rule_2+ , rule_3+ , rule_4+ , rule_5+ , rule_6+ , rule_7+ , rule_8+ , rule_9+ , rule_10+ , rule_11+ , rule_12+ , rule_13 ]++main :: IO ()+main = do+ a <- getArgs+ unless (length a == 3) (error "audio-file feature-file rule-number")+ let [w_fn, f_fn, r] = a+ rn = read r - 1+ unless (rn >= 0 && rn < length rules) (error "unknown rule")+ run_grn w_fn f_fn ( rules !! rn )
+ cmd/plot.hs view
@@ -0,0 +1,46 @@+-- Use hmatrix and gnuplot bindings to plot unit dimensioned features.++import Control.Monad+import qualified Data.Array.Unboxed as A+import Data.List+import qualified Data.Packed.Matrix as G+import qualified Data.Packed.Vector as G+import qualified Graphics.Gnuplot.Simple as P+import qualified Numeric.Container as G+import qualified Sound.Analysis.Meapsoft as M+import System.Environment++normalize :: G.Vector Double -> G.Vector Double+normalize v =+ let l = G.minElement v+ r = G.maxElement v+ d = r - l+ v' = G.addConstant (negate l) v+ in G.scale (recip d) v'++fromArray :: A.UArray (Int, Int) Double -> G.Matrix Double+fromArray m = (r G.>< c) (A.elems m)+ where ((r0,c0),(r1,c1)) = A.bounds m+ r = r1-r0+1+ c = c1-c0+1++main :: IO ()+main =+ do a <- getArgs+ unless (length a > 1)+ (error ("feature-file feature ..\n" ++ + show M.feature_names))+ let (fn:ns) = a+ (Right mp) <- M.read_meap fn+ let fs = M.features mp+ uf = map (\n -> M.required_feature n fs) ("onset_time":ns)+ ar = M.uarray_data mp+ m = fromArray ar+ ufc = map M.feature_column uf+ vs = G.toRows (G.extractRows ufc (G.trans m))+ vs' = map normalize vs+ (ot:ls) = map G.toList vs'+ ls' = map (zip ot) ls+ P.plotPaths + [P.XLabel "onset_time", P.YLabel (intercalate "," ns)]+ ls'
+ cmd/stat.hs view
@@ -0,0 +1,38 @@+-- Use hmatrix GSL bindings to do basic statistical analysis.++import Control.Monad+import qualified Data.Array.Unboxed as A+import Data.List+import qualified Data.Packed.Matrix as G+import qualified Numeric.Container as G+import qualified Sound.Analysis.Meapsoft as M+import System.Environment++fromArray :: A.UArray (Int, Int) Double -> G.Matrix Double+fromArray m = (r G.>< c) (A.elems m)+ where ((r0,c0),(r1,c1)) = A.bounds m+ r = r1-r0+1+ c = c1-c0+1++main :: IO ()+main =+ do a <- getArgs+ unless (length a == 1)+ (error "feature-file")+ let [fn] = a+ (Right mp) <- M.read_meap fn+ let nf = fromIntegral (M.n_frames mp)+ uf = filter ((== 1) . M.feature_degree) (M.features mp)+ ar = M.uarray_data mp+ m = fromArray ar+ ufc = map M.feature_column uf+ vs = G.toRows (G.extractRows ufc (G.trans m))+ r = zip5 (map M.feature_name uf)+ (zip (map G.minElement vs)+ (map G.minIndex vs))+ (zip (map G.maxElement vs)+ (map G.maxIndex vs))+ (zip (map G.absSum vs)+ (map G.norm2 vs))+ (map ((/ nf) . G.absSum) vs)+ mapM_ (putStrLn . show) r
hmeap.cabal view
@@ -1,26 +1,20 @@ Name: hmeap-Version: 0.8+Version: 0.9 Synopsis: Haskell Meapsoft Parser Description: Parser for the anaylsis files produced by the Meapsoft feature extractor. License: GPL Category: Sound-Copyright: Rohan Drape, 2007-2010+Copyright: Rohan Drape and others, 2007-2011 Author: Rohan Drape Maintainer: rd@slavepianos.org Stability: Experimental Homepage: http://slavepianos.org/rd/?t=hmeap-Tested-With: GHC == 6.10.3+Tested-With: GHC == 6.12.1 Build-Type: Simple-Cabal-Version: >= 1.6+Cabal-Version: >= 1.8 Data-files: README- Help/browse.hs- Help/Makefile- Help/parser.hs- Help/play.hs- Help/plot.hs- Help/stat.hs sh/extract.sh Library@@ -36,6 +30,30 @@ Sound.Analysis.Meapsoft.Header Sound.Analysis.Meapsoft.Data +Executable hmeap-browse+ Main-Is: cmd/browse.hs+ Build-Depends: array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,hmeap==0.9,parsec++Executable hmeap-parser+ Main-Is: cmd/parser.hs+ Build-Depends: array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,hmeap==0.9,parsec++Executable hmeap-play+ Main-Is: cmd/play.hs+ Build-Depends: array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,hmeap==0.9,hosc==0.9,hsc3==0.9,parsec++Executable hmeap-plot+ Main-Is: cmd/plot.hs+ Build-Depends: array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,gnuplot,hmatrix,hmeap==0.9,parsec++Executable hmeap-stat+ Main-Is: cmd/stat.hs+ Build-Depends: array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,hmatrix,hmeap==0.9,parsec+ Source-Repository head Type: darcs Location: http://slavepianos.org/rd/sw/hmeap++-- Local Variables:+-- truncate-lines:t+-- End:
sh/extract.sh view
@@ -1,21 +1,26 @@ #!/bin/sh -if test $# != 2+if test $# != 3 then- echo "extract.sh meapsoft-jar audio-file"+ echo "extract.sh MEAPsoft.jar audio-file threshold" exit 0 fi -if test -d $1+if test -f $1 then- echo "meapsoft dir: " $1+ echo "MEAPsoft.jar: " $1 else- echo "non-existant meapsoft dir: " $1+ echo "non-existant MEAPsoft.jar: " $1 exit 1 fi echo "file to analyse: " $2 $2.seg $2.feat+echo "threshold: " $3 +# -t = threshold (0.0 -> 3.0), lower values are more sensitive+# -s = smoothing window (seconds)+# -d = event detector (not beat detector)+ if test -f $2.seg then echo "$2.seg exists"@@ -25,13 +30,13 @@ com.meapsoft.Segmenter \ -o $2.seg \ $2 \- -t 1.0 \+ -t $3 \ -s 0.1 \ -d fi -# Xms = initial heap size-# Xmx = maximum heap size+# -Xms = initial heap size+# -Xmx = maximum heap size java \ -Xms128m \