aivika 4.0.1 → 4.0.3

raw patch · 14 files changed

+272/−168 lines, 14 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• Simulation/Aivika/Activity.hs +18/−18
• Simulation/Aivika/Resource/Preemption.hs +1/−1
• Simulation/Aivika/Results.hs +13/−3
• Simulation/Aivika/Server.hs +19/−19
• Simulation/Aivika/Statistics.hs +28/−12
• aivika.cabal +16/−7
• examples/BassDiffusion.hs +11/−0
• examples/ChemicalReaction.hs +3/−0
• examples/ChemicalReactionCircuit.hs +4/−1
• examples/InspectionAdjustmentStations.hs +20/−0
• examples/InventorySystem.hs +84/−106
• examples/MachineBreakdowns.hs +25/−1
• examples/WorkStationsInSeries.hs +17/−0

@@ -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 ----- 

@@ -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.

@@ -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)

@@ -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

@@ -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.

@@ -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

@@ -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] <http://hackage.haskell.org/package/aivika-experiment>     .     \[2] <http://hackage.haskell.org/package/aivika-experiment-chart>     .-    \[3] <https://github.com/dsorokin/aivika/wiki>+    \[3] <http://hackage.haskell.org/package/aivika-experiment-cairo>+    .+    \[4] <http://hackage.haskell.org/package/aivika-experiment-diagrams>+    .+    \[5] <https://github.com/dsorokin/aivika/wiki>     .     P.S. Aivika is actually a genuine female Mari name which is pronounced      with stress on the last syllable.

@@ -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 

@@ -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 

@@ -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. --

@@ -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, (.))  

@@ -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

@@ -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 = 

@@ -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, (.))