{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveFunctor #-} -------------------------------------------------------------------------------- -- | -- Module : HarmTrace.Base.MusicTime -- Copyright : (c) 2012--2013 W. Bas de Haas and Jose Pedro Magalhaes -- License : LGPL-3 -- -- Maintainer : bas@chordify.net, dreixel@chordify.net -- Stability : experimental -- Portability : non-portable -- -- Summary: A set of types and classes for representing musical time, mainly -- (but not necessarily) in the context of recognising chords -- from an arbitrary audio source. -------------------------------------------------------------------------------- module HarmTrace.Base.MusicTime ( -- * Datatypes -- ** Types for representing Chords and their probabilities ChordAnnotation , ProbChordSeg (..) , ProbChord (..) , ChordCand (..) -- ** Representing musical time , TimedData (..) , Beat (..) , BarTime (..) , BarTimeTrackData , NumData -- ** Representing raw audio data , AudioFeat (..) , ChordinoData , ChordinoLine (..) , KeyStrengthData , BeatTrackerData , BeatChroma , ChordStruct -- * Functions -- ** Data access , timedData , timedDataBT , getBarTime , getBeat , onset , offset , setData -- ** Type conversion and other utilities , getBeatTrack , concatTimedData , nextBeat , prevBeat , updateTPChord , dropProb , dropTimed , timeStamp , beat ) where import HarmTrace.Base.MusicRep -- | When reducing and expaninding 'TimedData' types there might be rounding -- errors in the floating point time stamps. The 'roundingError' parameter -- sets the acceptable rounding error that is used in the comparison of -- time stamps (e.g. see 'timeComp') roundingError :: NumData roundingError = 0.0001 -- = one milisecond -- | A type synonym is defined for our main numerical representation, this -- allows us to easily change the precision. type NumData = Double -------------------------------------------------------------------------------- -- High-level structure -------------------------------------------------------------------------------- -- | A chord annotation consists of a -- list with chords and segment boundaries. type ChordAnnotation = [TimedData ProbChord] -- | A datatype that wraps around an (musical) datatype, adding information -- about the musical time to this datatype. Musical time is stored as -- a list of 'BarTime' time stamps that can optionally be augmented -- with information about the 'Beat' position of the particular time stamp -- inside the bar. data TimedData a = TimedData { -- | Returns the contained datatype getData :: a -- | Returns the list of TimeStamps , getTimeStamps :: [BarTime] } deriving (Functor, Show, Eq) -- | Clustering 'ProbChord's in a collection of chords that share a key data ProbChordSeg = Segment { segKey :: Key , segChords :: [TimedData [ProbChord]] } deriving (Show, Eq) -- | Combines a 'ChordLabel' with a probability. data ProbChord = ProbChord { chordLab :: ChordLabel , prob :: NumData } -- | A chord candidate: an intermediate datatype that matches shorthand, -- chord structure and root note (plus inversion) data ChordCand = ChordCand { originalRootCC :: Root , inversionRootCC :: Root , shorthardCC :: Shorthand , chordStructCC :: ChordStruct } deriving (Show, Eq) -- | A chord template is list of 'NumData's type ChordStruct = [NumData] -- | For now, we fix the number of available beats to four, because this is also -- hard-coded into the bar and beat-tracker. data Beat = One | Two | Three | Four | NoBeat deriving (Eq, Enum) -------------------------------------------------------------------------------- -- Instances of high-level data structure -------------------------------------------------------------------------------- -- TODO to be replaced by a deriving instance instance Eq (ProbChord) where a == b = chordLab a == chordLab b instance Show (ProbChord) where show (ProbChord c _p) = show c -- ++ ':' : printf "%.2f" p instance Show Beat where show One = "1" show Two = "2" show Three = "3" show Four = "4" show NoBeat = "x" instance Show BarTime where show (BarTime t bt) = '(' : show t ++ ", " ++ show bt ++ ")" show (Time t) = '(' : show t ++ ")" -------------------------------------------------------------------------------- -- numerical data representation -------------------------------------------------------------------------------- -- | Groups the three types of VAMP plug-in data: 'ChordinoData', -- 'BarTimeTrackData', and 'KeyStrengthData'. See for more information: -- -- * -- -- * -- -- * data AudioFeat = AudioFeat { getChroma :: ChordinoData , getBeats :: BarTimeTrackData , getKeys :: KeyStrengthData , getAudioFeatId :: FilePath} type ChordinoData = [ChordinoLine] -- | Represents two chroma features and a time stamp. data ChordinoLine = ChordinoLine -- TODO remove useless type synonym { -- | Returns the time stamp of the chroma features time :: NumData -- | Returns the bass chroma feature , bass :: [NumData] -- each of the lists has always 12 elements -- | Returns the treble chroma feature , treb :: [NumData] -- A, Bb, B, C, Db, D, Eb, E, F, F#, G, Ab } deriving (Eq, Show) -- and is shifted 3 positions to match C, Db, .., B type KeyStrengthData = ChordinoData type BeatTrackerData = [NumData] -- TODO Rename to BeatTime -- | Represents a musical time stamp, which is a 'NumData' possibly augmented -- with a 'Beat' denoting the position of the time stamp within a bar. data BarTime = BarTime NumData Beat | Time NumData deriving Eq type BarTimeTrackData = [BarTime] type BeatChroma = TimedData [ChordinoLine] -- one list per beat -- we compare based on the timestamp only instance Ord BarTime where compare a b = compare (timeStamp a) (timeStamp b) -------------------------------------------------------------------------------- -- Some type conversion utilities -------------------------------------------------------------------------------- -- | alternative 'TimedData' constructor timedData :: a -> NumData -> NumData -> TimedData a timedData d x y = TimedData d [Time x, Time y] -- | alternative 'TimedData' constructor timedDataBT :: a -> BarTime -> BarTime -> TimedData a timedDataBT d x y = TimedData d [x, y] -- | concatenates the 'BarTime' timestamps of two 'TimedData's and -- creates a new 'TimedData' that stores the first argument. concatTimedData :: a -> TimedData a -> TimedData a -> TimedData a concatTimedData dat (TimedData _ ta) (TimedData _ tb) = TimedData dat (mergeBeatTime ta tb) where mergeBeatTime :: [BarTime] -> [BarTime] -> [BarTime] mergeBeatTime [] b = b mergeBeatTime a [] = a mergeBeatTime a b = case timeComp (timeStamp . last $ a) (timeStamp . head $ b) of GT -> error ("HarmTrace.Base.MusicTime.mergeBeatTime: " ++ "cannot merge BeatTimes " ++ show a ++ " and " ++ show b) EQ -> a ++ tail b -- do not include the same timestamp twice LT -> a ++ b -- | compares to 'NumData' timestamps taking a rounding error 'roundingError' -- into account. timeComp :: NumData -> NumData -> Ordering timeComp a b | a > (b + roundingError) = GT | a < (b - roundingError) = LT | otherwise = EQ -- | Converts 'BarTimeTrackData' into 'BeatTrackerData' getBeatTrack :: BarTimeTrackData -> BeatTrackerData getBeatTrack = map timeStamp -- | wraps a datatype in 'TimedData' setData :: TimedData a -> b -> TimedData b setData td d = td {getData = d} -- | Returns the start time stamp getBarTime :: TimedData a -> BarTime getBarTime td = case getTimeStamps td of [] -> error "HarmTrace.Base.MusicTime.getBarTime: no timestamps are stored" (h:_) -> h -- | Returns the start 'Beat' getBeat :: TimedData a -> Beat getBeat = beat . getBarTime -- | Returns the 'NumData' timestamp, given a 'BarTime' timeStamp :: BarTime -> NumData timeStamp (BarTime t _bt) = t timeStamp (Time t ) = t -- | Returns the 'NumData' timestamp, given a 'BarTime' beat :: BarTime -> Beat beat (BarTime _t bt) = bt beat (Time _t ) = NoBeat -- | Returns the onset time stamp onset :: TimedData a -> NumData onset = timeStamp . getBarTime -- | Returns the offset time stamp offset :: TimedData a -> NumData offset td = case getTimeStamps td of [] -> error "HarmTrace.Base.MusicTime.offset: no timestamps are stored" l -> timeStamp . last $ l -- TODO: replace by ad-hoc enum instance? -- | returns the next beat, e.g. @ nextBeat Two = Three @. -- Following the (current) definition of 'Beat', we still assume 4/4, in the -- future this function should also have the meter as an argument. nextBeat, prevBeat :: Beat -> Beat nextBeat Four = One nextBeat b = succ b -- | returns the previous 'Beat', similar to 'prevBeat'. prevBeat One = Four prevBeat b = pred b -- | Updates transforms ChordLabel wrapped in a 'ProbChord' and 'TimedData' updateTPChord :: (ChordLabel -> ChordLabel) -> TimedData ProbChord -> TimedData ProbChord updateTPChord f = fmap (update f) where update g (ProbChord c p) = (ProbChord (g c) p) -- | drops the probabilties paired with chordlabels (in a list of 'ProbChord's) -- and returns a list of 'ChordLabel's dropProb :: [TimedData ProbChord] -> [TimedData ChordLabel] dropProb = map (fmap chordLab) -- | drops the time (with or without 'Beat') information of a list -- 'Timed' data structure dropTimed :: [TimedData a] -> [a] dropTimed = map getData