diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,11 @@ +Version 1.1 +----- + +* Added the time horizon parameter. + +* Increased a frequency of the global virtual time synchronization. + Version 1.0 ----- diff --git a/Simulation/Aivika/Distributed/Optimistic/Internal/DIO.hs b/Simulation/Aivika/Distributed/Optimistic/Internal/DIO.hs --- a/Simulation/Aivika/Distributed/Optimistic/Internal/DIO.hs +++ b/Simulation/Aivika/Distributed/Optimistic/Internal/DIO.hs @@ -71,6 +71,8 @@ DIOParams { dioLoggingPriority :: Priority, -- ^ The logging priority dioName :: String, + -- ^ The time horizon in modeling time units. + dioTimeHorizon :: Maybe Double, -- ^ The name of the logical process. dioUndoableLogSizeThreshold :: Int, -- ^ The undoable log size threshold used for detecting an overflow @@ -193,6 +195,7 @@ defaultDIOParams = DIOParams { dioLoggingPriority = WARNING, dioName = "LP", + dioTimeHorizon = Nothing, dioUndoableLogSizeThreshold = 10000000, dioOutputMessageQueueSizeThreshold = 10000, dioTransientMessageQueueSizeThreshold = 5000, diff --git a/Simulation/Aivika/Distributed/Optimistic/Internal/Event.hs b/Simulation/Aivika/Distributed/Optimistic/Internal/Event.hs --- a/Simulation/Aivika/Distributed/Optimistic/Internal/Event.hs +++ b/Simulation/Aivika/Distributed/Optimistic/Internal/Event.hs @@ -295,6 +295,24 @@ return True else return False +-- | Whether the time horizon has exceeded. +isTimeHorizonExceeded :: Event DIO Bool +isTimeHorizonExceeded = + Event $ \p -> + do ps <- dioParams + case dioTimeHorizon ps of + Nothing -> return False + Just th -> + do let q = runEventQueue $ pointRun p + gvt <- liftIOUnsafe $ readIORef (queueGlobalTime q) + t <- liftIOUnsafe $ readIORef (queueTime q) + if t - gvt > th + then do logDIO INFO $ + "t = " ++ (show $ pointTime p) ++ + ": exceeded the time horizon" + return True + else return False + -- | Throttle the message channel. throttleMessageChannel :: TimeWarp DIO () throttleMessageChannel = @@ -319,8 +337,12 @@ invokeTimeWarp p' $ processChannelMessage x p' <- invokeEvent p currentEventPoint f2 <- invokeEvent p' isEventOverflow - when f2 $ - invokeTimeWarp p' throttleMessageChannel + if f2 + then invokeTimeWarp p' throttleMessageChannel + else do f3 <- invokeEvent p' isTimeHorizonExceeded + if f3 + then invokeTimeWarp p' throttleMessageChannel + else return () -- | Process the channel message. processChannelMessage :: LogicalProcessMessage -> TimeWarp DIO () diff --git a/Simulation/Aivika/Distributed/Optimistic/Internal/TimeServer.hs b/Simulation/Aivika/Distributed/Optimistic/Internal/TimeServer.hs --- a/Simulation/Aivika/Distributed/Optimistic/Internal/TimeServer.hs +++ b/Simulation/Aivika/Distributed/Optimistic/Internal/TimeServer.hs @@ -138,7 +138,7 @@ tsName = "Time Server", tsReceiveTimeout = 100000, tsTimeSyncTimeout = 60000000, - tsTimeSyncDelay = 1000000, + tsTimeSyncDelay = 100000, tsProcessMonitoringEnabled = False, tsProcessMonitoringDelay = 3000000, tsProcessReconnectingEnabled = False, diff --git a/Simulation/Aivika/Distributed/Optimistic/Internal/UndoableLog.hs b/Simulation/Aivika/Distributed/Optimistic/Internal/UndoableLog.hs --- a/Simulation/Aivika/Distributed/Optimistic/Internal/UndoableLog.hs +++ b/Simulation/Aivika/Distributed/Optimistic/Internal/UndoableLog.hs @@ -7,7 +7,7 @@ -- Stability : experimental -- Tested with: GHC 7.10.3 -- --- This module defines an output message queue. +-- This module defines an undoable log. -- module Simulation.Aivika.Distributed.Optimistic.Internal.UndoableLog (UndoableLog, diff --git a/aivika-distributed.cabal b/aivika-distributed.cabal --- a/aivika-distributed.cabal +++ b/aivika-distributed.cabal @@ -1,5 +1,5 @@ name: aivika-distributed -version: 1.0 +version: 1.1 synopsis: Parallel distributed discrete event simulation module for the Aivika library description: This package extends the aivika-transformers [1] package and allows running parallel distributed simulations. @@ -17,10 +17,10 @@ is that this is the optimistic distributed simulation with possible rollbacks. It is assumed that optimistic methods tend to better support the parallelism inherited in the models. . - You can test the distributed simulation using your own laptop only, although the package is still destined to be + You can test the distributed simulation using your own laptop, although the package is still destined to be used with a multi-core computer, or computers connected in the distributed cluster. . - There are additional packages that allow you to run the distributed simulation experiments by + There are additional packages that allow you to run the distributed simulation experiments by using the Monte-Carlo method. They allow you to save the simulation results in SQL databases and then generate a report or a set of reports consisting of HTML pages with charts, histograms, links to CSV tables, summary statistics etc. Please consult the AivikaSoft [3] website for more details. diff --git a/tests/MachRep2Sync.hs b/tests/MachRep2Sync.hs --- a/tests/MachRep2Sync.hs +++ b/tests/MachRep2Sync.hs @@ -220,7 +220,8 @@ master = \backend nodes -> do liftIO . putStrLn $ "Slaves: " ++ show nodes let n = 2 - timeServerParams = defaultTimeServerParams { tsLoggingPriority = DEBUG } + timeServerParams = defaultTimeServerParams { tsLoggingPriority = DEBUG, + tsTimeSyncDelay = 1000000 } timeServerId <- DP.spawnLocal $ timeServer 3 timeServerParams (masterId, masterProcess) <- runMasterModel timeServerId n forM_ [1..n] $ \i -> diff --git a/tests/MachRep2SyncIO.hs b/tests/MachRep2SyncIO.hs --- a/tests/MachRep2SyncIO.hs +++ b/tests/MachRep2SyncIO.hs @@ -222,7 +222,8 @@ master = \backend nodes -> do liftIO . putStrLn $ "Slaves: " ++ show nodes let n = 2 - timeServerParams = defaultTimeServerParams { tsLoggingPriority = DEBUG } + timeServerParams = defaultTimeServerParams { tsLoggingPriority = DEBUG, + tsTimeSyncDelay = 1000000 } timeServerId <- DP.spawnLocal $ timeServer 3 timeServerParams (masterId, masterProcess) <- runMasterModel timeServerId n forM_ [1..n] $ \i -> diff --git a/tests/MachRep2WithMonitoring.hs b/tests/MachRep2WithMonitoring.hs --- a/tests/MachRep2WithMonitoring.hs +++ b/tests/MachRep2WithMonitoring.hs @@ -197,7 +197,8 @@ runSlaveModel (timeServerId, masterId) = runDIOWithEnv m ps env timeServerId where - ps = defaultDIOParams { dioSimulationMonitoringInterval = 5000000 } + ps = defaultDIOParams { dioSimulationMonitoringInterval = 5000000, + dioTimeHorizon = Just 100 } env = defaultDIOEnv { dioSimulationMonitoringAction = Just monitorSimulation } m = do registerDIO runSimulation (slaveModel masterId) specs @@ -207,7 +208,8 @@ runMasterModel timeServerId n = runDIOWithEnv m ps env timeServerId where - ps = defaultDIOParams { dioSimulationMonitoringInterval = 5000000 } + ps = defaultDIOParams { dioSimulationMonitoringInterval = 5000000, + dioTimeHorizon = Just 100 } env = defaultDIOEnv { dioSimulationMonitoringAction = Just monitorSimulation } m = do registerDIO a <- runSimulation (masterModel n) specs