{-# LANGUAGE RankNTypes #-}
module Mcmc.Proposal.Scale
( scale,
scaleUnbiased,
scaleContrarily,
)
where
import Mcmc.Proposal
import Mcmc.Proposal.Generic
import Mcmc.Statistics.Types
import Numeric.Log
import Statistics.Distribution.Gamma
scaleSimple :: Shape -> Scale -> TuningParameter -> ProposalSimple Double
scaleSimple :: Shape -> Shape -> Shape -> ProposalSimple Shape
scaleSimple Shape
k Shape
th Shape
t =
GammaDistribution
-> (Shape -> Shape -> Shape)
-> Maybe (Shape -> Shape)
-> Maybe (Shape -> Shape -> Jacobian)
-> ProposalSimple Shape
forall d a.
(ContDistr d, ContGen d) =>
d
-> (a -> Shape -> a)
-> Maybe (Shape -> Shape)
-> Maybe (a -> Shape -> Jacobian)
-> ProposalSimple a
genericContinuous
(Shape -> Shape -> GammaDistribution
gammaDistr (Shape
k Shape -> Shape -> Shape
forall a. Fractional a => a -> a -> a
/ Shape
t) (Shape
th Shape -> Shape -> Shape
forall a. Num a => a -> a -> a
* Shape
t))
Shape -> Shape -> Shape
forall a. Num a => a -> a -> a
(*)
((Shape -> Shape) -> Maybe (Shape -> Shape)
forall a. a -> Maybe a
Just Shape -> Shape
forall a. Fractional a => a -> a
recip)
((Shape -> Shape -> Jacobian) -> Maybe (Shape -> Shape -> Jacobian)
forall a. a -> Maybe a
Just Shape -> Shape -> Jacobian
forall a p. Floating a => p -> a -> Log a
jac)
where
jac :: p -> a -> Log a
jac p
_ = a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> (a -> a) -> a -> Log a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Floating a => a -> a
log (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Fractional a => a -> a
recip
scale ::
Shape ->
Scale ->
PName ->
PWeight ->
Tune ->
Proposal Double
scale :: Shape -> Shape -> PName -> PWeight -> Tune -> Proposal Shape
scale Shape
k Shape
th = PDescription
-> (Shape -> ProposalSimple Shape)
-> PDimension
-> PName
-> PWeight
-> Tune
-> Proposal Shape
forall a.
PDescription
-> (Shape -> ProposalSimple a)
-> PDimension
-> PName
-> PWeight
-> Tune
-> Proposal a
createProposal PDescription
description (Shape -> Shape -> Shape -> ProposalSimple Shape
scaleSimple Shape
k Shape
th) (Int -> PDimension
PDimension Int
1)
where
description :: PDescription
description = String -> PDescription
PDescription (String -> PDescription) -> String -> PDescription
forall a b. (a -> b) -> a -> b
$ String
"Scale; shape: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Shape -> String
forall a. Show a => a -> String
show Shape
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", scale: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Shape -> String
forall a. Show a => a -> String
show Shape
th
scaleUnbiased ::
Shape ->
PName ->
PWeight ->
Tune ->
Proposal Double
scaleUnbiased :: Shape -> PName -> PWeight -> Tune -> Proposal Shape
scaleUnbiased Shape
k = PDescription
-> (Shape -> ProposalSimple Shape)
-> PDimension
-> PName
-> PWeight
-> Tune
-> Proposal Shape
forall a.
PDescription
-> (Shape -> ProposalSimple a)
-> PDimension
-> PName
-> PWeight
-> Tune
-> Proposal a
createProposal PDescription
description (Shape -> Shape -> Shape -> ProposalSimple Shape
scaleSimple Shape
k (Shape
1 Shape -> Shape -> Shape
forall a. Fractional a => a -> a -> a
/ Shape
k)) (Int -> PDimension
PDimension Int
1)
where
description :: PDescription
description = String -> PDescription
PDescription (String -> PDescription) -> String -> PDescription
forall a b. (a -> b) -> a -> b
$ String
"Scale unbiased; shape: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Shape -> String
forall a. Show a => a -> String
show Shape
k
scaleContrarilySimple :: Shape -> Scale -> TuningParameter -> ProposalSimple (Double, Double)
scaleContrarilySimple :: Shape -> Shape -> Shape -> ProposalSimple (Shape, Shape)
scaleContrarilySimple Shape
k Shape
th Shape
t =
GammaDistribution
-> ((Shape, Shape) -> Shape -> (Shape, Shape))
-> Maybe (Shape -> Shape)
-> Maybe ((Shape, Shape) -> Shape -> Jacobian)
-> ProposalSimple (Shape, Shape)
forall d a.
(ContDistr d, ContGen d) =>
d
-> (a -> Shape -> a)
-> Maybe (Shape -> Shape)
-> Maybe (a -> Shape -> Jacobian)
-> ProposalSimple a
genericContinuous
(Shape -> Shape -> GammaDistribution
gammaDistr (Shape
k Shape -> Shape -> Shape
forall a. Fractional a => a -> a -> a
/ Shape
t) (Shape
th Shape -> Shape -> Shape
forall a. Num a => a -> a -> a
* Shape
t))
(Shape, Shape) -> Shape -> (Shape, Shape)
forall b. Fractional b => (b, b) -> b -> (b, b)
contra
((Shape -> Shape) -> Maybe (Shape -> Shape)
forall a. a -> Maybe a
Just Shape -> Shape
forall a. Fractional a => a -> a
recip)
(((Shape, Shape) -> Shape -> Jacobian)
-> Maybe ((Shape, Shape) -> Shape -> Jacobian)
forall a. a -> Maybe a
Just (Shape, Shape) -> Shape -> Jacobian
forall a p. Floating a => p -> a -> Log a
jac)
where
contra :: (b, b) -> b -> (b, b)
contra (b
x, b
y) b
u = (b
x b -> b -> b
forall a. Num a => a -> a -> a
* b
u, b
y b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
u)
jac :: p -> a -> Log a
jac p
_ a
u = a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> a -> Log a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
log (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Fractional a => a -> a
recip (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
u a -> a -> a
forall a. Num a => a -> a -> a
* a
u
scaleContrarily ::
Shape ->
Scale ->
PName ->
PWeight ->
Tune ->
Proposal (Double, Double)
scaleContrarily :: Shape
-> Shape -> PName -> PWeight -> Tune -> Proposal (Shape, Shape)
scaleContrarily Shape
k Shape
th = PDescription
-> (Shape -> ProposalSimple (Shape, Shape))
-> PDimension
-> PName
-> PWeight
-> Tune
-> Proposal (Shape, Shape)
forall a.
PDescription
-> (Shape -> ProposalSimple a)
-> PDimension
-> PName
-> PWeight
-> Tune
-> Proposal a
createProposal PDescription
description (Shape -> Shape -> Shape -> ProposalSimple (Shape, Shape)
scaleContrarilySimple Shape
k Shape
th) (Int -> PDimension
PDimension Int
2)
where
description :: PDescription
description = String -> PDescription
PDescription (String -> PDescription) -> String -> PDescription
forall a b. (a -> b) -> a -> b
$ String
"Scale contrariliy; shape: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Shape -> String
forall a. Show a => a -> String
show Shape
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", scale: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Shape -> String
forall a. Show a => a -> String
show Shape
th