-- |
-- Module      : Control.Monad.Bayes.Inference.PMMH
-- Description : Particle Marginal Metropolis-Hastings (PMMH)
-- Copyright   : (c) Adam Scibior, 2015-2020
-- License     : MIT
-- Maintainer  : leonhard.markert@tweag.io
-- Stability   : experimental
-- Portability : GHC
--
-- Particle Marginal Metropolis-Hastings (PMMH) sampling.
--
-- Christophe Andrieu, Arnaud Doucet, and Roman Holenstein. 2010. Particle Markov chain Monte Carlo Methods. /Journal of the Royal Statistical Society/ 72 (2010), 269-342. <http://www.stats.ox.ac.uk/~doucet/andrieu_doucet_holenstein_PMCMC.pdf>
module Control.Monad.Bayes.Inference.PMMH
  ( pmmh,
  )
where

import Control.Monad.Bayes.Class
import Control.Monad.Bayes.Inference.SMC
import Control.Monad.Bayes.Population as Pop
import Control.Monad.Bayes.Sequential
import Control.Monad.Bayes.Traced
import Control.Monad.Trans (lift)
import Numeric.Log

-- | Particle Marginal Metropolis-Hastings sampling.
pmmh ::
  MonadInfer m =>
  -- | number of Metropolis-Hastings steps
  Int ->
  -- | number of time steps
  Int ->
  -- | number of particles
  Int ->
  -- | model parameters prior
  Traced m b ->
  -- | model
  (b -> Sequential (Population m) a) ->
  m [[(a, Log Double)]]
pmmh :: Int
-> Int
-> Int
-> Traced m b
-> (b -> Sequential (Population m) a)
-> m [[(a, Log Double)]]
pmmh t :: Int
t k :: Int
k n :: Int
n param :: Traced m b
param model :: b -> Sequential (Population m) a
model =
  Int -> Traced m [(a, Log Double)] -> m [[(a, Log Double)]]
forall (m :: * -> *) a. MonadSample m => Int -> Traced m a -> m [a]
mh Int
t (Traced m b
param Traced m b
-> (b -> Traced m [(a, Log Double)]) -> Traced m [(a, Log Double)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Population (Traced m) a -> Traced m [(a, Log Double)]
forall (m :: * -> *) a.
Functor m =>
Population m a -> m [(a, Log Double)]
runPopulation (Population (Traced m) a -> Traced m [(a, Log Double)])
-> (b -> Population (Traced m) a)
-> b
-> Traced m [(a, Log Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Population (Traced m) a -> Population (Traced m) a
forall (m :: * -> *) a.
MonadCond m =>
Population m a -> Population m a
pushEvidence (Population (Traced m) a -> Population (Traced m) a)
-> (b -> Population (Traced m) a) -> b -> Population (Traced m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. m x -> Traced m x)
-> Population m a -> Population (Traced m) a
forall (m :: * -> *) (n :: * -> *) a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> Population m a -> Population n a
Pop.hoist forall x. m x -> Traced m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Population m a -> Population (Traced m) a)
-> (b -> Population m a) -> b -> Population (Traced m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Sequential (Population m) a -> Population m a
forall (m :: * -> *) a.
MonadSample m =>
Int -> Int -> Sequential (Population m) a -> Population m a
smcSystematic Int
k Int
n (Sequential (Population m) a -> Population m a)
-> (b -> Sequential (Population m) a) -> b -> Population m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Sequential (Population m) a
model)