packages feed

hmeap-utils (empty) → 0.10

raw patch · 9 files changed

+455/−0 lines, 9 filesdep +arraydep +basedep +bytestringsetup-changed

Dependencies added: array, base, bytestring, bytestring-lexing, delimited-text, gnuplot, hmatrix, hmeap, hosc, hsc3, parsec

Files

+ README view
@@ -0,0 +1,12 @@+hmeap-utils - hmeap utilities++Simple hmeap utilities that illustrate hmeap use with+hmatrix, gnuplot and hsc3.++  meapsoft: http://labrosa.ee.columbia.edu/meapsoft/+  hmeap: http://slavepianos.org/rd/++(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
+ 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-utils.cabal view
@@ -0,0 +1,45 @@+Name:              hmeap-utils+Version:           0.10+Synopsis:          Haskell Meapsoft Parser Utilities+Description:       Utilities related to the hmeap parser.+License:           GPL+Category:          Sound+Copyright:         Rohan Drape and others, 2007-2011+Author:            Rohan Drape+Maintainer:        rd@slavepianos.org+Stability:         Experimental+Homepage:          http://slavepianos.org/rd/?t=hmeap-utils+Tested-With:       GHC == 6.12.1+Build-Type:        Simple+Cabal-Version:     >= 1.8++Data-files:        README+                   sh/extract.sh++Executable         hmeap-browse+ Main-Is:          cmd/browse.hs+ Build-Depends:    array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,hmeap==0.10,parsec++Executable         hmeap-parser+ Main-Is:          cmd/parser.hs+ Build-Depends:    array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,hmeap==0.10,parsec++Executable         hmeap-play+ Main-Is:          cmd/play.hs+ Build-Depends:    array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,hmeap==0.10,hosc,hsc3,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.10,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.10,parsec++Source-Repository  head+  Type:            darcs+  Location:        http://slavepianos.org/rd/sw/hmeap-utils++-- Local Variables:+-- truncate-lines:t+-- End:
+ sh/extract.sh view
@@ -0,0 +1,63 @@+#!/bin/sh++if test $# != 3+then+    echo "extract.sh MEAPsoft.jar audio-file threshold"+    exit 0+fi++if test -f $1+then+  echo "MEAPsoft.jar: " $1+else+  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"+else+    java \+        -cp $1 \+        com.meapsoft.Segmenter \+        -o $2.seg \+        $2 \+        -t $3 \+        -s 0.1 \+        -d+fi++# -Xms = initial heap size+# -Xmx = maximum heap size++java \+    -Xms128m \+    -Xmx512m \+    -cp $1 \+    com.meapsoft.FeatExtractor \+    -f AvgChroma \+    -f AvgChromaScalar \+    -f AvgChunkPower \+    -f AvgFreqSimple \+    -f AvgMelSpec \+    -f AvgMFCC \+    -f AvgPitch \+    -f AvgSpec \+    -f AvgSpecCentroid \+    -f AvgSpecFlatness \+    -f AvgTonalCentroid \+    -f ChunkLength \+    -f ChunkStartTime \+    -f Entropy \+    -f RMSAmplitude \+    -f SpectralStability \+    $2.seg \+    -o $2.feat