{-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver -fplugin=GHC.TypeLits.Normalise -fconstraint-solver-iterations=10 #-}
{-# LANGUAGE UndecidableInstances #-}

-- | 'Statistical' models where the observable biases depend on additional inputs.
module Goal.Graphical.Models.Dynamic
    (
    LatentProcess (LatentProcess)
    , HiddenMarkovModel
    , SimpleKalmanFilter
    , KalmanFilter
    , sampleLatentProcess
    -- ** Construction
    , joinLatentProcess
    , splitLatentProcess
    -- ** Inference
    , conjugatedFiltering
    , conjugatedSmoothing
    , conjugatedSmoothing0
    ) where


--- Imports  ---


-- Goal --

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


--- Generic ---


-- | A conditional 'Harmonium', where the observable biases of the
-- 'Harmonium' model depend on additional variables.
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)

-- | Split a 'LatentProcess' into a prior, an emission distribution, and a
-- transition distribution.
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)

-- | Construct a 'LatentProcess' from a prior, an emission distribution, and a
-- transition distribution.
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 -- ^ Emission Distribution
    -> Natural # Affine g x w x -- ^ Transition Distribution
    -> 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')

-- | Generate a realization of the observable and latent states from a given
-- latent process.
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)

-- | Filtering for latent processes based on conjugated distributions.
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'

-- | Smoothing for latent processes based on conjugated distributions.
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

-- | A more low-level implementation of smoothing which also returns joint
-- distributions over current and subsequent states.
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 -- ^ Emission Distribution
    -> Natural # Affine g x w x -- ^ Transition Distribution
    -> 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)


--- Instances ---

-- Implementations

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 -- ^ Emission Distribution
    -> Natural # Affine g x w x -- ^ Transition Distribution
    -> 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

-- Latent Processes

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