module Language.Passage.SimulatorConf where
import MonadLib
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import Language.Passage.Term
import Language.Passage.AST
import Language.Passage.Utils
import Language.Passage.Graph
data SimState = SimState
{ cfgSampleNum :: Int
, cfgItsPerSample :: Int
, cfgWarmup :: Int
, cfgMersenne :: Bool
, cfgProfile :: Bool
, cfgMonitor :: [(String, Term NodeIdx)]
, cfgObserve :: IM.IntMap Double
, cfgInitialize :: IM.IntMap Double
, cfgRandomSeed :: [Int]
, cfgNetwork :: Maybe BayesianGraph
, cfgThreadNum :: Int
, cfgSpecialSlicers :: Bool
, cfgSplitFiles :: Bool
}
initSimState :: SimState
initSimState = SimState { cfgSampleNum = 100000
, cfgItsPerSample = 10
, cfgWarmup = 1000
, cfgMersenne = False
, cfgProfile = False
, cfgMonitor = []
, cfgObserve = IM.empty
, cfgInitialize = IM.empty
, cfgRandomSeed = []
, cfgNetwork = Nothing
, cfgThreadNum = 2
, cfgSpecialSlicers = False
, cfgSplitFiles = False
}
newtype BayesianSimulator a = B (StateT SimState Id a)
deriving (Functor, Monad)
upd :: (SimState -> SimState) -> BayesianSimulator ()
upd f = B $ sets_ f
getField :: (SimState -> a) -> BayesianSimulator a
getField f = B (f `fmap` get)
runSim :: BayesianSimulator a -> SimState
runSim (B m) = snd $ runId $ runStateT initSimState m
setWarmupCount :: Int -> BayesianSimulator ()
setWarmupCount i = upd $ \s -> s { cfgWarmup = i }
setSampleCount :: Int -> BayesianSimulator ()
setSampleCount i = upd $ \s -> s { cfgSampleNum = i }
setIterationsPerSample :: Int -> BayesianSimulator ()
setIterationsPerSample i = upd $ \s -> s { cfgItsPerSample = i }
setRandomSeed :: Int -> BayesianSimulator ()
setRandomSeed d = upd $ \s -> s { cfgRandomSeed = d : cfgRandomSeed s }
setThreadNum :: Int -> BayesianSimulator ()
setThreadNum n = upd $ \s -> s { cfgThreadNum = n }
useMersenneTwister :: Bool -> BayesianSimulator ()
useMersenneTwister b = upd (\s -> s { cfgMersenne = b })
useSpecialSlicers :: Bool -> BayesianSimulator ()
useSpecialSlicers b = upd (\s -> s { cfgSpecialSlicers = b })
splitFiles :: Bool -> BayesianSimulator ()
splitFiles b = upd (\s -> s { cfgSplitFiles = b })
enableProfiling :: Bool -> BayesianSimulator ()
enableProfiling b = upd $ \s -> s { cfgProfile = b }
model :: BayesianNetwork a -> BayesianSimulator a
model t = do upd $ \s -> s { cfgNetwork = Just nw }
return a
where (a, nw) = buildBayesianGraph t
observe :: Term NodeIdx -> Double -> BayesianSimulator ()
observe t d =
case splitArray t of
(TVar idx, []) ->
do obs <- getField cfgObserve
case IM.insertLookupWithKey unused idx d obs of
(Nothing, m1) -> upd (\s -> s { cfgObserve = m1 })
(Just _, _) ->
error $ "observe: Model error. Node was observed before: "
++ show t
_ -> error $ "observe: Model error. Only nodes can be observed, received: "
++ show t
where unused = error "BUG: observe--not used"
initialize :: Term NodeIdx -> Double -> BayesianSimulator ()
initialize t d =
case splitArray t of
(TVar idx, []) ->
do init <- getField cfgInitialize
case IM.insertLookupWithKey unused idx d init of
(Nothing, m1) -> upd (\s -> s { cfgInitialize = m1 })
(Just _, _) ->
error $ "initialize: Model error. Node was initialized before: "
++ show t
_ -> error $ "initialize: Model error. Only nodes can be initialized, received: "
++ show t
where unused = error "BUG: initialize--not used"
monitor :: String -> Expr -> BayesianSimulator ()
monitor nm e = upd (\s -> s { cfgMonitor = (nm, e) : cfgMonitor s })