HarmTrace-2.1: src/HarmTrace/Audio/ChromaKey.hs
--------------------------------------------------------------------------------
-- |
-- Module : HarmTrace.Audio.ChromaKey
-- Copyright : (c) 2010-2012 Universiteit Utrecht, 2012 University of Oxford
-- License : GPL3
--
-- Maintainer : bash@cs.uu.nl, jpm@cs.ox.ac.uk
-- Stability : experimental
-- Portability : non-portable
--
-- Summary: Low-processing of chroma features for key-finding
--------------------------------------------------------------------------------
module HarmTrace.Audio.ChromaKey ( beatSyncKeyStrength, keyMap ) where
import HarmTrace.Audio.ChromaChord ( Vector, fromList, correlation
, beatSync, meanBeatSyncVectors
)
import HarmTrace.Base.MusicTime
import HarmTrace.Base.MusicRep
--------------------------------------------------------------------------------
-- Chroma key estimation
--------------------------------------------------------------------------------
-- | Calculates the beat synchronised key strenght for all
-- 24 keys (ordered by 'KeyMap').
beatSyncKeyStrength :: BarTimeTrackData -> ChordinoData -> [TimedData [NumData]]
beatSyncKeyStrength bts key =
map matchKeyProfiles . meanBeatSyncVectors $ beatSync bts key where
-- canMerge :: Beat -> Beat -> Bool
-- canMerge One Two = True
-- canMerge One Three = True
-- canMerge One Four = True
-- canMerge _ _ = False
nanToZero :: Double -> NumData
nanToZero n = if isNaN n then 0 else n
matchKeyProfiles :: TimedData (Vector NumData) -> TimedData [NumData]
-- matchKeyProfiles chroma = map (\x -> pnorm PNorm2 (chroma - x)) allKeyProfiles
-- matchKeyProfiles crm = map (nanToZero . GSL.correlation crm) allKeyProfiles
-- matchKeyProfiles crm = map (nanToZero . correlation crm) allKeyProfiles
matchKeyProfiles = fmap (\x -> map (nanToZero . correlation x) allKeyProfiles)
allKeyProfiles :: [Vector Double]
allKeyProfiles = map (fromList . keyToProfile) keyMap
keyToProfile :: Key -> [Double]
keyToProfile (Key root m) = reverseShift (toSemitone root) (selectProfile m)
where reverseShift :: Int -> [a] -> [a]
reverseShift p l = b ++ a where (a,b) = splitAt (length l - p) l
selectProfile :: Mode -> [Double]
selectProfile MajMode = temperleyProfCMaj
selectProfile MinMode = temperleyProfCMin
-- krumhanslProfCMaj, krumhanslProfCMin :: [NumData]
-- krumhanslProfCMaj =
-- [6.35, 2.23, 3.48, 2.33, 4.38, 4.09, 2.52, 5.19, 2.39, 3.66, 2.29, 2.88]
-- krumhanslProfCMin =
-- [6.33, 2.68, 3.52, 5.38, 2.60, 3.53, 2.54, 4.75, 3.98, 2.69, 3.34, 3.17]
temperleyProfCMaj, temperleyProfCMin :: [Double]
temperleyProfCMaj =
[5.0, 2.0, 3.5, 2.0, 4.5, 4.0, 2.0, 4.5, 2.0, 3.5, 1.5, 4.0 ]
temperleyProfCMin =
[5.0, 2.0, 3.5, 4.5, 2.0, 4.0, 2.0, 4.5, 3.5, 2.0, 1.5, 4.0 ]
--------------------------------------------------------------------------------
-- key strength Matrix Computations
--------------------------------------------------------------------------------
-- | A key chroma map using a circle of fifths based ordering.
keyMap :: [Key]
keyMap = [ Key (Note (Just Sh) F) MajMode -- "F#" 6
, Key (Note Nothing B) MajMode -- "B" 11
, Key (Note Nothing E) MajMode -- "E" 4
, Key (Note Nothing A) MajMode -- "A" 9
, Key (Note Nothing D) MajMode -- "D" 2
, Key (Note Nothing G) MajMode -- "G" 7
, Key (Note Nothing C) MajMode -- "C" 0
, Key (Note Nothing F) MajMode -- "F" 5
, Key (Note (Just Fl) B) MajMode -- "Bb" 10
, Key (Note (Just Fl) E) MajMode -- "Eb" 3
, Key (Note (Just Fl) A) MajMode -- "Ab" 8
, Key (Note (Just Fl) D) MajMode -- "Db" 1
, Key (Note (Just Fl) E) MinMode -- "Ebm" 3
, Key (Note (Just Sh) G) MinMode -- "G#m" 8
, Key (Note (Just Sh) C) MinMode -- "C#m" 1
, Key (Note (Just Sh) F) MinMode -- "F#m" 6
, Key (Note Nothing B) MinMode -- "Bm" 11
, Key (Note Nothing E) MinMode -- "Em" 4
, Key (Note Nothing A) MinMode -- "Am" 9
, Key (Note Nothing D) MinMode -- "Dm" 2
, Key (Note Nothing G) MinMode -- "Gm" 7
, Key (Note Nothing C) MinMode -- "Cm" 0
, Key (Note Nothing F) MinMode -- "Fm" 5
, Key (Note (Just Fl) B) MinMode -- "Bbm" 10
]