diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,16 @@ +Version 4.0.2 +----- + +* Minor changes in the Statistics module: replacing functions + resetSamplingCounter and resetTimingCounter with their general analogs. + +* Unifying process preemption signals in modules Server and Activity: + renaming four signals like that how they are named in the Process module. + +* The timing statistics (time persistent one) can be normalized to + a sampling-based statistics (based upon observation), which allows, + for example, building a deviation chart for the queue size. + Version 4.0.1 ----- diff --git a/Simulation/Aivika/Activity.hs b/Simulation/Aivika/Activity.hs --- a/Simulation/Aivika/Activity.hs +++ b/Simulation/Aivika/Activity.hs @@ -56,8 +56,8 @@ -- * Basic Signals activityUtilising, activityUtilised, - activityPreempting, - activityReentering, + activityPreemptionBeginning, + activityPreemptionEnding, -- * Overall Signal activityChanged_) where @@ -106,9 +106,9 @@ -- ^ A signal raised when starting to utilise the activity. activityUtilisedSource :: SignalSource (a, b), -- ^ A signal raised when the activity has been utilised. - activityPreemptingSource :: SignalSource a, + activityPreemptionBeginningSource :: SignalSource a, -- ^ A signal raised when the utilisation was preempted. - activityReenteringSource :: SignalSource a + activityPreemptionEndingSource :: SignalSource a -- ^ A signal raised when the utilisation was proceeded after it had been preempted earlier. } @@ -181,8 +181,8 @@ activityPreemptionTimeRef = r6, activityUtilisingSource = s1, activityUtilisedSource = s2, - activityPreemptingSource = s3, - activityReenteringSource = s4 } + activityPreemptionBeginningSource = s3, + activityPreemptionEndingSource = s4 } -- | Return a network computation for the specified activity. -- @@ -237,7 +237,7 @@ handleSignal (processPreemptionBeginning pid) $ \() -> do t0 <- liftDynamics time liftIO $ writeIORef r0 t0 - triggerSignal (activityPreemptingSource act) a + triggerSignal (activityPreemptionBeginningSource act) a h2 <- liftEvent $ handleSignal (processPreemptionEnding pid) $ \() -> do t0 <- liftIO $ readIORef r0 @@ -248,7 +248,7 @@ modifyIORef' (activityTotalPreemptionTimeRef act) (+ dt) modifyIORef' (activityPreemptionTimeRef act) $ addSamplingStats dt - triggerSignal (activityReenteringSource act) a + triggerSignal (activityPreemptionEndingSource act) a let m1 = do (s', b) <- activityProcess act s a dt <- liftIO $ readIORef rs @@ -335,7 +335,7 @@ -- | Signal when the 'activityTotalPreemptionTime' property value has changed. activityTotalPreemptionTimeChanged_ :: Activity s a b -> Signal () activityTotalPreemptionTimeChanged_ act = - mapSignal (const ()) (activityReentering act) + mapSignal (const ()) (activityPreemptionEnding act) -- | Return the statistics for the time when the activity was utilised. -- @@ -396,7 +396,7 @@ -- | Signal when the 'activityPreemptionTime' property value has changed. activityPreemptionTimeChanged_ :: Activity s a b -> Signal () activityPreemptionTimeChanged_ act = - mapSignal (const ()) (activityReentering act) + mapSignal (const ()) (activityPreemptionEnding act) -- | It returns the factor changing from 0 to 1, which estimates how often -- the activity was utilised. @@ -429,7 +429,7 @@ activityUtilisationFactorChanged_ act = mapSignal (const ()) (activityUtilising act) <> mapSignal (const ()) (activityUtilised act) <> - mapSignal (const ()) (activityReentering act) + mapSignal (const ()) (activityPreemptionEnding act) -- | It returns the factor changing from 0 to 1, which estimates how often -- the activity was idle. @@ -462,7 +462,7 @@ activityIdleFactorChanged_ act = mapSignal (const ()) (activityUtilising act) <> mapSignal (const ()) (activityUtilised act) <> - mapSignal (const ()) (activityReentering act) + mapSignal (const ()) (activityPreemptionEnding act) -- | It returns the factor changing from 0 to 1, which estimates how often -- the activity was preempted waiting for the further proceeding. @@ -495,7 +495,7 @@ activityPreemptionFactorChanged_ act = mapSignal (const ()) (activityUtilising act) <> mapSignal (const ()) (activityUtilised act) <> - mapSignal (const ()) (activityReentering act) + mapSignal (const ()) (activityPreemptionEnding act) -- | Raised when starting to utilise the activity after a new input task is received. activityUtilising :: Activity s a b -> Signal a @@ -506,19 +506,19 @@ activityUtilised = publishSignal . activityUtilisedSource -- | Raised when the task utilisation by the activity was preempted. -activityPreempting :: Activity s a b -> Signal a -activityPreempting = publishSignal . activityPreemptingSource +activityPreemptionBeginning :: Activity s a b -> Signal a +activityPreemptionBeginning = publishSignal . activityPreemptionBeginningSource -- | Raised when the task utilisation by the activity was proceeded after it had been preempted earlier. -activityReentering :: Activity s a b -> Signal a -activityReentering = publishSignal . activityReenteringSource +activityPreemptionEnding :: Activity s a b -> Signal a +activityPreemptionEnding = publishSignal . activityPreemptionEndingSource -- | Signal whenever any property of the activity changes. activityChanged_ :: Activity s a b -> Signal () activityChanged_ act = mapSignal (const ()) (activityUtilising act) <> mapSignal (const ()) (activityUtilised act) <> - mapSignal (const ()) (activityReentering act) + mapSignal (const ()) (activityPreemptionEnding act) -- | Return the summary for the activity with desciption of its -- properties using the specified indent. diff --git a/Simulation/Aivika/Resource/Preemption.hs b/Simulation/Aivika/Resource/Preemption.hs --- a/Simulation/Aivika/Resource/Preemption.hs +++ b/Simulation/Aivika/Resource/Preemption.hs @@ -202,7 +202,7 @@ Just maxCount | a' > maxCount -> error $ "The resource count cannot be greater than " ++ - "its maximum value: releaseResourceWithinEvent." + "its maximum value: releaseResource'." _ -> return () f <- PQ.queueNull (resourceWaitQueue r) diff --git a/Simulation/Aivika/Results.hs b/Simulation/Aivika/Results.hs --- a/Simulation/Aivika/Results.hs +++ b/Simulation/Aivika/Results.hs @@ -432,6 +432,10 @@ instance Functor ResultValue where fmap f x = x { resultValueData = fmap f (resultValueData x) } +-- | Transform the result value. +apResultValue :: ResultData (a -> b) -> ResultValue a -> ResultValue b +apResultValue f x = x { resultValueData = ap f (resultValueData x) } + -- | A container of the simulation results such as queue, server or array. data ResultContainer e = ResultContainer { resultContainerName :: ResultName, @@ -564,6 +568,12 @@ -- | Represents the very simulation results. type ResultData e = Event e +-- | Convert the timing statistics data to its normalised sampling-based representation. +normTimingStatsData :: TimingData a => ResultData (TimingStats a -> SamplingStats a) +normTimingStatsData = + do n <- liftDynamics integIteration + return $ normTimingStats (fromIntegral n) + -- | Whether an object containing the results emits a signal notifying about change of data. data ResultSignal = EmptyResultSignal -- ^ There is no signal at all. @@ -734,12 +744,12 @@ resultItemAsIntValue = const Nothing resultItemAsIntListValue = const Nothing - resultItemAsIntStatsValue = const Nothing + resultItemAsIntStatsValue = Just . apResultValue normTimingStatsData resultItemAsIntTimingStatsValue = Just resultItemAsDoubleValue = const Nothing resultItemAsDoubleListValue = const Nothing - resultItemAsDoubleStatsValue = const Nothing + resultItemAsDoubleStatsValue = Just . fmap fromIntSamplingStats . apResultValue normTimingStatsData resultItemAsDoubleTimingStatsValue = Just . fmap fromIntTimingStats resultItemAsStringValue = Just . fmap show @@ -760,7 +770,7 @@ resultItemAsDoubleValue = const Nothing resultItemAsDoubleListValue = const Nothing - resultItemAsDoubleStatsValue = const Nothing + resultItemAsDoubleStatsValue = Just . apResultValue normTimingStatsData resultItemAsDoubleTimingStatsValue = Just resultItemAsStringValue = Just . fmap show diff --git a/Simulation/Aivika/Server.hs b/Simulation/Aivika/Server.hs --- a/Simulation/Aivika/Server.hs +++ b/Simulation/Aivika/Server.hs @@ -63,8 +63,8 @@ serverPreemptionFactorChanged_, -- * Basic Signals serverInputReceived, - serverTaskPreempting, - serverTaskReentering, + serverTaskPreemptionBeginning, + serverTaskPreemptionEnding, serverTaskProcessed, serverOutputProvided, -- * Overall Signal @@ -116,9 +116,9 @@ -- ^ The statistics for the time spent being preempted. serverInputReceivedSource :: SignalSource a, -- ^ A signal raised when the server recieves a new input to process. - serverTaskPreemptingSource :: SignalSource a, + serverTaskPreemptionBeginningSource :: SignalSource a, -- ^ A signal raised when the task was preempted. - serverTaskReenteringSource :: SignalSource a, + serverTaskPreemptionEndingSource :: SignalSource a, -- ^ A signal raised when the task was proceeded after it had been preempted earlier. serverTaskProcessedSource :: SignalSource (a, b), -- ^ A signal raised when the input is processed and @@ -200,8 +200,8 @@ serverOutputWaitTimeRef = r7, serverPreemptionTimeRef = r8, serverInputReceivedSource = s1, - serverTaskPreemptingSource = s2, - serverTaskReenteringSource = s3, + serverTaskPreemptionBeginningSource = s2, + serverTaskPreemptionEndingSource = s3, serverTaskProcessedSource = s4, serverOutputProvidedSource = s5 } return server @@ -279,7 +279,7 @@ handleSignal (processPreemptionBeginning pid) $ \() -> do t1 <- liftDynamics time liftIO $ writeIORef r1 t1 - triggerSignal (serverTaskPreemptingSource server) a + triggerSignal (serverTaskPreemptionBeginningSource server) a h2 <- liftEvent $ handleSignal (processPreemptionEnding pid) $ \() -> do t1 <- liftIO $ readIORef r1 @@ -290,7 +290,7 @@ modifyIORef' (serverTotalPreemptionTimeRef server) (+ dt) modifyIORef' (serverPreemptionTimeRef server) $ addSamplingStats dt - triggerSignal (serverTaskReenteringSource server) a + triggerSignal (serverTaskPreemptionEndingSource server) a let m1 = do (s', b) <- serverProcess server s a dt <- liftIO $ readIORef rs @@ -398,7 +398,7 @@ -- | Signal when the 'serverTotalPreemptionTime' property value has changed. serverTotalPreemptionTimeChanged_ :: Server s a b -> Signal () serverTotalPreemptionTimeChanged_ server = - mapSignal (const ()) (serverTaskReentering server) + mapSignal (const ()) (serverTaskPreemptionEnding server) -- | Return the statistics of the time when the server was locked while awaiting the input. -- @@ -480,7 +480,7 @@ -- | Signal when the 'serverPreemptionTime' property value has changed. serverPreemptionTimeChanged_ :: Server s a b -> Signal () serverPreemptionTimeChanged_ server = - mapSignal (const ()) (serverTaskReentering server) + mapSignal (const ()) (serverTaskPreemptionEnding server) -- | It returns the factor changing from 0 to 1, which estimates how often -- the server was awaiting for the next input task. @@ -515,7 +515,7 @@ mapSignal (const ()) (serverInputReceived server) <> mapSignal (const ()) (serverTaskProcessed server) <> mapSignal (const ()) (serverOutputProvided server) <> - mapSignal (const ()) (serverTaskReentering server) + mapSignal (const ()) (serverTaskPreemptionEnding server) -- | It returns the factor changing from 0 to 1, which estimates how often -- the server was busy with direct processing its tasks. @@ -550,7 +550,7 @@ mapSignal (const ()) (serverInputReceived server) <> mapSignal (const ()) (serverTaskProcessed server) <> mapSignal (const ()) (serverOutputProvided server) <> - mapSignal (const ()) (serverTaskReentering server) + mapSignal (const ()) (serverTaskPreemptionEnding server) -- | It returns the factor changing from 0 to 1, which estimates how often -- the server was locked trying to deliver the output after the task is finished. @@ -585,7 +585,7 @@ mapSignal (const ()) (serverInputReceived server) <> mapSignal (const ()) (serverTaskProcessed server) <> mapSignal (const ()) (serverOutputProvided server) <> - mapSignal (const ()) (serverTaskReentering server) + mapSignal (const ()) (serverTaskPreemptionEnding server) -- | It returns the factor changing from 0 to 1, which estimates how often -- the server was preempted waiting for the further proceeding. @@ -620,19 +620,19 @@ mapSignal (const ()) (serverInputReceived server) <> mapSignal (const ()) (serverTaskProcessed server) <> mapSignal (const ()) (serverOutputProvided server) <> - mapSignal (const ()) (serverTaskReentering server) + mapSignal (const ()) (serverTaskPreemptionEnding server) -- | Raised when the server receives a new input task. serverInputReceived :: Server s a b -> Signal a serverInputReceived = publishSignal . serverInputReceivedSource -- | Raised when the task processing by the server was preempted. -serverTaskPreempting :: Server s a b -> Signal a -serverTaskPreempting = publishSignal . serverTaskPreemptingSource +serverTaskPreemptionBeginning :: Server s a b -> Signal a +serverTaskPreemptionBeginning = publishSignal . serverTaskPreemptionBeginningSource -- | Raised when the task processing by the server was proceeded after it has been preempeted earlier. -serverTaskReentering :: Server s a b -> Signal a -serverTaskReentering = publishSignal . serverTaskReenteringSource +serverTaskPreemptionEnding :: Server s a b -> Signal a +serverTaskPreemptionEnding = publishSignal . serverTaskPreemptionEndingSource -- | Raised when the server has just processed the task. serverTaskProcessed :: Server s a b -> Signal (a, b) @@ -648,7 +648,7 @@ mapSignal (const ()) (serverInputReceived server) <> mapSignal (const ()) (serverTaskProcessed server) <> mapSignal (const ()) (serverOutputProvided server) <> - mapSignal (const ()) (serverTaskReentering server) + mapSignal (const ()) (serverTaskPreemptionEnding server) -- | Return the summary for the server with desciption of its -- properties and activities using the specified indent. diff --git a/Simulation/Aivika/Statistics.hs b/Simulation/Aivika/Statistics.hs --- a/Simulation/Aivika/Statistics.hs +++ b/Simulation/Aivika/Statistics.hs @@ -28,19 +28,20 @@ timingStatsSummary, returnTimingStats, fromIntTimingStats, + normTimingStats, -- * Simple Counter SamplingCounter(..), emptySamplingCounter, incSamplingCounter, decSamplingCounter, - resetSamplingCounter, + setSamplingCounter, returnSamplingCounter, -- * Timing Counter TimingCounter(..), emptyTimingCounter, incTimingCounter, decTimingCounter, - resetTimingCounter, + setTimingCounter, returnTimingCounter) where import Data.Monoid @@ -272,6 +273,9 @@ -- | Return the average value. timingStatsMean :: TimingStats a -> Double + -- | Return the average square value. + timingStatsMean2 :: TimingStats a -> Double + -- | Return the variance. timingStatsVariance :: TimingStats a -> Double @@ -291,6 +295,7 @@ addTimingStats = addTimingStatsGeneric timingStatsMean = timingStatsMeanGeneric + timingStatsMean2 = timingStatsMean2Generic timingStatsVariance = timingStatsVarianceGeneric instance TimingData Int where @@ -309,6 +314,7 @@ addTimingStats = addTimingStatsGeneric timingStatsMean = timingStatsMeanGeneric + timingStatsMean2 = timingStatsMean2Generic timingStatsVariance = timingStatsVarianceGeneric addTimingStatsGeneric :: ConvertableToDouble a => Double -> a -> TimingStats a -> TimingStats a @@ -396,6 +402,16 @@ timingStatsMax = fromIntegral $ timingStatsMax stats, timingStatsLast = fromIntegral $ timingStatsLast stats } +-- | Convert the statistics to its normalised sampling-based representation, +-- where the first argument specifies the number of pseudo-samples. +normTimingStats :: TimingData a => Int -> TimingStats a -> SamplingStats a +normTimingStats n stats = + SamplingStats { samplingStatsCount = n, + samplingStatsMin = timingStatsMin stats, + samplingStatsMax = timingStatsMax stats, + samplingStatsMean = timingStatsMean stats, + samplingStatsMean2 = timingStatsMean2 stats } + -- | Show the summary of the statistics. showTimingStats :: (Show a, TimingData a) => TimingStats a -> ShowS showTimingStats stats = @@ -467,11 +483,11 @@ samplingCounterStats = addSamplingStats a' (samplingCounterStats counter) } where a' = samplingCounterValue counter - a --- | Reset the counter. -resetSamplingCounter :: SamplingData a => SamplingCounter a -> SamplingCounter a -resetSamplingCounter counter = - SamplingCounter { samplingCounterValue = 0, - samplingCounterStats = addSamplingStats 0 (samplingCounterStats counter) } +-- | Set a new value for the counter. +setSamplingCounter :: SamplingData a => a -> SamplingCounter a -> SamplingCounter a +setSamplingCounter a counter = + SamplingCounter { samplingCounterValue = a, + samplingCounterStats = addSamplingStats a (samplingCounterStats counter) } -- | Create a counter with the specified initial value. returnSamplingCounter :: SamplingData a => a -> SamplingCounter a @@ -507,11 +523,11 @@ timingCounterStats = addTimingStats t a' (timingCounterStats counter) } where a' = timingCounterValue counter - a --- | Reset the counter at the specified time. -resetTimingCounter :: TimingData a => Double -> TimingCounter a -> TimingCounter a -resetTimingCounter t counter = - TimingCounter { timingCounterValue = 0, - timingCounterStats = addTimingStats t 0 (timingCounterStats counter) } +-- | Set a new value for the counter at the specified time. +setTimingCounter :: TimingData a => Double -> a -> TimingCounter a -> TimingCounter a +setTimingCounter t a counter = + TimingCounter { timingCounterValue = a, + timingCounterStats = addTimingStats t a (timingCounterStats counter) } -- | Create a timing counter with the specified initial value at the given time. returnTimingCounter :: TimingData a => Double -> a -> TimingCounter a diff --git a/aivika.cabal b/aivika.cabal --- a/aivika.cabal +++ b/aivika.cabal @@ -1,5 +1,5 @@ name: aivika -version: 4.0.1 +version: 4.0.3 synopsis: A multi-paradigm simulation library description: Aivika is a multi-paradigm simulation library with a strong emphasis @@ -22,6 +22,8 @@ . * allows customizing the infinite and finite queues based on strategies too; . + * supports the resource preemption; + . * allows defining a queue network based on infinite streams of data and their processors, where we can define a complex enough behaviour just in a few lines of code; @@ -47,13 +49,13 @@ * allows gathering statistics in time points; . * hides technical details in high-level simulation computations - (monads and arrows). + (monads, streams and arrows). . Aivika itself is a light-weight engine with minimal dependencies. However, it has additional packages Aivika Experiment [1] and Aivika Experiment Chart [2] that offer the following features: . - * automating the simulation experiments; + * automating simulation experiments; . * saving the results in CSV files; . @@ -64,17 +66,24 @@ . * parallel execution of the Monte-Carlo simulation; . - * have an extensible architecture. + * has an extensible architecture. . - All three libraries were tested on Linux, Windows and OS X. + The charting package has two interchangeable back-ends: + Aivika Experiment Cairo [3] and Aivika Experiment Diagrams [4]. . - The PDF documentation is available on the Aivika Wiki [3] website. + All libraries were tested on Linux, Windows and OS X. . + The PDF documentation is available on the Aivika Wiki [5] website. + . \[1] . \[2] . - \[3] + \[3] + . + \[4] + . + \[5] . P.S. Aivika is actually a genuine female Mari name which is pronounced with stress on the last syllable. diff --git a/examples/BassDiffusion.hs b/examples/BassDiffusion.hs --- a/examples/BassDiffusion.hs +++ b/examples/BassDiffusion.hs @@ -2,6 +2,17 @@ -- This is the Bass Diffusion model solved with help of -- the Agent-based Modeling as described in the AnyLogic -- documentation. +-- +-- The model describes a product diffusion process. Potential +-- adopters of a product are influenced into buying the product +-- by advertising and by word of mouth from adopters, those +-- who have already purchased the new product. Adoption of +-- a new product driven by word of mouth is likewise an epidemic. +-- Potential adopters come into contact with adopters through +-- social interactions. A fraction of these contacts results +-- in the purchase of the new product. The advertising causes +-- a constant fraction of the potential adopter population +-- to adopt each time period. import Data.Array diff --git a/examples/ChemicalReaction.hs b/examples/ChemicalReaction.hs --- a/examples/ChemicalReaction.hs +++ b/examples/ChemicalReaction.hs @@ -1,6 +1,9 @@ {-# LANGUAGE RecursiveDo #-} +-- This is model Chemical Reaction from the 5-minute tutorial of +-- Berkeley-Madonna. + import Simulation.Aivika import Simulation.Aivika.SystemDynamics diff --git a/examples/ChemicalReactionCircuit.hs b/examples/ChemicalReactionCircuit.hs --- a/examples/ChemicalReactionCircuit.hs +++ b/examples/ChemicalReactionCircuit.hs @@ -1,7 +1,10 @@ +-- This is model Chemical Reaction from the 5-minute tutorial of +-- Berkeley-Madonna. +-- -- Note that the integCircut function uses Euler's method regardless of -- the simulation specs specified. Therefore, to receieve almost the same --- results in the old example based on using the integ function, you should +-- results as in the old example based on using the integ function, you should -- specify Euler's method in their specs in that file, although the Runge-Kutta -- method gives similar results too, which is expected. -- diff --git a/examples/InspectionAdjustmentStations.hs b/examples/InspectionAdjustmentStations.hs --- a/examples/InspectionAdjustmentStations.hs +++ b/examples/InspectionAdjustmentStations.hs @@ -10,6 +10,26 @@ -- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed. -- -- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 +-- +-- Assembled television sets move through a series of testing stations in the final +-- stage of their production. At the last of these stations, the vertical control +-- setting on the TV sets is tested. If the setting is found to be functioning improperly, +-- the offending set is routed to an adjustment station where the setting is adjusted. +-- After adjustment, the television set is sent back to the last inspection station where +-- the setting is again inspected. Television sets passing the final inspection phase, +-- whether for the first time of after one or more routings through the adjustment station, +-- are routed to a packing area. +-- +-- The time between arrivals of television sets to the final inspection station is uniformly +-- distributed between 3.5 and 7.5 minutes. Two inspectors work side-by-side at the final +-- inspection station. The time required to inspect a set is uniformly distributed between +-- 6 and 12 minutes. On the average, 85 percent of the sets are routed to the adjustment +-- station which is manned by a single worker. Adjustment of the vertical control setting +-- requires between 20 and 40 minutes, uniformly distributed. +-- +-- The inspection station and adjustor are to be simulated for 480 minutes to estimate +-- the time to process television sets through the final production stage and to determine +-- the utilization of the inspectors and the adjustors. import Prelude hiding (id, (.)) diff --git a/examples/InventorySystem.hs b/examples/InventorySystem.hs --- a/examples/InventorySystem.hs +++ b/examples/InventorySystem.hs @@ -9,12 +9,8 @@ import Control.Monad import Control.Monad.Trans -import Control.Category -import Data.Monoid - import Simulation.Aivika -import qualified Simulation.Aivika.Queue.Infinite as IQ -- | The simulation specs. specs = Specs { spcStartTime = 0.0, @@ -33,16 +29,16 @@ stockControlLevel = 72 -- | The inventory position for reordering radio. -inventoryPositionThreshold = 18 +reorderPositionThreshold = 18 --- | The initial stock of radios. -radioStock0 = 72 :: Int +-- | The initial radios in stock. +radio0 = 72 :: Int -- | The time from the placement of an order to its receipt -procurementLeadTime = 3 +leadTime = 3 -- | How often to order the radios? -procurementPeriod = 4 +reviewPeriod = 4 -- | Clear the statistics at the end of the first year clearingTime = 52 @@ -51,116 +47,98 @@ model = do -- the start time t0 <- liftParameter starttime - -- the radios in stock - radioStock <- newRef $ returnTimingCounter t0 radioStock0 - -- the number of orders - orderCount <- newRef emptyTimingCounter - -- the queue of backorders - backorderQueue <- runEventInStartTime $ IQ.newFCFSQueue - -- the total number of customers - totalCustomerCount <- newRef (0 :: Int) - -- the total order count - totalOrderCount <- newRef (0 :: Int) - -- the total number of backorders - totalBackorderCount <- newRef (0 :: Int) - -- the number of immediate sales - immedSalesCount <- newRef (0 :: Int) - -- the lost sales count - lostSalesCount <- newRef (0 :: Int) - -- whether the procurement initiated? - procuring <- newRef False -- the inventory position - let inventoryPosition = do - x1 <- readRef radioStock - x2 <- readRef orderCount - x3 <- IQ.queueCount backorderQueue - return (timingCounterValue x1 + - timingCounterValue x2 - - x3) - -- implement the ordering policy of the company + invPos <- newRef $ returnTimingCounter t0 radio0 + -- the radios in stock + radio <- newFCFSResource radio0 + -- the time between lost sales + tbLostSales <- newRef emptySamplingStats + -- the last arrive time for the lost sale + lostSaleArrive <- newRef Nothing + -- a customer order + let customerOrder :: Event () + customerOrder = do + do t <- liftDynamics time + modifyRef invPos $ + decTimingCounter t 1 + runProcess $ + requestResource radio + -- a customer has been lost + let customerLost :: Event () + customerLost = do + t0 <- readRef lostSaleArrive + t <- liftDynamics time + case t0 of + Nothing -> return () + Just t0 -> + modifyRef tbLostSales $ + addSamplingStats (t - t0) + writeRef lostSaleArrive (Just t) + -- a customer arrival process + let customerArrival :: Process () + customerArrival = do + randomExponentialProcess_ avgRadioDemand + liftEvent $ do + r <- resourceCount radio + if r > 0 + then customerOrder + else do b <- liftParameter $ + randomTrue backorderPercent + if b + then customerOrder + else customerLost + customerArrival + -- start the customer arrival process + runProcessInStartTime customerArrival + -- the safety stock + safetyStock <- newRef emptySamplingStats + -- an inventory review process + let invReview :: Process () + invReview = do + x <- liftEvent $ readRef invPos + let n = timingCounterValue x + when (n <= reorderPositionThreshold) $ + do let orderQty = stockControlLevel - n + liftEvent $ + do t <- liftDynamics time + modifyRef invPos $ + setTimingCounter t stockControlLevel + holdProcess leadTime + liftEvent $ + do r <- resourceCount radio + modifyRef safetyStock $ + addSamplingStats r + incResourceCount radio orderQty + -- start the inventory review process runEventInStartTime $ - enqueueEventWithTimes [t0, t0 + procurementPeriod..] $ - do c <- readRef orderCount - when (timingCounterValue c == 0) $ - do x <- inventoryPosition - when (x < inventoryPositionThreshold) $ - do let order = stockControlLevel - x - t0 <- liftDynamics time - modifyRef orderCount $ incTimingCounter t0 order - modifyRef totalOrderCount (+ order) - enqueueEvent (t0 + procurementLeadTime) $ - do t <- liftDynamics time - modifyRef radioStock $ incTimingCounter t order - modifyRef orderCount $ resetTimingCounter t - y1 <- readRef radioStock - y2 <- IQ.queueCount backorderQueue - let dy = min (timingCounterValue y1) y2 - modifyRef radioStock $ decTimingCounter t dy - forM_ [1..dy] $ \i -> - do IQ.tryDequeue backorderQueue - return () - -- a stream of customers - let customers = randomExponentialStream avgRadioDemand - -- model their behavior - runProcessInStartTime $ - flip consumeStream customers $ \a -> - liftEvent $ - do modifyRef totalCustomerCount (+ 1) - t <- liftDynamics time - x <- readRef radioStock - if timingCounterValue x > 0 - then do modifyRef radioStock $ decTimingCounter t 1 - modifyRef immedSalesCount (+ 1) - else do b <- liftParameter $ - randomTrue backorderPercent - if b - then do modifyRef totalBackorderCount (+ 1) - IQ.enqueue backorderQueue a - else modifyRef lostSalesCount (+ 1) - -- clear the statistics at the end of the first year (??) + enqueueEventWithTimes [t0, t0 + reviewPeriod ..] $ + runProcess invReview + -- clear the statistics at the end of the first year runEventInStartTime $ enqueueEvent clearingTime $ - do modifyRef radioStock $ \x -> x { timingCounterStats = emptyTimingStats } - modifyRef orderCount $ \x -> x { timingCounterStats = emptyTimingStats } - -- N.B. there is not yet clearing of the backorderQueue statistics - -- return the simulation results in start time + do t <- liftDynamics time + modifyRef invPos $ \x -> + returnTimingCounter t (timingCounterValue x) + writeRef tbLostSales emptySamplingStats + writeRef safetyStock emptySamplingStats + -- return the simulation results return $ results [resultSource - "radioStock" "the radios in stock" - radioStock, - -- - resultSource - "inventoryPosition" "inventory position" - inventoryPosition, - -- - resultSource - "orderCount" "the number of orders" - orderCount, - -- - resultSource - "backorderQueue" "the queue of backorders" - backorderQueue, - -- - resultSource - "totalCustomerCount" "the total number of customers" - totalCustomerCount, - -- - resultSource - "totalOrderCount" "the total order count" - totalOrderCount, + "radio" "the number of radios in stock" + (resourceCount radio), -- resultSource - "totalBackorderCount" "the total number of backorders" - totalBackorderCount, + "invPos" "the inventory position" + invPos, -- resultSource - "lostSalesCount" "the lost sales count" - lostSalesCount, + "tbLostSales" "the time between lost sales" + tbLostSales, -- resultSource - "immedSalesCount" "the number of immediate sales" - immedSalesCount] + "safetyStock" "the safety stock" + safetyStock] main = printSimulationResultsInStopTime diff --git a/examples/MachineBreakdowns.hs b/examples/MachineBreakdowns.hs --- a/examples/MachineBreakdowns.hs +++ b/examples/MachineBreakdowns.hs @@ -6,6 +6,30 @@ -- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed. -- -- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 +-- +-- Jobs arrive to a machine tool on the average of one per hour. The distribution of +-- these interarrival times is exponential. During normal operation, the jobs are +-- processed on a first-in, first-out basis. The time to process a job in hours is +-- normally distributed with a mean of 0.5 and a standard deviation of 0.1. In addition +-- to the processing time, there is a set up time that is uniformly distributed between +-- 0.2 and 0.5 of an hour. Jobs that have been processed by the machine tool are routed +-- to a different section of the shop and are considered to have left the machine tool +-- area. +-- +-- The machine tool experiences breakdowns during which time it can no longer process +-- jobs. The time between breakdowns is normally distributed with a mean of 20 hours +-- and a standard deviation of 2 hours. When a breakdown occurs, the job being processed +-- is removed from the machine tool and is placed at the head of the queue of jobs +-- waiting to be processed. Jobs preempted restart from the point at which they were +-- interrupted. +-- +-- When the machine tool breaks down, a repair process is initiated which is +-- accomplished in three phases. Each phase is exponentially distributed with a mean of +-- 3/4 of an hour. Since the repair time is the sum of independent and identically +-- distributed exponential random variables, the repair time is Erlang distributed. +-- The machine tool is to be analyzed for 500 hours to obtain information on +-- the utilization of the machine tool and the time required to process a job. +-- Statistics are to be collected for thousand simulation runs. import Control.Monad import Control.Monad.Trans @@ -85,7 +109,7 @@ runProcessInStartTime machineBreakdown -- update a counter of job interruptions runEventInStartTime $ - handleSignal_ (serverTaskPreempting machineProcessing) $ \a -> + handleSignal_ (serverTaskPreemptionBeginning machineProcessing) $ \a -> modifyRef jobsInterrupted (+ 1) -- define the queue network let network = diff --git a/examples/WorkStationsInSeries.hs b/examples/WorkStationsInSeries.hs --- a/examples/WorkStationsInSeries.hs +++ b/examples/WorkStationsInSeries.hs @@ -8,6 +8,23 @@ -- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed. -- -- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 +-- +-- The maintenance facility of a large manufacturer performs two operations. +-- These operations must be performed in series; operation 2 always follows operation 1. +-- The units that are maintained are bulky, and space is available for only eight units +-- including the units being worked on. A proposed design leaves space for two units +-- between the work stations, and space for four units before work station 1. [..] +-- Current company policy is to subcontract the maintenance of a unit if it cannot +-- gain access to the in-house facility. +-- +-- Historical data indicates that the time interval between requests for maintenance +-- is exponentially distributed with a mean of 0.4 time units. Service times are also +-- exponentially distributed with the first station requiring on the average 0.25 time +-- units and the second station, 0.5 time units. Units are transported automatically +-- from work station 1 to work station 2 in a negligible amount of time. If the queue of +-- work station 2 is full, that is, if there are two units awaiting for work station 2, +-- the first station is blocked and a unit cannot leave the station. A blocked work +-- station cannot server other units. import Prelude hiding (id, (.))