{- GENERATE 2000,500,,,1 GATE NI PROF,Busy PREEMPT PROF,PR,Add,5 ADVANCE (Exponential(1,0,200)) RETURN PROF Busy TERMINATE GENERATE 2000,500 QUEUE LINE SEIZE PROF DEPART LINE ADVANCE (Exponential(1,0,1000)) LetGo RELEASE PROF TERMINATE Add ASSIGN 5+,300 ADVANCE P5 TRANSFER ,LetGo GENERATE 10000000 TERMINATE 1 START 1 -} import Prelude hiding (id, (.)) import Control.Category import Control.Monad.Trans import qualified Control.Distributed.Process as DP import Control.Distributed.Process.Node (initRemoteTable) import Control.Distributed.Process.Backend.SimpleLocalnet import Data.Maybe import Simulation.Aivika.Trans import Simulation.Aivika.Trans.GPSS import qualified Simulation.Aivika.Trans.GPSS.Queue as Q import Simulation.Aivika.Distributed type DES = DIO specs = Specs { spcStartTime = 0.0, spcStopTime = 10000000.0, spcDT = 1.0, spcMethod = RungeKutta4, spcGeneratorType = SimpleGenerator } model :: Simulation DES () model = do line <- runEventInStartTime Q.newQueue prof <- runEventInStartTime newFacility let phoneCallStream = randomUniformStream (2000 - 500) (2000 + 500) studentStream = randomUniformStream (2000 - 500) (2000 + 500) let phoneCalls = streamGeneratorBlock phoneCallStream 1 phoneCallChain = Block (\a -> do f <- liftEvent (facilityInterrupted prof) if f then blockProcess (transferBlock busy) a else return a) >>> preemptBlock prof (PreemptBlockMode { preemptBlockPriorityMode = True, preemptBlockTransfer = Just add, -- preemptBlockTransfer = Nothing, preemptBlockRemoveMode = False }) >>> advanceBlock (randomExponentialProcess_ 200) >>> returnBlock prof >>> busy busy = terminateBlock students = streamGeneratorBlock studentStream 0 studentChain = queueBlock line 1 >>> seizeBlock prof >>> departBlock line 1 >>> advanceBlock (randomExponentialProcess_ 1000) >>> letGo letGo = releaseBlock prof >>> terminateBlock add dt0 = let dt = maybe 0 id dt0 in advanceBlock (holdProcess (dt + 300)) >>> transferBlock letGo runProcessInStartTime $ runGeneratorBlock phoneCalls phoneCallChain runProcessInStartTime $ runGeneratorBlock students studentChain let rs = results [resultSource "line" "Line" line, resultSource "prof" "Prof" prof] printResultsInStopTime printResultSourceInEnglish rs runModel :: DP.ProcessId -> DP.Process () runModel timeServerId = do DP.say "Started simulating..." let ps = defaultDIOParams { dioLoggingPriority = NOTICE } m = do registerDIO a <- runSimulation model specs terminateDIO return a (modelId, modelProcess) <- runDIO m ps timeServerId modelProcess master = \backend nodes -> do liftIO . putStrLn $ "Slaves: " ++ show nodes let timeServerParams = defaultTimeServerParams { tsLoggingPriority = NOTICE } timeServerId <- DP.spawnLocal $ timeServer 1 timeServerParams runModel timeServerId main :: IO () main = do backend <- initializeBackend "localhost" "8080" rtable startMaster backend (master backend) where rtable :: DP.RemoteTable -- rtable = __remoteTable initRemoteTable rtable = initRemoteTable