{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      :  Mcmc.Settings
-- Description :  Settings of Markov chain Monte Carlo samplers
-- Copyright   :  2021 Dominik Schrempf
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Mon Nov 16 11:13:01 2020.
module Mcmc.Settings
  ( -- * Data types
    AnalysisName (..),
    HasAnalysisName (..),
    BurnInSettings (..),
    burnInIterations,
    Iterations (..),
    TraceLength (..),
    ExecutionMode (..),
    HasExecutionMode (..),
    openWithExecutionMode,
    ParallelizationMode (..),
    SaveMode (..),
    LogMode (..),
    Verbosity (..),

    -- * Settings
    Settings (..),
    settingsSave,
    settingsLoad,
    settingsCheck,
    settingsPrettyPrint,
  )
where

import Data.Aeson
import Data.Aeson.TH
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy.Char8 as BL
import Mcmc.Logger
import System.Directory
import System.IO

bsInt :: Int -> BL.ByteString
bsInt :: Int -> ByteString
bsInt = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> (Int -> Builder) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
BB.intDec

-- | Analysis name of the MCMC sampler.
newtype AnalysisName = AnalysisName {AnalysisName -> String
fromAnalysisName :: String}
  deriving (AnalysisName -> AnalysisName -> Bool
(AnalysisName -> AnalysisName -> Bool)
-> (AnalysisName -> AnalysisName -> Bool) -> Eq AnalysisName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnalysisName -> AnalysisName -> Bool
$c/= :: AnalysisName -> AnalysisName -> Bool
== :: AnalysisName -> AnalysisName -> Bool
$c== :: AnalysisName -> AnalysisName -> Bool
Eq, ReadPrec [AnalysisName]
ReadPrec AnalysisName
Int -> ReadS AnalysisName
ReadS [AnalysisName]
(Int -> ReadS AnalysisName)
-> ReadS [AnalysisName]
-> ReadPrec AnalysisName
-> ReadPrec [AnalysisName]
-> Read AnalysisName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AnalysisName]
$creadListPrec :: ReadPrec [AnalysisName]
readPrec :: ReadPrec AnalysisName
$creadPrec :: ReadPrec AnalysisName
readList :: ReadS [AnalysisName]
$creadList :: ReadS [AnalysisName]
readsPrec :: Int -> ReadS AnalysisName
$creadsPrec :: Int -> ReadS AnalysisName
Read, Int -> AnalysisName -> ShowS
[AnalysisName] -> ShowS
AnalysisName -> String
(Int -> AnalysisName -> ShowS)
-> (AnalysisName -> String)
-> ([AnalysisName] -> ShowS)
-> Show AnalysisName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnalysisName] -> ShowS
$cshowList :: [AnalysisName] -> ShowS
show :: AnalysisName -> String
$cshow :: AnalysisName -> String
showsPrec :: Int -> AnalysisName -> ShowS
$cshowsPrec :: Int -> AnalysisName -> ShowS
Show)
  deriving (Semigroup AnalysisName
AnalysisName
Semigroup AnalysisName
-> AnalysisName
-> (AnalysisName -> AnalysisName -> AnalysisName)
-> ([AnalysisName] -> AnalysisName)
-> Monoid AnalysisName
[AnalysisName] -> AnalysisName
AnalysisName -> AnalysisName -> AnalysisName
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [AnalysisName] -> AnalysisName
$cmconcat :: [AnalysisName] -> AnalysisName
mappend :: AnalysisName -> AnalysisName -> AnalysisName
$cmappend :: AnalysisName -> AnalysisName -> AnalysisName
mempty :: AnalysisName
$cmempty :: AnalysisName
$cp1Monoid :: Semigroup AnalysisName
Monoid, b -> AnalysisName -> AnalysisName
NonEmpty AnalysisName -> AnalysisName
AnalysisName -> AnalysisName -> AnalysisName
(AnalysisName -> AnalysisName -> AnalysisName)
-> (NonEmpty AnalysisName -> AnalysisName)
-> (forall b. Integral b => b -> AnalysisName -> AnalysisName)
-> Semigroup AnalysisName
forall b. Integral b => b -> AnalysisName -> AnalysisName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> AnalysisName -> AnalysisName
$cstimes :: forall b. Integral b => b -> AnalysisName -> AnalysisName
sconcat :: NonEmpty AnalysisName -> AnalysisName
$csconcat :: NonEmpty AnalysisName -> AnalysisName
<> :: AnalysisName -> AnalysisName -> AnalysisName
$c<> :: AnalysisName -> AnalysisName -> AnalysisName
Semigroup) via String

$(deriveJSON defaultOptions ''AnalysisName)

-- | Types with analysis names.
class HasAnalysisName s where
  getAnalysisName :: s -> AnalysisName

-- | Burn in specification.
data BurnInSettings
  = -- | No burn in.
    NoBurnIn
  | -- | Burn in for a given number of iterations.
    BurnInWithoutAutoTuning Int
  | -- | Burn in for a given number of iterations. Enable auto tuning with a
    -- given period.
    BurnInWithAutoTuning Int Int
  | -- | Burn in with the given list of fast and full auto tuning periods.
    --
    -- The list of fast auto tuning periods may be empty. All periods have to be
    -- strictly positive.
    --
    -- See also 'Mcmc.Proposals.PSpeed'.
    --
    -- For example, @BurnInWithCustomAutoTuning [50] [100,200]@ performs
    -- 1a. 50 iterations without any slow proposals such as Hamiltonian proposals;
    -- 1b. Auto tuning;
    -- 2a. 100 iterations with all proposals;
    -- 2b Auto tuning;
    -- 3a. 200 iterations with all proposals;
    -- 3b. Auto tuning.
    --
    -- Usually it is useful to auto tune more frequently in the beginning of the
    -- MCMC run.
    BurnInWithCustomAutoTuning [Int] [Int]
  deriving (BurnInSettings -> BurnInSettings -> Bool
(BurnInSettings -> BurnInSettings -> Bool)
-> (BurnInSettings -> BurnInSettings -> Bool) -> Eq BurnInSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BurnInSettings -> BurnInSettings -> Bool
$c/= :: BurnInSettings -> BurnInSettings -> Bool
== :: BurnInSettings -> BurnInSettings -> Bool
$c== :: BurnInSettings -> BurnInSettings -> Bool
Eq, ReadPrec [BurnInSettings]
ReadPrec BurnInSettings
Int -> ReadS BurnInSettings
ReadS [BurnInSettings]
(Int -> ReadS BurnInSettings)
-> ReadS [BurnInSettings]
-> ReadPrec BurnInSettings
-> ReadPrec [BurnInSettings]
-> Read BurnInSettings
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BurnInSettings]
$creadListPrec :: ReadPrec [BurnInSettings]
readPrec :: ReadPrec BurnInSettings
$creadPrec :: ReadPrec BurnInSettings
readList :: ReadS [BurnInSettings]
$creadList :: ReadS [BurnInSettings]
readsPrec :: Int -> ReadS BurnInSettings
$creadsPrec :: Int -> ReadS BurnInSettings
Read, Int -> BurnInSettings -> ShowS
[BurnInSettings] -> ShowS
BurnInSettings -> String
(Int -> BurnInSettings -> ShowS)
-> (BurnInSettings -> String)
-> ([BurnInSettings] -> ShowS)
-> Show BurnInSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BurnInSettings] -> ShowS
$cshowList :: [BurnInSettings] -> ShowS
show :: BurnInSettings -> String
$cshow :: BurnInSettings -> String
showsPrec :: Int -> BurnInSettings -> ShowS
$cshowsPrec :: Int -> BurnInSettings -> ShowS
Show)

$(deriveJSON defaultOptions ''BurnInSettings)

burnInPrettyPrint :: BurnInSettings -> BL.ByteString
burnInPrettyPrint :: BurnInSettings -> ByteString
burnInPrettyPrint BurnInSettings
NoBurnIn =
  ByteString
"None."
burnInPrettyPrint (BurnInWithoutAutoTuning Int
x) =
  Int -> ByteString
bsInt Int
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" iterations; no auto tune."
burnInPrettyPrint (BurnInWithAutoTuning Int
x Int
y) =
  Int -> ByteString
bsInt Int
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" iterations; auto tune with a period of " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString
bsInt Int
y ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"."
burnInPrettyPrint (BurnInWithCustomAutoTuning [Int]
xs [Int]
ys) =
  Int -> ByteString
bsInt ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
xs) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" fast, " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString
bsInt ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ys) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" slow iterations; custom auto tune periods."

-- Check if the burn in settings are valid.
burnInValid :: BurnInSettings -> Bool
burnInValid :: BurnInSettings -> Bool
burnInValid BurnInSettings
NoBurnIn = Bool
True
burnInValid (BurnInWithoutAutoTuning Int
n) = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
burnInValid (BurnInWithAutoTuning Int
n Int
t) = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
-- The list of fast auto tuning periods may be empty, the list of full auto
-- tuning periods must be non-empty. All periods have to be strictly positive.
burnInValid (BurnInWithCustomAutoTuning [Int]
xs [Int]
ys) = (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) [Int]
xs Bool -> Bool -> Bool
&& Bool -> Bool
not ([Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
ys) Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) [Int]
ys

-- | Get the number of burn in iterations.
burnInIterations :: BurnInSettings -> Int
burnInIterations :: BurnInSettings -> Int
burnInIterations BurnInSettings
NoBurnIn = Int
0
burnInIterations (BurnInWithoutAutoTuning Int
n) = Int
n
burnInIterations (BurnInWithAutoTuning Int
n Int
_) = Int
n
burnInIterations (BurnInWithCustomAutoTuning [Int]
xs [Int]
ys) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ys

-- | Number of normal iterations after burn in.
--
-- Note that auto tuning only happens during burn in.
newtype Iterations = Iterations {Iterations -> Int
fromIterations :: Int}
  deriving (Iterations -> Iterations -> Bool
(Iterations -> Iterations -> Bool)
-> (Iterations -> Iterations -> Bool) -> Eq Iterations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Iterations -> Iterations -> Bool
$c/= :: Iterations -> Iterations -> Bool
== :: Iterations -> Iterations -> Bool
$c== :: Iterations -> Iterations -> Bool
Eq, ReadPrec [Iterations]
ReadPrec Iterations
Int -> ReadS Iterations
ReadS [Iterations]
(Int -> ReadS Iterations)
-> ReadS [Iterations]
-> ReadPrec Iterations
-> ReadPrec [Iterations]
-> Read Iterations
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Iterations]
$creadListPrec :: ReadPrec [Iterations]
readPrec :: ReadPrec Iterations
$creadPrec :: ReadPrec Iterations
readList :: ReadS [Iterations]
$creadList :: ReadS [Iterations]
readsPrec :: Int -> ReadS Iterations
$creadsPrec :: Int -> ReadS Iterations
Read, Int -> Iterations -> ShowS
[Iterations] -> ShowS
Iterations -> String
(Int -> Iterations -> ShowS)
-> (Iterations -> String)
-> ([Iterations] -> ShowS)
-> Show Iterations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Iterations] -> ShowS
$cshowList :: [Iterations] -> ShowS
show :: Iterations -> String
$cshow :: Iterations -> String
showsPrec :: Int -> Iterations -> ShowS
$cshowsPrec :: Int -> Iterations -> ShowS
Show)

$(deriveJSON defaultOptions ''Iterations)

-- | The length of the stored "Mcmc.Chain.Trace".
--
-- Be careful, this setting determines the memory requirement of the MCMC chain.
data TraceLength
  = -- | Automatically determine the minimum length of the trace. The value is
    -- the maximum of used
    --
    -- - 'Mcmc.Monitor.MonitorBatch' sizes
    --
    -- - auto tune intervals during burn in
    TraceAuto
  | -- | Store a given minimum number of iterations of the chain. Store more
    --  iterations if required (see 'TraceAuto').
    TraceMinimum Int
  deriving (TraceLength -> TraceLength -> Bool
(TraceLength -> TraceLength -> Bool)
-> (TraceLength -> TraceLength -> Bool) -> Eq TraceLength
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceLength -> TraceLength -> Bool
$c/= :: TraceLength -> TraceLength -> Bool
== :: TraceLength -> TraceLength -> Bool
$c== :: TraceLength -> TraceLength -> Bool
Eq, Int -> TraceLength -> ShowS
[TraceLength] -> ShowS
TraceLength -> String
(Int -> TraceLength -> ShowS)
-> (TraceLength -> String)
-> ([TraceLength] -> ShowS)
-> Show TraceLength
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceLength] -> ShowS
$cshowList :: [TraceLength] -> ShowS
show :: TraceLength -> String
$cshow :: TraceLength -> String
showsPrec :: Int -> TraceLength -> ShowS
$cshowsPrec :: Int -> TraceLength -> ShowS
Show)

$(deriveJSON defaultOptions ''TraceLength)

traceLengthPrettyPrint :: TraceLength -> BL.ByteString
traceLengthPrettyPrint :: TraceLength -> ByteString
traceLengthPrettyPrint TraceLength
TraceAuto = ByteString
"Determined automatically."
traceLengthPrettyPrint (TraceMinimum Int
x) = ByteString
"Minimum length of " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString
bsInt Int
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"."

validTraceLength :: TraceLength -> Bool
validTraceLength :: TraceLength -> Bool
validTraceLength (TraceMinimum Int
n) = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
validTraceLength TraceLength
_ = Bool
True

-- | Execution mode.
data ExecutionMode
  = -- | Perform new run.
    --
    -- Call 'error' if an output files exists.
    Fail
  | -- | Perform new run.
    --
    -- Overwrite existing output files.
    Overwrite
  | -- | Continue a previous run and append to output files.
    --
    -- Call 'error' if an output file does not exist.
    Continue
  deriving (ExecutionMode -> ExecutionMode -> Bool
(ExecutionMode -> ExecutionMode -> Bool)
-> (ExecutionMode -> ExecutionMode -> Bool) -> Eq ExecutionMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecutionMode -> ExecutionMode -> Bool
$c/= :: ExecutionMode -> ExecutionMode -> Bool
== :: ExecutionMode -> ExecutionMode -> Bool
$c== :: ExecutionMode -> ExecutionMode -> Bool
Eq, ReadPrec [ExecutionMode]
ReadPrec ExecutionMode
Int -> ReadS ExecutionMode
ReadS [ExecutionMode]
(Int -> ReadS ExecutionMode)
-> ReadS [ExecutionMode]
-> ReadPrec ExecutionMode
-> ReadPrec [ExecutionMode]
-> Read ExecutionMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExecutionMode]
$creadListPrec :: ReadPrec [ExecutionMode]
readPrec :: ReadPrec ExecutionMode
$creadPrec :: ReadPrec ExecutionMode
readList :: ReadS [ExecutionMode]
$creadList :: ReadS [ExecutionMode]
readsPrec :: Int -> ReadS ExecutionMode
$creadsPrec :: Int -> ReadS ExecutionMode
Read, Int -> ExecutionMode -> ShowS
[ExecutionMode] -> ShowS
ExecutionMode -> String
(Int -> ExecutionMode -> ShowS)
-> (ExecutionMode -> String)
-> ([ExecutionMode] -> ShowS)
-> Show ExecutionMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecutionMode] -> ShowS
$cshowList :: [ExecutionMode] -> ShowS
show :: ExecutionMode -> String
$cshow :: ExecutionMode -> String
showsPrec :: Int -> ExecutionMode -> ShowS
$cshowsPrec :: Int -> ExecutionMode -> ShowS
Show)

$(deriveJSON defaultOptions ''ExecutionMode)

-- | Types with execution modes.
class HasExecutionMode s where
  getExecutionMode :: s -> ExecutionMode

executionModePrettyPrint :: ExecutionMode -> BL.ByteString
executionModePrettyPrint :: ExecutionMode -> ByteString
executionModePrettyPrint ExecutionMode
Fail = ByteString
"Fail if output files exist."
executionModePrettyPrint ExecutionMode
Overwrite = ByteString
"Overwrite existing output files."
executionModePrettyPrint ExecutionMode
Continue = ByteString
"Expect output files exist."

-- | Open a file honoring the execution mode.
--
-- Call 'error' if execution mode is
--
-- - 'Continue' and file does not exist.
--
-- - 'Fail' and file exists.
openWithExecutionMode :: ExecutionMode -> FilePath -> IO Handle
openWithExecutionMode :: ExecutionMode -> String -> IO Handle
openWithExecutionMode ExecutionMode
em String
fn = do
  Bool
fe <- String -> IO Bool
doesFileExist String
fn
  case (ExecutionMode
em, Bool
fe) of
    (ExecutionMode
Continue, Bool
False) ->
      String -> IO Handle
forall a. HasCallStack => String -> a
error (String -> IO Handle) -> String -> IO Handle
forall a b. (a -> b) -> a -> b
$ String
"openWithExecutionMode: Cannot continue; file does not exist: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
    (ExecutionMode
Continue, Bool
True) ->
      String -> IOMode -> IO Handle
openFile String
fn IOMode
AppendMode
    (ExecutionMode
Fail, Bool
True) ->
      String -> IO Handle
forall a. HasCallStack => String -> a
error (String -> IO Handle) -> String -> IO Handle
forall a b. (a -> b) -> a -> b
$ String
"openWithExecutionMode: File exists: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"; use 'Overwrite'?"
    (ExecutionMode, Bool)
_ -> do
      Handle
h <- String -> IOMode -> IO Handle
openFile String
fn IOMode
WriteMode
      Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
LineBuffering
      Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
h

-- One could automatically select 'Parallel' or 'Sequential' according to the
-- number of capabilities when initializing the environment or according to the
-- iteration time in dependence of the number of used capabilities. However, I
-- decided to opt for a manual configuration, because more capabilities may be
-- available and other parts of the program may be executed in parallel even if
-- sequential execution of the MCMC sampler is beneficial.

-- | Parallelization mode.
--
-- Parallel execution of the chains is only beneficial when the algorithm allows
-- for parallelization, and if computation of the next iteration takes some
-- time. If the calculation of the next state is fast, sequential execution is
-- usually beneficial, even for algorithms involving parallel chains.
--
-- - The "Mcmc.Algorithm.MHG" algorithm is inherently sequential.
--
-- - The "Mcmc.Algorithm.MC3" algorithm works well with parallelization.
--
-- Of course, also the prior or likelihood functions can be computed in
-- parallel. However, this library is unaware about how these functions are
-- computed.
data ParallelizationMode
  = Sequential
  | Parallel
  deriving (ParallelizationMode -> ParallelizationMode -> Bool
(ParallelizationMode -> ParallelizationMode -> Bool)
-> (ParallelizationMode -> ParallelizationMode -> Bool)
-> Eq ParallelizationMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParallelizationMode -> ParallelizationMode -> Bool
$c/= :: ParallelizationMode -> ParallelizationMode -> Bool
== :: ParallelizationMode -> ParallelizationMode -> Bool
$c== :: ParallelizationMode -> ParallelizationMode -> Bool
Eq, ReadPrec [ParallelizationMode]
ReadPrec ParallelizationMode
Int -> ReadS ParallelizationMode
ReadS [ParallelizationMode]
(Int -> ReadS ParallelizationMode)
-> ReadS [ParallelizationMode]
-> ReadPrec ParallelizationMode
-> ReadPrec [ParallelizationMode]
-> Read ParallelizationMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ParallelizationMode]
$creadListPrec :: ReadPrec [ParallelizationMode]
readPrec :: ReadPrec ParallelizationMode
$creadPrec :: ReadPrec ParallelizationMode
readList :: ReadS [ParallelizationMode]
$creadList :: ReadS [ParallelizationMode]
readsPrec :: Int -> ReadS ParallelizationMode
$creadsPrec :: Int -> ReadS ParallelizationMode
Read, Int -> ParallelizationMode -> ShowS
[ParallelizationMode] -> ShowS
ParallelizationMode -> String
(Int -> ParallelizationMode -> ShowS)
-> (ParallelizationMode -> String)
-> ([ParallelizationMode] -> ShowS)
-> Show ParallelizationMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParallelizationMode] -> ShowS
$cshowList :: [ParallelizationMode] -> ShowS
show :: ParallelizationMode -> String
$cshow :: ParallelizationMode -> String
showsPrec :: Int -> ParallelizationMode -> ShowS
$cshowsPrec :: Int -> ParallelizationMode -> ShowS
Show)

$(deriveJSON defaultOptions ''ParallelizationMode)

-- | Define information stored on disk.
data SaveMode
  = -- | Do not save the MCMC analysis. The analysis can not be continued.
    NoSave
  | -- | Save the MCMC analysis so that it can be continued. This can be slow,
    -- if the trace is long, or if the states are large objects. See
    -- 'TraceLength'.
    Save
  deriving (SaveMode -> SaveMode -> Bool
(SaveMode -> SaveMode -> Bool)
-> (SaveMode -> SaveMode -> Bool) -> Eq SaveMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SaveMode -> SaveMode -> Bool
$c/= :: SaveMode -> SaveMode -> Bool
== :: SaveMode -> SaveMode -> Bool
$c== :: SaveMode -> SaveMode -> Bool
Eq, ReadPrec [SaveMode]
ReadPrec SaveMode
Int -> ReadS SaveMode
ReadS [SaveMode]
(Int -> ReadS SaveMode)
-> ReadS [SaveMode]
-> ReadPrec SaveMode
-> ReadPrec [SaveMode]
-> Read SaveMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SaveMode]
$creadListPrec :: ReadPrec [SaveMode]
readPrec :: ReadPrec SaveMode
$creadPrec :: ReadPrec SaveMode
readList :: ReadS [SaveMode]
$creadList :: ReadS [SaveMode]
readsPrec :: Int -> ReadS SaveMode
$creadsPrec :: Int -> ReadS SaveMode
Read, Int -> SaveMode -> ShowS
[SaveMode] -> ShowS
SaveMode -> String
(Int -> SaveMode -> ShowS)
-> (SaveMode -> String) -> ([SaveMode] -> ShowS) -> Show SaveMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SaveMode] -> ShowS
$cshowList :: [SaveMode] -> ShowS
show :: SaveMode -> String
$cshow :: SaveMode -> String
showsPrec :: Int -> SaveMode -> ShowS
$cshowsPrec :: Int -> SaveMode -> ShowS
Show)

$(deriveJSON defaultOptions ''SaveMode)

saveModePrettyPrint :: SaveMode -> BL.ByteString
saveModePrettyPrint :: SaveMode -> ByteString
saveModePrettyPrint SaveMode
NoSave = ByteString
"Do not save analysis."
saveModePrettyPrint SaveMode
Save = ByteString
"Save analysis."

-- | Settings of an MCMC sampler.
data Settings = Settings
  { Settings -> AnalysisName
sAnalysisName :: AnalysisName,
    Settings -> BurnInSettings
sBurnIn :: BurnInSettings,
    Settings -> Iterations
sIterations :: Iterations,
    Settings -> TraceLength
sTraceLength :: TraceLength,
    Settings -> ExecutionMode
sExecutionMode :: ExecutionMode,
    Settings -> ParallelizationMode
sParallelizationMode :: ParallelizationMode,
    Settings -> SaveMode
sSaveMode :: SaveMode,
    Settings -> LogMode
sLogMode :: LogMode,
    Settings -> Verbosity
sVerbosity :: Verbosity
  }
  deriving (Settings -> Settings -> Bool
(Settings -> Settings -> Bool)
-> (Settings -> Settings -> Bool) -> Eq Settings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Settings -> Settings -> Bool
$c/= :: Settings -> Settings -> Bool
== :: Settings -> Settings -> Bool
$c== :: Settings -> Settings -> Bool
Eq, Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
(Int -> Settings -> ShowS)
-> (Settings -> String) -> ([Settings] -> ShowS) -> Show Settings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Settings] -> ShowS
$cshowList :: [Settings] -> ShowS
show :: Settings -> String
$cshow :: Settings -> String
showsPrec :: Int -> Settings -> ShowS
$cshowsPrec :: Int -> Settings -> ShowS
Show)

instance HasAnalysisName Settings where
  getAnalysisName :: Settings -> AnalysisName
getAnalysisName = Settings -> AnalysisName
sAnalysisName

instance HasExecutionMode Settings where
  getExecutionMode :: Settings -> ExecutionMode
getExecutionMode = Settings -> ExecutionMode
sExecutionMode

instance HasLogMode Settings where
  getLogMode :: Settings -> LogMode
getLogMode = Settings -> LogMode
sLogMode

instance HasVerbosity Settings where
  getVerbosity :: Settings -> Verbosity
getVerbosity = Settings -> Verbosity
sVerbosity

$(deriveJSON defaultOptions ''Settings)

settingsFn :: String -> FilePath
settingsFn :: ShowS
settingsFn String
n = String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".mcmc.settings"

-- | Save settings to a file determined by the analysis name.
settingsSave :: Settings -> IO ()
settingsSave :: Settings -> IO ()
settingsSave Settings
s = String -> ByteString -> IO ()
BL.writeFile String
fn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Settings -> ByteString
forall a. ToJSON a => a -> ByteString
encode Settings
s
  where
    fn :: String
fn = ShowS
settingsFn ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ AnalysisName -> String
fromAnalysisName (AnalysisName -> String) -> AnalysisName -> String
forall a b. (a -> b) -> a -> b
$ Settings -> AnalysisName
sAnalysisName Settings
s

-- | Load settings.
settingsLoad :: AnalysisName -> IO Settings
settingsLoad :: AnalysisName -> IO Settings
settingsLoad (AnalysisName String
n) = (String -> Settings)
-> (Settings -> Settings) -> Either String Settings -> Settings
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Settings
forall a. HasCallStack => String -> a
error Settings -> Settings
forall a. a -> a
id (Either String Settings -> Settings)
-> (ByteString -> Either String Settings) -> ByteString -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Settings
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Settings) -> IO ByteString -> IO Settings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BL.readFile String
fn
  where
    fn :: String
fn = ShowS
settingsFn String
n

-- Show settings and call 'error'.
settingsError :: Settings -> Int -> String -> a
settingsError :: Settings -> Int -> String -> a
settingsError Settings
s Int
i String
err =
  String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
    Settings -> String
forall a. Show a => a -> String
show Settings
s
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Current iteration: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"settingsError: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err

-- | Check settings.
--
-- Call 'error' if:
--
-- - The analysis name is the empty string.
--
-- - The number of burn in iterations is negative.
--
-- - Auto tuning period is zero or negative.
--
-- - The number of iterations is negative.
--
-- - The current iteration is larger than the total number of iterations.
--
-- - The current iteration is non-zero but the execution mode is not 'Continue'.
--
-- - The current iteration is zero but the execution mode is 'Continue'.
settingsCheck ::
  Settings ->
  -- | Current iteration.
  Int ->
  IO ()
settingsCheck :: Settings -> Int -> IO ()
settingsCheck s :: Settings
s@(Settings AnalysisName
nm BurnInSettings
bi Iterations
i TraceLength
tl ExecutionMode
em ParallelizationMode
_ SaveMode
_ LogMode
_ Verbosity
_) Int
iCurrent
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (AnalysisName -> String
fromAnalysisName AnalysisName
nm) = String -> IO ()
forall a. String -> a
serr String
"Analysis name is the empty string."
  | BurnInSettings -> Int
burnInIterations BurnInSettings
bi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> IO ()
forall a. String -> a
serr String
"Number of burn in iterations is negative."
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ BurnInSettings -> Bool
burnInValid BurnInSettings
bi = String -> IO ()
forall a. String -> a
serr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Burn in setting invalid: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> BurnInSettings -> String
forall a. Show a => a -> String
show BurnInSettings
bi String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
  | Iterations -> Int
fromIterations Iterations
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> IO ()
forall a. String -> a
serr String
"Number of iterations is negative."
  | BurnInSettings -> Int
burnInIterations BurnInSettings
bi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Iterations -> Int
fromIterations Iterations
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
iCurrent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
      String -> IO ()
forall a. String -> a
serr String
"Current iteration is larger than the total number of iterations."
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TraceLength -> Bool
validTraceLength TraceLength
tl = String -> IO ()
forall a. String -> a
serr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Trace length invalid: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TraceLength -> String
forall a. Show a => a -> String
show TraceLength
tl String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
  | Int
iCurrent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
&& ExecutionMode
em ExecutionMode -> ExecutionMode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExecutionMode
Continue =
      String -> IO ()
forall a. String -> a
serr String
"Current iteration is non-zero but execution mode is not 'Continue'."
  | Int
iCurrent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& ExecutionMode
em ExecutionMode -> ExecutionMode -> Bool
forall a. Eq a => a -> a -> Bool
== ExecutionMode
Continue =
      String -> IO ()
forall a. String -> a
serr String
"Current iteration is zero but execution mode is 'Continue'."
  | Bool
otherwise = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    serr :: String -> a
serr = Settings -> Int -> String -> a
forall a. Settings -> Int -> String -> a
settingsError Settings
s Int
iCurrent

logModePrettyPrint :: LogMode -> BL.ByteString
logModePrettyPrint :: LogMode -> ByteString
logModePrettyPrint LogMode
LogStdOutAndFile = ByteString
"Log to standard output and file."
logModePrettyPrint LogMode
LogStdOutOnly = ByteString
"Log to standard output only."
logModePrettyPrint LogMode
LogFileOnly = ByteString
"Log to file only."

-- | Pretty print settings.
settingsPrettyPrint :: Settings -> BL.ByteString
settingsPrettyPrint :: Settings -> ByteString
settingsPrettyPrint (Settings AnalysisName
nm BurnInSettings
bi Iterations
is TraceLength
tl ExecutionMode
em ParallelizationMode
pm SaveMode
sm LogMode
lm Verbosity
vb) =
  [ByteString] -> ByteString
BL.unlines
    [ ByteString
"The MCMC settings are:",
      ByteString
"  Analysis name:        " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BL.pack (AnalysisName -> String
fromAnalysisName AnalysisName
nm) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".",
      ByteString
"  Burn in:              " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> BurnInSettings -> ByteString
burnInPrettyPrint BurnInSettings
bi,
      ByteString
"  Iterations:           " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString
bsInt (Iterations -> Int
fromIterations Iterations
is) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" iterations.",
      ByteString
"  Trace length:         " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> TraceLength -> ByteString
traceLengthPrettyPrint TraceLength
tl,
      ByteString
"  Execution mode:       " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ExecutionMode -> ByteString
executionModePrettyPrint ExecutionMode
em,
      ByteString
"  Parallelization mode: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BL.pack (ParallelizationMode -> String
forall a. Show a => a -> String
show ParallelizationMode
pm) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".",
      ByteString
"  Save mode:            " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SaveMode -> ByteString
saveModePrettyPrint SaveMode
sm,
      ByteString
"  Log mode:             " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> LogMode -> ByteString
logModePrettyPrint LogMode
lm,
      ByteString
"  Verbosity:            " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BL.pack (Verbosity -> String
forall a. Show a => a -> String
show Verbosity
vb) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"."
    ]