{- |
Example of an HMM with continuous emissions.
We train a model to accept sine waves of a certain frequency.

There are four hidden states:
0 - rising,
1 - high,
2 - falling,
3 - low.
-}
module Math.HiddenMarkovModel.Example.SineWave
{-# WARNING "do not import that module, it is only intended for demonstration" #-}
   where

import qualified Math.HiddenMarkovModel as HMM
import qualified Math.HiddenMarkovModel.Distribution as Distr

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

import qualified Data.NonEmpty.Class as NonEmptyC
import qualified Data.NonEmpty as NonEmpty
import Data.Function.HT (nest)
import Data.Tuple.HT (mapSnd)



hmm :: HMM.Gaussian Double
hmm =
   HMM.Cons {
      HMM.initial = Vector.fromList [1/4, 1/4, 1/4, 1/4],
      HMM.transition =
         Matrix.fromLists $
            [0.9, 0.0, 0.0, 0.1] :
            [0.1, 0.9, 0.0, 0.0] :
            [0.0, 0.1, 0.9, 0.0] :
            [0.0, 0.0, 0.1, 0.9] :
            [],
      HMM.distribution =
         Distr.gaussian $
            (Vector.fromList [ 0], Matrix.fromLists [[1]]) :
            (Vector.fromList [ 1], Matrix.fromLists [[1]]) :
            (Vector.fromList [ 0], Matrix.fromLists [[1]]) :
            (Vector.fromList [-1], Matrix.fromLists [[1]]) :
            []
   }

sineWaveLabeled :: NonEmpty.T [] (HMM.State, Double)
sineWaveLabeled =
   NonEmpty.mapTail (take 200) $
   fmap (\x -> (HMM.state $ mod (floor (x*2/pi+0.5)) 4, sin x)) $
   NonEmptyC.iterate (0.1+) 0

sineWave :: NonEmpty.T [] Double
sineWave = fmap snd sineWaveLabeled

revealed :: NonEmpty.T [] HMM.State
revealed = HMM.reveal hmmTrainedSupervised $ fmap NC.scalar sineWave

hmmTrainedSupervised :: HMM.Gaussian Double
hmmTrainedSupervised =
   HMM.finishTraining $ HMM.trainSupervised 4 $
   fmap (mapSnd NC.scalar) sineWaveLabeled

hmmTrainedUnsupervised :: HMM.Gaussian Double
hmmTrainedUnsupervised =
   HMM.finishTraining $ HMM.trainUnsupervised hmm $ fmap NC.scalar sineWave

hmmIterativelyTrained :: HMM.Gaussian Double
hmmIterativelyTrained =
   nest 100
      (\model ->
         HMM.finishTraining $ HMM.trainUnsupervised model $
         fmap NC.scalar sineWave)
      hmm