module Mcmc.Proposal.Generic
( genericContinuous,
genericDiscrete,
)
where
import Mcmc.Proposal
import Numeric.Log
import Statistics.Distribution
genericContinuous ::
(ContDistr d, ContGen d) =>
d ->
(a -> Double -> a) ->
Maybe (Double -> Double) ->
Maybe (a -> Double -> Jacobian) ->
ProposalSimple a
genericContinuous :: d
-> (a -> Double -> a)
-> Maybe (Double -> Double)
-> Maybe (a -> Double -> Jacobian)
-> ProposalSimple a
genericContinuous d
d a -> Double -> a
f Maybe (Double -> Double)
mInv Maybe (a -> Double -> Jacobian)
mJac a
x GenIO
g = do
Double
u <- d -> Gen RealWorld -> IO Double
forall d g (m :: * -> *).
(ContGen d, StatefulGen g m) =>
d -> g -> m Double
genContVar d
d Gen RealWorld
GenIO
g
let r :: Jacobian
r = case Maybe (Double -> Double)
mInv of
Maybe (Double -> Double)
Nothing -> Jacobian
1.0
Just Double -> Double
fInv ->
let qXY :: Jacobian
qXY = Double -> Jacobian
forall a. a -> Log a
Exp (Double -> Jacobian) -> Double -> Jacobian
forall a b. (a -> b) -> a -> b
$ d -> Double -> Double
forall d. ContDistr d => d -> Double -> Double
logDensity d
d Double
u
qYX :: Jacobian
qYX = Double -> Jacobian
forall a. a -> Log a
Exp (Double -> Jacobian) -> Double -> Jacobian
forall a b. (a -> b) -> a -> b
$ d -> Double -> Double
forall d. ContDistr d => d -> Double -> Double
logDensity d
d (Double -> Double
fInv Double
u)
in Jacobian
qYX Jacobian -> Jacobian -> Jacobian
forall a. Fractional a => a -> a -> a
/ Jacobian
qXY
j :: Jacobian
j = case Maybe (a -> Double -> Jacobian)
mJac of
Maybe (a -> Double -> Jacobian)
Nothing -> Jacobian
1.0
Just a -> Double -> Jacobian
fJac -> a -> Double -> Jacobian
fJac a
x Double
u
(a, Jacobian, Jacobian) -> IO (a, Jacobian, Jacobian)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x a -> Double -> a
`f` Double
u, Jacobian
r, Jacobian
j)
{-# INLINEABLE genericContinuous #-}
genericDiscrete ::
(DiscreteDistr d, DiscreteGen d) =>
d ->
(a -> Int -> a) ->
Maybe (Int -> Int) ->
ProposalSimple a
genericDiscrete :: d -> (a -> Int -> a) -> Maybe (Int -> Int) -> ProposalSimple a
genericDiscrete d
d a -> Int -> a
f Maybe (Int -> Int)
mfInv a
x GenIO
g = do
Int
u <- d -> Gen RealWorld -> IO Int
forall d g (m :: * -> *).
(DiscreteGen d, StatefulGen g m) =>
d -> g -> m Int
genDiscreteVar d
d Gen RealWorld
GenIO
g
let r :: Jacobian
r = case Maybe (Int -> Int)
mfInv of
Maybe (Int -> Int)
Nothing -> Jacobian
1.0
Just Int -> Int
fInv ->
let qXY :: Jacobian
qXY = Double -> Jacobian
forall a. a -> Log a
Exp (Double -> Jacobian) -> Double -> Jacobian
forall a b. (a -> b) -> a -> b
$ d -> Int -> Double
forall d. DiscreteDistr d => d -> Int -> Double
logProbability d
d Int
u
qYX :: Jacobian
qYX = Double -> Jacobian
forall a. a -> Log a
Exp (Double -> Jacobian) -> Double -> Jacobian
forall a b. (a -> b) -> a -> b
$ d -> Int -> Double
forall d. DiscreteDistr d => d -> Int -> Double
logProbability d
d (Int -> Int
fInv Int
u)
in Jacobian
qYX Jacobian -> Jacobian -> Jacobian
forall a. Fractional a => a -> a -> a
/ Jacobian
qXY
(a, Jacobian, Jacobian) -> IO (a, Jacobian, Jacobian)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x a -> Int -> a
`f` Int
u, Jacobian
r, Jacobian
1.0)
{-# INLINEABLE genericDiscrete #-}