aivika 4.2 → 4.3

raw patch · 22 files changed

+2108/−16 lines, 22 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• Simulation/Aivika.hs +4/−0
• Simulation/Aivika/Activity.hs +2/−2
• Simulation/Aivika/DoubleLinkedList.hs +18/−0
• Simulation/Aivika/Operation.hs +383/−0
• Simulation/Aivika/Operation/Random.hs +408/−0
• Simulation/Aivika/PriorityQueue.hs +20/−0
• Simulation/Aivika/Processor.hs +1/−6
• Simulation/Aivika/Processor/RoundRobbin.hs +2/−2
• Simulation/Aivika/Queue.hs +27/−0
• Simulation/Aivika/Queue/Base.hs +463/−0
• Simulation/Aivika/Queue/Infinite.hs +27/−0
• Simulation/Aivika/Queue/Infinite/Base.hs +349/−0
• Simulation/Aivika/QueueStrategy.hs +26/−0
• Simulation/Aivika/Results.hs +44/−0
• Simulation/Aivika/Results/Locale.hs +31/−2
• Simulation/Aivika/Results/Transform.hs +49/−1
• Simulation/Aivika/Stream.hs +66/−2
• Simulation/Aivika/Vector.hs +17/−0
• Simulation/Aivika/Vector/Unboxed.hs +17/−0
• aivika.cabal +6/−1
• examples/TruckHaulingSituation.hs +137/−0

@@ -1,4 +1,15 @@ +Version 4.3+-----++* Added optimised queues which have no counters nor signals.++* Added assembling functions for streams.++* Added the operation activity as a simplification of server.++* Added new functions for the queues.+ Version 4.2 ----- 

@@ -27,6 +27,8 @@         module Simulation.Aivika.Generator,         module Simulation.Aivika.Net,         module Simulation.Aivika.Net.Random,+        module Simulation.Aivika.Operation,+        module Simulation.Aivika.Operation.Random,         module Simulation.Aivika.Parameter,         module Simulation.Aivika.Parameter.Random,         module Simulation.Aivika.Process,@@ -70,6 +72,8 @@ import Simulation.Aivika.Generator import Simulation.Aivika.Net import Simulation.Aivika.Net.Random+import Simulation.Aivika.Operation+import Simulation.Aivika.Operation.Random import Simulation.Aivika.Parameter import Simulation.Aivika.Parameter.Random import Simulation.Aivika.Process

@@ -155,7 +155,7 @@                                -- old state and input                                -> s                                -- ^ the initial state-                              -> Simulation (Activity s a b)+                               -> Simulation (Activity s a b) newPreemptibleStateActivity preemptible provide state =   do r0 <- liftIO $ newIORef state      r1 <- liftIO $ newIORef 0@@ -554,7 +554,7 @@        showString "preemption factor (from 0 to 1) = " . shows xf3 .        showString "\n" .        showString tab .-       showString "utilisation time (locked while awaiting the input):\n\n" .+       showString "utilisation time:\n\n" .        samplingStatsSummary xs1 (2 + indent) .        showString "\n\n" .        showString tab .

@@ -20,6 +20,8 @@         listRemoveLast,         listRemove,         listRemoveBy,+        listContains,+        listContainsBy,         listFirst,         listLast) where  @@ -207,3 +209,19 @@                                do writeIORef (itemNext prev') (Just next')                                   writeIORef (itemPrev next') (Just prev')                            return (Just $ itemVal item)++-- | Detect whether the specified element is contained in the list.+listContains :: Eq a => DoubleLinkedList a -> a -> IO Bool+listContains x v = fmap isJust $ listContainsBy x (== v)++-- | Detect whether an element satisfying the specified predicate is contained in the list.+listContainsBy :: DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)+listContainsBy x p = readIORef (listHead x) >>= loop+  where loop item =+          case item of+            Nothing   -> return Nothing+            Just item ->+              do let f = p (itemVal item)+                 if not f+                   then readIORef (itemNext item) >>= loop+                   else return $ Just (itemVal item)

@@ -0,0 +1,383 @@++-- |+-- Module     : Simulation.Aivika.Operation+-- Copyright  : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 7.10.1+--+-- It defines a stateless activity, some simplification of 'Server' and 'Activity'.+module Simulation.Aivika.Operation+       (-- * Operation+        Operation,+        newOperation,+        newPreemptibleOperation,+        -- * Processing+        operationProcess,+        -- * Operation Properties+        operationTotalUtilisationTime,+        operationTotalPreemptionTime,+        operationUtilisationTime,+        operationPreemptionTime,+        operationUtilisationFactor,+        operationPreemptionFactor,+        -- * Summary+        operationSummary,+        -- * Derived Signals for Properties+        operationTotalUtilisationTimeChanged,+        operationTotalUtilisationTimeChanged_,+        operationTotalPreemptionTimeChanged,+        operationTotalPreemptionTimeChanged_,+        operationUtilisationTimeChanged,+        operationUtilisationTimeChanged_,+        operationPreemptionTimeChanged,+        operationPreemptionTimeChanged_,+        operationUtilisationFactorChanged,+        operationUtilisationFactorChanged_,+        operationPreemptionFactorChanged,+        operationPreemptionFactorChanged_,+        -- * Basic Signals+        operationUtilising,+        operationUtilised,+        operationPreemptionBeginning,+        operationPreemptionEnding,+        -- * Overall Signal+        operationChanged_) where++import Data.IORef+import Data.Monoid++import Control.Monad+import Control.Monad.Trans++import Simulation.Aivika.Internal.Specs+import Simulation.Aivika.Simulation+import Simulation.Aivika.Dynamics+import Simulation.Aivika.Internal.Event+import Simulation.Aivika.Signal+import Simulation.Aivika.Cont+import Simulation.Aivika.Process+import Simulation.Aivika.Activity+import Simulation.Aivika.Server+import Simulation.Aivika.Statistics++-- | Like 'Server' it models an activity that takes @a@ and provides @b@.+-- But unlike the former this kind of activity has no state. Also it is destined+-- to be used within 'Process' computations.+data Operation a b =+  Operation { operationInitProcess :: a -> Process b,+              -- ^ Provide @b@ by specified @a@.+              operationProcessPreemptible :: Bool,+              -- ^ Whether the process is preemptible.+              operationStartTime :: Double,+              -- ^ The start time of creating the operation.+              operationLastTimeRef :: IORef Double,+              -- ^ The last time of utilising the operation activity.+              operationTotalUtilisationTimeRef :: IORef Double,+              -- ^ The counted total time of utilising the activity.+              operationTotalPreemptionTimeRef :: IORef Double,+              -- ^ The counted total time when the activity was preempted. +              operationUtilisationTimeRef :: IORef (SamplingStats Double),+              -- ^ The statistics for the utilisation time.+              operationPreemptionTimeRef :: IORef (SamplingStats Double),+              -- ^ The statistics for the time when the activity was preempted.+              operationUtilisingSource :: SignalSource a,+              -- ^ A signal raised when starting to utilise the activity.+              operationUtilisedSource :: SignalSource (a, b),+              -- ^ A signal raised when the activity has been utilised.+              operationPreemptionBeginningSource :: SignalSource a,+              -- ^ A signal raised when the utilisation was preempted.+              operationPreemptionEndingSource :: SignalSource a+              -- ^ A signal raised when the utilisation was proceeded after it had been preempted earlier.+           }++-- | Create a new operation that can provide output @b@ by input @a@.+--+-- By default, it is assumed that the activity utilisation cannot be preempted,+-- because the handling of possible task preemption is rather costly+-- operation.+newOperation :: (a -> Process b)+                -- ^ provide an output by the specified input+                -> Event (Operation a b)+newOperation = newPreemptibleOperation False++-- | Create a new operation that can provide output @b@ by input @a@.+newPreemptibleOperation :: Bool+                           -- ^ whether the activity can be preempted+                           -> (a -> Process b)+                           -- ^ provide an output by the specified input+                           -> Event (Operation a b)+newPreemptibleOperation preemptible provide =+  do t0 <- liftDynamics time+     r0 <- liftIO $ newIORef t0+     r1 <- liftIO $ newIORef 0+     r2 <- liftIO $ newIORef 0+     r3 <- liftIO $ newIORef emptySamplingStats+     r4 <- liftIO $ newIORef emptySamplingStats+     s1 <- liftSimulation newSignalSource+     s2 <- liftSimulation newSignalSource+     s3 <- liftSimulation newSignalSource+     s4 <- liftSimulation newSignalSource+     return Operation { operationInitProcess = provide,+                        operationProcessPreemptible = preemptible,+                        operationStartTime = t0,+                        operationLastTimeRef = r0,+                        operationTotalUtilisationTimeRef = r1,+                        operationTotalPreemptionTimeRef = r2,+                        operationUtilisationTimeRef = r3,+                        operationPreemptionTimeRef = r4,+                        operationUtilisingSource = s1,+                        operationUtilisedSource = s2,+                        operationPreemptionBeginningSource = s3,+                        operationPreemptionEndingSource = s4 }++-- | Return a computation for the specified operation. It updates internal counters.+--+-- The computation can be used only within one process at any time.+operationProcess :: Operation a b -> a -> Process b+operationProcess op a =+  do t0 <- liftDynamics time+     liftEvent $+       triggerSignal (operationUtilisingSource op) a+     -- utilise the activity+     (b, dt) <- if operationProcessPreemptible op+                then operationProcessPreempting op a+                else do b <- operationInitProcess op a+                        return (b, 0)+     t1 <- liftDynamics time+     liftEvent $+       do liftIO $+            do modifyIORef' (operationTotalUtilisationTimeRef op) (+ (t1 - t0 - dt))+               modifyIORef' (operationUtilisationTimeRef op) $+                 addSamplingStats (t1 - t0 - dt)+               writeIORef (operationLastTimeRef op) t1+          triggerSignal (operationUtilisedSource op) (a, b)+     return b++-- | Process the input with ability to handle a possible preemption.+operationProcessPreempting :: Operation a b -> a -> Process (b, Double)+operationProcessPreempting op a =+  do pid <- processId+     t0  <- liftDynamics time+     rs  <- liftIO $ newIORef 0+     r0  <- liftIO $ newIORef t0+     h1  <- liftEvent $+            handleSignal (processPreemptionBeginning pid) $ \() ->+            do t0 <- liftDynamics time+               liftIO $ writeIORef r0 t0+               triggerSignal (operationPreemptionBeginningSource op) a+     h2  <- liftEvent $+            handleSignal (processPreemptionEnding pid) $ \() ->+            do t0 <- liftIO $ readIORef r0+               t1 <- liftDynamics time+               let dt = t1 - t0+               liftIO $+                 do modifyIORef' rs (+ dt)+                    modifyIORef' (operationTotalPreemptionTimeRef op) (+ dt)+                    modifyIORef' (operationPreemptionTimeRef op) $+                      addSamplingStats dt+                    writeIORef (operationLastTimeRef op) t1+               triggerSignal (operationPreemptionEndingSource op) a +     let m1 =+           do b <- operationInitProcess op a+              dt <- liftIO $ readIORef rs+              return (b, dt)+         m2 =+           liftEvent $+           do disposeEvent h1+              disposeEvent h2+     finallyProcess m1 m2++-- | Return the counted total time when the operation activity was utilised.+--+-- The value returned changes discretely and it is usually delayed relative+-- to the current simulation time.+--+-- See also 'operationTotalUtilisationTimeChanged' and 'operationTotalUtilisationTimeChanged_'.+operationTotalUtilisationTime :: Operation a b -> Event Double+operationTotalUtilisationTime op =+  Event $ \p -> readIORef (operationTotalUtilisationTimeRef op)+  +-- | Signal when the 'operationTotalUtilisationTime' property value has changed.+operationTotalUtilisationTimeChanged :: Operation a b -> Signal Double+operationTotalUtilisationTimeChanged op =+  mapSignalM (const $ operationTotalUtilisationTime op) (operationTotalUtilisationTimeChanged_ op)+  +-- | Signal when the 'operationTotalUtilisationTime' property value has changed.+operationTotalUtilisationTimeChanged_ :: Operation a b -> Signal ()+operationTotalUtilisationTimeChanged_ op =+  mapSignal (const ()) (operationUtilised op)++-- | Return the counted total time when the operation activity was preemted waiting for+-- the further proceeding.+--+-- The value returned changes discretely and it is usually delayed relative+-- to the current simulation time.+--+-- See also 'operationTotalPreemptionTimeChanged' and 'operationTotalPreemptionTimeChanged_'.+operationTotalPreemptionTime :: Operation a b -> Event Double+operationTotalPreemptionTime op =+  Event $ \p -> readIORef (operationTotalPreemptionTimeRef op)+  +-- | Signal when the 'operationTotalPreemptionTime' property value has changed.+operationTotalPreemptionTimeChanged :: Operation a b -> Signal Double+operationTotalPreemptionTimeChanged op =+  mapSignalM (const $ operationTotalPreemptionTime op) (operationTotalPreemptionTimeChanged_ op)+  +-- | Signal when the 'operationTotalPreemptionTime' property value has changed.+operationTotalPreemptionTimeChanged_ :: Operation a b -> Signal ()+operationTotalPreemptionTimeChanged_ op =+  mapSignal (const ()) (operationPreemptionEnding op)++-- | Return the statistics for the time when the operation activity was utilised.+--+-- The value returned changes discretely and it is usually delayed relative+-- to the current simulation time.+--+-- See also 'operationUtilisationTimeChanged' and 'operationUtilisationTimeChanged_'.+operationUtilisationTime :: Operation a b -> Event (SamplingStats Double)+operationUtilisationTime op =+  Event $ \p -> readIORef (operationUtilisationTimeRef op)+  +-- | Signal when the 'operationUtilisationTime' property value has changed.+operationUtilisationTimeChanged :: Operation a b -> Signal (SamplingStats Double)+operationUtilisationTimeChanged op =+  mapSignalM (const $ operationUtilisationTime op) (operationUtilisationTimeChanged_ op)+  +-- | Signal when the 'operationUtilisationTime' property value has changed.+operationUtilisationTimeChanged_ :: Operation a b -> Signal ()+operationUtilisationTimeChanged_ op =+  mapSignal (const ()) (operationUtilised op)++-- | Return the statistics for the time when the operation activity was preempted+-- waiting for the further proceeding.+--+-- The value returned changes discretely and it is usually delayed relative+-- to the current simulation time.+--+-- See also 'operationPreemptionTimeChanged' and 'operationPreemptionTimeChanged_'.+operationPreemptionTime :: Operation a b -> Event (SamplingStats Double)+operationPreemptionTime op =+  Event $ \p -> readIORef (operationPreemptionTimeRef op)+  +-- | Signal when the 'operationPreemptionTime' property value has changed.+operationPreemptionTimeChanged :: Operation a b -> Signal (SamplingStats Double)+operationPreemptionTimeChanged op =+  mapSignalM (const $ operationPreemptionTime op) (operationPreemptionTimeChanged_ op)+  +-- | Signal when the 'operationPreemptionTime' property value has changed.+operationPreemptionTimeChanged_ :: Operation a b -> Signal ()+operationPreemptionTimeChanged_ op =+  mapSignal (const ()) (operationPreemptionEnding op)+  +-- | It returns the factor changing from 0 to 1, which estimates how often+-- the operation activity was utilised since the time of creating the operation.+--+-- The value returned changes discretely and it is usually delayed relative+-- to the current simulation time.+--+-- See also 'operationUtilisationFactorChanged' and 'operationUtilisationFactorChanged_'.+operationUtilisationFactor :: Operation a b -> Event Double+operationUtilisationFactor op =+  Event $ \p ->+  do let t0 = operationStartTime op+     t1 <- readIORef (operationLastTimeRef op)+     x  <- readIORef (operationTotalUtilisationTimeRef op)+     return (x / (t1 - t0))+  +-- | Signal when the 'operationUtilisationFactor' property value has changed.+operationUtilisationFactorChanged :: Operation a b -> Signal Double+operationUtilisationFactorChanged op =+  mapSignalM (const $ operationUtilisationFactor op) (operationUtilisationFactorChanged_ op)+  +-- | Signal when the 'operationUtilisationFactor' property value has changed.+operationUtilisationFactorChanged_ :: Operation a b -> Signal ()+operationUtilisationFactorChanged_ op =+  mapSignal (const ()) (operationUtilised op) <>+  mapSignal (const ()) (operationPreemptionEnding op)+  +-- | It returns the factor changing from 0 to 1, which estimates how often+-- the operation activity was preempted waiting for the further proceeding+-- since the time of creating the operation.+--+-- The value returned changes discretely and it is usually delayed relative+-- to the current simulation time.+--+-- See also 'operationPreemptionFactorChanged' and 'operationPreemptionFactorChanged_'.+operationPreemptionFactor :: Operation a b -> Event Double+operationPreemptionFactor op =+  Event $ \p ->+  do let t0 = operationStartTime op+     t1 <- readIORef (operationLastTimeRef op)+     x  <- readIORef (operationTotalPreemptionTimeRef op)+     return (x / (t1 - t0))+  +-- | Signal when the 'operationPreemptionFactor' property value has changed.+operationPreemptionFactorChanged :: Operation a b -> Signal Double+operationPreemptionFactorChanged op =+  mapSignalM (const $ operationPreemptionFactor op) (operationPreemptionFactorChanged_ op)+  +-- | Signal when the 'operationPreemptionFactor' property value has changed.+operationPreemptionFactorChanged_ :: Operation a b -> Signal ()+operationPreemptionFactorChanged_ op =+  mapSignal (const ()) (operationUtilised op) <>+  mapSignal (const ()) (operationPreemptionEnding op)+  +-- | Raised when starting to utilise the operation activity after a new input task is received.+operationUtilising :: Operation a b -> Signal a+operationUtilising = publishSignal . operationUtilisingSource++-- | Raised when the operation activity has been utilised after the current task is processed.+operationUtilised :: Operation a b -> Signal (a, b)+operationUtilised = publishSignal . operationUtilisedSource++-- | Raised when the operation activity utilisation was preempted.+operationPreemptionBeginning :: Operation a b -> Signal a+operationPreemptionBeginning = publishSignal . operationPreemptionBeginningSource++-- | Raised when the operation activity utilisation was proceeded after it had been preempted earlier.+operationPreemptionEnding :: Operation a b -> Signal a+operationPreemptionEnding = publishSignal . operationPreemptionEndingSource++-- | Signal whenever any property of the operation changes.+operationChanged_ :: Operation a b -> Signal ()+operationChanged_ op =+  mapSignal (const ()) (operationUtilising op) <>+  mapSignal (const ()) (operationUtilised op) <>+  mapSignal (const ()) (operationPreemptionEnding op)++-- | Return the summary for the operation with desciption of its+-- properties using the specified indent.+operationSummary :: Operation a b -> Int -> Event ShowS+operationSummary op indent =+  Event $ \p ->+  do let t0 = operationStartTime op+     t1  <- readIORef (operationLastTimeRef op)+     tx1 <- readIORef (operationTotalUtilisationTimeRef op)+     tx2 <- readIORef (operationTotalPreemptionTimeRef op)+     let xf1 = tx1 / (t1 - t0)+         xf2 = tx2 / (t1 - t0)+     xs1 <- readIORef (operationUtilisationTimeRef op)+     xs2 <- readIORef (operationPreemptionTimeRef op)+     let tab = replicate indent ' '+     return $+       showString tab .+       showString "total utilisation time = " . shows tx1 .+       showString "\n" .+       showString tab .+       showString "total preemption time = " . shows tx2 .+       showString "\n" .+       showString tab .+       showString "utilisation factor (from 0 to 1) = " . shows xf1 .+       showString "\n" .+       showString tab .+       showString "preemption factor (from 0 to 1) = " . shows xf2 .+       showString "\n" .+       showString tab .+       showString "utilisation time:\n\n" .+       samplingStatsSummary xs1 (2 + indent) .+       showString "\n\n" .+       showString tab .+       showString "preemption time:\n\n" .+       samplingStatsSummary xs2 (2 + indent)

@@ -0,0 +1,408 @@++-- |+-- Module     : Simulation.Aivika.Operation.Random+-- Copyright  : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 7.10.1+--+-- This module defines some useful predefined operations that+-- hold the current process for the corresponding random time+-- interval, when processing every input element.+--++module Simulation.Aivika.Operation.Random+       (newRandomUniformOperation,+        newRandomUniformIntOperation,+        newRandomTriangularOperation,+        newRandomNormalOperation,+        newRandomLogNormalOperation,+        newRandomExponentialOperation,+        newRandomErlangOperation,+        newRandomPoissonOperation,+        newRandomBinomialOperation,+        newRandomGammaOperation,+        newRandomBetaOperation,+        newRandomWeibullOperation,+        newRandomDiscreteOperation,+        newPreemptibleRandomUniformOperation,+        newPreemptibleRandomUniformIntOperation,+        newPreemptibleRandomTriangularOperation,+        newPreemptibleRandomNormalOperation,+        newPreemptibleRandomLogNormalOperation,+        newPreemptibleRandomExponentialOperation,+        newPreemptibleRandomErlangOperation,+        newPreemptibleRandomPoissonOperation,+        newPreemptibleRandomBinomialOperation,+        newPreemptibleRandomGammaOperation,+        newPreemptibleRandomBetaOperation,+        newPreemptibleRandomWeibullOperation,+        newPreemptibleRandomDiscreteOperation) where++import Simulation.Aivika.Generator+import Simulation.Aivika.Event+import Simulation.Aivika.Process+import Simulation.Aivika.Process.Random+import Simulation.Aivika.Operation++-- | Create a new operation that holds the process for a random time interval+-- distributed uniformly, when processing every input element.+--+-- By default, it is assumed that the operation process cannot be preempted,+-- because the handling of possible task preemption is rather costly.+newRandomUniformOperation :: Double+                             -- ^ the minimum time interval+                             -> Double+                             -- ^ the maximum time interval+                             -> Event (Operation a a)+newRandomUniformOperation =+  newPreemptibleRandomUniformOperation False++-- | Create a new operation that holds the process for a random time interval+-- distributed uniformly, when processing every input element.+--+-- By default, it is assumed that the operation process cannot be preempted,+-- because the handling of possible task preemption is rather costly.+newRandomUniformIntOperation :: Int+                                -- ^ the minimum time interval+                                -> Int+                                -- ^ the maximum time interval+                                -> Event (Operation a a)+newRandomUniformIntOperation =+  newPreemptibleRandomUniformIntOperation False++-- | Create a new operation that holds the process for a random time interval+-- having the triangular distribution, when processing every input element.+--+-- By default, it is assumed that the operation process cannot be preempted,+-- because the handling of possible task preemption is rather costly.+newRandomTriangularOperation :: Double+                                -- ^ the minimum time interval+                                -> Double+                                -- ^ the median of the time interval+                                -> Double+                                -- ^ the maximum time interval+                                -> Event (Operation a a)+newRandomTriangularOperation =+  newPreemptibleRandomTriangularOperation False++-- | Create a new operation that holds the process for a random time interval+-- distributed normally, when processing every input element.+--+-- By default, it is assumed that the operation process cannot be preempted,+-- because the handling of possible task preemption is rather costly.+newRandomNormalOperation :: Double+                            -- ^ the mean time interval+                            -> Double+                            -- ^ the time interval deviation+                            -> Event (Operation a a)+newRandomNormalOperation =+  newPreemptibleRandomNormalOperation False+         +-- | Create a new operation that holds the process for a random time interval+-- having the lognormal distribution, when processing every input element.+--+-- By default, it is assumed that the operation process cannot be preempted,+-- because the handling of possible task preemption is rather costly.+newRandomLogNormalOperation :: Double+                               -- ^ the mean of a normal distribution which+                               -- this distribution is derived from+                               -> Double+                               -- ^ the deviation of a normal distribution which+                               -- this distribution is derived from+                               -> Event (Operation a a)+newRandomLogNormalOperation =+  newPreemptibleRandomLogNormalOperation False++-- | Create a new operation that holds the process for a random time interval+-- distributed exponentially with the specified mean (the reciprocal of the rate),+-- when processing every input element.+--+-- By default, it is assumed that the operation process cannot be preempted,+-- because the handling of possible task preemption is rather costly.+newRandomExponentialOperation :: Double+                                 -- ^ the mean time interval (the reciprocal of the rate)+                                 -> Event (Operation a a)+newRandomExponentialOperation =+  newPreemptibleRandomExponentialOperation False+         +-- | Create a new operation that holds the process for a random time interval+-- having the Erlang distribution with the specified scale (the reciprocal of the rate)+-- and shape parameters, when processing every input element.+--+-- By default, it is assumed that the operation process cannot be preempted,+-- because the handling of possible task preemption is rather costly.+newRandomErlangOperation :: Double+                            -- ^ the scale (the reciprocal of the rate)+                            -> Int+                            -- ^ the shape+                            -> Event (Operation a a)+newRandomErlangOperation =+  newPreemptibleRandomErlangOperation False++-- | Create a new operation that holds the process for a random time interval+-- having the Poisson distribution with the specified mean, when processing+-- every input element.+--+-- By default, it is assumed that the operation process cannot be preempted,+-- because the handling of possible task preemption is rather costly.+newRandomPoissonOperation :: Double+                             -- ^ the mean time interval+                             -> Event (Operation a a)+newRandomPoissonOperation =+  newPreemptibleRandomPoissonOperation False++-- | Create a new operation that holds the process for a random time interval+-- having the binomial distribution with the specified probability and trials,+-- when processing every input element.+--+-- By default, it is assumed that the operation process cannot be preempted,+-- because the handling of possible task preemption is rather costly.+newRandomBinomialOperation :: Double+                              -- ^ the probability+                              -> Int+                              -- ^ the number of trials+                              -> Event (Operation a a)+newRandomBinomialOperation =+  newPreemptibleRandomBinomialOperation False++-- | Create a new operation that holds the process for a random time interval+-- having the Gamma distribution with the specified shape and scale,+-- when processing every input element.+--+-- By default, it is assumed that the operation process cannot be preempted,+-- because the handling of possible task preemption is rather costly.+newRandomGammaOperation :: Double+                           -- ^ the shape+                           -> Double+                           -- ^ the scale (a reciprocal of the rate)+                           -> Event (Operation a a)+newRandomGammaOperation =+  newPreemptibleRandomGammaOperation False++-- | Create a new operation that holds the process for a random time interval+-- having the Beta distribution with the specified shape parameters (alpha and beta),+-- when processing every input element.+--+-- By default, it is assumed that the operation process cannot be preempted,+-- because the handling of possible task preemption is rather costly.+newRandomBetaOperation :: Double+                          -- ^ shape (alpha)+                          -> Double+                          -- ^ shape (beta)+                          -> Event (Operation a a)+newRandomBetaOperation =+  newPreemptibleRandomBetaOperation False++-- | Create a new operation that holds the process for a random time interval+-- having the Weibull distribution with the specified shape and scale,+-- when processing every input element.+--+-- By default, it is assumed that the operation process cannot be preempted,+-- because the handling of possible task preemption is rather costly.+newRandomWeibullOperation :: Double+                             -- ^ shape+                             -> Double+                             -- ^ scale+                             -> Event (Operation a a)+newRandomWeibullOperation =+  newPreemptibleRandomWeibullOperation False++-- | Create a new operation that holds the process for a random time interval+-- having the specified discrete distribution, when processing every input element.+--+-- By default, it is assumed that the operation process cannot be preempted,+-- because the handling of possible task preemption is rather costly.+newRandomDiscreteOperation :: DiscretePDF Double+                              -- ^ the discrete probability density function+                              -> Event (Operation a a)+newRandomDiscreteOperation =+  newPreemptibleRandomDiscreteOperation False++-- | Create a new operation that holds the process for a random time interval+-- distributed uniformly, when processing every input element.+newPreemptibleRandomUniformOperation :: Bool+                                        -- ^ whether the operation process can be preempted+                                        -> Double+                                        -- ^ the minimum time interval+                                        -> Double+                                        -- ^ the maximum time interval+                                        -> Event (Operation a a)+newPreemptibleRandomUniformOperation preemptible min max =+  newPreemptibleOperation preemptible $ \a ->+  do randomUniformProcess_ min max+     return a++-- | Create a new operation that holds the process for a random time interval+-- distributed uniformly, when processing every input element.+newPreemptibleRandomUniformIntOperation :: Bool+                                           -- ^ whether the operation process can be preempted+                                           -> Int+                                           -- ^ the minimum time interval+                                           -> Int+                                           -- ^ the maximum time interval+                                           -> Event (Operation a a)+newPreemptibleRandomUniformIntOperation preemptible min max =+  newPreemptibleOperation preemptible $ \a ->+  do randomUniformIntProcess_ min max+     return a++-- | Create a new operation that holds the process for a random time interval+-- having the triangular distribution, when processing every input element.+newPreemptibleRandomTriangularOperation :: Bool+                                           -- ^ whether the operation process can be preempted+                                           -> Double+                                           -- ^ the minimum time interval+                                           -> Double+                                           -- ^ the median of the time interval+                                           -> Double+                                           -- ^ the maximum time interval+                                           -> Event (Operation a a)+newPreemptibleRandomTriangularOperation preemptible min median max =+  newPreemptibleOperation preemptible $ \a ->+  do randomTriangularProcess_ min median max+     return a++-- | Create a new operation that holds the process for a random time interval+-- distributed normally, when processing every input element.+newPreemptibleRandomNormalOperation :: Bool+                                       -- ^ whether the operation process can be preempted+                                       -> Double+                                       -- ^ the mean time interval+                                       -> Double+                                       -- ^ the time interval deviation+                                       -> Event (Operation a a)+newPreemptibleRandomNormalOperation preemptible mu nu =+  newPreemptibleOperation preemptible $ \a ->+  do randomNormalProcess_ mu nu+     return a++-- | Create a new operation that holds the process for a random time interval+-- having the lognormal distribution, when processing every input element.+newPreemptibleRandomLogNormalOperation :: Bool+                                          -- ^ whether the operation process can be preempted+                                          -> Double+                                          -- ^ the mean of a normal distribution which+                                          -- this distribution is derived from+                                          -> Double+                                          -- ^ the deviation of a normal distribution which+                                          -- this distribution is derived from+                                          -> Event (Operation a a)+newPreemptibleRandomLogNormalOperation preemptible mu nu =+  newPreemptibleOperation preemptible $ \a ->+  do randomLogNormalProcess_ mu nu+     return a++-- | Create a new operation that holds the process for a random time interval+-- distributed exponentially with the specified mean (the reciprocal of the rate),+-- when processing every input element.+newPreemptibleRandomExponentialOperation :: Bool+                                            -- ^ whether the operation process can be preempted+                                            -> Double+                                            -- ^ the mean time interval (the reciprocal of the rate)+                                            -> Event (Operation a a)+newPreemptibleRandomExponentialOperation preemptible mu =+  newPreemptibleOperation preemptible $ \a ->+  do randomExponentialProcess_ mu+     return a+         +-- | Create a new operation that holds the process for a random time interval+-- having the Erlang distribution with the specified scale (the reciprocal of the rate)+-- and shape parameters, when processing every input element.+newPreemptibleRandomErlangOperation :: Bool+                                       -- ^ whether the operation process can be preempted+                                       -> Double+                                       -- ^ the scale (the reciprocal of the rate)+                                       -> Int+                                       -- ^ the shape+                                       -> Event (Operation a a)+newPreemptibleRandomErlangOperation preemptible beta m =+  newPreemptibleOperation preemptible $ \a ->+  do randomErlangProcess_ beta m+     return a++-- | Create a new operation that holds the process for a random time interval+-- having the Poisson distribution with the specified mean, when processing+-- every input element.+newPreemptibleRandomPoissonOperation :: Bool+                                        -- ^ whether the operation process can be preempted+                                        -> Double+                                        -- ^ the mean time interval+                                        -> Event (Operation a a)+newPreemptibleRandomPoissonOperation preemptible mu =+  newPreemptibleOperation preemptible $ \a ->+  do randomPoissonProcess_ mu+     return a++-- | Create a new operation that holds the process for a random time interval+-- having the binomial distribution with the specified probability and trials,+-- when processing every input element.+newPreemptibleRandomBinomialOperation :: Bool+                                         -- ^ whether the operation process can be preempted+                                         -> Double+                                         -- ^ the probability+                                         -> Int+                                         -- ^ the number of trials+                                         -> Event (Operation a a)+newPreemptibleRandomBinomialOperation preemptible prob trials =+  newPreemptibleOperation preemptible $ \a ->+  do randomBinomialProcess_ prob trials+     return a++-- | Create a new operation that holds the process for a random time interval+-- having the Gamma distribution with the specified shape and scale,+-- when processing every input element.+newPreemptibleRandomGammaOperation :: Bool+                                      -- ^ whether the operation process can be preempted+                                      -> Double+                                      -- ^ the shape+                                      -> Double+                                      -- ^ the scale+                                      -> Event (Operation a a)+newPreemptibleRandomGammaOperation preemptible kappa theta =+  newPreemptibleOperation preemptible $ \a ->+  do randomGammaProcess_ kappa theta+     return a++-- | Create a new operation that holds the process for a random time interval+-- having the Beta distribution with the specified shape parameters (alpha and beta),+-- when processing every input element.+newPreemptibleRandomBetaOperation :: Bool+                                     -- ^ whether the operation process can be preempted+                                     -> Double+                                     -- ^ shape (alpha)+                                     -> Double+                                     -- ^ shape (beta)+                                     -> Event (Operation a a)+newPreemptibleRandomBetaOperation preemptible alpha beta =+  newPreemptibleOperation preemptible $ \a ->+  do randomBetaProcess_ alpha beta+     return a++-- | Create a new operation that holds the process for a random time interval+-- having the Weibull distribution with the specified shape and scale,+-- when processing every input element.+newPreemptibleRandomWeibullOperation :: Bool+                                        -- ^ whether the operation process can be preempted+                                        -> Double+                                        -- ^ shape+                                        -> Double+                                        -- ^ scale+                                        -> Event (Operation a a)+newPreemptibleRandomWeibullOperation preemptible alpha beta =+  newPreemptibleOperation preemptible $ \a ->+  do randomWeibullProcess_ alpha beta+     return a++-- | Create a new operation that holds the process for a random time interval+-- having the specified discrete distribution, when processing every input element.+newPreemptibleRandomDiscreteOperation :: Bool+                                         -- ^ whether the operation process can be preempted+                                         -> DiscretePDF Double+                                         -- ^ the discrete probability density function+                                         -> Event (Operation a a)+newPreemptibleRandomDiscreteOperation preemptible dpdf =+  newPreemptibleOperation preemptible $ \a ->+  do randomDiscreteProcess_ dpdf+     return a

@@ -21,6 +21,8 @@         queueFront,         queueDelete,         queueDeleteBy,+        queueContains,+        queueContainsBy,         remove,         removeBy) where  @@ -203,6 +205,24 @@                writeArray vals i v0                when (i > 0) $                  siftDown keys vals i index k v+               return (Just x)++-- | Detect whether the specified element is contained in the queue.+--+-- Note that unlike other functions it has complexity O(n).+queueContains :: Eq a => PriorityQueue a -> a -> IO Bool+queueContains pq a = fmap isJust $ queueContainsBy pq (== a)++-- | Detect whether an element satisfying the predicate is contained in the queue.+--+-- Note that unlike other functions it has complexity O(n).+queueContainsBy :: PriorityQueue a -> (a -> Bool) -> IO (Maybe a)+queueContainsBy pq pred =+  do index <- queueIndexBy pq pred+     if index < 0+       then return Nothing+       else do vals <- readIORef (pqVals pq)+               x <- readArray vals index                return (Just x)       -- | Return the index of the item satisfying the predicate or -1.     

@@ -141,12 +141,7 @@  -- | Accumulator that outputs a value determined by the supplied function. accumProcessor :: (acc -> a -> Process (acc, b)) -> acc -> Processor a b-accumProcessor f acc =-  Processor $ \xs -> Cons $ loop xs acc where-    loop xs acc =-      do (a, xs') <- runStream xs-         (acc', b) <- f acc a-         return (b, Cons $ loop xs' acc') +accumProcessor f acc = Processor $ accumStream f acc  -- | Involve the computation with side effect when processing a stream of data. withinProcessor :: Process () -> Processor a a

@@ -20,7 +20,7 @@ import Simulation.Aivika.Process import Simulation.Aivika.Processor import Simulation.Aivika.Stream-import Simulation.Aivika.Queue.Infinite+import Simulation.Aivika.Queue.Infinite.Base  -- | Represents the Round-Robbin processor that tries to perform the task within -- the specified timeout. If the task times out, then it is canceled and returned@@ -41,7 +41,7 @@ roundRobbinProcessorUsingIds =   Processor $ \xs ->   Cons $-  do q <- liftEvent newFCFSQueue+  do q <- liftSimulation newFCFSQueue      let process =            do t@(x, p) <- dequeue q               (timeout, pid) <- x

@@ -67,6 +67,8 @@         queueDelete_,         queueDeleteBy,         queueDeleteBy_,+        queueContains,+        queueContainsBy,         clearQueue,         -- * Awaiting         waitWhileFullQueue,@@ -671,6 +673,31 @@                   -- ^ the predicate                   -> Event () queueDeleteBy_ q pred = fmap (const ()) $ queueDeleteBy q pred++-- | Detect whether the item is contained in the queue.+queueContains :: (Eq a,+                  DeletingQueueStrategy sm)+                 => Queue si sm so a+                 -- ^ the queue+                 -> a+                 -- ^ the item to search the queue for+                 -> Event Bool+                 -- ^ whether the item was found+queueContains q a = fmap isJust $ queueContainsBy q (== a)++-- | Detect whether an item satisfying the specified predicate is contained in the queue.+queueContainsBy :: DeletingQueueStrategy sm+                   => Queue si sm so a+                   -- ^ the queue+                   -> (a -> Bool)+                   -- ^ the predicate+                   -> Event (Maybe a)+                   -- ^ the item if it was found+queueContainsBy q pred =+  do x <- strategyQueueContainsBy (queueStore q) (pred . itemValue)+     case x of+       Nothing -> return Nothing+       Just i  -> return $ Just (itemValue i)  -- | Clear the queue immediately. clearQueue :: (DequeueStrategy si,

@@ -0,0 +1,463 @@++-- |+-- Module     : Simulation.Aivika.Queue.Base+-- Copyright  : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 7.10.1+--+-- This module defines an optimised finite queue, which has no counters nor signals.+--+module Simulation.Aivika.Queue.Base+       (-- * Queue Types+        FCFSQueue,+        LCFSQueue,+        SIROQueue,+        PriorityQueue,+        Queue,+        -- * Creating Queue+        newFCFSQueue,+        newLCFSQueue,+        newSIROQueue,+        newPriorityQueue,+        newQueue,+        -- * Queue Properties and Activities+        enqueueStrategy,+        enqueueStoringStrategy,+        dequeueStrategy,+        queueNull,+        queueFull,+        queueMaxCount,+        queueCount,+        -- * Dequeuing and Enqueuing+        dequeue,+        dequeueWithOutputPriority,+        tryDequeue,+        enqueue,+        enqueueWithInputPriority,+        enqueueWithStoringPriority,+        enqueueWithInputStoringPriorities,+        tryEnqueue,+        tryEnqueueWithStoringPriority,+        queueDelete,+        queueDelete_,+        queueDeleteBy,+        queueDeleteBy_,+        queueContains,+        queueContainsBy,+        clearQueue) where++import Data.IORef+import Data.Monoid+import Data.Maybe++import Control.Monad+import Control.Monad.Trans++import Simulation.Aivika.Internal.Specs+import Simulation.Aivika.Internal.Simulation+import Simulation.Aivika.Internal.Dynamics+import Simulation.Aivika.Internal.Event+import Simulation.Aivika.Internal.Process+import Simulation.Aivika.Resource.Base+import Simulation.Aivika.QueueStrategy++import qualified Simulation.Aivika.DoubleLinkedList as DLL +import qualified Simulation.Aivika.Vector as V+import qualified Simulation.Aivika.PriorityQueue as PQ++-- | A type synonym for the ordinary FIFO queue also known as the FCFS+-- (First Come - First Serviced) queue.+type FCFSQueue a = Queue FCFS FCFS FCFS a++-- | A type synonym for the ordinary LIFO queue also known as the LCFS+-- (Last Come - First Serviced) queue.+type LCFSQueue a = Queue FCFS LCFS FCFS a++-- | A type synonym for the SIRO (Serviced in Random Order) queue.+type SIROQueue a = Queue FCFS SIRO FCFS a++-- | A type synonym for the queue with static priorities applied when+-- storing the elements in the queue.+type PriorityQueue a = Queue FCFS StaticPriorities FCFS a++-- | Represents a queue using the specified strategies for enqueueing (input), @si@,+-- internal storing (in memory), @sm@, and dequeueing (output), @so@, where @a@ denotes+-- the type of items stored in the queue.+data Queue si sm so a =+  Queue { queueMaxCount :: Int,+          -- ^ The queue capacity.+          enqueueStrategy :: si,+          -- ^ The strategy applied to the enqueueing (input) processes when the queue is full.+          enqueueStoringStrategy :: sm,+          -- ^ The strategy applied when storing (in memory) items in the queue.+          dequeueStrategy :: so,+          -- ^ The strategy applied to the dequeueing (output) processes when the queue is empty.+          enqueueRes :: Resource si,+          queueStore :: StrategyQueue sm a,+          dequeueRes :: Resource so,+          queueCountRef :: IORef Int+        }++-- | Create a new FCFS queue with the specified capacity.  +newFCFSQueue :: Int -> Simulation (FCFSQueue a)  +newFCFSQueue = newQueue FCFS FCFS FCFS+  +-- | Create a new LCFS queue with the specified capacity.  +newLCFSQueue :: Int -> Simulation (LCFSQueue a)  +newLCFSQueue = newQueue FCFS LCFS FCFS+  +-- | Create a new SIRO queue with the specified capacity.  +newSIROQueue :: Int -> Simulation (SIROQueue a)  +newSIROQueue = newQueue FCFS SIRO FCFS+  +-- | Create a new priority queue with the specified capacity.  +newPriorityQueue :: Int -> Simulation (PriorityQueue a)  +newPriorityQueue = newQueue FCFS StaticPriorities FCFS+  +-- | Create a new queue with the specified strategies and capacity.  +newQueue :: (QueueStrategy si,+             QueueStrategy sm,+             QueueStrategy so) =>+            si+            -- ^ the strategy applied to the enqueueing (input) processes when the queue is full+            -> sm+            -- ^ the strategy applied when storing items in the queue+            -> so+            -- ^ the strategy applied to the dequeueing (output) processes when the queue is empty+            -> Int+            -- ^ the queue capacity+            -> Simulation (Queue si sm so a)  +newQueue si sm so count =+  do i  <- liftIO $ newIORef 0+     ri <- newResourceWithMaxCount si count (Just count)+     qm <- newStrategyQueue sm+     ro <- newResourceWithMaxCount so 0 (Just count)+     return Queue { queueMaxCount = count,+                    enqueueStrategy = si,+                    enqueueStoringStrategy = sm,+                    dequeueStrategy = so,+                    enqueueRes = ri,+                    queueStore = qm,+                    dequeueRes = ro,+                    queueCountRef = i }+  +-- | Test whether the queue is empty.+--+-- See also 'queueNullChanged' and 'queueNullChanged_'.+queueNull :: Queue si sm so a -> Event Bool+queueNull q =+  Event $ \p ->+  do n <- readIORef (queueCountRef q)+     return (n == 0)+  +-- | Test whether the queue is full.+--+-- See also 'queueFullChanged' and 'queueFullChanged_'.+queueFull :: Queue si sm so a -> Event Bool+queueFull q =+  Event $ \p ->+  do n <- readIORef (queueCountRef q)+     return (n == queueMaxCount q)+  +-- | Return the current queue size.+--+-- See also 'queueCountStats', 'queueCountChanged' and 'queueCountChanged_'.+queueCount :: Queue si sm so a -> Event Int+queueCount q =+  Event $ \p -> readIORef (queueCountRef q)++-- | Dequeue suspending the process if the queue is empty.+dequeue :: (DequeueStrategy si,+            DequeueStrategy sm,+            EnqueueStrategy so)+           => Queue si sm so a+           -- ^ the queue+           -> Process a+           -- ^ the dequeued value+dequeue q =+  do requestResource (dequeueRes q)+     liftEvent $ dequeueExtract q+  +-- | Dequeue with the output priority suspending the process if the queue is empty.+dequeueWithOutputPriority :: (DequeueStrategy si,+                              DequeueStrategy sm,+                              PriorityQueueStrategy so po)+                             => Queue si sm so a+                             -- ^ the queue+                             -> po+                             -- ^ the priority for output+                             -> Process a+                             -- ^ the dequeued value+dequeueWithOutputPriority q po =+  do requestResourceWithPriority (dequeueRes q) po+     liftEvent $ dequeueExtract q+  +-- | Try to dequeue immediately.+tryDequeue :: (DequeueStrategy si,+               DequeueStrategy sm)+              => Queue si sm so a+              -- ^ the queue+              -> Event (Maybe a)+              -- ^ the dequeued value of 'Nothing'+tryDequeue q =+  do x <- tryRequestResourceWithinEvent (dequeueRes q)+     if x +       then fmap Just $ dequeueExtract q+       else return Nothing++-- | Remove the item from the queue and return a flag indicating+-- whether the item was found and actually removed.+queueDelete :: (Eq a,+                DequeueStrategy si,+                DeletingQueueStrategy sm,+                DequeueStrategy so)+               => Queue si sm so a+               -- ^ the queue+               -> a+               -- ^ the item to remove from the queue+               -> Event Bool+               -- ^ whether the item was found and removed+queueDelete q a = fmap isJust $ queueDeleteBy q (== a)++-- | Remove the specified item from the queue.+queueDelete_ :: (Eq a,+                 DequeueStrategy si,+                 DeletingQueueStrategy sm,+                 DequeueStrategy so)+                => Queue si sm so a+                -- ^ the queue+                -> a+                -- ^ the item to remove from the queue+                -> Event ()+queueDelete_ q a = fmap (const ()) $ queueDeleteBy q (== a)++-- | Remove an item satisfying the specified predicate and return the item if found.+queueDeleteBy :: (DequeueStrategy si,+                  DeletingQueueStrategy sm,+                  DequeueStrategy so)+                 => Queue si sm so a+                 -- ^ the queue+                 -> (a -> Bool)+                 -- ^ the predicate+                 -> Event (Maybe a)+queueDeleteBy q pred =+  do x <- tryRequestResourceWithinEvent (dequeueRes q)+     if x+       then do i <- strategyQueueDeleteBy (queueStore q) pred+               case i of+                 Nothing ->+                   do releaseResourceWithinEvent (dequeueRes q)+                      return Nothing+                 Just i ->+                   fmap Just $ dequeuePostExtract q i+       else return Nothing+               +-- | Remove an item satisfying the specified predicate.+queueDeleteBy_ :: (DequeueStrategy si,+                   DeletingQueueStrategy sm,+                   DequeueStrategy so)+                  => Queue si sm so a+                  -- ^ the queue+                  -> (a -> Bool)+                  -- ^ the predicate+                  -> Event ()+queueDeleteBy_ q pred = fmap (const ()) $ queueDeleteBy q pred++-- | Detect whether the item is contained in the queue.+queueContains :: (Eq a,+                  DeletingQueueStrategy sm)+                 => Queue si sm so a+                 -- ^ the queue+                 -> a+                 -- ^ the item to search the queue for+                 -> Event Bool+                 -- ^ whether the item was found+queueContains q a = fmap isJust $ queueContainsBy q (== a)++-- | Detect whether an item satisfying the specified predicate is contained in the queue.+queueContainsBy :: DeletingQueueStrategy sm+                   => Queue si sm so a+                   -- ^ the queue+                   -> (a -> Bool)+                   -- ^ the predicate+                   -> Event (Maybe a)+                   -- ^ the item if it was found+queueContainsBy q pred =+  strategyQueueContainsBy (queueStore q) pred++-- | Clear the queue immediately.+clearQueue :: (DequeueStrategy si,+               DequeueStrategy sm)+              => Queue si sm so a+              -- ^ the queue+              -> Event ()+clearQueue q =+  do x <- tryDequeue q+     case x of+       Nothing -> return ()+       Just a  -> clearQueue q+              +-- | Enqueue the item suspending the process if the queue is full.  +enqueue :: (EnqueueStrategy si,+            EnqueueStrategy sm,+            DequeueStrategy so)+           => Queue si sm so a+           -- ^ the queue+           -> a+           -- ^ the item to enqueue+           -> Process ()+enqueue q a =+  do requestResource (enqueueRes q)+     liftEvent $ enqueueStore q a+     +-- | Enqueue with the input priority the item suspending the process if the queue is full.  +enqueueWithInputPriority :: (PriorityQueueStrategy si pi,+                             EnqueueStrategy sm,+                             DequeueStrategy so)+                            => Queue si sm so a+                            -- ^ the queue+                            -> pi+                            -- ^ the priority for input+                            -> a+                            -- ^ the item to enqueue+                            -> Process ()+enqueueWithInputPriority q pi a =+  do requestResourceWithPriority (enqueueRes q) pi+     liftEvent $ enqueueStore q a+     +-- | Enqueue with the storing priority the item suspending the process if the queue is full.  +enqueueWithStoringPriority :: (EnqueueStrategy si,+                               PriorityQueueStrategy sm pm,+                               DequeueStrategy so)+                              => Queue si sm so a+                              -- ^ the queue+                              -> pm+                              -- ^ the priority for storing+                              -> a+                              -- ^ the item to enqueue+                              -> Process ()+enqueueWithStoringPriority q pm a =+  do requestResource (enqueueRes q)+     liftEvent $ enqueueStoreWithPriority q pm a+     +-- | Enqueue with the input and storing priorities the item suspending the process if the queue is full.  +enqueueWithInputStoringPriorities :: (PriorityQueueStrategy si pi,+                                      PriorityQueueStrategy sm pm,+                                      DequeueStrategy so)+                                     => Queue si sm so a+                                     -- ^ the queue+                                     -> pi+                                     -- ^ the priority for input+                                     -> pm+                                     -- ^ the priority for storing+                                     -> a+                                     -- ^ the item to enqueue+                                     -> Process ()+enqueueWithInputStoringPriorities q pi pm a =+  do requestResourceWithPriority (enqueueRes q) pi+     liftEvent $ enqueueStoreWithPriority q pm a+     +-- | Try to enqueue the item. Return 'False' in the monad if the queue is full.+tryEnqueue :: (EnqueueStrategy sm,+               DequeueStrategy so)+              => Queue si sm so a+              -- ^ the queue+              -> a+              -- ^ the item which we try to enqueue+              -> Event Bool+tryEnqueue q a =+  do x <- tryRequestResourceWithinEvent (enqueueRes q)+     if x +       then do enqueueStore q a+               return True+       else return False++-- | Try to enqueue with the storing priority the item. Return 'False' in+-- the monad if the queue is full.+tryEnqueueWithStoringPriority :: (PriorityQueueStrategy sm pm,+                                  DequeueStrategy so)+                                 => Queue si sm so a+                                 -- ^ the queue+                                 -> pm+                                 -- ^ the priority for storing+                                 -> a+                                 -- ^ the item which we try to enqueue+                                 -> Event Bool+tryEnqueueWithStoringPriority q pm a =+  do x <- tryRequestResourceWithinEvent (enqueueRes q)+     if x +       then do enqueueStoreWithPriority q pm a+               return True+       else return False++-- | Store the item.+enqueueStore :: (EnqueueStrategy sm,+                 DequeueStrategy so)+                => Queue si sm so a+                -- ^ the queue+                -> a+                -- ^ the item to be stored+                -> Event ()+enqueueStore q a =+  Event $ \p ->+  do invokeEvent p $+       strategyEnqueue (queueStore q) a+     c <- readIORef (queueCountRef q)+     let c' = c + 1+     c' `seq` writeIORef (queueCountRef q) c'+     invokeEvent p $+       releaseResourceWithinEvent (dequeueRes q)++-- | Store with the priority the item.+enqueueStoreWithPriority :: (PriorityQueueStrategy sm pm,+                             DequeueStrategy so)+                            => Queue si sm so a+                            -- ^ the queue+                            -> pm+                            -- ^ the priority for storing+                            -> a+                            -- ^ the item to be enqueued+                            -> Event ()+enqueueStoreWithPriority q pm a =+  Event $ \p ->+  do invokeEvent p $+       strategyEnqueueWithPriority (queueStore q) pm a+     c <- readIORef (queueCountRef q)+     let c' = c + 1+     c' `seq` writeIORef (queueCountRef q) c'+     invokeEvent p $+       releaseResourceWithinEvent (dequeueRes q)++-- | Extract an item for the dequeuing request.  +dequeueExtract :: (DequeueStrategy si,+                   DequeueStrategy sm)+                  => Queue si sm so a+                  -- ^ the queue+                  -> Event a+                  -- ^ the dequeued value+dequeueExtract q =+  Event $ \p ->+  do a <- invokeEvent p $+          strategyDequeue (queueStore q)+     invokeEvent p $+       dequeuePostExtract q a++-- | A post action after extracting the item by the dequeuing request.  +dequeuePostExtract :: (DequeueStrategy si,+                       DequeueStrategy sm)+                      => Queue si sm so a+                      -- ^ the queue+                      -> a+                      -- ^ the item to dequeue+                      -> Event a+                      -- ^ the dequeued value+dequeuePostExtract q a =+  Event $ \p ->+  do c <- readIORef (queueCountRef q)+     let c' = c - 1+     c' `seq` writeIORef (queueCountRef q) c'+     invokeEvent p $+       releaseResourceWithinEvent (enqueueRes q)+     return a

@@ -47,6 +47,8 @@         queueDelete_,         queueDeleteBy,         queueDeleteBy_,+        queueContains,+        queueContainsBy,         clearQueue,         -- * Summary         queueSummary,@@ -468,6 +470,31 @@                   -- ^ the predicate                   -> Event () queueDeleteBy_ q pred = fmap (const ()) $ queueDeleteBy q pred++-- | Detect whether the item is contained in the queue.+queueContains :: (Eq a,+                  DeletingQueueStrategy sm)+                 => Queue sm so a+                 -- ^ the queue+                 -> a+                 -- ^ the item to search the queue for+                 -> Event Bool+                 -- ^ whether the item was found+queueContains q a = fmap isJust $ queueContainsBy q (== a)++-- | Detect whether an item satisfying the specified predicate is contained in the queue.+queueContainsBy :: DeletingQueueStrategy sm+                   => Queue sm so a+                   -- ^ the queue+                   -> (a -> Bool)+                   -- ^ the predicate+                   -> Event (Maybe a)+                   -- ^ the item if it was found+queueContainsBy q pred =+  do x <- strategyQueueContainsBy (queueStore q) (pred . itemValue)+     case x of+       Nothing -> return Nothing+       Just i  -> return $ Just (itemValue i)  -- | Clear the queue immediately. clearQueue :: DequeueStrategy sm

@@ -0,0 +1,349 @@++-- |+-- Module     : Simulation.Aivika.Queue.Infinite.Base+-- Copyright  : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 7.10.1+--+-- This module defines an infinite optimised queue, which has no counters nor signals.+--+module Simulation.Aivika.Queue.Infinite.Base+       (-- * Queue Types+        FCFSQueue,+        LCFSQueue,+        SIROQueue,+        PriorityQueue,+        Queue,+        -- * Creating Queue+        newFCFSQueue,+        newLCFSQueue,+        newSIROQueue,+        newPriorityQueue,+        newQueue,+        -- * Queue Properties and Activities+        enqueueStoringStrategy,+        dequeueStrategy,+        queueNull,+        queueCount,+        -- * Dequeuing and Enqueuing+        dequeue,+        dequeueWithOutputPriority,+        tryDequeue,+        enqueue,+        enqueueWithStoringPriority,+        queueDelete,+        queueDelete_,+        queueDeleteBy,+        queueDeleteBy_,+        queueContains,+        queueContainsBy,+        clearQueue) where++import Data.IORef+import Data.Monoid+import Data.Maybe++import Control.Monad+import Control.Monad.Trans++import Simulation.Aivika.Internal.Specs+import Simulation.Aivika.Internal.Simulation+import Simulation.Aivika.Internal.Dynamics+import Simulation.Aivika.Internal.Event+import Simulation.Aivika.Internal.Process+import Simulation.Aivika.Resource.Base+import Simulation.Aivika.QueueStrategy++import qualified Simulation.Aivika.DoubleLinkedList as DLL +import qualified Simulation.Aivika.Vector as V+import qualified Simulation.Aivika.PriorityQueue as PQ++-- | A type synonym for the ordinary FIFO queue also known as the FCFS+-- (First Come - First Serviced) queue.+type FCFSQueue a = Queue FCFS FCFS a++-- | A type synonym for the ordinary LIFO queue also known as the LCFS+-- (Last Come - First Serviced) queue.+type LCFSQueue a = Queue LCFS FCFS a++-- | A type synonym for the SIRO (Serviced in Random Order) queue.+type SIROQueue a = Queue SIRO FCFS a++-- | A type synonym for the queue with static priorities applied when+-- storing the elements in the queue.+type PriorityQueue a = Queue StaticPriorities FCFS a++-- | Represents an infinite queue using the specified strategies for+-- internal storing (in memory), @sm@, and dequeueing (output), @so@, where @a@ denotes+-- the type of items stored in the queue.+data Queue sm so a =+  Queue { enqueueStoringStrategy :: sm,+          -- ^ The strategy applied when storing (in memory) items in the queue.+          dequeueStrategy :: so,+          -- ^ The strategy applied to the dequeueing (output) processes.+          queueStore :: StrategyQueue sm a,+          dequeueRes :: Resource so,+          queueCountRef :: IORef Int }+  +-- | Create a new infinite FCFS queue.  +newFCFSQueue :: Simulation (FCFSQueue a)  +newFCFSQueue = newQueue FCFS FCFS+  +-- | Create a new infinite LCFS queue.  +newLCFSQueue :: Simulation (LCFSQueue a)  +newLCFSQueue = newQueue LCFS FCFS+  +-- | Create a new infinite SIRO queue.  +newSIROQueue :: Simulation (SIROQueue a)  +newSIROQueue = newQueue SIRO FCFS+  +-- | Create a new infinite priority queue.  +newPriorityQueue :: Simulation (PriorityQueue a)  +newPriorityQueue = newQueue StaticPriorities FCFS+  +-- | Create a new infinite queue with the specified strategies.  +newQueue :: (QueueStrategy sm,+             QueueStrategy so) =>+            sm+            -- ^ the strategy applied when storing items in the queue+            -> so+            -- ^ the strategy applied to the dequeueing (output) processes when the queue is empty+            -> Simulation (Queue sm so a)  +newQueue sm so =+  do i  <- liftIO $ newIORef 0+     qm <- newStrategyQueue sm+     ro <- newResourceWithMaxCount so 0 Nothing+     return Queue { enqueueStoringStrategy = sm,+                    dequeueStrategy = so,+                    queueStore = qm,+                    dequeueRes = ro,+                    queueCountRef = i }++-- | Test whether the queue is empty.+--+-- See also 'queueNullChanged' and 'queueNullChanged_'.+queueNull :: Queue sm so a -> Event Bool+queueNull q =+  Event $ \p ->+  do n <- readIORef (queueCountRef q)+     return (n == 0)+  +-- | Return the current queue size.+--+-- See also 'queueCountStats', 'queueCountChanged' and 'queueCountChanged_'.+queueCount :: Queue sm so a -> Event Int+queueCount q =+  Event $ \p -> readIORef (queueCountRef q)++-- | Dequeue suspending the process if the queue is empty.+dequeue :: (DequeueStrategy sm,+            EnqueueStrategy so)+           => Queue sm so a+           -- ^ the queue+           -> Process a+           -- ^ the dequeued value+dequeue q =+  do requestResource (dequeueRes q)+     liftEvent $ dequeueExtract q+  +-- | Dequeue with the output priority suspending the process if the queue is empty.+dequeueWithOutputPriority :: (DequeueStrategy sm,+                              PriorityQueueStrategy so po)+                             => Queue sm so a+                             -- ^ the queue+                             -> po+                             -- ^ the priority for output+                             -> Process a+                             -- ^ the dequeued value+dequeueWithOutputPriority q po =+  do requestResourceWithPriority (dequeueRes q) po+     liftEvent $ dequeueExtract q+  +-- | Try to dequeue immediately.+tryDequeue :: DequeueStrategy sm+              => Queue sm so a+              -- ^ the queue+              -> Event (Maybe a)+              -- ^ the dequeued value of 'Nothing'+tryDequeue q =+  do x <- tryRequestResourceWithinEvent (dequeueRes q)+     if x +       then fmap Just $ dequeueExtract q+       else return Nothing++-- | Remove the item from the queue and return a flag indicating+-- whether the item was found and actually removed.+queueDelete :: (Eq a,+                DeletingQueueStrategy sm,+                DequeueStrategy so)+               => Queue sm so a+               -- ^ the queue+               -> a+               -- ^ the item to remove from the queue+               -> Event Bool+               -- ^ whether the item was found and removed+queueDelete q a = fmap isJust $ queueDeleteBy q (== a)++-- | Remove the specified item from the queue.+queueDelete_ :: (Eq a,+                 DeletingQueueStrategy sm,+                 DequeueStrategy so)+                => Queue sm so a+                -- ^ the queue+                -> a+                -- ^ the item to remove from the queue+                -> Event ()+queueDelete_ q a = fmap (const ()) $ queueDeleteBy q (== a)++-- | Remove an item satisfying the specified predicate and return the item if found.+queueDeleteBy :: (DeletingQueueStrategy sm,+                  DequeueStrategy so)+                 => Queue sm so a+                 -- ^ the queue+                 -> (a -> Bool)+                 -- ^ the predicate+                 -> Event (Maybe a)+queueDeleteBy q pred =+  do x <- tryRequestResourceWithinEvent (dequeueRes q)+     if x+       then do i <- strategyQueueDeleteBy (queueStore q) pred+               case i of+                 Nothing ->+                   do releaseResourceWithinEvent (dequeueRes q)+                      return Nothing+                 Just i ->+                   fmap Just $ dequeuePostExtract q i+       else return Nothing+               +-- | Remove an item satisfying the specified predicate.+queueDeleteBy_ :: (DeletingQueueStrategy sm,+                   DequeueStrategy so)+                  => Queue sm so a+                  -- ^ the queue+                  -> (a -> Bool)+                  -- ^ the predicate+                  -> Event ()+queueDeleteBy_ q pred = fmap (const ()) $ queueDeleteBy q pred++-- | Detect whether the item is contained in the queue.+queueContains :: (Eq a,+                  DeletingQueueStrategy sm)+                 => Queue sm so a+                 -- ^ the queue+                 -> a+                 -- ^ the item to search the queue for+                 -> Event Bool+                 -- ^ whether the item was found+queueContains q a = fmap isJust $ queueContainsBy q (== a)++-- | Detect whether an item satisfying the specified predicate is contained in the queue.+queueContainsBy :: DeletingQueueStrategy sm+                   => Queue sm so a+                   -- ^ the queue+                   -> (a -> Bool)+                   -- ^ the predicate+                   -> Event (Maybe a)+                   -- ^ the item if it was found+queueContainsBy q pred =+  strategyQueueContainsBy (queueStore q) pred++-- | Clear the queue immediately.+clearQueue :: DequeueStrategy sm+              => Queue sm so a+              -- ^ the queue+              -> Event ()+clearQueue q =+  do x <- tryDequeue q+     case x of+       Nothing -> return ()+       Just a  -> clearQueue q++-- | Enqueue the item.  +enqueue :: (EnqueueStrategy sm,+            DequeueStrategy so)+           => Queue sm so a+           -- ^ the queue+           -> a+           -- ^ the item to enqueue+           -> Event ()+enqueue = enqueueStore+     +-- | Enqueue with the storing priority the item.  +enqueueWithStoringPriority :: (PriorityQueueStrategy sm pm,+                               DequeueStrategy so)+                              => Queue sm so a+                              -- ^ the queue+                              -> pm+                              -- ^ the priority for storing+                              -> a+                              -- ^ the item to enqueue+                              -> Event ()+enqueueWithStoringPriority = enqueueStoreWithPriority++-- | Store the item.+enqueueStore :: (EnqueueStrategy sm,+                 DequeueStrategy so)+                => Queue sm so a+                -- ^ the queue+                -> a+                -- ^ the item to be stored+                -> Event ()+enqueueStore q a =+  Event $ \p ->+  do invokeEvent p $+       strategyEnqueue (queueStore q) a+     c <- readIORef (queueCountRef q)+     let c' = c + 1+     c' `seq` writeIORef (queueCountRef q) c'+     invokeEvent p $+       releaseResourceWithinEvent (dequeueRes q)++-- | Store with the priority the item.+enqueueStoreWithPriority :: (PriorityQueueStrategy sm pm,+                             DequeueStrategy so)+                            => Queue sm so a+                            -- ^ the queue+                            -> pm+                            -- ^ the priority for storing+                            -> a+                            -- ^ the item to be enqueued+                            -> Event ()+enqueueStoreWithPriority q pm a =+  Event $ \p ->+  do invokeEvent p $+       strategyEnqueueWithPriority (queueStore q) pm a+     c <- readIORef (queueCountRef q)+     let c' = c + 1+     c' `seq` writeIORef (queueCountRef q) c'+     invokeEvent p $+       releaseResourceWithinEvent (dequeueRes q)++-- | Extract an item for the dequeuing request.  +dequeueExtract :: DequeueStrategy sm+                  => Queue sm so a+                  -- ^ the queue+                  -> Event a+                  -- ^ the dequeued value+dequeueExtract q =+  Event $ \p ->+  do a <- invokeEvent p $+          strategyDequeue (queueStore q)+     invokeEvent p $+       dequeuePostExtract q a++-- | A post action after extracting the item by the dequeuing request.  +dequeuePostExtract :: DequeueStrategy sm+                      => Queue sm so a+                      -- ^ the queue+                      -> a+                      -- ^ the item to dequeue+                      -> Event a+                      -- ^ the dequeued value+dequeuePostExtract q a =+  Event $ \p ->+  do c <- readIORef (queueCountRef q)+     let c' = c - 1+     c' `seq` writeIORef (queueCountRef q) c'+     return a

@@ -96,6 +96,24 @@                            -> Event (Maybe i)                            -- ^ the element if it was found and removed +  -- | Detect whether the specified element is contained in the queue.+  strategyQueueContains :: Eq i+                           => StrategyQueue s i+                           -- ^ the queue+                           -> i+                           -- ^ the element to find+                           -> Event Bool+                           -- ^ whether the element is contained in the queue+  strategyQueueContains s i = fmap isJust $ strategyQueueContainsBy s (== i)++  -- | Detect whether an element satifying the specified predicate is contained in the queue.+  strategyQueueContainsBy :: StrategyQueue s i+                             -- ^ the queue+                             -> (i -> Bool)+                             -- ^ the predicate+                             -> Event (Maybe i)+                             -- ^ the element if it was found+ -- | Strategy: First Come - First Served (FCFS). data FCFS = FCFS deriving (Eq, Ord, Show) @@ -137,6 +155,8 @@    strategyQueueDeleteBy (FCFSQueue q) p = liftIO $ listRemoveBy q p +  strategyQueueContainsBy (FCFSQueue q) p = liftIO $ listContainsBy q p+ -- | An implementation of the 'LCFS' queue strategy. instance QueueStrategy LCFS where @@ -166,6 +186,8 @@    strategyQueueDeleteBy (LCFSQueue q) p = liftIO $ listRemoveBy q p +  strategyQueueContainsBy (LCFSQueue q) p = liftIO $ listContainsBy q p+ -- | An implementation of the 'StaticPriorities' queue strategy. instance QueueStrategy StaticPriorities where @@ -195,6 +217,8 @@    strategyQueueDeleteBy (StaticPriorityQueue q) p = liftIO $ PQ.queueDeleteBy q p +  strategyQueueContainsBy (StaticPriorityQueue q) p = liftIO $ PQ.queueContainsBy q p+ -- | An implementation of the 'SIRO' queue strategy. instance QueueStrategy SIRO where @@ -228,3 +252,5 @@ instance DeletingQueueStrategy SIRO where    strategyQueueDeleteBy (SIROQueue q) p = liftIO $ V.vectorDeleteBy q p++  strategyQueueContainsBy (SIROQueue q) p = liftIO $ V.vectorContainsBy q p

@@ -134,6 +134,7 @@ import Simulation.Aivika.Activity import Simulation.Aivika.Resource import qualified Simulation.Aivika.Resource.Preemption as PR+import Simulation.Aivika.Operation import Simulation.Aivika.Results.Locale  -- | A name used for indentifying the results when generating output.@@ -1822,6 +1823,44 @@       resultContainerProperty c "countStats" ResourceCountStatsId PR.resourceCountStats PR.resourceCountChanged_,       resultContainerProperty c "utilisationCountStats" ResourceUtilisationCountStatsId PR.resourceUtilisationCountStats PR.resourceUtilisationCountChanged_ ] } +-- | Return a source by the specified operation.+operationResultSource :: ResultContainer (Operation a b)+                         -- ^ the operation container+                         -> ResultSource+operationResultSource c =+  ResultObjectSource $+  ResultObject {+    resultObjectName = resultContainerName c,+    resultObjectId = resultContainerId c,+    resultObjectTypeId = OperationId,+    resultObjectSignal = resultContainerSignal c,+    resultObjectSummary = operationResultSummary c,+    resultObjectProperties = [+      resultContainerProperty c "totalUtilisationTime" OperationTotalUtilisationTimeId operationTotalUtilisationTime operationTotalUtilisationTimeChanged_,+      resultContainerProperty c "totalPreemptionTime" OperationTotalPreemptionTimeId operationTotalPreemptionTime operationTotalPreemptionTimeChanged_,+      resultContainerProperty c "utilisationTime" OperationUtilisationTimeId operationUtilisationTime operationUtilisationTimeChanged_,+      resultContainerProperty c "preemptionTime" OperationPreemptionTimeId operationPreemptionTime operationPreemptionTimeChanged_,+      resultContainerProperty c "utilisationFactor" OperationUtilisationFactorId operationUtilisationFactor operationUtilisationFactorChanged_,+      resultContainerProperty c "preemptionFactor" OperationPreemptionFactorId operationPreemptionFactor operationPreemptionFactorChanged_ ] }++-- | Return a summary by the specified operation.+operationResultSummary :: ResultContainer (Operation a b)+                          -- ^ the operation container+                          -> ResultSource+operationResultSummary c =+  ResultObjectSource $+  ResultObject {+    resultObjectName = resultContainerName c,+    resultObjectId = resultContainerId c,+    resultObjectTypeId = OperationId,+    resultObjectSignal = resultContainerSignal c,+    resultObjectSummary = operationResultSummary c,+    resultObjectProperties = [+      resultContainerProperty c "utilisationTime" OperationUtilisationTimeId operationUtilisationTime operationUtilisationTimeChanged_,+      resultContainerProperty c "preemptionTime" OperationPreemptionTimeId operationPreemptionTime operationPreemptionTimeChanged_,+      resultContainerProperty c "utilisationFactor" OperationUtilisationFactorId operationUtilisationFactor operationUtilisationFactorChanged_,+      resultContainerProperty c "preemptionFactor" OperationPreemptionFactorId operationPreemptionFactor operationPreemptionFactorChanged_ ] }+ -- | Return an arbitrary text as a separator source. textResultSource :: String -> ResultSource textResultSource text =@@ -2062,3 +2101,8 @@    resultSource' name i m =     preemptibleResourceResultSource $ ResultContainer name i m (ResultSignal $ PR.resourceChanged_ m)++instance ResultProvider (Operation a b) where++  resultSource' name i m =+    operationResultSource $ ResultContainer name i m (ResultSignal $ operationChanged_ m)

@@ -35,6 +35,7 @@ import Simulation.Aivika.Server import Simulation.Aivika.Activity import Simulation.Aivika.Resource+import Simulation.Aivika.Operation  -- | A locale to output the simulation results. --@@ -234,6 +235,20 @@                 -- ^ Property 'resourceTotalWaitTime'.               | ResourceWaitTimeId                 -- ^ Property 'resourceWaitTime'.+              | OperationId+                -- ^ Represents an 'Operation'.+              | OperationTotalUtilisationTimeId+                -- ^ Property 'operationTotalUtilisationTime'.+              | OperationTotalPreemptionTimeId+                -- ^ Property 'operationTotalPreemptionTime'.+              | OperationUtilisationTimeId+                -- ^ Property 'operationUtilisationTime'.+              | OperationPreemptionTimeId+                -- ^ Property 'operationPreemptionTime'.+              | OperationUtilisationFactorId+                -- ^ Property 'operationUtilisationFactor'.+              | OperationPreemptionFactorId+                -- ^ Property 'operationPreemptionFactor'.               | UserDefinedResultId ResultDescription                 -- ^ An user defined description.               | LocalisedResultId (M.Map ResultLocale ResultDescription)@@ -343,6 +358,13 @@ russianResultLocalisation ResourceQueueCountStatsId = "статистика длины очереди к ресурсу" russianResultLocalisation ResourceTotalWaitTimeId = "общее время ожидания ресурса" russianResultLocalisation ResourceWaitTimeId = "время ожидания ресурса"+russianResultLocalisation OperationId = "операция"+russianResultLocalisation OperationTotalUtilisationTimeId = "общее время использования"+russianResultLocalisation OperationTotalPreemptionTimeId = "общее время вытеснения"+russianResultLocalisation OperationUtilisationTimeId = "статистика времени использования"+russianResultLocalisation OperationPreemptionTimeId = "статистика времени вытеснения"+russianResultLocalisation OperationUtilisationFactorId = "относительное время использования (от 0 до 1)"+russianResultLocalisation OperationPreemptionFactorId = "относительное время вытеснения (от 0 до 1)" russianResultLocalisation (UserDefinedResultId m) = m russianResultLocalisation x@(LocalisedResultId m) =   lookupResultLocalisation russianResultLocale x@@ -430,9 +452,9 @@ englishResultLocalisation ActivityUtilisationTimeId = "the utilisation time" englishResultLocalisation ActivityIdleTimeId = "the idle time" englishResultLocalisation ActivityPreemptionTimeId = "the preemption time"-englishResultLocalisation ActivityUtilisationFactorId = "the relative utilisation time (от 0 до 1)"+englishResultLocalisation ActivityUtilisationFactorId = "the relative utilisation time (from 0 to 1)" englishResultLocalisation ActivityIdleFactorId = "the relative idle time (от 0 до 1)"-englishResultLocalisation ActivityPreemptionFactorId = "the relative preemption time (от 0 до 1)"+englishResultLocalisation ActivityPreemptionFactorId = "the relative preemption time (from 0 to 1)" englishResultLocalisation ResourceId = "the resource" englishResultLocalisation ResourceCountId = "the current available count" englishResultLocalisation ResourceCountStatsId = "the available count statistics"@@ -442,6 +464,13 @@ englishResultLocalisation ResourceQueueCountStatsId = "the queue length statistics" englishResultLocalisation ResourceTotalWaitTimeId = "the total wait time" englishResultLocalisation ResourceWaitTimeId = "the wait time"+englishResultLocalisation OperationId = "the operation"+englishResultLocalisation OperationTotalUtilisationTimeId = "the total time of utilisation"+englishResultLocalisation OperationTotalPreemptionTimeId = "the total time of preemption"+englishResultLocalisation OperationUtilisationTimeId = "the utilisation time"+englishResultLocalisation OperationPreemptionTimeId = "the preemption time"+englishResultLocalisation OperationUtilisationFactorId = "the relative utilisation time (from 0 to 1)"+englishResultLocalisation OperationPreemptionFactorId = "the relative preemption time (from 0 to 1)" englishResultLocalisation (UserDefinedResultId m) = m englishResultLocalisation x@(LocalisedResultId m) =   lookupResultLocalisation englishResultLocale x

@@ -112,7 +112,15 @@         resourceQueueCount,         resourceQueueCountStats,         resourceTotalWaitTime,-        resourceWaitTime) where+        resourceWaitTime,+        -- * Operation+        Operation(..),+        operationTotalUtilisationTime,+        operationTotalPreemptionTime,+        operationUtilisationTime,+        operationPreemptionTime,+        operationUtilisationFactor,+        operationPreemptionFactor) where  import Control.Arrow @@ -608,3 +616,43 @@ resourceWaitTime :: Resource -> SamplingStats resourceWaitTime (Resource a) =   SamplingStats (a >>> resultById ResourceWaitTimeId)++-- | It models an opreation which actvity can be utilised.+newtype Operation = Operation ResultTransform++instance ResultTransformer Operation where+  tr (Operation a) = a++-- | Return the counted total time when the operation activity was utilised.+operationTotalUtilisationTime :: Operation -> ResultTransform+operationTotalUtilisationTime (Operation a) =+  a >>> resultById OperationTotalUtilisationTimeId++-- | Return the counted total time when the operation activity was preemted+-- waiting for the further proceeding.+operationTotalPreemptionTime :: Operation -> ResultTransform+operationTotalPreemptionTime (Operation a) =+  a >>> resultById OperationTotalPreemptionTimeId++-- | Return the statistics for the time when the operation activity was utilised.+operationUtilisationTime :: Operation -> SamplingStats+operationUtilisationTime (Operation a) =+  SamplingStats (a >>> resultById OperationUtilisationTimeId)++-- | Return the statistics for the time when the operation activity was preempted+-- waiting for the further proceeding.+operationPreemptionTime :: Operation -> SamplingStats+operationPreemptionTime (Operation a) =+  SamplingStats (a >>> resultById OperationPreemptionTimeId)++-- | It returns the factor changing from 0 to 1, which estimates how often+-- the operation activity was utilised.+operationUtilisationFactor :: Operation -> ResultTransform+operationUtilisationFactor (Operation a) =+  a >>> resultById OperationUtilisationFactorId++-- | It returns the factor changing from 0 to 1, which estimates how often+-- the operation activity was preempted waiting for the further proceeding.+operationPreemptionFactor :: Operation -> ResultTransform+operationPreemptionFactor (Operation a) =+  a >>> resultById OperationPreemptionFactorId

@@ -46,6 +46,7 @@         repeatProcess,         mapStream,         mapStreamM,+        accumStream,         apStream,         apStreamM,         filterStream,@@ -69,6 +70,11 @@         replaceLeftStream,         replaceRightStream,         partitionEitherStream,+        -- * Assemblying Streams+        cloneStream,+        firstArrivalStream,+        lastArrivalStream,+        assembleAccumStream,         -- * Debugging         traceStream) where @@ -88,7 +94,7 @@ import Simulation.Aivika.Signal import Simulation.Aivika.Resource.Base import Simulation.Aivika.QueueStrategy-import Simulation.Aivika.Queue.Infinite+import Simulation.Aivika.Queue.Infinite.Base import Simulation.Aivika.Internal.Arrival  -- | Represents an infinite stream of data in time,@@ -213,6 +219,14 @@          b <- f a          return (b, mapStreamM f xs) +-- | Accumulator that outputs a value determined by the supplied function.+accumStream :: (acc -> a -> Process (acc, b)) -> acc -> Stream a -> Stream b+accumStream f acc xs = Cons $ loop xs acc where+  loop (Cons s) acc =+    do (a, xs) <- s+       (acc', b) <- f acc a+       return (b, Cons $ loop xs acc') + -- | Sequential application. apStream :: Stream (a -> b) -> Stream a -> Stream b apStream (Cons sf) (Cons sa) = Cons y where@@ -513,7 +527,7 @@ -- Cancel the stream's process to unsubscribe from the specified signal. signalStream :: Signal a -> Process (Stream a) signalStream s =-  do q <- liftEvent newFCFSQueue+  do q <- liftSimulation newFCFSQueue      h <- liftEvent $           handleSignal s $            enqueue q@@ -657,6 +671,56 @@      if f        then runStream $ dropStreamWhileM p xs        else return (a, xs)++-- | Create the specified number of equivalent clones of the input stream.+cloneStream :: Int -> Stream a -> Simulation [Stream a]+cloneStream n s =+  do qs  <- forM [1..n] $ \i -> newFCFSQueue+     rs  <- newFCFSResource 1+     ref <- liftIO $ newIORef s+     let reader m q =+           do a <- liftEvent $ tryDequeue q+              case a of+                Just a  -> return a+                Nothing ->+                  usingResource rs $+                  do a <- liftEvent $ tryDequeue q+                     case a of+                       Just a  -> return a+                       Nothing ->+                         do s <- liftIO $ readIORef ref+                            (a, xs) <- runStream s+                            liftIO $ writeIORef ref xs+                            forM_ (zip [1..] qs) $ \(i, q) ->+                              unless (i == m) $+                              liftEvent $ enqueue q a+                            return a+     forM (zip [1..] qs) $ \(i, q) ->+       return $ repeatProcess $ reader i q++-- | Return a stream of first arrivals after assembling the specified number of elements.+firstArrivalStream :: Int -> Stream a -> Stream a+firstArrivalStream n s = assembleAccumStream f (1, Nothing) s+  where f (i, a0) a =+          let a0' = Just $ fromMaybe a a0+          in if i `mod` n == 0+             then return ((1, Nothing), a0')+             else return ((i + 1, a0'), Nothing)++-- | Return a stream of last arrivals after assembling the specified number of elements.+lastArrivalStream :: Int -> Stream a -> Stream a+lastArrivalStream n s = assembleAccumStream f 1 s+  where f i a =+          if i `mod` n == 0+          then return (1, Just a)+          else return (i + 1, Nothing)++-- | Assemble an accumulated stream using the supplied function.+assembleAccumStream :: (acc -> a -> Process (acc, Maybe b)) -> acc -> Stream a -> Stream b+assembleAccumStream f acc s =+  mapStream fromJust $+  filterStream isJust $+  accumStream f acc s  -- | Show the debug messages with the current simulation time. traceStream :: Maybe String

@@ -26,6 +26,8 @@         vectorDeleteBy,         vectorIndex,         vectorIndexBy,+        vectorContains,+        vectorContainsBy,         freezeVector) where   import Data.Array@@ -218,5 +220,20 @@      if index >= 0        then do a <- readVector vector index                vectorDeleteAt vector index+               return (Just a)+       else return Nothing++-- | Detect whether the specified element is contained in the vector.+vectorContains :: Eq a => Vector a -> a -> IO Bool+vectorContains vector item =+  do index <- vectorIndex vector item+     return (index >= 0)+            +-- | Detect whether an element satisfying the specified predicate is contained in the vector.+vectorContainsBy :: Vector a -> (a -> Bool) -> IO (Maybe a)+vectorContainsBy vector pred =+  do index <- vectorIndexBy vector pred+     if index >= 0+       then do a <- readVector vector index                return (Just a)        else return Nothing

@@ -26,6 +26,8 @@         vectorDeleteBy,         vectorIndex,         vectorIndexBy,+        vectorContains,+        vectorContainsBy,         freezeVector) where   import Data.Array@@ -222,3 +224,18 @@        then do vectorDeleteAt vector index                return True        else return False++-- | Detect whether the specified element is contained in the vector.+vectorContains :: (Unboxed a, Eq a) => Vector a -> a -> IO Bool+vectorContains vector item =+  do index <- vectorIndex vector item+     return (index >= 0)+            +-- | Detect whether an element satisfying the specified predicate is contained in the vector.+vectorContainsBy :: Unboxed a => Vector a -> (a -> Bool) -> IO (Maybe a)+vectorContainsBy vector pred =+  do index <- vectorIndexBy vector pred+     if index >= 0+       then do a <- readVector vector index+               return (Just a)+       else return Nothing

@@ -1,5 +1,5 @@ name:            aivika-version:         4.2+version:         4.3 synopsis:        A multi-paradigm simulation library description:     Aivika is a multi-paradigm simulation library with a strong emphasis@@ -121,6 +121,7 @@                      examples/PortOperations.hs                      examples/SingleLaneTraffic.hs                      examples/RenegingFromQueue.hs+                     examples/TruckHaulingSituation.hs                      CHANGELOG.md  library@@ -143,6 +144,8 @@                      Simulation.Aivika.Generator                      Simulation.Aivika.Net                      Simulation.Aivika.Net.Random+                     Simulation.Aivika.Operation+                     Simulation.Aivika.Operation.Random                      Simulation.Aivika.Parameter                      Simulation.Aivika.Parameter.Random                      Simulation.Aivika.PriorityQueue@@ -152,7 +155,9 @@                      Simulation.Aivika.Processor.Random                      Simulation.Aivika.Processor.RoundRobbin                      Simulation.Aivika.Queue+                     Simulation.Aivika.Queue.Base                      Simulation.Aivika.Queue.Infinite+                     Simulation.Aivika.Queue.Infinite.Base                      Simulation.Aivika.QueueStrategy                      Simulation.Aivika.Ref                      Simulation.Aivika.Ref.Base

@@ -0,0 +1,137 @@++-- Example: A Truck Hauling Situation+--+-- It is described in different sources [1, 2]. So, this is chapter 9 of [2] and section 7.16 of [1].+-- +-- The system to be modeled in this example consists of one bulldozer, four trucks,+-- and two man-machine loaders. The bulldozer stockpiles material for the loaders.+-- Two piles of material must be stocked prior to the initiation of any load operation.+-- The time for the bulldozer to stockpile material is Erlang distributed and consists+-- of the sum of two exponential variables each with a men of 4. (This corresponds to+-- an Erlang variable with a mean of 8 and a variance of 32.) In addition to this+-- material, a loader and an unloaded truck must be available before the loading+-- operations can begin. Loading time is exponentially distributed with a mean time of+-- 14 minutes for server 1 and 12 minutes for server 2.+-- +-- After a truck is loaded, it is hauled, then dumped and must be returned before+-- the truck is available for further loading. Hauling time is normally distributed.+-- When loaded, the average hauling time is 22 minutes. When unloaded, the average+-- time is 18 minutes. In both cases, the standard deviation is 3 minutes. Dumping+-- time is uniformly distributed between 2 and 8 minutes. Following a loading+-- operation, the loaded must rest for a 5 minute period before he is available+-- to begin loading again. The system is to be analyzed for 8 hours and all operations+-- in progress at the end of 8 hours should be completed before terminating+-- the operations for a run.+-- +-- [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.Monoid+import Data.List+import Data.Array++import Simulation.Aivika+import qualified Simulation.Aivika.Queue.Infinite as IQ++-- | The simulation specs.+specs = Specs { spcStartTime = 0.0,+                spcStopTime = 1000.0,+                spcDT = 0.1,+                spcMethod = RungeKutta4,+                spcGeneratorType = SimpleGenerator }++data Truck = Truck++data Pile = Pile++data Loader = Loader1+            | Loader2+              deriving (Eq, Ord, Show, Ix)++awaitQueuesNonEmpty q1 q2 q3 =+  do n1 <- liftEvent $ IQ.queueCount q1+     n2 <- liftEvent $ IQ.queueCount q2+     n3 <- liftEvent $ IQ.queueCount q3+     when (n1 == 0 || n2 == 0 || n3 == 0) $+       do let signal = IQ.queueCountChanged_ q1 <>+                       IQ.queueCountChanged_ q2 <>+                       IQ.queueCountChanged_ q3+          processAwait signal+          awaitQueuesNonEmpty q1 q2 q3++-- | The simulation model.+model :: Simulation Results+model = do+  truckQueue <- runEventInStartTime IQ.newFCFSQueue+  loadQueue <- runEventInStartTime IQ.newFCFSQueue+  loaderQueue <- runEventInStartTime IQ.newFCFSQueue+  loaderOp1 <- runEventInStartTime $+               newRandomExponentialOperation 14+  loaderOp2 <- runEventInStartTime $+               newRandomExponentialOperation 12+  let loaderOps = array (Loader1, Loader2)+                  [(Loader1, loaderOp1),+                   (Loader2, loaderOp2)]+  let start :: Process ()+      start =+        do randomErlangProcess_ 4 2+           randomErlangProcess_ 4 2+           liftEvent $+             IQ.enqueue loadQueue Pile+           t <- liftDynamics time+           when (t <= 480) start+      begin :: Process ()+      begin =+        do awaitQueuesNonEmpty truckQueue loadQueue loaderQueue+           truck  <- IQ.dequeue truckQueue+           pile   <- IQ.dequeue loadQueue+           loader <- IQ.dequeue loaderQueue+           -- the load operation+           operationProcess (loaderOps ! loader) () +           -- truck hauling+           liftEvent $+             do runProcess $+                  do holdProcess 5+                     liftEvent $+                       IQ.enqueue loaderQueue loader+                runProcess $+                  do randomNormalProcess_ 22 3+                     randomUniformProcess_ 2 8+                     randomNormalProcess_ 18 3+                     liftEvent $+                       IQ.enqueue truckQueue truck+           begin+  runEventInStartTime $+    do forM_ [1..4] $ \i ->+         IQ.enqueue truckQueue Truck+       IQ.enqueue loaderQueue Loader1+       IQ.enqueue loaderQueue Loader2+  runProcessInStartTime begin+  runProcessInStartTime begin+  runProcessInStartTime start+  return $+    results+    [ resultSource+     "loadQueue" "Queue Load"+     loadQueue,+     --+     resultSource+     "truckQueue" "Queue Trucks"+     truckQueue,+     --+     resultSource+     "loaderQueue" "Queue Loader"+     loaderQueue,+     --+     resultSource+     "loaderOps" "Loader Operations"+     loaderOps]++main =+  printSimulationResultsInStopTime+  printResultSourceInEnglish+  (fmap resultSummary model) specs