packages feed

hmeap (empty) → 0.6

raw patch · 9 files changed

+373/−0 lines, 9 filesdep +basesetup-changed

Dependencies added: base

Files

+ Help/Makefile view
@@ -0,0 +1,7 @@+all:+	ghc --make -Wall -O2 browse+	ghc --make -Wall -O2 parse+	ghc --make -Wall -O2 play++clean:+	rm *.o *.hi browse parse play
+ Help/browse.hs view
@@ -0,0 +1,33 @@+import Control.Monad+import qualified Data.IntMap as Map+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 :: Map.IntMap M.Frame -> IO ()+browse f = do putStr "feature> "+              n <- fmap (readDef 0) getLine+              putStr "chunk> "+              m <- fmap (readDef 0) getLine+              putStrLn (show ( "feature", n, M.features !! n+                             , "chunk", m ))+              let (_, _, d) = M.raw_data (f Map.! m)+              putStrLn (show (d !! n))++main :: IO ()+main = do hSetBuffering stdout NoBuffering+          a <- getArgs+          unless (length a == 1) (error "feature-file")+          let [f] = a+          fs <- M.read_file f+          putStrLn (show ("nframes", length fs, "nfeatures", length M.features))+          let m = Map.fromList (zip [0..] fs)+          forever (browse m)
+ Help/parse.hs view
@@ -0,0 +1,23 @@+import Control.Monad+import Data.List+import qualified Sound.Analysis.Meapsoft as M+import System.Environment+import System.FilePath+import System.IO++replace :: Eq a => a -> a -> [a] -> [a]+replace _ _ [] = []+replace a b (x:xs) | x == a = b : replace a b xs+                   | otherwise = x : replace a b xs++main :: IO ()+main = do+  a <- getArgs+  unless (length a == 1) (error "analysis-file")+  let [fn] = a+      vn = replace '-' '_' (dropExtensions (takeFileName fn))+  fs <- M.read_file fn+  putStrLn ("-- " ++ fn)+  putStrLn "import Sound.Analysis.Meapsoft"+  putStrLn (vn ++ " :: [Frame]")+  putStrLn (vn ++ " = " ++ show fs)
+ Help/play.hs view
@@ -0,0 +1,149 @@+import Control.Monad+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++mk_grain :: (Transport t) => t -> Double -> Double -> IO ()+mk_grain fd s d = send fd (s_new "grain" (-1) AddToTail 1 [ ("start", s)+                                                          , ("dur", d) ])++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 = send fd (s_new "tone" (-1) AddToTail 1 [ ("freq", f)+                                                        , ("dur", d) ])++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++interleave :: [a] -> [a] -> [a]+interleave [] b = b+interleave a [] = a+interleave (a:as) (b:bs) = a : b : interleave as bs++run_grn :: FilePath -> FilePath -> ([M.Frame] -> 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))+                    c <- M.read_file ff+                    plyr fd (rule c)++freq_1 :: [M.Frame] -> [Double]+freq_1 = map M.avg_freq_simple++freq_2 :: [M.Frame] -> [Double]+freq_2 = map M.avg_spec_centroid++rule_1 :: [M.Frame] -> Spec+rule_1 c = (0.75, M.segments c, freq_1 c)++rule_2 :: [M.Frame] -> Spec+rule_2 c = (0.75, reverse (M.segments c), freq_2 c)++rule_3 :: [M.Frame] -> Spec+rule_3 c = (0.75, sortBy f (M.segments c), freq_1 c)+    where f (_, d1) (_, d2) = compare d1 d2++rule_4 :: [M.Frame] -> Spec+rule_4 c = (0.75, interleave s (reverse s), freq_1 c)+    where f (_, d1) (_, d2) = compare d1 d2+          s = sortBy f (M.segments c)++with_times :: (M.Frame -> a) -> M.Frame -> (Double, Double, a)+with_times f c = (M.onset_time c, M.duration c, f c)++rule_5 :: [M.Frame] -> Spec+rule_5 cs = (0.75, map g x1, map h x1)+    where f (_, _, c1) (_, _, c2) = compare c1 c2+          g (t, d, _) = (t, d)+          h (_, _, fr) = fr+          x0 = map (with_times M.avg_spec_centroid) cs+          x1 = sortBy f x0++reverse_spec :: Spec -> Spec+reverse_spec (t, x, f) = (t, reverse x, reverse f)++rule_6 :: [M.Frame] -> Spec+rule_6 = reverse_spec . rule_5++rule_7 :: [M.Frame] -> Spec+rule_7 cs = (0.75, map g x1, map h x1)+    where f (_, _, c1) (_, _, c2) = compare c1 c2+          g (t, d, _) = (t, d)+          h (_, _, fr) = fr+          x0 = map (with_times M.avg_freq_simple) cs+          x1 = sortBy f x0++rule_8 :: [M.Frame] -> Spec+rule_8 = reverse_spec . rule_7++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_9 :: [M.Frame] -> Spec+rule_9 = (scale_start_only 0.75) . rule_7++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_10 :: [M.Frame] -> Spec+rule_10 = (scale_dur_only 0.65) . rule_7++fix_dur :: Double -> Spec -> Spec+fix_dur n (t, x, f) = (t, map g x, f)+    where g (s, _) = (s, n)++rule_11 :: [M.Frame] -> Spec+rule_11 = (fix_dur 0.075) . rule_7++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 < 11) (error "unknown rule")+  run_grn w_fn f_fn ( [ rule_1+                      , rule_2+                      , rule_3+                      , rule_4+                      , rule_5+                      , rule_6+                      , rule_7+                      , rule_8+                      , rule_9+                      , rule_10+                      , rule_11 ] !! rn)
+ README view
@@ -0,0 +1,10 @@+hmeap - Haskell Parser for Meapsoft Analysis Files++At present only supports analysis files with all+features extracted.++  meapsoft: http://labrosa.ee.columbia.edu/meapsoft/+  hmeap: http://slavepianos.org/rd/f/896678/++(c) rohan drape, 2007-2008+    GPL.2, http://gnu.org/copyleft/
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ Sound/Analysis/Meapsoft.hs view
@@ -0,0 +1,108 @@+-- | A data representation of, and parser for, MEAPsoft analysis frames.+module Sound.Analysis.Meapsoft ( Frame(..), Segment+                               , features+                               , read_file+                               , segments) where++import Control.Monad+import System.IO++-- | The data type representing an analysis frame.+data Frame = Frame { +    -- | Onset time of frame (seconds).+    onset_time :: Double+    -- | Duration of frame (seconds).+    , duration :: Double+    -- | Mean spectrum converted to the perceptually weighted Mel+    --   frequency scale.+    , avg_mel_spec :: [Double]+    -- | Vector of energy distribution across each semitone of the+    --   octave.+    , avg_chroma :: [Double]+    -- | Average power.+    , avg_chunk_power :: Double+    -- | Dominant semitone within the octave.+    , avg_chroma_scalar :: Double+    -- | A frequency estimation.+    , avg_freq_simple :: Double+    -- | Mean MFCCs, a commonly used feature in speech recognition.+    , avg_mfcc :: [Double]+    -- | Pitch estimation.+    , avg_pitch_simple :: Double+    -- | Average spectral center of mass of the frame.+    , avg_spec_centroid :: Double+    -- | Measure of flatness of the average spectrum.+    , avg_spec_flatness :: Double+    -- | Mean spectrum.+    , avg_spec :: [Double]+    -- | Length of analysis frame (sample frames).+    , chunk_length :: Double+    -- | Start time of analysis frame (sample frames).+    , chunk_start_time :: Double+    -- | The stability of the spectral energy.  More spectrally stable+    --   frames are more likely to be pitched material.+    , spectral_stability :: Double +    , raw_data :: (Double, Double, [[Double]]) }+             deriving (Show, Read)++-- | A segment is a pair (onset_time, duration).+type Segment = (Double, Double)++-- | Extract frame timing information.+segments :: [Frame] -> [Segment]+segments = map (\c -> (onset_time c, duration c))++-- | As association list indicating the number of data values+--   associated with each feature type.+features :: [(String, Int)]+features = [ ("AvgMelSpec", 40)+           , ("AvgChroma", 12)+           , ("AvgFramePower", 1)+           , ("AvgChromaScalar", 1)+           , ("AvgFreqSimple", 1)+           , ("AvgMFCC", 13)+           , ("AvgPitchSimple", 1)+           , ("AvgSpecCentroid", 1)+           , ("AvgSpecFlatness", 1)+           , ("AvgSpec", 513)+           , ("FrameLength", 1)+           , ("FrameStartTime", 1)+           , ("SpectralStability", 1) ]++-- | Read a MEAPsoft analysis file.+read_file :: FilePath -> IO [Frame]+read_file f =+    do h <- openFile f ReadMode+       t <- hGetContents h+       let l = drop 2 (lines t)+       return (map parse_frame l)++form_groups :: [Int] -> [a] -> [[a]]+form_groups [] _ = []+form_groups (n:ns) l = a : form_groups ns b+    where (a, b) = splitAt n l++type Chunk = (Double, Double, [[Double]])++make_chunk :: [Double] -> Chunk+make_chunk (o:t:f) = (o, t, form_groups (map snd features) f)+make_chunk _ = error "misformed data"++make_frame :: Chunk -> Frame+make_frame c@(o, t, [ f1, f2, [f3], [f4], [f5]+                    , f6, [f7], [f8], [f9], f10+                    , [f11], [f12], [f13] ]) =+    Frame o t f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 c+make_frame _ = error "make_frame"++split_on :: (Eq a) => a -> [a] -> [[a]]+split_on x xs = l' ++ r'+    where (l, r) = span (/= x) xs+          l' = if null l then [] else [l]+          r' = if null r then [] else split_on x (tail r)++to_f :: String -> Double+to_f = read++parse_frame :: String -> Frame+parse_frame = make_frame . make_chunk . map to_f . drop 1 . split_on ' '
+ Sound/Analysis/Meapsoft/Measure.hs view
@@ -0,0 +1,13 @@+module Sound.Analysis.Meapsoft.Measure where++-- | Cycles per second to MEL conversion, see Stevens & Volkman, 1940.+cps_mel :: Double -> Double+cps_mel f = 1127.01048 * log (f / 700 + 1)++-- | MEL to cycles per second conversion, see Stevens & Volkman, 1940.+mel_cps :: Double -> Double+mel_cps m = 700 * (exp (m / 1127.01048) - 1)++-- | Cycles per second to ERB conversion, see Glasberg & Moore, 1990, p. 114.+cps_erb :: Double -> Double+cps_erb f = 21.4 * logBase 10 (0.00437 * f + 1)
+ hmeap.cabal view
@@ -0,0 +1,27 @@+Name:              hmeap+Version:           0.6+Synopsis:          Haskell Meapsoft Parser+Description:       Parser for the anaylsis files produced by the Meapsoft +                   feature extractor.+License:           GPL+Category:          Sound+Copyright:         Rohan Drape, 2007-2008+Author:            Rohan Drape+Maintainer:        rd@slavepianos.org+Stability:         Experimental+Homepage:          http://slavepianos.org/rd/f/896678/+Tested-With:       GHC==6.10.1+Build-Type:        Simple+Cabal-Version:     >= 1.2++Data-files:        README+                   Help/browse.hs+                   Help/Makefile+                   Help/parse.hs+                   Help/play.hs++Library+  Build-Depends:   base+  GHC-Options:     -Wall -fwarn-tabs+  Exposed-modules: Sound.Analysis.Meapsoft+                   Sound.Analysis.Meapsoft.Measure