aivika-distributed 0.1.1 → 0.1.3

raw patch · 10 files changed

+823/−50 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Simulation/Aivika/Distributed/Optimistic/Internal/DIO.hs +1/−1
• Simulation/Aivika/Distributed/Optimistic/Internal/TimeServer.hs +1/−1
• aivika-distributed.cabal +5/−1
• tests/MachRep1.hs +2/−31
• tests/MachRep1Simple.hs +90/−0
• tests/MachRep2.hs +2/−9
• tests/MachRep2Distributed.hs +262/−0
• tests/MachRep2Reproducible.hs +2/−7
• tests/MachRep2Sync.hs +228/−0
• tests/MachRep2SyncIO.hs +230/−0

@@ -127,7 +127,7 @@ -- | The default parameters for the 'DIO' computation defaultDIOParams :: DIOParams defaultDIOParams =-  DIOParams { dioLoggingPriority = DEBUG,+  DIOParams { dioLoggingPriority = WARNING,               dioUndoableLogSizeThreshold = 500000,               dioOutputMessageQueueSizeThreshold = 10000,               dioSyncTimeout = 5000000,

@@ -68,7 +68,7 @@ -- | The default time server parameters. defaultTimeServerParams :: TimeServerParams defaultTimeServerParams =-  TimeServerParams { tsLoggingPriority = DEBUG,+  TimeServerParams { tsLoggingPriority = WARNING,                      tsExpectTimeout = 1000,                      tsTimeSyncDelay = 1000                    }

@@ -1,5 +1,5 @@ name:            aivika-distributed-version:         0.1.1+version:         0.1.3 synopsis:        Parallel distributed simulation library description:     This package extends the Aivika library with facilities for running parallel distributed simulations.@@ -17,8 +17,12 @@ tested-with:     GHC == 7.10.1  extra-source-files:  tests/MachRep1.hs+                     tests/MachRep1Simple.hs                      tests/MachRep2.hs+                     tests/MachRep2Distributed.hs                      tests/MachRep2Reproducible.hs+                     tests/MachRep2Sync.hs+                     tests/MachRep2SyncIO.hs  library 

@@ -18,19 +18,6 @@ -- Output is long-run proportion of up time. Should get value of about -- 0.66. -{--ghc -threaded MachRep1Distributed.hs--Fire up some slave nodes (for the example, we run them on a single machine):--./MachRep1Distributed slave localhost 8080 &-./MachRep1Distributed slave localhost 8081 &--And start the master node:--./MachRep1Distributed master localhost 8084--}- import System.Environment (getArgs)  import Data.Typeable@@ -115,8 +102,6 @@     m  = do runSimulation (slaveModel masterId) specs             unregisterDIO --- remotable ['runSlaveModel, 'timeServer]- runMasterModel :: DP.ProcessId -> Int -> DP.Process (DP.ProcessId, DP.Process Double) runMasterModel timeServerId n =   runDIO m ps timeServerId@@ -128,12 +113,9 @@  master = \backend nodes ->   do liftIO . putStrLn $ "Slaves: " ++ show nodes-     timeServerId <- DP.spawnLocal $ timeServer defaultTimeServerParams-     -- timeServerId <- DP.spawn node1 ($(mkClosure 'timeServer) defaultTimeServerParams)+     let timeServerParams = defaultTimeServerParams { tsLoggingPriority = DEBUG }+     timeServerId <- DP.spawnLocal $ timeServer timeServerParams      (masterId, masterProcess) <- runMasterModel timeServerId 2-     -- (masterId, masterProcess) <- runMasterModel timeServerId (length nodes)-     -- forM_ nodes $ \node ->-     --   DP.spawn node ($(mkClosure 'runSlaveModel) (timeServerId, masterId))      forM_ [1..2] $ \i ->        do (slaveId, slaveProcess) <- runSlaveModel (timeServerId, masterId)           DP.spawnLocal slaveProcess@@ -145,14 +127,3 @@ main = do   backend <- initializeBackend "localhost" "8080" initRemoteTable   startMaster backend (master backend)---- main :: IO ()--- main = do---   args <- getArgs---   case args of---     ["master", host, port] -> do---       backend <- initializeBackend host port initRemoteTable---       startMaster backend (master backend)---     ["slave", host, port] -> do---       backend <- initializeBackend host port initRemoteTable---       startSlave backend

@@ -0,0 +1,90 @@++-- It corresponds to model MachRep1 described in document +-- Introduction to Discrete-Event Simulation and the SimPy Language+-- [http://heather.cs.ucdavis.edu/~matloff/156/PLN/DESimIntro.pdf]. +-- SimPy is available on [http://simpy.sourceforge.net/].+--   +-- The model description is as follows.+--+-- Two machines, which sometimes break down.+-- Up time is exponentially distributed with mean 1.0, and repair time is+-- exponentially distributed with mean 0.5. There are two repairpersons,+-- so the two machines can be repaired simultaneously if they are down+-- at the same time.+--+-- Output is long-run proportion of up time. Should get value of about+-- 0.66.++import Control.Monad+import Control.Monad.Trans+import Control.Concurrent+import qualified Control.Distributed.Process as DP+import Control.Distributed.Process.Node (initRemoteTable)+import Control.Distributed.Process.Backend.SimpleLocalnet++import Simulation.Aivika.Trans+import Simulation.Aivika.Distributed++meanUpTime = 1.0+meanRepairTime = 0.5++specs = Specs { spcStartTime = 0.0,+                spcStopTime = 10000.0,+                spcDT = 1.0,+                spcMethod = RungeKutta4,+                spcGeneratorType = SimpleGenerator }+        +model :: Simulation DIO Double+model =+  do totalUpTime <- newRef 0.0+     +     let machine =+           do upTime <-+                liftParameter $+                randomExponential meanUpTime+              holdProcess upTime+              liftEvent $ +                modifyRef totalUpTime (+ upTime)+              repairTime <-+                liftParameter $+                randomExponential meanRepairTime+              holdProcess repairTime+              machine++     runProcessInStartTime machine+     runProcessInStartTime machine++     let upTimeProp =+           do x <- readRef totalUpTime+              y <- liftDynamics time+              return $ x / (2 * y)++     syncEventInStopTime $+       liftIO $ putStrLn "Test IO"+     +     runEventInStopTime upTimeProp++runModel :: DP.ProcessId -> DP.Process ()+runModel timeServerId =+  do DP.say "Started simulating..."+     let ps = defaultDIOParams { dioLoggingPriority = NOTICE }+         m =+           do a <- runSimulation model specs+              terminateDIO+              return a+     (modelId, modelProcess) <- runDIO m ps timeServerId+     a <- modelProcess+     DP.say $ "The result is " ++ show a++master = \backend nodes ->+  do liftIO . putStrLn $ "Slaves: " ++ show nodes+     let timeServerParams = defaultTimeServerParams { tsLoggingPriority = DEBUG }+     timeServerId  <- DP.spawnLocal $ timeServer timeServerParams+     runModel timeServerId+     liftIO $+       threadDelay 1000000+  +main :: IO ()+main = do+  backend <- initializeBackend "localhost" "8080" initRemoteTable+  startMaster backend (master backend)

@@ -20,8 +20,6 @@ -- that a given machine does not have immediate access to the repairperson  -- when the machine breaks down. Output values should be about 0.6 and 0.67.  --- import System.Environment (getArgs)- import Data.Typeable import Data.Binary @@ -197,8 +195,6 @@     m  = do runSimulation (slaveModel masterId) specs             unregisterDIO --- remotable ['runSlaveModel, 'timeServer]- runMasterModel :: DP.ProcessId -> Int -> DP.Process (DP.ProcessId, DP.Process (Double, Double)) runMasterModel timeServerId n =   runDIO m ps timeServerId@@ -211,12 +207,9 @@ master = \backend nodes ->   do liftIO . putStrLn $ "Slaves: " ++ show nodes      let n = 2-     timeServerId <- DP.spawnLocal $ timeServer defaultTimeServerParams-     -- timeServerId <- DP.spawn node1 ($(mkClosure 'timeServer) defaultTimeServerParams)+         timeServerParams = defaultTimeServerParams { tsLoggingPriority = DEBUG }+     timeServerId <- DP.spawnLocal $ timeServer timeServerParams      (masterId, masterProcess) <- runMasterModel timeServerId n-     -- (masterId, masterProcess) <- runMasterModel timeServerId (length nodes)-     -- forM_ nodes $ \node ->-     --   DP.spawn node ($(mkClosure 'runSlaveModel) (timeServerId, masterId))      forM_ [1..n] $ \i ->        do (slaveId, slaveProcess) <- runSlaveModel (timeServerId, masterId)           DP.spawnLocal slaveProcess

@@ -0,0 +1,262 @@++{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-}++-- It corresponds to model MachRep2 described in document +-- Introduction to Discrete-Event Simulation and the SimPy Language+-- [http://heather.cs.ucdavis.edu/~matloff/156/PLN/DESimIntro.pdf]. +-- SimPy is available on [http://simpy.sourceforge.net/].+--   +-- The model description is as follows.+--   +-- Two machines, but sometimes break down. Up time is exponentially +-- distributed with mean 1.0, and repair time is exponentially distributed +-- with mean 0.5. In this example, there is only one repairperson, so +-- the two machines cannot be repaired simultaneously if they are down +-- at the same time.+--+-- In addition to finding the long-run proportion of up time as in+-- model MachRep1, let’s also find the long-run proportion of the time +-- that a given machine does not have immediate access to the repairperson +-- when the machine breaks down. Output values should be about 0.6 and 0.67. ++-- Compiling and Running+---+-- Compile using+--+-- ghc -threaded MachRep2Distributed.hs+--+-- Fire up some slave nodes (for the example, we run them on a single machine):+--+-- ./MachRep2Distributed slave localhost 8080 &+-- ./MachRep2Distributed slave localhost 8081 &+-- ./MachRep2Distributed slave localhost 8082 &+--+-- And start the master node:+--+-- ./MachRep2Distributed master localhost 8088+--++import System.Environment (getArgs)++import Data.Typeable+import Data.Binary++import GHC.Generics++import Control.Monad+import Control.Monad.Trans+import Control.Concurrent+import qualified Control.Distributed.Process as DP+import Control.Distributed.Process.Closure+import Control.Distributed.Process.Node (initRemoteTable)+import Control.Distributed.Process.Backend.SimpleLocalnet++import Simulation.Aivika.Trans+import Simulation.Aivika.Distributed++meanUpTime = 1.0+meanRepairTime = 0.5++specs = Specs { spcStartTime = 0.0,+                spcStopTime = 1000.0,+                spcDT = 1.0,+                spcMethod = RungeKutta4,+                spcGeneratorType = SimpleGenerator }++-- | The time shift when replying the messages.+delta = 0.01++data TotalUpTimeChange = TotalUpTimeChange (DP.ProcessId, Double) deriving (Eq, Ord, Show, Typeable, Generic)+data TotalUpTimeChangeResp = TotalUpTimeChangeResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)++data NRepChange = NRepChange (DP.ProcessId, Int) deriving (Eq, Ord, Show, Typeable, Generic)+data NRepChangeResp = NRepChangeResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)++data NImmedRepChange = NImmedRepChange (DP.ProcessId, Int) deriving (Eq, Ord, Show, Typeable, Generic)+data NImmedRepChangeResp = NImmedRepChangeResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)++data RepairPersonCount = RepairPersonCount DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)+data RepairPersonCountResp = RepairPersonCountResp (DP.ProcessId, Int) deriving (Eq, Ord, Show, Typeable, Generic)++data RequestRepairPerson = RequestRepairPerson DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)+data RequestRepairPersonResp = RequestRepairPersonResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)++data ReleaseRepairPerson = ReleaseRepairPerson DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)+data ReleaseRepairPersonResp = ReleaseRepairPersonResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)++instance Binary TotalUpTimeChange+instance Binary TotalUpTimeChangeResp++instance Binary NRepChange+instance Binary NRepChangeResp++instance Binary NImmedRepChange+instance Binary NImmedRepChangeResp++instance Binary RepairPersonCount+instance Binary RepairPersonCountResp++instance Binary RequestRepairPerson+instance Binary RequestRepairPersonResp++instance Binary ReleaseRepairPerson+instance Binary ReleaseRepairPersonResp++-- | A sub-model.+slaveModel :: DP.ProcessId -> Simulation DIO ()+slaveModel masterId =+  do inboxId <- liftComp messageInboxId++     let machine =+           do t <- liftDynamics time+              upTime <-+                liftParameter $ randomExponential meanUpTime+              enqueueMessage masterId (t + delta + upTime) (TotalUpTimeChange (inboxId, upTime))+              enqueueMessage masterId (t + delta + upTime) (NRepChange (inboxId, 1))+              enqueueMessage masterId (t + delta + upTime) (RepairPersonCount inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(RepairPersonCountResp (senderId, n)) ->+       do t <- liftDynamics time+          when (n == 1) $+            enqueueMessage masterId (t + delta) (NImmedRepChange (inboxId, 1))+          enqueueMessage masterId (t + delta) (RequestRepairPerson inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(RequestRepairPersonResp senderId) ->+       do t <- liftDynamics time+          repairTime <-+            liftParameter $ randomExponential meanRepairTime+          enqueueMessage masterId (t + delta + repairTime) (ReleaseRepairPerson inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(ReleaseRepairPersonResp senderId) ->+       machine+  +     runEventInStartTime machine++     syncEventInStopTime $+       liftIO $ putStrLn "The sub-model finished"++-- | The main model.       +masterModel :: Int -> Simulation DIO (Double, Double)+masterModel count =+  do totalUpTime <- newRef 0.0+     nRep <- newRef 0+     nImmedRep <- newRef 0++     let maxRepairPersonCount = 1+     repairPerson <- newFCFSResource maxRepairPersonCount++     inboxId <- liftComp messageInboxId++     runEventInStartTime $+       handleSignal messageReceived $ \(TotalUpTimeChange (senderId, x)) ->+       do modifyRef totalUpTime (+ x)+          t <- liftDynamics time+          enqueueMessage senderId (t + delta) (TotalUpTimeChangeResp inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(NRepChange (senderId, x)) ->+       do modifyRef nRep (+ x)+          t <- liftDynamics time+          enqueueMessage senderId (t + delta) (NRepChangeResp inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(NImmedRepChange (senderId, x)) ->+       do modifyRef nImmedRep (+ x)+          t <- liftDynamics time+          enqueueMessage senderId (t + delta) (NImmedRepChangeResp inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(RepairPersonCount senderId) ->+       do n <- resourceCount repairPerson+          t <- liftDynamics time+          enqueueMessage senderId (t + delta) (RepairPersonCountResp (inboxId, n))++     runEventInStartTime $+       handleSignal messageReceived $ \(RequestRepairPerson senderId) ->+       runProcess $+       do requestResource repairPerson+          t <- liftDynamics time+          liftEvent $+            enqueueMessage senderId (t + delta) (RequestRepairPersonResp inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(ReleaseRepairPerson senderId) ->+       do t <- liftDynamics time+          releaseResourceWithinEvent repairPerson+          enqueueMessage senderId (t + delta) (ReleaseRepairPersonResp inboxId)+          +     let upTimeProp =+           do x <- readRef totalUpTime+              y <- liftDynamics time+              return $ x / (fromIntegral count * y)++         immedProp =+           do n <- readRef nRep+              nImmed <- readRef nImmedRep+              return $+                fromIntegral nImmed /+                fromIntegral n++     runEventInStopTime $+       do x <- upTimeProp+          y <- immedProp+          return (x, y)++runSlaveModel :: (DP.ProcessId, DP.ProcessId) -> DP.Process (DP.ProcessId, DP.Process ())+runSlaveModel (timeServerId, masterId) =+  runDIO m ps timeServerId+  where+    ps = defaultDIOParams { dioLoggingPriority = WARNING }+    m  = do runSimulation (slaveModel masterId) specs+            unregisterDIO++startSlaveModel :: (DP.ProcessId, DP.ProcessId) -> DP.Process ()+startSlaveModel x@(timeServerId, masterId) =+  do (slaveId, slaveProcess) <- runSlaveModel x+     slaveProcess++remotable ['startSlaveModel, 'timeServer]++runMasterModel :: DP.ProcessId -> Int -> DP.Process (DP.ProcessId, DP.Process (Double, Double))+runMasterModel timeServerId n =+  runDIO m ps timeServerId+  where+    ps = defaultDIOParams { dioLoggingPriority = WARNING }+    m  = do a <- runSimulation (masterModel n) specs+            terminateDIO+            return a++master = \backend nodes ->+  do liftIO . putStrLn $ "Slaves: " ++ show nodes+     let [n0, n1, n2] = nodes+         timeServerParams = defaultTimeServerParams { tsLoggingPriority = DEBUG }+     -- timeServerId <- DP.spawnLocal $ timeServer timeServerParams+     timeServerId <- DP.spawn n0 ($(mkClosure 'timeServer) timeServerParams)+     -- (masterId, masterProcess) <- runMasterModel timeServerId 2+     -- forM_ [1..2] $ \i ->+     --   do (slaveId, slaveProcess) <- runSlaveModel (timeServerId, masterId)+     --      DP.spawnLocal slaveProcess+     (masterId, masterProcess) <- runMasterModel timeServerId 2+     forM_ [n1, n2] $ \node ->+        DP.spawn node ($(mkClosure 'startSlaveModel) (timeServerId, masterId))+     a <- masterProcess+     DP.say $+       "The result is " ++ show a++main :: IO ()+main = do+  args <- getArgs+  case args of+    ["master", host, port] -> do+      backend <- initializeBackend host port rtable+      startMaster backend (master backend)+    ["slave", host, port] -> do+      backend <- initializeBackend host port rtable+      startSlave backend+  where+    rtable :: DP.RemoteTable+    rtable = __remoteTable initRemoteTable

@@ -20,8 +20,6 @@ -- that a given machine does not have immediate access to the repairperson  -- when the machine breaks down. Output values should be about 0.6 and 0.67.  --- import System.Environment (getArgs)- import Data.Typeable import Data.Binary @@ -227,12 +225,9 @@ master = \backend nodes ->   do liftIO . putStrLn $ "Slaves: " ++ show nodes      let n = length seeds-     timeServerId <- DP.spawnLocal $ timeServer defaultTimeServerParams-     -- timeServerId <- DP.spawn node1 ($(mkClosure 'timeServer) defaultTimeServerParams)+         timeServerParams = defaultTimeServerParams { tsLoggingPriority = DEBUG }+     timeServerId <- DP.spawnLocal $ timeServer timeServerParams      (masterId, masterProcess) <- runMasterModel timeServerId n-     -- (masterId, masterProcess) <- runMasterModel timeServerId (length nodes)-     -- forM_ nodes $ \node ->-     --   DP.spawn node ($(mkClosure 'runSlaveModel) (timeServerId, masterId))      forM_ [1..n] $ \i ->        do (slaveId, slaveProcess) <- runSlaveModel (timeServerId, masterId, i)           DP.spawnLocal slaveProcess

@@ -0,0 +1,228 @@++{--# LANGUAGE TemplateHaskell #--}+{-# LANGUAGE DeriveGeneric #-}++-- It corresponds to model MachRep2 described in document +-- Introduction to Discrete-Event Simulation and the SimPy Language+-- [http://heather.cs.ucdavis.edu/~matloff/156/PLN/DESimIntro.pdf]. +-- SimPy is available on [http://simpy.sourceforge.net/].+--   +-- The model description is as follows.+--   +-- Two machines, but sometimes break down. Up time is exponentially +-- distributed with mean 1.0, and repair time is exponentially distributed +-- with mean 0.5. In this example, there is only one repairperson, so +-- the two machines cannot be repaired simultaneously if they are down +-- at the same time.+--+-- In addition to finding the long-run proportion of up time as in+-- model MachRep1, let’s also find the long-run proportion of the time +-- that a given machine does not have immediate access to the repairperson +-- when the machine breaks down. Output values should be about 0.6 and 0.67. ++import Data.Typeable+import Data.Binary++import GHC.Generics++import Control.Monad+import Control.Monad.Trans+import Control.Concurrent+import qualified Control.Distributed.Process as DP+import Control.Distributed.Process.Closure+import Control.Distributed.Process.Node (initRemoteTable)+import Control.Distributed.Process.Backend.SimpleLocalnet++import Simulation.Aivika.Trans+import Simulation.Aivika.Distributed++meanUpTime = 1.0+meanRepairTime = 0.5++specs = Specs { spcStartTime = 0.0,+                spcStopTime = 1000.0,+                spcDT = 1.0,+                spcMethod = RungeKutta4,+                spcGeneratorType = SimpleGenerator }++-- | The time shift when replying the messages.+delta = 0.01++data TotalUpTimeChange = TotalUpTimeChange (DP.ProcessId, Double) deriving (Eq, Ord, Show, Typeable, Generic)+data TotalUpTimeChangeResp = TotalUpTimeChangeResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)++data NRepChange = NRepChange (DP.ProcessId, Int) deriving (Eq, Ord, Show, Typeable, Generic)+data NRepChangeResp = NRepChangeResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)++data NImmedRepChange = NImmedRepChange (DP.ProcessId, Int) deriving (Eq, Ord, Show, Typeable, Generic)+data NImmedRepChangeResp = NImmedRepChangeResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)++data RepairPersonCount = RepairPersonCount DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)+data RepairPersonCountResp = RepairPersonCountResp (DP.ProcessId, Int) deriving (Eq, Ord, Show, Typeable, Generic)++data RequestRepairPerson = RequestRepairPerson DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)+data RequestRepairPersonResp = RequestRepairPersonResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)++data ReleaseRepairPerson = ReleaseRepairPerson DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)+data ReleaseRepairPersonResp = ReleaseRepairPersonResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)++instance Binary TotalUpTimeChange+instance Binary TotalUpTimeChangeResp++instance Binary NRepChange+instance Binary NRepChangeResp++instance Binary NImmedRepChange+instance Binary NImmedRepChangeResp++instance Binary RepairPersonCount+instance Binary RepairPersonCountResp++instance Binary RequestRepairPerson+instance Binary RequestRepairPersonResp++instance Binary ReleaseRepairPerson+instance Binary ReleaseRepairPersonResp++-- | A sub-model.+slaveModel :: DP.ProcessId -> Simulation DIO ()+slaveModel masterId =+  do inboxId <- liftComp messageInboxId++     let machine =+           do t <- liftDynamics time+              upTime <-+                liftParameter $ randomExponential meanUpTime+              enqueueMessage masterId (t + delta + upTime) (TotalUpTimeChange (inboxId, upTime))+              enqueueMessage masterId (t + delta + upTime) (NRepChange (inboxId, 1))+              enqueueMessage masterId (t + delta + upTime) (RepairPersonCount inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(RepairPersonCountResp (senderId, n)) ->+       do t <- liftDynamics time+          when (n == 1) $+            enqueueMessage masterId (t + delta) (NImmedRepChange (inboxId, 1))+          enqueueMessage masterId (t + delta) (RequestRepairPerson inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(RequestRepairPersonResp senderId) ->+       do t <- liftDynamics time+          repairTime <-+            liftParameter $ randomExponential meanRepairTime+          enqueueMessage masterId (t + delta + repairTime) (ReleaseRepairPerson inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(ReleaseRepairPersonResp senderId) ->+       machine+  +     runEventInStartTime machine++     syncEventInStopTime $+       liftIO $ putStrLn "The sub-model finished"++-- | The main model.       +masterModel :: Int -> Simulation DIO (Double, Double)+masterModel count =+  do totalUpTime <- newRef 0.0+     nRep <- newRef 0+     nImmedRep <- newRef 0++     let maxRepairPersonCount = 1+     repairPerson <- newFCFSResource maxRepairPersonCount++     inboxId <- liftComp messageInboxId++     runEventInStartTime $+       handleSignal messageReceived $ \(TotalUpTimeChange (senderId, x)) ->+       do modifyRef totalUpTime (+ x)+          t <- liftDynamics time+          enqueueMessage senderId (t + delta) (TotalUpTimeChangeResp inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(NRepChange (senderId, x)) ->+       do modifyRef nRep (+ x)+          t <- liftDynamics time+          enqueueMessage senderId (t + delta) (NRepChangeResp inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(NImmedRepChange (senderId, x)) ->+       do modifyRef nImmedRep (+ x)+          t <- liftDynamics time+          enqueueMessage senderId (t + delta) (NImmedRepChangeResp inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(RepairPersonCount senderId) ->+       do n <- resourceCount repairPerson+          t <- liftDynamics time+          enqueueMessage senderId (t + delta) (RepairPersonCountResp (inboxId, n))++     runEventInStartTime $+       handleSignal messageReceived $ \(RequestRepairPerson senderId) ->+       runProcess $+       do requestResource repairPerson+          t <- liftDynamics time+          liftEvent $+            enqueueMessage senderId (t + delta) (RequestRepairPersonResp inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(ReleaseRepairPerson senderId) ->+       do t <- liftDynamics time+          releaseResourceWithinEvent repairPerson+          enqueueMessage senderId (t + delta) (ReleaseRepairPersonResp inboxId)++     runEventInStartTime $+       forM_ [100, 200.. 1000] $ \t ->+       syncEvent t $+       return ()+          +     let upTimeProp =+           do x <- readRef totalUpTime+              y <- liftDynamics time+              return $ x / (fromIntegral count * y)++         immedProp =+           do n <- readRef nRep+              nImmed <- readRef nImmedRep+              return $+                fromIntegral nImmed /+                fromIntegral n++     runEventInStopTime $+       do x <- upTimeProp+          y <- immedProp+          return (x, y)++runSlaveModel :: (DP.ProcessId, DP.ProcessId) -> DP.Process (DP.ProcessId, DP.Process ())+runSlaveModel (timeServerId, masterId) =+  runDIO m ps timeServerId+  where+    ps = defaultDIOParams { dioLoggingPriority = WARNING }+    m  = do runSimulation (slaveModel masterId) specs+            unregisterDIO++runMasterModel :: DP.ProcessId -> Int -> DP.Process (DP.ProcessId, DP.Process (Double, Double))+runMasterModel timeServerId n =+  runDIO m ps timeServerId+  where+    ps = defaultDIOParams { dioLoggingPriority = WARNING }+    m  = do a <- runSimulation (masterModel n) specs+            terminateDIO+            return a++master = \backend nodes ->+  do liftIO . putStrLn $ "Slaves: " ++ show nodes+     let n = 2+         timeServerParams = defaultTimeServerParams { tsLoggingPriority = DEBUG }+     timeServerId <- DP.spawnLocal $ timeServer timeServerParams+     (masterId, masterProcess) <- runMasterModel timeServerId n+     forM_ [1..n] $ \i ->+       do (slaveId, slaveProcess) <- runSlaveModel (timeServerId, masterId)+          DP.spawnLocal slaveProcess+     a <- masterProcess+     DP.say $+       "The result is " ++ show a+  +main :: IO ()+main = do+  backend <- initializeBackend "localhost" "8080" initRemoteTable+  startMaster backend (master backend)

@@ -0,0 +1,230 @@++{--# LANGUAGE TemplateHaskell #--}+{-# LANGUAGE DeriveGeneric #-}++-- It corresponds to model MachRep2 described in document +-- Introduction to Discrete-Event Simulation and the SimPy Language+-- [http://heather.cs.ucdavis.edu/~matloff/156/PLN/DESimIntro.pdf]. +-- SimPy is available on [http://simpy.sourceforge.net/].+--   +-- The model description is as follows.+--   +-- Two machines, but sometimes break down. Up time is exponentially +-- distributed with mean 1.0, and repair time is exponentially distributed +-- with mean 0.5. In this example, there is only one repairperson, so +-- the two machines cannot be repaired simultaneously if they are down +-- at the same time.+--+-- In addition to finding the long-run proportion of up time as in+-- model MachRep1, let’s also find the long-run proportion of the time +-- that a given machine does not have immediate access to the repairperson +-- when the machine breaks down. Output values should be about 0.6 and 0.67. ++import Data.Typeable+import Data.Binary++import GHC.Generics++import Control.Monad+import Control.Monad.Trans+import Control.Concurrent+import qualified Control.Distributed.Process as DP+import Control.Distributed.Process.Closure+import Control.Distributed.Process.Node (initRemoteTable)+import Control.Distributed.Process.Backend.SimpleLocalnet++import Simulation.Aivika.Trans+import Simulation.Aivika.Distributed++meanUpTime = 1.0+meanRepairTime = 0.5++specs = Specs { spcStartTime = 0.0,+                spcStopTime = 1000.0,+                spcDT = 1.0,+                spcMethod = RungeKutta4,+                spcGeneratorType = SimpleGenerator }++-- | The time shift when replying the messages.+delta = 0.01++data TotalUpTimeChange = TotalUpTimeChange (DP.ProcessId, Double) deriving (Eq, Ord, Show, Typeable, Generic)+data TotalUpTimeChangeResp = TotalUpTimeChangeResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)++data NRepChange = NRepChange (DP.ProcessId, Int) deriving (Eq, Ord, Show, Typeable, Generic)+data NRepChangeResp = NRepChangeResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)++data NImmedRepChange = NImmedRepChange (DP.ProcessId, Int) deriving (Eq, Ord, Show, Typeable, Generic)+data NImmedRepChangeResp = NImmedRepChangeResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)++data RepairPersonCount = RepairPersonCount DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)+data RepairPersonCountResp = RepairPersonCountResp (DP.ProcessId, Int) deriving (Eq, Ord, Show, Typeable, Generic)++data RequestRepairPerson = RequestRepairPerson DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)+data RequestRepairPersonResp = RequestRepairPersonResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)++data ReleaseRepairPerson = ReleaseRepairPerson DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)+data ReleaseRepairPersonResp = ReleaseRepairPersonResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)++instance Binary TotalUpTimeChange+instance Binary TotalUpTimeChangeResp++instance Binary NRepChange+instance Binary NRepChangeResp++instance Binary NImmedRepChange+instance Binary NImmedRepChangeResp++instance Binary RepairPersonCount+instance Binary RepairPersonCountResp++instance Binary RequestRepairPerson+instance Binary RequestRepairPersonResp++instance Binary ReleaseRepairPerson+instance Binary ReleaseRepairPersonResp++-- | A sub-model.+slaveModel :: DP.ProcessId -> Simulation DIO ()+slaveModel masterId =+  do inboxId <- liftComp messageInboxId++     let machine =+           do t <- liftDynamics time+              upTime <-+                liftParameter $ randomExponential meanUpTime+              enqueueMessage masterId (t + delta + upTime) (TotalUpTimeChange (inboxId, upTime))+              enqueueMessage masterId (t + delta + upTime) (NRepChange (inboxId, 1))+              enqueueMessage masterId (t + delta + upTime) (RepairPersonCount inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(RepairPersonCountResp (senderId, n)) ->+       do t <- liftDynamics time+          when (n == 1) $+            enqueueMessage masterId (t + delta) (NImmedRepChange (inboxId, 1))+          enqueueMessage masterId (t + delta) (RequestRepairPerson inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(RequestRepairPersonResp senderId) ->+       do t <- liftDynamics time+          repairTime <-+            liftParameter $ randomExponential meanRepairTime+          enqueueMessage masterId (t + delta + repairTime) (ReleaseRepairPerson inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(ReleaseRepairPersonResp senderId) ->+       machine+  +     runEventInStartTime machine++     syncEventInStopTime $+       liftIO $ putStrLn "The sub-model finished"++-- | The main model.       +masterModel :: Int -> Simulation DIO (Double, Double)+masterModel count =+  do totalUpTime <- newRef 0.0+     nRep <- newRef 0+     nImmedRep <- newRef 0++     let maxRepairPersonCount = 1+     repairPerson <- newFCFSResource maxRepairPersonCount++     inboxId <- liftComp messageInboxId++     runEventInStartTime $+       handleSignal messageReceived $ \(TotalUpTimeChange (senderId, x)) ->+       do modifyRef totalUpTime (+ x)+          t <- liftDynamics time+          enqueueMessage senderId (t + delta) (TotalUpTimeChangeResp inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(NRepChange (senderId, x)) ->+       do modifyRef nRep (+ x)+          t <- liftDynamics time+          enqueueMessage senderId (t + delta) (NRepChangeResp inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(NImmedRepChange (senderId, x)) ->+       do modifyRef nImmedRep (+ x)+          t <- liftDynamics time+          enqueueMessage senderId (t + delta) (NImmedRepChangeResp inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(RepairPersonCount senderId) ->+       do n <- resourceCount repairPerson+          t <- liftDynamics time+          enqueueMessage senderId (t + delta) (RepairPersonCountResp (inboxId, n))++     runEventInStartTime $+       handleSignal messageReceived $ \(RequestRepairPerson senderId) ->+       runProcess $+       do requestResource repairPerson+          t <- liftDynamics time+          liftEvent $+            enqueueMessage senderId (t + delta) (RequestRepairPersonResp inboxId)++     runEventInStartTime $+       handleSignal messageReceived $ \(ReleaseRepairPerson senderId) ->+       do t <- liftDynamics time+          releaseResourceWithinEvent repairPerson+          enqueueMessage senderId (t + delta) (ReleaseRepairPersonResp inboxId)++     runEventInStartTime $+       forM_ [100, 200.. 1000] $ \t ->+       syncEvent t $+       liftIO $+       putStrLn $+       "t = " ++ show t ++ ": synchronization"+          +     let upTimeProp =+           do x <- readRef totalUpTime+              y <- liftDynamics time+              return $ x / (fromIntegral count * y)++         immedProp =+           do n <- readRef nRep+              nImmed <- readRef nImmedRep+              return $+                fromIntegral nImmed /+                fromIntegral n++     runEventInStopTime $+       do x <- upTimeProp+          y <- immedProp+          return (x, y)++runSlaveModel :: (DP.ProcessId, DP.ProcessId) -> DP.Process (DP.ProcessId, DP.Process ())+runSlaveModel (timeServerId, masterId) =+  runDIO m ps timeServerId+  where+    ps = defaultDIOParams { dioLoggingPriority = WARNING }+    m  = do runSimulation (slaveModel masterId) specs+            unregisterDIO++runMasterModel :: DP.ProcessId -> Int -> DP.Process (DP.ProcessId, DP.Process (Double, Double))+runMasterModel timeServerId n =+  runDIO m ps timeServerId+  where+    ps = defaultDIOParams { dioLoggingPriority = WARNING }+    m  = do a <- runSimulation (masterModel n) specs+            terminateDIO+            return a++master = \backend nodes ->+  do liftIO . putStrLn $ "Slaves: " ++ show nodes+     let n = 2+         timeServerParams = defaultTimeServerParams { tsLoggingPriority = DEBUG }+     timeServerId <- DP.spawnLocal $ timeServer timeServerParams+     (masterId, masterProcess) <- runMasterModel timeServerId n+     forM_ [1..n] $ \i ->+       do (slaveId, slaveProcess) <- runSlaveModel (timeServerId, masterId)+          DP.spawnLocal slaveProcess+     a <- masterProcess+     DP.say $+       "The result is " ++ show a+  +main :: IO ()+main = do+  backend <- initializeBackend "localhost" "8080" initRemoteTable+  startMaster backend (master backend)