{-# LANGUAGE OverloadedStrings #-}
module Mcmc.Mcmc
( mcmc,
mcmcContinue,
)
where
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Mcmc.Algorithm
import Mcmc.Cycle
import Mcmc.Environment
import Mcmc.Logger
import Mcmc.Proposal (TuningType (LastTuningStep, NormalTuningStep))
import Mcmc.Settings
import System.IO
import Prelude hiding (cycle)
type MCMC = ReaderT (Environment Settings) IO
mcmcExecute :: Algorithm a => a -> MCMC a
mcmcExecute :: forall a. Algorithm a => a -> MCMC a
mcmcExecute a
a = do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Executing MCMC run."
Settings
s <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader forall s. Environment s -> s
settings
a
a' <- case Settings -> ExecutionMode
sExecutionMode Settings
s of
ExecutionMode
Fail -> forall a. Algorithm a => a -> MCMC a
mcmcNewRun a
a
ExecutionMode
Overwrite -> forall a. Algorithm a => a -> MCMC a
mcmcNewRun a
a
ExecutionMode
Continue -> forall a. Algorithm a => a -> MCMC a
mcmcContinueRun a
a
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Executed MCMC run."
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
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Reset acceptance rates."
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => a -> a
aResetAcceptance 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
_ <- 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 forall a b. (a -> b) -> a -> b
$ String
"Rethrowing error: " forall a. Semigroup a => a -> a -> a
<> forall e. Exception e => e -> String
displayException AsyncException
err forall a. Semigroup a => a -> a -> a
<> String
"."
forall e a. Exception e => e -> IO a
throwIO AsyncException
err
where
action :: ReaderT (Environment Settings) IO a
action = do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logWarnS String
"INTERRUPT!"
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logWarnS String
"Trying to terminate gracefully and to save chain for continuation."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logWarnS String
"Press CTRL-C (again) to terminate now."
forall a. Algorithm a => a -> MCMC a
mcmcClose a
a
mcmcExecuteMonitors :: Algorithm a => a -> MCMC ()
mcmcExecuteMonitors :: forall a. Algorithm a => a -> MCMC ()
mcmcExecuteMonitors a
a = do
Environment Settings
e <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let s :: Settings
s = forall s. Environment s -> s
settings Environment Settings
e
vb :: Verbosity
vb = Settings -> Verbosity
sVerbosity Settings
s
t0 :: UTCTime
t0 = forall s. Environment s -> UTCTime
startingTime Environment Settings
e
iTotal :: Int
iTotal = BurnInSettings -> Int
burnInIterations (Settings -> BurnInSettings
sBurnIn Settings
s) forall a. Num a => a -> a -> a
+ Iterations -> Int
fromIterations (Settings -> Iterations
sIterations Settings
s)
Maybe ByteString
mStdLog <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
Algorithm a =>
Verbosity -> UTCTime -> Int -> a -> IO (Maybe ByteString)
aExecuteMonitors Verbosity
vb UTCTime
t0 Int
iTotal a
a
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ByteString
mStdLog (forall e.
(HasLogHandles e, HasLock e) =>
ByteString -> ByteString -> Logger e ()
logOutB ByteString
" ")
mcmcIterate :: Algorithm a => IterationMode -> Int -> a -> MCMC a
mcmcIterate :: forall a. Algorithm a => IterationMode -> Int -> a -> MCMC a
mcmcIterate IterationMode
m Int
n a
a
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. HasCallStack => String -> a
error String
"mcmcIterate: Number of iterations is negative."
| Int
n forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return a
a
| Bool
otherwise = do
Environment Settings
e <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let p :: ParallelizationMode
p = Settings -> ParallelizationMode
sParallelizationMode forall a b. (a -> b) -> a -> b
$ forall s. Environment s -> s
settings Environment Settings
e
let handlerOld :: AsyncException -> IO b
handlerOld = forall a b.
Algorithm a =>
Environment Settings -> a -> AsyncException -> IO b
mcmcExceptionHandler Environment Settings
e a
a
actionIterate :: IO a
actionIterate = forall a.
Algorithm a =>
IterationMode -> ParallelizationMode -> a -> IO a
aIterate IterationMode
m ParallelizationMode
p a
a
a
a' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO a
actionIterate forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall {b}. AsyncException -> IO b
handlerOld
let handlerNew :: AsyncException -> IO b
handlerNew = forall a b.
Algorithm a =>
Environment Settings -> a -> AsyncException -> IO b
mcmcExceptionHandler Environment Settings
e a
a'
actionWrite :: IO ()
actionWrite = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall a. Algorithm a => a -> MCMC ()
mcmcExecuteMonitors a
a') Environment Settings
e
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ (forall a. IO a -> IO a
uninterruptibleMask_ IO ()
actionWrite) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall {b}. AsyncException -> IO b
handlerNew
forall a. Algorithm a => IterationMode -> Int -> a -> MCMC a
mcmcIterate IterationMode
m (Int
n 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 <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader forall s. Environment s -> s
settings
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Starting new MCMC sampler."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Initial state."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a
forall a. Algorithm a => a -> MCMC ()
mcmcExecuteMonitors a
a
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Algorithm a => a -> Bool
aIsInvalidState a
a) (forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logWarnB ByteString
"The initial state is invalid!")
a
a' <- forall a. Algorithm a => a -> MCMC a
mcmcBurnIn a
a
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Cleaning chain after burn in."
let tl :: TraceLength
tl = Settings -> TraceLength
sTraceLength Settings
s
a
a'' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => TraceLength -> a -> IO a
aCleanAfterBurnIn TraceLength
tl a
a'
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Saving chain after burn in."
forall a. Algorithm a => a -> MCMC ()
mcmcSave a
a''
let i :: Int
i = Iterations -> Int
fromIterations forall a b. (a -> b) -> a -> b
$ Settings -> Iterations
sIterations Settings
s
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Running chain for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
" iterations."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a''
forall a. Algorithm a => IterationMode -> Int -> a -> MCMC a
mcmcIterate 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 <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader 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 forall a. Num a => a -> a -> a
+ Int
iNormal
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Continuation of MCMC sampler."
let iCurrent :: Int
iCurrent = forall a. Algorithm a => a -> Int
aIteration a
a
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Burn in iterations: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
iBurnIn forall a. [a] -> [a] -> [a]
++ String
"."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Normal iterations: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
iNormal forall a. [a] -> [a] -> [a]
++ String
"."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Total iterations: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
iTotal forall a. [a] -> [a] -> [a]
++ String
"."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Current iteration: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
iCurrent forall a. [a] -> [a] -> [a]
++ String
"."
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
iCurrent forall a. Ord a => a -> a -> Bool
< Int
iBurnIn) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"mcmcContinueRun: Can not continue burn in."
let di :: Int
di = Int
iTotal forall a. Num a => a -> a -> a
- Int
iCurrent
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
AllProposals a
a
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Running chain for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
di forall a. [a] -> [a] -> [a]
++ String
" iterations."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a
forall a. Algorithm a => IterationMode -> Int -> a -> MCMC a
mcmcIterate 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 <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader forall s. Environment s -> s
settings
case Settings -> BurnInSettings
sBurnIn Settings
s of
BurnInSettings
NoBurnIn -> do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
AllProposals a
a
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS String
"No burn in."
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
BurnInWithoutAutoTuning Int
n -> do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
AllProposals a
a
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Burning in for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n forall a. Semigroup a => a -> a -> a
<> String
" iterations."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS String
"Auto tuning is disabled."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a
a
a' <- forall a. Algorithm a => IterationMode -> Int -> a -> MCMC a
mcmcIterate IterationMode
AllProposals Int
n a
a
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
AllProposals a
a'
a
a'' <- forall a. Algorithm a => a -> MCMC a
mcmcResetAcceptance a
a'
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Burn in finished."
forall (m :: * -> *) a. Monad m => a -> m a
return a
a''
BurnInWithAutoTuning Int
n Int
t -> do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
AllProposals a
a
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Burning in for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" iterations."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Auto tuning is enabled with a period of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
t forall a. [a] -> [a] -> [a]
++ String
"."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a
let (Int
m, Int
r) = Int
n forall a. Integral a => a -> a -> (a, a)
`divMod` Int
t
xs :: [Int]
xs = forall a. Int -> a -> [a]
replicate Int
m Int
t forall a. Semigroup a => a -> a -> a
<> [Int
r | Int
r forall a. Ord a => a -> a -> Bool
> Int
0]
a
a' <- forall a. Algorithm a => IterationMode -> [Int] -> a -> MCMC a
mcmcBurnInWithAutoTuning IterationMode
AllProposals [Int]
xs a
a
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Burn in finished."
forall (m :: * -> *) a. Monad m => a -> m a
return a
a'
BurnInWithCustomAutoTuning [Int]
xs [Int]
ys -> do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Burning in for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
xs forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ys) forall a. [a] -> [a] -> [a]
++ String
" iterations."
a
a' <-
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
xs
then do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
AllProposals a
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
else do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
FastProposals a
a
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Fast custom auto tuning with periods " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [Int]
xs forall a. [a] -> [a] -> [a]
++ String
"."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a
forall a. Algorithm a => IterationMode -> [Int] -> a -> MCMC a
mcmcBurnInWithAutoTuning IterationMode
FastProposals [Int]
xs a
a
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Full custom auto tuning with periods " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [Int]
ys forall a. [a] -> [a] -> [a]
++ String
"."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a
a
a'' <- forall a. Algorithm a => IterationMode -> [Int] -> a -> MCMC a
mcmcBurnInWithAutoTuning IterationMode
AllProposals [Int]
ys a
a'
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Burn in finished."
forall (m :: * -> *) a. Monad m => a -> m a
return a
a''
mcmcAutotune :: Algorithm a => TuningType -> Int -> a -> MCMC a
mcmcAutotune :: forall a. Algorithm a => TuningType -> Int -> a -> MCMC a
mcmcAutotune TuningType
NormalTuningStep Int
n a
a = do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Intermediate auto tune."
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => TuningType -> Int -> a -> IO a
aAutoTune TuningType
NormalTuningStep Int
n a
a
mcmcAutotune TuningType
LastTuningStep Int
n a
a = do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Last auto tune."
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => TuningType -> Int -> a -> IO a
aAutoTune TuningType
LastTuningStep 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
_ = forall a. HasCallStack => String -> a
error String
"mcmcBurnInWithAutoTuning: Empty list."
mcmcBurnInWithAutoTuning IterationMode
m [Int
x] a
a = do
a
a' <- forall a. Algorithm a => IterationMode -> Int -> a -> MCMC a
mcmcIterate IterationMode
m Int
x a
a
a
a'' <- forall a. Algorithm a => TuningType -> Int -> a -> MCMC a
mcmcAutotune TuningType
LastTuningStep Int
x a
a'
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
m a
a''
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Acceptance rates calculated over the last " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
x forall a. Semigroup a => a -> a -> a
<> String
" iterations."
forall a. Algorithm a => a -> MCMC a
mcmcResetAcceptance a
a''
mcmcBurnInWithAutoTuning IterationMode
m (Int
x : [Int]
xs) a
a = do
a
a' <- forall a. Algorithm a => IterationMode -> Int -> a -> MCMC a
mcmcIterate IterationMode
m Int
x a
a
a
a'' <- forall a. Algorithm a => TuningType -> Int -> a -> MCMC a
mcmcAutotune TuningType
NormalTuningStep Int
x a
a'
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
m a
a''
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logDebugS forall a b. (a -> b) -> a -> b
$ String
"Acceptance rates calculated over the last " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
x forall a. Semigroup a => a -> a -> a
<> String
" iterations."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => a -> ByteString
aStdMonitorHeader a
a''
a
a''' <- forall a. Algorithm a => a -> MCMC a
mcmcResetAcceptance a
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
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => a -> String
aName a
a forall a. [a] -> [a] -> [a]
++ String
" algorithm."
Settings
s <- forall s. Environment s -> s
settings forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Opening monitors."
a
a' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => AnalysisName -> ExecutionMode -> a -> IO a
aOpenMonitors (Settings -> AnalysisName
sAnalysisName Settings
s) (Settings -> ExecutionMode
sExecutionMode Settings
s) a
a
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Monitors opened."
forall (m :: * -> *) a. Monad m => a -> m a
return a
a'
mcmcSave :: Algorithm a => a -> MCMC ()
mcmcSave :: forall a. Algorithm a => a -> MCMC ()
mcmcSave a
a = do
Settings
s <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader forall s. Environment s -> s
settings
case Settings -> SaveMode
sSaveMode Settings
s of
SaveMode
NoSave -> forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"NoSave set; Do not save the MCMC analysis."
SaveMode
Save -> do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Saving settings."
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Settings -> IO ()
settingsSave Settings
s
let nm :: AnalysisName
nm = Settings -> AnalysisName
sAnalysisName Settings
s
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Saving compressed MCMC analysis."
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"For long traces, or complex objects, this may take a while."
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => AnalysisName -> a -> IO ()
aSave AnalysisName
nm a
a
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB ByteString
"Markov chain saved. Analysis can be continued."
mcmcClose :: Algorithm a => a -> MCMC a
mcmcClose :: forall a. Algorithm a => a -> MCMC a
mcmcClose a
a = do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS String
"Closing monitors."
a
a' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => a -> IO a
aCloseMonitors a
a
forall a. Algorithm a => a -> MCMC ()
mcmcSave a
a'
forall e.
(HasLock e, HasLogHandles e, HasStartingTime e, HasVerbosity e) =>
Logger e ()
logInfoEndTime
Environment Settings
e <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS String
"Closing environment."
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall s. Environment s -> IO ()
closeEnvironment Environment Settings
e
forall (m :: * -> *) a. Monad m => a -> m a
return a
a'
mcmcRun :: Algorithm a => a -> MCMC a
mcmcRun :: forall a. Algorithm a => a -> MCMC a
mcmcRun a
a = do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
Logger e ()
logInfoHeader
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader forall s. Environment s -> s
settings forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> ByteString
settingsPrettyPrint
a
a' <- forall a. Algorithm a => a -> MCMC a
mcmcInitialize a
a
forall e.
(HasLock e, HasLogHandles e, HasStartingTime e, HasVerbosity e) =>
Logger e ()
logInfoStartingTime
a
a'' <- forall a. Algorithm a => a -> MCMC a
mcmcExecute a
a'
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => IterationMode -> a -> ByteString
aSummarizeCycle IterationMode
AllProposals a
a''
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => a -> String
aName a
a'' forall a. [a] -> [a] -> [a]
++ String
" algorithm finished."
forall a. Algorithm a => a -> MCMC a
mcmcClose a
a''
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 forall a b. (a -> b) -> a -> b
$ forall a. Algorithm a => a -> Int
aIteration a
a
Environment Settings
e <- forall s.
(HasAnalysisName s, HasExecutionMode s, HasLogMode s,
HasVerbosity s) =>
s -> IO (Environment s)
initializeEnvironment Settings
s
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall a. Algorithm a => a -> MCMC a
mcmcRun a
a) Environment Settings
e
mcmcContinue :: Algorithm a => Iterations -> Settings -> a -> IO a
mcmcContinue :: forall a. Algorithm a => Iterations -> Settings -> a -> IO a
mcmcContinue Iterations
dn Settings
s = forall a. Algorithm a => Settings -> a -> IO a
mcmc Settings
s'
where
n' :: Iterations
n' = Int -> Iterations
Iterations forall a b. (a -> b) -> a -> b
$ Iterations -> Int
fromIterations (Settings -> Iterations
sIterations Settings
s) forall a. Num a => a -> a -> a
+ Iterations -> Int
fromIterations Iterations
dn
s' :: Settings
s' = Settings
s {sIterations :: Iterations
sIterations = Iterations
n', sExecutionMode :: ExecutionMode
sExecutionMode = ExecutionMode
Continue}