HarmTrace (empty) → 0.1
raw patch · 4 files changed
+242/−0 lines, 4 filesdep +Diffdep +ListLikedep +arraybuild-type:Customsetup-changed
Dependencies added: Diff, ListLike, array, base, containers, deepseq, directory, filepath, ghc-prim, mtl, parallel, parseargs, process, regex-tdfa, syb, template-haskell, uu-parsinglib, vector
Files
- HarmTrace.cabal +43/−0
- LICENSE +1/−0
- Main.hs +173/−0
- Setup.hs +25/−0
+ HarmTrace.cabal view
@@ -0,0 +1,43 @@+name: HarmTrace+version: 0.1+synopsis: HarmTrace: Harmony Analysis and Retrieval of Music + with Type-level Representations of Abstract+ Chords Entities+description: This is the first public release of HarmTrace, a system+ for automatically analysing the harmony of music+ sequences. HarmTrace is described in the paper:+ .+ * José Pedro Magalhães and W. Bas de Haas.+ /Experience Report: Functional Modelling of Musical Harmony./+ International Conference on Functional Programming,+ 2011.+ <http://dreixel.net/research/pdf/fmmh.pdf>++copyright: (c) 2010--2011 Universiteit Utrecht+license: OtherLicense+license-file: LICENSE+author: W. Bas de Haas and José Pedro Magalhães+stability: experimental+maintainer: bash@cs.uu.nl, jpm@cs.uu.nl+category: Music+build-type: Custom+cabal-version: >= 1.6+tested-with: GHC == 7.0.3++executable mir+ hs-source-dirs: .+ main-is: Main.hs+ build-depends: base >= 4.2 && < 4.4, template-haskell >=2.4 && <2.6,+ mtl, directory, filepath, array, parallel >= 3,+ Diff == 0.1.*, parseargs >= 0.1.3.2, + regex-tdfa == 1.1.*, process >= 1.0,+ uu-parsinglib == 2.7.1, ListLike >= 3.0.1,+ vector == 0.7.*, deepseq,+ -- temporary+ containers, syb, ghc-prim+ ghc-options: -Wall+ -O2 -fno-spec-constr-count -funbox-strict-fields+ -fcontext-stack=50+ -threaded -feager-blackholing -rtsopts++ ghc-prof-options: -auto-all
+ LICENSE view
@@ -0,0 +1,1 @@+This work is licensed under the Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. To view a copy of this license, visit http://creativecommons.org/licenses/by-nc-sa/3.0/ or send a letter to Creative Commons, 444 Castro Street, Suite 900, Mountain View, California, 94041, USA.
+ Main.hs view
@@ -0,0 +1,173 @@+{-# OPTIONS_GHC -Wall #-}++module Main where++-- Libs+import System.Console.ParseArgs hiding (args) -- cabal install parseargs+import System.FilePath+import System.IO+import Data.Maybe (isJust, fromJust)+import Data.List (unzip4)+import Control.Monad (when)++-- Music stuff+import MIR.Run++-- Parallelism+import Control.Parallel.Strategies++--------------------------------------------------------------------------------+-- Command-line arguments+--------------------------------------------------------------------------------++data MyArgs = SourceInputString | SourceInputFile | TargetInputFile + | InputDir | OpMode | Print | MaxErrorRate | WriteGT+ deriving (Eq, Ord, Show)++myArgs :: [Arg MyArgs]+myArgs = [+ Arg { argIndex = MaxErrorRate,+ argAbbr = Just 'e',+ argName = Just "max-error",+ argData = argDataOptional "float" ArgtypeFloat,+ argDesc = "Ignore pieces with higher error rate for diff"+ },+ Arg { argIndex = SourceInputString,+ argAbbr = Just 'c',+ argName = Just "chords",+ argData = argDataOptional "string" ArgtypeString,+ argDesc = "Input Chord Sequence to parse"+ },+ Arg { argIndex = SourceInputFile,+ argAbbr = Just '1',+ argName = Just "sfile",+ argData = argDataOptional "filepath" ArgtypeString,+ argDesc = "Input file (source for diff)"+ },+ Arg { argIndex = TargetInputFile,+ argAbbr = Just '2',+ argName = Just "tfile",+ argData = argDataOptional "filepath" ArgtypeString,+ argDesc = "Input file (target for diff)"+ },+ Arg { argIndex = InputDir,+ argAbbr = Just 'd',+ argName = Just "dir",+ argData = argDataOptional "directory" ArgtypeString,+ argDesc = "Input directory (to process all files within)"+ },+ Arg { argIndex = OpMode,+ argAbbr = Just 'm',+ argName = Just "mode",+ argData = argDataRequired "parse|gdiff|stdiff"+ ArgtypeString,+ argDesc = "One of \"parse\", \"diff\", or \"stdiff\""+ },+ Arg { argIndex = Print,+ argAbbr = Just 'p',+ argName = Just "print",+ argData = Nothing,+ argDesc = "Set this flag to generate a .png for an input file"+ },+ Arg { argIndex = WriteGT,+ argAbbr = Just 'g',+ argName = Just "writegt",+ argData = argDataOptional "filepath" ArgtypeString,+ argDesc = "Write ground truth to file"+ }+ ]++--------------------------------------------------------------------------------+-- Main+--------------------------------------------------------------------------------+++data MatchMode = STDiff | GDiff+ deriving (Eq, Ord, Show)++err1, err2, err3 :: String+err1 = "Use a source file, or a directory."+err2 = "Use a source file and a target file, or a directory."+err3 = "Use a source file and optionally a target file."++main :: IO ()+main = do args <- parseArgsIO ArgsComplete myArgs+ let mode = getRequiredArg args OpMode+ prnt = gotArg args Print+ case mode of+ "parse" -> mainParse prnt+ "gdiff" -> mainDiff False GDiff -- diffs cannot be printed+ "stdiff" -> mainDiff False STDiff+ s -> usageError args ("Unknown mode: " ++ s)++mainParse :: Bool -> IO ()+mainParse p = do args <- parseArgsIO ArgsComplete myArgs+ -- cdir <- getCurrentDirectory+ let cStr = getArgString args SourceInputString+ mf1 = getArgString args SourceInputFile+ mf2 = getArgString args TargetInputFile+ mdir = getArgString args InputDir+ case (cStr, mf1,mf2,mdir, p) of+ -- parse a string of chords+ (Just c, Nothing, Nothing, Nothing , False) + -> parseTree c+ -- Parse one file, show full output+ (Nothing, Just f1, Nothing, Nothing , False) + -> readFile' f1 >>= parseTree+ -- Parse all files in one dir, show condensed output+ (Nothing, Nothing, Nothing, Just dir, False) + -> testDir dir+ _ -> usageError args err1 ++ + +mainDiff :: Bool -> MatchMode -> IO ()+mainDiff p m =+ do args <- parseArgsIO ArgsComplete myArgs+ let mf1 = getArg args SourceInputFile+ mf2 = getArg args TargetInputFile+ mdir = getArg args InputDir+ me = getArg args MaxErrorRate+ gt = getArg args WriteGT+ case (mf1,mf2,mdir,p) of+ -- Parse source and target file, show full output+ (Just f1, Just f2, Nothing, False) -> diff m f1 f2+ -- Diff all files in one dir, show condensed output+ (Nothing, Nothing, Just dir, False) -> testDirMatch m me gt dir + _ -> usageError args err2++diff :: MatchMode -> String -> String -> IO ()+diff m f1 f2 = do (toks1, ts1, _, _) <- readFile' f1 >>= return . string2PieceC+ (toks2, ts2, _, _) <- readFile' f2 >>= return . string2PieceC+ case m of+ STDiff -> putStrLn (diffChords toks1 toks2)+ GDiff -> print (diffPiece (head ts1) (head ts2))+ + +filterNonQuery :: [FilePath] -> [FilePath] +filterNonQuery = concat . map snd . filter ((>1) . length . snd) . getClassSizes++testDirMatch :: MatchMode -> Maybe Float -> Maybe FilePath -> FilePath -> IO ()+testDirMatch m me od fp = + do fs <- readDataDir fp+ let process f = do s <- readFile' (fp </> f)+ let (toks, ps, _, errs) = string2PieceC s+ return (f, toks, head ps, errorRatio errs toks)+ (fs', toks, ps, errs) <- fmap unzip4 (mapM process fs)+ when (isJust od) $ writeGroundTruth fs' (fromJust od)+ let fsq = filterNonQuery fs'+ putStr "true\ntrue\n"+ mapM_ (putStr . (++ "\t")) fsq+ putChar '\n'+ mapM_ (putStr . (++ "\t"). getId) fs'+ putStrLn ""+ let runDiff df l = [ [ df me ex ey x y | (y,ey) <- l ]+ | ((x,ex),i) <- zip l (map getId fs'), i `elem` fsq ]+ printLine l = putStrLn (foldr (\a b -> showFloat a ++ "\t" ++ b) "" l)+ >> hFlush stdout+ undf = error "stdiff should not inspect parsing results"+ let r = case m of+ STDiff -> runDiff diffChordsLen (zip toks (repeat undf))+ GDiff -> runDiff diffPieceLen (zip ps errs)+ `using` parList rdeepseq+ sequence_ [ printLine x | x <- r]
+ Setup.hs view
@@ -0,0 +1,25 @@+module Main (main) where++import Distribution.Simple+import System.FilePath ((</>))+import System.Cmd (system)+import System.IO (hFlush, stdout)+import System.Exit+import System.Directory++main :: IO ()+main = defaultMainWithHooks (simpleUserHooks { postConf = mypostConf })++mypostConf a f d b = let path = "MIR" </> "GeneratedInstances"+ file = "GenerateInstances.hs"+ ghc = "ghc "+ flags = "-e main "+ in do putStr "Generating instances..." + hFlush stdout+ setCurrentDirectory path+ ec <- system (ghc ++ flags ++ file)+ case ec of+ ExitSuccess -> putStrLn " done."+ ExitFailure _ -> putStrLn " failed!" >> exitWith ec+ postConf simpleUserHooks a f d b+