{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Mcmc.Mcmc
-- Description :  Framework for running 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: Fri May 29 10:19:45 2020.
--
-- This module provides the general framework for running MCMC samplers. By
-- design choice this module is agnostic about the details of the used
-- 'Algorithm'.
module Mcmc.Mcmc
  ( mcmc,
    mcmcContinue,
  )
where

import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Data.Functor
import Mcmc.Acceptance (ResetAcceptance (ResetEverything, ResetExpectedRatesOnly))
import Mcmc.Algorithm
import Mcmc.Cycle
import Mcmc.Environment
import Mcmc.Logger
import Mcmc.Proposal
import Mcmc.Settings
import System.IO
import Prelude hiding (cycle)

-- The MCMC algorithm has read access to an environment and uses an algorithm
-- transforming the state @a@.
type MCMC = ReaderT (Environment Settings) IO

mcmcExecute :: (Algorithm a) => a -> MCMC a
mcmcExecute :: forall a. Algorithm a => a -> MCMC a
mcmcExecute a
a = do
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Executing MCMC run."
  Settings
s <- (Environment Settings -> Settings)
-> ReaderT (Environment Settings) IO Settings
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader Environment Settings -> Settings
forall s. Environment s -> s
settings
  a
a' <- case Settings -> ExecutionMode
sExecutionMode Settings
s of
    ExecutionMode
Fail -> a -> MCMC a
forall a. Algorithm a => a -> MCMC a
mcmcNewRun a
a
    ExecutionMode
Overwrite -> a -> MCMC a
forall a. Algorithm a => a -> MCMC a
mcmcNewRun a
a
    ExecutionMode
Continue -> a -> MCMC a
forall a. Algorithm a => a -> MCMC a
mcmcContinueRun a
a
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Executed MCMC run."
  a -> MCMC a
forall a. a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a'

mcmcResetAcceptance :: (Algorithm a) => a -> MCMC a
mcmcResetAcceptance :: forall a. Algorithm a => a -> MCMC a
mcmcResetAcceptance a
a = do
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Reset acceptance rates."
  a -> MCMC a
forall a. a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> MCMC a) -> a -> MCMC a
forall a b. (a -> b) -> a -> b
$ ResetAcceptance -> a -> a
forall a. Algorithm a => ResetAcceptance -> a -> a
aResetAcceptance ResetAcceptance
ResetEverything a
a

mcmcExceptionHandler :: (Algorithm a) => Environment Settings -> a -> AsyncException -> IO b
mcmcExceptionHandler :: forall a b.
Algorithm a =>
Environment Settings -> a -> AsyncException -> IO b
mcmcExceptionHandler Environment Settings
e a
a AsyncException
err = do
  a
_ <- ReaderT (Environment Settings) IO a -> Environment Settings -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Environment Settings) IO a
action Environment Settings
e
  String -> IO ()
putStrLn String
"Graceful termination successful."
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Rethrowing error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> AsyncException -> String
forall e. Exception e => e -> String
displayException AsyncException
err String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"."
  AsyncException -> IO b
forall e a. Exception e => e -> IO a
throwIO AsyncException
err
  where
    action :: ReaderT (Environment Settings) IO a
action = do
      String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logWarnS String
"INTERRUPT!"
      String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logWarnS String
"Trying to terminate gracefully and to save chain for continuation."
      String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logWarnS String
"Press CTRL-C (again) to terminate now."
      a -> ReaderT (Environment Settings) IO a
forall a. Algorithm a => a -> MCMC a
mcmcClose a
a

mcmcExecuteMonitors :: (Algorithm a) => a -> MCMC ()
mcmcExecuteMonitors :: forall a. Algorithm a => a -> Logger (Environment Settings) ()
mcmcExecuteMonitors a
a = do
  Environment Settings
e <- ReaderT (Environment Settings) IO (Environment Settings)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let s :: Settings
s = Environment Settings -> Settings
forall s. Environment s -> s
settings Environment Settings
e
      vb :: Verbosity
vb = Settings -> Verbosity
sVerbosity Settings
s
      t0 :: UTCTime
t0 = Environment Settings -> UTCTime
forall s. Environment s -> UTCTime
startingTime Environment Settings
e
      iTotal :: Int
iTotal = BurnInSettings -> Int
burnInIterations (Settings -> BurnInSettings
sBurnIn Settings
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Iterations -> Int
fromIterations (Settings -> Iterations
sIterations Settings
s)
  Maybe ByteString
mStdLog <- IO (Maybe ByteString)
-> ReaderT (Environment Settings) IO (Maybe ByteString)
forall a. IO a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString)
 -> ReaderT (Environment Settings) IO (Maybe ByteString))
-> IO (Maybe ByteString)
-> ReaderT (Environment Settings) IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Verbosity -> UTCTime -> Int -> a -> IO (Maybe ByteString)
forall a.
Algorithm a =>
Verbosity -> UTCTime -> Int -> a -> IO (Maybe ByteString)
aExecuteMonitors Verbosity
vb UTCTime
t0 Int
iTotal a
a
  Maybe ByteString
-> (ByteString -> Logger (Environment Settings) ())
-> Logger (Environment Settings) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ByteString
mStdLog (ByteString -> ByteString -> Logger (Environment Settings) ()
forall e.
(HasLogHandles e, HasLock e) =>
ByteString -> ByteString -> Logger e ()
logOutB ByteString
"   ")

-- When intermediate tuning is activated, specific proposals get tuned every
-- iterations.
data IntermediateTuningSpec
  = IntermediateTuningFastProposalsOnlyOn
  | IntermediateTuningAllProposalsOn
  | IntermediateTuningOff
  deriving (IntermediateTuningSpec -> IntermediateTuningSpec -> Bool
(IntermediateTuningSpec -> IntermediateTuningSpec -> Bool)
-> (IntermediateTuningSpec -> IntermediateTuningSpec -> Bool)
-> Eq IntermediateTuningSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntermediateTuningSpec -> IntermediateTuningSpec -> Bool
== :: IntermediateTuningSpec -> IntermediateTuningSpec -> Bool
$c/= :: IntermediateTuningSpec -> IntermediateTuningSpec -> Bool
/= :: IntermediateTuningSpec -> IntermediateTuningSpec -> Bool
Eq)

mcmcIterate :: (Algorithm a) => IntermediateTuningSpec -> IterationMode -> Int -> a -> MCMC a
mcmcIterate :: forall a.
Algorithm a =>
IntermediateTuningSpec -> IterationMode -> Int -> a -> MCMC a
mcmcIterate IntermediateTuningSpec
t IterationMode
m Int
n a
a = case Int
n Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
0 of
  Ordering
LT -> String -> MCMC a
forall a. HasCallStack => String -> a
error String
"mcmcIterate: Number of iterations is negative."
  Ordering
EQ -> a -> MCMC a
forall a. a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  Ordering
GT -> do
    Environment Settings
e <- ReaderT (Environment Settings) IO (Environment Settings)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    let p :: ParallelizationMode
p = Settings -> ParallelizationMode
sParallelizationMode (Settings -> ParallelizationMode)
-> Settings -> ParallelizationMode
forall a b. (a -> b) -> a -> b
$ Environment Settings -> Settings
forall s. Environment s -> s
settings Environment Settings
e
    -- NOTE: Handle interrupts during iterations, before writing monitors,
    -- using the old algorithm state @a@.
    let handlerOld :: AsyncException -> IO b
handlerOld = Environment Settings -> a -> AsyncException -> IO b
forall a b.
Algorithm a =>
Environment Settings -> a -> AsyncException -> IO b
mcmcExceptionHandler Environment Settings
e a
a
        maybeIntermediateAutoTune :: a -> IO a
maybeIntermediateAutoTune a
x =
          -- Do not perform intermediate tuning at the last step, because a
          -- normal tuning will be performed.
          case IntermediateTuningSpec
t of
            IntermediateTuningSpec
IntermediateTuningFastProposalsOnlyOn
              | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 ->
                  TuningType -> Int -> a -> IO a
forall a. Algorithm a => TuningType -> Int -> a -> IO a
aAutoTune TuningType
IntermediateTuningFastProposalsOnly Int
1 a
x
                    IO a -> (a -> a) -> IO a
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ResetAcceptance -> a -> a
forall a. Algorithm a => ResetAcceptance -> a -> a
aResetAcceptance ResetAcceptance
ResetExpectedRatesOnly
            IntermediateTuningSpec
IntermediateTuningAllProposalsOn
              | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 ->
                  TuningType -> Int -> a -> IO a
forall a. Algorithm a => TuningType -> Int -> a -> IO a
aAutoTune TuningType
IntermediateTuningAllProposals Int
1 a
x
                    IO a -> (a -> a) -> IO a
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ResetAcceptance -> a -> a
forall a. Algorithm a => ResetAcceptance -> a -> a
aResetAcceptance ResetAcceptance
ResetExpectedRatesOnly
            IntermediateTuningSpec
_otherTuningSpecs -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
        actionIterate :: IO a
actionIterate = IterationMode -> ParallelizationMode -> a -> IO a
forall a.
Algorithm a =>
IterationMode -> ParallelizationMode -> a -> IO a
aIterate IterationMode
m ParallelizationMode
p a
a IO a -> (a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
forall {a}. Algorithm a => a -> IO a
maybeIntermediateAutoTune
    a
a' <- IO a -> MCMC a
forall a. IO a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> MCMC a) -> IO a -> MCMC a
forall a b. (a -> b) -> a -> b
$ IO a
actionIterate IO a -> (AsyncException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` AsyncException -> IO a
forall {b}. AsyncException -> IO b
handlerOld
    -- NOTE: Mask asynchronous exceptions while writing monitor files. Handle
    -- interrupts after writing monitors; use the new state @a'@.
    --
    -- The problem that arises using this method is: What if executing the
    -- monitors actually throws an error (and not the user or the operating
    -- system that want to stop the chain). In this case, the chain is left in
    -- an undefined state because the monitor files are partly written; the
    -- new state is saved by the handler. However, I do not think I can
    -- recover from partly written monitor files.
    let handlerNew :: AsyncException -> IO b
handlerNew = Environment Settings -> a -> AsyncException -> IO b
forall a b.
Algorithm a =>
Environment Settings -> a -> AsyncException -> IO b
mcmcExceptionHandler Environment Settings
e a
a'
        actionWrite :: IO ()
actionWrite = Logger (Environment Settings) () -> Environment Settings -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> Logger (Environment Settings) ()
forall a. Algorithm a => a -> Logger (Environment Settings) ()
mcmcExecuteMonitors a
a') Environment Settings
e
    IO () -> Logger (Environment Settings) ()
forall a. IO a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Logger (Environment Settings) ())
-> IO () -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall a. IO a -> IO a
uninterruptibleMask_ IO ()
actionWrite IO () -> (AsyncException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` AsyncException -> IO ()
forall {b}. AsyncException -> IO b
handlerNew
    IntermediateTuningSpec -> IterationMode -> Int -> a -> MCMC a
forall a.
Algorithm a =>
IntermediateTuningSpec -> IterationMode -> Int -> a -> MCMC a
mcmcIterate IntermediateTuningSpec
t IterationMode
m (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
a'

mcmcNewRun :: (Algorithm a) => a -> MCMC a
mcmcNewRun :: forall a. Algorithm a => a -> MCMC a
mcmcNewRun a
a = do
  Settings
s <- (Environment Settings -> Settings)
-> ReaderT (Environment Settings) IO Settings
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader Environment Settings -> Settings
forall s. Environment s -> s
settings
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Starting new MCMC sampler."
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Initial state."
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a
  a -> Logger (Environment Settings) ()
forall a. Algorithm a => a -> Logger (Environment Settings) ()
mcmcExecuteMonitors a
a
  Bool
-> Logger (Environment Settings) ()
-> Logger (Environment Settings) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
forall a. Algorithm a => a -> Bool
aIsInvalidState a
a) (ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logWarnB ByteString
"The initial state is invalid!")
  a
a' <- a -> MCMC a
forall a. Algorithm a => a -> MCMC a
mcmcBurnIn a
a
  String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS String
"Cleaning chain after burn in."
  let tl :: TraceLength
tl = Settings -> TraceLength
sTraceLength Settings
s
  a
a'' <- IO a -> MCMC a
forall a. IO a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> MCMC a) -> IO a -> MCMC a
forall a b. (a -> b) -> a -> b
$ TraceLength -> a -> IO a
forall a. Algorithm a => TraceLength -> a -> IO a
aCleanAfterBurnIn TraceLength
tl a
a'
  String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS String
"Saving chain after burn in."
  a -> Logger (Environment Settings) ()
forall a. Algorithm a => a -> Logger (Environment Settings) ()
mcmcSave a
a''
  let i :: Int
i = Iterations -> Int
fromIterations (Iterations -> Int) -> Iterations -> Int
forall a b. (a -> b) -> a -> b
$ Settings -> Iterations
sIterations Settings
s
  String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ String
"Running chain for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" iterations."
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a''
  IntermediateTuningSpec -> IterationMode -> Int -> a -> MCMC a
forall a.
Algorithm a =>
IntermediateTuningSpec -> IterationMode -> Int -> a -> MCMC a
mcmcIterate IntermediateTuningSpec
IntermediateTuningOff IterationMode
AllProposals Int
i a
a''

mcmcContinueRun :: (Algorithm a) => a -> MCMC a
mcmcContinueRun :: forall a. Algorithm a => a -> MCMC a
mcmcContinueRun a
a = do
  Settings
s <- (Environment Settings -> Settings)
-> ReaderT (Environment Settings) IO Settings
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader Environment Settings -> Settings
forall s. Environment s -> s
settings
  let iBurnIn :: Int
iBurnIn = BurnInSettings -> Int
burnInIterations (Settings -> BurnInSettings
sBurnIn Settings
s)
      iNormal :: Int
iNormal = Iterations -> Int
fromIterations (Settings -> Iterations
sIterations Settings
s)
      iTotal :: Int
iTotal = Int
iBurnIn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
iNormal
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Continuation of MCMC sampler."
  let iCurrent :: Int
iCurrent = a -> Int
forall a. Algorithm a => a -> Int
aIteration a
a
  String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ String
"Burn in iterations: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
iBurnIn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
  String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ String
"Normal iterations: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
iNormal String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
  String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ String
"Total iterations: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
iTotal String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
  String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ String
"Current iteration: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
iCurrent String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
  Bool
-> Logger (Environment Settings) ()
-> Logger (Environment Settings) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
iCurrent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
iBurnIn) (Logger (Environment Settings) ()
 -> Logger (Environment Settings) ())
-> Logger (Environment Settings) ()
-> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ String -> Logger (Environment Settings) ()
forall a. HasCallStack => String -> a
error String
"mcmcContinueRun: Can not continue burn in."
  let di :: Int
di = Int
iTotal Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
iCurrent
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ IterationMode -> a -> ByteString
forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
AllProposals a
a
  String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ String
"Running chain for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
di String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" iterations."
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a
  IntermediateTuningSpec -> IterationMode -> Int -> a -> MCMC a
forall a.
Algorithm a =>
IntermediateTuningSpec -> IterationMode -> Int -> a -> MCMC a
mcmcIterate IntermediateTuningSpec
IntermediateTuningOff IterationMode
AllProposals Int
di a
a

mcmcBurnIn :: (Algorithm a) => a -> MCMC a
mcmcBurnIn :: forall a. Algorithm a => a -> MCMC a
mcmcBurnIn a
a = do
  Settings
s <- (Environment Settings -> Settings)
-> ReaderT (Environment Settings) IO Settings
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader Environment Settings -> Settings
forall s. Environment s -> s
settings
  case Settings -> BurnInSettings
sBurnIn Settings
s of
    BurnInSettings
NoBurnIn -> do
      ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ IterationMode -> a -> ByteString
forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
AllProposals a
a
      String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS String
"No burn in."
      a -> MCMC a
forall a. a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    BurnInWithoutAutoTuning Int
n -> do
      ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ IterationMode -> a -> ByteString
forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
AllProposals a
a
      String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ String
"Burning in for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" iterations."
      String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS String
"Auto tuning is disabled."
      ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a
      a
a' <- IntermediateTuningSpec -> IterationMode -> Int -> a -> MCMC a
forall a.
Algorithm a =>
IntermediateTuningSpec -> IterationMode -> Int -> a -> MCMC a
mcmcIterate IntermediateTuningSpec
IntermediateTuningOff IterationMode
AllProposals Int
n a
a
      ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ IterationMode -> a -> ByteString
forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
AllProposals a
a'
      a
a'' <- a -> MCMC a
forall a. Algorithm a => a -> MCMC a
mcmcResetAcceptance a
a'
      ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Burn in finished."
      a -> MCMC a
forall a. a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a''
    BurnInWithAutoTuning Int
n Int
t -> do
      ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ IterationMode -> a -> ByteString
forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
AllProposals a
a
      String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ String
"Burning in for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" iterations."
      String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ String
"Auto tuning is enabled with a period of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
      ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a
      let (Int
m, Int
r) = Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
t
          -- Don't add another auto tune period if r == 0, because then we auto
          -- tune without acceptance counts and get NaNs.
          xs :: [Int]
xs = Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
m Int
t [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [Int
r | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
      a
a' <- IterationMode -> [Int] -> a -> MCMC a
forall a. Algorithm a => IterationMode -> [Int] -> a -> MCMC a
mcmcBurnInWithAutoTuning IterationMode
AllProposals [Int]
xs a
a
      ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Burn in finished."
      a -> MCMC a
forall a. a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a'
    BurnInWithCustomAutoTuning [Int]
xs [Int]
ys -> do
      String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ String
"Burning in for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Int] -> Int
forall a. Num a => [a] -> a
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 a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ys) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" iterations."
      a
a' <-
        if [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
xs
          then do
            ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ IterationMode -> a -> ByteString
forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
AllProposals a
a
            a -> MCMC a
forall a. a -> ReaderT (Environment Settings) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
          else do
            ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ IterationMode -> a -> ByteString
forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
FastProposals a
a
            String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ String
"Fast custom auto tuning with periods " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int]
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
            ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a
            IterationMode -> [Int] -> a -> MCMC a
forall a. Algorithm a => IterationMode -> [Int] -> a -> MCMC a
mcmcBurnInWithAutoTuning IterationMode
FastProposals [Int]
xs a
a
      String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ String
"Full custom auto tuning with periods " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int]
ys String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
      ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a
      a
a'' <- IterationMode -> [Int] -> a -> MCMC a
forall a. Algorithm a => IterationMode -> [Int] -> a -> MCMC a
mcmcBurnInWithAutoTuning IterationMode
AllProposals [Int]
ys a
a'
      ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Burn in finished."
      a -> MCMC a
forall a. a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a''

-- Auto tune the proposals.
mcmcAutotune :: (Algorithm a) => TuningType -> Int -> a -> MCMC a
mcmcAutotune :: forall a. Algorithm a => TuningType -> Int -> a -> MCMC a
mcmcAutotune TuningType
t Int
n a
a = do
  case TuningType
t of
    TuningType
NormalTuningFastProposalsOnly -> ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Normal auto tune; fast proposals only."
    TuningType
IntermediateTuningFastProposalsOnly -> () -> Logger (Environment Settings) ()
forall a. a -> ReaderT (Environment Settings) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    TuningType
LastTuningFastProposalsOnly -> ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Last auto tune; fast proposals only."
    TuningType
NormalTuningAllProposals -> ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Normal auto tune; all proposals."
    TuningType
IntermediateTuningAllProposals -> () -> Logger (Environment Settings) ()
forall a. a -> ReaderT (Environment Settings) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    TuningType
LastTuningAllProposals -> ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Last auto tune; all proposals."
  IO a -> MCMC a
forall a. IO a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> MCMC a) -> IO a -> MCMC a
forall a b. (a -> b) -> a -> b
$ TuningType -> Int -> a -> IO a
forall a. Algorithm a => TuningType -> Int -> a -> IO a
aAutoTune TuningType
t Int
n a
a

mcmcBurnInWithAutoTuning :: (Algorithm a) => IterationMode -> [Int] -> a -> MCMC a
mcmcBurnInWithAutoTuning :: forall a. Algorithm a => IterationMode -> [Int] -> a -> MCMC a
mcmcBurnInWithAutoTuning IterationMode
_ [] a
_ = String -> MCMC a
forall a. HasCallStack => String -> a
error String
"mcmcBurnInWithAutoTuning: Empty list."
mcmcBurnInWithAutoTuning IterationMode
m [Int
x] a
a = do
  -- Last round.
  let (IntermediateTuningSpec
tti, TuningType
ttl) = case IterationMode
m of
        IterationMode
FastProposals -> (IntermediateTuningSpec
IntermediateTuningFastProposalsOnlyOn, TuningType
LastTuningFastProposalsOnly)
        IterationMode
AllProposals -> (IntermediateTuningSpec
IntermediateTuningAllProposalsOn, TuningType
LastTuningAllProposals)
  a
a' <- IntermediateTuningSpec -> IterationMode -> Int -> a -> MCMC a
forall a.
Algorithm a =>
IntermediateTuningSpec -> IterationMode -> Int -> a -> MCMC a
mcmcIterate IntermediateTuningSpec
tti IterationMode
m Int
x a
a
  a
a'' <- TuningType -> Int -> a -> MCMC a
forall a. Algorithm a => TuningType -> Int -> a -> MCMC a
mcmcAutotune TuningType
ttl Int
x a
a'
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ IterationMode -> a -> ByteString
forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
m a
a''
  String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ String
"Acceptance rates calculated over the last " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" iterations."
  a -> MCMC a
forall a. Algorithm a => a -> MCMC a
mcmcResetAcceptance a
a''
mcmcBurnInWithAutoTuning IterationMode
m (Int
x : [Int]
xs) a
a = do
  let (IntermediateTuningSpec
tti, TuningType
ttn) = case IterationMode
m of
        IterationMode
FastProposals -> (IntermediateTuningSpec
IntermediateTuningFastProposalsOnlyOn, TuningType
NormalTuningFastProposalsOnly)
        IterationMode
AllProposals -> (IntermediateTuningSpec
IntermediateTuningAllProposalsOn, TuningType
NormalTuningAllProposals)
  a
a' <- IntermediateTuningSpec -> IterationMode -> Int -> a -> MCMC a
forall a.
Algorithm a =>
IntermediateTuningSpec -> IterationMode -> Int -> a -> MCMC a
mcmcIterate IntermediateTuningSpec
tti IterationMode
m Int
x a
a
  a
a'' <- TuningType -> Int -> a -> MCMC a
forall a. Algorithm a => TuningType -> Int -> a -> MCMC a
mcmcAutotune TuningType
ttn Int
x a
a'
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ IterationMode -> a -> ByteString
forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
m a
a''
  String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logDebugS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ String
"Acceptance rates calculated over the last " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" iterations."
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a''
  a
a''' <- a -> MCMC a
forall a. Algorithm a => a -> MCMC a
mcmcResetAcceptance a
a''
  IterationMode -> [Int] -> a -> MCMC a
forall a. Algorithm a => IterationMode -> [Int] -> a -> MCMC a
mcmcBurnInWithAutoTuning IterationMode
m [Int]
xs a
a'''

mcmcInitialize :: (Algorithm a) => a -> MCMC a
mcmcInitialize :: forall a. Algorithm a => a -> MCMC a
mcmcInitialize a
a = do
  String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Algorithm a => a -> String
aName a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" algorithm."
  Settings
s <- Environment Settings -> Settings
forall s. Environment s -> s
settings (Environment Settings -> Settings)
-> ReaderT (Environment Settings) IO (Environment Settings)
-> ReaderT (Environment Settings) IO Settings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (Environment Settings) IO (Environment Settings)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Opening monitors."
  a
a' <- IO a -> MCMC a
forall a. IO a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> MCMC a) -> IO a -> MCMC a
forall a b. (a -> b) -> a -> b
$ AnalysisName -> ExecutionMode -> a -> IO a
forall a. Algorithm a => AnalysisName -> ExecutionMode -> a -> IO a
aOpenMonitors (Settings -> AnalysisName
sAnalysisName Settings
s) (Settings -> ExecutionMode
sExecutionMode Settings
s) a
a
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Monitors opened."
  a -> MCMC a
forall a. a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a'

-- Save the MCMC run.
mcmcSave :: (Algorithm a) => a -> MCMC ()
mcmcSave :: forall a. Algorithm a => a -> Logger (Environment Settings) ()
mcmcSave a
a = do
  Settings
s <- (Environment Settings -> Settings)
-> ReaderT (Environment Settings) IO Settings
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader Environment Settings -> Settings
forall s. Environment s -> s
settings
  case Settings -> SaveMode
sSaveMode Settings
s of
    SaveMode
NoSave -> ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"NoSave set; Do not save the MCMC analysis."
    SaveMode
Save -> do
      ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Saving settings."
      IO () -> Logger (Environment Settings) ()
forall a. IO a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Logger (Environment Settings) ())
-> IO () -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ Settings -> IO ()
settingsSave Settings
s
      let nm :: AnalysisName
nm = Settings -> AnalysisName
sAnalysisName Settings
s
      ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Saving compressed MCMC analysis."
      ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"For long traces, or complex objects, this may take a while."
      IO () -> Logger (Environment Settings) ()
forall a. IO a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Logger (Environment Settings) ())
-> IO () -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ AnalysisName -> a -> IO ()
forall a. Algorithm a => AnalysisName -> a -> IO ()
aSave AnalysisName
nm a
a
      ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Markov chain saved. Analysis can be continued."

-- Report and finish up.
mcmcClose :: (Algorithm a) => a -> MCMC a
mcmcClose :: forall a. Algorithm a => a -> MCMC a
mcmcClose a
a = do
  String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS String
"Closing monitors."
  a
a' <- IO a -> MCMC a
forall a. IO a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> MCMC a) -> IO a -> MCMC a
forall a b. (a -> b) -> a -> b
$ a -> IO a
forall {a}. Algorithm a => a -> IO a
aCloseMonitors a
a
  a -> Logger (Environment Settings) ()
forall a. Algorithm a => a -> Logger (Environment Settings) ()
mcmcSave a
a'
  Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasStartingTime e, HasVerbosity e) =>
Logger e ()
logInfoEndTime
  Environment Settings
e <- ReaderT (Environment Settings) IO (Environment Settings)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS String
"Closing environment."
  IO () -> Logger (Environment Settings) ()
forall a. IO a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Logger (Environment Settings) ())
-> IO () -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ Environment Settings -> IO ()
forall s. Environment s -> IO ()
closeEnvironment Environment Settings
e
  a -> MCMC a
forall a. a -> ReaderT (Environment Settings) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a'

-- Initialize the run, execute the run, and close the run.
mcmcRun :: (Algorithm a) => a -> MCMC a
mcmcRun :: forall a. Algorithm a => a -> MCMC a
mcmcRun a
a = do
  -- Header.
  Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
Logger e ()
logInfoHeader
  (Environment Settings -> Settings)
-> ReaderT (Environment Settings) IO Settings
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader Environment Settings -> Settings
forall s. Environment s -> s
settings ReaderT (Environment Settings) IO Settings
-> (Settings -> Logger (Environment Settings) ())
-> Logger (Environment Settings) ()
forall a b.
ReaderT (Environment Settings) IO a
-> (a -> ReaderT (Environment Settings) IO b)
-> ReaderT (Environment Settings) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> (Settings -> ByteString)
-> Settings
-> Logger (Environment Settings) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> ByteString
settingsPrettyPrint

  -- Initialize.
  a
a' <- a -> MCMC a
forall a. Algorithm a => a -> MCMC a
mcmcInitialize a
a
  Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasStartingTime e, HasVerbosity e) =>
Logger e ()
logInfoStartingTime

  -- Execute.
  a
a'' <- a -> MCMC a
forall a. Algorithm a => a -> MCMC a
mcmcExecute a
a'

  -- Close.
  ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger (Environment Settings) ())
-> ByteString -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ IterationMode -> a -> ByteString
forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
AllProposals a
a''
  String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS (String -> Logger (Environment Settings) ())
-> String -> Logger (Environment Settings) ()
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Algorithm a => a -> String
aName a
a'' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" algorithm finished."
  a -> MCMC a
forall a. Algorithm a => a -> MCMC a
mcmcClose a
a''

-- | Run an MCMC algorithm with given settings.
mcmc :: (Algorithm a) => Settings -> a -> IO a
mcmc :: forall a. Algorithm a => Settings -> a -> IO a
mcmc Settings
s a
a = do
  Settings -> Int -> IO ()
settingsCheck Settings
s (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Algorithm a => a -> Int
aIteration a
a
  Environment Settings
e <- Settings -> IO (Environment Settings)
forall s.
(HasAnalysisName s, HasExecutionMode s, HasLogMode s,
 HasVerbosity s) =>
s -> IO (Environment s)
initializeEnvironment Settings
s
  ReaderT (Environment Settings) IO a -> Environment Settings -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> ReaderT (Environment Settings) IO a
forall a. Algorithm a => a -> MCMC a
mcmcRun a
a) Environment Settings
e

-- | Continue an MCMC algorithm for the given number of iterations.
--
-- Currently, it is only possible to continue MCMC algorithms that have
-- completed successfully. This restriction is necessary, because for parallel
-- chains, it is hardly possible to ensure all chains are synchronized when the
-- process is killed or fails.
--
-- See:
--
-- - 'Mcmc.Algorithm.MHG.mhgLoad'
--
-- - 'Mcmc.Algorithm.MC3.mc3Load'
mcmcContinue :: (Algorithm a) => Iterations -> Settings -> a -> IO a
mcmcContinue :: forall a. Algorithm a => Iterations -> Settings -> a -> IO a
mcmcContinue Iterations
dn Settings
s = Settings -> a -> IO a
forall a. Algorithm a => Settings -> a -> IO a
mcmc Settings
s'
  where
    n' :: Iterations
n' = Int -> Iterations
Iterations (Int -> Iterations) -> Int -> Iterations
forall a b. (a -> b) -> a -> b
$ Iterations -> Int
fromIterations (Settings -> Iterations
sIterations Settings
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Iterations -> Int
fromIterations Iterations
dn
    s' :: Settings
s' = Settings
s {sIterations = n', sExecutionMode = Continue}