Hardwired.hs

module HiddenMarkovModel.Hardwired where

import HiddenMarkovModel (inverseMap)
import qualified Label

import qualified Math.HiddenMarkovModel.Distribution as Distr
import qualified Math.HiddenMarkovModel.Pattern as Pat
import qualified Math.HiddenMarkovModel.Named as HMMNamed
import qualified Math.HiddenMarkovModel as HMM

import qualified Numeric.Container as NC
import qualified Data.Packed.Matrix as Matrix
import qualified Data.Packed.Vector as Vector
import Data.Packed.Matrix (Matrix)

import qualified Data.Map as Map; import Data.Map (Map)
import Data.Semigroup ((<>))
import Data.Tuple.HT (mapFst)



pause, clickBegin, clickEnd, chirping, chirpingPause, growling :: HMM.State
pause         = HMM.state 0
clickBegin    = HMM.state 1
clickEnd      = HMM.state 2
chirping      = HMM.state 3
chirpingPause = HMM.state 4
growling      = HMM.state 5

numberOfStates :: Int
numberOfStates = 6

formatState :: Distr.State -> String
formatState (Distr.State s) =
   case s of
      1 -> "click begin"
      2 -> "click end"
      3 -> "chirping loop"
      4 -> "chirping pause"
      5 -> "growling"
      _ -> "pause"

labelFromStateMap :: Map HMM.State String
labelFromStateMap =
   Map.fromList $ map (mapFst HMM.state) $
      (0, Label.pause) :
      (1, Label.clickBegin) :
      (2, Label.clickEnd) :
      (3, Label.chirpingMain) :
      (4, Label.chirpingPause) :
      (5, Label.growling) :
      []

stateFromLabelMap :: Map String HMM.State
stateFromLabelMap =
   inverseMap labelFromStateMap



infixr 7 *<>

(*<>) :: Int -> Pat.T Double -> Pat.T Double
(*<>) = Pat.replicate


rasping :: Pat.T Double
rasping =
   15 *<>
      (600 *<> Pat.atom clickBegin
       <>
       600 *<> Pat.atom clickEnd)

pattern :: Pat.T Double
pattern =
   10000 *<> Pat.atom pause
   <>
   15 *<>
      (rasping
       <>
       6000 *<> Pat.atom chirping
       <>
       1500 *<> Pat.atom chirpingPause)
   <>
   rasping
   <>
   60000 *<> Pat.atom pause
   <>
   7 *<>
      (150 *<> Pat.atom growling
       <>
       1000 *<> Pat.atom pause)



hmm :: HMM.Gaussian Double
hmm = hmmTrained

hmmTrained :: HMM.Gaussian Double
hmmTrained =
   HMM.Cons {
      HMM.initial =
         Vector.fromList [0.0,0.0,0.0,1.0,0.0,0.0],
      HMM.transition =
         Matrix.fromLists $
            [0.9994586913864266,0.0,2.100090303883067e-5,0.0,0.0,1.0218978102189781e-2] :
            [0.0,0.9855812349085892,4.09517609257198e-3,0.0,2.4915465385299874e-3,0.0] :
            [0.0,1.4418765091410832e-2,0.9956108112648844,0.0,0.0,0.0] :
            [0.0,0.0,2.730117395047987e-4,0.9994628194305887,0.0,0.0] :
            [0.0,0.0,0.0,5.371805694114036e-4,0.99750845346147,0.0] :
            [5.413086135733135e-4,0.0,0.0,0.0,0.0,0.9897810218978101] :
            [],
      HMM.distribution =
         Distr.gaussian $
            (Vector.fromList [0.9513191890047871], covariance [[0.17689006357223516]]) :
            (Vector.fromList [1.5879408507110250], covariance [[0.600575479836784]]) :
            (Vector.fromList [0.7454942099113683], covariance [[0.4088353694711163]]) :
            (Vector.fromList [1.0231037870319346], covariance [[0.19801719658707737]]) :
            (Vector.fromList [0.6214106323233616], covariance [[0.3085570412459857]]) :
            (Vector.fromList [1.5574159338071116], covariance [[0.6221472768351596]]) :
            []}

hmmPattern :: HMM.Gaussian Double
hmmPattern =
   (HMM.finishTraining $
    Pat.finish numberOfStates (Distr.GaussianTrained Map.empty) pattern)
       {HMM.distribution =
          Distr.gaussian $
            (Vector.fromList [1.00], covariance [[0.17]]) :
            (Vector.fromList [1.60], covariance [[0.60]]) :
            (Vector.fromList [0.75], covariance [[0.40]]) :
            (Vector.fromList [1.00], covariance [[0.20]]) :
            (Vector.fromList [0.60], covariance [[0.30]]) :
            (Vector.fromList [1.60], covariance [[0.60]]) :
            []}

hmmNamed :: HMMNamed.Gaussian Double
hmmNamed =
   HMMNamed.Cons {
      HMMNamed.model = hmm,
      HMMNamed.nameFromStateMap = labelFromStateMap,
      HMMNamed.stateFromNameMap = stateFromLabelMap
   }


covariance :: [[Double]] -> Matrix Double
covariance xs =
   let m = Matrix.fromLists xs
   in  Matrix.trans m NC.<> m


scaleStdDev :: Double -> HMM.Gaussian Double -> HMM.Gaussian Double
scaleStdDev k model =
   model {
      HMM.distribution =
         let Distr.Gaussian arr = HMM.distribution model
         in  Distr.Gaussian $
             fmap (\(center,dev,c) -> (center, NC.scale k dev, c/k)) arr
   }