{-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver -fplugin=GHC.TypeLits.Normalise -fconstraint-solver-iterations=10 #-}
{-# LANGUAGE UndecidableInstances #-}
module Goal.Graphical.Models.Dynamic
(
LatentProcess (LatentProcess)
, HiddenMarkovModel
, SimpleKalmanFilter
, KalmanFilter
, sampleLatentProcess
, joinLatentProcess
, splitLatentProcess
, conjugatedFiltering
, conjugatedSmoothing
, conjugatedSmoothing0
) where
import Goal.Core
import Goal.Geometry
import Goal.Probability
import Goal.Graphical.Models
import Goal.Graphical.Inference
import Goal.Graphical.Models.Harmonium
import Data.List
newtype LatentProcess f g y x z w
= LatentProcess (AffineHarmonium f y x z w, Affine g x w x)
type HiddenMarkovModel n k =
LatentProcess Tensor Tensor (Categorical n) (Categorical n) (Categorical k) (Categorical k)
type SimpleKalmanFilter = LatentProcess Tensor Tensor NormalMean NormalMean Normal Normal
type KalmanFilter n k
= LatentProcess Tensor Tensor (MVNMean n) (MVNMean k) (MultivariateNormal n) (MultivariateNormal k)
type instance Observation (LatentProcess f g y x z w) = Sample z
deriving instance (Manifold (AffineHarmonium f y x z w), Manifold (Affine g x w x))
=> Manifold (LatentProcess f g y x z w)
deriving instance (Manifold (AffineHarmonium f y x z w), Manifold (Affine g x w x))
=> Product (LatentProcess f g y x z w)
splitLatentProcess
:: (Manifold z, Manifold w, Manifold (f y x), Manifold (g x x))
=> c # LatentProcess f g y x z w
-> (c # w, c # Affine f y z x, c # Affine g x w x)
splitLatentProcess :: (c # LatentProcess f g y x z w)
-> (c # w, c # Affine f y z x, c # Affine g x w x)
splitLatentProcess c # LatentProcess f g y x z w
ltnt =
let (c # AffineHarmonium f y x z w
hrm,c # Affine g x w x
trns) = (c # LatentProcess f g y x z w)
-> (c # First (LatentProcess f g y x z w),
c # Second (LatentProcess f g y x z w))
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split c # LatentProcess f g y x z w
ltnt
(c # Affine f y z x
emsn,c # w
prr) = (c # AffineHarmonium f y x z w)
-> (c # First (AffineHarmonium f y x z w),
c # Second (AffineHarmonium f y x z w))
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split c # AffineHarmonium f y x z w
hrm
in (c # w
prr,c # Affine f y z x
emsn,c # Affine g x w x
trns)
joinLatentProcess
:: (Manifold z, Manifold w, Manifold (f y x), Manifold (g x x))
=> c # w
-> c # Affine f y z x
-> c # Affine g x w x
-> c # LatentProcess f g y x z w
joinLatentProcess :: (c # w)
-> (c # Affine f y z x)
-> (c # Affine g x w x)
-> c # LatentProcess f g y x z w
joinLatentProcess c # w
prr c # Affine f y z x
emsn c # Affine g x w x
trns =
let hrm :: c # AffineHarmonium f y x z w
hrm = (c # First (AffineHarmonium f y x z w))
-> (c # Second (AffineHarmonium f y x z w))
-> c # AffineHarmonium f y x z w
forall z c. Product z => (c # First z) -> (c # Second z) -> c # z
join c # First (AffineHarmonium f y x z w)
c # Affine f y z x
emsn c # w
c # Second (AffineHarmonium f y x z w)
prr
in (c # First (LatentProcess f g y x z w))
-> (c # Second (LatentProcess f g y x z w))
-> c # LatentProcess f g y x z w
forall z c. Product z => (c # First z) -> (c # Second z) -> c # z
join c # First (LatentProcess f g y x z w)
c # AffineHarmonium f y x z w
hrm c # Second (LatentProcess f g y x z w)
c # Affine g x w x
trns
latentProcessTransition
:: ( SamplePoint w ~ SamplePoint x, ExponentialFamily z
, Translation w x, Translation z y, Map Natural g x x
, ExponentialFamily x, Bilinear f x x
, Generative Natural w, Generative Natural z
, Bilinear g z x, Map Natural f y x )
=> Natural # Affine f y z x
-> Natural # Affine g x w x
-> SamplePoint w
-> Random (SamplePoint (z,w))
latentProcessTransition :: (Natural # Affine f y z x)
-> (Natural # Affine g x w x)
-> SamplePoint w
-> Random (SamplePoint (z, w))
latentProcessTransition Natural # Affine f y z x
emsn Natural # Affine g x w x
trns SamplePoint w
w = do
SamplePoint x
w' <- Point Natural w -> Random (SamplePoint w)
forall c x. Generative c x => Point c x -> Random (SamplePoint x)
samplePoint (Point Natural w -> Random (SamplePoint w))
-> Point Natural w -> Random (SamplePoint w)
forall a b. (a -> b) -> a -> b
$ Natural # Affine g x w x
trns (Natural # Affine g x w x) -> SamplePoint x -> Point Natural w
forall (f :: Type -> Type -> Type) y x.
(Map Natural f y x, ExponentialFamily x) =>
(Natural # f y x) -> SamplePoint x -> Natural # y
>.>* SamplePoint w
SamplePoint x
w
SamplePoint z
z' <- Point Natural z -> Random (SamplePoint z)
forall c x. Generative c x => Point c x -> Random (SamplePoint x)
samplePoint (Point Natural z -> Random (SamplePoint z))
-> Point Natural z -> Random (SamplePoint z)
forall a b. (a -> b) -> a -> b
$ Natural # Affine f y z x
emsn (Natural # Affine f y z x) -> SamplePoint x -> Point Natural z
forall (f :: Type -> Type -> Type) y x.
(Map Natural f y x, ExponentialFamily x) =>
(Natural # f y x) -> SamplePoint x -> Natural # y
>.>* SamplePoint x
w'
(SamplePoint z, SamplePoint x)
-> Random (SamplePoint z, SamplePoint x)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SamplePoint z
z',SamplePoint x
w')
sampleLatentProcess
:: ( SamplePoint w ~ SamplePoint x, ExponentialFamily z
, Translation w x, Translation z y, Map Natural g x x
, ExponentialFamily x, Bilinear f x x
, Generative Natural w, Generative Natural z
, Bilinear g z x, Map Natural f y x )
=> Int
-> Natural # LatentProcess f g y x z w
-> Random (Sample (z,x))
sampleLatentProcess :: Int
-> (Natural # LatentProcess f g y x z w) -> Random (Sample (z, x))
sampleLatentProcess Int
n Natural # LatentProcess f g y x z w
ltnt = do
let (Natural # w
prr,Natural # Affine f y z x
emsn,Natural # Affine g x w x
trns) = (Natural # LatentProcess f g y x z w)
-> (Natural # w, Natural # Affine f y z x,
Natural # Affine g x w x)
forall z w (f :: Type -> Type -> Type) y x
(g :: Type -> Type -> Type) c.
(Manifold z, Manifold w, Manifold (f y x), Manifold (g x x)) =>
(c # LatentProcess f g y x z w)
-> (c # w, c # Affine f y z x, c # Affine g x w x)
splitLatentProcess Natural # LatentProcess f g y x z w
ltnt
SamplePoint x
x0 <- (Natural # w) -> Random (SamplePoint w)
forall c x. Generative c x => Point c x -> Random (SamplePoint x)
samplePoint Natural # w
prr
SamplePoint z
z0 <- Point Natural z -> Random (SamplePoint z)
forall c x. Generative c x => Point c x -> Random (SamplePoint x)
samplePoint (Point Natural z -> Random (SamplePoint z))
-> Point Natural z -> Random (SamplePoint z)
forall a b. (a -> b) -> a -> b
$ Natural # Affine f y z x
emsn (Natural # Affine f y z x) -> SamplePoint x -> Point Natural z
forall (f :: Type -> Type -> Type) y x.
(Map Natural f y x, ExponentialFamily x) =>
(Natural # f y x) -> SamplePoint x -> Natural # y
>.>* SamplePoint x
x0
Int
-> ((SamplePoint z, SamplePoint x)
-> Random (SamplePoint z, SamplePoint x))
-> (SamplePoint z, SamplePoint x)
-> Random [(SamplePoint z, SamplePoint x)]
forall (m :: Type -> Type) x.
Monad m =>
Int -> (x -> m x) -> x -> m [x]
iterateM (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ((Natural # Affine f y z x)
-> (Natural # Affine g x w x)
-> SamplePoint w
-> Random (SamplePoint (z, w))
forall w x z y (g :: Type -> Type -> Type)
(f :: Type -> Type -> Type).
(SamplePoint w ~ SamplePoint x, ExponentialFamily z,
Translation w x, Translation z y, Map Natural g x x,
ExponentialFamily x, Bilinear f x x, Generative Natural w,
Generative Natural z, Bilinear g z x, Map Natural f y x) =>
(Natural # Affine f y z x)
-> (Natural # Affine g x w x)
-> SamplePoint w
-> Random (SamplePoint (z, w))
latentProcessTransition Natural # Affine f y z x
emsn Natural # Affine g x w x
trns (SamplePoint x -> Random (SamplePoint z, SamplePoint x))
-> ((SamplePoint z, SamplePoint x) -> SamplePoint x)
-> (SamplePoint z, SamplePoint x)
-> Random (SamplePoint z, SamplePoint x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SamplePoint z, SamplePoint x) -> SamplePoint x
forall a b. (a, b) -> b
snd) (SamplePoint z
z0,SamplePoint x
x0)
conjugatedFiltering
:: ( ConjugatedLikelihood g x x w w, Bilinear g x x
, ConjugatedLikelihood f y x z w, Bilinear f y x
, Map Natural g x x, Map Natural f x y )
=> Natural # LatentProcess f g y x z w
-> Sample z
-> [Natural # w]
conjugatedFiltering :: (Natural # LatentProcess f g y x z w) -> Sample z -> [Natural # w]
conjugatedFiltering Natural # LatentProcess f g y x z w
_ [] = []
conjugatedFiltering Natural # LatentProcess f g y x z w
ltnt (SamplePoint z
z:Sample z
zs') =
let (Natural # w
prr,Natural # Affine f y z x
emsn,Natural # Affine g x w x
trns) = (Natural # LatentProcess f g y x z w)
-> (Natural # w, Natural # Affine f y z x,
Natural # Affine g x w x)
forall z w (f :: Type -> Type -> Type) y x
(g :: Type -> Type -> Type) c.
(Manifold z, Manifold w, Manifold (f y x), Manifold (g x x)) =>
(c # LatentProcess f g y x z w)
-> (c # w, c # Affine f y z x, c # Affine g x w x)
splitLatentProcess Natural # LatentProcess f g y x z w
ltnt
prr' :: Natural # w
prr' = (Natural # Affine f y z x)
-> (Natural # w) -> SamplePoint z -> Natural # w
forall (f :: Type -> Type -> Type) y x z w.
(Map Natural f x y, Bilinear f y x,
ConjugatedLikelihood f y x z w) =>
(Natural # Affine f y z x)
-> (Natural # w) -> SamplePoint z -> Natural # w
conjugatedBayesRule Natural # Affine f y z x
emsn Natural # w
prr SamplePoint z
z
in ((Natural # w) -> SamplePoint z -> Natural # w)
-> (Natural # w) -> Sample z -> [Natural # w]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' ((Natural # Affine g x w x)
-> (Natural # Affine f y z x)
-> (Natural # w)
-> SamplePoint z
-> Natural # w
forall (g :: Type -> Type -> Type) x w (f :: Type -> Type -> Type)
y z.
(ConjugatedLikelihood g x x w w, Bilinear g x x,
ConjugatedLikelihood f y x z w, Bilinear f y x, Map Natural g x x,
Map Natural f x y) =>
(Natural # Affine g x w x)
-> (Natural # Affine f y z x)
-> (Natural # w)
-> SamplePoint z
-> Natural # w
conjugatedForwardStep Natural # Affine g x w x
trns Natural # Affine f y z x
emsn) Natural # w
prr' Sample z
zs'
conjugatedSmoothing
:: ( ConjugatedLikelihood g x x w w, Bilinear g x x
, ConjugatedLikelihood f y x z w, Bilinear f y x
, Map Natural g x x, Map Natural f x y )
=> Natural # LatentProcess f g y x z w
-> Sample z
-> [Natural # w]
conjugatedSmoothing :: (Natural # LatentProcess f g y x z w) -> Sample z -> [Natural # w]
conjugatedSmoothing Natural # LatentProcess f g y x z w
ltnt Sample z
zs =
let (Natural # w
prr,Natural # Affine f y z x
emsn,Natural # Affine g x w x
trns) = (Natural # LatentProcess f g y x z w)
-> (Natural # w, Natural # Affine f y z x,
Natural # Affine g x w x)
forall z w (f :: Type -> Type -> Type) y x
(g :: Type -> Type -> Type) c.
(Manifold z, Manifold w, Manifold (f y x), Manifold (g x x)) =>
(c # LatentProcess f g y x z w)
-> (c # w, c # Affine f y z x, c # Affine g x w x)
splitLatentProcess Natural # LatentProcess f g y x z w
ltnt
in ([Natural # w], [Natural # AffineHarmonium g x x w w])
-> [Natural # w]
forall a b. (a, b) -> a
fst (([Natural # w], [Natural # AffineHarmonium g x x w w])
-> [Natural # w])
-> ([Natural # w], [Natural # AffineHarmonium g x x w w])
-> [Natural # w]
forall a b. (a -> b) -> a -> b
$ (Natural # w)
-> (Natural # Affine f y z x)
-> (Natural # Affine g x w x)
-> Sample z
-> ([Natural # w], [Natural # AffineHarmonium g x x w w])
forall (g :: Type -> Type -> Type) x w (f :: Type -> Type -> Type)
y z.
(ConjugatedLikelihood g x x w w, Bilinear g x x,
ConjugatedLikelihood f y x z w, Bilinear f y x, Map Natural g x x,
Map Natural f x y) =>
(Natural # w)
-> (Natural # Affine f y z x)
-> (Natural # Affine g x w x)
-> Sample z
-> ([Natural # w], [Natural # AffineHarmonium g x x w w])
conjugatedSmoothing0 Natural # w
prr Natural # Affine f y z x
emsn Natural # Affine g x w x
trns Sample z
zs
conjugatedSmoothing0
:: ( ConjugatedLikelihood g x x w w, Bilinear g x x
, ConjugatedLikelihood f y x z w, Bilinear f y x
, Map Natural g x x, Map Natural f x y )
=> Natural # w
-> Natural # Affine f y z x
-> Natural # Affine g x w x
-> Sample z
-> ([Natural # w],[Natural # AffineHarmonium g x x w w])
conjugatedSmoothing0 :: (Natural # w)
-> (Natural # Affine f y z x)
-> (Natural # Affine g x w x)
-> Sample z
-> ([Natural # w], [Natural # AffineHarmonium g x x w w])
conjugatedSmoothing0 Natural # w
_ Natural # Affine f y z x
_ Natural # Affine g x w x
_ [] = ([],[])
conjugatedSmoothing0 Natural # w
prr Natural # Affine f y z x
emsn Natural # Affine g x w x
_ [SamplePoint z
z] =
([(Natural # Affine f y z x)
-> (Natural # w) -> SamplePoint z -> Natural # w
forall (f :: Type -> Type -> Type) y x z w.
(Map Natural f x y, Bilinear f y x,
ConjugatedLikelihood f y x z w) =>
(Natural # Affine f y z x)
-> (Natural # w) -> SamplePoint z -> Natural # w
conjugatedBayesRule Natural # Affine f y z x
emsn Natural # w
prr SamplePoint z
z],[])
conjugatedSmoothing0 Natural # w
prr Natural # Affine f y z x
emsn Natural # Affine g x w x
trns (SamplePoint z
z:Sample z
zs) =
let pst :: Natural # w
pst = (Natural # Affine f y z x)
-> (Natural # w) -> SamplePoint z -> Natural # w
forall (f :: Type -> Type -> Type) y x z w.
(Map Natural f x y, Bilinear f y x,
ConjugatedLikelihood f y x z w) =>
(Natural # Affine f y z x)
-> (Natural # w) -> SamplePoint z -> Natural # w
conjugatedBayesRule Natural # Affine f y z x
emsn Natural # w
prr SamplePoint z
z
(Natural # Affine g x w x
trns',Natural # w
fwd) = (Natural # AffineHarmonium g x x w w)
-> (Natural # Affine g x w x, Natural # w)
forall (f :: Type -> Type -> Type) y x z w.
ConjugatedLikelihood f y x z w =>
(Natural # AffineHarmonium f y x z w)
-> (Natural # Affine f y z x, Natural # w)
splitConjugatedHarmonium ((Natural # AffineHarmonium g x x w w)
-> (Natural # Affine g x w x, Natural # w))
-> ((Natural # AffineHarmonium g x x w w)
-> Natural # AffineHarmonium g x x w w)
-> (Natural # AffineHarmonium g x x w w)
-> (Natural # Affine g x w x, Natural # w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural # AffineHarmonium g x x w w)
-> Natural # AffineHarmonium g x x w w
forall (f :: Type -> Type -> Type) y x z w c.
(Bilinear f y x, Manifold z, Manifold w) =>
(c # AffineHarmonium f y x z w) -> c # AffineHarmonium f x y w z
transposeHarmonium
((Natural # AffineHarmonium g x x w w)
-> (Natural # Affine g x w x, Natural # w))
-> (Natural # AffineHarmonium g x x w w)
-> (Natural # Affine g x w x, Natural # w)
forall a b. (a -> b) -> a -> b
$ (Natural # Affine g x w x)
-> (Natural # w) -> Natural # AffineHarmonium g x x w w
forall (f :: Type -> Type -> Type) y x z w.
ConjugatedLikelihood f y x z w =>
(Natural # Affine f y z x)
-> (Natural # w) -> Natural # AffineHarmonium f y x z w
joinConjugatedHarmonium Natural # Affine g x w x
trns Natural # w
pst
(Natural # w
smth:[Natural # w]
smths,[Natural # AffineHarmonium g x x w w]
hrms) = (Natural # w)
-> (Natural # Affine f y z x)
-> (Natural # Affine g x w x)
-> Sample z
-> ([Natural # w], [Natural # AffineHarmonium g x x w w])
forall (g :: Type -> Type -> Type) x w (f :: Type -> Type -> Type)
y z.
(ConjugatedLikelihood g x x w w, Bilinear g x x,
ConjugatedLikelihood f y x z w, Bilinear f y x, Map Natural g x x,
Map Natural f x y) =>
(Natural # w)
-> (Natural # Affine f y z x)
-> (Natural # Affine g x w x)
-> Sample z
-> ([Natural # w], [Natural # AffineHarmonium g x x w w])
conjugatedSmoothing0 Natural # w
fwd Natural # Affine f y z x
emsn Natural # Affine g x w x
trns Sample z
zs
hrm :: Natural # AffineHarmonium g x x w w
hrm = (Natural # AffineHarmonium g x x w w)
-> Natural # AffineHarmonium g x x w w
forall (f :: Type -> Type -> Type) y x z w c.
(Bilinear f y x, Manifold z, Manifold w) =>
(c # AffineHarmonium f y x z w) -> c # AffineHarmonium f x y w z
transposeHarmonium ((Natural # AffineHarmonium g x x w w)
-> Natural # AffineHarmonium g x x w w)
-> (Natural # AffineHarmonium g x x w w)
-> Natural # AffineHarmonium g x x w w
forall a b. (a -> b) -> a -> b
$ (Natural # Affine g x w x)
-> (Natural # w) -> Natural # AffineHarmonium g x x w w
forall (f :: Type -> Type -> Type) y x z w.
ConjugatedLikelihood f y x z w =>
(Natural # Affine f y z x)
-> (Natural # w) -> Natural # AffineHarmonium f y x z w
joinConjugatedHarmonium Natural # Affine g x w x
trns' Natural # w
smth
bwd :: Natural # w
bwd = (Natural # Affine g x w x, Natural # w) -> Natural # w
forall a b. (a, b) -> b
snd ((Natural # Affine g x w x, Natural # w) -> Natural # w)
-> (Natural # Affine g x w x, Natural # w) -> Natural # w
forall a b. (a -> b) -> a -> b
$ (Natural # AffineHarmonium g x x w w)
-> (Natural # Affine g x w x, Natural # w)
forall (f :: Type -> Type -> Type) y x z w.
ConjugatedLikelihood f y x z w =>
(Natural # AffineHarmonium f y x z w)
-> (Natural # Affine f y z x, Natural # w)
splitConjugatedHarmonium Natural # AffineHarmonium g x x w w
hrm
in (Natural # w
bwd(Natural # w) -> [Natural # w] -> [Natural # w]
forall a. a -> [a] -> [a]
:Natural # w
smth(Natural # w) -> [Natural # w] -> [Natural # w]
forall a. a -> [a] -> [a]
:[Natural # w]
smths,Natural # AffineHarmonium g x x w w
hrm(Natural # AffineHarmonium g x x w w)
-> [Natural # AffineHarmonium g x x w w]
-> [Natural # AffineHarmonium g x x w w]
forall a. a -> [a] -> [a]
:[Natural # AffineHarmonium g x x w w]
hrms)
latentProcessLogDensity
:: ( ExponentialFamily z, ExponentialFamily x, Map Natural f y x
, Translation z y , Map Natural g x x, AbsolutelyContinuous Natural w
, SamplePoint w ~ SamplePoint x, AbsolutelyContinuous Natural z, Translation w x )
=> Natural # w
-> Natural # Affine f y z x
-> Natural # Affine g x w x
-> Sample (z,w)
-> Double
latentProcessLogDensity :: (Natural # w)
-> (Natural # Affine f y z x)
-> (Natural # Affine g x w x)
-> Sample (z, w)
-> Double
latentProcessLogDensity Natural # w
prr Natural # Affine f y z x
emsn Natural # Affine g x w x
trns Sample (z, w)
zxs =
let ([SamplePoint z]
zs,[SamplePoint x]
xs) = [(SamplePoint z, SamplePoint x)]
-> ([SamplePoint z], [SamplePoint x])
forall a b. [(a, b)] -> ([a], [b])
unzip [(SamplePoint z, SamplePoint x)]
Sample (z, w)
zxs
prrdns :: Double
prrdns = (Natural # w) -> SamplePoint w -> Double
forall c x.
AbsolutelyContinuous c x =>
Point c x -> SamplePoint x -> Double
logDensity Natural # w
prr (SamplePoint w -> Double) -> SamplePoint w -> Double
forall a b. (a -> b) -> a -> b
$ [SamplePoint x] -> SamplePoint x
forall a. [a] -> a
head [SamplePoint x]
xs
trnsdnss :: [Double]
trnsdnss = ((Natural # w) -> SamplePoint x -> Double)
-> [Natural # w] -> [SamplePoint x] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Natural # w) -> SamplePoint x -> Double
forall c x.
AbsolutelyContinuous c x =>
Point c x -> SamplePoint x -> Double
logDensity (Natural # Affine g x w x
trns (Natural # Affine g x w x) -> [SamplePoint x] -> [Natural # w]
forall (f :: Type -> Type -> Type) y x.
(Map Natural f y x, ExponentialFamily x) =>
(Natural # f y x) -> Sample x -> [Natural # y]
>$>* [SamplePoint x]
xs) ([SamplePoint x] -> [Double]) -> [SamplePoint x] -> [Double]
forall a b. (a -> b) -> a -> b
$ [SamplePoint x] -> [SamplePoint x]
forall a. [a] -> [a]
tail [SamplePoint x]
xs
emsndnss :: [Double]
emsndnss = (Point Natural z -> SamplePoint z -> Double)
-> [Point Natural z] -> [SamplePoint z] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Point Natural z -> SamplePoint z -> Double
forall c x.
AbsolutelyContinuous c x =>
Point c x -> SamplePoint x -> Double
logDensity (Natural # Affine f y z x
emsn (Natural # Affine f y z x) -> [SamplePoint x] -> [Point Natural z]
forall (f :: Type -> Type -> Type) y x.
(Map Natural f y x, ExponentialFamily x) =>
(Natural # f y x) -> Sample x -> [Natural # y]
>$>* [SamplePoint x]
xs) [SamplePoint z]
zs
in [Double] -> Double
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ Double
prrdns Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double]
trnsdnss [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ [Double]
emsndnss
conjugatedSmoothingLogDensity
:: ( ConjugatedLikelihood g x x w w, Bilinear g x x
, ConjugatedLikelihood f y x z w, Bilinear f y x
, Map Natural g x x, Map Natural f x y, ExponentialFamily y
, LegendreExponentialFamily z, LegendreExponentialFamily w )
=> Natural # LatentProcess f g y x z w
-> Sample z
-> Double
conjugatedSmoothingLogDensity :: (Natural # LatentProcess f g y x z w) -> Sample z -> Double
conjugatedSmoothingLogDensity Natural # LatentProcess f g y x z w
ltnt Sample z
zs =
let (Natural # w
_,Natural # Affine f y z x
emsn,Natural # Affine g x w x
_) = (Natural # LatentProcess f g y x z w)
-> (Natural # w, Natural # Affine f y z x,
Natural # Affine g x w x)
forall z w (f :: Type -> Type -> Type) y x
(g :: Type -> Type -> Type) c.
(Manifold z, Manifold w, Manifold (f y x), Manifold (g x x)) =>
(c # LatentProcess f g y x z w)
-> (c # w, c # Affine f y z x, c # Affine g x w x)
splitLatentProcess Natural # LatentProcess f g y x z w
ltnt
smths :: [Natural # w]
smths = (Natural # LatentProcess f g y x z w) -> Sample z -> [Natural # w]
forall (g :: Type -> Type -> Type) x w (f :: Type -> Type -> Type)
y z.
(ConjugatedLikelihood g x x w w, Bilinear g x x,
ConjugatedLikelihood f y x z w, Bilinear f y x, Map Natural g x x,
Map Natural f x y) =>
(Natural # LatentProcess f g y x z w) -> Sample z -> [Natural # w]
conjugatedSmoothing Natural # LatentProcess f g y x z w
ltnt Sample z
zs
hrms :: [Natural # AffineHarmonium f y x z w]
hrms = (Natural # Affine f y z x)
-> (Natural # w) -> Natural # AffineHarmonium f y x z w
forall (f :: Type -> Type -> Type) y x z w.
ConjugatedLikelihood f y x z w =>
(Natural # Affine f y z x)
-> (Natural # w) -> Natural # AffineHarmonium f y x z w
joinConjugatedHarmonium Natural # Affine f y z x
emsn ((Natural # w) -> Natural # AffineHarmonium f y x z w)
-> [Natural # w] -> [Natural # AffineHarmonium f y x z w]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Natural # w]
smths
in [Double] -> Double
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ ((Natural # AffineHarmonium f y x z w) -> SamplePoint z -> Double)
-> [Natural # AffineHarmonium f y x z w] -> Sample z -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Natural # AffineHarmonium f y x z w) -> SamplePoint z -> Double
forall c f.
ObservablyContinuous c f =>
(c # f) -> Observation f -> Double
logObservableDensity [Natural # AffineHarmonium f y x z w]
hrms Sample z
zs
instance Manifold (LatentProcess f g y x z w) => Statistical (LatentProcess f g y x z w) where
type SamplePoint (LatentProcess f g y x z w) = [SamplePoint (z,x)]
instance ( ExponentialFamily z, ExponentialFamily x, Map Natural f y x
, Translation z y , Map Natural g x x, AbsolutelyContinuous Natural w
, SamplePoint w ~ SamplePoint x, AbsolutelyContinuous Natural z, Translation w x )
=> AbsolutelyContinuous Natural (LatentProcess f g y x z w) where
logDensities :: Point Natural (LatentProcess f g y x z w)
-> Sample (LatentProcess f g y x z w) -> [Double]
logDensities Point Natural (LatentProcess f g y x z w)
ltnt Sample (LatentProcess f g y x z w)
zxss = do
[(SamplePoint z, SamplePoint x)]
zxs <- [[(SamplePoint z, SamplePoint x)]]
Sample (LatentProcess f g y x z w)
zxss
let (Natural # w
prr,Natural # Affine f y z x
emsn,Natural # Affine g x w x
trns) = Point Natural (LatentProcess f g y x z w)
-> (Natural # w, Natural # Affine f y z x,
Natural # Affine g x w x)
forall z w (f :: Type -> Type -> Type) y x
(g :: Type -> Type -> Type) c.
(Manifold z, Manifold w, Manifold (f y x), Manifold (g x x)) =>
(c # LatentProcess f g y x z w)
-> (c # w, c # Affine f y z x, c # Affine g x w x)
splitLatentProcess Point Natural (LatentProcess f g y x z w)
ltnt
Double -> [Double]
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Double -> [Double]) -> Double -> [Double]
forall a b. (a -> b) -> a -> b
$ (Natural # w)
-> (Natural # Affine f y z x)
-> (Natural # Affine g x w x)
-> Sample (z, w)
-> Double
forall z x (f :: Type -> Type -> Type) y
(g :: Type -> Type -> Type) w.
(ExponentialFamily z, ExponentialFamily x, Map Natural f y x,
Translation z y, Map Natural g x x, AbsolutelyContinuous Natural w,
SamplePoint w ~ SamplePoint x, AbsolutelyContinuous Natural z,
Translation w x) =>
(Natural # w)
-> (Natural # Affine f y z x)
-> (Natural # Affine g x w x)
-> Sample (z, w)
-> Double
latentProcessLogDensity Natural # w
prr Natural # Affine f y z x
emsn Natural # Affine g x w x
trns [(SamplePoint z, SamplePoint x)]
Sample (z, w)
zxs
instance ( ConjugatedLikelihood g x x w w, Bilinear g x x
, ConjugatedLikelihood f y x z w, Bilinear f y x
, Map Natural g x x, Map Natural f x y, ExponentialFamily y
, LegendreExponentialFamily z, LegendreExponentialFamily w )
=> ObservablyContinuous Natural (LatentProcess f g y x z w) where
logObservableDensities :: (Natural # LatentProcess f g y x z w)
-> Observations (LatentProcess f g y x z w) -> [Double]
logObservableDensities Natural # LatentProcess f g y x z w
ltnt = ([SamplePoint z] -> Double) -> [[SamplePoint z]] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ((Natural # LatentProcess f g y x z w) -> [SamplePoint z] -> Double
forall (g :: Type -> Type -> Type) x w (f :: Type -> Type -> Type)
y z.
(ConjugatedLikelihood g x x w w, Bilinear g x x,
ConjugatedLikelihood f y x z w, Bilinear f y x, Map Natural g x x,
Map Natural f x y, ExponentialFamily y,
LegendreExponentialFamily z, LegendreExponentialFamily w) =>
(Natural # LatentProcess f g y x z w) -> Sample z -> Double
conjugatedSmoothingLogDensity Natural # LatentProcess f g y x z w
ltnt)
instance ( Manifold w , Manifold (g x x)
, Translation z y, Bilinear f y x )
=> Translation (LatentProcess f g y x z w) y where
>+> :: (c # LatentProcess f g y x z w)
-> (c # y) -> c # LatentProcess f g y x z w
(>+>) c # LatentProcess f g y x z w
ltnt c # y
y =
let (c # AffineHarmonium f y x z w
ehrm,c # Affine g x w x
trns) = (c # LatentProcess f g y x z w)
-> (c # First (LatentProcess f g y x z w),
c # Second (LatentProcess f g y x z w))
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split c # LatentProcess f g y x z w
ltnt
(c # z
z,c # f y x
yx,c # w
w) = (c # AffineHarmonium f y x z w) -> (c # z, c # f y x, c # w)
forall z (f :: Type -> Type -> Type) y x w c.
(Manifold z, Manifold (f y x), Manifold w) =>
(c # AffineHarmonium f y x z w) -> (c # z, c # f y x, c # w)
splitHarmonium c # AffineHarmonium f y x z w
ehrm
z' :: c # z
z' = c # z
z (c # z) -> (c # y) -> c # z
forall z y c. Translation z y => (c # z) -> (c # y) -> c # z
>+> c # y
y
in (c # First (LatentProcess f g y x z w))
-> (c # Second (LatentProcess f g y x z w))
-> c # LatentProcess f g y x z w
forall z c. Product z => (c # First z) -> (c # Second z) -> c # z
join ((c # z) -> (c # f y x) -> (c # w) -> c # AffineHarmonium f y x z w
forall w z (f :: Type -> Type -> Type) y x c.
(Manifold w, Manifold z, Manifold (f y x)) =>
(c # z) -> (c # f y x) -> (c # w) -> c # AffineHarmonium f y x z w
joinHarmonium c # z
z' c # f y x
yx c # w
w) c # Second (LatentProcess f g y x z w)
c # Affine g x w x
trns
anchor :: (c # LatentProcess f g y x z w) -> c # y
anchor c # LatentProcess f g y x z w
ltnt =
(c # z) -> c # y
forall z y c. Translation z y => (c # z) -> c # y
anchor ((c # z) -> c # y)
-> ((c # AffineHarmonium f y x z w, c # Affine g x w x) -> c # z)
-> (c # AffineHarmonium f y x z w, c # Affine g x w x)
-> c # y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c # Affine f x w y, c # z) -> c # z
forall a b. (a, b) -> b
snd ((c # Affine f x w y, c # z) -> c # z)
-> ((c # AffineHarmonium f y x z w, c # Affine g x w x)
-> (c # Affine f x w y, c # z))
-> (c # AffineHarmonium f y x z w, c # Affine g x w x)
-> c # z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c # AffineHarmonium f x y w z) -> (c # Affine f x w y, c # z)
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split ((c # AffineHarmonium f x y w z) -> (c # Affine f x w y, c # z))
-> ((c # AffineHarmonium f y x z w, c # Affine g x w x)
-> c # AffineHarmonium f x y w z)
-> (c # AffineHarmonium f y x z w, c # Affine g x w x)
-> (c # Affine f x w y, c # z)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c # AffineHarmonium f y x z w) -> c # AffineHarmonium f x y w z
forall (f :: Type -> Type -> Type) y x z w c.
(Bilinear f y x, Manifold z, Manifold w) =>
(c # AffineHarmonium f y x z w) -> c # AffineHarmonium f x y w z
transposeHarmonium ((c # AffineHarmonium f y x z w) -> c # AffineHarmonium f x y w z)
-> ((c # AffineHarmonium f y x z w, c # Affine g x w x)
-> c # AffineHarmonium f y x z w)
-> (c # AffineHarmonium f y x z w, c # Affine g x w x)
-> c # AffineHarmonium f x y w z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c # AffineHarmonium f y x z w, c # Affine g x w x)
-> c # AffineHarmonium f y x z w
forall a b. (a, b) -> a
fst ((c # AffineHarmonium f y x z w, c # Affine g x w x) -> c # y)
-> (c # AffineHarmonium f y x z w, c # Affine g x w x) -> c # y
forall a b. (a -> b) -> a -> b
$ (c # LatentProcess f g y x z w)
-> (c # First (LatentProcess f g y x z w),
c # Second (LatentProcess f g y x z w))
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split c # LatentProcess f g y x z w
ltnt