{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE EmptyDataDecls #-}
module Math.HiddenMarkovModel.Public.Distribution (
T(..), Trained(..), Emission,
Show(..), NFData(..), Format(..),
Info(..), Generate(..), EmissionProb(..),
Estimate(..), accumulateEmissionVectors,
Discrete, discreteFromList,
Gaussian, gaussian, gaussianTrained,
ToCSV(..), FromCSV(..), HMMCSV.CSVParser, CSVSymbol(..),
) where
import qualified Math.HiddenMarkovModel.CSV as HMMCSV
import Math.HiddenMarkovModel.Utility (randomItemProp, vectorDim)
import qualified Numeric.LAPACK.Matrix.HermitianPositiveDefinite as HermitianPD
import qualified Numeric.LAPACK.Matrix.Hermitian as Hermitian
import qualified Numeric.LAPACK.Matrix.Triangular as Triangular
import qualified Numeric.LAPACK.Matrix.Layout as Layout
import qualified Numeric.LAPACK.Matrix.Array as ArrMatrix
import qualified Numeric.LAPACK.Matrix as Matrix
import qualified Numeric.LAPACK.Vector as Vector
import qualified Numeric.LAPACK.Format as Format
import qualified Numeric.LAPACK.Output as Output
import Numeric.LAPACK.Matrix ((-*#), (-/#), (#/\), (|*-), (#!))
import Numeric.LAPACK.Vector (Vector)
import Numeric.LAPACK.Format (FormatArray)
import Numeric.LAPACK.Output (Output)
import qualified Type.Data.Bool as TBool
import qualified Numeric.Netlib.Class as Class
import Foreign.Storable (Storable)
import qualified Data.Array.Comfort.Storable as StorableArray
import qualified Data.Array.Comfort.Shape as Shape
import qualified Data.Array.Comfort.Boxed as Array
import Data.Array.Comfort.Boxed (Array, (!))
import Data.Array.Comfort.Shape ((::+)((::+)))
import qualified System.Random as Rnd
import qualified Text.CSV.Lazy.String as CSV
import Text.Read.HT (maybeRead)
import Text.Printf (printf)
import qualified Control.Monad.Exception.Synchronous as ME
import qualified Control.Monad.Trans.Class as MT
import qualified Control.Monad.Trans.State as MS
import qualified Control.DeepSeq as DeepSeq
import Control.Monad (liftM2)
import Control.Applicative (liftA2)
import qualified Data.NonEmpty.Map as NonEmptyMap
import qualified Data.NonEmpty as NonEmpty
import qualified Data.Semigroup as Sg
import qualified Data.Map as Map
import qualified Data.List.HT as ListHT
import qualified Data.List as List
import Data.Functor.Identity (Identity(Identity), runIdentity)
import Data.Tuple.HT (snd3)
import Data.Set (Set)
import Data.Maybe (listToMaybe)
import qualified Prelude as P
import Prelude2010 hiding (Show, showsPrec)
data family T typ sh prob
data family Trained typ sh prob
type family Emission typ prob
class Show typ where
showsPrec ::
(Shape.C sh, P.Show sh, P.Show prob, Storable prob) =>
Int -> T typ sh prob -> ShowS
showsPrecTrained ::
(Shape.C sh, P.Show sh, P.Show prob, Storable prob) =>
Int -> Trained typ sh prob -> ShowS
instance
(Show typ, Shape.C sh, P.Show sh, P.Show prob, Storable prob) =>
P.Show (T typ sh prob) where
showsPrec :: Int -> T typ sh prob -> ShowS
showsPrec = Int -> T typ sh prob -> ShowS
forall typ sh prob.
(Show typ, C sh, Show sh, Show prob, Storable prob) =>
Int -> T typ sh prob -> ShowS
showsPrec
instance
(Show typ, Shape.C sh, P.Show sh, P.Show prob, Storable prob) =>
P.Show (Trained typ sh prob) where
showsPrec :: Int -> Trained typ sh prob -> ShowS
showsPrec = Int -> Trained typ sh prob -> ShowS
forall typ sh prob.
(Show typ, C sh, Show sh, Show prob, Storable prob) =>
Int -> Trained typ sh prob -> ShowS
showsPrecTrained
class NFData typ where
rnf ::
(DeepSeq.NFData sh, DeepSeq.NFData prob, Shape.C sh) =>
T typ sh prob -> ()
rnfTrained ::
(DeepSeq.NFData sh, DeepSeq.NFData prob, Shape.C sh) =>
Trained typ sh prob -> ()
instance
(NFData typ, DeepSeq.NFData sh, DeepSeq.NFData prob, Shape.C sh) =>
DeepSeq.NFData (T typ sh prob) where
rnf :: T typ sh prob -> ()
rnf = T typ sh prob -> ()
forall typ sh prob.
(NFData typ, NFData sh, NFData prob, C sh) =>
T typ sh prob -> ()
rnf
instance
(NFData typ, DeepSeq.NFData sh, DeepSeq.NFData prob, Shape.C sh) =>
DeepSeq.NFData (Trained typ sh prob) where
rnf :: Trained typ sh prob -> ()
rnf = Trained typ sh prob -> ()
forall typ sh prob.
(NFData typ, NFData sh, NFData prob, C sh) =>
Trained typ sh prob -> ()
rnfTrained
class Format typ where
format ::
(Shape.C sh, Output out, Class.Real prob) =>
Format.Config -> T typ sh prob -> out
instance
(Format typ, Shape.C sh, Class.Real prob) =>
Format.Format (T typ sh prob) where
format :: Config -> T typ sh prob -> out
format = Config -> T typ sh prob -> out
forall typ sh out prob.
(Format typ, C sh, Output out, Real prob) =>
Config -> T typ sh prob -> out
format
class Info typ where
statesShape :: (Shape.C sh) => T typ sh prob -> sh
statesShapeTrained :: (Shape.C sh) => Trained typ sh prob -> sh
class Generate typ where
generate ::
(Shape.Indexed sh, Class.Real prob, Rnd.Random prob, Rnd.RandomGen g) =>
T typ sh prob -> Shape.Index sh -> MS.State g (Emission typ prob)
class EmissionProb typ where
mapStatesShape ::
(Shape.C sh0, Shape.C sh1) =>
(sh0 -> sh1) -> T typ sh0 prob -> T typ sh1 prob
emissionProb ::
(Shape.C sh, Class.Real prob) =>
T typ sh prob -> Emission typ prob -> Vector sh prob
emissionStateProb ::
(Shape.Indexed sh, Class.Real prob) =>
T typ sh prob -> Emission typ prob -> Shape.Index sh -> prob
emissionStateProb T typ sh prob
distr Emission typ prob
e Index sh
s = T typ sh prob -> Emission typ prob -> Vector sh prob
forall typ sh prob.
(EmissionProb typ, C sh, Real prob) =>
T typ sh prob -> Emission typ prob -> Vector sh prob
emissionProb T typ sh prob
distr Emission typ prob
e Vector sh prob -> Index sh -> prob
forall sh a.
(Indexed sh, Storable a) =>
Array sh a -> Index sh -> a
StorableArray.! Index sh
s
class (EmissionProb typ) => Estimate typ where
accumulateEmissions ::
(Shape.Indexed sh, Class.Real prob, Shape.Index sh ~ state) =>
sh -> NonEmpty.T [] (state, Emission typ prob) -> Trained typ sh prob
trainVector ::
(Shape.C sh, Eq sh, Class.Real prob) =>
Emission typ prob -> Vector sh prob -> Trained typ sh prob
combine ::
(Shape.C sh, Eq sh, Class.Real prob) =>
Trained typ sh prob -> Trained typ sh prob -> Trained typ sh prob
normalize ::
(Shape.C sh, Eq sh, Class.Real prob) =>
Trained typ sh prob -> T typ sh prob
accumulateEmissionVectors ::
(Estimate typ, Shape.C sh, Eq sh, Class.Real prob) =>
NonEmpty.T [] (Emission typ prob, Vector sh prob) -> Trained typ sh prob
accumulateEmissionVectors :: T [] (Emission typ prob, Vector sh prob) -> Trained typ sh prob
accumulateEmissionVectors = (Trained typ sh prob -> Trained typ sh prob -> Trained typ sh prob)
-> ((Emission typ prob, Vector sh prob) -> Trained typ sh prob)
-> T [] (Emission typ prob, Vector sh prob)
-> Trained typ sh prob
forall (f :: * -> *) b a.
Foldable f =>
(b -> b -> b) -> (a -> b) -> T f a -> b
NonEmpty.foldl1Map Trained typ sh prob -> Trained typ sh prob -> Trained typ sh prob
forall typ sh prob.
(Estimate typ, C sh, Eq sh, Real prob) =>
Trained typ sh prob -> Trained typ sh prob -> Trained typ sh prob
combine ((Emission typ prob -> Vector sh prob -> Trained typ sh prob)
-> (Emission typ prob, Vector sh prob) -> Trained typ sh prob
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Emission typ prob -> Vector sh prob -> Trained typ sh prob
forall typ sh prob.
(Estimate typ, C sh, Eq sh, Real prob) =>
Emission typ prob -> Vector sh prob -> Trained typ sh prob
trainVector)
instance
(Estimate typ, Shape.C sh, Eq sh, Class.Real prob) =>
Sg.Semigroup (Trained typ sh prob) where
<> :: Trained typ sh prob -> Trained typ sh prob -> Trained typ sh prob
(<>) = Trained typ sh prob -> Trained typ sh prob -> Trained typ sh prob
forall typ sh prob.
(Estimate typ, C sh, Eq sh, Real prob) =>
Trained typ sh prob -> Trained typ sh prob -> Trained typ sh prob
combine
data Discrete symbol
newtype instance T (Discrete symbol) sh prob =
Discrete (Matrix.General (Set symbol) sh prob)
newtype instance Trained (Discrete symbol) sh prob =
DiscreteTrained (NonEmptyMap.T symbol (Vector sh prob))
type instance Emission (Discrete symbol) prob = symbol
instance (P.Show symbol, Ord symbol) => Show (Discrete symbol) where
showsPrec :: Int -> T (Discrete symbol) sh prob -> ShowS
showsPrec Int
prec (Discrete m) = Int -> General (Set symbol) sh prob -> ShowS
forall a. Show a => Int -> a -> ShowS
P.showsPrec Int
prec General (Set symbol) sh prob
m
showsPrecTrained :: Int -> Trained (Discrete symbol) sh prob -> ShowS
showsPrecTrained Int
prec (DiscreteTrained m) = Int -> T symbol (Vector sh prob) -> ShowS
forall a. Show a => Int -> a -> ShowS
P.showsPrec Int
prec T symbol (Vector sh prob)
m
instance (DeepSeq.NFData symbol) => NFData (Discrete symbol) where
rnf :: T (Discrete symbol) sh prob -> ()
rnf (Discrete m) = General (Set symbol) sh prob -> ()
forall a. NFData a => a -> ()
DeepSeq.rnf General (Set symbol) sh prob
m
rnfTrained :: Trained (Discrete symbol) sh prob -> ()
rnfTrained (DiscreteTrained m) = T symbol (Vector sh prob) -> ()
forall a. NFData a => a -> ()
DeepSeq.rnf T symbol (Vector sh prob)
m
instance (P.Show symbol, Ord symbol) => Format (Discrete symbol) where
format :: Config -> T (Discrete symbol) sh prob -> out
format Config
fmt (Discrete m) =
[[Identity out]] -> out
forall (f :: * -> *) out.
(Foldable f, Output out) =>
[[f out]] -> out
Output.formatAligned ([[Identity out]] -> out) -> [[Identity out]] -> out
forall a b. (a -> b) -> a -> b
$
((symbol, Vector sh prob) -> [Identity out])
-> [(symbol, Vector sh prob)] -> [[Identity out]]
forall a b. (a -> b) -> [a] -> [b]
map (\(symbol
sym,Vector sh prob
v) ->
(String -> Identity out) -> [String] -> [Identity out]
forall a b. (a -> b) -> [a] -> [b]
map (out -> Identity out
forall a. a -> Identity a
Identity (out -> Identity out) -> (String -> out) -> String -> Identity out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> out
forall out. Output out => String -> out
Output.text) ([String] -> [Identity out]) -> [String] -> [Identity out]
forall a b. (a -> b) -> a -> b
$
(symbol -> String
forall a. Show a => a -> String
show symbol
sym String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":") String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
(prob -> String) -> [prob] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> prob -> String
forall a. Real a => String -> a -> String
printFmt (String -> prob -> String) -> String -> prob -> String
forall a b. (a -> b) -> a -> b
$ Config -> String
Format.configFormat Config
fmt) (Vector sh prob -> [prob]
forall sh a. (C sh, Storable a) => Vector sh a -> [a]
Vector.toList Vector sh prob
v)) ([(symbol, Vector sh prob)] -> [[Identity out]])
-> [(symbol, Vector sh prob)] -> [[Identity out]]
forall a b. (a -> b) -> a -> b
$
Array (Set symbol) (Vector sh prob)
-> [(Index (Set symbol), Vector sh prob)]
forall sh a. Indexed sh => Array sh a -> [(Index sh, a)]
Array.toAssociations (Array (Set symbol) (Vector sh prob)
-> [(Index (Set symbol), Vector sh prob)])
-> Array (Set symbol) (Vector sh prob)
-> [(Index (Set symbol), Vector sh prob)]
forall a b. (a -> b) -> a -> b
$ Full Size Big Big (Set symbol) sh prob
-> Array (Set symbol) (Vector sh prob)
forall meas vert horiz height width a.
(Measure meas, C vert, C horiz, C height, C width, Floating a) =>
Full meas vert horiz height width a
-> Array height (Vector width a)
Matrix.toRowArray Full Size Big Big (Set symbol) sh prob
m
newtype Flip f b a = Flip {Flip f b a -> f a b
getFlip :: f a b}
printFmt :: (Class.Real a) => String -> a -> String
printFmt :: String -> a -> String
printFmt String
fmt =
Flip (->) String a -> a -> String
forall (f :: * -> * -> *) b a. Flip f b a -> f a b
getFlip (Flip (->) String a -> a -> String)
-> Flip (->) String a -> a -> String
forall a b. (a -> b) -> a -> b
$ Flip (->) String Float
-> Flip (->) String Double -> Flip (->) String a
forall a (f :: * -> *). Real a => f Float -> f Double -> f a
Class.switchReal ((Float -> String) -> Flip (->) String Float
forall (f :: * -> * -> *) b a. f a b -> Flip f b a
Flip ((Float -> String) -> Flip (->) String Float)
-> (Float -> String) -> Flip (->) String Float
forall a b. (a -> b) -> a -> b
$ String -> Float -> String
forall r. PrintfType r => String -> r
printf String
fmt) ((Double -> String) -> Flip (->) String Double
forall (f :: * -> * -> *) b a. f a b -> Flip f b a
Flip ((Double -> String) -> Flip (->) String Double)
-> (Double -> String) -> Flip (->) String Double
forall a b. (a -> b) -> a -> b
$ String -> Double -> String
forall r. PrintfType r => String -> r
printf String
fmt)
instance (Ord symbol) => Info (Discrete symbol) where
statesShape :: T (Discrete symbol) sh prob -> sh
statesShape (Discrete m) = Matrix
(Array Unpacked Arbitrary)
()
()
Filled
Filled
Size
Big
Big
(Set symbol)
sh
prob
-> sh
forall typ xl xu meas vert horiz lower upper height width a.
(Box typ, BoxExtra typ xl, BoxExtra typ xu, Measure meas, C vert,
C horiz) =>
Matrix typ xl xu lower upper meas vert horiz height width a
-> width
Matrix.width Matrix
(Array Unpacked Arbitrary)
()
()
Filled
Filled
Size
Big
Big
(Set symbol)
sh
prob
m
statesShapeTrained :: Trained (Discrete symbol) sh prob -> sh
statesShapeTrained (DiscreteTrained m) = T symbol (Vector sh prob) -> sh
forall sh symbol prob. C sh => T symbol (Vector sh prob) -> sh
discreteStateShape T symbol (Vector sh prob)
m
instance (Ord symbol) => Generate (Discrete symbol) where
generate :: T (Discrete symbol) sh prob
-> Index sh -> State g (Emission (Discrete symbol) prob)
generate (Discrete m) =
[(symbol, prob)] -> State g symbol
forall g b a.
(RandomGen g, Random b, Num b, Ord b) =>
[(a, b)] -> State g a
randomItemProp ([(symbol, prob)] -> State g symbol)
-> (Index sh -> [(symbol, prob)]) -> Index sh -> State g symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array (Set symbol) prob -> [(symbol, prob)]
forall sh a.
(Indexed sh, Storable a) =>
Array sh a -> [(Index sh, a)]
StorableArray.toAssociations (Array (Set symbol) prob -> [(symbol, prob)])
-> (Index sh -> Array (Set symbol) prob)
-> Index sh
-> [(symbol, prob)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Full Size Big Big (Set symbol) sh prob
-> Index sh -> Array (Set symbol) prob
forall meas vert horiz height width ix a.
(Measure meas, C vert, C horiz, C height, Indexed width,
Index width ~ ix, Floating a) =>
Full meas vert horiz height width a -> ix -> Vector height a
Matrix.takeColumn Full Size Big Big (Set symbol) sh prob
m
instance (Ord symbol) => EmissionProb (Discrete symbol) where
mapStatesShape :: (sh0 -> sh1)
-> T (Discrete symbol) sh0 prob -> T (Discrete symbol) sh1 prob
mapStatesShape sh0 -> sh1
f (Discrete m) = General (Set symbol) sh1 prob -> T (Discrete symbol) sh1 prob
forall symbol sh prob.
General (Set symbol) sh prob -> T (Discrete symbol) sh prob
Discrete (General (Set symbol) sh1 prob -> T (Discrete symbol) sh1 prob)
-> General (Set symbol) sh1 prob -> T (Discrete symbol) sh1 prob
forall a b. (a -> b) -> a -> b
$ (sh0 -> sh1)
-> Matrix
(Array Unpacked Arbitrary)
()
()
Filled
Filled
Size
Big
Big
(Set symbol)
sh0
prob
-> General (Set symbol) sh1 prob
forall typ vert horiz height widthA widthB extraLower extraUpper
lower upper a.
(MapSize typ, C vert, C horiz, C height, C widthA, C widthB) =>
(widthA -> widthB)
-> Matrix
typ
extraLower
extraUpper
lower
upper
Size
vert
horiz
height
widthA
a
-> Matrix
typ
extraLower
extraUpper
lower
upper
Size
vert
horiz
height
widthB
a
Matrix.mapWidth sh0 -> sh1
f Matrix
(Array Unpacked Arbitrary)
()
()
Filled
Filled
Size
Big
Big
(Set symbol)
sh0
prob
m
emissionProb :: T (Discrete symbol) sh prob
-> Emission (Discrete symbol) prob -> Vector sh prob
emissionProb (Discrete m) = Full Size Big Big (Set symbol) sh prob -> symbol -> Vector sh prob
forall meas vert horiz height width ix a.
(Measure meas, C vert, C horiz, Indexed height, C width,
Index height ~ ix, Floating a) =>
Full meas vert horiz height width a -> ix -> Vector width a
Matrix.takeRow Full Size Big Big (Set symbol) sh prob
m
emissionStateProb :: T (Discrete symbol) sh prob
-> Emission (Discrete symbol) prob -> Index sh -> prob
emissionStateProb (Discrete m) Emission (Discrete symbol) prob
x Index sh
s = General (Set symbol) sh prob
m General (Set symbol) sh prob
-> (Index (Set symbol), Index sh) -> prob
forall typ meas vert horiz height width a xl xu lower upper.
(Indexed typ, Measure meas, C vert, C horiz, Indexed height,
Indexed width, Floating a) =>
Matrix typ xl xu lower upper meas vert horiz height width a
-> (Index height, Index width) -> a
#! (Index (Set symbol)
Emission (Discrete symbol) prob
x,Index sh
s)
instance (Ord symbol) => Estimate (Discrete symbol) where
accumulateEmissions :: sh
-> T [] (state, Emission (Discrete symbol) prob)
-> Trained (Discrete symbol) sh prob
accumulateEmissions sh
sh =
T symbol (Vector sh prob) -> Trained (Discrete symbol) sh prob
forall symbol sh prob.
T symbol (Vector sh prob) -> Trained (Discrete symbol) sh prob
DiscreteTrained (T symbol (Vector sh prob) -> Trained (Discrete symbol) sh prob)
-> (T [] (state, symbol) -> T symbol (Vector sh prob))
-> T [] (state, symbol)
-> Trained (Discrete symbol) sh prob
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Map (DeferredIndex sh) prob -> Vector sh prob)
-> T symbol (Map (DeferredIndex sh) prob)
-> T symbol (Vector sh prob)
forall k a b. Ord k => (a -> b) -> T k a -> T k b
NonEmptyMap.map
(sh -> Array (Deferred sh) prob -> Vector sh prob
forall sh0 sh1 a.
(C sh0, C sh1) =>
sh1 -> Array sh0 a -> Array sh1 a
StorableArray.reshape sh
sh (Array (Deferred sh) prob -> Vector sh prob)
-> (Map (DeferredIndex sh) prob -> Array (Deferred sh) prob)
-> Map (DeferredIndex sh) prob
-> Vector sh prob
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
prob
-> Deferred sh
-> [(Index (Deferred sh), prob)]
-> Array (Deferred sh) prob
forall sh a.
(Indexed sh, Storable a) =>
a -> sh -> [(Index sh, a)] -> Array sh a
StorableArray.fromAssociations prob
0 (sh -> Deferred sh
forall sh. sh -> Deferred sh
Shape.Deferred sh
sh) ([(DeferredIndex sh, prob)] -> Array (Deferred sh) prob)
-> (Map (DeferredIndex sh) prob -> [(DeferredIndex sh, prob)])
-> Map (DeferredIndex sh) prob
-> Array (Deferred sh) prob
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Map (DeferredIndex sh) prob -> [(DeferredIndex sh, prob)]
forall k a. Map k a -> [(k, a)]
Map.toList) (T symbol (Map (DeferredIndex sh) prob)
-> T symbol (Vector sh prob))
-> (T [] (state, symbol) -> T symbol (Map (DeferredIndex sh) prob))
-> T [] (state, symbol)
-> T symbol (Vector sh prob)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Map (DeferredIndex sh) prob
-> Map (DeferredIndex sh) prob -> Map (DeferredIndex sh) prob)
-> T [] (symbol, Map (DeferredIndex sh) prob)
-> T symbol (Map (DeferredIndex sh) prob)
forall k a. Ord k => (a -> a -> a) -> T [] (k, a) -> T k a
NonEmptyMap.fromListWith ((prob -> prob -> prob)
-> Map (DeferredIndex sh) prob
-> Map (DeferredIndex sh) prob
-> Map (DeferredIndex sh) prob
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith prob -> prob -> prob
forall a. Num a => a -> a -> a
(+)) (T [] (symbol, Map (DeferredIndex sh) prob)
-> T symbol (Map (DeferredIndex sh) prob))
-> (T [] (state, symbol)
-> T [] (symbol, Map (DeferredIndex sh) prob))
-> T [] (state, symbol)
-> T symbol (Map (DeferredIndex sh) prob)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((state, symbol) -> (symbol, Map (DeferredIndex sh) prob))
-> T [] (state, symbol)
-> T [] (symbol, Map (DeferredIndex sh) prob)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(state
state,symbol
sym) -> (symbol
sym, DeferredIndex sh -> prob -> Map (DeferredIndex sh) prob
forall k a. k -> a -> Map k a
Map.singleton (sh -> state -> DeferredIndex sh
forall sh ix.
(Indexed sh, Index sh ~ ix) =>
sh -> ix -> DeferredIndex sh
Shape.deferIndex sh
sh state
state) prob
1))
trainVector :: Emission (Discrete symbol) prob
-> Vector sh prob -> Trained (Discrete symbol) sh prob
trainVector Emission (Discrete symbol) prob
sym = T symbol (Vector sh prob) -> Trained (Discrete symbol) sh prob
forall symbol sh prob.
T symbol (Vector sh prob) -> Trained (Discrete symbol) sh prob
DiscreteTrained (T symbol (Vector sh prob) -> Trained (Discrete symbol) sh prob)
-> (Vector sh prob -> T symbol (Vector sh prob))
-> Vector sh prob
-> Trained (Discrete symbol) sh prob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. symbol -> Vector sh prob -> T symbol (Vector sh prob)
forall k a. k -> a -> T k a
NonEmptyMap.singleton symbol
Emission (Discrete symbol) prob
sym
combine :: Trained (Discrete symbol) sh prob
-> Trained (Discrete symbol) sh prob
-> Trained (Discrete symbol) sh prob
combine (DiscreteTrained distr0) (DiscreteTrained distr1) =
T symbol (Vector sh prob) -> Trained (Discrete symbol) sh prob
forall symbol sh prob.
T symbol (Vector sh prob) -> Trained (Discrete symbol) sh prob
DiscreteTrained (T symbol (Vector sh prob) -> Trained (Discrete symbol) sh prob)
-> T symbol (Vector sh prob) -> Trained (Discrete symbol) sh prob
forall a b. (a -> b) -> a -> b
$ (Vector sh prob -> Vector sh prob -> Vector sh prob)
-> T symbol (Vector sh prob)
-> T symbol (Vector sh prob)
-> T symbol (Vector sh prob)
forall k a. Ord k => (a -> a -> a) -> T k a -> T k a -> T k a
NonEmptyMap.unionWith Vector sh prob -> Vector sh prob -> Vector sh prob
forall sh a.
(C sh, Eq sh, Floating a) =>
Vector sh a -> Vector sh a -> Vector sh a
Vector.add T symbol (Vector sh prob)
distr0 T symbol (Vector sh prob)
distr1
normalize :: Trained (Discrete symbol) sh prob -> T (Discrete symbol) sh prob
normalize (DiscreteTrained distr) =
General (Set symbol) sh prob -> T (Discrete symbol) sh prob
forall symbol sh prob.
General (Set symbol) sh prob -> T (Discrete symbol) sh prob
Discrete (General (Set symbol) sh prob -> T (Discrete symbol) sh prob)
-> General (Set symbol) sh prob -> T (Discrete symbol) sh prob
forall a b. (a -> b) -> a -> b
$ General (Set symbol) sh prob -> General (Set symbol) sh prob
forall height width a.
(C height, C width, Eq width, Real a) =>
General height width a -> General height width a
normalizeProbColumns (General (Set symbol) sh prob -> General (Set symbol) sh prob)
-> General (Set symbol) sh prob -> General (Set symbol) sh prob
forall a b. (a -> b) -> a -> b
$ T symbol (Vector sh prob) -> General (Set symbol) sh prob
forall symbol sh prob.
(Ord symbol, C sh, Eq sh, Real prob) =>
T symbol (Vector sh prob) -> General (Set symbol) sh prob
discreteFromMap T symbol (Vector sh prob)
distr
normalizeProbColumns ::
(Shape.C height, Shape.C width, Eq width, Class.Real a) =>
Matrix.General height width a -> Matrix.General height width a
normalizeProbColumns :: General height width a -> General height width a
normalizeProbColumns General height width a
m = General height width a
m General height width a -> Vector width a -> General height width a
forall meas vert horiz height width a.
(Measure meas, C vert, C horiz, C height, C width, Eq width,
Floating a) =>
Full meas vert horiz height width a
-> Vector width a -> Full meas vert horiz height width a
#/\ General height width a -> Vector width a
forall meas vert horiz height width a.
(Measure meas, C vert, C horiz, C height, C width, Floating a) =>
Full meas vert horiz height width a -> Vector width a
Matrix.columnSums General height width a
m
discreteStateShape ::
(Shape.C sh) => NonEmptyMap.T symbol (Vector sh prob) -> sh
discreteStateShape :: T symbol (Vector sh prob) -> sh
discreteStateShape =
Vector sh prob -> sh
forall sh a. Array sh a -> sh
StorableArray.shape (Vector sh prob -> sh)
-> (T symbol (Vector sh prob) -> Vector sh prob)
-> T symbol (Vector sh prob)
-> sh
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (symbol, Vector sh prob) -> Vector sh prob
forall a b. (a, b) -> b
snd ((symbol, Vector sh prob) -> Vector sh prob)
-> (T symbol (Vector sh prob) -> (symbol, Vector sh prob))
-> T symbol (Vector sh prob)
-> Vector sh prob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((symbol, Vector sh prob), Map symbol (Vector sh prob))
-> (symbol, Vector sh prob)
forall a b. (a, b) -> a
fst (((symbol, Vector sh prob), Map symbol (Vector sh prob))
-> (symbol, Vector sh prob))
-> (T symbol (Vector sh prob)
-> ((symbol, Vector sh prob), Map symbol (Vector sh prob)))
-> T symbol (Vector sh prob)
-> (symbol, Vector sh prob)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T symbol (Vector sh prob)
-> ((symbol, Vector sh prob), Map symbol (Vector sh prob))
forall k a. T k a -> ((k, a), Map k a)
NonEmptyMap.minViewWithKey
discreteFromMap ::
(Ord symbol, Shape.C sh, Eq sh, Class.Real prob) =>
NonEmptyMap.T symbol (Vector sh prob) -> Matrix.General (Set symbol) sh prob
discreteFromMap :: T symbol (Vector sh prob) -> General (Set symbol) sh prob
discreteFromMap T symbol (Vector sh prob)
m =
sh
-> Array (Set symbol) (Vector sh prob)
-> General (Set symbol) sh prob
forall height width a.
(C height, C width, Eq width, Storable a) =>
width -> Array height (Vector width a) -> General height width a
Matrix.fromRowArray (T symbol (Vector sh prob) -> sh
forall sh symbol prob. C sh => T symbol (Vector sh prob) -> sh
discreteStateShape T symbol (Vector sh prob)
m) (Array (Set symbol) (Vector sh prob)
-> General (Set symbol) sh prob)
-> Array (Set symbol) (Vector sh prob)
-> General (Set symbol) sh prob
forall a b. (a -> b) -> a -> b
$
Map symbol (Vector sh prob) -> Array (Set symbol) (Vector sh prob)
forall k a. Ord k => Map k a -> Array (Set k) a
Array.fromMap (Map symbol (Vector sh prob)
-> Array (Set symbol) (Vector sh prob))
-> Map symbol (Vector sh prob)
-> Array (Set symbol) (Vector sh prob)
forall a b. (a -> b) -> a -> b
$ T symbol (Vector sh prob) -> Map symbol (Vector sh prob)
forall k a. Ord k => T k a -> Map k a
NonEmptyMap.flatten T symbol (Vector sh prob)
m
discreteFromList ::
(Ord symbol, Shape.C sh, Eq sh, Class.Real prob) =>
NonEmpty.T [] (symbol, Vector sh prob) -> T (Discrete symbol) sh prob
discreteFromList :: T [] (symbol, Vector sh prob) -> T (Discrete symbol) sh prob
discreteFromList = General (Set symbol) sh prob -> T (Discrete symbol) sh prob
forall symbol sh prob.
General (Set symbol) sh prob -> T (Discrete symbol) sh prob
Discrete (General (Set symbol) sh prob -> T (Discrete symbol) sh prob)
-> (T [] (symbol, Vector sh prob) -> General (Set symbol) sh prob)
-> T [] (symbol, Vector sh prob)
-> T (Discrete symbol) sh prob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T symbol (Vector sh prob) -> General (Set symbol) sh prob
forall symbol sh prob.
(Ord symbol, C sh, Eq sh, Real prob) =>
T symbol (Vector sh prob) -> General (Set symbol) sh prob
discreteFromMap (T symbol (Vector sh prob) -> General (Set symbol) sh prob)
-> (T [] (symbol, Vector sh prob) -> T symbol (Vector sh prob))
-> T [] (symbol, Vector sh prob)
-> General (Set symbol) sh prob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T [] (symbol, Vector sh prob) -> T symbol (Vector sh prob)
forall k a. Ord k => T [] (k, a) -> T k a
NonEmptyMap.fromList
data Gaussian emiSh
newtype instance T (Gaussian emiSh) stateSh a =
Gaussian (Array stateSh (a, Vector emiSh a, Triangular.Upper emiSh a))
newtype instance Trained (Gaussian emiSh) stateSh a =
GaussianTrained
(StorableArray.Array (stateSh, Layout.Hermitian (()::+emiSh)) a)
type instance Emission (Gaussian emiSh) a = Vector emiSh a
instance (Shape.C emiSh, P.Show emiSh) => Show (Gaussian emiSh) where
showsPrec :: Int -> T (Gaussian emiSh) sh prob -> ShowS
showsPrec Int
prec (Gaussian m) = Int
-> Array sh (prob, Vector emiSh prob, Upper emiSh prob) -> ShowS
forall a. Show a => Int -> a -> ShowS
P.showsPrec Int
prec Array sh (prob, Vector emiSh prob, Upper emiSh prob)
m
showsPrecTrained :: Int -> Trained (Gaussian emiSh) sh prob -> ShowS
showsPrecTrained Int
prec (GaussianTrained m) = Int -> Array (sh, Hermitian (() ::+ emiSh)) prob -> ShowS
forall a. Show a => Int -> a -> ShowS
P.showsPrec Int
prec Array (sh, Hermitian (() ::+ emiSh)) prob
m
instance (DeepSeq.NFData emiSh) => NFData (Gaussian emiSh) where
rnf :: T (Gaussian emiSh) sh prob -> ()
rnf (Gaussian params) = Array sh (prob, Vector emiSh prob, Upper emiSh prob) -> ()
forall a. NFData a => a -> ()
DeepSeq.rnf Array sh (prob, Vector emiSh prob, Upper emiSh prob)
params
rnfTrained :: Trained (Gaussian emiSh) sh prob -> ()
rnfTrained (GaussianTrained params) = Array (sh, Hermitian (() ::+ emiSh)) prob -> ()
forall a. NFData a => a -> ()
DeepSeq.rnf Array (sh, Hermitian (() ::+ emiSh)) prob
params
instance (FormatArray emiSh) => Format (Gaussian emiSh) where
format :: Config -> T (Gaussian emiSh) sh prob -> out
format = FormatGaussian out emiSh sh prob
-> Config -> T (Gaussian emiSh) sh prob -> out
forall out emiSh stateSh a.
FormatGaussian out emiSh stateSh a
-> Config -> T (Gaussian emiSh) stateSh a -> out
runFormatGaussian (FormatGaussian out emiSh sh prob
-> Config -> T (Gaussian emiSh) sh prob -> out)
-> FormatGaussian out emiSh sh prob
-> Config
-> T (Gaussian emiSh) sh prob
-> out
forall a b. (a -> b) -> a -> b
$ FormatGaussian out emiSh sh Float
-> FormatGaussian out emiSh sh Double
-> FormatGaussian out emiSh sh prob
forall a (f :: * -> *). Real a => f Float -> f Double -> f a
Class.switchReal FormatGaussian out emiSh sh Float
forall emiSh stateSh a out.
(FormatArray emiSh, C stateSh, Real a, Format a, Output out) =>
FormatGaussian out emiSh stateSh a
formatGaussian FormatGaussian out emiSh sh Double
forall emiSh stateSh a out.
(FormatArray emiSh, C stateSh, Real a, Format a, Output out) =>
FormatGaussian out emiSh stateSh a
formatGaussian
newtype FormatGaussian out emiSh stateSh a =
FormatGaussian {
FormatGaussian out emiSh stateSh a
-> Config -> T (Gaussian emiSh) stateSh a -> out
runFormatGaussian ::
Format.Config -> T (Gaussian emiSh) stateSh a -> out
}
formatGaussian ::
(FormatArray emiSh, Shape.C stateSh,
Class.Real a, Format.Format a, Output out) =>
FormatGaussian out emiSh stateSh a
formatGaussian :: FormatGaussian out emiSh stateSh a
formatGaussian =
(Config -> T (Gaussian emiSh) stateSh a -> out)
-> FormatGaussian out emiSh stateSh a
forall out emiSh stateSh a.
(Config -> T (Gaussian emiSh) stateSh a -> out)
-> FormatGaussian out emiSh stateSh a
FormatGaussian ((Config -> T (Gaussian emiSh) stateSh a -> out)
-> FormatGaussian out emiSh stateSh a)
-> (Config -> T (Gaussian emiSh) stateSh a -> out)
-> FormatGaussian out emiSh stateSh a
forall a b. (a -> b) -> a -> b
$ \Config
fmt (Gaussian params) ->
Config -> [(a, Vector emiSh a, Upper emiSh a)] -> out
forall a out. (Format a, Output out) => Config -> a -> out
Format.format Config
fmt ([(a, Vector emiSh a, Upper emiSh a)] -> out)
-> [(a, Vector emiSh a, Upper emiSh a)] -> out
forall a b. (a -> b) -> a -> b
$ Array stateSh (a, Vector emiSh a, Upper emiSh a)
-> [(a, Vector emiSh a, Upper emiSh a)]
forall sh a. C sh => Array sh a -> [a]
Array.toList Array stateSh (a, Vector emiSh a, Upper emiSh a)
params
instance Info (Gaussian emiSh) where
statesShape :: T (Gaussian emiSh) sh prob -> sh
statesShape (Gaussian params) = Array sh (prob, Vector emiSh prob, Upper emiSh prob) -> sh
forall sh a. Array sh a -> sh
Array.shape Array sh (prob, Vector emiSh prob, Upper emiSh prob)
params
statesShapeTrained :: Trained (Gaussian emiSh) sh prob -> sh
statesShapeTrained (GaussianTrained params) =
(sh, Hermitian (() ::+ emiSh)) -> sh
forall a b. (a, b) -> a
fst ((sh, Hermitian (() ::+ emiSh)) -> sh)
-> (sh, Hermitian (() ::+ emiSh)) -> sh
forall a b. (a -> b) -> a -> b
$ Array (sh, Hermitian (() ::+ emiSh)) prob
-> (sh, Hermitian (() ::+ emiSh))
forall sh a. Array sh a -> sh
StorableArray.shape Array (sh, Hermitian (() ::+ emiSh)) prob
params
instance (Shape.C emiSh, Eq emiSh) => Generate (Gaussian emiSh) where
generate :: T (Gaussian emiSh) sh prob
-> Index sh -> State g (Emission (Gaussian emiSh) prob)
generate (Gaussian allParams) Index sh
state = do
let (prob
_c, Vector emiSh prob
center, Upper emiSh prob
covarianceChol) = Array sh (prob, Vector emiSh prob, Upper emiSh prob)
allParams Array sh (prob, Vector emiSh prob, Upper emiSh prob)
-> Index sh -> (prob, Vector emiSh prob, Upper emiSh prob)
forall sh a. Indexed sh => Array sh a -> Index sh -> a
! Index sh
state
Word64
seed <- (g -> (Word64, g)) -> StateT g Identity Word64
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state g -> (Word64, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
Rnd.random
Vector emiSh prob -> StateT g Identity (Vector emiSh prob)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector emiSh prob -> StateT g Identity (Vector emiSh prob))
-> Vector emiSh prob -> StateT g Identity (Vector emiSh prob)
forall a b. (a -> b) -> a -> b
$
Vector emiSh prob -> Vector emiSh prob -> Vector emiSh prob
forall sh a.
(C sh, Eq sh, Floating a) =>
Vector sh a -> Vector sh a -> Vector sh a
Vector.add Vector emiSh prob
center (Vector emiSh prob -> Vector emiSh prob)
-> Vector emiSh prob -> Vector emiSh prob
forall a b. (a -> b) -> a -> b
$
RandomDistribution -> emiSh -> Word64 -> Vector emiSh prob
forall sh a.
(C sh, Floating a) =>
RandomDistribution -> sh -> Word64 -> Vector sh a
Vector.random RandomDistribution
Vector.Normal (Vector emiSh prob -> emiSh
forall sh a. Array sh a -> sh
StorableArray.shape Vector emiSh prob
center) Word64
seed
Vector emiSh prob -> Upper emiSh prob -> Vector emiSh prob
forall typ lower upper xl xu meas vert horiz height width a.
(MultiplyVector typ, Strip lower, Strip upper,
MultiplyVectorExtra typ xl, MultiplyVectorExtra typ xu,
Measure meas, C vert, C horiz, C height, C width, Eq height,
Floating a) =>
Vector height a
-> Matrix typ xl xu lower upper meas vert horiz height width a
-> Vector width a
-*# Upper emiSh prob
covarianceChol
instance (Shape.C emiSh, Eq emiSh) => EmissionProb (Gaussian emiSh) where
mapStatesShape :: (sh0 -> sh1)
-> T (Gaussian emiSh) sh0 prob -> T (Gaussian emiSh) sh1 prob
mapStatesShape sh0 -> sh1
f (Gaussian m) = Array sh1 (prob, Vector emiSh prob, Upper emiSh prob)
-> T (Gaussian emiSh) sh1 prob
forall emiSh stateSh a.
Array stateSh (a, Vector emiSh a, Upper emiSh a)
-> T (Gaussian emiSh) stateSh a
Gaussian (Array sh1 (prob, Vector emiSh prob, Upper emiSh prob)
-> T (Gaussian emiSh) sh1 prob)
-> Array sh1 (prob, Vector emiSh prob, Upper emiSh prob)
-> T (Gaussian emiSh) sh1 prob
forall a b. (a -> b) -> a -> b
$ (sh0 -> sh1)
-> Array sh0 (prob, Vector emiSh prob, Upper emiSh prob)
-> Array sh1 (prob, Vector emiSh prob, Upper emiSh prob)
forall sh0 sh1 a.
(C sh0, C sh1) =>
(sh0 -> sh1) -> Array sh0 a -> Array sh1 a
Array.mapShape sh0 -> sh1
f Array sh0 (prob, Vector emiSh prob, Upper emiSh prob)
m
emissionProb :: T (Gaussian emiSh) sh prob
-> Emission (Gaussian emiSh) prob -> Vector sh prob
emissionProb (Gaussian allParams) Emission (Gaussian emiSh) prob
x =
Array sh prob -> Vector sh prob
forall sh a. (C sh, Storable a) => Array sh a -> Array sh a
StorableArray.fromBoxed (Array sh prob -> Vector sh prob)
-> Array sh prob -> Vector sh prob
forall a b. (a -> b) -> a -> b
$ ((prob, Vector emiSh prob, Upper emiSh prob) -> prob)
-> Array sh (prob, Vector emiSh prob, Upper emiSh prob)
-> Array sh prob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vector emiSh prob
-> (prob, Vector emiSh prob, Upper emiSh prob) -> prob
forall emiSh a.
(C emiSh, Eq emiSh, Real a) =>
Vector emiSh a -> (a, Vector emiSh a, Upper emiSh a) -> a
gaussianEmissionProb Vector emiSh prob
Emission (Gaussian emiSh) prob
x) Array sh (prob, Vector emiSh prob, Upper emiSh prob)
allParams
emissionStateProb :: T (Gaussian emiSh) sh prob
-> Emission (Gaussian emiSh) prob -> Index sh -> prob
emissionStateProb (Gaussian allParams) Emission (Gaussian emiSh) prob
x Index sh
s =
Vector emiSh prob
-> (prob, Vector emiSh prob, Upper emiSh prob) -> prob
forall emiSh a.
(C emiSh, Eq emiSh, Real a) =>
Vector emiSh a -> (a, Vector emiSh a, Upper emiSh a) -> a
gaussianEmissionProb Vector emiSh prob
Emission (Gaussian emiSh) prob
x ((prob, Vector emiSh prob, Upper emiSh prob) -> prob)
-> (prob, Vector emiSh prob, Upper emiSh prob) -> prob
forall a b. (a -> b) -> a -> b
$ Array sh (prob, Vector emiSh prob, Upper emiSh prob)
allParams Array sh (prob, Vector emiSh prob, Upper emiSh prob)
-> Index sh -> (prob, Vector emiSh prob, Upper emiSh prob)
forall sh a. Indexed sh => Array sh a -> Index sh -> a
! Index sh
s
gaussianEmissionProb ::
(Shape.C emiSh, Eq emiSh, Class.Real a) =>
Vector emiSh a -> (a, Vector emiSh a, Triangular.Upper emiSh a) -> a
gaussianEmissionProb :: Vector emiSh a -> (a, Vector emiSh a, Upper emiSh a) -> a
gaussianEmissionProb Vector emiSh a
x (a
c, Vector emiSh a
center, Upper emiSh a
covarianceChol) =
a
c a -> a -> a
forall a. Num a => a -> a -> a
* Vector emiSh a -> a
forall sh a. (C sh, Real a) => Vector sh a -> a
expSquared (Vector emiSh a -> Vector emiSh a -> Vector emiSh a
forall sh a.
(C sh, Eq sh, Floating a) =>
Vector sh a -> Vector sh a -> Vector sh a
Vector.sub Vector emiSh a
x Vector emiSh a
center Vector emiSh a -> Upper emiSh a -> Vector emiSh a
forall typ xl xu lower upper meas height width a.
(Solve typ, ToQuadratic typ, SolveExtra typ xl, SolveExtra typ xu,
BoxExtra typ xl, BoxExtra typ xu, Strip lower, Strip upper,
Measure meas, C height, C width, Eq width, Floating a) =>
Vector width a
-> QuadraticMeas typ xl xu lower upper meas height width a
-> Vector height a
-/# Upper emiSh a
covarianceChol)
expSquared :: (Shape.C sh, Class.Real a) => Vector sh a -> a
expSquared :: Vector sh a -> a
expSquared =
Norm (Array sh) a -> Vector sh a -> a
forall (f :: * -> *) a. Norm f a -> f a -> a
getNorm (Norm (Array sh) a -> Vector sh a -> a)
-> Norm (Array sh) a -> Vector sh a -> a
forall a b. (a -> b) -> a -> b
$ Norm (Array sh) Float
-> Norm (Array sh) Double -> Norm (Array sh) a
forall a (f :: * -> *). Real a => f Float -> f Double -> f a
Class.switchReal ((Array sh Float -> Float) -> Norm (Array sh) Float
forall (f :: * -> *) a. (f a -> a) -> Norm f a
Norm Array sh Float -> Float
forall sh a ar.
(C sh, Floating a, RealOf a ~ ar, Real ar) =>
Vector sh a -> ar
expSquaredAux) ((Array sh Double -> Double) -> Norm (Array sh) Double
forall (f :: * -> *) a. (f a -> a) -> Norm f a
Norm Array sh Double -> Double
forall sh a ar.
(C sh, Floating a, RealOf a ~ ar, Real ar) =>
Vector sh a -> ar
expSquaredAux)
newtype Norm f a = Norm {Norm f a -> f a -> a
getNorm :: f a -> a}
expSquaredAux ::
(Shape.C sh, Class.Floating a, Vector.RealOf a ~ ar, Class.Real ar) =>
Vector sh a -> ar
expSquaredAux :: Vector sh a -> ar
expSquaredAux Vector sh a
x = ar -> ar
forall a. Floating a => a -> a
exp ((-ar
1ar -> ar -> ar
forall a. Fractional a => a -> a -> a
/ar
2) ar -> ar -> ar
forall a. Num a => a -> a -> a
* Vector sh a -> RealOf a
forall sh a. (C sh, Floating a) => Vector sh a -> RealOf a
Vector.norm2Squared Vector sh a
x)
instance (Shape.C emiSh, Eq emiSh) => Estimate (Gaussian emiSh) where
accumulateEmissions :: sh
-> T [] (state, Emission (Gaussian emiSh) prob)
-> Trained (Gaussian emiSh) sh prob
accumulateEmissions sh
sh T [] (state, Emission (Gaussian emiSh) prob)
xs =
let emiSh :: emiSh
emiSh = Array emiSh prob -> emiSh
forall sh a. Array sh a -> sh
StorableArray.shape (Array emiSh prob -> emiSh) -> Array emiSh prob -> emiSh
forall a b. (a -> b) -> a -> b
$ (state, Array emiSh prob) -> Array emiSh prob
forall a b. (a, b) -> b
snd ((state, Array emiSh prob) -> Array emiSh prob)
-> (state, Array emiSh prob) -> Array emiSh prob
forall a b. (a -> b) -> a -> b
$ T [] (state, Array emiSh prob) -> (state, Array emiSh prob)
forall (f :: * -> *) a. T f a -> a
NonEmpty.head T [] (state, Array emiSh prob)
T [] (state, Emission (Gaussian emiSh) prob)
xs
hermSh :: Hermitian (() ::+ emiSh)
hermSh = Order -> (() ::+ emiSh) -> Hermitian (() ::+ emiSh)
forall size. Order -> size -> Hermitian size
Layout.hermitian Order
Layout.RowMajor (()() -> emiSh -> () ::+ emiSh
forall sh0 sh1. sh0 -> sh1 -> sh0 ::+ sh1
::+emiSh
emiSh)
in Array (sh, Hermitian (() ::+ emiSh)) prob
-> Trained (Gaussian emiSh) sh prob
forall emiSh stateSh a.
Array (stateSh, Hermitian (() ::+ emiSh)) a
-> Trained (Gaussian emiSh) stateSh a
GaussianTrained (Array (sh, Hermitian (() ::+ emiSh)) prob
-> Trained (Gaussian emiSh) sh prob)
-> Array (sh, Hermitian (() ::+ emiSh)) prob
-> Trained (Gaussian emiSh) sh prob
forall a b. (a -> b) -> a -> b
$
Full Size Big Big sh (Hermitian (() ::+ emiSh)) prob
-> Array (sh, Hermitian (() ::+ emiSh)) prob
forall meas vert horiz height width a.
(Measure meas, C vert, C horiz, C height, C width, Floating a) =>
Full meas vert horiz height width a -> Array (height, width) a
Matrix.toRowMajor (Full Size Big Big sh (Hermitian (() ::+ emiSh)) prob
-> Array (sh, Hermitian (() ::+ emiSh)) prob)
-> (T [] (state, Array emiSh prob)
-> Full Size Big Big sh (Hermitian (() ::+ emiSh)) prob)
-> T [] (state, Array emiSh prob)
-> Array (sh, Hermitian (() ::+ emiSh)) prob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hermitian (() ::+ emiSh)
-> Array sh (Vector (Hermitian (() ::+ emiSh)) prob)
-> Full Size Big Big sh (Hermitian (() ::+ emiSh)) prob
forall height width a.
(C height, C width, Eq width, Storable a) =>
width -> Array height (Vector width a) -> General height width a
Matrix.fromRowArray Hermitian (() ::+ emiSh)
hermSh (Array sh (Vector (Hermitian (() ::+ emiSh)) prob)
-> Full Size Big Big sh (Hermitian (() ::+ emiSh)) prob)
-> (T [] (state, Array emiSh prob)
-> Array sh (Vector (Hermitian (() ::+ emiSh)) prob))
-> T [] (state, Array emiSh prob)
-> Full Size Big Big sh (Hermitian (() ::+ emiSh)) prob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sh
-> Array (Deferred sh) (Vector (Hermitian (() ::+ emiSh)) prob)
-> Array sh (Vector (Hermitian (() ::+ emiSh)) prob)
forall sh0 sh1 a.
(C sh0, C sh1) =>
sh1 -> Array sh0 a -> Array sh1 a
Array.reshape sh
sh (Array (Deferred sh) (Vector (Hermitian (() ::+ emiSh)) prob)
-> Array sh (Vector (Hermitian (() ::+ emiSh)) prob))
-> (T [] (state, Array emiSh prob)
-> Array (Deferred sh) (Vector (Hermitian (() ::+ emiSh)) prob))
-> T [] (state, Array emiSh prob)
-> Array sh (Vector (Hermitian (() ::+ emiSh)) prob)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Vector (Hermitian (() ::+ emiSh)) prob
-> Vector (Hermitian (() ::+ emiSh)) prob
-> Vector (Hermitian (() ::+ emiSh)) prob)
-> Array (Deferred sh) (Vector (Hermitian (() ::+ emiSh)) prob)
-> [(Index (Deferred sh), Vector (Hermitian (() ::+ emiSh)) prob)]
-> Array (Deferred sh) (Vector (Hermitian (() ::+ emiSh)) prob)
forall sh a b.
Indexed sh =>
(a -> b -> a) -> Array sh a -> [(Index sh, b)] -> Array sh a
Array.accumulate Vector (Hermitian (() ::+ emiSh)) prob
-> Vector (Hermitian (() ::+ emiSh)) prob
-> Vector (Hermitian (() ::+ emiSh)) prob
forall sh a.
(C sh, Eq sh, Floating a) =>
Vector sh a -> Vector sh a -> Vector sh a
Vector.add
(Deferred sh
-> Vector (Hermitian (() ::+ emiSh)) prob
-> Array (Deferred sh) (Vector (Hermitian (() ::+ emiSh)) prob)
forall sh a. C sh => sh -> a -> Array sh a
Array.replicate (sh -> Deferred sh
forall sh. sh -> Deferred sh
Shape.Deferred sh
sh) (Hermitian (() ::+ emiSh) -> Vector (Hermitian (() ::+ emiSh)) prob
forall sh a. (C sh, Floating a) => sh -> Vector sh a
Vector.zero Hermitian (() ::+ emiSh)
hermSh)) ([(DeferredIndex sh, Vector (Hermitian (() ::+ emiSh)) prob)]
-> Array (Deferred sh) (Vector (Hermitian (() ::+ emiSh)) prob))
-> (T [] (state, Array emiSh prob)
-> [(DeferredIndex sh, Vector (Hermitian (() ::+ emiSh)) prob)])
-> T [] (state, Array emiSh prob)
-> Array (Deferred sh) (Vector (Hermitian (() ::+ emiSh)) prob)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((state, Array emiSh prob)
-> (DeferredIndex sh, Vector (Hermitian (() ::+ emiSh)) prob))
-> [(state, Array emiSh prob)]
-> [(DeferredIndex sh, Vector (Hermitian (() ::+ emiSh)) prob)]
forall a b. (a -> b) -> [a] -> [b]
map (\(state
state,Array emiSh prob
v) -> (sh -> state -> DeferredIndex sh
forall sh ix.
(Indexed sh, Index sh ~ ix) =>
sh -> ix -> DeferredIndex sh
Shape.deferIndex sh
sh state
state, Array emiSh prob -> Vector (Hermitian (() ::+ emiSh)) prob
forall emiSh a.
(C emiSh, Floating a) =>
Array emiSh a -> Array (Hermitian (() ::+ emiSh)) a
extendedHermitian Array emiSh prob
v)) ([(state, Array emiSh prob)]
-> [(DeferredIndex sh, Vector (Hermitian (() ::+ emiSh)) prob)])
-> (T [] (state, Array emiSh prob) -> [(state, Array emiSh prob)])
-> T [] (state, Array emiSh prob)
-> [(DeferredIndex sh, Vector (Hermitian (() ::+ emiSh)) prob)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
T [] (state, Array emiSh prob) -> [(state, Array emiSh prob)]
forall (f :: * -> *) a. Cons f => T f a -> f a
NonEmpty.flatten
(T [] (state, Array emiSh prob)
-> Array (sh, Hermitian (() ::+ emiSh)) prob)
-> T [] (state, Array emiSh prob)
-> Array (sh, Hermitian (() ::+ emiSh)) prob
forall a b. (a -> b) -> a -> b
$ T [] (state, Array emiSh prob)
T [] (state, Emission (Gaussian emiSh) prob)
xs
trainVector :: Emission (Gaussian emiSh) prob
-> Vector sh prob -> Trained (Gaussian emiSh) sh prob
trainVector Emission (Gaussian emiSh) prob
xs Vector sh prob
probs =
Array (sh, Hermitian (() ::+ emiSh)) prob
-> Trained (Gaussian emiSh) sh prob
forall emiSh stateSh a.
Array (stateSh, Hermitian (() ::+ emiSh)) a
-> Trained (Gaussian emiSh) stateSh a
GaussianTrained (Array (sh, Hermitian (() ::+ emiSh)) prob
-> Trained (Gaussian emiSh) sh prob)
-> Array (sh, Hermitian (() ::+ emiSh)) prob
-> Trained (Gaussian emiSh) sh prob
forall a b. (a -> b) -> a -> b
$ Full Size Big Big sh (Hermitian (() ::+ emiSh)) prob
-> Array (sh, Hermitian (() ::+ emiSh)) prob
forall meas vert horiz height width a.
(Measure meas, C vert, C horiz, C height, C width, Floating a) =>
Full meas vert horiz height width a -> Array (height, width) a
Matrix.toRowMajor (Full Size Big Big sh (Hermitian (() ::+ emiSh)) prob
-> Array (sh, Hermitian (() ::+ emiSh)) prob)
-> Full Size Big Big sh (Hermitian (() ::+ emiSh)) prob
-> Array (sh, Hermitian (() ::+ emiSh)) prob
forall a b. (a -> b) -> a -> b
$ Vector sh prob
probs Vector sh prob
-> Vector (Hermitian (() ::+ emiSh)) prob
-> Full Size Big Big sh (Hermitian (() ::+ emiSh)) prob
forall height width a.
(C height, Eq height, C width, Eq width, Floating a) =>
Vector height a -> Vector width a -> General height width a
|*- Array emiSh prob -> Vector (Hermitian (() ::+ emiSh)) prob
forall emiSh a.
(C emiSh, Floating a) =>
Array emiSh a -> Array (Hermitian (() ::+ emiSh)) a
extendedHermitian Array emiSh prob
Emission (Gaussian emiSh) prob
xs
combine :: Trained (Gaussian emiSh) sh prob
-> Trained (Gaussian emiSh) sh prob
-> Trained (Gaussian emiSh) sh prob
combine (GaussianTrained m0) (GaussianTrained m1) =
Array (sh, Hermitian (() ::+ emiSh)) prob
-> Trained (Gaussian emiSh) sh prob
forall emiSh stateSh a.
Array (stateSh, Hermitian (() ::+ emiSh)) a
-> Trained (Gaussian emiSh) stateSh a
GaussianTrained (Array (sh, Hermitian (() ::+ emiSh)) prob
-> Trained (Gaussian emiSh) sh prob)
-> Array (sh, Hermitian (() ::+ emiSh)) prob
-> Trained (Gaussian emiSh) sh prob
forall a b. (a -> b) -> a -> b
$ Array (sh, Hermitian (() ::+ emiSh)) prob
-> Array (sh, Hermitian (() ::+ emiSh)) prob
-> Array (sh, Hermitian (() ::+ emiSh)) prob
forall sh a.
(C sh, Eq sh, Floating a) =>
Vector sh a -> Vector sh a -> Vector sh a
Vector.add Array (sh, Hermitian (() ::+ emiSh)) prob
m0 Array (sh, Hermitian (() ::+ emiSh)) prob
m1
normalize :: Trained (Gaussian emiSh) sh prob -> T (Gaussian emiSh) sh prob
normalize (GaussianTrained m) =
let params :: (Matrix typ xl xu lower upper meas vert horiz height width a,
General () sh a,
Matrix
(Array pack HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
sh
sh
a)
-> (Vector sh a,
Quadratic pack HermitianPositiveDefinite Filled Filled sh a)
params (Matrix typ xl xu lower upper meas vert horiz height width a
weight, General () sh a
centerSum, Matrix
(Array pack HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
sh
sh
a
covarianceSum) =
let c :: a
c = a -> a
forall a. Fractional a => a -> a
recip (Matrix typ xl xu lower upper meas vert horiz height width a
weightMatrix typ xl xu lower upper meas vert horiz height width a
-> (Index height, Index width) -> a
forall typ meas vert horiz height width a xl xu lower upper.
(Indexed typ, Measure meas, C vert, C horiz, Indexed height,
Indexed width, Floating a) =>
Matrix typ xl xu lower upper meas vert horiz height width a
-> (Index height, Index width) -> a
#!((),()))
center :: Vector sh a
center = a -> Vector sh a -> Vector sh a
forall sh a. (C sh, Floating a) => a -> Vector sh a -> Vector sh a
Vector.scale a
c (Vector sh a -> Vector sh a) -> Vector sh a -> Vector sh a
forall a b. (a -> b) -> a -> b
$ General () sh a -> Vector sh a
forall width a. General () width a -> Vector width a
Matrix.flattenRow General () sh a
centerSum
in (Vector sh a
center,
Matrix
(Array pack HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
sh
sh
a
-> Quadratic pack HermitianPositiveDefinite Filled Filled sh a
forall neg zero pos pack bands sh a.
(C neg, C zero, C pos) =>
AnyHermitianP pack neg zero pos bands sh a
-> Quadratic pack HermitianPositiveDefinite bands bands sh a
HermitianPD.assurePositiveDefiniteness (Matrix
(Array pack HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
sh
sh
a
-> Quadratic pack HermitianPositiveDefinite Filled Filled sh a)
-> Matrix
(Array pack HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
sh
sh
a
-> Quadratic pack HermitianPositiveDefinite Filled Filled sh a
forall a b. (a -> b) -> a -> b
$
Matrix
(Array pack HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
sh
sh
a
-> Matrix
(Array pack HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
sh
sh
a
-> Matrix
(Array pack HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
sh
sh
a
forall typ meas vert horiz xl xu height width a lower upper.
(Subtractive typ, Measure meas, C vert, C horiz,
SubtractiveExtra typ xl, SubtractiveExtra typ xu, C height,
Eq height, C width, Eq width, Floating a) =>
Matrix typ xl xu lower upper meas vert horiz height width a
-> Matrix typ xl xu lower upper meas vert horiz height width a
-> Matrix typ xl xu lower upper meas vert horiz height width a
Matrix.sub
(a
-> Matrix
(Array pack HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
sh
sh
a
-> Matrix
(Array pack HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
sh
sh
a
forall typ xl xu meas vert horiz height width a lower upper.
(Homogeneous typ, HomogeneousExtra typ xl, HomogeneousExtra typ xu,
Measure meas, C vert, C horiz, C height, C width, Real a) =>
a
-> Matrix typ xl xu lower upper meas vert horiz height width a
-> Matrix typ xl xu lower upper meas vert horiz height width a
Matrix.scaleRealReal a
c Matrix
(Array pack HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
sh
sh
a
covarianceSum)
(AnyHermitianP pack False True True Filled sh a
-> Matrix
(Array pack HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
sh
sh
a
forall neg zero pos pack bands sh a.
(C neg, C zero, C pos) =>
AnyHermitianP pack neg zero pos bands sh a
-> Quadratic pack HermitianUnknownDefiniteness bands bands sh a
Hermitian.relaxIndefinite (AnyHermitianP pack False True True Filled sh a
-> Matrix
(Array pack HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
sh
sh
a)
-> AnyHermitianP pack False True True Filled sh a
-> Matrix
(Array pack HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
sh
sh
a
forall a b. (a -> b) -> a -> b
$
Order
-> Vector sh a -> AnyHermitianP pack False True True Filled sh a
forall pack sh a.
(Packing pack, C sh, Floating a) =>
Order -> Vector sh a -> HermitianPosSemidefP pack sh a
Hermitian.outer Order
Layout.RowMajor Vector sh a
center))
in Array sh (prob, Vector emiSh prob, Upper emiSh prob)
-> T (Gaussian emiSh) sh prob
forall emiSh stateSh a.
Array stateSh (a, Vector emiSh a, Upper emiSh a)
-> T (Gaussian emiSh) stateSh a
Gaussian (Array sh (prob, Vector emiSh prob, Upper emiSh prob)
-> T (Gaussian emiSh) sh prob)
-> Array sh (prob, Vector emiSh prob, Upper emiSh prob)
-> T (Gaussian emiSh) sh prob
forall a b. (a -> b) -> a -> b
$
(Array (Hermitian (() ::+ emiSh)) prob
-> (prob, Vector emiSh prob, Upper emiSh prob))
-> Array sh (Array (Hermitian (() ::+ emiSh)) prob)
-> Array sh (prob, Vector emiSh prob, Upper emiSh prob)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Vector emiSh prob, HermitianPosDef emiSh prob)
-> (prob, Vector emiSh prob, Upper emiSh prob)
forall emiSh prob.
(C emiSh, Real prob) =>
(Vector emiSh prob, HermitianPosDef emiSh prob)
-> (prob, Vector emiSh prob, Upper emiSh prob)
gaussianParameters ((Vector emiSh prob, HermitianPosDef emiSh prob)
-> (prob, Vector emiSh prob, Upper emiSh prob))
-> (Array (Hermitian (() ::+ emiSh)) prob
-> (Vector emiSh prob, HermitianPosDef emiSh prob))
-> Array (Hermitian (() ::+ emiSh)) prob
-> (prob, Vector emiSh prob, Upper emiSh prob)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Matrix
(Array Packed HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
()
()
prob,
General () emiSh prob,
Matrix
(Array Packed HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
emiSh
emiSh
prob)
-> (Vector emiSh prob, HermitianPosDef emiSh prob)
forall a typ meas vert horiz height width pack sh xl xu lower
upper.
(Indexed typ, Measure meas, C vert, C horiz, Indexed height,
Indexed width, Real a, Packing pack, Eq sh, C sh,
Index height ~ (), Index width ~ ()) =>
(Matrix typ xl xu lower upper meas vert horiz height width a,
General () sh a,
Matrix
(Array pack HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
sh
sh
a)
-> (Vector sh a,
Quadratic pack HermitianPositiveDefinite Filled Filled sh a)
params ((Matrix
(Array Packed HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
()
()
prob,
General () emiSh prob,
Matrix
(Array Packed HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
emiSh
emiSh
prob)
-> (Vector emiSh prob, HermitianPosDef emiSh prob))
-> (Array (Hermitian (() ::+ emiSh)) prob
-> (Matrix
(Array Packed HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
()
()
prob,
General () emiSh prob,
Matrix
(Array Packed HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
emiSh
emiSh
prob))
-> Array (Hermitian (() ::+ emiSh)) prob
-> (Vector emiSh prob, HermitianPosDef emiSh prob)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
FlexHermitianP Packed True True True (() ::+ emiSh) prob
-> (Matrix
(Array Packed HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
()
()
prob,
General () emiSh prob,
Matrix
(Array Packed HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
emiSh
emiSh
prob)
forall pack neg zero pos sh0 sh1 a.
(Packing pack, C neg, C zero, C pos, C sh0, C sh1, Floating a) =>
FlexHermitianP pack neg zero pos (sh0 ::+ sh1) a
-> (FlexHermitianP pack neg zero pos sh0 a, General sh0 sh1 a,
FlexHermitianP pack neg zero pos sh1 a)
Hermitian.split (FlexHermitianP Packed True True True (() ::+ emiSh) prob
-> (Matrix
(Array Packed HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
()
()
prob,
General () emiSh prob,
Matrix
(Array Packed HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
emiSh
emiSh
prob))
-> (Array (Hermitian (() ::+ emiSh)) prob
-> FlexHermitianP Packed True True True (() ::+ emiSh) prob)
-> Array (Hermitian (() ::+ emiSh)) prob
-> (Matrix
(Array Packed HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
()
()
prob,
General () emiSh prob,
Matrix
(Array Packed HermitianUnknownDefiniteness)
()
()
Filled
Filled
Shape
Small
Small
emiSh
emiSh
prob)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array (Hermitian (() ::+ emiSh)) prob
-> FlexHermitianP Packed True True True (() ::+ emiSh) prob
forall pack prop lower upper meas vert horiz height width shape a.
(FromPlain pack prop lower upper meas vert horiz height width,
Plain pack prop lower upper meas vert horiz height width ~ shape,
Measure meas, C vert, C horiz, C height, C width, Floating a) =>
Array shape a
-> ArrayMatrix pack prop lower upper meas vert horiz height width a
ArrMatrix.fromVector) (Array sh (Array (Hermitian (() ::+ emiSh)) prob)
-> Array sh (prob, Vector emiSh prob, Upper emiSh prob))
-> Array sh (Array (Hermitian (() ::+ emiSh)) prob)
-> Array sh (prob, Vector emiSh prob, Upper emiSh prob)
forall a b. (a -> b) -> a -> b
$
Full Size Big Big sh (Hermitian (() ::+ emiSh)) prob
-> Array sh (Array (Hermitian (() ::+ emiSh)) prob)
forall meas vert horiz height width a.
(Measure meas, C vert, C horiz, C height, C width, Floating a) =>
Full meas vert horiz height width a
-> Array height (Vector width a)
Matrix.toRowArray (Full Size Big Big sh (Hermitian (() ::+ emiSh)) prob
-> Array sh (Array (Hermitian (() ::+ emiSh)) prob))
-> Full Size Big Big sh (Hermitian (() ::+ emiSh)) prob
-> Array sh (Array (Hermitian (() ::+ emiSh)) prob)
forall a b. (a -> b) -> a -> b
$ Array (sh, Hermitian (() ::+ emiSh)) prob
-> Full Size Big Big sh (Hermitian (() ::+ emiSh)) prob
forall height width a.
(C height, C width, Floating a) =>
Array (height, width) a -> General height width a
Matrix.fromRowMajor Array (sh, Hermitian (() ::+ emiSh)) prob
m
extendedHermitian ::
(Shape.C emiSh, Class.Floating a) =>
StorableArray.Array emiSh a ->
StorableArray.Array (Layout.Hermitian (()::+emiSh)) a
extendedHermitian :: Array emiSh a -> Array (Hermitian (() ::+ emiSh)) a
extendedHermitian =
ArrayMatrix
Packed
HermitianPositiveSemidefinite
Filled
Filled
Shape
Small
Small
(() ::+ emiSh)
(() ::+ emiSh)
a
-> Array (Hermitian (() ::+ emiSh)) a
forall pack property lower upper meas vert horiz height width a.
ToPlain pack property lower upper meas vert horiz height width =>
ArrayMatrix
pack property lower upper meas vert horiz height width a
-> PlainArray
pack property lower upper meas vert horiz height width a
ArrMatrix.toVector (ArrayMatrix
Packed
HermitianPositiveSemidefinite
Filled
Filled
Shape
Small
Small
(() ::+ emiSh)
(() ::+ emiSh)
a
-> Array (Hermitian (() ::+ emiSh)) a)
-> (Array emiSh a
-> ArrayMatrix
Packed
HermitianPositiveSemidefinite
Filled
Filled
Shape
Small
Small
(() ::+ emiSh)
(() ::+ emiSh)
a)
-> Array emiSh a
-> Array (Hermitian (() ::+ emiSh)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Order
-> Vector (() ::+ emiSh) a
-> ArrayMatrix
Packed
HermitianPositiveSemidefinite
Filled
Filled
Shape
Small
Small
(() ::+ emiSh)
(() ::+ emiSh)
a
forall pack sh a.
(Packing pack, C sh, Floating a) =>
Order -> Vector sh a -> HermitianPosSemidefP pack sh a
Hermitian.outer Order
Layout.RowMajor (Vector (() ::+ emiSh) a
-> ArrayMatrix
Packed
HermitianPositiveSemidefinite
Filled
Filled
Shape
Small
Small
(() ::+ emiSh)
(() ::+ emiSh)
a)
-> (Array emiSh a -> Vector (() ::+ emiSh) a)
-> Array emiSh a
-> ArrayMatrix
Packed
HermitianPositiveSemidefinite
Filled
Filled
Shape
Small
Small
(() ::+ emiSh)
(() ::+ emiSh)
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array () a -> Array emiSh a -> Vector (() ::+ emiSh) a
forall shx shy a.
(C shx, C shy, Storable a) =>
Array shx a -> Array shy a -> Array (shx ::+ shy) a
Vector.append (() -> Array () a
forall sh a. (C sh, Floating a) => sh -> Vector sh a
Vector.one ())
gaussianTrained ::
(TBool.C zero, Shape.C emiSh, Eq emiSh, Shape.C stateSh, Class.Real prob) =>
Array stateSh
(prob, Vector emiSh prob,
Matrix.FlexHermitian TBool.False zero TBool.True emiSh prob) ->
Trained (Gaussian emiSh) stateSh prob
gaussianTrained :: Array
stateSh
(prob, Vector emiSh prob, FlexHermitian False zero True emiSh prob)
-> Trained (Gaussian emiSh) stateSh prob
gaussianTrained =
Array (stateSh, Hermitian (() ::+ emiSh)) prob
-> Trained (Gaussian emiSh) stateSh prob
forall emiSh stateSh a.
Array (stateSh, Hermitian (() ::+ emiSh)) a
-> Trained (Gaussian emiSh) stateSh a
GaussianTrained (Array (stateSh, Hermitian (() ::+ emiSh)) prob
-> Trained (Gaussian emiSh) stateSh prob)
-> (Array
stateSh
(prob, Vector emiSh prob, FlexHermitian False zero True emiSh prob)
-> Array (stateSh, Hermitian (() ::+ emiSh)) prob)
-> Array
stateSh
(prob, Vector emiSh prob, FlexHermitian False zero True emiSh prob)
-> Trained (Gaussian emiSh) stateSh prob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Full Size Big Big stateSh (Hermitian (() ::+ emiSh)) prob
-> Array (stateSh, Hermitian (() ::+ emiSh)) prob
forall meas vert horiz height width a.
(Measure meas, C vert, C horiz, C height, C width, Floating a) =>
Full meas vert horiz height width a -> Array (height, width) a
Matrix.toRowMajor (Full Size Big Big stateSh (Hermitian (() ::+ emiSh)) prob
-> Array (stateSh, Hermitian (() ::+ emiSh)) prob)
-> (Array
stateSh
(prob, Vector emiSh prob, FlexHermitian False zero True emiSh prob)
-> Full Size Big Big stateSh (Hermitian (() ::+ emiSh)) prob)
-> Array
stateSh
(prob, Vector emiSh prob, FlexHermitian False zero True emiSh prob)
-> Array (stateSh, Hermitian (() ::+ emiSh)) prob
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String
-> Array stateSh (Array (Hermitian (() ::+ emiSh)) prob)
-> Full Size Big Big stateSh (Hermitian (() ::+ emiSh)) prob
forall width height a.
(C width, Eq width, C height, Real a) =>
String -> Array height (Array width a) -> General height width a
matrixFromRowArray String
"HMM.Distribution.gaussianTrained" (Array stateSh (Array (Hermitian (() ::+ emiSh)) prob)
-> Full Size Big Big stateSh (Hermitian (() ::+ emiSh)) prob)
-> (Array
stateSh
(prob, Vector emiSh prob, FlexHermitian False zero True emiSh prob)
-> Array stateSh (Array (Hermitian (() ::+ emiSh)) prob))
-> Array
stateSh
(prob, Vector emiSh prob, FlexHermitian False zero True emiSh prob)
-> Full Size Big Big stateSh (Hermitian (() ::+ emiSh)) prob
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((prob, Vector emiSh prob,
FlexHermitian False zero True emiSh prob)
-> Array (Hermitian (() ::+ emiSh)) prob)
-> Array
stateSh
(prob, Vector emiSh prob, FlexHermitian False zero True emiSh prob)
-> Array stateSh (Array (Hermitian (() ::+ emiSh)) prob)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\(prob
weight, Vector emiSh prob
center, FlexHermitian False zero True emiSh prob
covariance) ->
ArrayMatrix
Packed
HermitianUnknownDefiniteness
Filled
Filled
Shape
Small
Small
(() ::+ emiSh)
(() ::+ emiSh)
prob
-> PlainArray
Packed
HermitianUnknownDefiniteness
Filled
Filled
Shape
Small
Small
(() ::+ emiSh)
(() ::+ emiSh)
prob
forall pack property lower upper meas vert horiz height width a.
ToPlain pack property lower upper meas vert horiz height width =>
ArrayMatrix
pack property lower upper meas vert horiz height width a
-> PlainArray
pack property lower upper meas vert horiz height width a
ArrMatrix.toVector (ArrayMatrix
Packed
HermitianUnknownDefiniteness
Filled
Filled
Shape
Small
Small
(() ::+ emiSh)
(() ::+ emiSh)
prob
-> PlainArray
Packed
HermitianUnknownDefiniteness
Filled
Filled
Shape
Small
Small
(() ::+ emiSh)
(() ::+ emiSh)
prob)
-> ArrayMatrix
Packed
HermitianUnknownDefiniteness
Filled
Filled
Shape
Small
Small
(() ::+ emiSh)
(() ::+ emiSh)
prob
-> PlainArray
Packed
HermitianUnknownDefiniteness
Filled
Filled
Shape
Small
Small
(() ::+ emiSh)
(() ::+ emiSh)
prob
forall a b. (a -> b) -> a -> b
$
HermitianP Packed () prob
-> General () emiSh prob
-> HermitianP Packed emiSh prob
-> ArrayMatrix
Packed
HermitianUnknownDefiniteness
Filled
Filled
Shape
Small
Small
(() ::+ emiSh)
(() ::+ emiSh)
prob
forall pack sh0 sh1 a.
(Packing pack, C sh0, Eq sh0, C sh1, Eq sh1, Floating a) =>
HermitianP pack sh0 a
-> General sh0 sh1 a
-> HermitianP pack sh1 a
-> HermitianP pack (sh0 ::+ sh1) a
Hermitian.stack
(Order -> () -> [prob] -> HermitianP Packed () prob
forall sh a.
(C sh, Floating a) =>
Order -> sh -> [a] -> Hermitian sh a
Hermitian.fromList Order
Layout.RowMajor () [prob
weight])
(Order -> Vector emiSh prob -> General () emiSh prob
forall width a. Order -> Vector width a -> General () width a
Matrix.singleRow Order
Layout.RowMajor Vector emiSh prob
center)
(FlexHermitian False zero True emiSh prob
-> HermitianP Packed emiSh prob
forall neg zero pos pack bands sh a.
(C neg, C zero, C pos) =>
AnyHermitianP pack neg zero pos bands sh a
-> Quadratic pack HermitianUnknownDefiniteness bands bands sh a
Hermitian.relaxIndefinite FlexHermitian False zero True emiSh prob
covariance))
matrixFromRowArray ::
(Shape.C width, Eq width, Shape.C height, Class.Real a) =>
String ->
Array height (StorableArray.Array width a) ->
Matrix.General height width a
matrixFromRowArray :: String -> Array height (Array width a) -> General height width a
matrixFromRowArray String
name Array height (Array width a)
xs =
case Array height (Array width a) -> [Array width a]
forall sh a. C sh => Array sh a -> [a]
Array.toList Array height (Array width a)
xs of
[] -> String -> General height width a
forall a. HasCallStack => String -> a
error (String -> General height width a)
-> String -> General height width a
forall a b. (a -> b) -> a -> b
$ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": empty array"
Array width a
x:[Array width a]
_ -> width -> Array height (Array width a) -> General height width a
forall height width a.
(C height, C width, Eq width, Storable a) =>
width -> Array height (Vector width a) -> General height width a
Matrix.fromRowArray (Array width a -> width
forall sh a. Array sh a -> sh
StorableArray.shape Array width a
x) Array height (Array width a)
xs
gaussian ::
(Shape.C emiSh, Shape.C stateSh, Class.Real prob) =>
Array stateSh (Vector emiSh prob, Matrix.HermitianPosDef emiSh prob) ->
T (Gaussian emiSh) stateSh prob
gaussian :: Array stateSh (Vector emiSh prob, HermitianPosDef emiSh prob)
-> T (Gaussian emiSh) stateSh prob
gaussian = Array stateSh (prob, Vector emiSh prob, Upper emiSh prob)
-> T (Gaussian emiSh) stateSh prob
forall emiSh stateSh a.
Array stateSh (a, Vector emiSh a, Upper emiSh a)
-> T (Gaussian emiSh) stateSh a
Gaussian (Array stateSh (prob, Vector emiSh prob, Upper emiSh prob)
-> T (Gaussian emiSh) stateSh prob)
-> (Array stateSh (Vector emiSh prob, HermitianPosDef emiSh prob)
-> Array stateSh (prob, Vector emiSh prob, Upper emiSh prob))
-> Array stateSh (Vector emiSh prob, HermitianPosDef emiSh prob)
-> T (Gaussian emiSh) stateSh prob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Vector emiSh prob, HermitianPosDef emiSh prob)
-> (prob, Vector emiSh prob, Upper emiSh prob))
-> Array stateSh (Vector emiSh prob, HermitianPosDef emiSh prob)
-> Array stateSh (prob, Vector emiSh prob, Upper emiSh prob)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vector emiSh prob, HermitianPosDef emiSh prob)
-> (prob, Vector emiSh prob, Upper emiSh prob)
forall emiSh prob.
(C emiSh, Real prob) =>
(Vector emiSh prob, HermitianPosDef emiSh prob)
-> (prob, Vector emiSh prob, Upper emiSh prob)
gaussianParameters
gaussianParameters ::
(Shape.C emiSh, Class.Real prob) =>
(Vector emiSh prob, Matrix.HermitianPosDef emiSh prob) ->
(prob, Vector emiSh prob, Triangular.Upper emiSh prob)
gaussianParameters :: (Vector emiSh prob, HermitianPosDef emiSh prob)
-> (prob, Vector emiSh prob, Upper emiSh prob)
gaussianParameters (Vector emiSh prob
center, HermitianPosDef emiSh prob
covariance) =
Vector emiSh prob
-> Upper emiSh prob -> (prob, Vector emiSh prob, Upper emiSh prob)
forall emiSh prob.
(C emiSh, Real prob) =>
Vector emiSh prob
-> Upper emiSh prob -> (prob, Vector emiSh prob, Upper emiSh prob)
gaussianFromCholesky Vector emiSh prob
center (Upper emiSh prob -> (prob, Vector emiSh prob, Upper emiSh prob))
-> Upper emiSh prob -> (prob, Vector emiSh prob, Upper emiSh prob)
forall a b. (a -> b) -> a -> b
$ HermitianPosDef emiSh prob -> Upper emiSh prob
forall pack sh a.
(Packing pack, C sh, Floating a) =>
HermitianPosDefP pack sh a -> UpperP pack sh a
HermitianPD.decompose HermitianPosDef emiSh prob
covariance
gaussianFromCholesky ::
(Shape.C emiSh, Class.Real prob) =>
Vector emiSh prob -> Triangular.Upper emiSh prob ->
(prob, Vector emiSh prob, Triangular.Upper emiSh prob)
gaussianFromCholesky :: Vector emiSh prob
-> Upper emiSh prob -> (prob, Vector emiSh prob, Upper emiSh prob)
gaussianFromCholesky Vector emiSh prob
center Upper emiSh prob
covarianceChol =
let covarianceSqrtDet :: prob
covarianceSqrtDet =
Vector emiSh prob -> prob
forall sh a. (C sh, Floating a) => Vector sh a -> a
Vector.product (Vector emiSh prob -> prob) -> Vector emiSh prob -> prob
forall a b. (a -> b) -> a -> b
$ Upper emiSh prob -> Vector emiSh prob
forall lo up diag sh a pack.
(PowerStrip lo, PowerStrip up, TriDiag diag, C sh, Floating a) =>
TriangularP pack lo diag up sh a -> Vector sh a
Triangular.takeDiagonal Upper emiSh prob
covarianceChol
in (prob -> prob
forall a. Fractional a => a -> a
recip (prob
forall a. Real a => a
sqrt2pi prob -> Int -> prob
forall a b. (Num a, Integral b) => a -> b -> a
^ Vector emiSh prob -> Int
forall sh a. C sh => Vector sh a -> Int
vectorDim Vector emiSh prob
center prob -> prob -> prob
forall a. Num a => a -> a -> a
* prob
covarianceSqrtDet),
Vector emiSh prob
center, Upper emiSh prob
covarianceChol)
sqrt2pi :: (Class.Real a) => a
sqrt2pi :: a
sqrt2pi = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> Identity a -> a
forall a b. (a -> b) -> a -> b
$ Identity Float -> Identity Double -> Identity a
forall a (f :: * -> *). Real a => f Float -> f Double -> f a
Class.switchReal Identity Float
forall a. Floating a => Identity a
sqrt2piAux Identity Double
forall a. Floating a => Identity a
sqrt2piAux
sqrt2piAux :: (Floating a) => Identity a
sqrt2piAux :: Identity a
sqrt2piAux = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> a -> Identity a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
sqrt (a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
forall a. Floating a => a
pi)
class ToCSV typ where
toCells ::
(Shape.C sh, Class.Real prob, P.Show prob) =>
T typ sh prob -> [[String]]
class FromCSV typ where
parseCells ::
(Shape.C sh, Eq sh, Class.Real prob, Read prob) =>
sh -> HMMCSV.CSVParser (T typ sh prob)
class (Ord symbol) => CSVSymbol symbol where
cellFromSymbol :: symbol -> String
symbolFromCell :: String -> Maybe symbol
instance CSVSymbol Char where
cellFromSymbol :: Char -> String
cellFromSymbol = (Char -> ShowS
forall a. a -> [a] -> [a]
:[])
symbolFromCell :: String -> Maybe Char
symbolFromCell = String -> Maybe Char
forall a. [a] -> Maybe a
listToMaybe
instance CSVSymbol Int where
cellFromSymbol :: Int -> String
cellFromSymbol = Int -> String
forall a. Show a => a -> String
show
symbolFromCell :: String -> Maybe Int
symbolFromCell = String -> Maybe Int
forall a. Read a => String -> Maybe a
maybeRead
instance (CSVSymbol symbol) => ToCSV (Discrete symbol) where
toCells :: T (Discrete symbol) sh prob -> [[String]]
toCells (Discrete m) =
((symbol, Vector sh prob) -> [String])
-> [(symbol, Vector sh prob)] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map
(\(symbol
symbol, Vector sh prob
probs) ->
symbol -> String
forall symbol. CSVSymbol symbol => symbol -> String
cellFromSymbol symbol
symbol String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Vector sh prob -> [String]
forall sh a. (C sh, Show a, Real a) => Vector sh a -> [String]
HMMCSV.cellsFromVector Vector sh prob
probs) ([(symbol, Vector sh prob)] -> [[String]])
-> [(symbol, Vector sh prob)] -> [[String]]
forall a b. (a -> b) -> a -> b
$
Array (Set symbol) (Vector sh prob)
-> [(Index (Set symbol), Vector sh prob)]
forall sh a. Indexed sh => Array sh a -> [(Index sh, a)]
Array.toAssociations (Array (Set symbol) (Vector sh prob)
-> [(Index (Set symbol), Vector sh prob)])
-> Array (Set symbol) (Vector sh prob)
-> [(Index (Set symbol), Vector sh prob)]
forall a b. (a -> b) -> a -> b
$ Full Size Big Big (Set symbol) sh prob
-> Array (Set symbol) (Vector sh prob)
forall meas vert horiz height width a.
(Measure meas, C vert, C horiz, C height, C width, Floating a) =>
Full meas vert horiz height width a
-> Array height (Vector width a)
Matrix.toRowArray Full Size Big Big (Set symbol) sh prob
m
instance (CSVSymbol symbol) => FromCSV (Discrete symbol) where
parseCells :: sh -> CSVParser (T (Discrete symbol) sh prob)
parseCells sh
n =
let p :: CSVRow -> CSVParser (symbol, Vector sh prob)
p = sh -> CSVRow -> CSVParser (symbol, Vector sh prob)
forall sh prob symbol.
(C sh, Real prob, Read prob, CSVSymbol symbol) =>
sh -> CSVRow -> CSVParser (symbol, Vector sh prob)
parseSymbolProb sh
n
in (T [] (symbol, Vector sh prob) -> T (Discrete symbol) sh prob)
-> StateT
CSVResult (Exceptional String) (T [] (symbol, Vector sh prob))
-> CSVParser (T (Discrete symbol) sh prob)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T [] (symbol, Vector sh prob) -> T (Discrete symbol) sh prob
forall symbol sh prob.
(Ord symbol, C sh, Eq sh, Real prob) =>
T [] (symbol, Vector sh prob) -> T (Discrete symbol) sh prob
discreteFromList (StateT
CSVResult (Exceptional String) (T [] (symbol, Vector sh prob))
-> CSVParser (T (Discrete symbol) sh prob))
-> StateT
CSVResult (Exceptional String) (T [] (symbol, Vector sh prob))
-> CSVParser (T (Discrete symbol) sh prob)
forall a b. (a -> b) -> a -> b
$
((symbol, Vector sh prob)
-> [(symbol, Vector sh prob)] -> T [] (symbol, Vector sh prob))
-> CSVParser (symbol, Vector sh prob)
-> StateT CSVResult (Exceptional String) [(symbol, Vector sh prob)]
-> StateT
CSVResult (Exceptional String) (T [] (symbol, Vector sh prob))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (symbol, Vector sh prob)
-> [(symbol, Vector sh prob)] -> T [] (symbol, Vector sh prob)
forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons (CSVParser CSVRow
HMMCSV.getRow CSVParser CSVRow
-> (CSVRow -> CSVParser (symbol, Vector sh prob))
-> CSVParser (symbol, Vector sh prob)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSVRow -> CSVParser (symbol, Vector sh prob)
p) ((CSVRow -> CSVParser (symbol, Vector sh prob))
-> StateT CSVResult (Exceptional String) [(symbol, Vector sh prob)]
forall a. (CSVRow -> CSVParser a) -> CSVParser [a]
HMMCSV.manyRowsUntilEnd CSVRow -> CSVParser (symbol, Vector sh prob)
p)
parseSymbolProb ::
(Shape.C sh, Class.Real prob, Read prob, CSVSymbol symbol) =>
sh -> CSV.CSVRow -> HMMCSV.CSVParser (symbol, Vector sh prob)
parseSymbolProb :: sh -> CSVRow -> CSVParser (symbol, Vector sh prob)
parseSymbolProb sh
sh CSVRow
row =
case CSVRow
row of
[] -> Exceptional String (symbol, Vector sh prob)
-> CSVParser (symbol, Vector sh prob)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (Exceptional String (symbol, Vector sh prob)
-> CSVParser (symbol, Vector sh prob))
-> Exceptional String (symbol, Vector sh prob)
-> CSVParser (symbol, Vector sh prob)
forall a b. (a -> b) -> a -> b
$ String -> Exceptional String (symbol, Vector sh prob)
forall e a. e -> Exceptional e a
ME.throw String
"missing symbol"
CSVField
c:CSVRow
cs ->
(symbol -> Vector sh prob -> (symbol, Vector sh prob))
-> StateT CSVResult (Exceptional String) symbol
-> StateT CSVResult (Exceptional String) (Vector sh prob)
-> CSVParser (symbol, Vector sh prob)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,)
(let str :: String
str = CSVField -> String
CSV.csvFieldContent CSVField
c
in Exceptional String symbol
-> StateT CSVResult (Exceptional String) symbol
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (Exceptional String symbol
-> StateT CSVResult (Exceptional String) symbol)
-> Exceptional String symbol
-> StateT CSVResult (Exceptional String) symbol
forall a b. (a -> b) -> a -> b
$ String -> Maybe symbol -> Exceptional String symbol
forall e a. e -> Maybe a -> Exceptional e a
ME.fromMaybe (String -> ShowS
forall r. PrintfType r => String -> r
printf String
"unknown symbol %s" String
str) (Maybe symbol -> Exceptional String symbol)
-> Maybe symbol -> Exceptional String symbol
forall a b. (a -> b) -> a -> b
$
String -> Maybe symbol
forall symbol. CSVSymbol symbol => String -> Maybe symbol
symbolFromCell String
str)
(do Vector ShapeInt prob
v <- CSVRow -> CSVParser (Vector ShapeInt prob)
forall a.
(Read a, Real a) =>
CSVRow -> CSVParser (Vector ShapeInt a)
HMMCSV.parseVectorFields CSVRow
cs
let n :: Int
n = sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh
let m :: Int
m = Vector ShapeInt prob -> Int
forall sh a. C sh => Vector sh a -> Int
vectorDim Vector ShapeInt prob
v
Bool -> String -> CSVParser ()
HMMCSV.assert (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m)
(String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"number of states (%d) and size of probability vector (%d) mismatch"
Int
n Int
m)
Vector sh prob
-> StateT CSVResult (Exceptional String) (Vector sh prob)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector sh prob
-> StateT CSVResult (Exceptional String) (Vector sh prob))
-> Vector sh prob
-> StateT CSVResult (Exceptional String) (Vector sh prob)
forall a b. (a -> b) -> a -> b
$ sh -> Vector ShapeInt prob -> Vector sh prob
forall sh0 sh1 a.
(C sh0, C sh1) =>
sh1 -> Array sh0 a -> Array sh1 a
StorableArray.reshape sh
sh Vector ShapeInt prob
v)
instance (Shape.Indexed emiSh) => ToCSV (Gaussian emiSh) where
toCells :: T (Gaussian emiSh) sh prob -> [[String]]
toCells (Gaussian params) =
[[String]] -> [[[String]]] -> [[String]]
forall a. [a] -> [[a]] -> [a]
List.intercalate [[]] ([[[String]]] -> [[String]]) -> [[[String]]] -> [[String]]
forall a b. (a -> b) -> a -> b
$
((prob, Vector emiSh prob,
TriangularP Packed Empty Arbitrary Filled emiSh prob)
-> [[String]])
-> [(prob, Vector emiSh prob,
TriangularP Packed Empty Arbitrary Filled emiSh prob)]
-> [[[String]]]
forall a b. (a -> b) -> [a] -> [b]
map
(\(prob
_, Vector emiSh prob
center, TriangularP Packed Empty Arbitrary Filled emiSh prob
covarianceChol) ->
Vector emiSh prob -> [String]
forall sh a. (C sh, Show a, Real a) => Vector sh a -> [String]
HMMCSV.cellsFromVector Vector emiSh prob
center [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
:
Square emiSh prob -> [[String]]
forall sh a.
(Indexed sh, Show a, Real a) =>
Square sh a -> [[String]]
HMMCSV.cellsFromSquare (TriangularP Packed Empty Arbitrary Filled emiSh prob
-> Square emiSh prob
forall lo up diag sh a pack.
(PowerStrip lo, PowerStrip up, TriDiag diag, C sh, Floating a) =>
TriangularP pack lo diag up sh a -> Square sh a
Triangular.toSquare TriangularP Packed Empty Arbitrary Filled emiSh prob
covarianceChol)) ([(prob, Vector emiSh prob,
TriangularP Packed Empty Arbitrary Filled emiSh prob)]
-> [[[String]]])
-> [(prob, Vector emiSh prob,
TriangularP Packed Empty Arbitrary Filled emiSh prob)]
-> [[[String]]]
forall a b. (a -> b) -> a -> b
$
Array
sh
(prob, Vector emiSh prob,
TriangularP Packed Empty Arbitrary Filled emiSh prob)
-> [(prob, Vector emiSh prob,
TriangularP Packed Empty Arbitrary Filled emiSh prob)]
forall sh a. C sh => Array sh a -> [a]
Array.toList Array
sh
(prob, Vector emiSh prob,
TriangularP Packed Empty Arbitrary Filled emiSh prob)
params
instance (emiSh ~ Matrix.ShapeInt) => FromCSV (Gaussian emiSh) where
parseCells :: sh -> CSVParser (T (Gaussian emiSh) sh prob)
parseCells sh
sh = do
let n :: Int
n = sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh
[(prob, Vector emiSh prob, Upper emiSh prob)]
gs <- CSVParser (prob, Vector emiSh prob, Upper emiSh prob)
-> CSVParser [(prob, Vector emiSh prob, Upper emiSh prob)]
forall a. CSVParser a -> CSVParser [a]
HMMCSV.manySepUntilEnd CSVParser (prob, Vector emiSh prob, Upper emiSh prob)
forall emiSh prob.
(emiSh ~ ShapeInt, Real prob, Eq prob, Read prob) =>
CSVParser (prob, Vector emiSh prob, Upper emiSh prob)
parseSingleGaussian
Bool -> String -> CSVParser ()
HMMCSV.assert ([(prob, Vector emiSh prob, Upper emiSh prob)] -> Int
forall a. [a] -> Int
length [(prob, Vector emiSh prob, Upper emiSh prob)]
gs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n) (String -> CSVParser ()) -> String -> CSVParser ()
forall a b. (a -> b) -> a -> b
$
String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"number of states (%d) and number of Gaussians (%d) mismatch"
Int
n ([(prob, Vector emiSh prob, Upper emiSh prob)] -> Int
forall a. [a] -> Int
length [(prob, Vector emiSh prob, Upper emiSh prob)]
gs)
let sizes :: [Int]
sizes = ((prob, Vector emiSh prob, Upper emiSh prob) -> Int)
-> [(prob, Vector emiSh prob, Upper emiSh prob)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Vector emiSh prob -> Int
forall sh a. C sh => Vector sh a -> Int
vectorDim (Vector emiSh prob -> Int)
-> ((prob, Vector emiSh prob, Upper emiSh prob)
-> Vector emiSh prob)
-> (prob, Vector emiSh prob, Upper emiSh prob)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (prob, Vector emiSh prob, Upper emiSh prob) -> Vector emiSh prob
forall a b c. (a, b, c) -> b
snd3) [(prob, Vector emiSh prob, Upper emiSh prob)]
gs
Bool -> String -> CSVParser ()
HMMCSV.assert ([Int] -> Bool
forall a. Eq a => [a] -> Bool
ListHT.allEqual [Int]
sizes) (String -> CSVParser ()) -> String -> CSVParser ()
forall a b. (a -> b) -> a -> b
$
String -> ShowS
forall r. PrintfType r => String -> r
printf String
"dimensions of emissions mismatch: %s" ([Int] -> String
forall a. Show a => a -> String
show [Int]
sizes)
T (Gaussian emiSh) sh prob
-> CSVParser (T (Gaussian emiSh) sh prob)
forall (m :: * -> *) a. Monad m => a -> m a
return (T (Gaussian emiSh) sh prob
-> CSVParser (T (Gaussian emiSh) sh prob))
-> T (Gaussian emiSh) sh prob
-> CSVParser (T (Gaussian emiSh) sh prob)
forall a b. (a -> b) -> a -> b
$ Array sh (prob, Vector emiSh prob, Upper emiSh prob)
-> T (Gaussian emiSh) sh prob
forall emiSh stateSh a.
Array stateSh (a, Vector emiSh a, Upper emiSh a)
-> T (Gaussian emiSh) stateSh a
Gaussian (Array sh (prob, Vector emiSh prob, Upper emiSh prob)
-> T (Gaussian emiSh) sh prob)
-> Array sh (prob, Vector emiSh prob, Upper emiSh prob)
-> T (Gaussian emiSh) sh prob
forall a b. (a -> b) -> a -> b
$ sh
-> [(prob, Vector emiSh prob, Upper emiSh prob)]
-> Array sh (prob, Vector emiSh prob, Upper emiSh prob)
forall sh a. C sh => sh -> [a] -> Array sh a
Array.fromList sh
sh [(prob, Vector emiSh prob, Upper emiSh prob)]
gs
parseSingleGaussian ::
(emiSh ~ Matrix.ShapeInt, Class.Real prob, Eq prob, Read prob) =>
HMMCSV.CSVParser (prob, Vector emiSh prob, Triangular.Upper emiSh prob)
parseSingleGaussian :: CSVParser (prob, Vector emiSh prob, Upper emiSh prob)
parseSingleGaussian = do
Vector ShapeInt prob
center <- CSVParser (Vector ShapeInt prob)
forall a. (Read a, Real a) => CSVParser (Vector ShapeInt a)
HMMCSV.parseNonEmptyVectorCells
Square ShapeInt prob
covarianceCholSquare <-
ShapeInt -> CSVParser (Square ShapeInt prob)
forall sh a.
(C sh, Read a, Real a) =>
sh -> CSVParser (Square sh a)
HMMCSV.parseSquareMatrixCells (ShapeInt -> CSVParser (Square ShapeInt prob))
-> ShapeInt -> CSVParser (Square ShapeInt prob)
forall a b. (a -> b) -> a -> b
$ Vector ShapeInt prob -> ShapeInt
forall sh a. Array sh a -> sh
StorableArray.shape Vector ShapeInt prob
center
let covarianceChol :: Upper ShapeInt prob
covarianceChol = Square ShapeInt prob -> Upper ShapeInt prob
forall property lower meas vert height width a.
(Property property, Strip lower, Measure meas, C vert, C height,
C width, Floating a) =>
Unpacked property lower Filled meas vert Small height width a
-> Upper width a
Triangular.takeUpper Square ShapeInt prob
covarianceCholSquare
Bool -> String -> CSVParser ()
HMMCSV.assert
(Square ShapeInt prob -> Upper ShapeInt prob -> Bool
forall sh a.
(C sh, Real a, Eq a) =>
Square sh a -> Upper sh a -> Bool
isUpperTriang Square ShapeInt prob
covarianceCholSquare Upper ShapeInt prob
covarianceChol)
String
"matrices must be upper triangular"
(prob, Vector ShapeInt prob, Upper ShapeInt prob)
-> StateT
CSVResult
(Exceptional String)
(prob, Vector ShapeInt prob, Upper ShapeInt prob)
forall (m :: * -> *) a. Monad m => a -> m a
return ((prob, Vector ShapeInt prob, Upper ShapeInt prob)
-> StateT
CSVResult
(Exceptional String)
(prob, Vector ShapeInt prob, Upper ShapeInt prob))
-> (prob, Vector ShapeInt prob, Upper ShapeInt prob)
-> StateT
CSVResult
(Exceptional String)
(prob, Vector ShapeInt prob, Upper ShapeInt prob)
forall a b. (a -> b) -> a -> b
$ Vector ShapeInt prob
-> Upper ShapeInt prob
-> (prob, Vector ShapeInt prob, Upper ShapeInt prob)
forall emiSh prob.
(C emiSh, Real prob) =>
Vector emiSh prob
-> Upper emiSh prob -> (prob, Vector emiSh prob, Upper emiSh prob)
gaussianFromCholesky Vector ShapeInt prob
center Upper ShapeInt prob
covarianceChol
isUpperTriang ::
(Shape.C sh, Class.Real a, Eq a) =>
Matrix.Square sh a -> Triangular.Upper sh a -> Bool
isUpperTriang :: Square sh a -> Upper sh a -> Bool
isUpperTriang Square sh a
m Upper sh a
mt =
Vector (Full Shape Small Small sh sh) a -> [a]
forall sh a. (C sh, Storable a) => Vector sh a -> [a]
Vector.toList (Square sh a
-> PlainArray
Unpacked Arbitrary Filled Filled Shape Small Small sh sh a
forall pack property lower upper meas vert horiz height width a.
ToPlain pack property lower upper meas vert horiz height width =>
ArrayMatrix
pack property lower upper meas vert horiz height width a
-> PlainArray
pack property lower upper meas vert horiz height width a
ArrMatrix.toVector Square sh a
m)
[a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
==
Vector (Full Shape Small Small sh sh) a -> [a]
forall sh a. (C sh, Storable a) => Vector sh a -> [a]
Vector.toList (Square sh a
-> PlainArray
Unpacked Arbitrary Filled Filled Shape Small Small sh sh a
forall pack property lower upper meas vert horiz height width a.
ToPlain pack property lower upper meas vert horiz height width =>
ArrayMatrix
pack property lower upper meas vert horiz height width a
-> PlainArray
pack property lower upper meas vert horiz height width a
ArrMatrix.toVector (Upper sh a -> Square sh a
forall lo up diag sh a pack.
(PowerStrip lo, PowerStrip up, TriDiag diag, C sh, Floating a) =>
TriangularP pack lo diag up sh a -> Square sh a
Triangular.toSquare Upper sh a
mt))