{-# 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