-- Example: Single-Lane Traffic Analysis
--
-- It is described in different sources [1, 2]. So, this is chapter 15 of [2] and section 6.18 of [1].
--
-- The system to be modeled in this example consists of the traffic flow from
-- two directions along a two-lane road, one lane of which has been closed for
-- 500 meters for repairs. Traffic lights have been placed at each end of
-- the closed lane to control the flow of traffic through the repair section.
-- The lights allow traffic to flow for a specified time interval from only
-- one direction. When a light turns green, the waiting cars start and pass
-- the light every two seconds. If a car arrives at a green light when there
-- are no waiting cars, the car passes through the light without delay. The car
-- arrival pattern is exponentially distributed, with an average of 9 seconds
-- between cars from direction 1 and 12 seconds between cars from direction 2.
-- A light cycle consists of green in direction 1, both red, green in direction 2,
-- both red, and then the cycle is repeated. Both lights remain red for 55 seconds
-- to allow the cars in transit to leave the repair section before traffic from
-- the other direction can be initiated.
--
-- The objective is to simulate the above system to determine values for
-- the green time for direction 1 and the green time for direction 2 which
-- yield a low average waiting time for all cars.
--
-- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed.
-- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006
import Control.Monad
import Control.Monad.Trans
import Control.Arrow
import Data.Array
import Simulation.Aivika.Trans
import qualified Simulation.Aivika.Trans.Resource as R
import Simulation.Aivika.IO
type DES = IO
-- | The simulation specs.
specs = Specs { spcStartTime = 0.0,
spcStopTime = 3600.0,
spcDT = 0.1,
spcMethod = RungeKutta4,
spcGeneratorType = SimpleGenerator }
data LightTime =
LightTime { greenLightTime1 :: Double,
greenLightTime2 :: Double }
model :: LightTime -> Simulation DES (Results DES)
model lightTime = do
let greenLightTime =
array (1, 2)
[(1, return $ greenLightTime1 lightTime :: Event DES Double),
(2, return $ greenLightTime2 lightTime :: Event DES Double)]
waitTime1 <- newRef emptySamplingStats
waitTime2 <- newRef emptySamplingStats
let waitTime =
array (1, 2) [(1, waitTime1), (2, waitTime2)]
start1 <-
runEventInStartTime $
R.newFCFSResource 1
start2 <-
runEventInStartTime $
R.newFCFSResource 1
let start =
array (1, 2) [(1, start1), (2, start2)]
light1 <- newGateClosed
light2 <- newGateClosed
let stream1 = randomExponentialStream 9
stream2 = randomExponentialStream 12
runProcessInStartTime $
flip consumeStream stream1 $ \x ->
liftEvent $
runProcess $
do R.requestResource start1
awaitGateOpened light1
t <- liftDynamics time
liftEvent $
modifyRef waitTime1 $
addSamplingStats (t - arrivalTime x)
when (t > arrivalTime x) $
holdProcess 2
R.releaseResource start1
runProcessInStartTime $
flip consumeStream stream2 $ \x ->
liftEvent $
runProcess $
do R.requestResource start2
awaitGateOpened light2
t <- liftDynamics time
liftEvent $
modifyRef waitTime2 $
addSamplingStats (t - arrivalTime x)
when (t > arrivalTime x) $
holdProcess 2
R.releaseResource start2
let lighting =
do holdProcess 55
liftEvent $
openGate light1
holdProcess $
greenLightTime1 lightTime
liftEvent $
closeGate light1
holdProcess 55
liftEvent $
openGate light2
holdProcess $
greenLightTime2 lightTime
liftEvent $
closeGate light2
lighting
runProcessInStartTime lighting
return $
results
[resultSource
"start" "Start Resource"
start,
--
resultSource
"waitTime" "Wait Time"
waitTime,
--
resultSource
"greenLightTime" "Green Light Time"
greenLightTime]
modelSummary :: LightTime -> Simulation DES (Results DES)
modelSummary lightTime =
fmap resultSummary $ model lightTime
lightTime1 = LightTime 60 45
lightTime2 = LightTime 80 60
lightTime3 = LightTime 40 30
model1 = model lightTime1
model2 = model lightTime2
model3 = model lightTime3
modelSummary1 = fmap resultSummary model1
modelSummary2 = fmap resultSummary model2
modelSummary3 = fmap resultSummary model3
main =
do printSimulationResultsInStopTime
printResultSourceInEnglish
modelSummary1 specs