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

-- |
-- Module      :  Mcmc.Proposal
-- Description :  Proposals are instruction to move around the state space
-- Copyright   :  (c) Dominik Schrempf 2021
-- 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 (..),
    Proposal (..),
    KernelRatio,
    Jacobian,
    JacobianFunction,
    (@~),
    liftProposal,
    liftProposalWith,
    ProposalSimple,
    createProposal,

    -- * Tuners
    Tuner (..),
    Tune (..),
    TuningParameter,
    TuningFunction,
    AuxiliaryTuningParameters,
    AuxiliaryTuningFunction,
    defaultTuningFunctionWith,
    noTuningFunction,
    noAuxiliaryTuningFunction,
    tuningParameterMin,
    tuningParameterMax,
    tuneWithTuningParameters,
    getOptimalRate,

    -- * Output
    proposalHeader,
    summarizeProposal,
  )
where

import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.Double.Conversion.ByteString as BC
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 Numeric.Log hiding (sum)
import System.Random.MWC

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

-- | Proposal description.
newtype PDescription = PDescription {PDescription -> String
fromPDescription :: String}
  deriving (Int -> PDescription -> ShowS
[PDescription] -> ShowS
PDescription -> String
(Int -> PDescription -> ShowS)
-> (PDescription -> String)
-> ([PDescription] -> ShowS)
-> Show PDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDescription] -> ShowS
$cshowList :: [PDescription] -> ShowS
show :: PDescription -> String
$cshow :: PDescription -> String
showsPrec :: Int -> PDescription -> ShowS
$cshowsPrec :: Int -> PDescription -> ShowS
Show, PDescription -> PDescription -> Bool
(PDescription -> PDescription -> Bool)
-> (PDescription -> PDescription -> Bool) -> Eq PDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDescription -> PDescription -> Bool
$c/= :: PDescription -> PDescription -> Bool
== :: PDescription -> PDescription -> Bool
$c== :: 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
min :: PDescription -> PDescription -> PDescription
$cmin :: PDescription -> PDescription -> PDescription
max :: PDescription -> PDescription -> PDescription
$cmax :: PDescription -> PDescription -> PDescription
>= :: PDescription -> PDescription -> Bool
$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
compare :: PDescription -> PDescription -> Ordering
$ccompare :: PDescription -> PDescription -> Ordering
$cp1Ord :: Eq 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 -> String
(Int -> PWeight -> ShowS)
-> (PWeight -> String) -> ([PWeight] -> ShowS) -> Show PWeight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWeight] -> ShowS
$cshowList :: [PWeight] -> ShowS
show :: PWeight -> String
$cshow :: PWeight -> String
showsPrec :: Int -> PWeight -> ShowS
$cshowsPrec :: Int -> PWeight -> ShowS
Show, PWeight -> PWeight -> Bool
(PWeight -> PWeight -> Bool)
-> (PWeight -> PWeight -> Bool) -> Eq PWeight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWeight -> PWeight -> Bool
$c/= :: PWeight -> PWeight -> Bool
== :: PWeight -> PWeight -> Bool
$c== :: 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
min :: PWeight -> PWeight -> PWeight
$cmin :: PWeight -> PWeight -> PWeight
max :: PWeight -> PWeight -> PWeight
$cmax :: PWeight -> PWeight -> PWeight
>= :: PWeight -> PWeight -> Bool
$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
compare :: PWeight -> PWeight -> Ordering
$ccompare :: PWeight -> PWeight -> Ordering
$cp1Ord :: Eq 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 = String -> PWeight
forall a. HasCallStack => String -> a
error (String -> PWeight) -> String -> PWeight
forall a b. (a -> b) -> a -> b
$ String
"pWeight: Proposal weight is zero or negative: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
  | Bool
otherwise = Int -> PWeight
PWeight Int
n

-- | Proposal dimension.
--
-- The number of affected, independent parameters.
--
-- 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

-- | 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.
    Proposal a -> PName
prName :: PName,
    -- | Description of the proposal type and parameters.
    Proposal a -> PDescription
prDescription :: PDescription,
    -- | Dimension of the proposal. The dimension is used to calculate the
    -- optimal acceptance rate, and does not have to be exact.
    Proposal a -> PDimension
prDimension :: PDimension,
    -- | The weight determines how often a 'Proposal' is executed per iteration of
    -- the Markov chain.
    Proposal a -> PWeight
prWeight :: PWeight,
    -- | Simple proposal without name, weight, and tuning information.
    Proposal a -> ProposalSimple a
prSimple :: ProposalSimple a,
    -- | Tuning is disabled if set to 'Nothing'.
    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.
--
-- Part of the MHG acceptance ratio.
--
-- See also 'Jacobian'.
--
-- NOTE: Actually 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?
type KernelRatio = Log Double

-- | Absolute value of the determinant of the Jacobian matrix.
--
-- Part of the MHG acceptance ratio.
--
-- See also 'Jacobian'.
type Jacobian = Log Double

-- | Function calculating the 'Jacobian' of a proposal.
type JacobianFunction a = a -> Jacobian

-- | 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
@~ :: 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 :: 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 (Jacobian -> JacobianFunction b
forall a b. a -> b -> a
const Jacobian
1.0)

-- | Lift a proposal from one data type to another.
--
-- A function to calculate the Jacobian has to be provided (but see '(@~)').
--
-- 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 :: JacobianFunction b -> Lens' b a -> Proposal a -> Proposal b
liftProposalWith JacobianFunction b
jf Lens' b a
l (Proposal PName
n PDescription
r PDimension
d PWeight
w ProposalSimple a
s Maybe (Tuner a)
t) =
  PName
-> PDescription
-> PDimension
-> PWeight
-> ProposalSimple b
-> Maybe (Tuner b)
-> Proposal b
forall a.
PName
-> PDescription
-> PDimension
-> PWeight
-> ProposalSimple a
-> Maybe (Tuner a)
-> Proposal a
Proposal PName
n PDescription
r PDimension
d PWeight
w (JacobianFunction b
-> Lens' b a -> ProposalSimple a -> ProposalSimple b
forall b a.
JacobianFunction b
-> Lens' b a -> ProposalSimple a -> ProposalSimple b
liftProposalSimpleWith JacobianFunction b
jf Lens' b a
l ProposalSimple 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 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)

-- | Simple proposal without tuning information.
--
-- Instruction about randomly moving from the current state to a new state,
-- given some source of randomness.
--
-- 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'.
--
-- For unbiased proposals, these values are 1.0 such that
--
-- @
-- proposalSimpleUnbiased x g = return (x', 1.0, 1.0)
-- @
--
-- For biased proposals, the kernel ratio is qYX / qXY, where qXY is the
-- probability density to move from X to Y, and the absolute value of the
-- determinant of the Jacobian matrix differs from 1.0.
type ProposalSimple a = a -> GenIO -> IO (a, KernelRatio, Jacobian)

-- Lift a simple proposal from one data type to another.
liftProposalSimpleWith :: JacobianFunction b -> Lens' b a -> ProposalSimple a -> ProposalSimple b
liftProposalSimpleWith :: JacobianFunction b
-> Lens' b a -> ProposalSimple a -> ProposalSimple b
liftProposalSimpleWith JacobianFunction b
jf Lens' b a
l ProposalSimple a
s = b -> Gen RealWorld -> IO (b, Jacobian, Jacobian)
ProposalSimple b
s'
  where
    s' :: b -> Gen RealWorld -> IO (b, Jacobian, Jacobian)
s' b
y Gen RealWorld
g = do
      (a
x', Jacobian
r, Jacobian
j) <- ProposalSimple 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) Gen RealWorld
Gen (PrimState IO)
g
      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 :: Jacobian
jxy = JacobianFunction b
jf b
y
          jyx :: Jacobian
jyx = JacobianFunction b
jf b
y'
          j' :: Jacobian
j' = Jacobian
j Jacobian -> Jacobian -> Jacobian
forall a. Num a => a -> a -> a
* Jacobian
jyx Jacobian -> Jacobian -> Jacobian
forall a. Fractional a => a -> a -> a
/ Jacobian
jxy
      (b, Jacobian, Jacobian) -> IO (b, Jacobian, Jacobian)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
y', Jacobian
r, Jacobian
j')

-- | Create a proposal with a single tuning parameter.
--
-- Proposals with arbitrary 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 for a given tuning parameter.
  (TuningParameter -> ProposalSimple a) ->
  -- | Dimension.
  PDimension ->
  -- | Name.
  PName ->
  -- | Weight.
  PWeight ->
  -- | Activate tuning?
  Tune ->
  Proposal a
createProposal :: PDescription
-> (TuningParameter -> ProposalSimple a)
-> PDimension
-> PName
-> PWeight
-> Tune
-> Proposal a
createProposal PDescription
r TuningParameter -> ProposalSimple a
f PDimension
d PName
n PWeight
w Tune
Tune =
  PName
-> PDescription
-> PDimension
-> PWeight
-> ProposalSimple a
-> Maybe (Tuner a)
-> Proposal a
forall a.
PName
-> PDescription
-> PDimension
-> PWeight
-> ProposalSimple a
-> Maybe (Tuner a)
-> Proposal a
Proposal PName
n PDescription
r PDimension
d PWeight
w (TuningParameter -> ProposalSimple a
f TuningParameter
1.0) (Tuner a -> Maybe (Tuner a)
forall a. a -> Maybe a
Just Tuner a
tuner)
  where
    fT :: TuningFunction
fT = PDimension -> TuningFunction
defaultTuningFunctionWith PDimension
d
    fTs :: AuxiliaryTuningFunction a
fTs = AuxiliaryTuningFunction a
forall a. AuxiliaryTuningFunction a
noAuxiliaryTuningFunction
    g :: TuningParameter
-> p -> Either a (a -> Gen RealWorld -> IO (a, Jacobian, Jacobian))
g TuningParameter
t p
_ = (a -> Gen RealWorld -> IO (a, Jacobian, Jacobian))
-> Either a (a -> Gen RealWorld -> IO (a, Jacobian, Jacobian))
forall a b. b -> Either a b
Right ((a -> Gen RealWorld -> IO (a, Jacobian, Jacobian))
 -> Either a (a -> Gen RealWorld -> IO (a, Jacobian, Jacobian)))
-> (a -> Gen RealWorld -> IO (a, Jacobian, Jacobian))
-> Either a (a -> Gen RealWorld -> IO (a, Jacobian, Jacobian))
forall a b. (a -> b) -> a -> b
$ TuningParameter -> ProposalSimple a
f TuningParameter
t
    tuner :: Tuner a
tuner = TuningParameter
-> TuningFunction
-> AuxiliaryTuningParameters
-> AuxiliaryTuningFunction a
-> (TuningParameter
    -> AuxiliaryTuningParameters -> Either String (ProposalSimple a))
-> Tuner a
forall a.
TuningParameter
-> TuningFunction
-> AuxiliaryTuningParameters
-> AuxiliaryTuningFunction a
-> (TuningParameter
    -> AuxiliaryTuningParameters -> Either String (ProposalSimple a))
-> Tuner a
Tuner TuningParameter
1.0 TuningFunction
fT AuxiliaryTuningParameters
forall a. Unbox a => Vector a
VU.empty AuxiliaryTuningFunction a
forall a. AuxiliaryTuningFunction a
fTs TuningParameter
-> AuxiliaryTuningParameters -> Either String (ProposalSimple a)
forall p a.
TuningParameter
-> p -> Either a (a -> Gen RealWorld -> IO (a, Jacobian, Jacobian))
g
createProposal PDescription
r TuningParameter -> ProposalSimple a
f PDimension
d PName
n PWeight
w Tune
NoTune =
  PName
-> PDescription
-> PDimension
-> PWeight
-> ProposalSimple a
-> Maybe (Tuner a)
-> Proposal a
forall a.
PName
-> PDescription
-> PDimension
-> PWeight
-> ProposalSimple a
-> Maybe (Tuner a)
-> Proposal a
Proposal PName
n PDescription
r PDimension
d PWeight
w (TuningParameter -> ProposalSimple a
f TuningParameter
1.0) Maybe (Tuner a)
forall a. Maybe a
Nothing

-- | Required information to tune 'Proposal's.
data Tuner a = Tuner
  { Tuner a -> TuningParameter
tTuningParameter :: TuningParameter,
    Tuner a -> TuningFunction
tTuningFunction :: TuningFunction,
    Tuner a -> AuxiliaryTuningParameters
tAuxiliaryTuningParameters :: AuxiliaryTuningParameters,
    Tuner a -> AuxiliaryTuningFunction a
tAuxiliaryTuningFunction :: AuxiliaryTuningFunction a,
    -- | Given the tuning parameter, and the auxiliary tuning parameters, get
    -- the tuned simple proposal.
    --
    -- Should return 'Left' if the vector of auxiliary tuning parameters is
    -- invalid.
    Tuner a
-> TuningParameter
-> AuxiliaryTuningParameters
-> Either String (ProposalSimple a)
tGetSimpleProposal ::
      TuningParameter ->
      AuxiliaryTuningParameters ->
      Either String (ProposalSimple a)
  }

-- Lift tuner from one data type to another.
liftTunerWith :: JacobianFunction b -> Lens' b a -> Tuner a -> Tuner b
liftTunerWith :: JacobianFunction b -> Lens' b a -> Tuner a -> Tuner b
liftTunerWith JacobianFunction b
jf Lens' b a
l (Tuner TuningParameter
p TuningFunction
fP AuxiliaryTuningParameters
ps AuxiliaryTuningFunction a
fPs TuningParameter
-> AuxiliaryTuningParameters -> Either String (ProposalSimple a)
g) = TuningParameter
-> TuningFunction
-> AuxiliaryTuningParameters
-> AuxiliaryTuningFunction b
-> (TuningParameter
    -> AuxiliaryTuningParameters -> Either String (ProposalSimple b))
-> Tuner b
forall a.
TuningParameter
-> TuningFunction
-> AuxiliaryTuningParameters
-> AuxiliaryTuningFunction a
-> (TuningParameter
    -> AuxiliaryTuningParameters -> Either String (ProposalSimple a))
-> Tuner a
Tuner TuningParameter
p TuningFunction
fP AuxiliaryTuningParameters
ps AuxiliaryTuningFunction b
fPs' TuningParameter
-> AuxiliaryTuningParameters
-> Either String (b -> Gen RealWorld -> IO (b, Jacobian, Jacobian))
TuningParameter
-> AuxiliaryTuningParameters -> Either String (ProposalSimple b)
g'
  where
    fPs' :: AuxiliaryTuningFunction b
fPs' = AuxiliaryTuningFunction a
fPs AuxiliaryTuningFunction a
-> (Vector b -> Vector a) -> AuxiliaryTuningFunction b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 String (b -> Gen RealWorld -> IO (b, Jacobian, Jacobian))
g' TuningParameter
x AuxiliaryTuningParameters
xs = JacobianFunction b
-> Lens' b a -> ProposalSimple a -> ProposalSimple b
forall b a.
JacobianFunction b
-> Lens' b a -> ProposalSimple a -> ProposalSimple b
liftProposalSimpleWith JacobianFunction b
jf Lens' b a
l ((a -> Gen RealWorld -> IO (a, Jacobian, Jacobian))
 -> b -> Gen RealWorld -> IO (b, Jacobian, Jacobian))
-> Either String (a -> Gen RealWorld -> IO (a, Jacobian, Jacobian))
-> Either String (b -> Gen RealWorld -> IO (b, Jacobian, Jacobian))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TuningParameter
-> AuxiliaryTuningParameters -> Either String (ProposalSimple a)
g TuningParameter
x AuxiliaryTuningParameters
xs

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

-- | Compute new tuning parameter from a given acceptance rate and the old
-- tuning parameter.
type TuningFunction = AcceptanceRate -> TuningParameter -> TuningParameter

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

-- | Compute new auxiliary tuning parameters from a given trace and the old
-- auxiliary tuning parameters.
type AuxiliaryTuningFunction a = VB.Vector a -> AuxiliaryTuningParameters -> AuxiliaryTuningParameters

-- | Default tuning function.
--
-- Subject to change.
defaultTuningFunctionWith ::
  -- Optimal acceptance rate.
  PDimension ->
  TuningFunction
defaultTuningFunctionWith :: PDimension -> TuningFunction
defaultTuningFunctionWith 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 TuningFunction
forall a. Num a => a -> a -> a
* (TuningParameter
r TuningFunction
forall a. Num a => a -> a -> a
- TuningParameter
rO)) TuningFunction
forall a. Num a => a -> a -> a
* TuningParameter
t

-- | Do not tune.
--
-- Useful if auxiliary tuning parameters are tuned, but not the main tuning
-- parameter.
noTuningFunction :: TuningFunction
noTuningFunction :: TuningFunction
noTuningFunction TuningParameter
_ = TuningParameter -> TuningParameter
forall a. a -> a
id

-- | Do not tune auxiliary parameters.
noAuxiliaryTuningFunction :: AuxiliaryTuningFunction a
noAuxiliaryTuningFunction :: AuxiliaryTuningFunction a
noAuxiliaryTuningFunction Vector a
_ = AuxiliaryTuningParameters -> AuxiliaryTuningParameters
forall a. a -> a
id

-- 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-5

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

-- | 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 :: TuningParameter
-> AuxiliaryTuningParameters
-> Proposal a
-> Either String (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 -> String -> Either String (Proposal a)
forall a b. a -> Either a b
Left String
"tuneWithTuningParameters: Proposal is not tunable."
  Just (Tuner TuningParameter
_ TuningFunction
fT AuxiliaryTuningParameters
_ AuxiliaryTuningFunction a
fTs TuningParameter
-> AuxiliaryTuningParameters -> Either String (ProposalSimple a)
g) ->
    -- Ensure that the tuning parameter is strictly positive and well bounded.
    let t' :: TuningParameter
t' = TuningFunction
forall a. Ord a => a -> a -> a
max TuningParameter
tuningParameterMin TuningParameter
t
        t'' :: TuningParameter
t'' = TuningFunction
forall a. Ord a => a -> a -> a
min TuningParameter
tuningParameterMax TuningParameter
t'
        psE :: Either String (ProposalSimple a)
psE = TuningParameter
-> AuxiliaryTuningParameters -> Either String (ProposalSimple a)
g TuningParameter
t'' AuxiliaryTuningParameters
ts
     in case Either String (a -> Gen RealWorld -> IO (a, Jacobian, Jacobian))
psE of
          Left String
err -> String -> Either String (Proposal a)
forall a b. a -> Either a b
Left (String -> Either String (Proposal a))
-> String -> Either String (Proposal a)
forall a b. (a -> b) -> a -> b
$ String
"tune: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err
          Right a -> Gen RealWorld -> IO (a, Jacobian, Jacobian)
ps -> Proposal a -> Either String (Proposal a)
forall a b. b -> Either a b
Right (Proposal a -> Either String (Proposal a))
-> Proposal a -> Either String (Proposal a)
forall a b. (a -> b) -> a -> b
$ Proposal a
p {prSimple :: ProposalSimple a
prSimple = a -> Gen RealWorld -> IO (a, Jacobian, Jacobian)
ProposalSimple a
ps, prTuner :: Maybe (Tuner a)
prTuner = Tuner a -> Maybe (Tuner a)
forall a. a -> Maybe a
Just (Tuner a -> Maybe (Tuner a)) -> Tuner a -> Maybe (Tuner a)
forall a b. (a -> b) -> a -> b
$ TuningParameter
-> TuningFunction
-> AuxiliaryTuningParameters
-> AuxiliaryTuningFunction a
-> (TuningParameter
    -> AuxiliaryTuningParameters -> Either String (ProposalSimple a))
-> Tuner a
forall a.
TuningParameter
-> TuningFunction
-> AuxiliaryTuningParameters
-> AuxiliaryTuningFunction a
-> (TuningParameter
    -> AuxiliaryTuningParameters -> Either String (ProposalSimple a))
-> Tuner a
Tuner TuningParameter
t'' TuningFunction
fT AuxiliaryTuningParameters
ts AuxiliaryTuningFunction a
fTs TuningParameter
-> AuxiliaryTuningParameters -> Either String (ProposalSimple a)
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 = String -> TuningParameter
forall a. HasCallStack => String -> a
error String
"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 = String -> TuningParameter
forall a. HasCallStack => String -> a
error String
"getOptimalRate: Proposal dimension is not an integer?"
getOptimalRate PDimension
PDimensionUnknown = TuningParameter
0.234
getOptimalRate (PSpecial Int
_ TuningParameter
r) = TuningParameter
r

-- 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
acceptRate 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
acceptRate
    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
"Rate"
    ByteString
"Optimal rate"
    ByteString
"Tuning parameter"
    ByteString
"Consider manual adjustment"

-- | Proposal summary.
summarizeProposal ::
  PName ->
  PDescription ->
  PWeight ->
  Maybe TuningParameter ->
  PDimension ->
  Maybe (Int, Int, Double) ->
  BL.ByteString
summarizeProposal :: PName
-> PDescription
-> PWeight
-> Maybe TuningParameter
-> PDimension
-> Maybe (Int, Int, TuningParameter)
-> ByteString
summarizeProposal PName
name PDescription
description PWeight
weight Maybe TuningParameter
tuningParameter PDimension
dimension Maybe (Int, Int, TuningParameter)
ar =
  ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
renderRow
    (String -> ByteString
BL.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ PName -> String
fromPName PName
name)
    (String -> ByteString
BL.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ PDescription -> String
fromPDescription PDescription
description)
    ByteString
weightStr
    ByteString
nAccept
    ByteString
nReject
    ByteString
acceptRate
    ByteString
optimalRate
    ByteString
tuneParamStr
    ByteString
manualAdjustmentStr
  where
    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
$ Builder
-> ((Int, Int, TuningParameter) -> Builder)
-> Maybe (Int, Int, TuningParameter)
-> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" (Int -> Builder
BB.intDec (Int -> Builder)
-> ((Int, Int, TuningParameter) -> Int)
-> (Int, Int, TuningParameter)
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int, TuningParameter)
-> Getting Int (Int, Int, TuningParameter) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Int, Int, TuningParameter) Int
forall s t a b. Field1 s t a b => Lens s t a b
_1)) Maybe (Int, Int, TuningParameter)
ar
    nReject :: ByteString
nReject = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder
-> ((Int, Int, TuningParameter) -> Builder)
-> Maybe (Int, Int, TuningParameter)
-> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" (Int -> Builder
BB.intDec (Int -> Builder)
-> ((Int, Int, TuningParameter) -> Int)
-> (Int, Int, TuningParameter)
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int, TuningParameter)
-> Getting Int (Int, Int, TuningParameter) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Int, Int, TuningParameter) Int
forall s t a b. Field2 s t a b => Lens s t a b
_2)) Maybe (Int, Int, TuningParameter)
ar
    acceptRate :: ByteString
acceptRate = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
-> ((Int, Int, TuningParameter) -> ByteString)
-> Maybe (Int, Int, TuningParameter)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" (Int -> TuningParameter -> ByteString
BC.toFixed Int
2 (TuningParameter -> ByteString)
-> ((Int, Int, TuningParameter) -> TuningParameter)
-> (Int, Int, TuningParameter)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int, TuningParameter)
-> Getting
     TuningParameter (Int, Int, TuningParameter) TuningParameter
-> TuningParameter
forall s a. s -> Getting a s a -> a
^. Getting TuningParameter (Int, Int, TuningParameter) TuningParameter
forall s t a b. Field3 s t a b => Lens s t a b
_3)) Maybe (Int, Int, TuningParameter)
ar
    optimalRate :: ByteString
optimalRate = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> TuningParameter -> ByteString
BC.toFixed Int
2 (TuningParameter -> ByteString) -> TuningParameter -> ByteString
forall a b. (a -> b) -> a -> b
$ PDimension -> TuningParameter
getOptimalRate PDimension
dimension
    tuneParamStr :: ByteString
tuneParamStr = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
-> (TuningParameter -> ByteString)
-> Maybe TuningParameter
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" (Int -> TuningParameter -> ByteString
BC.toFixed Int
4) 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 TuningFunction
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 TuningFunction
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
    ars :: Maybe ByteString
ars = (TuningParameter -> Maybe ByteString
forall a. IsString a => TuningParameter -> Maybe a
checkRate (TuningParameter -> Maybe ByteString)
-> ((Int, Int, TuningParameter) -> TuningParameter)
-> (Int, Int, TuningParameter)
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int, TuningParameter)
-> Getting
     TuningParameter (Int, Int, TuningParameter) TuningParameter
-> TuningParameter
forall s a. s -> Getting a s a -> a
^. Getting TuningParameter (Int, Int, TuningParameter) TuningParameter
forall s t a b. Field3 s t a b => Lens s t a b
_3)) ((Int, Int, TuningParameter) -> Maybe ByteString)
-> Maybe (Int, Int, TuningParameter) -> Maybe ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Int, Int, TuningParameter)
ar
    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