{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

-- |
-- Module      :  Mcmc.Proposal
-- Description :  Proposals are instruction to move around the state space
-- Copyright   :  2021 Dominik Schrempf
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Wed May 20 13:42:53 2020.
module Mcmc.Proposal
  ( -- * Proposals
    PName (..),
    PDescription (..),
    PWeight (fromPWeight),
    pWeight,
    PDimension (..),
    PSpeed (..),
    Proposal (..),
    KernelRatio,
    PResult (..),
    Jacobian,
    JacobianFunction,
    PFunction,
    createProposal,

    -- * Tuners
    Tuner (..),
    Tune (..),
    TuningParameter,
    TuningType (..),
    TuningFunction,
    AuxiliaryTuningParameters,
    tuningFunction,
    tuningParameterMin,
    tuningParameterMax,
    tuneWithTuningParameters,
    getOptimalRate,

    -- * Lift proposals
    (@~),
    liftProposal,
    liftProposalWith,

    -- * Output
    proposalHeader,
    summarizeProposal,
  )
where

import Data.Bifunctor
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Function
import qualified Data.Vector as VB
import qualified Data.Vector.Unboxed as VU
import Lens.Micro
import Mcmc.Acceptance
import Mcmc.Internal.ByteString
import Mcmc.Jacobian
import Numeric.Log hiding (sum)
import System.Random.Stateful

-- | Proposal name.
newtype PName = PName {PName -> [Char]
fromPName :: String}
  deriving (Int -> PName -> ShowS
[PName] -> ShowS
PName -> [Char]
(Int -> PName -> ShowS)
-> (PName -> [Char]) -> ([PName] -> ShowS) -> Show PName
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PName -> ShowS
showsPrec :: Int -> PName -> ShowS
$cshow :: PName -> [Char]
show :: PName -> [Char]
$cshowList :: [PName] -> ShowS
showList :: [PName] -> ShowS
Show, PName -> PName -> Bool
(PName -> PName -> Bool) -> (PName -> PName -> Bool) -> Eq PName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PName -> PName -> Bool
== :: PName -> PName -> Bool
$c/= :: PName -> PName -> Bool
/= :: PName -> PName -> Bool
Eq, Eq PName
Eq PName =>
(PName -> PName -> Ordering)
-> (PName -> PName -> Bool)
-> (PName -> PName -> Bool)
-> (PName -> PName -> Bool)
-> (PName -> PName -> Bool)
-> (PName -> PName -> PName)
-> (PName -> PName -> PName)
-> Ord PName
PName -> PName -> Bool
PName -> PName -> Ordering
PName -> PName -> PName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PName -> PName -> Ordering
compare :: PName -> PName -> Ordering
$c< :: PName -> PName -> Bool
< :: PName -> PName -> Bool
$c<= :: PName -> PName -> Bool
<= :: PName -> PName -> Bool
$c> :: PName -> PName -> Bool
> :: PName -> PName -> Bool
$c>= :: PName -> PName -> Bool
>= :: PName -> PName -> Bool
$cmax :: PName -> PName -> PName
max :: PName -> PName -> PName
$cmin :: PName -> PName -> PName
min :: PName -> PName -> PName
Ord)
  deriving (Semigroup PName
PName
Semigroup PName =>
PName
-> (PName -> PName -> PName) -> ([PName] -> PName) -> Monoid PName
[PName] -> PName
PName -> PName -> PName
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: PName
mempty :: PName
$cmappend :: PName -> PName -> PName
mappend :: PName -> PName -> PName
$cmconcat :: [PName] -> PName
mconcat :: [PName] -> PName
Monoid, NonEmpty PName -> PName
PName -> PName -> PName
(PName -> PName -> PName)
-> (NonEmpty PName -> PName)
-> (forall b. Integral b => b -> PName -> PName)
-> Semigroup PName
forall b. Integral b => b -> PName -> PName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: PName -> PName -> PName
<> :: PName -> PName -> PName
$csconcat :: NonEmpty PName -> PName
sconcat :: NonEmpty PName -> PName
$cstimes :: forall b. Integral b => b -> PName -> PName
stimes :: forall b. Integral b => b -> PName -> PName
Semigroup) via String

-- | Proposal description.
newtype PDescription = PDescription {PDescription -> [Char]
fromPDescription :: String}
  deriving (Int -> PDescription -> ShowS
[PDescription] -> ShowS
PDescription -> [Char]
(Int -> PDescription -> ShowS)
-> (PDescription -> [Char])
-> ([PDescription] -> ShowS)
-> Show PDescription
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PDescription -> ShowS
showsPrec :: Int -> PDescription -> ShowS
$cshow :: PDescription -> [Char]
show :: PDescription -> [Char]
$cshowList :: [PDescription] -> ShowS
showList :: [PDescription] -> ShowS
Show, PDescription -> PDescription -> Bool
(PDescription -> PDescription -> Bool)
-> (PDescription -> PDescription -> Bool) -> Eq PDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PDescription -> PDescription -> Bool
== :: PDescription -> PDescription -> Bool
$c/= :: PDescription -> PDescription -> Bool
/= :: PDescription -> PDescription -> Bool
Eq, Eq PDescription
Eq PDescription =>
(PDescription -> PDescription -> Ordering)
-> (PDescription -> PDescription -> Bool)
-> (PDescription -> PDescription -> Bool)
-> (PDescription -> PDescription -> Bool)
-> (PDescription -> PDescription -> Bool)
-> (PDescription -> PDescription -> PDescription)
-> (PDescription -> PDescription -> PDescription)
-> Ord PDescription
PDescription -> PDescription -> Bool
PDescription -> PDescription -> Ordering
PDescription -> PDescription -> PDescription
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PDescription -> PDescription -> Ordering
compare :: PDescription -> PDescription -> Ordering
$c< :: PDescription -> PDescription -> Bool
< :: PDescription -> PDescription -> Bool
$c<= :: PDescription -> PDescription -> Bool
<= :: PDescription -> PDescription -> Bool
$c> :: PDescription -> PDescription -> Bool
> :: PDescription -> PDescription -> Bool
$c>= :: PDescription -> PDescription -> Bool
>= :: PDescription -> PDescription -> Bool
$cmax :: PDescription -> PDescription -> PDescription
max :: PDescription -> PDescription -> PDescription
$cmin :: PDescription -> PDescription -> PDescription
min :: PDescription -> PDescription -> PDescription
Ord)

-- | The positive weight determines how often a 'Proposal' is executed per
-- iteration of the Markov chain. Abstract data type; for construction, see
-- 'pWeight'.
newtype PWeight = PWeight {PWeight -> Int
fromPWeight :: Int}
  deriving (Int -> PWeight -> ShowS
[PWeight] -> ShowS
PWeight -> [Char]
(Int -> PWeight -> ShowS)
-> (PWeight -> [Char]) -> ([PWeight] -> ShowS) -> Show PWeight
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PWeight -> ShowS
showsPrec :: Int -> PWeight -> ShowS
$cshow :: PWeight -> [Char]
show :: PWeight -> [Char]
$cshowList :: [PWeight] -> ShowS
showList :: [PWeight] -> ShowS
Show, PWeight -> PWeight -> Bool
(PWeight -> PWeight -> Bool)
-> (PWeight -> PWeight -> Bool) -> Eq PWeight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PWeight -> PWeight -> Bool
== :: PWeight -> PWeight -> Bool
$c/= :: PWeight -> PWeight -> Bool
/= :: PWeight -> PWeight -> Bool
Eq, Eq PWeight
Eq PWeight =>
(PWeight -> PWeight -> Ordering)
-> (PWeight -> PWeight -> Bool)
-> (PWeight -> PWeight -> Bool)
-> (PWeight -> PWeight -> Bool)
-> (PWeight -> PWeight -> Bool)
-> (PWeight -> PWeight -> PWeight)
-> (PWeight -> PWeight -> PWeight)
-> Ord PWeight
PWeight -> PWeight -> Bool
PWeight -> PWeight -> Ordering
PWeight -> PWeight -> PWeight
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PWeight -> PWeight -> Ordering
compare :: PWeight -> PWeight -> Ordering
$c< :: PWeight -> PWeight -> Bool
< :: PWeight -> PWeight -> Bool
$c<= :: PWeight -> PWeight -> Bool
<= :: PWeight -> PWeight -> Bool
$c> :: PWeight -> PWeight -> Bool
> :: PWeight -> PWeight -> Bool
$c>= :: PWeight -> PWeight -> Bool
>= :: PWeight -> PWeight -> Bool
$cmax :: PWeight -> PWeight -> PWeight
max :: PWeight -> PWeight -> PWeight
$cmin :: PWeight -> PWeight -> PWeight
min :: PWeight -> PWeight -> PWeight
Ord)

-- | Check if the weight is positive.
--
-- Call 'error' if weight is zero or negative.
pWeight :: Int -> PWeight
pWeight :: Int -> PWeight
pWeight Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> PWeight
forall a. HasCallStack => [Char] -> a
error ([Char] -> PWeight) -> [Char] -> PWeight
forall a b. (a -> b) -> a -> b
$ [Char]
"pWeight: Proposal weight is zero or negative: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"."
  | Bool
otherwise = Int -> PWeight
PWeight Int
n

-- | Proposal dimension.
--
-- The number of affected, independent parameters.
--
-- The dimension is used to calculate the optimal acceptance rate, and does not
-- have to be exact.
--
-- Usually, the optimal acceptance rate of low dimensional proposals is higher
-- than for high dimensional ones. However, this is not always true (see below).
--
-- Further, optimal acceptance rates are still subject to controversies. To my
-- knowledge, research has focused on random walk proposals with multivariate
-- normal distributions of dimension @d@. In this case, the following acceptance
-- rates are desired:
--
-- - one dimension: 0.44 (numerical results);
--
-- - five and more dimensions: 0.234 (numerical results);
--
-- - infinite dimensions: 0.234 (theorem for specific target distributions).
--
-- See Handbook of Markov chain Monte Carlo, chapter 4.
--
-- Of course, many proposals may not be classical random walk proposals. For
-- example, the beta proposal on a simplex ('Mcmc.Proposal.Simplex.beta')
-- samples one new variable of the simplex from a beta distribution while
-- rescaling all other variables. What is the dimension of this proposal? Here,
-- the dimension is set to 2. The reason is that if the dimension of the simplex
-- is 2, two variables are changed. If the dimension of the simplex is high, one
-- variable is changed substantially, while all others are changed marginally.
--
-- Further, if a proposal changes a number of variables in the same way (and not
-- independently like in a random walk proposal), the dimension of the proposal
-- is set to the number of variables changed.
--
-- Moreover, proposals of unknown dimension are assumed to have high dimension,
-- and the optimal acceptance rate 0.234 is used.
--
-- Finally, special proposals may have completely different desired acceptance
-- rates. For example. the Hamiltonian Monte Carlo proposal (see
-- Mcmc.Proposal.Hamiltonian.hmc) has a desired acceptance rate of 0.65.
-- Specific acceptance rates can be set with 'PSpecial'.
data PDimension
  = PDimension Int
  | PDimensionUnknown
  | -- | Provide dimension ('Int') and desired acceptance rate ('Double').
    PSpecial Int Double

-- | Rough indication whether a proposal is fast or slow.
--
-- Useful during burn in. Slow proposals are not executed during fast auto
-- tuning periods.
--
-- See 'Mcmc.Settings.BurnInSettings'.
data PSpeed = PFast | PSlow
  deriving (PSpeed -> PSpeed -> Bool
(PSpeed -> PSpeed -> Bool)
-> (PSpeed -> PSpeed -> Bool) -> Eq PSpeed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PSpeed -> PSpeed -> Bool
== :: PSpeed -> PSpeed -> Bool
$c/= :: PSpeed -> PSpeed -> Bool
/= :: PSpeed -> PSpeed -> Bool
Eq)

-- | A 'Proposal' is an instruction about how the Markov chain will traverse the
-- state space @a@. Essentially, it is a probability mass or probability density
-- conditioned on the current state (i.e., a Markov kernel).
--
-- A 'Proposal' may be tuneable in that it contains information about how to
-- enlarge or shrink the proposal size to decrease or increase the acceptance
-- rate.
--
-- Predefined proposals are provided. To create custom proposals, one may use
-- the convenience function 'createProposal'.
data Proposal a = Proposal
  { -- | Name of the affected variable.
    forall a. Proposal a -> PName
prName :: PName,
    -- | Description of the proposal type and parameters.
    forall a. Proposal a -> PDescription
prDescription :: PDescription,
    forall a. Proposal a -> PSpeed
prSpeed :: PSpeed,
    forall a. Proposal a -> PDimension
prDimension :: PDimension,
    -- | The weight determines how often a 'Proposal' is executed per iteration of
    -- the Markov chain.
    forall a. Proposal a -> PWeight
prWeight :: PWeight,
    -- | Simple proposal function without name, weight, and tuning information.
    forall a. Proposal a -> PFunction a
prFunction :: PFunction a,
    -- | Tuning is disabled if set to 'Nothing'.
    forall a. Proposal a -> Maybe (Tuner a)
prTuner :: Maybe (Tuner a)
  }

instance Eq (Proposal a) where
  Proposal a
m == :: Proposal a -> Proposal a -> Bool
== Proposal a
n = Proposal a -> PName
forall a. Proposal a -> PName
prName Proposal a
m PName -> PName -> Bool
forall a. Eq a => a -> a -> Bool
== Proposal a -> PName
forall a. Proposal a -> PName
prName Proposal a
n Bool -> Bool -> Bool
&& Proposal a -> PDescription
forall a. Proposal a -> PDescription
prDescription Proposal a
m PDescription -> PDescription -> Bool
forall a. Eq a => a -> a -> Bool
== Proposal a -> PDescription
forall a. Proposal a -> PDescription
prDescription Proposal a
n

instance Ord (Proposal a) where
  compare :: Proposal a -> Proposal a -> Ordering
compare = (PDescription, PName, PWeight)
-> (PDescription, PName, PWeight) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((PDescription, PName, PWeight)
 -> (PDescription, PName, PWeight) -> Ordering)
-> (Proposal a -> (PDescription, PName, PWeight))
-> Proposal a
-> Proposal a
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\Proposal a
p -> (Proposal a -> PDescription
forall a. Proposal a -> PDescription
prDescription Proposal a
p, Proposal a -> PName
forall a. Proposal a -> PName
prName Proposal a
p, Proposal a -> PWeight
forall a. Proposal a -> PWeight
prWeight Proposal a
p))

-- | Ratio of the proposal kernels.
--
-- For unbiased, volume preserving proposals, the values is 1.0.
--
-- For biased proposals, the kernel ratio is qYX / qXY, where qAB is the
-- probability density to move from A to B.
type KernelRatio = Log Double

-- | Proposal result.
data PResult a
  = -- | Accept the new value regardless of the prior, likelihood or Jacobian.
    ForceAccept !a
  | -- | Reject the proposal regardless of the prior, likelihood or Jacobian.
    ForceReject
  | -- | Propose a new value.
    --
    -- In order to calculate the Metropolis-Hastings-Green ratio, we need to know
    -- the ratio of the backward to forward kernels (the 'KernelRatio' or the
    -- probability masses or probability densities) and the 'Jacobian'.
    --
    -- Note: The 'Jacobian' should be part of the 'KernelRatio'. However, it is
    -- more declarative to have them separate. Like so, we are constantly
    -- reminded: Is the Jacobian modifier different from 1.0?
    Propose !a !KernelRatio !Jacobian
  deriving (Int -> PResult a -> ShowS
[PResult a] -> ShowS
PResult a -> [Char]
(Int -> PResult a -> ShowS)
-> (PResult a -> [Char])
-> ([PResult a] -> ShowS)
-> Show (PResult a)
forall a. Show a => Int -> PResult a -> ShowS
forall a. Show a => [PResult a] -> ShowS
forall a. Show a => PResult a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> PResult a -> ShowS
showsPrec :: Int -> PResult a -> ShowS
$cshow :: forall a. Show a => PResult a -> [Char]
show :: PResult a -> [Char]
$cshowList :: forall a. Show a => [PResult a] -> ShowS
showList :: [PResult a] -> ShowS
Show, PResult a -> PResult a -> Bool
(PResult a -> PResult a -> Bool)
-> (PResult a -> PResult a -> Bool) -> Eq (PResult a)
forall a. Eq a => PResult a -> PResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => PResult a -> PResult a -> Bool
== :: PResult a -> PResult a -> Bool
$c/= :: forall a. Eq a => PResult a -> PResult a -> Bool
/= :: PResult a -> PResult a -> Bool
Eq)

-- | Simple proposal function without tuning information.
--
-- Instruction about randomly moving from the current state to a new state,
-- given some source of randomness.
--
-- Maybe report acceptance rates internal to the proposal (e.g., used by
-- proposals based on Hamiltonian dynamics).
type PFunction a = a -> IOGenM StdGen -> IO (PResult a, Maybe AcceptanceRates)

-- | Create a proposal with a single tuning parameter.
--
-- Proposals with auxiliary tuning parameters have to be created manually. See
-- 'Tuner' for more information, and 'Mcmc.Proposal.Hamiltonian' for an example.
createProposal ::
  -- | Description of the proposal type and parameters.
  PDescription ->
  -- | Function creating a simple proposal function for a given tuning parameter.
  (TuningParameter -> PFunction a) ->
  -- | Speed.
  PSpeed ->
  -- | Dimension.
  PDimension ->
  -- | Name.
  PName ->
  -- | Weight.
  PWeight ->
  -- | Activate tuning?
  Tune ->
  Proposal a
createProposal :: forall a.
PDescription
-> (TuningParameter -> PFunction a)
-> PSpeed
-> PDimension
-> PName
-> PWeight
-> Tune
-> Proposal a
createProposal PDescription
r TuningParameter -> PFunction a
f PSpeed
s PDimension
d PName
n PWeight
w Tune
Tune =
  PName
-> PDescription
-> PSpeed
-> PDimension
-> PWeight
-> PFunction a
-> Maybe (Tuner a)
-> Proposal a
forall a.
PName
-> PDescription
-> PSpeed
-> PDimension
-> PWeight
-> PFunction a
-> Maybe (Tuner a)
-> Proposal a
Proposal PName
n PDescription
r PSpeed
s PDimension
d PWeight
w (TuningParameter -> PFunction a
f TuningParameter
1.0) (Tuner a -> Maybe (Tuner a)
forall a. a -> Maybe a
Just Tuner a
tuner)
  where
    fT :: TuningFunction a
fT = TuningFunction a
forall a. TuningFunction a
tuningFunction
    g :: TuningParameter -> p -> Either a (PFunction a)
g TuningParameter
t p
_ = PFunction a -> Either a (PFunction a)
forall a b. b -> Either a b
Right (PFunction a -> Either a (PFunction a))
-> PFunction a -> Either a (PFunction a)
forall a b. (a -> b) -> a -> b
$ TuningParameter -> PFunction a
f TuningParameter
t
    tuner :: Tuner a
tuner = TuningParameter
-> AuxiliaryTuningParameters
-> Bool
-> Bool
-> TuningFunction a
-> (TuningParameter
    -> AuxiliaryTuningParameters -> Either [Char] (PFunction a))
-> Tuner a
forall a.
TuningParameter
-> AuxiliaryTuningParameters
-> Bool
-> Bool
-> TuningFunction a
-> (TuningParameter
    -> AuxiliaryTuningParameters -> Either [Char] (PFunction a))
-> Tuner a
Tuner TuningParameter
1.0 AuxiliaryTuningParameters
forall a. Unbox a => Vector a
VU.empty Bool
False Bool
False TuningFunction a
forall a. TuningFunction a
fT TuningParameter
-> AuxiliaryTuningParameters -> Either [Char] (PFunction a)
forall {p} {a}. TuningParameter -> p -> Either a (PFunction a)
g
createProposal PDescription
r TuningParameter -> PFunction a
f PSpeed
s PDimension
d PName
n PWeight
w Tune
NoTune =
  PName
-> PDescription
-> PSpeed
-> PDimension
-> PWeight
-> PFunction a
-> Maybe (Tuner a)
-> Proposal a
forall a.
PName
-> PDescription
-> PSpeed
-> PDimension
-> PWeight
-> PFunction a
-> Maybe (Tuner a)
-> Proposal a
Proposal PName
n PDescription
r PSpeed
s PDimension
d PWeight
w (TuningParameter -> PFunction a
f TuningParameter
1.0) Maybe (Tuner a)
forall a. Maybe a
Nothing

-- | Required information to tune 'Proposal's.
data Tuner a = Tuner
  { forall a. Tuner a -> TuningParameter
tTuningParameter :: TuningParameter,
    forall a. Tuner a -> AuxiliaryTuningParameters
tAuxiliaryTuningParameters :: AuxiliaryTuningParameters,
    -- | Does the tuner require the trace over the last tuning period?
    forall a. Tuner a -> Bool
tRequireTrace :: Bool,
    -- | Can the tuner be used for intermediate tuning (see 'TuningType')?
    forall a. Tuner a -> Bool
tSuitableForIntermediateTuning :: Bool,
    forall a. Tuner a -> TuningFunction a
tTuningFunction :: TuningFunction a,
    -- | Given the tuning parameter, and the auxiliary tuning parameters, get
    -- the tuned propose function.
    --
    -- Should return 'Left' if the vector of auxiliary tuning parameters is
    -- invalid.
    forall a.
Tuner a
-> TuningParameter
-> AuxiliaryTuningParameters
-> Either [Char] (PFunction a)
tGetPFunction ::
      TuningParameter ->
      AuxiliaryTuningParameters ->
      Either String (PFunction a)
  }

-- | Tune proposal?
data Tune = Tune | NoTune
  deriving (Int -> Tune -> ShowS
[Tune] -> ShowS
Tune -> [Char]
(Int -> Tune -> ShowS)
-> (Tune -> [Char]) -> ([Tune] -> ShowS) -> Show Tune
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tune -> ShowS
showsPrec :: Int -> Tune -> ShowS
$cshow :: Tune -> [Char]
show :: Tune -> [Char]
$cshowList :: [Tune] -> ShowS
showList :: [Tune] -> ShowS
Show, Tune -> Tune -> Bool
(Tune -> Tune -> Bool) -> (Tune -> Tune -> Bool) -> Eq Tune
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tune -> Tune -> Bool
== :: Tune -> Tune -> Bool
$c/= :: Tune -> Tune -> Bool
/= :: Tune -> Tune -> Bool
Eq)

-- | Tuning parameter.
--
--  The larger the tuning parameter, the larger the proposal and the lower the
-- expected acceptance rate; and vice versa.
type TuningParameter = Double

-- | Tuning type. To distinguish between fast and slow proposals, see
-- 'Mcmc.Cycle.IterationMode'.
data TuningType
  = -- | Normal tuning step with fast proposals only.
    NormalTuningFastProposalsOnly
  | -- | Intermediate tuning step executed after each iteration with fast
    -- proposals only. Only suitable for proposals which can calculate expected
    -- acceptance rates.
    IntermediateTuningFastProposalsOnly
  | -- | The last tuning step with fast proposals only may be special.
    LastTuningFastProposalsOnly
  | -- | Normal tuning step of all proposals.
    NormalTuningAllProposals
  | -- | Intermediate tuning step of all proposals.
    IntermediateTuningAllProposals
  | -- | The last tuning step with all proposals.
    LastTuningAllProposals
  deriving (TuningType -> TuningType -> Bool
(TuningType -> TuningType -> Bool)
-> (TuningType -> TuningType -> Bool) -> Eq TuningType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TuningType -> TuningType -> Bool
== :: TuningType -> TuningType -> Bool
$c/= :: TuningType -> TuningType -> Bool
/= :: TuningType -> TuningType -> Bool
Eq)

-- | Compute new tuning parameters.
type TuningFunction a =
  TuningType ->
  PDimension ->
  -- | Acceptance rate of last tuning period. May not always be available
  -- because proposals may be skipped.
  Maybe AcceptanceRate ->
  -- | Trace of last tuning period. Not available for intermediate tuning' steps
  -- (see 'TuningType'), and only available for other tuning types when
  -- requested by proposal.
  Maybe (VB.Vector a) ->
  (TuningParameter, AuxiliaryTuningParameters) ->
  (TuningParameter, AuxiliaryTuningParameters)

-- | Auxiliary tuning parameters.
--
-- Auxiliary tuning parameters are not shown in proposal summaries.
--
-- Vector may be empty.
type AuxiliaryTuningParameters = VU.Vector TuningParameter

tuningFunctionSimple :: PDimension -> AcceptanceRate -> TuningParameter -> TuningParameter
tuningFunctionSimple :: PDimension -> TuningParameter -> TuningParameter -> TuningParameter
tuningFunctionSimple PDimension
d TuningParameter
r TuningParameter
t = let rO :: TuningParameter
rO = PDimension -> TuningParameter
getOptimalRate PDimension
d in TuningParameter -> TuningParameter
forall a. Floating a => a -> a
exp (TuningParameter
2 TuningParameter -> TuningParameter -> TuningParameter
forall a. Num a => a -> a -> a
* (TuningParameter
r TuningParameter -> TuningParameter -> TuningParameter
forall a. Num a => a -> a -> a
- TuningParameter
rO)) TuningParameter -> TuningParameter -> TuningParameter
forall a. Num a => a -> a -> a
* TuningParameter
t

-- | Default tuning function.
--
-- The default tuning function only uses the actual acceptance rate. In
-- particular, it does not handle auxiliary tuning parameters, ignores
-- intermediate tuning steps, and ignores the actual samples attained during the
-- last tuning period.
tuningFunction :: TuningFunction a
tuningFunction :: forall a. TuningFunction a
tuningFunction TuningType
IntermediateTuningFastProposalsOnly PDimension
_ Maybe TuningParameter
_ Maybe (Vector a)
_ (TuningParameter, AuxiliaryTuningParameters)
t = (TuningParameter, AuxiliaryTuningParameters)
t
tuningFunction TuningType
IntermediateTuningAllProposals PDimension
_ Maybe TuningParameter
_ Maybe (Vector a)
_ (TuningParameter, AuxiliaryTuningParameters)
t = (TuningParameter, AuxiliaryTuningParameters)
t
tuningFunction TuningType
_ PDimension
_ Maybe TuningParameter
Nothing Maybe (Vector a)
_ (TuningParameter, AuxiliaryTuningParameters)
t = (TuningParameter, AuxiliaryTuningParameters)
t
tuningFunction TuningType
_ PDimension
d (Just TuningParameter
r) Maybe (Vector a)
_ (!TuningParameter
t, !AuxiliaryTuningParameters
ts) = (TuningParameter -> TuningParameter)
-> (TuningParameter, AuxiliaryTuningParameters)
-> (TuningParameter, AuxiliaryTuningParameters)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (PDimension -> TuningParameter -> TuningParameter -> TuningParameter
tuningFunctionSimple PDimension
d TuningParameter
r) (TuningParameter
t, AuxiliaryTuningParameters
ts)

-- IDEA: Per proposal type tuning parameter boundaries. For example, a sliding
-- proposal with a large tuning parameter is not a problem. But then, if the
-- tuning parameters are very different from one, a different base proposal
-- should be chosen.

-- | Minimal tuning parameter; subject to change.
tuningParameterMin :: TuningParameter
tuningParameterMin :: TuningParameter
tuningParameterMin = TuningParameter
1e-6

-- | Maximal tuning parameter; subject to change.
tuningParameterMax :: TuningParameter
tuningParameterMax :: TuningParameter
tuningParameterMax = TuningParameter
5e3

-- | Tune a 'Proposal'.
--
-- The size of the proposal is proportional to the tuning parameter which has
-- positive lower and upper boundaries of 'tuningParameterMin' and
-- 'tuningParameterMax', respectively.
--
-- Auxiliary tuning parameters may also be used by the 'Tuner' of the proposal.
--
-- Return 'Left' if:
--
-- - the 'Proposal' is not tuneable;
--
-- - the auxiliary tuning parameters are invalid.
--
-- Used by 'Mcmc.Chain.Save.fromSavedChain'.
tuneWithTuningParameters ::
  TuningParameter ->
  AuxiliaryTuningParameters ->
  Proposal a ->
  Either String (Proposal a)
tuneWithTuningParameters :: forall a.
TuningParameter
-> AuxiliaryTuningParameters
-> Proposal a
-> Either [Char] (Proposal a)
tuneWithTuningParameters TuningParameter
t AuxiliaryTuningParameters
ts Proposal a
p = case Proposal a -> Maybe (Tuner a)
forall a. Proposal a -> Maybe (Tuner a)
prTuner Proposal a
p of
  Maybe (Tuner a)
Nothing -> [Char] -> Either [Char] (Proposal a)
forall a b. a -> Either a b
Left [Char]
"tuneWithTuningParameters: Proposal is not tunable."
  Just (Tuner TuningParameter
_ AuxiliaryTuningParameters
_ Bool
reqTr Bool
inTn TuningFunction a
fT TuningParameter
-> AuxiliaryTuningParameters -> Either [Char] (PFunction a)
g) ->
    -- Ensure that the tuning parameter is strictly positive and well bounded.
    let t' :: TuningParameter
t' = TuningParameter -> TuningParameter -> TuningParameter
forall a. Ord a => a -> a -> a
max TuningParameter
tuningParameterMin TuningParameter
t
        t'' :: TuningParameter
t'' = TuningParameter -> TuningParameter -> TuningParameter
forall a. Ord a => a -> a -> a
min TuningParameter
tuningParameterMax TuningParameter
t'
        psE :: Either [Char] (PFunction a)
psE = TuningParameter
-> AuxiliaryTuningParameters -> Either [Char] (PFunction a)
g TuningParameter
t'' AuxiliaryTuningParameters
ts
     in case Either [Char] (PFunction a)
psE of
          Left [Char]
err -> [Char] -> Either [Char] (Proposal a)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (Proposal a))
-> [Char] -> Either [Char] (Proposal a)
forall a b. (a -> b) -> a -> b
$ [Char]
"tune: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
err
          Right PFunction a
ps -> Proposal a -> Either [Char] (Proposal a)
forall a b. b -> Either a b
Right (Proposal a -> Either [Char] (Proposal a))
-> Proposal a -> Either [Char] (Proposal a)
forall a b. (a -> b) -> a -> b
$ Proposal a
p {prFunction = ps, prTuner = Just $ Tuner t'' ts reqTr inTn fT g}

-- | See 'PDimension'.
getOptimalRate :: PDimension -> Double
getOptimalRate :: PDimension -> TuningParameter
getOptimalRate (PDimension Int
n)
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> TuningParameter
forall a. HasCallStack => [Char] -> a
error [Char]
"getOptimalRate: Proposal dimension is zero or negative."
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = TuningParameter
0.44
  -- Use a linear interpolation with delta 0.0515.
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = TuningParameter
0.3885
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = TuningParameter
0.337
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = TuningParameter
0.2855
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
5 = TuningParameter
0.234
  | Bool
otherwise = [Char] -> TuningParameter
forall a. HasCallStack => [Char] -> a
error [Char]
"getOptimalRate: Proposal dimension is not an integer?"
getOptimalRate PDimension
PDimensionUnknown = TuningParameter
0.234
getOptimalRate (PSpecial Int
_ TuningParameter
r) = TuningParameter
r

-- | Lift a proposal from one data type to another.
--
-- Assume the Jacobian is 1.0.
--
-- For example:
--
-- @
-- scaleFirstEntryOfTuple = _1 @~ scale
-- @
--
-- See also 'liftProposalWith'.
infixl 7 @~

(@~) :: Lens' b a -> Proposal a -> Proposal b
@~ :: forall b a. Lens' b a -> Proposal a -> Proposal b
(@~) = Lens' b a -> Proposal a -> Proposal b
forall b a. Lens' b a -> Proposal a -> Proposal b
liftProposal

-- | See '(@~)'.
liftProposal :: Lens' b a -> Proposal a -> Proposal b
liftProposal :: forall b a. Lens' b a -> Proposal a -> Proposal b
liftProposal = JacobianFunction b -> Lens' b a -> Proposal a -> Proposal b
forall b a.
JacobianFunction b -> Lens' b a -> Proposal a -> Proposal b
liftProposalWith (KernelRatio -> JacobianFunction b
forall a b. a -> b -> a
const KernelRatio
1.0)

-- | Lift a proposal from one data type to another.
--
-- A function to calculate the Jacobian has to be provided. If the Jabobian is
-- 1.0, use 'liftProposal'.
--
-- For further reference, please see the [example
-- @Pair@](https://github.com/dschrempf/mcmc/blob/master/mcmc-examples/Pair/Pair.hs).
liftProposalWith :: JacobianFunction b -> Lens' b a -> Proposal a -> Proposal b
liftProposalWith :: forall b a.
JacobianFunction b -> Lens' b a -> Proposal a -> Proposal b
liftProposalWith JacobianFunction b
jf Lens' b a
l (Proposal PName
n PDescription
r PSpeed
d PDimension
p PWeight
w PFunction a
s Maybe (Tuner a)
t) =
  PName
-> PDescription
-> PSpeed
-> PDimension
-> PWeight
-> PFunction b
-> Maybe (Tuner b)
-> Proposal b
forall a.
PName
-> PDescription
-> PSpeed
-> PDimension
-> PWeight
-> PFunction a
-> Maybe (Tuner a)
-> Proposal a
Proposal PName
n PDescription
r PSpeed
d PDimension
p PWeight
w (JacobianFunction b -> Lens' b a -> PFunction a -> PFunction b
forall b a.
JacobianFunction b -> Lens' b a -> PFunction a -> PFunction b
liftPFunctionWith JacobianFunction b
jf (a -> f a) -> b -> f b
Lens' b a
l PFunction a
s) (JacobianFunction b -> Lens' b a -> Tuner a -> Tuner b
forall b a. JacobianFunction b -> Lens' b a -> Tuner a -> Tuner b
liftTunerWith JacobianFunction b
jf (a -> f a) -> b -> f b
Lens' b a
l (Tuner a -> Tuner b) -> Maybe (Tuner a) -> Maybe (Tuner b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Tuner a)
t)

-- Lift a proposal function from one data type to another.
liftPFunctionWith :: JacobianFunction b -> Lens' b a -> PFunction a -> PFunction b
liftPFunctionWith :: forall b a.
JacobianFunction b -> Lens' b a -> PFunction a -> PFunction b
liftPFunctionWith JacobianFunction b
jf Lens' b a
l PFunction a
s = b -> IOGenM StdGen -> IO (PResult b, Maybe AcceptanceRates)
s'
  where
    s' :: b -> IOGenM StdGen -> IO (PResult b, Maybe AcceptanceRates)
s' b
y IOGenM StdGen
g = do
      (PResult a
pr, Maybe AcceptanceRates
ac) <- PFunction a
s (b
y b -> Getting a b a -> a
forall s a. s -> Getting a s a -> a
^. Getting a b a
Lens' b a
l) IOGenM StdGen
g
      let pr' :: PResult b
pr' = case PResult a
pr of
            ForceAccept a
x' -> b -> PResult b
forall a. a -> PResult a
ForceAccept (b -> PResult b) -> b -> PResult b
forall a b. (a -> b) -> a -> b
$ ASetter b b a a -> a -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter b b a a
Lens' b a
l a
x' b
y
            PResult a
ForceReject -> PResult b
forall a. PResult a
ForceReject
            Propose a
x' KernelRatio
r KernelRatio
j ->
              let y' :: b
y' = ASetter b b a a -> a -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter b b a a
Lens' b a
l a
x' b
y
                  jxy :: KernelRatio
jxy = JacobianFunction b
jf b
y
                  jyx :: KernelRatio
jyx = JacobianFunction b
jf b
y'
                  j' :: KernelRatio
j' = KernelRatio
j KernelRatio -> KernelRatio -> KernelRatio
forall a. Num a => a -> a -> a
* KernelRatio
jyx KernelRatio -> KernelRatio -> KernelRatio
forall a. Fractional a => a -> a -> a
/ KernelRatio
jxy
               in b -> KernelRatio -> KernelRatio -> PResult b
forall a. a -> KernelRatio -> KernelRatio -> PResult a
Propose b
y' KernelRatio
r KernelRatio
j'
      (PResult b, Maybe AcceptanceRates)
-> IO (PResult b, Maybe AcceptanceRates)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PResult b
pr', Maybe AcceptanceRates
ac)

-- Lift tuner from one data type to another.
liftTunerWith :: JacobianFunction b -> Lens' b a -> Tuner a -> Tuner b
liftTunerWith :: forall b a. JacobianFunction b -> Lens' b a -> Tuner a -> Tuner b
liftTunerWith JacobianFunction b
jf Lens' b a
l (Tuner TuningParameter
p AuxiliaryTuningParameters
ps Bool
reqTr Bool
inTn TuningFunction a
fP TuningParameter
-> AuxiliaryTuningParameters -> Either [Char] (PFunction a)
g) = TuningParameter
-> AuxiliaryTuningParameters
-> Bool
-> Bool
-> TuningFunction b
-> (TuningParameter
    -> AuxiliaryTuningParameters -> Either [Char] (PFunction b))
-> Tuner b
forall a.
TuningParameter
-> AuxiliaryTuningParameters
-> Bool
-> Bool
-> TuningFunction a
-> (TuningParameter
    -> AuxiliaryTuningParameters -> Either [Char] (PFunction a))
-> Tuner a
Tuner TuningParameter
p AuxiliaryTuningParameters
ps Bool
reqTr Bool
inTn TuningFunction b
fP' TuningParameter
-> AuxiliaryTuningParameters -> Either [Char] (PFunction b)
g'
  where
    fP' :: TuningFunction b
fP' TuningType
b PDimension
d Maybe TuningParameter
r = TuningFunction a
fP TuningType
b PDimension
d Maybe TuningParameter
r (Maybe (Vector a)
 -> (TuningParameter, AuxiliaryTuningParameters)
 -> (TuningParameter, AuxiliaryTuningParameters))
-> (Maybe (Vector b) -> Maybe (Vector a))
-> Maybe (Vector b)
-> (TuningParameter, AuxiliaryTuningParameters)
-> (TuningParameter, AuxiliaryTuningParameters)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector b -> Vector a) -> Maybe (Vector b) -> Maybe (Vector a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> a) -> Vector b -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (b -> Getting a b a -> a
forall s a. s -> Getting a s a -> a
^. Getting a b a
Lens' b a
l))
    g' :: TuningParameter
-> AuxiliaryTuningParameters -> Either [Char] (PFunction b)
g' TuningParameter
x AuxiliaryTuningParameters
xs = JacobianFunction b -> Lens' b a -> PFunction a -> PFunction b
forall b a.
JacobianFunction b -> Lens' b a -> PFunction a -> PFunction b
liftPFunctionWith JacobianFunction b
jf (a -> f a) -> b -> f b
Lens' b a
l (PFunction a -> PFunction b)
-> Either [Char] (PFunction a) -> Either [Char] (PFunction b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TuningParameter
-> AuxiliaryTuningParameters -> Either [Char] (PFunction a)
g TuningParameter
x AuxiliaryTuningParameters
xs

-- Warn if acceptance rate is lower.
rateMin :: Double
rateMin :: TuningParameter
rateMin = TuningParameter
0.1

-- Warn if acceptance rate is larger.
rateMax :: Double
rateMax :: TuningParameter
rateMax = TuningParameter
0.9

renderRow ::
  BL.ByteString ->
  BL.ByteString ->
  BL.ByteString ->
  BL.ByteString ->
  BL.ByteString ->
  BL.ByteString ->
  BL.ByteString ->
  BL.ByteString ->
  BL.ByteString ->
  BL.ByteString
renderRow :: ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
renderRow ByteString
name ByteString
ptype ByteString
weight ByteString
nAccept ByteString
nReject ByteString
acceptRateActual ByteString
optimalRate ByteString
tuneParam ByteString
manualAdjustment =
  ByteString
nm ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
pt ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
wt ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
na ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
nr ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
ra ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
ro ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
tp ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
mt
  where
    nm :: ByteString
nm = Int -> ByteString -> ByteString
alignLeft Int
30 ByteString
name
    pt :: ByteString
pt = Int -> ByteString -> ByteString
alignLeft Int
50 ByteString
ptype
    wt :: ByteString
wt = Int -> ByteString -> ByteString
alignRight Int
8 ByteString
weight
    na :: ByteString
na = Int -> ByteString -> ByteString
alignRight Int
14 ByteString
nAccept
    nr :: ByteString
nr = Int -> ByteString -> ByteString
alignRight Int
14 ByteString
nReject
    ra :: ByteString
ra = Int -> ByteString -> ByteString
alignRight Int
14 ByteString
acceptRateActual
    ro :: ByteString
ro = Int -> ByteString -> ByteString
alignRight Int
14 ByteString
optimalRate
    tp :: ByteString
tp = Int -> ByteString -> ByteString
alignRight Int
20 ByteString
tuneParam
    mt :: ByteString
mt = Int -> ByteString -> ByteString
alignRight Int
30 ByteString
manualAdjustment

-- | Header of proposal summaries.
proposalHeader :: BL.ByteString
proposalHeader :: ByteString
proposalHeader =
  ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
renderRow
    ByteString
"Name"
    ByteString
"Description"
    ByteString
"Weight"
    ByteString
"Accepted"
    ByteString
"Rejected"
    ByteString
"Actual rate"
    ByteString
"Optimal rate"
    ByteString
"Tuning parameter"
    ByteString
"Consider manual adjustment"

-- | Proposal summary.
summarizeProposal ::
  PName ->
  PDescription ->
  PWeight ->
  Maybe TuningParameter ->
  PDimension ->
  (Int, Int, Maybe Double, Maybe Double) ->
  BL.ByteString
summarizeProposal :: PName
-> PDescription
-> PWeight
-> Maybe TuningParameter
-> PDimension
-> (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
-> ByteString
summarizeProposal PName
name PDescription
description PWeight
weight Maybe TuningParameter
tuningParameter PDimension
dimension (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
ar =
  ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
renderRow
    ([Char] -> ByteString
BL.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ PName -> [Char]
fromPName PName
name)
    ([Char] -> ByteString
BL.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ PDescription -> [Char]
fromPDescription PDescription
description)
    ByteString
weightStr
    ByteString
nAccept
    ByteString
nReject
    ByteString
acceptRateActual
    -- acceptRateExpected
    ByteString
optimalRate
    ByteString
tuneParamStr
    ByteString
manualAdjustmentStr
  where
    fN :: Int -> TuningParameter -> Builder
fN Int
n = FloatFormat -> TuningParameter -> Builder
BB.formatDouble (Int -> FloatFormat
BB.standard Int
n)
    weightStr :: ByteString
weightStr = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Builder
BB.intDec (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ PWeight -> Int
fromPWeight PWeight
weight
    nAccept :: ByteString
nAccept = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Builder
BB.intDec (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
ar (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
-> Getting
     Int (Int, Int, Maybe TuningParameter, Maybe TuningParameter) Int
-> Int
forall s a. s -> Getting a s a -> a
^. Getting
  Int (Int, Int, Maybe TuningParameter, Maybe TuningParameter) Int
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
  (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
  Int
  Int
_1
    nReject :: ByteString
nReject = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Builder
BB.intDec (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
ar (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
-> Getting
     Int (Int, Int, Maybe TuningParameter, Maybe TuningParameter) Int
-> Int
forall s a. s -> Getting a s a -> a
^. Getting
  Int (Int, Int, Maybe TuningParameter, Maybe TuningParameter) Int
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
  (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
  Int
  Int
_2
    acceptRateActual :: ByteString
acceptRateActual = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder
-> (TuningParameter -> Builder) -> Maybe TuningParameter -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" (Int -> TuningParameter -> Builder
fN Int
2) ((Int, Int, Maybe TuningParameter, Maybe TuningParameter)
ar (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
-> Getting
     (Maybe TuningParameter)
     (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
     (Maybe TuningParameter)
-> Maybe TuningParameter
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe TuningParameter)
  (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
  (Maybe TuningParameter)
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
  (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
  (Maybe TuningParameter)
  (Maybe TuningParameter)
_3)
    optimalRate :: ByteString
optimalRate = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> TuningParameter -> Builder
fN Int
2 (TuningParameter -> Builder) -> TuningParameter -> Builder
forall a b. (a -> b) -> a -> b
$ PDimension -> TuningParameter
getOptimalRate PDimension
dimension
    tuneParamStr :: ByteString
tuneParamStr = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder
-> (TuningParameter -> Builder) -> Maybe TuningParameter -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" (Int -> TuningParameter -> Builder
fN Int
6) Maybe TuningParameter
tuningParameter
    checkRate :: TuningParameter -> Maybe a
checkRate TuningParameter
rate
      | TuningParameter
rate TuningParameter -> TuningParameter -> Bool
forall a. Ord a => a -> a -> Bool
< TuningParameter
rateMin = a -> Maybe a
forall a. a -> Maybe a
Just a
"rate too low"
      | TuningParameter
rate TuningParameter -> TuningParameter -> Bool
forall a. Ord a => a -> a -> Bool
> TuningParameter
rateMax = a -> Maybe a
forall a. a -> Maybe a
Just a
"rate too high"
      | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
    checkTuningParam :: TuningParameter -> Maybe a
checkTuningParam TuningParameter
tp
      | TuningParameter
tp TuningParameter -> TuningParameter -> Bool
forall a. Ord a => a -> a -> Bool
<= (TuningParameter
1.1 TuningParameter -> TuningParameter -> TuningParameter
forall a. Num a => a -> a -> a
* TuningParameter
tuningParameterMin) = a -> Maybe a
forall a. a -> Maybe a
Just a
"tuning parameter too low"
      | TuningParameter
tp TuningParameter -> TuningParameter -> Bool
forall a. Ord a => a -> a -> Bool
>= (TuningParameter
0.9 TuningParameter -> TuningParameter -> TuningParameter
forall a. Num a => a -> a -> a
* TuningParameter
tuningParameterMax) = a -> Maybe a
forall a. a -> Maybe a
Just a
"tuning parameter too high"
      | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
    tps :: Maybe ByteString
tps = TuningParameter -> Maybe ByteString
forall {a}. IsString a => TuningParameter -> Maybe a
checkTuningParam (TuningParameter -> Maybe ByteString)
-> Maybe TuningParameter -> Maybe ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe TuningParameter
tuningParameter
    -- Use actual acceptance rate.
    ars :: Maybe ByteString
ars = TuningParameter -> Maybe ByteString
forall {a}. IsString a => TuningParameter -> Maybe a
checkRate (TuningParameter -> Maybe ByteString)
-> Maybe TuningParameter -> Maybe ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((Int, Int, Maybe TuningParameter, Maybe TuningParameter)
ar (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
-> Getting
     (Maybe TuningParameter)
     (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
     (Maybe TuningParameter)
-> Maybe TuningParameter
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe TuningParameter)
  (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
  (Maybe TuningParameter)
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
  (Int, Int, Maybe TuningParameter, Maybe TuningParameter)
  (Maybe TuningParameter)
  (Maybe TuningParameter)
_3)
    manualAdjustmentStr :: ByteString
manualAdjustmentStr =
      let
       in case (Maybe ByteString
ars, Maybe ByteString
tps) of
            (Maybe ByteString
Nothing, Maybe ByteString
Nothing) -> ByteString
""
            (Just ByteString
s, Maybe ByteString
_) -> ByteString
s
            (Maybe ByteString
_, Just ByteString
s) -> ByteString
s