aivika-1.2: examples/InspectionAdjustmentStations.hs
{-# LANGUAGE RecursiveDo, Arrows #-}
-- Example: Inspection and Adjustment Stations on a Production Line
--
-- This is a model of the workflow with a loop. Also there are two infinite queues.
--
-- It is described in different sources [1, 2]. So, this is chapter 8 of [2] and section 5.15 of [1].
--
-- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed.
--
-- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006
-- CAUTION:
--
-- This model is not yet fully tested and it may contain logical errors but it seems to be working,
-- although some results may differ slightly but it can be related to a great value of the deviation
-- for some variables as well as to a small number of samples in [1].
--
-- The results for the queue sizes in [2] seem doubtful for me, while my results for these queue sizes
-- are similar to [1] but I also made 1000 runs (see the aivika-experiment-chart package) versus 1 run
-- in [1]. In comparison with [1] I see a difference in the queue size for the adjustment station and
-- it can be realized as there was a too small number of samples (= 13) in [1], for the TV settings must
-- fail when inspecting to be directed to the adjustor.
--
-- Also I have received more small values for the wait time in comparison with [1] but they have
-- a relatively great deviation, which may be acceptable (??), taking into account a small number of
-- samples used in [1].
--
-- At the same time, all my other results except for these queue sizes correspond to [2], where the author
-- launched 1000 simulation runs too.
--
-- Some new things that I have added the past summer (2013), i.e. Streams / Processors / Queues / Servers,
-- should be yet verified for other models but, as I wrote, they seem to be working.
import Prelude hiding (id, (.))
import Control.Monad
import Control.Monad.Trans
import Control.Arrow
import Control.Category (id, (.))
import Simulation.Aivika
import Simulation.Aivika.Queue.Infinite
-- | The simulation specs.
specs = Specs { spcStartTime = 0.0,
spcStopTime = 480.0,
spcDT = 0.1,
spcMethod = RungeKutta4,
spcGeneratorType = SimpleGenerator }
-- the minimum delay of arriving the next TV set
minArrivalDelay = 3.5
-- the maximum delay of arriving the next TV set
maxArrivalDelay = 7.5
-- the minimum time to inspect the TV set
minInspectionTime = 6
-- the maximum time to inspect the TV set
maxInspectionTime = 12
-- the probability of passing the inspection phase
inspectionPassingProb = 0.85
-- how many are inspection stations?
inspectionStationCount = 2
-- the minimum time to adjust an improper TV set
minAdjustmentTime = 20
-- the maximum time to adjust an improper TV set
maxAdjustmentTime = 40
-- how many are adjustment stations?
adjustmentStationCount = 1
-- create an accumulator to gather the queue size statistics
newQueueSizeAccumulator queue =
newTimingStatsAccumulator $
Signalable (queueCount queue) (queueCountChanged_ queue)
-- create an inspection station (server)
newInspectionStation =
newServer $ \a ->
do holdProcess =<<
(liftParameter $
randomUniform minInspectionTime maxInspectionTime)
passed <-
liftParameter $
randomTrue inspectionPassingProb
if passed
then return $ Right a
else return $ Left a
-- create an adjustment station (server)
newAdjustmentStation =
newServer $ \a ->
do holdProcess =<<
(liftParameter $
randomUniform minAdjustmentTime maxAdjustmentTime)
return a
model :: Simulation ()
model = mdo
-- to count the arrived TV sets for inspecting and adjusting
inputArrivalTimer <- newArrivalTimer
-- it will gather the statistics of the processing time
outputArrivalTimer <- newArrivalTimer
-- define a stream of input events
let inputStream =
randomUniformStream minArrivalDelay maxArrivalDelay
-- create a queue before the inspection stations
inspectionQueue <- newFCFSQueue
-- create a queue before the adjustment stations
adjustmentQueue <- newFCFSQueue
-- the inspection stations' queue size statistics
inspectionQueueSizeAcc <-
runEventInStartTime $
newQueueSizeAccumulator inspectionQueue
-- the adjustment stations' queue size statistics
adjustmentQueueSizeAcc <-
runEventInStartTime $
newQueueSizeAccumulator adjustmentQueue
-- create the inspection stations (servers)
inspectionStations <-
forM [1 .. inspectionStationCount] $ \_ ->
newInspectionStation
-- create the adjustment stations (servers)
adjustmentStations <-
forM [1 .. adjustmentStationCount] $ \_ ->
newAdjustmentStation
-- a processor loop for the inspection stations' queue
let inspectionQueueProcessorLoop =
queueProcessorLoopSeq
(liftEvent . enqueue inspectionQueue)
(dequeue inspectionQueue)
inspectionProcessor
(adjustmentQueueProcessor >>> adjustmentProcessor)
-- a processor for the adjustment stations' queue
let adjustmentQueueProcessor =
queueProcessor
(liftEvent . enqueue adjustmentQueue)
(dequeue adjustmentQueue)
-- a parallel work of the inspection stations
let inspectionProcessor =
processorParallel (map serverProcessor inspectionStations)
-- a parallel work of the adjustment stations
let adjustmentProcessor =
processorParallel (map serverProcessor adjustmentStations)
-- the entire processor from input to output
let entireProcessor =
arrivalTimerProcessor inputArrivalTimer >>>
inspectionQueueProcessorLoop >>>
arrivalTimerProcessor outputArrivalTimer
-- start simulating the model
runProcessInStartTime $
sinkStream $ runProcessor entireProcessor inputStream
-- show the results in the final time
runEventInStopTime $
do let indent = 2
inspectionQueueSum <- queueSummary inspectionQueue indent
adjustmentQueueSum <- queueSummary adjustmentQueue indent
inspectionStationSums <-
forM inspectionStations $ \x -> serverSummary x indent
adjustmentStationSums <-
forM adjustmentStations $ \x -> serverSummary x indent
inputProcessingTime <- arrivalProcessingTime inputArrivalTimer
outputProcessingTime <- arrivalProcessingTime outputArrivalTimer
inspectionQueueSize <- timingStatsAccumulated inspectionQueueSizeAcc
adjustmentQueueSize <- timingStatsAccumulated adjustmentQueueSizeAcc
liftIO $
do putStrLn ""
putStrLn "--- the inspection stations' queue summary (in the final time) ---"
putStrLn ""
putStrLn $ inspectionQueueSum []
putStrLn ""
forM_ (zip [1..] inspectionStationSums) $ \(i, x) ->
do putStrLn $ "--- the inspection station no. "
++ show i ++ " (in the final time) ---"
putStrLn ""
putStrLn $ x []
putStrLn ""
putStrLn "--- the adjustment stations' queue summary (in the final time) ---"
putStrLn ""
putStrLn $ adjustmentQueueSum []
putStrLn ""
forM_ (zip [1..] adjustmentStationSums) $ \(i, x) ->
do putStrLn $ "--- the adjustment station no. "
++ show i ++ " (in the final time) ---"
putStrLn ""
putStrLn $ x []
putStrLn ""
putStrLn "--- the input arrival time summary (we are interested in their count) ---"
putStrLn ""
putStrLn $ samplingStatsSummary inputProcessingTime indent []
putStrLn ""
putStrLn "--- the arrival processing time summary ---"
putStrLn ""
putStrLn $ samplingStatsSummary outputProcessingTime indent []
putStrLn ""
putStrLn $ "--- the inspection stations' queue size summary "
++ "(updated when enqueueing and dequeueing) ---"
putStrLn ""
putStrLn $ timingStatsSummary inspectionQueueSize indent []
putStrLn ""
putStrLn $ "--- the adjustment stations' queue size summary "
++ "(updated when enqueueing and dequeueing) ---"
putStrLn ""
putStrLn $ timingStatsSummary adjustmentQueueSize indent []
putStrLn ""
main = runSimulation model specs