{-# 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.Environment
import Mcmc.Logger
import Mcmc.Settings
import System.Exit
import System.IO
import Prelude hiding (cycle)
type MCMC = ReaderT (Environment Settings) IO
mcmcExecute :: Algorithm a => a -> MCMC a
mcmcExecute :: 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 (m :: * -> *) a. Monad m => a -> m a
return a
a'
mcmcResetAcceptance :: Algorithm a => a -> MCMC a
mcmcResetAcceptance :: 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 (m :: * -> *) a. Monad m => a -> m a
return (a -> MCMC a) -> a -> MCMC a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Algorithm a => a -> a
aResetAcceptance a
a
mcmcExceptionHandler :: Algorithm a => Environment Settings -> a -> AsyncException -> IO b
mcmcExceptionHandler :: Environment Settings -> a -> AsyncException -> IO b
mcmcExceptionHandler Environment Settings
e a
a AsyncException
UserInterrupt = do
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn String
"USER INTERRUPT!"
String -> IO ()
putStrLn String
"Try to terminate gracefully and save chain for continuation."
String -> IO ()
putStrLn String
"Press CTRL-C again to terminate now."
String -> IO ()
putStrLn String
"Close output files."
a
_ <- a -> IO a
forall a. Algorithm a => a -> IO a
aCloseMonitors a
a
Environment Settings -> IO ()
forall s. Environment s -> IO ()
closeEnvironment Environment Settings
e
String -> IO ()
putStrLn String
"Try to save settings."
let s :: Settings
s = Environment Settings -> Settings
forall s. Environment s -> s
settings Environment Settings
e
Settings -> IO ()
settingsSave Settings
s
String -> IO ()
putStrLn String
"Try to save compressed MCMC analysis."
String -> IO ()
putStrLn String
"For long traces, or complex objects, this may take a while."
let nm :: AnalysisName
nm = Settings -> AnalysisName
sAnalysisName Settings
s
AnalysisName -> a -> IO ()
forall a. Algorithm a => AnalysisName -> a -> IO ()
aSave AnalysisName
nm a
a
String -> IO ()
putStrLn String
"Markov chain saved. Analysis can be continued."
String -> IO ()
putStrLn String
"Terminate gracefully."
ExitCode -> IO b
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO b) -> ExitCode -> IO b
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1
mcmcExceptionHandler Environment Settings
_ a
_ AsyncException
e = AsyncException -> IO b
forall a e. Exception e => e -> a
throw AsyncException
e
mcmcExecuteMonitors :: Algorithm a => a -> MCMC ()
mcmcExecuteMonitors :: 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 (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
$ IO (Maybe ByteString) -> IO (Maybe ByteString)
forall a. IO a -> IO a
mask_ (IO (Maybe ByteString) -> IO (Maybe ByteString))
-> IO (Maybe ByteString) -> 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
" ")
mcmcIterate :: Algorithm a => Int -> a -> MCMC a
mcmcIterate :: Int -> a -> MCMC a
mcmcIterate Int
n a
a
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> MCMC a
forall a. HasCallStack => String -> a
error String
"mcmcIterate: Number of iterations is negative."
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = a -> MCMC a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
| Bool
otherwise = do
Environment Settings
e <- ReaderT (Environment Settings) IO (Environment Settings)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
ParallelizationMode
p <- Settings -> ParallelizationMode
sParallelizationMode (Settings -> ParallelizationMode)
-> (Environment Settings -> Settings)
-> Environment Settings
-> ParallelizationMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment Settings -> Settings
forall s. Environment s -> s
settings (Environment Settings -> ParallelizationMode)
-> ReaderT (Environment Settings) IO (Environment Settings)
-> ReaderT (Environment Settings) IO ParallelizationMode
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
a
a' <- IO a -> MCMC 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 -> (AsyncException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (ParallelizationMode -> a -> IO a
forall a. Algorithm a => ParallelizationMode -> a -> IO a
aIterate ParallelizationMode
p a
a) (Environment Settings -> a -> AsyncException -> IO a
forall a b.
Algorithm a =>
Environment Settings -> a -> AsyncException -> IO b
mcmcExceptionHandler Environment Settings
e a
a)
a -> Logger (Environment Settings) ()
forall a. Algorithm a => a -> Logger (Environment Settings) ()
mcmcExecuteMonitors a
a'
Int -> a -> MCMC a
forall a. Algorithm a => Int -> a -> MCMC a
mcmcIterate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
a'
mcmcNewRun :: Algorithm a => a -> MCMC a
mcmcNewRun :: 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
"Start 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!")
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
aSummarizeCycle a
a
a
a' <- a -> MCMC a
forall a. Algorithm a => a -> MCMC a
mcmcBurnIn 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
"Run 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'
Int -> a -> MCMC a
forall a. Algorithm a => Int -> a -> MCMC a
mcmcIterate Int
i a
a'
mcmcContinueRun :: Algorithm a => a -> MCMC a
mcmcContinueRun :: 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
$ a -> ByteString
forall a. Algorithm a => a -> ByteString
aSummarizeCycle 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
"Run 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
Int -> a -> MCMC a
forall a. Algorithm a => Int -> a -> MCMC a
mcmcIterate Int
di a
a
mcmcBurnIn :: Algorithm a => a -> MCMC a
mcmcBurnIn :: 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
String -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS String
"No burn in."
a -> MCMC a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
BurnInWithoutAutoTuning Int
n -> 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
"Burn 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' <- Int -> a -> MCMC a
forall a. Algorithm a => Int -> a -> MCMC a
mcmcIterate 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
$ a -> ByteString
forall a. Algorithm a => a -> ByteString
aSummarizeCycle 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 (m :: * -> *) a. Monad m => a -> m a
return a
a''
BurnInWithAutoTuning Int
n Int
t -> 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
"Burn 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
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' <- [Int] -> a -> MCMC a
forall a. Algorithm a => [Int] -> a -> MCMC a
mcmcBurnInWithAutoTuning [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 (m :: * -> *) a. Monad m => a -> m a
return a
a'
BurnInWithCustomAutoTuning [Int]
xs -> 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
"Burn in for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
xs) 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
"Custom auto tuning is enabled 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
a
a' <- [Int] -> a -> MCMC a
forall a. Algorithm a => [Int] -> a -> MCMC a
mcmcBurnInWithAutoTuning [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 (m :: * -> *) a. Monad m => a -> m a
return a
a'
mcmcAutotune :: Algorithm a => Int -> a -> MCMC a
mcmcAutotune :: Int -> a -> MCMC a
mcmcAutotune Int
n a
a = do
ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Auto tune."
IO a -> MCMC 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
$ Int -> a -> IO a
forall a. Algorithm a => Int -> a -> IO a
aAutoTune Int
n a
a
mcmcBurnInWithAutoTuning :: Algorithm a => [Int] -> a -> MCMC a
mcmcBurnInWithAutoTuning :: [Int] -> a -> MCMC a
mcmcBurnInWithAutoTuning [] a
_ = String -> MCMC a
forall a. HasCallStack => String -> a
error String
"mcmcBurnInWithAutoTuning: Empty lisst."
mcmcBurnInWithAutoTuning [Int
x] a
a = do
a
a' <- Int -> a -> MCMC a
forall a. Algorithm a => Int -> a -> MCMC a
mcmcIterate Int
x a
a
a
a'' <- Int -> a -> MCMC a
forall a. Algorithm a => Int -> a -> MCMC a
mcmcAutotune 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
$ a -> ByteString
forall a. Algorithm a => a -> ByteString
aSummarizeCycle 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 (Int
x : [Int]
xs) a
a = do
a
a' <- Int -> a -> MCMC a
forall a. Algorithm a => Int -> a -> MCMC a
mcmcIterate Int
x a
a
a
a'' <- Int -> a -> MCMC a
forall a. Algorithm a => Int -> a -> MCMC a
mcmcAutotune 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
$ a -> ByteString
forall a. Algorithm a => a -> ByteString
aSummarizeCycle 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''
[Int] -> a -> MCMC a
forall a. Algorithm a => [Int] -> a -> MCMC a
mcmcBurnInWithAutoTuning [Int]
xs a
a'''
mcmcInitialize :: Algorithm a => a -> MCMC a
mcmcInitialize :: 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 (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 (m :: * -> *) a. Monad m => a -> m a
return a
a'
mcmcSave :: Algorithm a => a -> MCMC ()
mcmcSave :: 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
"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
"Save settings."
IO () -> Logger (Environment Settings) ()
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
"Save 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 (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."
mcmcClose :: Algorithm a => a -> MCMC a
mcmcClose :: a -> MCMC a
mcmcClose a
a = do
ByteString -> Logger (Environment Settings) ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB ByteString
"Closing MCMC run."
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
aSummarizeCycle 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 -> 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
a
a' <- IO a -> MCMC 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
Environment Settings
e <- ReaderT (Environment Settings) IO (Environment Settings)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
IO () -> Logger (Environment Settings) ()
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 (m :: * -> *) a. Monad m => a -> m a
return a
a'
mcmcRun :: Algorithm a => a -> MCMC a
mcmcRun :: a -> MCMC a
mcmcRun a
a = do
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 (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
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
a
a'' <- a -> MCMC a
forall a. Algorithm a => a -> MCMC a
mcmcExecute a
a'
a -> MCMC a
forall a. Algorithm a => a -> MCMC a
mcmcClose a
a''
mcmc :: Algorithm a => Settings -> a -> IO a
mcmc :: 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
mcmcContinue :: Algorithm a => Iterations -> Settings -> a -> IO a
mcmcContinue :: 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 :: Iterations
sIterations = Iterations
n', sExecutionMode :: ExecutionMode
sExecutionMode = ExecutionMode
Continue}