{-# LANGUAGE BangPatterns #-}
{-# 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 and types
    PName (..),
    PDescription (..),
    PWeight (fromPWeight),
    pWeight,
    PDimension (..),
    Proposal (..),
    KernelRatio,
    Jacobian,
    JacobianFunction,
    (@~),
    liftProposal,
    liftProposalWith,
    ProposalSimple,
    Tuner (..),
    Tune (..),
    createProposal,
    TuningParameter,
    tuningParameterMin,
    tuningParameterMax,
    tune,
    getOptimalRate,

    -- * Cycles
    Order (..),
    Cycle (ccProposals),
    cycleFromList,
    setOrder,
    prepareProposals,
    tuneCycle,
    autoTuneCycle,

    -- * Acceptance rates
    Acceptance (fromAcceptance),
    emptyA,
    pushA,
    resetA,
    transformKeysA,
    acceptanceRate,
    acceptanceRates,

    -- * Output
    proposalHeader,
    proposalHLine,
    summarizeProposal,
    summarizeCycle,
  )
where

import Control.DeepSeq
import Data.Aeson
import Data.Bifunctor
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Default
import qualified Data.Double.Conversion.ByteString as BC
import Data.Function
import Data.List
import qualified Data.Map.Strict as M
import Data.Maybe
import Lens.Micro
import Mcmc.Internal.ByteString
import Mcmc.Internal.Shuffle
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.
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.
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: Proposal weight is zero or negative."
          | Bool
otherwise = Int -> PWeight
PWeight Int
n

-- | Proposal dimension.
--
-- The number of affected, independent parameters.
--
-- The optimal acceptance rate of low dimensional proposals is higher than for
-- high dimensional ones.
--
-- Optimal acceptance rates are still subject to controversies. As far as I
-- know, research has focused on random walk proposal with a multivariate normal
-- distribution 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? I
-- don't know, but I set the dimension 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), I still set the dimension of
-- the proposal to the number of variables changed.
--
-- Finally, I assume that proposals of unknown dimension have high dimension,
-- and use the optimal acceptance rate 0.234.
data PDimension = PDimension Int | PDimensionUnknown

-- | 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 step size to tune 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. It is a constant reminder: 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 (see also 'liftProposal' and 'liftProposalWith').
--
-- For example:
--
-- @
-- scaleFirstEntryOfTuple = _1 @~ scale
-- @
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

-- | Lift a proposal from one data type to another.
--
-- Assume the Jacobian is 1.0 (see also '(@~)' and 'liftProposalWith').
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 (see also
-- '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 :: 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
convertProposalSimple 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
convertTuner 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)

convertProposalSimple :: JacobianFunction b -> Lens' b a -> ProposalSimple a -> ProposalSimple b
convertProposalSimple :: JacobianFunction b
-> Lens' b a -> ProposalSimple a -> ProposalSimple b
convertProposalSimple 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')

-- | Tune the acceptance rate of a 'Proposal'; see 'tune', or 'autoTuneCycle'.
data Tuner a = Tuner
  { Tuner a -> TuningParameter
tParam :: TuningParameter,
    Tuner a -> TuningParameter -> ProposalSimple a
tFunc :: TuningParameter -> ProposalSimple a
  }

convertTuner :: JacobianFunction b -> Lens' b a -> Tuner a -> Tuner b
convertTuner :: JacobianFunction b -> Lens' b a -> Tuner a -> Tuner b
convertTuner JacobianFunction b
jf Lens' b a
l (Tuner TuningParameter
p TuningParameter -> ProposalSimple a
f) = TuningParameter -> (TuningParameter -> ProposalSimple b) -> Tuner b
forall a.
TuningParameter -> (TuningParameter -> ProposalSimple a) -> Tuner a
Tuner TuningParameter
p TuningParameter -> b -> Gen RealWorld -> IO (b, Jacobian, Jacobian)
TuningParameter -> ProposalSimple b
f'
  where
    f' :: TuningParameter -> ProposalSimple b
f' TuningParameter
x = JacobianFunction b
-> Lens' b a -> ProposalSimple a -> ProposalSimple b
forall b a.
JacobianFunction b
-> Lens' b a -> ProposalSimple a -> ProposalSimple b
convertProposalSimple JacobianFunction b
jf Lens' b a
l (ProposalSimple a -> ProposalSimple b)
-> ProposalSimple a -> ProposalSimple b
forall a b. (a -> b) -> a -> b
$ TuningParameter -> ProposalSimple a
f TuningParameter
x

-- | Tune the 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.
type TuningParameter = Double

-- | Create a tuneable proposal.
createProposal ::
  -- | Description of the proposal type and parameters.
  PDescription ->
  -- | Function creating a simple proposal for a given tuning parameter. The
  -- larger the tuning parameter, the larger the proposal and the lower the
  -- expected acceptance rate; and vice versa.
  (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 -> Maybe (Tuner a)) -> Tuner a -> Maybe (Tuner a)
forall a b. (a -> b) -> a -> b
$ TuningParameter -> (TuningParameter -> ProposalSimple a) -> Tuner a
forall a.
TuningParameter -> (TuningParameter -> ProposalSimple a) -> Tuner a
Tuner TuningParameter
1.0 TuningParameter -> ProposalSimple a
f)
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

-- | Minimal tuning parameter; @1e-12@, subject to change.
--
-- >>> tuningParameterMin
-- 1e-5
tuningParameterMin :: TuningParameter
tuningParameterMin :: TuningParameter
tuningParameterMin = TuningParameter
1e-5

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

-- | Tune a 'Proposal'.
--
-- The size of the proposal is proportional to the tuning parameter which has a
-- positive lower bound of 'tuningParameterMin'.
--
-- The tuning function maps the current tuning parameter to a new one.
--
-- Return 'Nothing' if 'Proposal' is not tuneable.
tune :: (TuningParameter -> TuningParameter) -> Proposal a -> Maybe (Proposal a)
tune :: (TuningParameter -> TuningParameter)
-> Proposal a -> Maybe (Proposal a)
tune TuningParameter -> TuningParameter
f Proposal a
m = do
  (Tuner TuningParameter
t TuningParameter -> ProposalSimple a
g) <- Proposal a -> Maybe (Tuner a)
forall a. Proposal a -> Maybe (Tuner a)
prTuner Proposal a
m
  -- 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 -> TuningParameter
f TuningParameter
t)
      t'' :: TuningParameter
t'' = TuningParameter -> TuningParameter -> TuningParameter
forall a. Ord a => a -> a -> a
min TuningParameter
tuningParameterMax TuningParameter
t'
  Proposal a -> Maybe (Proposal a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Proposal a -> Maybe (Proposal a))
-> Proposal a -> Maybe (Proposal a)
forall a b. (a -> b) -> a -> b
$ Proposal a
m {prSimple :: ProposalSimple a
prSimple = TuningParameter -> ProposalSimple a
g TuningParameter
t'', 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 -> (TuningParameter -> ProposalSimple a) -> Tuner a
forall a.
TuningParameter -> (TuningParameter -> ProposalSimple a) -> Tuner a
Tuner TuningParameter
t'' TuningParameter -> 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

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

-- | Define the order in which 'Proposal's are executed in a 'Cycle'. The total
-- number of 'Proposal's per 'Cycle' may differ between 'Order's (e.g., compare
-- 'RandomO' and 'RandomReversibleO').
data Order
  = -- | Shuffle the 'Proposal's in the 'Cycle'. The 'Proposal's are replicated
    -- according to their weights and executed in random order. If a 'Proposal' has
    -- weight @w@, it is executed exactly @w@ times per iteration.
    RandomO
  | -- | The 'Proposal's are executed sequentially, in the order they appear in the
    -- 'Cycle'. 'Proposal's with weight @w>1@ are repeated immediately @w@ times
    -- (and not appended to the end of the list).
    SequentialO
  | -- | Similar to 'RandomO'. However, a reversed copy of the list of
    --  shuffled 'Proposal's is appended such that the resulting Markov chain is
    --  reversible.
    --  Note: the total number of 'Proposal's executed per cycle is twice the number
    --  of 'RandomO'.
    RandomReversibleO
  | -- | Similar to 'SequentialO'. However, a reversed copy of the list of
    -- sequentially ordered 'Proposal's is appended such that the resulting Markov
    -- chain is reversible.
    SequentialReversibleO
  deriving (Order -> Order -> Bool
(Order -> Order -> Bool) -> (Order -> Order -> Bool) -> Eq Order
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Order -> Order -> Bool
$c/= :: Order -> Order -> Bool
== :: Order -> Order -> Bool
$c== :: Order -> Order -> Bool
Eq, Int -> Order -> ShowS
[Order] -> ShowS
Order -> String
(Int -> Order -> ShowS)
-> (Order -> String) -> ([Order] -> ShowS) -> Show Order
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Order] -> ShowS
$cshowList :: [Order] -> ShowS
show :: Order -> String
$cshow :: Order -> String
showsPrec :: Int -> Order -> ShowS
$cshowsPrec :: Int -> Order -> ShowS
Show)

instance Default Order where def :: Order
def = Order
RandomO

-- Describe the order.
describeOrder :: Order -> BL.ByteString
describeOrder :: Order -> ByteString
describeOrder Order
RandomO = ByteString
"The proposals are executed in random order."
describeOrder Order
SequentialO = ByteString
"The proposals are executed sequentially."
describeOrder Order
RandomReversibleO =
  ByteString -> [ByteString] -> ByteString
BL.intercalate
    ByteString
"\n"
    [ Order -> ByteString
describeOrder Order
RandomO,
      ByteString
"A reversed copy of the shuffled proposals is appended to ensure reversibility."
    ]
describeOrder Order
SequentialReversibleO =
  ByteString -> [ByteString] -> ByteString
BL.intercalate
    ByteString
"\n"
    [ Order -> ByteString
describeOrder Order
SequentialO,
      ByteString
"A reversed copy of the sequential proposals is appended to ensure reversibility."
    ]

-- | In brief, a 'Cycle' is a list of proposals.
--
-- The state of the Markov chain will be logged only after all 'Proposal's in
-- the 'Cycle' have been completed, and the iteration counter will be increased
-- by one. The order in which the 'Proposal's are executed is specified by
-- 'Order'. The default is 'RandomO'.
--
-- No proposals with the same name and description are allowed in a 'Cycle', so
-- that they can be uniquely identified.
data Cycle a = Cycle
  { Cycle a -> [Proposal a]
ccProposals :: [Proposal a],
    Cycle a -> Order
ccOrder :: Order
  }

-- | Create a 'Cycle' from a list of 'Proposal's.
cycleFromList :: [Proposal a] -> Cycle a
cycleFromList :: [Proposal a] -> Cycle a
cycleFromList [] =
  String -> Cycle a
forall a. HasCallStack => String -> a
error String
"cycleFromList: Received an empty list but cannot create an empty Cycle."
cycleFromList [Proposal a]
xs =
  if [Proposal a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Proposal a] -> [Proposal a]
forall a. Eq a => [a] -> [a]
nub [Proposal a]
xs) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Proposal a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Proposal a]
xs
    then [Proposal a] -> Order -> Cycle a
forall a. [Proposal a] -> Order -> Cycle a
Cycle [Proposal a]
xs Order
forall a. Default a => a
def
    else String -> Cycle a
forall a. HasCallStack => String -> a
error String
"cycleFromList: Proposals are not unique."

-- | Set the order of 'Proposal's in a 'Cycle'.
setOrder :: Order -> Cycle a -> Cycle a
setOrder :: Order -> Cycle a -> Cycle a
setOrder Order
o Cycle a
c = Cycle a
c {ccOrder :: Order
ccOrder = Order
o}

-- | Replicate 'Proposal's according to their weights and possibly shuffle them.
prepareProposals :: Cycle a -> GenIO -> IO [Proposal a]
prepareProposals :: Cycle a -> Gen (PrimState IO) -> IO [Proposal a]
prepareProposals (Cycle [Proposal a]
xs Order
o) Gen (PrimState IO)
g = case Order
o of
  Order
RandomO -> [Proposal a] -> Gen (PrimState IO) -> IO [Proposal a]
forall a. [a] -> Gen (PrimState IO) -> IO [a]
shuffle [Proposal a]
ps Gen (PrimState IO)
g
  Order
SequentialO -> [Proposal a] -> IO [Proposal a]
forall (m :: * -> *) a. Monad m => a -> m a
return [Proposal a]
ps
  Order
RandomReversibleO -> do
    [Proposal a]
psR <- [Proposal a] -> Gen (PrimState IO) -> IO [Proposal a]
forall a. [a] -> Gen (PrimState IO) -> IO [a]
shuffle [Proposal a]
ps Gen (PrimState IO)
g
    [Proposal a] -> IO [Proposal a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Proposal a] -> IO [Proposal a])
-> [Proposal a] -> IO [Proposal a]
forall a b. (a -> b) -> a -> b
$ [Proposal a]
psR [Proposal a] -> [Proposal a] -> [Proposal a]
forall a. [a] -> [a] -> [a]
++ [Proposal a] -> [Proposal a]
forall a. [a] -> [a]
reverse [Proposal a]
psR
  Order
SequentialReversibleO -> [Proposal a] -> IO [Proposal a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Proposal a] -> IO [Proposal a])
-> [Proposal a] -> IO [Proposal a]
forall a b. (a -> b) -> a -> b
$ [Proposal a]
ps [Proposal a] -> [Proposal a] -> [Proposal a]
forall a. [a] -> [a] -> [a]
++ [Proposal a] -> [Proposal a]
forall a. [a] -> [a]
reverse [Proposal a]
ps
  where
    !ps :: [Proposal a]
ps = [[Proposal a]] -> [Proposal a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int -> Proposal a -> [Proposal a]
forall a. Int -> a -> [a]
replicate (PWeight -> Int
fromPWeight (PWeight -> Int) -> PWeight -> Int
forall a b. (a -> b) -> a -> b
$ Proposal a -> PWeight
forall a. Proposal a -> PWeight
prWeight Proposal a
p) Proposal a
p | Proposal a
p <- [Proposal a]
xs]

-- The number of proposals depends on the order.
getNProposalsPerCycle :: Cycle a -> Int
getNProposalsPerCycle :: Cycle a -> Int
getNProposalsPerCycle (Cycle [Proposal a]
xs Order
o) = case Order
o of
  Order
RandomO -> Int
once
  Order
SequentialO -> Int
once
  Order
RandomReversibleO -> Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
once
  Order
SequentialReversibleO -> Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
once
  where
    once :: Int
once = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Proposal a -> Int) -> [Proposal a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (PWeight -> Int
fromPWeight (PWeight -> Int) -> (Proposal a -> PWeight) -> Proposal a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proposal a -> PWeight
forall a. Proposal a -> PWeight
prWeight) [Proposal a]
xs

-- | Tune 'Proposal's in the 'Cycle'. See 'tune'.
tuneCycle :: M.Map (Proposal a) (TuningParameter -> TuningParameter) -> Cycle a -> Cycle a
tuneCycle :: Map (Proposal a) (TuningParameter -> TuningParameter)
-> Cycle a -> Cycle a
tuneCycle Map (Proposal a) (TuningParameter -> TuningParameter)
m Cycle a
c =
  if [Proposal a] -> [Proposal a]
forall a. Ord a => [a] -> [a]
sort (Map (Proposal a) (TuningParameter -> TuningParameter)
-> [Proposal a]
forall k a. Map k a -> [k]
M.keys Map (Proposal a) (TuningParameter -> TuningParameter)
m) [Proposal a] -> [Proposal a] -> Bool
forall a. Eq a => a -> a -> Bool
== [Proposal a] -> [Proposal a]
forall a. Ord a => [a] -> [a]
sort [Proposal a]
ps
    then Cycle a
c {ccProposals :: [Proposal a]
ccProposals = (Proposal a -> Proposal a) -> [Proposal a] -> [Proposal a]
forall a b. (a -> b) -> [a] -> [b]
map Proposal a -> Proposal a
tuneF [Proposal a]
ps}
    else String -> Cycle a
forall a. HasCallStack => String -> a
error String
"tuneCycle: Propoals in map and cycle do not match."
  where
    ps :: [Proposal a]
ps = Cycle a -> [Proposal a]
forall a. Cycle a -> [Proposal a]
ccProposals Cycle a
c
    tuneF :: Proposal a -> Proposal a
tuneF Proposal a
p = case Map (Proposal a) (TuningParameter -> TuningParameter)
m Map (Proposal a) (TuningParameter -> TuningParameter)
-> Proposal a -> Maybe (TuningParameter -> TuningParameter)
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? Proposal a
p of
      Maybe (TuningParameter -> TuningParameter)
Nothing -> Proposal a
p
      Just TuningParameter -> TuningParameter
f -> Proposal a -> Maybe (Proposal a) -> Proposal a
forall a. a -> Maybe a -> a
fromMaybe Proposal a
p ((TuningParameter -> TuningParameter)
-> Proposal a -> Maybe (Proposal a)
forall a.
(TuningParameter -> TuningParameter)
-> Proposal a -> Maybe (Proposal a)
tune TuningParameter -> TuningParameter
f Proposal a
p)

-- | Calculate acceptance rates and auto tune the 'Proposal's in the 'Cycle'. For
-- now, a 'Proposal' is enlarged when the acceptance rate is above 0.44, and
-- shrunk otherwise. Do not change 'Proposal's that are not tuneable.
autoTuneCycle :: Acceptance (Proposal a) -> Cycle a -> Cycle a
autoTuneCycle :: Acceptance (Proposal a) -> Cycle a -> Cycle a
autoTuneCycle Acceptance (Proposal a)
a = Map (Proposal a) (TuningParameter -> TuningParameter)
-> Cycle a -> Cycle a
forall a.
Map (Proposal a) (TuningParameter -> TuningParameter)
-> Cycle a -> Cycle a
tuneCycle ((Proposal a
 -> Maybe TuningParameter -> TuningParameter -> TuningParameter)
-> Map (Proposal a) (Maybe TuningParameter)
-> Map (Proposal a) (TuningParameter -> TuningParameter)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey Proposal a
-> Maybe TuningParameter -> TuningParameter -> TuningParameter
forall a.
Proposal a
-> Maybe TuningParameter -> TuningParameter -> TuningParameter
tuningF (Map (Proposal a) (Maybe TuningParameter)
 -> Map (Proposal a) (TuningParameter -> TuningParameter))
-> Map (Proposal a) (Maybe TuningParameter)
-> Map (Proposal a) (TuningParameter -> TuningParameter)
forall a b. (a -> b) -> a -> b
$ Acceptance (Proposal a) -> Map (Proposal a) (Maybe TuningParameter)
forall k. Acceptance k -> Map k (Maybe TuningParameter)
acceptanceRates Acceptance (Proposal a)
a)
  where
    tuningF :: Proposal a
-> Maybe TuningParameter -> TuningParameter -> TuningParameter
tuningF Proposal a
proposal Maybe TuningParameter
mCurrentRate TuningParameter
currentTuningParam = case Maybe TuningParameter
mCurrentRate of
      Maybe TuningParameter
Nothing -> TuningParameter
currentTuningParam
      Just TuningParameter
currentRate ->
        let optimalRate :: TuningParameter
optimalRate = PDimension -> TuningParameter
getOptimalRate (Proposal a -> PDimension
forall a. Proposal a -> PDimension
prDimension Proposal a
proposal)
         in TuningParameter -> TuningParameter
forall a. Floating a => a -> a
exp (TuningParameter
2 TuningParameter -> TuningParameter -> TuningParameter
forall a. Num a => a -> a -> a
* (TuningParameter
currentRate TuningParameter -> TuningParameter -> TuningParameter
forall a. Num a => a -> a -> a
- TuningParameter
optimalRate)) TuningParameter -> TuningParameter -> TuningParameter
forall a. Num a => a -> a -> a
* TuningParameter
currentTuningParam

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

-- | For each key @k@, store the number of accepted and rejected proposals.
newtype Acceptance k = Acceptance {Acceptance k -> Map k (Int, Int)
fromAcceptance :: M.Map k (Int, Int)}
  deriving (Acceptance k -> Acceptance k -> Bool
(Acceptance k -> Acceptance k -> Bool)
-> (Acceptance k -> Acceptance k -> Bool) -> Eq (Acceptance k)
forall k. Eq k => Acceptance k -> Acceptance k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Acceptance k -> Acceptance k -> Bool
$c/= :: forall k. Eq k => Acceptance k -> Acceptance k -> Bool
== :: Acceptance k -> Acceptance k -> Bool
$c== :: forall k. Eq k => Acceptance k -> Acceptance k -> Bool
Eq, ReadPrec [Acceptance k]
ReadPrec (Acceptance k)
Int -> ReadS (Acceptance k)
ReadS [Acceptance k]
(Int -> ReadS (Acceptance k))
-> ReadS [Acceptance k]
-> ReadPrec (Acceptance k)
-> ReadPrec [Acceptance k]
-> Read (Acceptance k)
forall k. (Ord k, Read k) => ReadPrec [Acceptance k]
forall k. (Ord k, Read k) => ReadPrec (Acceptance k)
forall k. (Ord k, Read k) => Int -> ReadS (Acceptance k)
forall k. (Ord k, Read k) => ReadS [Acceptance k]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Acceptance k]
$creadListPrec :: forall k. (Ord k, Read k) => ReadPrec [Acceptance k]
readPrec :: ReadPrec (Acceptance k)
$creadPrec :: forall k. (Ord k, Read k) => ReadPrec (Acceptance k)
readList :: ReadS [Acceptance k]
$creadList :: forall k. (Ord k, Read k) => ReadS [Acceptance k]
readsPrec :: Int -> ReadS (Acceptance k)
$creadsPrec :: forall k. (Ord k, Read k) => Int -> ReadS (Acceptance k)
Read, Int -> Acceptance k -> ShowS
[Acceptance k] -> ShowS
Acceptance k -> String
(Int -> Acceptance k -> ShowS)
-> (Acceptance k -> String)
-> ([Acceptance k] -> ShowS)
-> Show (Acceptance k)
forall k. Show k => Int -> Acceptance k -> ShowS
forall k. Show k => [Acceptance k] -> ShowS
forall k. Show k => Acceptance k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Acceptance k] -> ShowS
$cshowList :: forall k. Show k => [Acceptance k] -> ShowS
show :: Acceptance k -> String
$cshow :: forall k. Show k => Acceptance k -> String
showsPrec :: Int -> Acceptance k -> ShowS
$cshowsPrec :: forall k. Show k => Int -> Acceptance k -> ShowS
Show)

instance ToJSONKey k => ToJSON (Acceptance k) where
  toJSON :: Acceptance k -> Value
toJSON (Acceptance Map k (Int, Int)
m) = Map k (Int, Int) -> Value
forall a. ToJSON a => a -> Value
toJSON Map k (Int, Int)
m
  toEncoding :: Acceptance k -> Encoding
toEncoding (Acceptance Map k (Int, Int)
m) = Map k (Int, Int) -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Map k (Int, Int)
m

instance (Ord k, FromJSONKey k) => FromJSON (Acceptance k) where
  parseJSON :: Value -> Parser (Acceptance k)
parseJSON Value
v = Map k (Int, Int) -> Acceptance k
forall k. Map k (Int, Int) -> Acceptance k
Acceptance (Map k (Int, Int) -> Acceptance k)
-> Parser (Map k (Int, Int)) -> Parser (Acceptance k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map k (Int, Int))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

-- | In the beginning there was the Word.
--
-- Initialize an empty storage of accepted/rejected values.
emptyA :: Ord k => [k] -> Acceptance k
emptyA :: [k] -> Acceptance k
emptyA [k]
ks = Map k (Int, Int) -> Acceptance k
forall k. Map k (Int, Int) -> Acceptance k
Acceptance (Map k (Int, Int) -> Acceptance k)
-> Map k (Int, Int) -> Acceptance k
forall a b. (a -> b) -> a -> b
$ [(k, (Int, Int))] -> Map k (Int, Int)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k
k, (Int
0, Int
0)) | k
k <- [k]
ks]

-- | For key @k@, prepend an accepted (True) or rejected (False) proposal.
pushA :: Ord k => k -> Bool -> Acceptance k -> Acceptance k
pushA :: k -> Bool -> Acceptance k -> Acceptance k
pushA k
k Bool
True = Map k (Int, Int) -> Acceptance k
forall k. Map k (Int, Int) -> Acceptance k
Acceptance (Map k (Int, Int) -> Acceptance k)
-> (Acceptance k -> Map k (Int, Int))
-> Acceptance k
-> Acceptance k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> (Int, Int))
-> k -> Map k (Int, Int) -> Map k (Int, Int)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ((Int, Int) -> (Int, Int)
forall a. NFData a => a -> a
force ((Int, Int) -> (Int, Int))
-> ((Int, Int) -> (Int, Int)) -> (Int, Int) -> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> (Int, Int) -> (Int, Int)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Int -> Int
forall a. Enum a => a -> a
succ) k
k (Map k (Int, Int) -> Map k (Int, Int))
-> (Acceptance k -> Map k (Int, Int))
-> Acceptance k
-> Map k (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acceptance k -> Map k (Int, Int)
forall k. Acceptance k -> Map k (Int, Int)
fromAcceptance
pushA k
k Bool
False = Map k (Int, Int) -> Acceptance k
forall k. Map k (Int, Int) -> Acceptance k
Acceptance (Map k (Int, Int) -> Acceptance k)
-> (Acceptance k -> Map k (Int, Int))
-> Acceptance k
-> Acceptance k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> (Int, Int))
-> k -> Map k (Int, Int) -> Map k (Int, Int)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ((Int, Int) -> (Int, Int)
forall a. NFData a => a -> a
force ((Int, Int) -> (Int, Int))
-> ((Int, Int) -> (Int, Int)) -> (Int, Int) -> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> (Int, Int) -> (Int, Int)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Int -> Int
forall a. Enum a => a -> a
succ) k
k (Map k (Int, Int) -> Map k (Int, Int))
-> (Acceptance k -> Map k (Int, Int))
-> Acceptance k
-> Map k (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acceptance k -> Map k (Int, Int)
forall k. Acceptance k -> Map k (Int, Int)
fromAcceptance
{-# INLINEABLE pushA #-}

-- | Reset acceptance storage.
resetA :: Ord k => Acceptance k -> Acceptance k
resetA :: Acceptance k -> Acceptance k
resetA = [k] -> Acceptance k
forall k. Ord k => [k] -> Acceptance k
emptyA ([k] -> Acceptance k)
-> (Acceptance k -> [k]) -> Acceptance k -> Acceptance k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (Int, Int) -> [k]
forall k a. Map k a -> [k]
M.keys (Map k (Int, Int) -> [k])
-> (Acceptance k -> Map k (Int, Int)) -> Acceptance k -> [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acceptance k -> Map k (Int, Int)
forall k. Acceptance k -> Map k (Int, Int)
fromAcceptance

transformKeys :: (Ord k1, Ord k2) => [k1] -> [k2] -> M.Map k1 v -> M.Map k2 v
transformKeys :: [k1] -> [k2] -> Map k1 v -> Map k2 v
transformKeys [k1]
ks1 [k2]
ks2 Map k1 v
m = (Map k2 v -> (k1, k2) -> Map k2 v)
-> Map k2 v -> [(k1, k2)] -> Map k2 v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map k2 v -> (k1, k2) -> Map k2 v
forall k. Ord k => Map k v -> (k1, k) -> Map k v
insrt Map k2 v
forall k a. Map k a
M.empty ([(k1, k2)] -> Map k2 v) -> [(k1, k2)] -> Map k2 v
forall a b. (a -> b) -> a -> b
$ [k1] -> [k2] -> [(k1, k2)]
forall a b. [a] -> [b] -> [(a, b)]
zip [k1]
ks1 [k2]
ks2
  where
    insrt :: Map k v -> (k1, k) -> Map k v
insrt Map k v
m' (k1
k1, k
k2) = k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
k2 (Map k1 v
m Map k1 v -> k1 -> v
forall k a. Ord k => Map k a -> k -> a
M.! k1
k1) Map k v
m'

-- | Transform keys using the given lists. Keys not provided will not be present
-- in the new 'Acceptance' variable.
transformKeysA :: (Ord k1, Ord k2) => [k1] -> [k2] -> Acceptance k1 -> Acceptance k2
transformKeysA :: [k1] -> [k2] -> Acceptance k1 -> Acceptance k2
transformKeysA [k1]
ks1 [k2]
ks2 = Map k2 (Int, Int) -> Acceptance k2
forall k. Map k (Int, Int) -> Acceptance k
Acceptance (Map k2 (Int, Int) -> Acceptance k2)
-> (Acceptance k1 -> Map k2 (Int, Int))
-> Acceptance k1
-> Acceptance k2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [k1] -> [k2] -> Map k1 (Int, Int) -> Map k2 (Int, Int)
forall k1 k2 v.
(Ord k1, Ord k2) =>
[k1] -> [k2] -> Map k1 v -> Map k2 v
transformKeys [k1]
ks1 [k2]
ks2 (Map k1 (Int, Int) -> Map k2 (Int, Int))
-> (Acceptance k1 -> Map k1 (Int, Int))
-> Acceptance k1
-> Map k2 (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acceptance k1 -> Map k1 (Int, Int)
forall k. Acceptance k -> Map k (Int, Int)
fromAcceptance

-- | Acceptance counts and rate for a specific proposal.
--
-- Return 'Nothing' if no proposals have been accepted or rejected (division by
-- zero).
acceptanceRate :: Ord k => k -> Acceptance k -> Maybe (Int, Int, Double)
acceptanceRate :: k -> Acceptance k -> Maybe (Int, Int, TuningParameter)
acceptanceRate k
k Acceptance k
a = case Acceptance k -> Map k (Int, Int)
forall k. Acceptance k -> Map k (Int, Int)
fromAcceptance Acceptance k
a Map k (Int, Int) -> k -> Maybe (Int, Int)
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? k
k of
  Just (Int
0, Int
0) -> Maybe (Int, Int, TuningParameter)
forall a. Maybe a
Nothing
  Just (Int
as, Int
rs) -> (Int, Int, TuningParameter) -> Maybe (Int, Int, TuningParameter)
forall a. a -> Maybe a
Just (Int
as, Int
rs, Int -> TuningParameter
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
as TuningParameter -> TuningParameter -> TuningParameter
forall a. Fractional a => a -> a -> a
/ Int -> TuningParameter
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
as Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs))
  Maybe (Int, Int)
Nothing -> String -> Maybe (Int, Int, TuningParameter)
forall a. HasCallStack => String -> a
error String
"acceptanceRate: Key not found in map."

-- | Acceptance rates for all proposals.
--
-- Set rate to 'Nothing' if no proposals have been accepted or rejected
-- (division by zero).
acceptanceRates :: Acceptance k -> M.Map k (Maybe Double)
acceptanceRates :: Acceptance k -> Map k (Maybe TuningParameter)
acceptanceRates =
  ((Int, Int) -> Maybe TuningParameter)
-> Map k (Int, Int) -> Map k (Maybe TuningParameter)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map
    ( \(Int
as, Int
rs) ->
        if Int
as Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
          then Maybe TuningParameter
forall a. Maybe a
Nothing
          else TuningParameter -> Maybe TuningParameter
forall a. a -> Maybe a
Just (TuningParameter -> Maybe TuningParameter)
-> TuningParameter -> Maybe TuningParameter
forall a b. (a -> b) -> a -> b
$ Int -> TuningParameter
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
as TuningParameter -> TuningParameter -> TuningParameter
forall a. Fractional a => a -> a -> a
/ Int -> TuningParameter
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
as Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs)
    )
    (Map k (Int, Int) -> Map k (Maybe TuningParameter))
-> (Acceptance k -> Map k (Int, Int))
-> Acceptance k
-> Map k (Maybe TuningParameter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acceptance k -> Map k (Int, Int)
forall k. Acceptance k -> Map k (Int, Int)
fromAcceptance

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

-- | Horizontal line of proposal summaries.
proposalHLine :: BL.ByteString
proposalHLine :: ByteString
proposalHLine = Int64 -> Char -> ByteString
BL.replicate (ByteString -> Int64
BL.length ByteString
proposalHeader) Char
'-'

-- | 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
3) 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
    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

-- | Summarize the 'Proposal's in the 'Cycle'. Also report acceptance rates.
summarizeCycle :: Acceptance (Proposal a) -> Cycle a -> BL.ByteString
summarizeCycle :: Acceptance (Proposal a) -> Cycle a -> ByteString
summarizeCycle Acceptance (Proposal a)
a Cycle a
c =
  ByteString -> [ByteString] -> ByteString
BL.intercalate ByteString
"\n" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
    [ ByteString
"Summary of proposal(s) in cycle.",
      ByteString
nProposalsFullStr,
      Order -> ByteString
describeOrder (Cycle a -> Order
forall a. Cycle a -> Order
ccOrder Cycle a
c),
      ByteString
proposalHeader,
      ByteString
proposalHLine
    ]
      [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ PName
-> PDescription
-> PWeight
-> Maybe TuningParameter
-> PDimension
-> Maybe (Int, Int, TuningParameter)
-> ByteString
summarizeProposal
             (Proposal a -> PName
forall a. Proposal a -> PName
prName Proposal a
p)
             (Proposal a -> PDescription
forall a. Proposal a -> PDescription
prDescription Proposal a
p)
             (Proposal a -> PWeight
forall a. Proposal a -> PWeight
prWeight Proposal a
p)
             (Tuner a -> TuningParameter
forall a. Tuner a -> TuningParameter
tParam (Tuner a -> TuningParameter)
-> Maybe (Tuner a) -> Maybe TuningParameter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proposal a -> Maybe (Tuner a)
forall a. Proposal a -> Maybe (Tuner a)
prTuner Proposal a
p)
             (Proposal a -> PDimension
forall a. Proposal a -> PDimension
prDimension Proposal a
p)
             (Proposal a -> Maybe (Int, Int, TuningParameter)
ar Proposal a
p)
           | Proposal a
p <- [Proposal a]
ps
         ]
      [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
proposalHLine]
  where
    ps :: [Proposal a]
ps = Cycle a -> [Proposal a]
forall a. Cycle a -> [Proposal a]
ccProposals Cycle a
c
    nProposals :: Int
nProposals = Cycle a -> Int
forall a. Cycle a -> Int
getNProposalsPerCycle Cycle a
c
    nProposalsStr :: ByteString
nProposalsStr = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Builder
BB.intDec Int
nProposals
    nProposalsFullStr :: ByteString
nProposalsFullStr = case Int
nProposals of
      Int
1 -> ByteString
nProposalsStr ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" proposal is performed per iteration."
      Int
_ -> ByteString
nProposalsStr ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" proposals are performed per iterations."
    ar :: Proposal a -> Maybe (Int, Int, TuningParameter)
ar Proposal a
m = Proposal a
-> Acceptance (Proposal a) -> Maybe (Int, Int, TuningParameter)
forall k.
Ord k =>
k -> Acceptance k -> Maybe (Int, Int, TuningParameter)
acceptanceRate Proposal a
m Acceptance (Proposal a)
a