{-# 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
scalePFunction :: Shape Double -> Scale Double -> TuningParameter -> PFunction Double
scalePFunction :: Double -> Double -> Double -> PFunction Double
scalePFunction Double
k Double
th Double
t =
GammaDistribution
-> (Double -> Double -> Double)
-> Maybe (Double -> Double)
-> Maybe (Double -> Double -> Jacobian)
-> PFunction Double
forall d a.
(ContDistr d, ContGen d) =>
d
-> (a -> Double -> a)
-> Maybe (Double -> Double)
-> Maybe (a -> Double -> Jacobian)
-> PFunction a
genericContinuous
(Double -> Double -> GammaDistribution
gammaDistr (Double
k Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
t) (Double
th Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
t))
Double -> Double -> Double
forall a. Num a => a -> a -> a
(*)
((Double -> Double) -> Maybe (Double -> Double)
forall a. a -> Maybe a
Just Double -> Double
forall a. Fractional a => a -> a
recip)
((Double -> Double -> Jacobian)
-> Maybe (Double -> Double -> Jacobian)
forall a. a -> Maybe a
Just Double -> Double -> Jacobian
forall {b} {p}. Floating b => p -> b -> Log b
jac)
where
jac :: p -> b -> Log b
jac p
_ = b -> Log b
forall a. a -> Log a
Exp (b -> Log b) -> (b -> b) -> b -> Log b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
forall a. Floating a => a -> a
log (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
forall a. Fractional a => a -> a
recip
scale ::
Shape Double ->
Scale Double ->
PName ->
PWeight ->
Tune ->
Proposal Double
scale :: Double -> Double -> PName -> PWeight -> Tune -> Proposal Double
scale Double
k Double
th = PDescription
-> (Double -> PFunction Double)
-> PSpeed
-> PDimension
-> PName
-> PWeight
-> Tune
-> Proposal Double
forall a.
PDescription
-> (Double -> PFunction a)
-> PSpeed
-> PDimension
-> PName
-> PWeight
-> Tune
-> Proposal a
createProposal PDescription
description (Double -> Double -> Double -> PFunction Double
scalePFunction Double
k Double
th) PSpeed
PFast (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]
++ Double -> String
forall a. Show a => a -> String
show Double
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", scale: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
th
scaleUnbiased ::
Shape Double ->
PName ->
PWeight ->
Tune ->
Proposal Double
scaleUnbiased :: Double -> PName -> PWeight -> Tune -> Proposal Double
scaleUnbiased Double
k = PDescription
-> (Double -> PFunction Double)
-> PSpeed
-> PDimension
-> PName
-> PWeight
-> Tune
-> Proposal Double
forall a.
PDescription
-> (Double -> PFunction a)
-> PSpeed
-> PDimension
-> PName
-> PWeight
-> Tune
-> Proposal a
createProposal PDescription
description (Double -> Double -> Double -> PFunction Double
scalePFunction Double
k (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
k)) PSpeed
PFast (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]
++ Double -> String
forall a. Show a => a -> String
show Double
k
scaleContrarilyPFunction ::
Shape Double ->
Scale Double ->
TuningParameter ->
PFunction (Double, Double)
scaleContrarilyPFunction :: Double -> Double -> Double -> PFunction (Double, Double)
scaleContrarilyPFunction Double
k Double
th Double
t =
GammaDistribution
-> ((Double, Double) -> Double -> (Double, Double))
-> Maybe (Double -> Double)
-> Maybe ((Double, Double) -> Double -> Jacobian)
-> PFunction (Double, Double)
forall d a.
(ContDistr d, ContGen d) =>
d
-> (a -> Double -> a)
-> Maybe (Double -> Double)
-> Maybe (a -> Double -> Jacobian)
-> PFunction a
genericContinuous
(Double -> Double -> GammaDistribution
gammaDistr (Double
k Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
t) (Double
th Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
t))
(Double, Double) -> Double -> (Double, Double)
forall {b}. Fractional b => (b, b) -> b -> (b, b)
contra
((Double -> Double) -> Maybe (Double -> Double)
forall a. a -> Maybe a
Just Double -> Double
forall a. Fractional a => a -> a
recip)
(((Double, Double) -> Double -> Jacobian)
-> Maybe ((Double, Double) -> Double -> Jacobian)
forall a. a -> Maybe a
Just (Double, Double) -> Double -> Jacobian
forall {b} {p}. Floating b => p -> b -> Log b
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 Double ->
Scale Double ->
PName ->
PWeight ->
Tune ->
Proposal (Double, Double)
scaleContrarily :: Double
-> Double -> PName -> PWeight -> Tune -> Proposal (Double, Double)
scaleContrarily Double
k Double
th = PDescription
-> (Double -> PFunction (Double, Double))
-> PSpeed
-> PDimension
-> PName
-> PWeight
-> Tune
-> Proposal (Double, Double)
forall a.
PDescription
-> (Double -> PFunction a)
-> PSpeed
-> PDimension
-> PName
-> PWeight
-> Tune
-> Proposal a
createProposal PDescription
description (Double -> Double -> Double -> PFunction (Double, Double)
scaleContrarilyPFunction Double
k Double
th) PSpeed
PFast (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]
++ Double -> String
forall a. Show a => a -> String
show Double
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", scale: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
th