diff --git a/Simulation/Aivika.hs b/Simulation/Aivika.hs --- a/Simulation/Aivika.hs +++ b/Simulation/Aivika.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module re-exports the most part of the library functionality. -- But there are modules that must be imported explicitly. @@ -35,7 +35,7 @@ module Simulation.Aivika.Processor.RoundRobbin, module Simulation.Aivika.QueueStrategy, module Simulation.Aivika.Ref, - module Simulation.Aivika.Resource, + module Simulation.Aivika.Resource.Base, module Simulation.Aivika.Results, module Simulation.Aivika.Results.Locale, module Simulation.Aivika.Results.IO, @@ -77,7 +77,7 @@ import Simulation.Aivika.Processor.RoundRobbin import Simulation.Aivika.QueueStrategy import Simulation.Aivika.Ref -import Simulation.Aivika.Resource +import Simulation.Aivika.Resource.Base import Simulation.Aivika.Results import Simulation.Aivika.Results.Locale import Simulation.Aivika.Results.IO diff --git a/Simulation/Aivika/Activity.hs b/Simulation/Aivika/Activity.hs --- a/Simulation/Aivika/Activity.hs +++ b/Simulation/Aivika/Activity.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- It models an activity that can be utilised. The activity is similar to a 'Server' -- but destined for simulation within 'Net' computation. @@ -72,7 +72,6 @@ import Simulation.Aivika.Dynamics import Simulation.Aivika.Internal.Event import Simulation.Aivika.Signal -import Simulation.Aivika.Resource import Simulation.Aivika.Cont import Simulation.Aivika.Process import Simulation.Aivika.Net @@ -505,11 +504,11 @@ activityUtilised :: Activity s a b -> Signal (a, b) activityUtilised = publishSignal . activityUtilisedSource --- | Raised when the task utilisation by the activity was preempted. +-- | Raised when the activity utilisation was preempted. activityPreemptionBeginning :: Activity s a b -> Signal a activityPreemptionBeginning = publishSignal . activityPreemptionBeginningSource --- | Raised when the task utilisation by the activity was proceeded after it had been preempted earlier. +-- | Raised when the activity utilisation was proceeded after it had been preempted earlier. activityPreemptionEnding :: Activity s a b -> Signal a activityPreemptionEnding = publishSignal . activityPreemptionEndingSource diff --git a/Simulation/Aivika/Activity/Random.hs b/Simulation/Aivika/Activity/Random.hs --- a/Simulation/Aivika/Activity/Random.hs +++ b/Simulation/Aivika/Activity/Random.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines some useful predefined activities that -- hold the current process for the corresponding random time diff --git a/Simulation/Aivika/Agent.hs b/Simulation/Aivika/Agent.hs --- a/Simulation/Aivika/Agent.hs +++ b/Simulation/Aivika/Agent.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module introduces basic entities for the agent-based modeling. -- diff --git a/Simulation/Aivika/Arrival.hs b/Simulation/Aivika/Arrival.hs --- a/Simulation/Aivika/Arrival.hs +++ b/Simulation/Aivika/Arrival.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines the types and functions for working with the events -- that can represent something that arrive from outside the model, or diff --git a/Simulation/Aivika/Circuit.hs b/Simulation/Aivika/Circuit.hs --- a/Simulation/Aivika/Circuit.hs +++ b/Simulation/Aivika/Circuit.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- It represents a circuit synchronized with the event queue. -- Also it allows creating the recursive links with help of diff --git a/Simulation/Aivika/Cont.hs b/Simulation/Aivika/Cont.hs --- a/Simulation/Aivika/Cont.hs +++ b/Simulation/Aivika/Cont.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- The 'Cont' monad is a variation of the standard Cont monad -- and F# async workflow, where the result of applying diff --git a/Simulation/Aivika/DoubleLinkedList.hs b/Simulation/Aivika/DoubleLinkedList.hs --- a/Simulation/Aivika/DoubleLinkedList.hs +++ b/Simulation/Aivika/DoubleLinkedList.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- An imperative double-linked list. -- diff --git a/Simulation/Aivika/Dynamics.hs b/Simulation/Aivika/Dynamics.hs --- a/Simulation/Aivika/Dynamics.hs +++ b/Simulation/Aivika/Dynamics.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- The module defines the 'Dynamics' monad representing a time varying polymorphic function. -- diff --git a/Simulation/Aivika/Dynamics/Extra.hs b/Simulation/Aivika/Dynamics/Extra.hs --- a/Simulation/Aivika/Dynamics/Extra.hs +++ b/Simulation/Aivika/Dynamics/Extra.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines auxiliary functions such as interpolation ones -- that complement the memoization, for example. There are scan functions too. diff --git a/Simulation/Aivika/Dynamics/Memo.hs b/Simulation/Aivika/Dynamics/Memo.hs --- a/Simulation/Aivika/Dynamics/Memo.hs +++ b/Simulation/Aivika/Dynamics/Memo.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines memo functions. The memoization creates such 'Dynamics' -- computations, which values are cached in the integration time points. Then diff --git a/Simulation/Aivika/Dynamics/Memo/Unboxed.hs b/Simulation/Aivika/Dynamics/Memo/Unboxed.hs --- a/Simulation/Aivika/Dynamics/Memo/Unboxed.hs +++ b/Simulation/Aivika/Dynamics/Memo/Unboxed.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines the unboxed memo functions. The memoization creates such 'Dynamics' -- computations, which values are cached in the integration time points. Then diff --git a/Simulation/Aivika/Dynamics/Random.hs b/Simulation/Aivika/Dynamics/Random.hs --- a/Simulation/Aivika/Dynamics/Random.hs +++ b/Simulation/Aivika/Dynamics/Random.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines the random functions that always return the same values -- in the integration time points within a single simulation run. The values diff --git a/Simulation/Aivika/Event.hs b/Simulation/Aivika/Event.hs --- a/Simulation/Aivika/Event.hs +++ b/Simulation/Aivika/Event.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- The module defines the 'Event' monad which is very similar to the 'Dynamics' -- monad but only now the computation is strongly synchronized with the event queue. diff --git a/Simulation/Aivika/Generator.hs b/Simulation/Aivika/Generator.hs --- a/Simulation/Aivika/Generator.hs +++ b/Simulation/Aivika/Generator.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- Below is defined a type class of the random number generator. -- diff --git a/Simulation/Aivika/Internal/Arrival.hs b/Simulation/Aivika/Internal/Arrival.hs --- a/Simulation/Aivika/Internal/Arrival.hs +++ b/Simulation/Aivika/Internal/Arrival.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines the types and functions for working with the events -- that can represent something that arrive from outside the model, or diff --git a/Simulation/Aivika/Internal/Cont.hs b/Simulation/Aivika/Internal/Cont.hs --- a/Simulation/Aivika/Internal/Cont.hs +++ b/Simulation/Aivika/Internal/Cont.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This is an internal implementation module that should never be used directly. -- diff --git a/Simulation/Aivika/Internal/Dynamics.hs b/Simulation/Aivika/Internal/Dynamics.hs --- a/Simulation/Aivika/Internal/Dynamics.hs +++ b/Simulation/Aivika/Internal/Dynamics.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This is an internal implementation module that should never be used directly. -- diff --git a/Simulation/Aivika/Internal/Event.hs b/Simulation/Aivika/Internal/Event.hs --- a/Simulation/Aivika/Internal/Event.hs +++ b/Simulation/Aivika/Internal/Event.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This is an internal implementation module that should never be used directly. -- diff --git a/Simulation/Aivika/Internal/Parameter.hs b/Simulation/Aivika/Internal/Parameter.hs --- a/Simulation/Aivika/Internal/Parameter.hs +++ b/Simulation/Aivika/Internal/Parameter.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This is an internal implementation module that should never be used directly. -- diff --git a/Simulation/Aivika/Internal/Process.hs b/Simulation/Aivika/Internal/Process.hs --- a/Simulation/Aivika/Internal/Process.hs +++ b/Simulation/Aivika/Internal/Process.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This is an internal implementation module that should never be used directly. -- diff --git a/Simulation/Aivika/Internal/Simulation.hs b/Simulation/Aivika/Internal/Simulation.hs --- a/Simulation/Aivika/Internal/Simulation.hs +++ b/Simulation/Aivika/Internal/Simulation.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This is an internal implementation module that should never be used directly. -- diff --git a/Simulation/Aivika/Internal/Specs.hs b/Simulation/Aivika/Internal/Specs.hs --- a/Simulation/Aivika/Internal/Specs.hs +++ b/Simulation/Aivika/Internal/Specs.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- It defines the simulation specs and related stuff. module Simulation.Aivika.Internal.Specs diff --git a/Simulation/Aivika/Net.hs b/Simulation/Aivika/Net.hs --- a/Simulation/Aivika/Net.hs +++ b/Simulation/Aivika/Net.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- The module defines a 'Net' arrow that can be applied to modeling the queue networks -- like the 'Processor' arrow from another module. Only the former has a more efficient @@ -60,7 +60,7 @@ import Simulation.Aivika.Process import Simulation.Aivika.Stream import Simulation.Aivika.QueueStrategy -import Simulation.Aivika.Resource +import Simulation.Aivika.Resource.Base import Simulation.Aivika.Processor import Simulation.Aivika.Ref import Simulation.Aivika.Circuit diff --git a/Simulation/Aivika/Net/Random.hs b/Simulation/Aivika/Net/Random.hs --- a/Simulation/Aivika/Net/Random.hs +++ b/Simulation/Aivika/Net/Random.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines some useful random network computations that -- hold the current process for the corresponding time interval, diff --git a/Simulation/Aivika/Parameter.hs b/Simulation/Aivika/Parameter.hs --- a/Simulation/Aivika/Parameter.hs +++ b/Simulation/Aivika/Parameter.hs @@ -4,7 +4,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- The module defines the 'Parameter' monad that allows representing the model -- parameters. For example, they can be used when running the Monte-Carlo simulation. diff --git a/Simulation/Aivika/Parameter/Random.hs b/Simulation/Aivika/Parameter/Random.hs --- a/Simulation/Aivika/Parameter/Random.hs +++ b/Simulation/Aivika/Parameter/Random.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines the random parameters of simulation experiments. -- diff --git a/Simulation/Aivika/PriorityQueue.hs b/Simulation/Aivika/PriorityQueue.hs --- a/Simulation/Aivika/PriorityQueue.hs +++ b/Simulation/Aivika/PriorityQueue.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- An imperative heap-based priority queue. -- diff --git a/Simulation/Aivika/Process.hs b/Simulation/Aivika/Process.hs --- a/Simulation/Aivika/Process.hs +++ b/Simulation/Aivika/Process.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- A value in the 'Process' monad represents a discontinuous process that -- can suspend in any simulation time point and then resume later in the same diff --git a/Simulation/Aivika/Process/Random.hs b/Simulation/Aivika/Process/Random.hs --- a/Simulation/Aivika/Process/Random.hs +++ b/Simulation/Aivika/Process/Random.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines helper functions, which are useful to hold -- the 'Process' computation for a time interval according to some diff --git a/Simulation/Aivika/Processor.hs b/Simulation/Aivika/Processor.hs --- a/Simulation/Aivika/Processor.hs +++ b/Simulation/Aivika/Processor.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- The processor of simulation data. -- diff --git a/Simulation/Aivika/Processor/Random.hs b/Simulation/Aivika/Processor/Random.hs --- a/Simulation/Aivika/Processor/Random.hs +++ b/Simulation/Aivika/Processor/Random.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines some useful random processors that -- hold the current process for the corresponding time interval, diff --git a/Simulation/Aivika/Processor/RoundRobbin.hs b/Simulation/Aivika/Processor/RoundRobbin.hs --- a/Simulation/Aivika/Processor/RoundRobbin.hs +++ b/Simulation/Aivika/Processor/RoundRobbin.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- The module defines the Round-Robbin processor. -- diff --git a/Simulation/Aivika/Queue.hs b/Simulation/Aivika/Queue.hs --- a/Simulation/Aivika/Queue.hs +++ b/Simulation/Aivika/Queue.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines a queue that can use the specified strategies. So, having only -- the 'FCFS', 'LCFS', 'SIRO' and 'StaticPriorities' strategies, you can build @@ -117,7 +117,7 @@ import Simulation.Aivika.Internal.Event import Simulation.Aivika.Internal.Process import Simulation.Aivika.Signal -import Simulation.Aivika.Resource +import Simulation.Aivika.Resource.Base import Simulation.Aivika.QueueStrategy import Simulation.Aivika.Statistics diff --git a/Simulation/Aivika/Queue/Infinite.hs b/Simulation/Aivika/Queue/Infinite.hs --- a/Simulation/Aivika/Queue/Infinite.hs +++ b/Simulation/Aivika/Queue/Infinite.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines an infinite queue that can use the specified strategies. -- @@ -81,7 +81,7 @@ import Simulation.Aivika.Internal.Event import Simulation.Aivika.Internal.Process import Simulation.Aivika.Signal -import Simulation.Aivika.Resource +import Simulation.Aivika.Resource.Base import Simulation.Aivika.QueueStrategy import Simulation.Aivika.Statistics diff --git a/Simulation/Aivika/QueueStrategy.hs b/Simulation/Aivika/QueueStrategy.hs --- a/Simulation/Aivika/QueueStrategy.hs +++ b/Simulation/Aivika/QueueStrategy.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines the queue strategies. -- diff --git a/Simulation/Aivika/Ref.hs b/Simulation/Aivika/Ref.hs --- a/Simulation/Aivika/Ref.hs +++ b/Simulation/Aivika/Ref.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines an updatable reference that depends on the event queue. -- diff --git a/Simulation/Aivika/Ref/Base.hs b/Simulation/Aivika/Ref/Base.hs new file mode 100644 --- /dev/null +++ b/Simulation/Aivika/Ref/Base.hs @@ -0,0 +1,53 @@ + +-- | +-- Module : Simulation.Aivika.Ref.Base +-- Copyright : Copyright (c) 2009-2015, David Sorokin +-- License : BSD3 +-- Maintainer : David Sorokin +-- Stability : experimental +-- Tested with: GHC 7.10.1 +-- +-- This module defines a light-weight and more fast version of an updatable reference +-- that depends on the event queue but that doesn't supply with the signal notification. +-- +module Simulation.Aivika.Ref.Base + (Ref, + newRef, + readRef, + writeRef, + modifyRef) where + +import Data.IORef +import Control.Monad +import Control.Monad.Trans + +import Simulation.Aivika.Internal.Simulation +import Simulation.Aivika.Internal.Event + +-- | The 'Ref' type represents a mutable variable similar to the 'IORef' variable +-- but only dependent on the event queue, which allows synchronizing the reference +-- with the model explicitly through the 'Event' monad. +newtype Ref a = + Ref { refValue :: IORef a } + +-- | Create a new reference. +newRef :: a -> Simulation (Ref a) +newRef a = + do x <- liftIO $ newIORef a + return Ref { refValue = x } + +-- | Read the value of a reference. +readRef :: Ref a -> Event a +readRef r = Event $ \p -> readIORef (refValue r) + +-- | Write a new value into the reference. +writeRef :: Ref a -> a -> Event () +writeRef r a = Event $ \p -> + a `seq` writeIORef (refValue r) a + +-- | Mutate the contents of the reference. +modifyRef :: Ref a -> (a -> a) -> Event () +modifyRef r f = Event $ \p -> + do a <- readIORef (refValue r) + let b = f a + b `seq` writeIORef (refValue r) b diff --git a/Simulation/Aivika/Ref/Plain.hs b/Simulation/Aivika/Ref/Plain.hs deleted file mode 100644 --- a/Simulation/Aivika/Ref/Plain.hs +++ /dev/null @@ -1,53 +0,0 @@ - --- | --- Module : Simulation.Aivika.Ref.Plain --- Copyright : Copyright (c) 2009-2015, David Sorokin --- License : BSD3 --- Maintainer : David Sorokin --- Stability : experimental --- Tested with: GHC 7.8.3 --- --- This module defines a light-weight and more fast version of an updatable reference --- that depends on the event queue but that doesn't supply with the signal notification. --- -module Simulation.Aivika.Ref.Plain - (Ref, - newRef, - readRef, - writeRef, - modifyRef) where - -import Data.IORef -import Control.Monad -import Control.Monad.Trans - -import Simulation.Aivika.Internal.Simulation -import Simulation.Aivika.Internal.Event - --- | The 'Ref' type represents a mutable variable similar to the 'IORef' variable --- but only dependent on the event queue, which allows synchronizing the reference --- with the model explicitly through the 'Event' monad. -newtype Ref a = - Ref { refValue :: IORef a } - --- | Create a new reference. -newRef :: a -> Simulation (Ref a) -newRef a = - do x <- liftIO $ newIORef a - return Ref { refValue = x } - --- | Read the value of a reference. -readRef :: Ref a -> Event a -readRef r = Event $ \p -> readIORef (refValue r) - --- | Write a new value into the reference. -writeRef :: Ref a -> a -> Event () -writeRef r a = Event $ \p -> - a `seq` writeIORef (refValue r) a - --- | Mutate the contents of the reference. -modifyRef :: Ref a -> (a -> a) -> Event () -modifyRef r f = Event $ \p -> - do a <- readIORef (refValue r) - let b = f a - b `seq` writeIORef (refValue r) b diff --git a/Simulation/Aivika/Resource.hs b/Simulation/Aivika/Resource.hs --- a/Simulation/Aivika/Resource.hs +++ b/Simulation/Aivika/Resource.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines the resource which can be acquired and -- then released by the discontinuous process 'Process'. @@ -35,6 +35,9 @@ resourceStrategy, resourceMaxCount, resourceCount, + resourceCountStats, + resourceUtilisationCount, + resourceUtilisationCountStats, -- * Requesting for and Releasing Resource requestResource, requestResourceWithPriority, @@ -44,9 +47,18 @@ usingResource, usingResourceWithPriority, -- * Altering Resource - incResourceCount) where + incResourceCount, + decResourceCount, + -- * Signals + resourceCountChanged, + resourceCountChanged_, + resourceUtilisationCountChanged, + resourceUtilisationCountChanged_, + resourceChanged_) where import Data.IORef +import Data.Monoid + import Control.Monad import Control.Monad.Trans import Control.Exception @@ -57,6 +69,8 @@ import Simulation.Aivika.Internal.Cont import Simulation.Aivika.Internal.Process import Simulation.Aivika.QueueStrategy +import Simulation.Aivika.Statistics +import Simulation.Aivika.Signal import qualified Simulation.Aivika.DoubleLinkedList as DLL import qualified Simulation.Aivika.Vector as V @@ -81,7 +95,12 @@ resourceMaxCount :: Maybe Int, -- ^ Return the maximum count of the resource, where 'Nothing' -- means that the resource has no upper bound. - resourceCountRef :: IORef Int, + resourceCountRef :: IORef Int, + resourceCountStatsRef :: IORef (TimingStats Int), + resourceCountSource :: SignalSource Int, + resourceUtilisationCountRef :: IORef Int, + resourceUtilisationCountStatsRef :: IORef (TimingStats Int), + resourceUtilisationCountSource :: SignalSource Int, resourceWaitList :: StrategyQueue s (FrozenCont ()) } instance Eq (Resource s) where @@ -91,7 +110,7 @@ -- the upper bound as well. newFCFSResource :: Int -- ^ the initial count (and maximal count too) of the resource - -> Simulation FCFSResource + -> Event FCFSResource newFCFSResource = newResource FCFS -- | Create a new FCFS resource with the specified initial and maximum counts, @@ -100,14 +119,14 @@ -- ^ the initial count of the resource -> Maybe Int -- ^ the maximum count of the resource, which can be indefinite - -> Simulation FCFSResource + -> Event FCFSResource newFCFSResourceWithMaxCount = newResourceWithMaxCount FCFS -- | Create a new LCFS resource with the specified initial count which value becomes -- the upper bound as well. newLCFSResource :: Int -- ^ the initial count (and maximal count too) of the resource - -> Simulation LCFSResource + -> Event LCFSResource newLCFSResource = newResource LCFS -- | Create a new LCFS resource with the specified initial and maximum counts, @@ -116,14 +135,14 @@ -- ^ the initial count of the resource -> Maybe Int -- ^ the maximum count of the resource, which can be indefinite - -> Simulation LCFSResource + -> Event LCFSResource newLCFSResourceWithMaxCount = newResourceWithMaxCount LCFS -- | Create a new SIRO resource with the specified initial count which value becomes -- the upper bound as well. newSIROResource :: Int -- ^ the initial count (and maximal count too) of the resource - -> Simulation SIROResource + -> Event SIROResource newSIROResource = newResource SIRO -- | Create a new SIRO resource with the specified initial and maximum counts, @@ -132,14 +151,14 @@ -- ^ the initial count of the resource -> Maybe Int -- ^ the maximum count of the resource, which can be indefinite - -> Simulation SIROResource + -> Event SIROResource newSIROResourceWithMaxCount = newResourceWithMaxCount SIRO -- | Create a new priority resource with the specified initial count which value becomes -- the upper bound as well. newPriorityResource :: Int -- ^ the initial count (and maximal count too) of the resource - -> Simulation PriorityResource + -> Event PriorityResource newPriorityResource = newResource StaticPriorities -- | Create a new priority resource with the specified initial and maximum counts, @@ -148,7 +167,7 @@ -- ^ the initial count of the resource -> Maybe Int -- ^ the maximum count of the resource, which can be indefinite - -> Simulation PriorityResource + -> Event PriorityResource newPriorityResourceWithMaxCount = newResourceWithMaxCount StaticPriorities -- | Create a new resource with the specified queue strategy and initial count. @@ -158,18 +177,30 @@ -- ^ the strategy for managing the queuing requests -> Int -- ^ the initial count (and maximal count too) of the resource - -> Simulation (Resource s) + -> Event (Resource s) newResource s count = - Simulation $ \r -> - do when (count < 0) $ + Event $ \p -> + do let r = pointRun p + t = pointTime p + when (count < 0) $ error $ "The resource count cannot be negative: " ++ "newResource." countRef <- newIORef count + countStatsRef <- newIORef $ returnTimingStats t count + countSource <- invokeSimulation r newSignalSource + utilCountRef <- newIORef 0 + utilCountStatsRef <- newIORef $ returnTimingStats t 0 + utilCountSource <- invokeSimulation r newSignalSource waitList <- invokeSimulation r $ newStrategyQueue s return Resource { resourceStrategy = s, resourceMaxCount = Just count, resourceCountRef = countRef, + resourceCountStatsRef = countStatsRef, + resourceCountSource = countSource, + resourceUtilisationCountRef = utilCountRef, + resourceUtilisationCountStatsRef = utilCountStatsRef, + resourceUtilisationCountSource = utilCountSource, resourceWaitList = waitList } -- | Create a new resource with the specified queue strategy, initial and maximum counts, @@ -181,10 +212,12 @@ -- ^ the initial count of the resource -> Maybe Int -- ^ the maximum count of the resource, which can be indefinite - -> Simulation (Resource s) + -> Event (Resource s) newResourceWithMaxCount s count maxCount = - Simulation $ \r -> - do when (count < 0) $ + Event $ \p -> + do let r = pointRun p + t = pointTime p + when (count < 0) $ error $ "The resource count cannot be negative: " ++ "newResourceWithMaxCount." @@ -196,17 +229,62 @@ _ -> return () countRef <- newIORef count + countStatsRef <- newIORef $ returnTimingStats t count + countSource <- invokeSimulation r newSignalSource + utilCountRef <- newIORef 0 + utilCountStatsRef <- newIORef $ returnTimingStats t 0 + utilCountSource <- invokeSimulation r newSignalSource waitList <- invokeSimulation r $ newStrategyQueue s return Resource { resourceStrategy = s, resourceMaxCount = maxCount, resourceCountRef = countRef, + resourceCountStatsRef = countStatsRef, + resourceCountSource = countSource, + resourceUtilisationCountRef = utilCountRef, + resourceUtilisationCountStatsRef = utilCountStatsRef, + resourceUtilisationCountSource = utilCountSource, resourceWaitList = waitList } --- | Return the current count of the resource. +-- | Return the current available count of the resource. resourceCount :: Resource s -> Event Int resourceCount r = Event $ \p -> readIORef (resourceCountRef r) +-- | Return the statistics for the available count of the resource. +resourceCountStats :: Resource s -> Event (TimingStats Int) +resourceCountStats r = + Event $ \p -> readIORef (resourceCountStatsRef r) + +-- | Signal triggered when the 'resourceCount' property changes. +resourceCountChanged :: Resource s -> Signal Int +resourceCountChanged r = + publishSignal $ resourceCountSource r + +-- | Signal triggered when the 'resourceCount' property changes. +resourceCountChanged_ :: Resource s -> Signal () +resourceCountChanged_ r = + mapSignal (const ()) $ resourceCountChanged r + +-- | Return the current utilisation count of the resource. +resourceUtilisationCount :: Resource s -> Event Int +resourceUtilisationCount r = + Event $ \p -> readIORef (resourceUtilisationCountRef r) + +-- | Return the statistics for the utilisation count of the resource. +resourceUtilisationCountStats :: Resource s -> Event (TimingStats Int) +resourceUtilisationCountStats r = + Event $ \p -> readIORef (resourceUtilisationCountStatsRef r) + +-- | Signal triggered when the 'resourceUtilisationCount' property changes. +resourceUtilisationCountChanged :: Resource s -> Signal Int +resourceUtilisationCountChanged r = + publishSignal $ resourceUtilisationCountSource r + +-- | Signal triggered when the 'resourceUtilisationCount' property changes. +resourceUtilisationCountChanged_ :: Resource s -> Signal () +resourceUtilisationCountChanged_ r = + mapSignal (const ()) $ resourceUtilisationCountChanged r + -- | Request for the resource decreasing its count in case of success, -- otherwise suspending the discontinuous process until some other -- process releases the resource. @@ -227,8 +305,8 @@ requestResource r invokeEvent p $ strategyEnqueue (resourceWaitList r) c - else do let a' = a - 1 - a' `seq` writeIORef (resourceCountRef r) a' + else do invokeEvent p $ updateResourceCount r (-1) + invokeEvent p $ updateResourceUtilisationCount r 1 invokeEvent p $ resumeCont c () -- | Request with the priority for the resource decreasing its count @@ -253,8 +331,8 @@ requestResourceWithPriority r priority invokeEvent p $ strategyEnqueueWithPriority (resourceWaitList r) priority c - else do let a' = a - 1 - a' `seq` writeIORef (resourceCountRef r) a' + else do invokeEvent p $ updateResourceCount r (-1) + invokeEvent p $ updateResourceUtilisationCount r 1 invokeEvent p $ resumeCont c () -- | Release the resource increasing its count and resuming one of the @@ -278,27 +356,38 @@ -> Event () releaseResourceWithinEvent r = Event $ \p -> + do invokeEvent p $ updateResourceUtilisationCount r (-1) + invokeEvent p $ releaseResource' r + +-- | Release the resource without affecting its utilisation. +releaseResource' :: DequeueStrategy s + => Resource s + -- ^ the resource to release + -> Event () +releaseResource' r = + Event $ \p -> do a <- readIORef (resourceCountRef r) let a' = a + 1 case resourceMaxCount r of Just maxCount | a' > maxCount -> error $ "The resource count cannot be greater than " ++ - "its maximum value: releaseResourceWithinEvent." + "its maximum value: releaseResource'." _ -> return () f <- invokeEvent p $ strategyQueueNull (resourceWaitList r) if f - then a' `seq` writeIORef (resourceCountRef r) a' + then invokeEvent p $ updateResourceCount r 1 else do c <- invokeEvent p $ strategyDequeue (resourceWaitList r) c <- invokeEvent p $ unfreezeCont c case c of Nothing -> - invokeEvent p $ releaseResourceWithinEvent r + invokeEvent p $ releaseResource' r Just c -> - invokeEvent p $ enqueueEvent (pointTime p) $ resumeCont c () + do invokeEvent p $ updateResourceUtilisationCount r 1 + invokeEvent p $ enqueueEvent (pointTime p) $ resumeCont c () -- | Try to request for the resource decreasing its count in case of success -- and returning 'True' in the 'Event' monad; otherwise, returning 'False'. @@ -310,8 +399,8 @@ do a <- readIORef (resourceCountRef r) if a == 0 then return False - else do let a' = a - 1 - a' `seq` writeIORef (resourceCountRef r) a' + else do invokeEvent p $ updateResourceCount r (-1) + invokeEvent p $ updateResourceUtilisationCount r 1 return True -- | Acquire the resource, perform some action and safely release the resource @@ -344,6 +433,16 @@ do requestResourceWithPriority r priority finallyProcess m $ releaseResource r +-- | Decrease the count of available resource. +decResourceCount' :: EnqueueStrategy s + => Resource s + -- ^ the resource for which to decrease the count + -> Process () +decResourceCount' r = + do liftEvent $ + updateResourceUtilisationCount r (-1) + requestResource r + -- | Increase the count of available resource by the specified number, -- invoking the awaiting processes as needed. incResourceCount :: DequeueStrategy s @@ -356,6 +455,50 @@ | n < 0 = error "The increment cannot be negative: incResourceCount" | n == 0 = return () | otherwise = - do releaseResourceWithinEvent r + do releaseResource' r incResourceCount r (n - 1) +-- | Decrease the count of available resource by the specified number, +-- waiting for the processes capturing the resource as needed. +decResourceCount :: EnqueueStrategy s + => Resource s + -- ^ the resource + -> Int + -- ^ the decrement for the resource count + -> Process () +decResourceCount r n + | n < 0 = error "The decrement cannot be negative: decResourceCount" + | n == 0 = return () + | otherwise = + do decResourceCount' r + decResourceCount r (n - 1) + +-- | Signal triggered when one of the resource counters changes. +resourceChanged_ :: Resource s -> Signal () +resourceChanged_ r = + resourceCountChanged_ r <> + resourceUtilisationCountChanged_ r + +-- | Update the resource count and its statistics. +updateResourceCount :: Resource s -> Int -> Event () +updateResourceCount r delta = + Event $ \p -> + do a <- readIORef (resourceCountRef r) + let a' = a + delta + a' `seq` writeIORef (resourceCountRef r) a' + modifyIORef' (resourceCountStatsRef r) $ + addTimingStats (pointTime p) a' + invokeEvent p $ + triggerSignal (resourceCountSource r) a' + +-- | Update the resource utilisation count and its statistics. +updateResourceUtilisationCount :: Resource s -> Int -> Event () +updateResourceUtilisationCount r delta = + Event $ \p -> + do a <- readIORef (resourceUtilisationCountRef r) + let a' = a + delta + a' `seq` writeIORef (resourceUtilisationCountRef r) a' + modifyIORef' (resourceUtilisationCountStatsRef r) $ + addTimingStats (pointTime p) a' + invokeEvent p $ + triggerSignal (resourceUtilisationCountSource r) a' diff --git a/Simulation/Aivika/Resource/Base.hs b/Simulation/Aivika/Resource/Base.hs new file mode 100644 --- /dev/null +++ b/Simulation/Aivika/Resource/Base.hs @@ -0,0 +1,381 @@ + +-- | +-- Module : Simulation.Aivika.Resource.Base +-- Copyright : Copyright (c) 2009-2015, David Sorokin +-- License : BSD3 +-- Maintainer : David Sorokin +-- Stability : experimental +-- Tested with: GHC 7.10.1 +-- +-- This module defines an optimised version of the resource +-- which can be acquired and then released by the discontinuous +-- process 'Process'. The resource can be either limited by +-- the upper bound (run-time check), or it can have no upper bound. +-- The latter is useful for modeling the infinite queue, for example. +-- +-- The module is optimised in the sense that this kind of the resource +-- has neither additional signals, nor counters that would may slow +-- down the simulation. +-- +module Simulation.Aivika.Resource.Base + (-- * Resource Types + FCFSResource, + LCFSResource, + SIROResource, + PriorityResource, + Resource, + -- * Creating Resource + newFCFSResource, + newFCFSResourceWithMaxCount, + newLCFSResource, + newLCFSResourceWithMaxCount, + newSIROResource, + newSIROResourceWithMaxCount, + newPriorityResource, + newPriorityResourceWithMaxCount, + newResource, + newResourceWithMaxCount, + -- * Resource Properties + resourceStrategy, + resourceMaxCount, + resourceCount, + -- * Requesting for and Releasing Resource + requestResource, + requestResourceWithPriority, + tryRequestResourceWithinEvent, + releaseResource, + releaseResourceWithinEvent, + usingResource, + usingResourceWithPriority, + -- * Altering Resource + incResourceCount, + decResourceCount) where + +import Data.IORef +import Control.Monad +import Control.Monad.Trans +import Control.Exception + +import Simulation.Aivika.Internal.Specs +import Simulation.Aivika.Internal.Simulation +import Simulation.Aivika.Internal.Event +import Simulation.Aivika.Internal.Cont +import Simulation.Aivika.Internal.Process +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 + +-- | The ordinary FCFS (First Come - First Serviced) resource. +type FCFSResource = Resource FCFS + +-- | The ordinary LCFS (Last Come - First Serviced) resource. +type LCFSResource = Resource LCFS + +-- | The SIRO (Serviced in Random Order) resource. +type SIROResource = Resource SIRO + +-- | The resource with static priorities. +type PriorityResource = Resource StaticPriorities + +-- | Represents the resource with strategy @s@ applied for queuing the requests. +data Resource s = + Resource { resourceStrategy :: s, + -- ^ Return the strategy applied for queuing the requests. + resourceMaxCount :: Maybe Int, + -- ^ Return the maximum count of the resource, where 'Nothing' + -- means that the resource has no upper bound. + resourceCountRef :: IORef Int, + resourceWaitList :: StrategyQueue s (FrozenCont ()) } + +instance Eq (Resource s) where + x == y = resourceCountRef x == resourceCountRef y -- unique references + +-- | Create a new FCFS resource with the specified initial count which value becomes +-- the upper bound as well. +newFCFSResource :: Int + -- ^ the initial count (and maximal count too) of the resource + -> Simulation FCFSResource +newFCFSResource = newResource FCFS + +-- | Create a new FCFS resource with the specified initial and maximum counts, +-- where 'Nothing' means that the resource has no upper bound. +newFCFSResourceWithMaxCount :: Int + -- ^ the initial count of the resource + -> Maybe Int + -- ^ the maximum count of the resource, which can be indefinite + -> Simulation FCFSResource +newFCFSResourceWithMaxCount = newResourceWithMaxCount FCFS + +-- | Create a new LCFS resource with the specified initial count which value becomes +-- the upper bound as well. +newLCFSResource :: Int + -- ^ the initial count (and maximal count too) of the resource + -> Simulation LCFSResource +newLCFSResource = newResource LCFS + +-- | Create a new LCFS resource with the specified initial and maximum counts, +-- where 'Nothing' means that the resource has no upper bound. +newLCFSResourceWithMaxCount :: Int + -- ^ the initial count of the resource + -> Maybe Int + -- ^ the maximum count of the resource, which can be indefinite + -> Simulation LCFSResource +newLCFSResourceWithMaxCount = newResourceWithMaxCount LCFS + +-- | Create a new SIRO resource with the specified initial count which value becomes +-- the upper bound as well. +newSIROResource :: Int + -- ^ the initial count (and maximal count too) of the resource + -> Simulation SIROResource +newSIROResource = newResource SIRO + +-- | Create a new SIRO resource with the specified initial and maximum counts, +-- where 'Nothing' means that the resource has no upper bound. +newSIROResourceWithMaxCount :: Int + -- ^ the initial count of the resource + -> Maybe Int + -- ^ the maximum count of the resource, which can be indefinite + -> Simulation SIROResource +newSIROResourceWithMaxCount = newResourceWithMaxCount SIRO + +-- | Create a new priority resource with the specified initial count which value becomes +-- the upper bound as well. +newPriorityResource :: Int + -- ^ the initial count (and maximal count too) of the resource + -> Simulation PriorityResource +newPriorityResource = newResource StaticPriorities + +-- | Create a new priority resource with the specified initial and maximum counts, +-- where 'Nothing' means that the resource has no upper bound. +newPriorityResourceWithMaxCount :: Int + -- ^ the initial count of the resource + -> Maybe Int + -- ^ the maximum count of the resource, which can be indefinite + -> Simulation PriorityResource +newPriorityResourceWithMaxCount = newResourceWithMaxCount StaticPriorities + +-- | Create a new resource with the specified queue strategy and initial count. +-- The last value becomes the upper bound as well. +newResource :: QueueStrategy s + => s + -- ^ the strategy for managing the queuing requests + -> Int + -- ^ the initial count (and maximal count too) of the resource + -> Simulation (Resource s) +newResource s count = + Simulation $ \r -> + do when (count < 0) $ + error $ + "The resource count cannot be negative: " ++ + "newResource." + countRef <- newIORef count + waitList <- invokeSimulation r $ newStrategyQueue s + return Resource { resourceStrategy = s, + resourceMaxCount = Just count, + resourceCountRef = countRef, + resourceWaitList = waitList } + +-- | Create a new resource with the specified queue strategy, initial and maximum counts, +-- where 'Nothing' means that the resource has no upper bound. +newResourceWithMaxCount :: QueueStrategy s + => s + -- ^ the strategy for managing the queuing requests + -> Int + -- ^ the initial count of the resource + -> Maybe Int + -- ^ the maximum count of the resource, which can be indefinite + -> Simulation (Resource s) +newResourceWithMaxCount s count maxCount = + Simulation $ \r -> + do when (count < 0) $ + error $ + "The resource count cannot be negative: " ++ + "newResourceWithMaxCount." + case maxCount of + Just maxCount | count > maxCount -> + error $ + "The resource count cannot be greater than " ++ + "its maximum value: newResourceWithMaxCount." + _ -> + return () + countRef <- newIORef count + waitList <- invokeSimulation r $ newStrategyQueue s + return Resource { resourceStrategy = s, + resourceMaxCount = maxCount, + resourceCountRef = countRef, + resourceWaitList = waitList } + +-- | Return the current count of the resource. +resourceCount :: Resource s -> Event Int +resourceCount r = + Event $ \p -> readIORef (resourceCountRef r) + +-- | Request for the resource decreasing its count in case of success, +-- otherwise suspending the discontinuous process until some other +-- process releases the resource. +requestResource :: EnqueueStrategy s + => Resource s + -- ^ the requested resource + -> Process () +requestResource r = + Process $ \pid -> + Cont $ \c -> + Event $ \p -> + do a <- readIORef (resourceCountRef r) + if a == 0 + then do c <- invokeEvent p $ + freezeContReentering c () $ + invokeCont c $ + invokeProcess pid $ + requestResource r + invokeEvent p $ + strategyEnqueue (resourceWaitList r) c + else do let a' = a - 1 + a' `seq` writeIORef (resourceCountRef r) a' + invokeEvent p $ resumeCont c () + +-- | Request with the priority for the resource decreasing its count +-- in case of success, otherwise suspending the discontinuous process +-- until some other process releases the resource. +requestResourceWithPriority :: PriorityQueueStrategy s p + => Resource s + -- ^ the requested resource + -> p + -- ^ the priority + -> Process () +requestResourceWithPriority r priority = + Process $ \pid -> + Cont $ \c -> + Event $ \p -> + do a <- readIORef (resourceCountRef r) + if a == 0 + then do c <- invokeEvent p $ + freezeContReentering c () $ + invokeCont c $ + invokeProcess pid $ + requestResourceWithPriority r priority + invokeEvent p $ + strategyEnqueueWithPriority (resourceWaitList r) priority c + else do let a' = a - 1 + a' `seq` writeIORef (resourceCountRef r) a' + invokeEvent p $ resumeCont c () + +-- | Release the resource increasing its count and resuming one of the +-- previously suspended processes as possible. +releaseResource :: DequeueStrategy s + => Resource s + -- ^ the resource to release + -> Process () +releaseResource r = + Process $ \_ -> + Cont $ \c -> + Event $ \p -> + do invokeEvent p $ releaseResourceWithinEvent r + invokeEvent p $ resumeCont c () + +-- | Release the resource increasing its count and resuming one of the +-- previously suspended processes as possible. +releaseResourceWithinEvent :: DequeueStrategy s + => Resource s + -- ^ the resource to release + -> Event () +releaseResourceWithinEvent r = + Event $ \p -> + do a <- readIORef (resourceCountRef r) + let a' = a + 1 + case resourceMaxCount r of + Just maxCount | a' > maxCount -> + error $ + "The resource count cannot be greater than " ++ + "its maximum value: releaseResourceWithinEvent." + _ -> + return () + f <- invokeEvent p $ + strategyQueueNull (resourceWaitList r) + if f + then a' `seq` writeIORef (resourceCountRef r) a' + else do c <- invokeEvent p $ + strategyDequeue (resourceWaitList r) + c <- invokeEvent p $ unfreezeCont c + case c of + Nothing -> + invokeEvent p $ releaseResourceWithinEvent r + Just c -> + invokeEvent p $ enqueueEvent (pointTime p) $ resumeCont c () + +-- | Try to request for the resource decreasing its count in case of success +-- and returning 'True' in the 'Event' monad; otherwise, returning 'False'. +tryRequestResourceWithinEvent :: Resource s + -- ^ the resource which we try to request for + -> Event Bool +tryRequestResourceWithinEvent r = + Event $ \p -> + do a <- readIORef (resourceCountRef r) + if a == 0 + then return False + else do let a' = a - 1 + a' `seq` writeIORef (resourceCountRef r) a' + return True + +-- | Acquire the resource, perform some action and safely release the resource +-- in the end, even if the 'IOException' was raised within the action. +usingResource :: EnqueueStrategy s + => Resource s + -- ^ the resource we are going to request for and then release in the end + -> Process a + -- ^ the action we are going to apply having the resource + -> Process a + -- ^ the result of the action +usingResource r m = + do requestResource r + finallyProcess m $ releaseResource r + +-- | Acquire the resource with the specified priority, perform some action and +-- safely release the resource in the end, even if the 'IOException' was raised +-- within the action. +usingResourceWithPriority :: PriorityQueueStrategy s p + => Resource s + -- ^ the resource we are going to request for and then + -- release in the end + -> p + -- ^ the priority + -> Process a + -- ^ the action we are going to apply having the resource + -> Process a + -- ^ the result of the action +usingResourceWithPriority r priority m = + do requestResourceWithPriority r priority + finallyProcess m $ releaseResource r + +-- | Increase the count of available resource by the specified number, +-- invoking the awaiting processes as needed. +incResourceCount :: DequeueStrategy s + => Resource s + -- ^ the resource + -> Int + -- ^ the increment for the resource count + -> Event () +incResourceCount r n + | n < 0 = error "The increment cannot be negative: incResourceCount" + | n == 0 = return () + | otherwise = + do releaseResourceWithinEvent r + incResourceCount r (n - 1) + +-- | Decrease the count of available resource by the specified number, +-- waiting for the processes capturing the resource as needed. +decResourceCount :: EnqueueStrategy s + => Resource s + -- ^ the resource + -> Int + -- ^ the decrement for the resource count + -> Process () +decResourceCount r n + | n < 0 = error "The decrement cannot be negative: decResourceCount" + | n == 0 = return () + | otherwise = + do requestResource r + decResourceCount r (n - 1) + diff --git a/Simulation/Aivika/Resource/Preemption.hs b/Simulation/Aivika/Resource/Preemption.hs --- a/Simulation/Aivika/Resource/Preemption.hs +++ b/Simulation/Aivika/Resource/Preemption.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines the preemptible resource. -- @@ -18,6 +18,9 @@ -- * Resource Properties resourceMaxCount, resourceCount, + resourceCountStats, + resourceUtilisationCount, + resourceUtilisationCountStats, -- * Requesting for and Releasing Resource requestResourceWithPriority, releaseResource, @@ -25,9 +28,16 @@ -- * Altering Resource incResourceCount, decResourceCount, - alterResourceCount) where + alterResourceCount, + -- * Signals + resourceCountChanged, + resourceCountChanged_, + resourceUtilisationCountChanged, + resourceUtilisationCountChanged_, + resourceChanged_) where import Data.IORef +import Data.Monoid import Control.Monad import Control.Monad.Trans @@ -39,6 +49,8 @@ import Simulation.Aivika.Internal.Cont import Simulation.Aivika.Internal.Process import Simulation.Aivika.QueueStrategy +import Simulation.Aivika.Statistics +import Simulation.Aivika.Signal import qualified Simulation.Aivika.PriorityQueue as PQ @@ -48,6 +60,11 @@ -- ^ Return the maximum count of the resource, where 'Nothing' -- means that the resource has no upper bound. resourceCountRef :: IORef Int, + resourceCountStatsRef :: IORef (TimingStats Int), + resourceCountSource :: SignalSource Int, + resourceUtilisationCountRef :: IORef Int, + resourceUtilisationCountStatsRef :: IORef (TimingStats Int), + resourceUtilisationCountSource :: SignalSource Int, resourceActingQueue :: PQ.PriorityQueue ResourceActingItem, resourceWaitQueue :: PQ.PriorityQueue ResourceAwaitingItem } @@ -79,18 +96,30 @@ -- | Create a new resource with the specified initial count that becomes the upper bound as well. newResource :: Int -- ^ the initial count (and maximal count too) of the resource - -> Simulation Resource + -> Event Resource newResource count = - Simulation $ \r -> - do when (count < 0) $ + Event $ \p -> + do let r = pointRun p + t = pointTime p + when (count < 0) $ error $ "The resource count cannot be negative: " ++ "newResource." countRef <- newIORef count + countStatsRef <- newIORef $ returnTimingStats t count + countSource <- invokeSimulation r newSignalSource + utilCountRef <- newIORef 0 + utilCountStatsRef <- newIORef $ returnTimingStats t 0 + utilCountSource <- invokeSimulation r newSignalSource actingQueue <- PQ.newQueue waitQueue <- PQ.newQueue return Resource { resourceMaxCount = Just count, resourceCountRef = countRef, + resourceCountStatsRef = countStatsRef, + resourceCountSource = countSource, + resourceUtilisationCountRef = utilCountRef, + resourceUtilisationCountStatsRef = utilCountStatsRef, + resourceUtilisationCountSource = utilCountSource, resourceActingQueue = actingQueue, resourceWaitQueue = waitQueue } @@ -100,10 +129,12 @@ -- ^ the initial count of the resource -> Maybe Int -- ^ the maximum count of the resource, which can be indefinite - -> Simulation Resource + -> Event Resource newResourceWithMaxCount count maxCount = - Simulation $ \r -> - do when (count < 0) $ + Event $ \p -> + do let r = pointRun p + t = pointTime p + when (count < 0) $ error $ "The resource count cannot be negative: " ++ "newResourceWithMaxCount." @@ -115,18 +146,63 @@ _ -> return () countRef <- newIORef count + countStatsRef <- newIORef $ returnTimingStats t count + countSource <- invokeSimulation r newSignalSource + utilCountRef <- newIORef 0 + utilCountStatsRef <- newIORef $ returnTimingStats t 0 + utilCountSource <- invokeSimulation r newSignalSource actingQueue <- PQ.newQueue waitQueue <- PQ.newQueue return Resource { resourceMaxCount = maxCount, resourceCountRef = countRef, + resourceCountStatsRef = countStatsRef, + resourceCountSource = countSource, + resourceUtilisationCountRef = utilCountRef, + resourceUtilisationCountStatsRef = utilCountStatsRef, + resourceUtilisationCountSource = utilCountSource, resourceActingQueue = actingQueue, resourceWaitQueue = waitQueue } --- | Return the current count of the resource. +-- | Return the current available count of the resource. resourceCount :: Resource -> Event Int resourceCount r = Event $ \p -> readIORef (resourceCountRef r) +-- | Return the statistics for the available count of the resource. +resourceCountStats :: Resource -> Event (TimingStats Int) +resourceCountStats r = + Event $ \p -> readIORef (resourceCountStatsRef r) + +-- | Signal triggered when the 'resourceCount' property changes. +resourceCountChanged :: Resource -> Signal Int +resourceCountChanged r = + publishSignal $ resourceCountSource r + +-- | Signal triggered when the 'resourceCount' property changes. +resourceCountChanged_ :: Resource -> Signal () +resourceCountChanged_ r = + mapSignal (const ()) $ resourceCountChanged r + +-- | Return the current utilisation count of the resource. +resourceUtilisationCount :: Resource -> Event Int +resourceUtilisationCount r = + Event $ \p -> readIORef (resourceUtilisationCountRef r) + +-- | Return the statistics for the utilisation count of the resource. +resourceUtilisationCountStats :: Resource -> Event (TimingStats Int) +resourceUtilisationCountStats r = + Event $ \p -> readIORef (resourceUtilisationCountStatsRef r) + +-- | Signal triggered when the 'resourceUtilisationCount' property changes. +resourceUtilisationCountChanged :: Resource -> Signal Int +resourceUtilisationCountChanged r = + publishSignal $ resourceUtilisationCountSource r + +-- | Signal triggered when the 'resourceUtilisationCount' property changes. +resourceUtilisationCountChanged_ :: Resource -> Signal () +resourceUtilisationCountChanged_ r = + mapSignal (const ()) $ resourceUtilisationCountChanged r + -- | Request with the priority for the resource decreasing its count -- in case of success, otherwise suspending the discontinuous process -- until some other process releases the resource. @@ -168,9 +244,9 @@ invokeProcess pid $ requestResourceWithPriority r priority PQ.enqueue (resourceWaitQueue r) priority (Left $ ResourceRequestingItem priority pid c) - else do let a' = a - 1 - a' `seq` writeIORef (resourceCountRef r) a' - PQ.enqueue (resourceActingQueue r) (- priority) $ ResourceActingItem priority pid + else do PQ.enqueue (resourceActingQueue r) (- priority) $ ResourceActingItem priority pid + invokeEvent p $ updateResourceCount r (-1) + invokeEvent p $ updateResourceUtilisationCount r 1 invokeEvent p $ resumeCont c () -- | Release the resource increasing its count and resuming one of the @@ -184,7 +260,8 @@ Event $ \p -> do f <- PQ.removeBy (resourceActingQueue r) (\item -> actingItemId item == pid) if f - then do invokeEvent p $ releaseResource' r + then do invokeEvent p $ updateResourceUtilisationCount r (-1) + invokeEvent p $ releaseResource' r invokeEvent p $ resumeCont c () else error $ "The resource was not acquired by this process: releaseResource" @@ -207,7 +284,7 @@ return () f <- PQ.queueNull (resourceWaitQueue r) if f - then a' `seq` writeIORef (resourceCountRef r) a' + then invokeEvent p $ updateResourceCount r 1 else do (priority', item) <- PQ.queueFront (resourceWaitQueue r) PQ.dequeue (resourceWaitQueue r) case item of @@ -218,6 +295,7 @@ invokeEvent p $ releaseResource' r Just c -> do PQ.enqueue (resourceActingQueue r) (- priority) $ ResourceActingItem priority pid + invokeEvent p $ updateResourceUtilisationCount r 1 invokeEvent p $ enqueueEvent (pointTime p) $ resumeCont c () Right (ResourcePreemptedItem priority pid) -> do f <- invokeEvent p $ processCancelled pid @@ -226,6 +304,7 @@ invokeEvent p $ releaseResource' r False -> do PQ.enqueue (resourceActingQueue r) (- priority) $ ResourceActingItem priority pid + invokeEvent p $ updateResourceUtilisationCount r 1 invokeEvent p $ processPreemptionEnd pid -- | Acquire the resource with the specified priority, perform some action and @@ -254,17 +333,15 @@ error $ "The resource exceeded and its count is zero: decResourceCount'" f <- PQ.queueNull (resourceActingQueue r) - when f $ - error $ - "The resource acting queue is null: decResourceCount'" - (p0', item0) <- PQ.queueFront (resourceActingQueue r) - let p0 = - p0' - pid0 = actingItemId item0 - PQ.dequeue (resourceActingQueue r) - PQ.enqueue (resourceWaitQueue r) p0 (Right $ ResourcePreemptedItem p0 pid0) - invokeEvent p $ processPreemptionEnd pid0 - let a' = a - 1 - a' `seq` writeIORef (resourceCountRef r) a' + unless f $ + do (p0', item0) <- PQ.queueFront (resourceActingQueue r) + let p0 = - p0' + pid0 = actingItemId item0 + PQ.dequeue (resourceActingQueue r) + PQ.enqueue (resourceWaitQueue r) p0 (Right $ ResourcePreemptedItem p0 pid0) + invokeEvent p $ processPreemptionBegin pid0 + invokeEvent p $ updateResourceUtilisationCount r (-1) + invokeEvent p $ updateResourceCount r (-1) -- | Increase the count of available resource by the specified number, -- invoking the awaiting and preempted processes according to their priorities @@ -296,7 +373,7 @@ decResourceCount r (n - 1) -- | Alter the resource count either increasing or decreasing it by calling --- 'incResourceCount' or 'decResourceCount' respectively. +-- 'incResourceCount' or 'decResourceCount' respectively. alterResourceCount :: Resource -- ^ the resource -> Int @@ -306,3 +383,33 @@ | n < 0 = decResourceCount r (- n) | n > 0 = incResourceCount r n | n == 0 = return () + +-- | Signal triggered when one of the resource counters changes. +resourceChanged_ :: Resource -> Signal () +resourceChanged_ r = + resourceCountChanged_ r <> + resourceUtilisationCountChanged_ r + +-- | Update the resource count and its statistics. +updateResourceCount :: Resource -> Int -> Event () +updateResourceCount r delta = + Event $ \p -> + do a <- readIORef (resourceCountRef r) + let a' = a + delta + a' `seq` writeIORef (resourceCountRef r) a' + modifyIORef' (resourceCountStatsRef r) $ + addTimingStats (pointTime p) a' + invokeEvent p $ + triggerSignal (resourceCountSource r) a' + +-- | Update the resource utilisation count and its statistics. +updateResourceUtilisationCount :: Resource -> Int -> Event () +updateResourceUtilisationCount r delta = + Event $ \p -> + do a <- readIORef (resourceUtilisationCountRef r) + let a' = a + delta + a' `seq` writeIORef (resourceUtilisationCountRef r) a' + modifyIORef' (resourceUtilisationCountStatsRef r) $ + addTimingStats (pointTime p) a' + invokeEvent p $ + triggerSignal (resourceUtilisationCountSource r) a' diff --git a/Simulation/Aivika/Resource/Preemption/Base.hs b/Simulation/Aivika/Resource/Preemption/Base.hs new file mode 100644 --- /dev/null +++ b/Simulation/Aivika/Resource/Preemption/Base.hs @@ -0,0 +1,310 @@ + +-- | +-- Module : Simulation.Aivika.Resource.Preemption.Base +-- Copyright : Copyright (c) 2009-2015, David Sorokin +-- License : BSD3 +-- Maintainer : David Sorokin +-- Stability : experimental +-- Tested with: GHC 7.10.1 +-- +-- This module defines the preemptible resource. +-- +-- The module is optimised in the sense that this kind of the resource +-- has neither additional signals, nor counters that would may slow +-- down the simulation. +-- +module Simulation.Aivika.Resource.Preemption.Base + (-- * Resource Type + Resource, + -- * Creating Resource + newResource, + newResourceWithMaxCount, + -- * Resource Properties + resourceMaxCount, + resourceCount, + -- * Requesting for and Releasing Resource + requestResourceWithPriority, + releaseResource, + usingResourceWithPriority, + -- * Altering Resource + incResourceCount, + decResourceCount, + alterResourceCount) where + +import Data.IORef + +import Control.Monad +import Control.Monad.Trans +import Control.Exception + +import Simulation.Aivika.Internal.Specs +import Simulation.Aivika.Internal.Simulation +import Simulation.Aivika.Internal.Event +import Simulation.Aivika.Internal.Cont +import Simulation.Aivika.Internal.Process +import Simulation.Aivika.QueueStrategy + +import qualified Simulation.Aivika.PriorityQueue as PQ + +-- | Represents a preemptible resource. +data Resource = + Resource { resourceMaxCount :: Maybe Int, + -- ^ Return the maximum count of the resource, where 'Nothing' + -- means that the resource has no upper bound. + resourceCountRef :: IORef Int, + resourceActingQueue :: PQ.PriorityQueue ResourceActingItem, + resourceWaitQueue :: PQ.PriorityQueue ResourceAwaitingItem } + +-- | Identifies an acting item that acquired the resource. +data ResourceActingItem = + ResourceActingItem { actingItemPriority :: Double, + actingItemId :: ProcessId } + +-- | Idenitifies an awaiting item that waits for releasing of the resource to take it. +type ResourceAwaitingItem = Either ResourceRequestingItem ResourcePreemptedItem + +-- | Idenitifies an item that requests for the resource. +data ResourceRequestingItem = + ResourceRequestingItem { requestingItemPriority :: Double, + requestingItemId :: ProcessId, + requestingItemCont :: FrozenCont () } + +-- | Idenitifies an item that was preempted. +data ResourcePreemptedItem = + ResourcePreemptedItem { preemptedItemPriority :: Double, + preemptedItemId :: ProcessId } + +instance Eq Resource where + x == y = resourceCountRef x == resourceCountRef y -- unique references + +instance Eq ResourceActingItem where + x == y = actingItemId x == actingItemId y + +-- | Create a new resource with the specified initial count that becomes the upper bound as well. +newResource :: Int + -- ^ the initial count (and maximal count too) of the resource + -> Simulation Resource +newResource count = + Simulation $ \r -> + do when (count < 0) $ + error $ + "The resource count cannot be negative: " ++ + "newResource." + countRef <- newIORef count + actingQueue <- PQ.newQueue + waitQueue <- PQ.newQueue + return Resource { resourceMaxCount = Just count, + resourceCountRef = countRef, + resourceActingQueue = actingQueue, + resourceWaitQueue = waitQueue } + +-- | Create a new resource with the specified initial and maximum counts, +-- where 'Nothing' means that the resource has no upper bound. +newResourceWithMaxCount :: Int + -- ^ the initial count of the resource + -> Maybe Int + -- ^ the maximum count of the resource, which can be indefinite + -> Simulation Resource +newResourceWithMaxCount count maxCount = + Simulation $ \r -> + do when (count < 0) $ + error $ + "The resource count cannot be negative: " ++ + "newResourceWithMaxCount." + case maxCount of + Just maxCount | count > maxCount -> + error $ + "The resource count cannot be greater than " ++ + "its maximum value: newResourceWithMaxCount." + _ -> + return () + countRef <- newIORef count + actingQueue <- PQ.newQueue + waitQueue <- PQ.newQueue + return Resource { resourceMaxCount = maxCount, + resourceCountRef = countRef, + resourceActingQueue = actingQueue, + resourceWaitQueue = waitQueue } + +-- | Return the current count of the resource. +resourceCount :: Resource -> Event Int +resourceCount r = + Event $ \p -> readIORef (resourceCountRef r) + +-- | Request with the priority for the resource decreasing its count +-- in case of success, otherwise suspending the discontinuous process +-- until some other process releases the resource. +-- +-- It may preempt another process if the latter aquired the resource before +-- but had a lower priority. Then the current process takes an ownership of +-- the resource. +requestResourceWithPriority :: Resource + -- ^ the requested resource + -> Double + -- ^ the priority (the less value has a higher priority) + -> Process () +requestResourceWithPriority r priority = + Process $ \pid -> + Cont $ \c -> + Event $ \p -> + do a <- readIORef (resourceCountRef r) + if a == 0 + then do f <- PQ.queueNull (resourceActingQueue r) + if f + then do c <- invokeEvent p $ + freezeContReentering c () $ + invokeCont c $ + invokeProcess pid $ + requestResourceWithPriority r priority + PQ.enqueue (resourceWaitQueue r) priority (Left $ ResourceRequestingItem priority pid c) + else do (p0', item0) <- PQ.queueFront (resourceActingQueue r) + let p0 = - p0' + pid0 = actingItemId item0 + if priority < p0 + then do PQ.dequeue (resourceActingQueue r) + PQ.enqueue (resourceActingQueue r) (- priority) $ ResourceActingItem priority pid + PQ.enqueue (resourceWaitQueue r) p0 (Right $ ResourcePreemptedItem p0 pid0) + invokeEvent p $ processPreemptionBegin pid0 + invokeEvent p $ resumeCont c () + else do c <- invokeEvent p $ + freezeContReentering c () $ + invokeCont c $ + invokeProcess pid $ + requestResourceWithPriority r priority + PQ.enqueue (resourceWaitQueue r) priority (Left $ ResourceRequestingItem priority pid c) + else do let a' = a - 1 + a' `seq` writeIORef (resourceCountRef r) a' + PQ.enqueue (resourceActingQueue r) (- priority) $ ResourceActingItem priority pid + invokeEvent p $ resumeCont c () + +-- | Release the resource increasing its count and resuming one of the +-- previously suspended or preempted processes as possible. +releaseResource :: Resource + -- ^ the resource to release + -> Process () +releaseResource r = + Process $ \pid -> + Cont $ \c -> + Event $ \p -> + do f <- PQ.removeBy (resourceActingQueue r) (\item -> actingItemId item == pid) + if f + then do invokeEvent p $ releaseResource' r + invokeEvent p $ resumeCont c () + else error $ + "The resource was not acquired by this process: releaseResource" + +-- | Release the resource increasing its count and resuming one of the +-- previously suspended or preempted processes as possible. +releaseResource' :: Resource + -- ^ the resource to release + -> Event () +releaseResource' r = + Event $ \p -> + do a <- readIORef (resourceCountRef r) + let a' = a + 1 + case resourceMaxCount r of + Just maxCount | a' > maxCount -> + error $ + "The resource count cannot be greater than " ++ + "its maximum value: releaseResource'." + _ -> + return () + f <- PQ.queueNull (resourceWaitQueue r) + if f + then a' `seq` writeIORef (resourceCountRef r) a' + else do (priority', item) <- PQ.queueFront (resourceWaitQueue r) + PQ.dequeue (resourceWaitQueue r) + case item of + Left (ResourceRequestingItem priority pid c) -> + do c <- invokeEvent p $ unfreezeCont c + case c of + Nothing -> + invokeEvent p $ releaseResource' r + Just c -> + do PQ.enqueue (resourceActingQueue r) (- priority) $ ResourceActingItem priority pid + invokeEvent p $ enqueueEvent (pointTime p) $ resumeCont c () + Right (ResourcePreemptedItem priority pid) -> + do f <- invokeEvent p $ processCancelled pid + case f of + True -> + invokeEvent p $ releaseResource' r + False -> + do PQ.enqueue (resourceActingQueue r) (- priority) $ ResourceActingItem priority pid + invokeEvent p $ processPreemptionEnd pid + +-- | Acquire the resource with the specified priority, perform some action and +-- safely release the resource in the end, even if the 'IOException' was raised +-- within the action. +usingResourceWithPriority :: Resource + -- ^ the resource we are going to request for and then + -- release in the end + -> Double + -- ^ the priority (the less value has a higher priority) + -> Process a + -- ^ the action we are going to apply having the resource + -> Process a + -- ^ the result of the action +usingResourceWithPriority r priority m = + do requestResourceWithPriority r priority + finallyProcess m $ releaseResource r + +-- | Preempt a process with the lowest priority that acquires yet the resource +-- and decrease the count of available resource by 1. +decResourceCount' :: Resource -> Event () +decResourceCount' r = + Event $ \p -> + do a <- readIORef (resourceCountRef r) + when (a == 0) $ + error $ + "The resource exceeded and its count is zero: decResourceCount'" + f <- PQ.queueNull (resourceActingQueue r) + unless f $ + do (p0', item0) <- PQ.queueFront (resourceActingQueue r) + let p0 = - p0' + pid0 = actingItemId item0 + PQ.dequeue (resourceActingQueue r) + PQ.enqueue (resourceWaitQueue r) p0 (Right $ ResourcePreemptedItem p0 pid0) + invokeEvent p $ processPreemptionBegin pid0 + let a' = a - 1 + a' `seq` writeIORef (resourceCountRef r) a' + +-- | Increase the count of available resource by the specified number, +-- invoking the awaiting and preempted processes according to their priorities +-- as needed. +incResourceCount :: Resource + -- ^ the resource + -> Int + -- ^ the increment for the resource count + -> Event () +incResourceCount r n + | n < 0 = error "The increment cannot be negative: incResourceCount" + | n == 0 = return () + | otherwise = + do releaseResource' r + incResourceCount r (n - 1) + +-- | Decrease the count of available resource by the specified number, +-- preempting the processes according to their priorities as needed. +decResourceCount :: Resource + -- ^ the resource + -> Int + -- ^ the decrement for the resource count + -> Event () +decResourceCount r n + | n < 0 = error "The decrement cannot be negative: decResourceCount" + | n == 0 = return () + | otherwise = + do decResourceCount' r + decResourceCount r (n - 1) + +-- | Alter the resource count either increasing or decreasing it by calling +-- 'incResourceCount' or 'decResourceCount' respectively. +alterResourceCount :: Resource + -- ^ the resource + -> Int + -- ^ a change of the resource count + -> Event () +alterResourceCount r n + | n < 0 = decResourceCount r (- n) + | n > 0 = incResourceCount r n + | n == 0 = return () diff --git a/Simulation/Aivika/Results.hs b/Simulation/Aivika/Results.hs --- a/Simulation/Aivika/Results.hs +++ b/Simulation/Aivika/Results.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- The module allows exporting the simulation results from the model. -- @@ -124,7 +124,7 @@ import Simulation.Aivika.Statistics import Simulation.Aivika.Statistics.Accumulator import Simulation.Aivika.Ref -import qualified Simulation.Aivika.Ref.Plain as LR +import qualified Simulation.Aivika.Ref.Base as BR import Simulation.Aivika.Var import Simulation.Aivika.QueueStrategy import qualified Simulation.Aivika.Queue as Q @@ -132,6 +132,8 @@ import Simulation.Aivika.Arrival import Simulation.Aivika.Server import Simulation.Aivika.Activity +import Simulation.Aivika.Resource +import qualified Simulation.Aivika.Resource.Preemption as PR import Simulation.Aivika.Results.Locale -- | A name used for indentifying the results when generating output. @@ -1329,9 +1331,9 @@ computeResultData = readRef computeResultSignal = ResultSignal . refChanged_ -instance ResultComputing LR.Ref where +instance ResultComputing BR.Ref where - computeResultData = LR.readRef + computeResultData = BR.readRef computeResultSignal = const UnknownResultSignal instance ResultComputing Var where @@ -1739,6 +1741,75 @@ resultContainerProperty c "idleFactor" ActivityIdleFactorId activityIdleFactor activityIdleFactorChanged_, resultContainerProperty c "preemptionFactor" ActivityPreemptionFactorId activityPreemptionFactor activityPreemptionFactorChanged_ ] } +-- | Return a source by the specified resource. +resourceResultSource :: (Show s, ResultItemable (ResultValue s)) + => ResultContainer (Resource s) + -- ^ the resource container + -> ResultSource +resourceResultSource c = + ResultObjectSource $ + ResultObject { + resultObjectName = resultContainerName c, + resultObjectId = resultContainerId c, + resultObjectTypeId = ResourceId, + resultObjectSignal = resultContainerSignal c, + resultObjectSummary = resourceResultSummary c, + resultObjectProperties = [ + resultContainerProperty c "count" ResourceCountId resourceCount resourceCountChanged_, + resultContainerProperty c "countStats" ResourceCountStatsId resourceCountStats resourceCountChanged_, + resultContainerProperty c "utilisationCount" ResourceUtilisationCountId resourceUtilisationCount resourceUtilisationCountChanged_, + resultContainerProperty c "utilisationCountStats" ResourceUtilisationCountStatsId resourceUtilisationCountStats resourceUtilisationCountChanged_ ] } + +-- | Return a summary by the specified resource. +resourceResultSummary :: ResultContainer (Resource s) + -- ^ the resource container + -> ResultSource +resourceResultSummary c = + ResultObjectSource $ + ResultObject { + resultObjectName = resultContainerName c, + resultObjectId = resultContainerId c, + resultObjectTypeId = ResourceId, + resultObjectSignal = resultContainerSignal c, + resultObjectSummary = resourceResultSummary c, + resultObjectProperties = [ + resultContainerProperty c "countStats" ResourceCountStatsId resourceCountStats resourceCountChanged_, + resultContainerProperty c "utilisationCountStats" ResourceUtilisationCountStatsId resourceUtilisationCountStats resourceUtilisationCountChanged_ ] } + +-- | Return a source by the specified resource. +preemptibleResourceResultSource :: ResultContainer PR.Resource + -- ^ the resource container + -> ResultSource +preemptibleResourceResultSource c = + ResultObjectSource $ + ResultObject { + resultObjectName = resultContainerName c, + resultObjectId = resultContainerId c, + resultObjectTypeId = ResourceId, + resultObjectSignal = resultContainerSignal c, + resultObjectSummary = preemptibleResourceResultSummary c, + resultObjectProperties = [ + resultContainerProperty c "count" ResourceCountId PR.resourceCount PR.resourceCountChanged_, + resultContainerProperty c "countStats" ResourceCountStatsId PR.resourceCountStats PR.resourceCountChanged_, + resultContainerProperty c "utilisationCount" ResourceUtilisationCountId PR.resourceUtilisationCount PR.resourceUtilisationCountChanged_, + resultContainerProperty c "utilisationCountStats" ResourceUtilisationCountStatsId PR.resourceUtilisationCountStats PR.resourceUtilisationCountChanged_ ] } + +-- | Return a summary by the specified resource. +preemptibleResourceResultSummary :: ResultContainer PR.Resource + -- ^ the resource container + -> ResultSource +preemptibleResourceResultSummary c = + ResultObjectSource $ + ResultObject { + resultObjectName = resultContainerName c, + resultObjectId = resultContainerId c, + resultObjectTypeId = ResourceId, + resultObjectSignal = resultContainerSignal c, + resultObjectSummary = preemptibleResourceResultSummary c, + resultObjectProperties = [ + resultContainerProperty c "countStats" ResourceCountStatsId PR.resourceCountStats PR.resourceCountChanged_, + resultContainerProperty c "utilisationCountStats" ResourceUtilisationCountStatsId PR.resourceUtilisationCountStats PR.resourceUtilisationCountChanged_ ] } + -- | Return an arbitrary text as a separator source. textResultSource :: String -> ResultSource textResultSource text = @@ -1969,3 +2040,13 @@ resultSource' name i m = activityResultSource $ ResultContainer name i m (ResultSignal $ activityChanged_ m) + +instance (Show s, ResultItemable (ResultValue s)) => ResultProvider (Resource s) where + + resultSource' name i m = + resourceResultSource $ ResultContainer name i m (ResultSignal $ resourceChanged_ m) + +instance ResultProvider PR.Resource where + + resultSource' name i m = + preemptibleResourceResultSource $ ResultContainer name i m (ResultSignal $ PR.resourceChanged_ m) diff --git a/Simulation/Aivika/Results/IO.hs b/Simulation/Aivika/Results/IO.hs --- a/Simulation/Aivika/Results/IO.hs +++ b/Simulation/Aivika/Results/IO.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- The module allows printing and converting the 'Simulation' 'Results' to a 'String'. -- diff --git a/Simulation/Aivika/Results/Locale.hs b/Simulation/Aivika/Results/Locale.hs --- a/Simulation/Aivika/Results/Locale.hs +++ b/Simulation/Aivika/Results/Locale.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- The module defines locales for outputting and printing the simulation results. -- @@ -34,6 +34,7 @@ import Simulation.Aivika.Arrival import Simulation.Aivika.Server import Simulation.Aivika.Activity +import Simulation.Aivika.Resource -- | A locale to output the simulation results. -- @@ -215,6 +216,16 @@ -- ^ Property 'activityIdleFactor'. | ActivityPreemptionFactorId -- ^ Property 'activityPreemptionFactor'. + | ResourceId + -- ^ Represents a 'Resource'. + | ResourceCountId + -- ^ Property 'resourceCount'. + | ResourceCountStatsId + -- ^ Property 'resourceCountStats'. + | ResourceUtilisationCountId + -- ^ Property 'resourceUtilisationCount'. + | ResourceUtilisationCountStatsId + -- ^ Property 'resourceUtilisationCountStats'. | UserDefinedResultId ResultDescription -- ^ An user defined description. | LocalisedResultId (M.Map ResultLocale ResultDescription) @@ -315,6 +326,11 @@ russianResultLocalisation ActivityUtilisationFactorId = "относительное время использования (от 0 до 1)" russianResultLocalisation ActivityIdleFactorId = "относительное время простоя (от 0 до 1)" russianResultLocalisation ActivityPreemptionFactorId = "относительное время вытеснения (от 0 до 1)" +russianResultLocalisation ResourceId = "ресурс" +russianResultLocalisation ResourceCountId = "текущее доступное количество ресурса" +russianResultLocalisation ResourceCountStatsId = "статистика по доступному количеству ресурса" +russianResultLocalisation ResourceUtilisationCountId = "текущее используемое количество ресурса" +russianResultLocalisation ResourceUtilisationCountStatsId = "статистика по используемому количеству ресурса" russianResultLocalisation (UserDefinedResultId m) = m russianResultLocalisation x@(LocalisedResultId m) = lookupResultLocalisation russianResultLocale x @@ -405,6 +421,11 @@ englishResultLocalisation ActivityUtilisationFactorId = "the relative utilisation time (от 0 до 1)" englishResultLocalisation ActivityIdleFactorId = "the relative idle time (от 0 до 1)" englishResultLocalisation ActivityPreemptionFactorId = "the relative preemption time (от 0 до 1)" +englishResultLocalisation ResourceId = "the resource" +englishResultLocalisation ResourceCountId = "the current available count" +englishResultLocalisation ResourceCountStatsId = "the available count statistics" +englishResultLocalisation ResourceUtilisationCountId = "the current utilisation count" +englishResultLocalisation ResourceUtilisationCountStatsId = "the utilisation count statistics" englishResultLocalisation (UserDefinedResultId m) = m englishResultLocalisation x@(LocalisedResultId m) = lookupResultLocalisation englishResultLocale x diff --git a/Simulation/Aivika/Server.hs b/Simulation/Aivika/Server.hs --- a/Simulation/Aivika/Server.hs +++ b/Simulation/Aivika/Server.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- It models the server that prodives a service. module Simulation.Aivika.Server @@ -81,7 +81,6 @@ import Simulation.Aivika.Dynamics import Simulation.Aivika.Internal.Event import Simulation.Aivika.Signal -import Simulation.Aivika.Resource import Simulation.Aivika.Cont import Simulation.Aivika.Process import Simulation.Aivika.Processor @@ -626,11 +625,11 @@ serverInputReceived :: Server s a b -> Signal a serverInputReceived = publishSignal . serverInputReceivedSource --- | Raised when the task processing by the server was preempted. +-- | Raised when the task processing was preempted. serverTaskPreemptionBeginning :: Server s a b -> Signal a serverTaskPreemptionBeginning = publishSignal . serverTaskPreemptionBeginningSource --- | Raised when the task processing by the server was proceeded after it has been preempeted earlier. +-- | Raised when the task processing was proceeded after it had been preempeted earlier. serverTaskPreemptionEnding :: Server s a b -> Signal a serverTaskPreemptionEnding = publishSignal . serverTaskPreemptionEndingSource diff --git a/Simulation/Aivika/Server/Random.hs b/Simulation/Aivika/Server/Random.hs --- a/Simulation/Aivika/Server/Random.hs +++ b/Simulation/Aivika/Server/Random.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines some useful predefined servers that -- hold the current process for the corresponding random time diff --git a/Simulation/Aivika/Signal.hs b/Simulation/Aivika/Signal.hs --- a/Simulation/Aivika/Signal.hs +++ b/Simulation/Aivika/Signal.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines the signal which we can subscribe handlers to. -- These handlers can be disposed. The signal is triggered in the diff --git a/Simulation/Aivika/Simulation.hs b/Simulation/Aivika/Simulation.hs --- a/Simulation/Aivika/Simulation.hs +++ b/Simulation/Aivika/Simulation.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- The module defines the 'Simulation' monad that represents a computation within -- the simulation run. diff --git a/Simulation/Aivika/Specs.hs b/Simulation/Aivika/Specs.hs --- a/Simulation/Aivika/Specs.hs +++ b/Simulation/Aivika/Specs.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- It defines the simulation specs and functions for this data type. module Simulation.Aivika.Specs diff --git a/Simulation/Aivika/Statistics.hs b/Simulation/Aivika/Statistics.hs --- a/Simulation/Aivika/Statistics.hs +++ b/Simulation/Aivika/Statistics.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- Represents statistics. -- diff --git a/Simulation/Aivika/Statistics/Accumulator.hs b/Simulation/Aivika/Statistics/Accumulator.hs --- a/Simulation/Aivika/Statistics/Accumulator.hs +++ b/Simulation/Aivika/Statistics/Accumulator.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This small utility module allows accumulating the timing statistics based on 'Signalable' data -- such as the queue size or the number of lost items in the queue. diff --git a/Simulation/Aivika/Stream.hs b/Simulation/Aivika/Stream.hs --- a/Simulation/Aivika/Stream.hs +++ b/Simulation/Aivika/Stream.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- The infinite stream of data in time. -- @@ -86,7 +86,7 @@ import Simulation.Aivika.Cont import Simulation.Aivika.Process import Simulation.Aivika.Signal -import Simulation.Aivika.Resource +import Simulation.Aivika.Resource.Base import Simulation.Aivika.QueueStrategy import Simulation.Aivika.Queue.Infinite import Simulation.Aivika.Internal.Arrival diff --git a/Simulation/Aivika/Stream/Random.hs b/Simulation/Aivika/Stream/Random.hs --- a/Simulation/Aivika/Stream/Random.hs +++ b/Simulation/Aivika/Stream/Random.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines random streams of events, which are useful -- for describing the input of the model. diff --git a/Simulation/Aivika/SystemDynamics.hs b/Simulation/Aivika/SystemDynamics.hs --- a/Simulation/Aivika/SystemDynamics.hs +++ b/Simulation/Aivika/SystemDynamics.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines integrals and other functions of System Dynamics. -- diff --git a/Simulation/Aivika/Table.hs b/Simulation/Aivika/Table.hs --- a/Simulation/Aivika/Table.hs +++ b/Simulation/Aivika/Table.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- It defines the table functions. -- diff --git a/Simulation/Aivika/Task.hs b/Simulation/Aivika/Task.hs --- a/Simulation/Aivika/Task.hs +++ b/Simulation/Aivika/Task.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- The 'Task' value represents a process that was already started in background. -- We can check the completion of the task, receive notifications about changing diff --git a/Simulation/Aivika/Transform.hs b/Simulation/Aivika/Transform.hs --- a/Simulation/Aivika/Transform.hs +++ b/Simulation/Aivika/Transform.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- The module defines something which is most close to the notion of -- analogous circuit as an opposite to the digital one. diff --git a/Simulation/Aivika/Transform/Extra.hs b/Simulation/Aivika/Transform/Extra.hs --- a/Simulation/Aivika/Transform/Extra.hs +++ b/Simulation/Aivika/Transform/Extra.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines auxiliary computations such as interpolation ones -- that complement the memoization, for example. There are scan computations too. diff --git a/Simulation/Aivika/Transform/Memo.hs b/Simulation/Aivika/Transform/Memo.hs --- a/Simulation/Aivika/Transform/Memo.hs +++ b/Simulation/Aivika/Transform/Memo.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines memoization transforms. The memoization creates such 'Dynamics' -- computations, which values are cached in the integration time points. Then diff --git a/Simulation/Aivika/Transform/Memo/Unboxed.hs b/Simulation/Aivika/Transform/Memo/Unboxed.hs --- a/Simulation/Aivika/Transform/Memo/Unboxed.hs +++ b/Simulation/Aivika/Transform/Memo/Unboxed.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines the unboxed memoization transforms. The memoization creates such 'Dynamics' -- computations, which values are cached in the integration time points. Then diff --git a/Simulation/Aivika/Unboxed.hs b/Simulation/Aivika/Unboxed.hs --- a/Simulation/Aivika/Unboxed.hs +++ b/Simulation/Aivika/Unboxed.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- The 'Unboxed' class allows creating unboxed arrays in monad 'IO'. -- diff --git a/Simulation/Aivika/Var.hs b/Simulation/Aivika/Var.hs --- a/Simulation/Aivika/Var.hs +++ b/Simulation/Aivika/Var.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines a variable that is bound up with the event queue and -- that keeps the history of changes storing the values in arrays, which diff --git a/Simulation/Aivika/Var/Unboxed.hs b/Simulation/Aivika/Var/Unboxed.hs --- a/Simulation/Aivika/Var/Unboxed.hs +++ b/Simulation/Aivika/Var/Unboxed.hs @@ -5,7 +5,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- This module defines an unboxed variable that is bound up with the event queue and -- that keeps the history of changes storing the values in unboxed arrays, which diff --git a/Simulation/Aivika/Vector.hs b/Simulation/Aivika/Vector.hs --- a/Simulation/Aivika/Vector.hs +++ b/Simulation/Aivika/Vector.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- An imperative vector. -- diff --git a/Simulation/Aivika/Vector/Unboxed.hs b/Simulation/Aivika/Vector/Unboxed.hs --- a/Simulation/Aivika/Vector/Unboxed.hs +++ b/Simulation/Aivika/Vector/Unboxed.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental --- Tested with: GHC 7.8.3 +-- Tested with: GHC 7.10.1 -- -- An imperative unboxed vector. -- diff --git a/aivika.cabal b/aivika.cabal --- a/aivika.cabal +++ b/aivika.cabal @@ -1,5 +1,5 @@ name: aivika -version: 4.0.3 +version: 4.1 synopsis: A multi-paradigm simulation library description: Aivika is a multi-paradigm simulation library with a strong emphasis @@ -96,7 +96,7 @@ homepage: http://github.com/dsorokin/aivika cabal-version: >= 1.10 build-type: Simple -tested-with: GHC == 7.8.3 +tested-with: GHC == 7.10.1 extra-source-files: examples/BassDiffusion.hs examples/BouncingBall.hs @@ -117,6 +117,8 @@ examples/TimeOut.hs examples/TimeOutInt.hs examples/TimeOutWait.hs + examples/PingPong.hs + examples/PortOperations.hs CHANGELOG.md library @@ -150,9 +152,11 @@ Simulation.Aivika.Queue.Infinite Simulation.Aivika.QueueStrategy Simulation.Aivika.Ref - Simulation.Aivika.Ref.Plain + Simulation.Aivika.Ref.Base Simulation.Aivika.Resource + Simulation.Aivika.Resource.Base Simulation.Aivika.Resource.Preemption + Simulation.Aivika.Resource.Preemption.Base Simulation.Aivika.Results.Locale Simulation.Aivika.Results Simulation.Aivika.Results.IO diff --git a/examples/ChemicalReaction.hs b/examples/ChemicalReaction.hs --- a/examples/ChemicalReaction.hs +++ b/examples/ChemicalReaction.hs @@ -7,8 +7,6 @@ import Simulation.Aivika import Simulation.Aivika.SystemDynamics -import qualified Data.Vector as V - specs = Specs { spcStartTime = 0, spcStopTime = 13, spcDT = 0.01, diff --git a/examples/Furnace.hs b/examples/Furnace.hs --- a/examples/Furnace.hs +++ b/examples/Furnace.hs @@ -1,9 +1,51 @@ --- This is a model of the Furnace. It is described in different sources [1, 2]. +-- This is a model of the soaking pit furnace. It is described in different sources [1, 2]. -- -- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed. -- -- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 +-- +-- Steel ingots arrive at a soaking pit furnace in a steel plant with +-- an interarrival time that is exponentially distributed with mean +-- of 2.25 hours. The soaking pit furnace heats an ingot so that it +-- can be economically rolled in the next stage of the process. +-- The temperature change of an ingot in the soaking pit furnace is +-- described by the following differential equation. +-- +-- d(h_i)/dt = (H - h_i) * C_i, +-- +-- where h_i is the temperature of the i-th ingot in the soaking pit; +-- C_i is the heating time coefficient of an ingot and is equal to X + 0.1 +-- where X is normally distributed with mean of 0.05 and standard deviation +-- of 0.01; and H is the furnace temperature which is heated toward 2600 F +-- with a heating rate constant if 0.2, that is, +-- +-- dH/dt = (2600 - H) * 0.2. +-- +-- The ingots interact with one another in that adding a "cold" ingot +-- to the furnace reduces the temperature of the furnace and thus changes +-- the heating time for all ingots in the furnace. The temperature reduction +-- is equal to the difference between furnace and ingot temperatures, divided +-- by the number of ingots in the furnace. There are 10 soaking pits in +-- the furnace. When a new ingot arrives and the furnace is full, it is +-- stored in an ingot storage bank. It is assumed that the initial temperature +-- of an arriving ingot is uniformly distributed in the interval from 400 to 500 F. +-- All ingots put in the ingot storage bank are assumed to have a temperature of +-- 400 F upon insertion into the soaking pit. The operating policy of the company +-- is to continue heating the ingots in the furnace until one or more ingots +-- reach 2200 F. At such a time all ingots with a temperature greater than 2000 F +-- are removed. The initial conditions are that there are six ingots in the furnace +-- with initial temperatures of 550, 600, 650, 700, 750 and 800 F. Initially, +-- the temperature of the furnace is 1650 F, and the next ingot is due to arrive +-- at time 0. +-- +-- The objective is to simulate the above system for 500 hours to obtain +-- estimates of the following quantities: +-- +-- 1) heating time of the ingots; +-- 2) final temperature distribution of the ingots; +-- 3) waiting time of the ingots in the ingot storage bank; and +-- 4) utilization of the soaking pit furnace. import Data.Maybe import System.Random diff --git a/examples/InspectionAdjustmentStations.hs b/examples/InspectionAdjustmentStations.hs --- a/examples/InspectionAdjustmentStations.hs +++ b/examples/InspectionAdjustmentStations.hs @@ -6,10 +6,6 @@ -- This is a model of the workflow with a loop. Also there are two infinite queues. -- -- It is described in different sources [1, 2]. So, this is chapter 8 of [2] and section 5.15 of [1]. --- --- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed. --- --- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 -- -- Assembled television sets move through a series of testing stations in the final -- stage of their production. At the last of these stations, the vertical control @@ -30,6 +26,9 @@ -- The inspection station and adjustor are to be simulated for 480 minutes to estimate -- the time to process television sets through the final production stage and to determine -- the utilization of the inspectors and the adjustors. +-- +-- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed. +-- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 import Prelude hiding (id, (.)) diff --git a/examples/InventorySystem.hs b/examples/InventorySystem.hs --- a/examples/InventorySystem.hs +++ b/examples/InventorySystem.hs @@ -3,14 +3,40 @@ -- -- It is described in different sources [1, 2]. So, this is chapter 11 of [2] and section 6.7 of [1]. -- --- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed. +-- A large discount house is planning to install a system to control the inventory of +-- a particular radio. The time between demands for a radio is exponentially distributed +-- with a mean time of 0.2 weeks. In the case where customers demand the radio when it +-- is not in stock, 80 percent will go to another nearby discount house to find it, thereby +-- representing lost sales, while the other 20 percent will backorder the radio and wait +-- for the next shipment arrival. The store employs a periodic review-reorder point +-- inventory system where the inventory status is reviewed every four weeks to decide if +-- an order should be placed. The company policy is to order up to the stock control level +-- of 72 radios whenever the inventory position, consisting of the radios in stock plus +-- the radios on order minus the radios on backorder, is found to be less than or equal to +-- the reorder point of 18 radios. The procurement lead time (the time from the placement +-- of an order to its receipt) is constant and requires three weeks. -- +-- The objective of this example is to simulate the inventory system for a period of six +-- years (312 weeks) to obtain statistics on the following quantities: +-- +-- 1) number of radios in stock; +-- 2) inventory position; +-- 3) safety stock (radios in stock at order receipt times); and +-- 4) time between lost sales. +-- +-- The initial conditions for the simulation are an inventory position of 72 and no +-- initial backorders. In order to reduce the bias in the statistics due to the initial +-- starting conditions, all the statistics are to be cleared at the end of the first year +-- of the six year simulation period. +-- +-- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed. -- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 import Control.Monad import Control.Monad.Trans import Simulation.Aivika +import qualified Simulation.Aivika.Resource as R -- | The simulation specs. specs = Specs { spcStartTime = 0.0, @@ -50,7 +76,7 @@ -- the inventory position invPos <- newRef $ returnTimingCounter t0 radio0 -- the radios in stock - radio <- newFCFSResource radio0 + radio <- runEventInStartTime $ R.newFCFSResource radio0 -- the time between lost sales tbLostSales <- newRef emptySamplingStats -- the last arrive time for the lost sale @@ -62,7 +88,7 @@ modifyRef invPos $ decTimingCounter t 1 runProcess $ - requestResource radio + R.requestResource radio -- a customer has been lost let customerLost :: Event () customerLost = do @@ -79,7 +105,7 @@ customerArrival = do randomExponentialProcess_ avgRadioDemand liftEvent $ do - r <- resourceCount radio + r <- R.resourceCount radio if r > 0 then customerOrder else do b <- liftParameter $ @@ -105,10 +131,10 @@ setTimingCounter t stockControlLevel holdProcess leadTime liftEvent $ - do r <- resourceCount radio + do r <- R.resourceCount radio modifyRef safetyStock $ addSamplingStats r - incResourceCount radio orderQty + R.incResourceCount radio orderQty -- start the inventory review process runEventInStartTime $ enqueueEventWithTimes [t0, t0 + reviewPeriod ..] $ @@ -126,7 +152,7 @@ results [resultSource "radio" "the number of radios in stock" - (resourceCount radio), + radio, -- resultSource "invPos" "the inventory position" diff --git a/examples/MachineBreakdowns.hs b/examples/MachineBreakdowns.hs --- a/examples/MachineBreakdowns.hs +++ b/examples/MachineBreakdowns.hs @@ -3,10 +3,6 @@ -- -- It is described in different sources [1, 2]. So, this is chapter 13 of [2] and section 6.12 of [1]. -- --- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed. --- --- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 --- -- Jobs arrive to a machine tool on the average of one per hour. The distribution of -- these interarrival times is exponential. During normal operation, the jobs are -- processed on a first-in, first-out basis. The time to process a job in hours is @@ -30,6 +26,9 @@ -- The machine tool is to be analyzed for 500 hours to obtain information on -- the utilization of the machine tool and the time required to process a job. -- Statistics are to be collected for thousand simulation runs. +-- +-- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed. +-- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 import Control.Monad import Control.Monad.Trans @@ -92,7 +91,7 @@ let inputStream = randomExponentialStream jobArrivingMu -- create a preemptible resource - tool <- PR.newResource 1 + tool <- runEventInStartTime $ PR.newResource 1 -- the machine setting up machineSettingUp <- newPreemptibleRandomUniformServer True minSetUpTime maxSetUpTime @@ -145,7 +144,11 @@ -- resultSource "jobsCompleted" "a counter of the completed jobs" - jobsCompleted] + jobsCompleted, + -- + resultSource + "tool" "the machine tool" + tool] main = printSimulationResultsInStopTime diff --git a/examples/PingPong.hs b/examples/PingPong.hs new file mode 100644 --- /dev/null +++ b/examples/PingPong.hs @@ -0,0 +1,41 @@ + +-- A classic Ping-Pong example. + +import Control.Monad.Trans + +import Simulation.Aivika + +delta = 1.0 + +specs = Specs { spcStartTime = 0, + spcStopTime = 10 * delta, + spcDT = delta, + spcMethod = RungeKutta4, + spcGeneratorType = SimpleGenerator } + +model :: Simulation () +model = + do pingSource <- newSignalSource + pongSource <- newSignalSource + let pingSignal = publishSignal pingSource + pongSignal = publishSignal pongSource + ping = + do holdProcess delta + liftEvent $ + traceEvent "ping" $ + triggerSignal pingSource () + processAwait pongSignal + ping + pong = + do processAwait pingSignal + liftEvent $ + traceEvent "pong" $ + triggerSignal pongSource () + pong + runProcessInStartTime ping + runProcessInStartTime pong + runEventInStopTime $ + traceEvent "end" $ + return () + +main = runSimulation model specs diff --git a/examples/PortOperations.hs b/examples/PortOperations.hs new file mode 100644 --- /dev/null +++ b/examples/PortOperations.hs @@ -0,0 +1,177 @@ + +{-# LANGUAGE RecursiveDo #-} + +-- Example: Port Operations +-- +-- It is described in different sources [1, 2]. So, this is chapter 12 of [2] and section 6.13 of [1]. +-- +-- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed. +-- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 +-- +-- A port in Africa is used to load tankers with crude oil for overwater shipment. +-- The port has facilities for loading as many as three tankers simultaneously. +-- The tankers, which arrive at the port every 11 +/- 7 hours, are of three different +-- types. The relative frequency of the various types, and their loading time +-- requirements, are as follows: +-- +-- Type Relative Frequency Loading Time, Hours +-- 1 0.25 18 +/- 2 +-- 2 0.55 24 +/- 3 +-- 3 0.20 36 +/- 4 +-- +-- There is one tug at the port. Tankers of all types require the services of this tug +-- to move into a berth, and later to move out of a berth. When the tug is available, +-- any berthing or de-berthing activity takes about one hour. Top priority is given to +-- the berthing activity. +-- +-- A shipper is considering bidding on a contract to transport oil from the port to +-- the United Kingdom. He has determined that 5 tankers of a particular type would +-- have to be committed to this task to meet contract specifications. These tankers +-- would require 21 +/- 3 hours to load oil at the port. After loading and de-berthing, +-- they would travel to the United Kingdom, offload the oil, and return to the port for +-- reloading. Their round-trip travel time, including offloading, is estimated to be +-- 240 +/- hours. +-- +-- A complicated factor is that the port experiences storms. The time between +-- the onset of storms is exponentially distributed with a mean of 48 hours and a +-- storm lasts 4 +/- 2 hours. No tug can start an operation until a storm is over. +-- +-- Before the port authorities can commit themselves to accommodating the +-- proposed 5 tankers, the effect of the additional port traffic on the in-port residence +-- time of the current port users must be determined. It is desired to simulate the +-- operation of the port for a one-year period (= 8640 hours) under the proposed new +-- commitment to measure in-port residence time of the proposed additional tankers, +-- as well as the three types of tankers which already use the port. All durations +-- given as ranges are uniformly distributed. + +import Prelude hiding (id, (.)) + +import Control.Monad +import Control.Monad.Trans +import Control.Arrow +import Control.Category (id, (.)) + +import Data.Array + +import Simulation.Aivika +import Simulation.Aivika.Queue +import qualified Simulation.Aivika.Resource as R + +-- | The simulation specs. +specs = Specs { spcStartTime = 0.0, + spcStopTime = 8760.0, + spcDT = 0.1, + spcMethod = RungeKutta4, + spcGeneratorType = SimpleGenerator } + +data Tunker = + Tunker { tunkerLoadingTime :: Double, + tunkerType :: Int } + +model :: Simulation Results +model = mdo + portTime' <- forM [1..4] $ \i -> + newRef emptySamplingStats + let portTime = + array (1, 4) $ zip [1..] portTime' + berth <- + runEventInStartTime $ + R.newFCFSResource 3 + tug <- + runEventInStartTime $ + R.newFCFSResource 1 + let tunkers13 = randomUniformStream 4 18 + tunkers4 = takeStream 5 $ + randomUniformStream 48 48 + runProcessInStartTime $ + flip consumeStream tunkers13 $ \x -> + do p <- liftParameter $ + randomUniform 0 1 + let tp | p <= 0.25 = 1 + | p <= 0.25 + 0.55 = 2 + | otherwise = 3 + case tp of + 1 -> liftEvent arv1 + 2 -> liftEvent arv2 + 3 -> liftEvent arv3 + runProcessInStartTime $ + flip consumeStream tunkers4 $ \x -> + liftEvent arv4 + let arv1 :: Event () + arv1 = do + loadingTime <- liftParameter $ + randomUniform 16 20 + let t = Tunker loadingTime 1 + runProcess (port t) + arv2 :: Event () + arv2 = do + loadingTime <- liftParameter $ + randomUniform 21 27 + let t = Tunker loadingTime 2 + runProcess (port t) + arv3 :: Event () + arv3 = do + loadingTime <- liftParameter $ + randomUniform 32 40 + let t = Tunker loadingTime 3 + runProcess (port t) + arv4 :: Event () + arv4 = do + loadingTime <- liftParameter $ + randomUniform 18 24 + let t = Tunker loadingTime 4 + runProcess (port t) + let port :: Tunker -> Process () + port t = do + t0 <- liftDynamics time + R.requestResource berth + R.requestResource tug + holdProcess 1 + R.releaseResource tug + holdProcess (tunkerLoadingTime t) + R.requestResource tug + holdProcess 1 + R.releaseResource tug + R.releaseResource berth + t1 <- liftDynamics time + let tp = tunkerType t + liftEvent $ + modifyRef (portTime ! tp) $ + addSamplingStats (t1 - t0) + when (tp == 4) $ + liftEvent $ + runProcess $ + do randomUniformProcess_ 216 264 + liftEvent arv4 + storm :: Process () + storm = do + randomExponentialProcess_ 48 + R.decResourceCount tug 1 + randomUniformProcess_ 2 6 + liftEvent $ + R.incResourceCount tug 1 + storm + runProcessInStartTime storm + return $ + results + [resultSource + "portTime" "Port Time" + portTime, + -- + resultSource + "berth" "Berth" + berth, + -- + resultSource + "tug" "Tug" + tug ] + +modelSummary :: Simulation Results +modelSummary = + fmap resultSummary model + +main = + printSimulationResultsInStopTime + printResultSourceInEnglish + -- model specs + modelSummary specs diff --git a/examples/QuarryOperations.hs b/examples/QuarryOperations.hs --- a/examples/QuarryOperations.hs +++ b/examples/QuarryOperations.hs @@ -6,8 +6,25 @@ -- It is described in different sources [1, 2]. So, this is chapter 10 of [2] and section 5.16 of [1]. -- -- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed. --- -- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 +-- +-- In this example, the operations of a quarry are modeled. In the quarry, +-- trucks deliver ore from three shovels to a crusher. A truck always +-- returns to its assigned shovel after dumping a load at the crusher. +-- There are two different truck sizes in use, twenty-ton and fifty-ton. +-- The size of the truck affects its loading time at the shovel, travel +-- time to the crusher, dumping time at the crusher and return trip time +-- from the crusher back to the appropriate shovel. For the twenty-ton +-- trucks, there loading, travel, dumping and return trip times are: +-- exponentially distributed with a mean 5; a constant 2.5; exponentially +-- distributed with mean 2; and a constant 1.5. The corresponding times +-- for the fifty-ton trucks are: exponentially distributed with mean 10; +-- a constant 3; exponentially distributed with mean 4; and a constant 2. +-- To each shovel is assigned two twenty-ton trucks are one fifty-ton truck. +-- The shovel queues are all ranked on a first-in, first-out basis. +-- The crusher queue is ranked on truck size, largest trucks first. +-- It is desired to analyze this system over 480 time units to determine +-- the utilization and queue lengths associated with the shovels and crusher. import Control.Monad import Control.Monad.Trans @@ -138,19 +155,13 @@ IQ.enqueue q t -- utilise the crusher's activity let utiliseCrusher q t = - do dumpingTime <- - liftParameter $ - randomExponential $ + do randomExponentialProcess_ $ truckAvgDumpingTime t - holdProcess dumpingTime return t -- utilise the shovel's activity let utiliseShovel q t = - do loadingTime <- - liftParameter $ - randomExponential $ + do randomExponentialProcess_ $ truckAvgLoadingTime t - holdProcess loadingTime return t -- create shovel activities shovelAct1 <- diff --git a/examples/WorkStationsInSeries.hs b/examples/WorkStationsInSeries.hs --- a/examples/WorkStationsInSeries.hs +++ b/examples/WorkStationsInSeries.hs @@ -5,10 +5,6 @@ -- -- It is described in different sources [1, 2]. So, this is chapter 7 of [2] and section 5.14 of [1]. -- --- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed. --- --- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 --- -- The maintenance facility of a large manufacturer performs two operations. -- These operations must be performed in series; operation 2 always follows operation 1. -- The units that are maintained are bulky, and space is available for only eight units @@ -25,6 +21,9 @@ -- work station 2 is full, that is, if there are two units awaiting for work station 2, -- the first station is blocked and a unit cannot leave the station. A blocked work -- station cannot server other units. +-- +-- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed. +-- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 import Prelude hiding (id, (.))