aivika 3.0 → 3.1
raw patch · 66 files changed
+1022/−976 lines, 66 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Simulation.Aivika.Results: ResultExtract :: ResultName -> ResultId -> Event e -> ResultSignal -> ResultExtract e
- Simulation.Aivika.Results: data ResultExtract e
- Simulation.Aivika.Results: extractDoubleListResults :: Results -> [ResultExtract [Double]]
- Simulation.Aivika.Results: extractDoubleResults :: Results -> [ResultExtract Double]
- Simulation.Aivika.Results: extractDoubleStatsEitherResults :: Results -> [ResultExtract (Either Double (SamplingStats Double))]
- Simulation.Aivika.Results: extractDoubleStatsResults :: Results -> [ResultExtract (SamplingStats Double)]
- Simulation.Aivika.Results: extractDoubleTimingStatsResults :: Results -> [ResultExtract (TimingStats Double)]
- Simulation.Aivika.Results: extractIntListResults :: Results -> [ResultExtract [Int]]
- Simulation.Aivika.Results: extractIntResults :: Results -> [ResultExtract Int]
- Simulation.Aivika.Results: extractIntStatsEitherResults :: Results -> [ResultExtract (Either Int (SamplingStats Int))]
- Simulation.Aivika.Results: extractIntStatsResults :: Results -> [ResultExtract (SamplingStats Int)]
- Simulation.Aivika.Results: extractIntTimingStatsResults :: Results -> [ResultExtract (TimingStats Int)]
- Simulation.Aivika.Results: extractStringResults :: Results -> [ResultExtract String]
- Simulation.Aivika.Results: resultExtractData :: ResultExtract e -> Event e
- Simulation.Aivika.Results: resultExtractId :: ResultExtract e -> ResultId
- Simulation.Aivika.Results: resultExtractName :: ResultExtract e -> ResultName
- Simulation.Aivika.Results: resultExtractSignal :: ResultExtract e -> ResultSignal
- Simulation.Aivika.Results: voidResultValue :: ResultValue a -> ResultValue b
+ Simulation.Aivika.Processor: failoverProcessor :: [Processor a b] -> Processor a b
+ Simulation.Aivika.Processor: joinProcessor :: Process (Processor a b) -> Processor a b
+ Simulation.Aivika.Results: resultItemAsDoubleListValue :: ResultItemable a => a -> Maybe (ResultValue [Double])
+ Simulation.Aivika.Results: resultItemAsDoubleStatsEitherValue :: ResultItemable a => a -> Maybe (ResultValue (Either Double (SamplingStats Double)))
+ Simulation.Aivika.Results: resultItemAsDoubleStatsValue :: ResultItemable a => a -> Maybe (ResultValue (SamplingStats Double))
+ Simulation.Aivika.Results: resultItemAsDoubleTimingStatsValue :: ResultItemable a => a -> Maybe (ResultValue (TimingStats Double))
+ Simulation.Aivika.Results: resultItemAsDoubleValue :: ResultItemable a => a -> Maybe (ResultValue Double)
+ Simulation.Aivika.Results: resultItemAsIntListValue :: ResultItemable a => a -> Maybe (ResultValue [Int])
+ Simulation.Aivika.Results: resultItemAsIntStatsEitherValue :: ResultItemable a => a -> Maybe (ResultValue (Either Int (SamplingStats Int)))
+ Simulation.Aivika.Results: resultItemAsIntStatsValue :: ResultItemable a => a -> Maybe (ResultValue (SamplingStats Int))
+ Simulation.Aivika.Results: resultItemAsIntTimingStatsValue :: ResultItemable a => a -> Maybe (ResultValue (TimingStats Int))
+ Simulation.Aivika.Results: resultItemAsIntValue :: ResultItemable a => a -> Maybe (ResultValue Int)
+ Simulation.Aivika.Results: resultItemAsStringValue :: ResultItemable a => a -> Maybe (ResultValue String)
+ Simulation.Aivika.Signal: instance Eq (SignalHandler a)
+ Simulation.Aivika.Signal: instance Functor Signal
+ Simulation.Aivika.Signal: instance Functor Signalable
+ Simulation.Aivika.Signal: instance Monoid (Signal a)
+ Simulation.Aivika.Signal: instance Monoid a => Monoid (Signalable a)
+ Simulation.Aivika.Stream: failoverStream :: [Stream a] -> Stream a
+ Simulation.Aivika.Stream: instance Alternative Stream
+ Simulation.Aivika.Stream: joinStream :: Process (Stream a) -> Stream a
+ Simulation.Aivika.Stream: singletonStream :: a -> Stream a
+ Simulation.Aivika.Task: taskParallelProcess :: Task a -> Task a -> Process (a, Task a)
+ Simulation.Aivika.Task: taskParallelResult :: Task a -> Task a -> Process (TaskResult a, Task a)
- Simulation.Aivika.Agent: setStateActivation :: AgentState -> Event () -> Simulation ()
+ Simulation.Aivika.Agent: setStateActivation :: AgentState -> Event () -> Event ()
- Simulation.Aivika.Agent: setStateDeactivation :: AgentState -> Event () -> Simulation ()
+ Simulation.Aivika.Agent: setStateDeactivation :: AgentState -> Event () -> Event ()
- Simulation.Aivika.Agent: setStateTransition :: AgentState -> Event (Maybe AgentState) -> Simulation ()
+ Simulation.Aivika.Agent: setStateTransition :: AgentState -> Event (Maybe AgentState) -> Event ()
- Simulation.Aivika.Results: type ResultData e = Maybe (Event e)
+ Simulation.Aivika.Results: type ResultData e = Event e
Files
- CHANGELOG.md +22/−0
- LICENSE +1/−1
- Simulation/Aivika.hs +1/−1
- Simulation/Aivika/Activity.hs +2/−2
- Simulation/Aivika/Agent.hs +8/−8
- Simulation/Aivika/Arrival.hs +1/−1
- Simulation/Aivika/Circuit.hs +1/−1
- Simulation/Aivika/Cont.hs +1/−1
- Simulation/Aivika/DoubleLinkedList.hs +1/−1
- Simulation/Aivika/Dynamics.hs +1/−1
- Simulation/Aivika/Dynamics/Extra.hs +1/−1
- Simulation/Aivika/Dynamics/Memo.hs +1/−1
- Simulation/Aivika/Dynamics/Memo/Unboxed.hs +1/−1
- Simulation/Aivika/Dynamics/Random.hs +1/−1
- Simulation/Aivika/Event.hs +7/−1
- Simulation/Aivika/Generator.hs +1/−1
- Simulation/Aivika/Internal/Arrival.hs +1/−1
- Simulation/Aivika/Internal/Cont.hs +6/−4
- Simulation/Aivika/Internal/Dynamics.hs +3/−1
- Simulation/Aivika/Internal/Event.hs +9/−1
- Simulation/Aivika/Internal/Parameter.hs +4/−2
- Simulation/Aivika/Internal/Process.hs +10/−3
- Simulation/Aivika/Internal/Signal.hs +0/−388
- Simulation/Aivika/Internal/Simulation.hs +5/−3
- Simulation/Aivika/Internal/Specs.hs +1/−1
- Simulation/Aivika/Net.hs +1/−1
- Simulation/Aivika/Parameter.hs +1/−1
- Simulation/Aivika/Parameter/Random.hs +1/−1
- Simulation/Aivika/PriorityQueue.hs +1/−1
- Simulation/Aivika/Process.hs +1/−1
- Simulation/Aivika/Processor.hs +18/−1
- Simulation/Aivika/Processor/RoundRobbin.hs +1/−1
- Simulation/Aivika/Queue.hs +1/−2
- Simulation/Aivika/Queue/Infinite.hs +1/−2
- Simulation/Aivika/QueueStrategy.hs +1/−1
- Simulation/Aivika/Ref.hs +1/−2
- Simulation/Aivika/Ref/Plain.hs +1/−1
- Simulation/Aivika/Resource.hs +1/−1
- Simulation/Aivika/Results.hs +317/−397
- Simulation/Aivika/Results/IO.hs +25/−37
- Simulation/Aivika/Results/Locale.hs +1/−1
- Simulation/Aivika/Server.hs +3/−3
- Simulation/Aivika/Signal.hs +334/−2
- Simulation/Aivika/Simulation.hs +3/−2
- Simulation/Aivika/Specs.hs +1/−1
- Simulation/Aivika/Statistics.hs +1/−1
- Simulation/Aivika/Statistics/Accumulator.hs +1/−1
- Simulation/Aivika/Stream.hs +62/−1
- Simulation/Aivika/Stream/Random.hs +1/−1
- Simulation/Aivika/SystemDynamics.hs +1/−1
- Simulation/Aivika/Table.hs +1/−1
- Simulation/Aivika/Task.hs +55/−6
- Simulation/Aivika/Transform.hs +1/−1
- Simulation/Aivika/Transform/Extra.hs +1/−1
- Simulation/Aivika/Transform/Memo.hs +1/−1
- Simulation/Aivika/Transform/Memo/Unboxed.hs +1/−1
- Simulation/Aivika/Unboxed.hs +1/−1
- Simulation/Aivika/Var.hs +1/−2
- Simulation/Aivika/Var/Unboxed.hs +1/−2
- Simulation/Aivika/Vector.hs +1/−1
- Simulation/Aivika/Vector/Unboxed.hs +1/−1
- aivika.cabal +3/−3
- examples/BassDiffusion.hs +5/−5
- examples/InventorySystem.hs +1/−1
- examples/MachineBreakdowns.hs +76/−52
- examples/WorkStationsInSeries.hs +2/−6
+ CHANGELOG.md view
@@ -0,0 +1,22 @@+Version 3.1+-----++* Added functions failoverStream and failoverProcessor to model+servers with failures (temporary cancellation of the process with the+further repairing of the server).++* Added functions joinStream and joinProcessor to simplify the+modeling of servers.++* Checking the argument, i.e. time period, in the holdProcess+function. It must not be negative.++* The taskProcess computation behaves exactly like the background+ process, i.e. now its cancellation leads to immediate cancelling the background+ process too.++* Functions setStateActivation, setStateDeactivation and+ setStateTransition are redefined as the Event computations instead+ of Simulation computations.++* Refactored and simplified module Results.
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2009, 2010, 2011, 2012, 2013, 2014 David Sorokin <david.sorokin@gmail.com>+Copyright (c) 2009-2015 David Sorokin <david.sorokin@gmail.com> All rights reserved.
Simulation/Aivika.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Activity.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Activity--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -62,7 +62,7 @@ import Simulation.Aivika.Simulation import Simulation.Aivika.Dynamics import Simulation.Aivika.Internal.Event-import Simulation.Aivika.Internal.Signal+import Simulation.Aivika.Signal import Simulation.Aivika.Resource import Simulation.Aivika.Cont import Simulation.Aivika.Process
Simulation/Aivika/Agent.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Agent--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -33,7 +33,7 @@ import Simulation.Aivika.Internal.Specs import Simulation.Aivika.Internal.Simulation import Simulation.Aivika.Internal.Event-import Simulation.Aivika.Internal.Signal+import Simulation.Aivika.Signal -- -- Agent-based Modeling@@ -215,24 +215,24 @@ invokeEvent p $ traversePath x0 st -- | Set the activation computation for the specified state.-setStateActivation :: AgentState -> Event () -> Simulation ()+setStateActivation :: AgentState -> Event () -> Event () setStateActivation st action =- Simulation $ \r ->+ Event $ \p -> writeIORef (stateActivateRef st) action -- | Set the deactivation computation for the specified state.-setStateDeactivation :: AgentState -> Event () -> Simulation ()+setStateDeactivation :: AgentState -> Event () -> Event () setStateDeactivation st action =- Simulation $ \r ->+ Event $ \p -> writeIORef (stateDeactivateRef st) action -- | Set the transition state which will be next and which is used only -- when selecting the state directly with help of 'selectState'. -- If the state was activated intermediately, when selecting -- another state, then this computation is not used.-setStateTransition :: AgentState -> Event (Maybe AgentState) -> Simulation ()+setStateTransition :: AgentState -> Event (Maybe AgentState) -> Event () setStateTransition st action =- Simulation $ \r ->+ Event $ \p -> writeIORef (stateTransitRef st) action -- | Trigger the signal when the agent state changes.
Simulation/Aivika/Arrival.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Arrival--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Circuit.hs view
@@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Circuit--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Cont.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Cont--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/DoubleLinkedList.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.DoubleLinkedList--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Dynamics.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Dynamics--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Dynamics/Extra.hs view
@@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Dynamics.Extra--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Dynamics/Memo.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Dynamics.Memo--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Dynamics/Memo/Unboxed.hs view
@@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Dynamics.Memo.Unboxed--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Dynamics/Random.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Dynamics.Random--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Event.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Event--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -9,6 +9,12 @@ -- -- 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.+--+-- The @Dynamics@ computation is defined in all time points simultaneously, while+-- the @Event@ computation can be described in every time point differently and can change+-- in discrete steps. Therefore, the former is destined for differential and difference+-- equations of System Dynamics, while the latter is destined for discrete event simulation,+-- being its core actually. -- module Simulation.Aivika.Event (-- * Event Monad
Simulation/Aivika/Generator.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Generator--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Internal/Arrival.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Internal.Arrival--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Internal/Cont.hs view
@@ -1,13 +1,15 @@ -- | -- Module : Simulation.Aivika.Internal.Cont--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental -- Tested with: GHC 7.8.3 ----- The 'Cont' monad is a variation of the standard Cont monad +-- This is an internal implementation module that should never be used directly.+--+-- The 'Cont' monad is a variation of the standard @Cont@ monad -- and F# async workflow, where the result of applying -- the continuations is the 'Event' computation. --@@ -55,7 +57,7 @@ import Simulation.Aivika.Internal.Simulation import Simulation.Aivika.Internal.Dynamics import Simulation.Aivika.Internal.Event-import Simulation.Aivika.Internal.Signal+import Simulation.Aivika.Signal -- | It defines how the parent and child computations should be cancelled. data ContCancellation = CancelTogether@@ -161,7 +163,7 @@ writeIORef (contCancellationActivatedRef x) True invokeEvent p $ triggerSignal (contCancellationInitiatingSource x) () --- | The 'Cont' type is similar to the standard Cont monad +-- | The 'Cont' type is similar to the standard @Cont@ monad -- and F# async workflow but only the result of applying -- the continuations return the 'Event' computation. newtype Cont a = Cont (ContParams a -> Event ())
Simulation/Aivika/Internal/Dynamics.hs view
@@ -3,11 +3,13 @@ -- | -- Module : Simulation.Aivika.Internal.Dynamics--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental -- Tested with: GHC 7.8.3+--+-- This is an internal implementation module that should never be used directly. -- -- The module defines the 'Dynamics' monad representing a time varying polymorphic function. --
Simulation/Aivika/Internal/Event.hs view
@@ -3,14 +3,22 @@ -- | -- Module : Simulation.Aivika.Internal.Event--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental -- Tested with: GHC 7.8.3 --+-- This is an internal implementation module that should never be used directly.+-- -- 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.+--+-- The @Dynamics@ computation is defined in all time points simultaneously, while+-- the @Event@ computation can be described in every time point differently and can change+-- in discrete steps. Therefore, the former is destined for differential and difference+-- equations of System Dynamics, while the latter is destined for discrete event simulation,+-- being its core actually. -- module Simulation.Aivika.Internal.Event (-- * Event Monad
Simulation/Aivika/Internal/Parameter.hs view
@@ -3,15 +3,17 @@ -- | -- Module : Simulation.Aivika.Internal.Parameter--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental -- Tested with: GHC 7.8.3 --+-- This is an internal implementation module that should never be used directly.+-- -- The module defines the 'Parameter' monad that allows representing the model -- parameters. For example, they can be used when running the Monte-Carlo simulation.--- +-- -- In general, this monad is very useful for representing a computation which is external -- relative to the model itself. --
Simulation/Aivika/Internal/Process.hs view
@@ -1,12 +1,14 @@ -- | -- Module : Simulation.Aivika.Internal.Process--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental -- Tested with: GHC 7.8.3 --+-- This is an internal implementation module that should never be used directly.+-- -- 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 -- or another time point. @@ -17,6 +19,9 @@ -- -- A value of the 'ProcessId' type is just an identifier of such a process. --+-- The characteristic property of the @Process@ type is function 'holdProcess'+-- that suspends the current process for the specified time interval.+-- module Simulation.Aivika.Internal.Process (-- * Process Monad ProcessId,@@ -95,7 +100,7 @@ import Simulation.Aivika.Internal.Dynamics import Simulation.Aivika.Internal.Event import Simulation.Aivika.Internal.Cont-import Simulation.Aivika.Internal.Signal+import Simulation.Aivika.Signal -- | Represents a process identifier. data ProcessId = @@ -130,7 +135,9 @@ Process $ \pid -> Cont $ \c -> Event $ \p ->- do let x = processInterruptCont pid+ do when (dt < 0) $+ error "Time period dt < 0: holdProcess"+ let x = processInterruptCont pid writeIORef x $ Just c writeIORef (processInterruptRef pid) False v <- readIORef (processInterruptVersion pid)
− Simulation/Aivika/Internal/Signal.hs
@@ -1,388 +0,0 @@---- |--- Module : Simulation.Aivika.Internal.Signal--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>--- License : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability : experimental--- Tested with: GHC 7.8.3------ This module defines the signal which we can subscribe handlers to. --- These handlers can be disposed. The signal is triggered in the --- current time point actuating the corresponded computations from --- the handlers. -----module Simulation.Aivika.Internal.Signal- (-- * Handling and Triggering Signal- Signal(..),- handleSignal_,- SignalSource,- newSignalSource,- publishSignal,- triggerSignal,- -- * Useful Combinators- mapSignal,- mapSignalM,- apSignal,- filterSignal,- filterSignalM,- emptySignal,- merge2Signals,- merge3Signals,- merge4Signals,- merge5Signals,- -- * Signal Arriving- arrivalSignal,- -- * Creating Signal in Time Points- newSignalInTimes,- newSignalInIntegTimes,- newSignalInStartTime,- newSignalInStopTime,- -- * Signal History- SignalHistory,- signalHistorySignal,- newSignalHistory,- newSignalHistoryStartingWith,- readSignalHistory,- -- * Signalable Computations- Signalable(..),- signalableChanged,- emptySignalable,- appendSignalable,- -- * Debugging- traceSignal) where--import Data.IORef-import Data.Monoid-import Data.List-import Data.Array--import Control.Monad-import Control.Monad.Trans--import Simulation.Aivika.Internal.Specs-import Simulation.Aivika.Internal.Parameter-import Simulation.Aivika.Internal.Simulation-import Simulation.Aivika.Internal.Event-import Simulation.Aivika.Internal.Arrival--import qualified Simulation.Aivika.Vector as V-import qualified Simulation.Aivika.Vector.Unboxed as UV---- | The signal source that can publish its signal.-data SignalSource a =- SignalSource { publishSignal :: Signal a,- -- ^ Publish the signal.- triggerSignal :: a -> Event ()- -- ^ Trigger the signal actuating - -- all its handlers at the current - -- simulation time point.- }- --- | The signal that can have disposable handlers. -data Signal a =- Signal { handleSignal :: (a -> Event ()) -> Event DisposableEvent- -- ^ Subscribe the handler to the specified - -- signal and return a nested computation- -- within a disposable object that, being applied,- -- unsubscribes the handler from this signal.- }- --- | The queue of signal handlers.-data SignalHandlerQueue a =- SignalHandlerQueue { queueList :: IORef [SignalHandler a] }- --- | It contains the information about the disposable queue handler.-data SignalHandler a =- SignalHandler { handlerComp :: a -> Event (),- handlerRef :: IORef () }--instance Eq (SignalHandler a) where- x == y = (handlerRef x) == (handlerRef y)---- | Subscribe the handler to the specified signal forever.--- To subscribe the disposable handlers, use function 'handleSignal'.-handleSignal_ :: Signal a -> (a -> Event ()) -> Event ()-handleSignal_ signal h = - do x <- handleSignal signal h- return ()- --- | Create a new signal source.-newSignalSource :: Simulation (SignalSource a)-newSignalSource =- Simulation $ \r ->- do list <- newIORef []- let queue = SignalHandlerQueue { queueList = list }- signal = Signal { handleSignal = handle }- source = SignalSource { publishSignal = signal, - triggerSignal = trigger }- handle h =- Event $ \p ->- do x <- enqueueSignalHandler queue h- return $- DisposableEvent $- Event $ \p -> dequeueSignalHandler queue x- trigger a =- Event $ \p -> triggerSignalHandlers queue a p- return source---- | Trigger all next signal handlers.-triggerSignalHandlers :: SignalHandlerQueue a -> a -> Point -> IO ()-{-# INLINE triggerSignalHandlers #-}-triggerSignalHandlers q a p =- do hs <- readIORef (queueList q)- forM_ hs $ \h ->- invokeEvent p $ handlerComp h a- --- | Enqueue the handler and return its representative in the queue. -enqueueSignalHandler :: SignalHandlerQueue a -> (a -> Event ()) -> IO (SignalHandler a)-{-# INLINE enqueueSignalHandler #-}-enqueueSignalHandler q h = - do r <- newIORef ()- let handler = SignalHandler { handlerComp = h,- handlerRef = r }- modifyIORef (queueList q) (handler :)- return handler---- | Dequeue the handler representative.-dequeueSignalHandler :: SignalHandlerQueue a -> SignalHandler a -> IO ()-{-# INLINE dequeueSignalHandler #-}-dequeueSignalHandler q h = - modifyIORef (queueList q) (delete h)--instance Functor Signal where- fmap = mapSignal- -instance Monoid (Signal a) where - - mempty = emptySignal- - mappend = merge2Signals- - mconcat [] = emptySignal- mconcat [x1] = x1- mconcat [x1, x2] = merge2Signals x1 x2- mconcat [x1, x2, x3] = merge3Signals x1 x2 x3- mconcat [x1, x2, x3, x4] = merge4Signals x1 x2 x3 x4- mconcat [x1, x2, x3, x4, x5] = merge5Signals x1 x2 x3 x4 x5- mconcat (x1 : x2 : x3 : x4 : x5 : xs) = - mconcat $ merge5Signals x1 x2 x3 x4 x5 : xs- --- | Map the signal according the specified function.-mapSignal :: (a -> b) -> Signal a -> Signal b-mapSignal f m =- Signal { handleSignal = \h -> - handleSignal m $ h . f }---- | Filter only those signal values that satisfy to --- the specified predicate.-filterSignal :: (a -> Bool) -> Signal a -> Signal a-filterSignal p m =- Signal { handleSignal = \h ->- handleSignal m $ \a ->- when (p a) $ h a }- --- | Filter only those signal values that satisfy to --- the specified predicate.-filterSignalM :: (a -> Event Bool) -> Signal a -> Signal a-filterSignalM p m =- Signal { handleSignal = \h ->- handleSignal m $ \a ->- do x <- p a- when x $ h a }- --- | Merge two signals.-merge2Signals :: Signal a -> Signal a -> Signal a-merge2Signals m1 m2 =- Signal { handleSignal = \h ->- do x1 <- handleSignal m1 h- x2 <- handleSignal m2 h- return $ x1 <> x2 }---- | Merge three signals.-merge3Signals :: Signal a -> Signal a -> Signal a -> Signal a-merge3Signals m1 m2 m3 =- Signal { handleSignal = \h ->- do x1 <- handleSignal m1 h- x2 <- handleSignal m2 h- x3 <- handleSignal m3 h- return $ x1 <> x2 <> x3 }---- | Merge four signals.-merge4Signals :: Signal a -> Signal a -> Signal a -> - Signal a -> Signal a-merge4Signals m1 m2 m3 m4 =- Signal { handleSignal = \h ->- do x1 <- handleSignal m1 h- x2 <- handleSignal m2 h- x3 <- handleSignal m3 h- x4 <- handleSignal m4 h- return $ x1 <> x2 <> x3 <> x4 }- --- | Merge five signals.-merge5Signals :: Signal a -> Signal a -> Signal a -> - Signal a -> Signal a -> Signal a-merge5Signals m1 m2 m3 m4 m5 =- Signal { handleSignal = \h ->- do x1 <- handleSignal m1 h- x2 <- handleSignal m2 h- x3 <- handleSignal m3 h- x4 <- handleSignal m4 h- x5 <- handleSignal m5 h- return $ x1 <> x2 <> x3 <> x4 <> x5 }---- | Compose the signal.-mapSignalM :: (a -> Event b) -> Signal a -> Signal b-mapSignalM f m =- Signal { handleSignal = \h ->- handleSignal m (f >=> h) }- --- | Transform the signal.-apSignal :: Event (a -> b) -> Signal a -> Signal b-apSignal f m =- Signal { handleSignal = \h ->- handleSignal m $ \a -> do { x <- f; h (x a) } }---- | An empty signal which is never triggered.-emptySignal :: Signal a-emptySignal =- Signal { handleSignal = \h -> return mempty }- --- | Represents the history of the signal values.-data SignalHistory a =- SignalHistory { signalHistorySignal :: Signal a, - -- ^ The signal for which the history is created.- signalHistoryTimes :: UV.Vector Double,- signalHistoryValues :: V.Vector a }---- | Create a history of the signal values.-newSignalHistory :: Signal a -> Event (SignalHistory a)-newSignalHistory =- newSignalHistoryStartingWith Nothing---- | Create a history of the signal values starting with--- the optional initial value.-newSignalHistoryStartingWith :: Maybe a -> Signal a -> Event (SignalHistory a)-newSignalHistoryStartingWith init signal =- Event $ \p ->- do ts <- UV.newVector- xs <- V.newVector- case init of- Nothing -> return ()- Just a ->- do UV.appendVector ts (pointTime p)- V.appendVector xs a- invokeEvent p $- handleSignal_ signal $ \a ->- Event $ \p ->- do UV.appendVector ts (pointTime p)- V.appendVector xs a- return SignalHistory { signalHistorySignal = signal,- signalHistoryTimes = ts,- signalHistoryValues = xs }- --- | Read the history of signal values.-readSignalHistory :: SignalHistory a -> Event (Array Int Double, Array Int a)-readSignalHistory history =- do xs <- liftIO $ UV.freezeVector (signalHistoryTimes history)- ys <- liftIO $ V.freezeVector (signalHistoryValues history)- return (xs, ys) - --- | Trigger the signal with the current time.-triggerSignalWithCurrentTime :: SignalSource Double -> Event ()-triggerSignalWithCurrentTime s =- Event $ \p -> invokeEvent p $ triggerSignal s (pointTime p)---- | Return a signal that is triggered in the specified time points.-newSignalInTimes :: [Double] -> Event (Signal Double)-newSignalInTimes xs =- do s <- liftSimulation newSignalSource- enqueueEventWithTimes xs $ triggerSignalWithCurrentTime s- return $ publishSignal s- --- | Return a signal that is triggered in the integration time points.--- It should be called with help of 'runEventInStartTime'.-newSignalInIntegTimes :: Event (Signal Double)-newSignalInIntegTimes =- do s <- liftSimulation newSignalSource- enqueueEventWithIntegTimes $ triggerSignalWithCurrentTime s- return $ publishSignal s- --- | Return a signal that is triggered in the start time.--- It should be called with help of 'runEventInStartTime'.-newSignalInStartTime :: Event (Signal Double)-newSignalInStartTime =- do s <- liftSimulation newSignalSource- t <- liftParameter starttime- enqueueEvent t $ triggerSignalWithCurrentTime s- return $ publishSignal s---- | Return a signal that is triggered in the final time.-newSignalInStopTime :: Event (Signal Double)-newSignalInStopTime =- do s <- liftSimulation newSignalSource- t <- liftParameter stoptime- enqueueEvent t $ triggerSignalWithCurrentTime s- return $ publishSignal s---- | Describes a computation that also signals when changing its value.-data Signalable a =- Signalable { readSignalable :: Event a,- -- ^ Return a computation of the value.- signalableChanged_ :: Signal ()- -- ^ Return a signal notifying that the value has changed- -- but without providing the information about the changed value.- }---- | Return a signal notifying that the value has changed.-signalableChanged :: Signalable a -> Signal a-signalableChanged x = mapSignalM (const $ readSignalable x) $ signalableChanged_ x--instance Functor Signalable where- fmap f x = x { readSignalable = fmap f (readSignalable x) }--instance Monoid a => Monoid (Signalable a) where-- mempty = emptySignalable- mappend = appendSignalable---- | Return an identity.-emptySignalable :: Monoid a => Signalable a-emptySignalable =- Signalable { readSignalable = return mempty,- signalableChanged_ = mempty }---- | An associative operation.-appendSignalable :: Monoid a => Signalable a -> Signalable a -> Signalable a-appendSignalable m1 m2 =- Signalable { readSignalable = liftM2 (<>) (readSignalable m1) (readSignalable m2),- signalableChanged_ = (signalableChanged_ m1) <> (signalableChanged_ m2) }---- | Transform a signal so that the resulting signal returns a sequence of arrivals--- saving the information about the time points at which the original signal was received.-arrivalSignal :: Signal a -> Signal (Arrival a)-arrivalSignal m = - Signal { handleSignal = \h ->- Event $ \p ->- do r <- newIORef Nothing- invokeEvent p $- handleSignal m $ \a ->- Event $ \p ->- do t0 <- readIORef r- let t = pointTime p- writeIORef r (Just t)- invokeEvent p $- h Arrival { arrivalValue = a,- arrivalTime = t,- arrivalDelay =- case t0 of- Nothing -> Nothing- Just t0 -> Just (t - t0) }- }---- | Show the debug message with the current simulation time.-traceSignal :: String -> Signal a -> Signal a -traceSignal message m =- Signal { handleSignal = \h ->- handleSignal m $ traceEvent message . h }
Simulation/Aivika/Internal/Simulation.hs view
@@ -3,14 +3,16 @@ -- | -- Module : Simulation.Aivika.Internal.Simulation--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental -- Tested with: GHC 7.8.3 ----- The module defines the 'Simulation' monad that represents a computation--- within the simulation run.+-- This is an internal implementation module that should never be used directly.+--+-- The module defines the 'Simulation' monad that represents a computation within+-- the simulation run. -- module Simulation.Aivika.Internal.Simulation (-- * Simulation
Simulation/Aivika/Internal/Specs.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Internal.Specs--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Net.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Net--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Parameter.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Simulation.Aivika.Parameter--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Parameter/Random.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Parameter.Random--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/PriorityQueue.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.PriorityQueue--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Process.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Process--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Processor.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Processor--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -39,6 +39,10 @@ processorPrioritisingInputOutputParallel, -- * Arrival Processor arrivalProcessor,+ -- * Utilities+ joinProcessor,+ -- * Failover+ failoverProcessor, -- * Integrating with Signals signalProcessor, processorSignaling,@@ -458,6 +462,19 @@ -- | A processor that delays the input stream by one step using the specified initial value. delayProcessor :: a -> Processor a a delayProcessor a0 = Processor $ delayStream a0++-- | Removes one level of the computation, projecting its bound processor into the outer level.+joinProcessor :: Process (Processor a b) -> Processor a b+joinProcessor m =+ Processor $ \xs ->+ Cons $+ do Processor f <- m+ runStream $ f xs++-- | Takes the next processor from the list after the current processor fails because of cancelling the underlying process.+failoverProcessor :: [Processor a b] -> Processor a b+failoverProcessor ps =+ Processor $ \xs -> failoverStream [runProcessor p xs | p <- ps] -- | Show the debug messages with the current simulation time. traceProcessor :: Maybe String
Simulation/Aivika/Processor/RoundRobbin.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Processor.RoundRobbin--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Queue.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Queue--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -116,7 +116,6 @@ import Simulation.Aivika.Internal.Dynamics import Simulation.Aivika.Internal.Event import Simulation.Aivika.Internal.Process-import Simulation.Aivika.Internal.Signal import Simulation.Aivika.Signal import Simulation.Aivika.Resource import Simulation.Aivika.QueueStrategy
Simulation/Aivika/Queue/Infinite.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Queue.Infinite--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -80,7 +80,6 @@ import Simulation.Aivika.Internal.Dynamics import Simulation.Aivika.Internal.Event import Simulation.Aivika.Internal.Process-import Simulation.Aivika.Internal.Signal import Simulation.Aivika.Signal import Simulation.Aivika.Resource import Simulation.Aivika.QueueStrategy
Simulation/Aivika/QueueStrategy.hs view
@@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.QueueStrategy--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Ref.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Ref--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -24,7 +24,6 @@ import Simulation.Aivika.Internal.Simulation import Simulation.Aivika.Internal.Event-import Simulation.Aivika.Internal.Signal import Simulation.Aivika.Signal -- | The 'Ref' type represents a mutable variable similar to the 'IORef' variable
Simulation/Aivika/Ref/Plain.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Ref.Plain--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Resource.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Resource--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Results.hs view
@@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Results--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -33,18 +33,18 @@ ResultVectorWithSubscript(..), #endif -- * Definitions Focused on Using the Library- ResultExtract(..),- extractIntResults,- extractIntListResults,- extractIntStatsResults,- extractIntStatsEitherResults,- extractIntTimingStatsResults,- extractDoubleResults,- extractDoubleListResults,- extractDoubleStatsResults,- extractDoubleStatsEitherResults,- extractDoubleTimingStatsResults,- extractStringResults,+ ResultValue(..),+ resultsToIntValues,+ resultsToIntListValues,+ resultsToIntStatsValues,+ resultsToIntStatsEitherValues,+ resultsToIntTimingStatsValues,+ resultsToDoubleValues,+ resultsToDoubleListValues,+ resultsToDoubleStatsValues,+ resultsToDoubleStatsEitherValues,+ resultsToDoubleTimingStatsValues,+ resultsToStringValues, ResultPredefinedSignals(..), newResultPredefinedSignals, resultSignal,@@ -54,16 +54,25 @@ ResultSource(..), ResultItem(..), ResultItemable(..),+ resultItemAsIntStatsEitherValue,+ resultItemAsDoubleStatsEitherValue,+ resultItemToIntValue,+ resultItemToIntListValue,+ resultItemToIntStatsValue, resultItemToIntStatsEitherValue,+ resultItemToIntTimingStatsValue,+ resultItemToDoubleValue,+ resultItemToDoubleListValue,+ resultItemToDoubleStatsValue, resultItemToDoubleStatsEitherValue,+ resultItemToDoubleTimingStatsValue,+ resultItemToStringValue, ResultObject(..), ResultProperty(..), ResultVector(..), memoResultVectorSignal, memoResultVectorSummary, ResultSeparator(..),- ResultValue(..),- voidResultValue, ResultContainer(..), resultContainerPropertySource, resultContainerConstProperty,@@ -90,17 +99,6 @@ resultSourceToStringValues, resultSourceMap, resultSourceList,- resultsToIntValues,- resultsToIntListValues,- resultsToIntStatsValues,- resultsToIntStatsEitherValues,- resultsToIntTimingStatsValues,- resultsToDoubleValues,- resultsToDoubleListValues,- resultsToDoubleStatsValues,- resultsToDoubleStatsEitherValues,- resultsToDoubleTimingStatsValues,- resultsToStringValues, composeResults, computeResultValue) where @@ -190,59 +188,169 @@ -- properties. resultItemSummary :: a -> ResultSource - -- | Return integer numbers in time points.- resultItemToIntValue :: a -> ResultValue Int+ -- | Try to return integer numbers in time points.+ resultItemAsIntValue :: a -> Maybe (ResultValue Int) - -- | Return lists of integer numbers in time points. - resultItemToIntListValue :: a -> ResultValue [Int]+ -- | Try to return lists of integer numbers in time points. + resultItemAsIntListValue :: a -> Maybe (ResultValue [Int]) - -- | Return statistics based on integer numbers.- resultItemToIntStatsValue :: a -> ResultValue (SamplingStats Int)+ -- | Try to return statistics based on integer numbers.+ resultItemAsIntStatsValue :: a -> Maybe (ResultValue (SamplingStats Int)) - -- | Return timing statistics based on integer numbers.- resultItemToIntTimingStatsValue :: a -> ResultValue (TimingStats Int)+ -- | Try to return timing statistics based on integer numbers.+ resultItemAsIntTimingStatsValue :: a -> Maybe (ResultValue (TimingStats Int)) - -- | Return double numbers in time points.- resultItemToDoubleValue :: a -> ResultValue Double+ -- | Try to return double numbers in time points.+ resultItemAsDoubleValue :: a -> Maybe (ResultValue Double) - -- | Return lists of double numbers in time points. - resultItemToDoubleListValue :: a -> ResultValue [Double]+ -- | Try to return lists of double numbers in time points. + resultItemAsDoubleListValue :: a -> Maybe (ResultValue [Double]) - -- | Return statistics based on double numbers.- resultItemToDoubleStatsValue :: a -> ResultValue (SamplingStats Double)+ -- | Try to return statistics based on double numbers.+ resultItemAsDoubleStatsValue :: a -> Maybe (ResultValue (SamplingStats Double)) - -- | Return timing statistics based on integer numbers.- resultItemToDoubleTimingStatsValue :: a -> ResultValue (TimingStats Double)+ -- | Try to return timing statistics based on integer numbers.+ resultItemAsDoubleTimingStatsValue :: a -> Maybe (ResultValue (TimingStats Double)) - -- | Return string representations in time points.- resultItemToStringValue :: a -> ResultValue String+ -- | Try to return string representations in time points.+ resultItemAsStringValue :: a -> Maybe (ResultValue String) +-- | Try to return a version optimised for fast aggregation of the statistics based on integer numbers.+resultItemAsIntStatsEitherValue :: ResultItemable a => a -> Maybe (ResultValue (Either Int (SamplingStats Int)))+resultItemAsIntStatsEitherValue x =+ case x1 of+ Just a1 -> Just $ fmap Left a1+ Nothing ->+ case x2 of+ Just a2 -> Just $ fmap Right a2+ Nothing -> Nothing+ where+ x1 = resultItemAsIntValue x+ x2 = resultItemAsIntStatsValue x++-- | Try to return a version optimised for fast aggregation of the statistics based on double floating point numbers.+resultItemAsDoubleStatsEitherValue :: ResultItemable a => a -> Maybe (ResultValue (Either Double (SamplingStats Double)))+resultItemAsDoubleStatsEitherValue x =+ case x1 of+ Just a1 -> Just $ fmap Left a1+ Nothing ->+ case x2 of+ Just a2 -> Just $ fmap Right a2+ Nothing -> Nothing+ where+ x1 = resultItemAsDoubleValue x+ x2 = resultItemAsDoubleStatsValue x++-- | Return integer numbers in time points.+resultItemToIntValue :: ResultItemable a => a -> ResultValue Int+resultItemToIntValue x =+ case resultItemAsIntValue x of+ Just a -> a+ Nothing ->+ error $+ "Cannot represent " ++ resultItemName x +++ " as a source of integer numbers: resultItemToIntValue"++-- | Return lists of integer numbers in time points. +resultItemToIntListValue :: ResultItemable a => a -> ResultValue [Int]+resultItemToIntListValue x =+ case resultItemAsIntListValue x of+ Just a -> a+ Nothing ->+ error $+ "Cannot represent " ++ resultItemName x +++ " as a source of lists of integer numbers: resultItemToIntListValue"++-- | Return statistics based on integer numbers.+resultItemToIntStatsValue :: ResultItemable a => a -> ResultValue (SamplingStats Int)+resultItemToIntStatsValue x =+ case resultItemAsIntStatsValue x of+ Just a -> a+ Nothing ->+ error $+ "Cannot represent " ++ resultItemName x +++ " as a source of statistics based on integer numbers: resultItemToIntStatsValue"+ -- | Return a version optimised for fast aggregation of the statistics based on integer numbers. resultItemToIntStatsEitherValue :: ResultItemable a => a -> ResultValue (Either Int (SamplingStats Int)) resultItemToIntStatsEitherValue x =- case resultValueData x1 of- Just a1 -> fmap Left x1+ case resultItemAsIntStatsEitherValue x of+ Just a -> a Nothing ->- case resultValueData x2 of- Just a2 -> fmap Right x2- Nothing -> voidResultValue x2- where- x1 = resultItemToIntValue x- x2 = resultItemToIntStatsValue x+ error $+ "Cannot represent " ++ resultItemName x +++ " as an optimised source of statistics based on integer numbers: resultItemToIntStatsEitherValue" +-- | Return timing statistics based on integer numbers.+resultItemToIntTimingStatsValue :: ResultItemable a => a -> ResultValue (TimingStats Int)+resultItemToIntTimingStatsValue x =+ case resultItemAsIntTimingStatsValue x of+ Just a -> a+ Nothing ->+ error $+ "Cannot represent " ++ resultItemName x +++ " as a source of timing statistics based on integer numbers: resultItemToIntTimingStatsValue"++-- | Return double numbers in time points.+resultItemToDoubleValue :: ResultItemable a => a -> ResultValue Double+resultItemToDoubleValue x =+ case resultItemAsDoubleValue x of+ Just a -> a+ Nothing ->+ error $+ "Cannot represent " ++ resultItemName x +++ " as a source of double-precision floating-point numbers: resultItemToDoubleValue"+ +-- | Return lists of double numbers in time points. +resultItemToDoubleListValue :: ResultItemable a => a -> ResultValue [Double]+resultItemToDoubleListValue x =+ case resultItemAsDoubleListValue x of+ Just a -> a+ Nothing ->+ error $+ "Cannot represent " ++ resultItemName x +++ " as a source of lists of double-precision floating-point numbers: resultItemToDoubleListValue"++-- | Return statistics based on double numbers.+resultItemToDoubleStatsValue :: ResultItemable a => a -> ResultValue (SamplingStats Double)+resultItemToDoubleStatsValue x =+ case resultItemAsDoubleStatsValue x of+ Just a -> a+ Nothing ->+ error $+ "Cannot represent " ++ resultItemName x +++ " as a source of statistics based on double-precision floating-point numbers: resultItemToDoubleStatsValue"+ -- | Return a version optimised for fast aggregation of the statistics based on double floating point numbers. resultItemToDoubleStatsEitherValue :: ResultItemable a => a -> ResultValue (Either Double (SamplingStats Double)) resultItemToDoubleStatsEitherValue x =- case resultValueData x1 of- Just a1 -> fmap Left x1+ case resultItemAsDoubleStatsEitherValue x of+ Just a -> a Nothing ->- case resultValueData x2 of- Just a2 -> fmap Right x2- Nothing -> voidResultValue x2- where- x1 = resultItemToDoubleValue x- x2 = resultItemToDoubleStatsValue x+ error $+ "Cannot represent " ++ resultItemName x +++ " as an optimised source of statistics based on double-precision floating-point numbers: resultItemToDoubleStatsEitherValue" +-- | Return timing statistics based on integer numbers.+resultItemToDoubleTimingStatsValue :: ResultItemable a => a -> ResultValue (TimingStats Double)+resultItemToDoubleTimingStatsValue x =+ case resultItemAsDoubleTimingStatsValue x of+ Just a -> a+ Nothing ->+ error $+ "Cannot represent " ++ resultItemName x +++ " as a source of timing statistics based on double-precision floating-point numbers: resultItemToDoubleTimingStatsValue"++-- | Return string representations in time points.+resultItemToStringValue :: ResultItemable a => a -> ResultValue String+resultItemToStringValue x =+ case resultItemAsStringValue x of+ Just a -> a+ Nothing ->+ error $+ "Cannot represent " ++ resultItemName x +++ " as a source of strings: resultItemToStringValue"+ -- | The simulation results represented by an object having properties. data ResultObject = ResultObject { resultObjectName :: ResultName,@@ -322,11 +430,7 @@ } instance Functor ResultValue where- fmap f x = x { resultValueData = fmap (fmap f) (resultValueData x) }---- | Return a new value with the discarded simulation results.-voidResultValue :: ResultValue a -> ResultValue b-voidResultValue x = x { resultValueData = Nothing }+ fmap f x = x { resultValueData = fmap f (resultValueData x) } -- | A container of the simulation results such as queue, server or array. data ResultContainer e =@@ -381,7 +485,7 @@ resultPropertyLabel = name, resultPropertyId = i, resultPropertySource =- resultContainerPropertySource cont name i (Just . return . f) (const EmptyResultSignal) }+ resultContainerPropertySource cont name i (return . f) (const EmptyResultSignal) } -- | Create by the specified container a property that changes in the integration time points, or it is supposed to be such one. resultContainerIntegProperty :: ResultItemable (ResultValue b)@@ -399,7 +503,7 @@ resultPropertyLabel = name, resultPropertyId = i, resultPropertySource =- resultContainerPropertySource cont name i (Just . f) (const UnknownResultSignal) }+ resultContainerPropertySource cont name i f (const UnknownResultSignal) } -- | Create a property by the specified container. resultContainerProperty :: ResultItemable (ResultValue b)@@ -419,7 +523,7 @@ resultPropertyLabel = name, resultPropertyId = i, resultPropertySource =- resultContainerPropertySource cont name i (Just . f) (ResultSignal . g) }+ resultContainerPropertySource cont name i f (ResultSignal . g) } -- | Create by the specified container a mapped property which is recomputed each time again and again. resultContainerMapProperty :: ResultItemable (ResultValue b)@@ -437,7 +541,7 @@ resultPropertyLabel = name, resultPropertyId = i, resultPropertySource =- resultContainerPropertySource cont name i (fmap $ fmap f) (const $ resultContainerSignal cont) }+ resultContainerPropertySource cont name i (fmap f) (const $ resultContainerSignal cont) } -- | Convert the result value to a container with the specified object identifier. resultValueToContainer :: ResultValue a -> ResultContainer (ResultData a)@@ -458,7 +562,7 @@ resultValueSignal = resultContainerSignal x } -- | Represents the very simulation results.-type ResultData e = Maybe (Event e)+type ResultData e = Event e -- | Whether an object containing the results emits a signal notifying about change of data. data ResultSignal = EmptyResultSignal@@ -502,17 +606,17 @@ resultItemId = resultValueId resultItemSignal = resultValueSignal - resultItemToIntValue = id- resultItemToIntListValue = fmap return- resultItemToIntStatsValue = fmap returnSamplingStats- resultItemToIntTimingStatsValue = voidResultValue+ resultItemAsIntValue = Just+ resultItemAsIntListValue = Just . fmap return+ resultItemAsIntStatsValue = Just . fmap returnSamplingStats+ resultItemAsIntTimingStatsValue = const Nothing - resultItemToDoubleValue = fmap fromIntegral- resultItemToDoubleListValue = fmap (return . fromIntegral)- resultItemToDoubleStatsValue = fmap (returnSamplingStats . fromIntegral)- resultItemToDoubleTimingStatsValue = voidResultValue+ resultItemAsDoubleValue = Just . fmap fromIntegral+ resultItemAsDoubleListValue = Just . fmap (return . fromIntegral)+ resultItemAsDoubleStatsValue = Just . fmap (returnSamplingStats . fromIntegral)+ resultItemAsDoubleTimingStatsValue = const Nothing - resultItemToStringValue = fmap show+ resultItemAsStringValue = Just . fmap show resultItemExpansion = ResultItemSource . ResultItem resultItemSummary = ResultItemSource . ResultItem@@ -523,17 +627,17 @@ resultItemId = resultValueId resultItemSignal = resultValueSignal - resultItemToIntValue = voidResultValue- resultItemToIntListValue = voidResultValue- resultItemToIntStatsValue = voidResultValue- resultItemToIntTimingStatsValue = voidResultValue+ resultItemAsIntValue = const Nothing+ resultItemAsIntListValue = const Nothing+ resultItemAsIntStatsValue = const Nothing+ resultItemAsIntTimingStatsValue = const Nothing - resultItemToDoubleValue = id- resultItemToDoubleListValue = fmap return- resultItemToDoubleStatsValue = fmap returnSamplingStats- resultItemToDoubleTimingStatsValue = voidResultValue+ resultItemAsDoubleValue = Just+ resultItemAsDoubleListValue = Just . fmap return+ resultItemAsDoubleStatsValue = Just . fmap returnSamplingStats+ resultItemAsDoubleTimingStatsValue = const Nothing - resultItemToStringValue = fmap show+ resultItemAsStringValue = Just . fmap show resultItemExpansion = ResultItemSource . ResultItem resultItemSummary = ResultItemSource . ResultItem@@ -544,17 +648,17 @@ resultItemId = resultValueId resultItemSignal = resultValueSignal - resultItemToIntValue = voidResultValue- resultItemToIntListValue = id- resultItemToIntStatsValue = fmap listSamplingStats- resultItemToIntTimingStatsValue = voidResultValue+ resultItemAsIntValue = const Nothing+ resultItemAsIntListValue = Just+ resultItemAsIntStatsValue = Just . fmap listSamplingStats+ resultItemAsIntTimingStatsValue = const Nothing - resultItemToDoubleValue = voidResultValue- resultItemToDoubleListValue = fmap (map fromIntegral)- resultItemToDoubleStatsValue = fmap (fromIntSamplingStats . listSamplingStats)- resultItemToDoubleTimingStatsValue = voidResultValue+ resultItemAsDoubleValue = const Nothing+ resultItemAsDoubleListValue = Just . fmap (map fromIntegral)+ resultItemAsDoubleStatsValue = Just . fmap (fromIntSamplingStats . listSamplingStats)+ resultItemAsDoubleTimingStatsValue = const Nothing - resultItemToStringValue = fmap show+ resultItemAsStringValue = Just . fmap show resultItemExpansion = ResultItemSource . ResultItem resultItemSummary = ResultItemSource . ResultItem@@ -565,17 +669,17 @@ resultItemId = resultValueId resultItemSignal = resultValueSignal - resultItemToIntValue = voidResultValue- resultItemToIntListValue = voidResultValue- resultItemToIntStatsValue = voidResultValue- resultItemToIntTimingStatsValue = voidResultValue+ resultItemAsIntValue = const Nothing+ resultItemAsIntListValue = const Nothing+ resultItemAsIntStatsValue = const Nothing+ resultItemAsIntTimingStatsValue = const Nothing - resultItemToDoubleValue = voidResultValue- resultItemToDoubleListValue = id- resultItemToDoubleStatsValue = fmap listSamplingStats- resultItemToDoubleTimingStatsValue = voidResultValue+ resultItemAsDoubleValue = const Nothing+ resultItemAsDoubleListValue = Just+ resultItemAsDoubleStatsValue = Just . fmap listSamplingStats+ resultItemAsDoubleTimingStatsValue = const Nothing - resultItemToStringValue = fmap show+ resultItemAsStringValue = Just . fmap show resultItemExpansion = ResultItemSource . ResultItem resultItemSummary = ResultItemSource . ResultItem@@ -586,17 +690,17 @@ resultItemId = resultValueId resultItemSignal = resultValueSignal - resultItemToIntValue = voidResultValue- resultItemToIntListValue = voidResultValue- resultItemToIntStatsValue = id- resultItemToIntTimingStatsValue = voidResultValue+ resultItemAsIntValue = const Nothing+ resultItemAsIntListValue = const Nothing+ resultItemAsIntStatsValue = Just+ resultItemAsIntTimingStatsValue = const Nothing - resultItemToDoubleValue = voidResultValue- resultItemToDoubleListValue = voidResultValue- resultItemToDoubleStatsValue = fmap fromIntSamplingStats- resultItemToDoubleTimingStatsValue = voidResultValue+ resultItemAsDoubleValue = const Nothing+ resultItemAsDoubleListValue = const Nothing+ resultItemAsDoubleStatsValue = Just . fmap fromIntSamplingStats+ resultItemAsDoubleTimingStatsValue = const Nothing - resultItemToStringValue = fmap show+ resultItemAsStringValue = Just . fmap show resultItemExpansion = samplingStatsResultSource resultItemSummary = samplingStatsResultSummary@@ -607,17 +711,17 @@ resultItemId = resultValueId resultItemSignal = resultValueSignal - resultItemToIntValue = voidResultValue- resultItemToIntListValue = voidResultValue- resultItemToIntStatsValue = voidResultValue- resultItemToIntTimingStatsValue = voidResultValue+ resultItemAsIntValue = const Nothing+ resultItemAsIntListValue = const Nothing+ resultItemAsIntStatsValue = const Nothing+ resultItemAsIntTimingStatsValue = const Nothing - resultItemToDoubleValue = voidResultValue- resultItemToDoubleListValue = voidResultValue- resultItemToDoubleStatsValue = id- resultItemToDoubleTimingStatsValue = voidResultValue+ resultItemAsDoubleValue = const Nothing+ resultItemAsDoubleListValue = const Nothing+ resultItemAsDoubleStatsValue = Just+ resultItemAsDoubleTimingStatsValue = const Nothing - resultItemToStringValue = fmap show+ resultItemAsStringValue = Just . fmap show resultItemExpansion = samplingStatsResultSource resultItemSummary = samplingStatsResultSummary@@ -628,17 +732,17 @@ resultItemId = resultValueId resultItemSignal = resultValueSignal - resultItemToIntValue = voidResultValue- resultItemToIntListValue = voidResultValue- resultItemToIntStatsValue = voidResultValue- resultItemToIntTimingStatsValue = id+ resultItemAsIntValue = const Nothing+ resultItemAsIntListValue = const Nothing+ resultItemAsIntStatsValue = const Nothing+ resultItemAsIntTimingStatsValue = Just - resultItemToDoubleValue = voidResultValue- resultItemToDoubleListValue = voidResultValue- resultItemToDoubleStatsValue = voidResultValue- resultItemToDoubleTimingStatsValue = fmap fromIntTimingStats+ resultItemAsDoubleValue = const Nothing+ resultItemAsDoubleListValue = const Nothing+ resultItemAsDoubleStatsValue = const Nothing+ resultItemAsDoubleTimingStatsValue = Just . fmap fromIntTimingStats - resultItemToStringValue = fmap show+ resultItemAsStringValue = Just . fmap show resultItemExpansion = timingStatsResultSource resultItemSummary = timingStatsResultSummary@@ -649,17 +753,17 @@ resultItemId = resultValueId resultItemSignal = resultValueSignal - resultItemToIntValue = voidResultValue- resultItemToIntListValue = voidResultValue- resultItemToIntStatsValue = voidResultValue- resultItemToIntTimingStatsValue = voidResultValue+ resultItemAsIntValue = const Nothing+ resultItemAsIntListValue = const Nothing+ resultItemAsIntStatsValue = const Nothing+ resultItemAsIntTimingStatsValue = const Nothing - resultItemToDoubleValue = voidResultValue- resultItemToDoubleListValue = voidResultValue- resultItemToDoubleStatsValue = voidResultValue- resultItemToDoubleTimingStatsValue = id+ resultItemAsDoubleValue = const Nothing+ resultItemAsDoubleListValue = const Nothing+ resultItemAsDoubleStatsValue = const Nothing+ resultItemAsDoubleTimingStatsValue = Just - resultItemToStringValue = fmap show+ resultItemAsStringValue = Just . fmap show resultItemExpansion = timingStatsResultSource resultItemSummary = timingStatsResultSummary@@ -670,17 +774,17 @@ resultItemId = resultValueId resultItemSignal = resultValueSignal - resultItemToIntValue = voidResultValue- resultItemToIntListValue = voidResultValue- resultItemToIntStatsValue = voidResultValue- resultItemToIntTimingStatsValue = voidResultValue+ resultItemAsIntValue = const Nothing+ resultItemAsIntListValue = const Nothing+ resultItemAsIntStatsValue = const Nothing+ resultItemAsIntTimingStatsValue = const Nothing - resultItemToDoubleValue = voidResultValue- resultItemToDoubleListValue = voidResultValue- resultItemToDoubleStatsValue = voidResultValue- resultItemToDoubleTimingStatsValue = voidResultValue+ resultItemAsDoubleValue = const Nothing+ resultItemAsDoubleListValue = const Nothing+ resultItemAsDoubleStatsValue = const Nothing+ resultItemAsDoubleTimingStatsValue = const Nothing - resultItemToStringValue = fmap show+ resultItemAsStringValue = Just . fmap show resultItemExpansion = ResultItemSource . ResultItem resultItemSummary = ResultItemSource . ResultItem@@ -691,17 +795,17 @@ resultItemId = resultValueId resultItemSignal = resultValueSignal - resultItemToIntValue = voidResultValue- resultItemToIntListValue = voidResultValue- resultItemToIntStatsValue = voidResultValue- resultItemToIntTimingStatsValue = voidResultValue+ resultItemAsIntValue = const Nothing+ resultItemAsIntListValue = const Nothing+ resultItemAsIntStatsValue = const Nothing+ resultItemAsIntTimingStatsValue = const Nothing - resultItemToDoubleValue = voidResultValue- resultItemToDoubleListValue = voidResultValue- resultItemToDoubleStatsValue = voidResultValue- resultItemToDoubleTimingStatsValue = voidResultValue+ resultItemAsDoubleValue = const Nothing+ resultItemAsDoubleListValue = const Nothing+ resultItemAsDoubleStatsValue = const Nothing+ resultItemAsDoubleTimingStatsValue = const Nothing - resultItemToStringValue = id+ resultItemAsStringValue = Just resultItemExpansion = ResultItemSource . ResultItem resultItemSummary = ResultItemSource . ResultItem@@ -712,17 +816,17 @@ resultItemId = resultValueId resultItemSignal = resultValueSignal - resultItemToIntValue = voidResultValue- resultItemToIntListValue = voidResultValue- resultItemToIntStatsValue = voidResultValue- resultItemToIntTimingStatsValue = voidResultValue+ resultItemAsIntValue = const Nothing+ resultItemAsIntListValue = const Nothing+ resultItemAsIntStatsValue = const Nothing+ resultItemAsIntTimingStatsValue = const Nothing - resultItemToDoubleValue = voidResultValue- resultItemToDoubleListValue = voidResultValue- resultItemToDoubleStatsValue = voidResultValue- resultItemToDoubleTimingStatsValue = voidResultValue+ resultItemAsDoubleValue = const Nothing+ resultItemAsDoubleListValue = const Nothing+ resultItemAsDoubleStatsValue = const Nothing+ resultItemAsDoubleTimingStatsValue = const Nothing - resultItemToStringValue = fmap show+ resultItemAsStringValue = Just . fmap show resultItemExpansion = ResultItemSource . ResultItem resultItemSummary = ResultItemSource . ResultItem@@ -733,17 +837,17 @@ resultItemId = resultValueId resultItemSignal = resultValueSignal - resultItemToIntValue = voidResultValue- resultItemToIntListValue = voidResultValue- resultItemToIntStatsValue = voidResultValue- resultItemToIntTimingStatsValue = voidResultValue+ resultItemAsIntValue = const Nothing+ resultItemAsIntListValue = const Nothing+ resultItemAsIntStatsValue = const Nothing+ resultItemAsIntTimingStatsValue = const Nothing - resultItemToDoubleValue = voidResultValue- resultItemToDoubleListValue = voidResultValue- resultItemToDoubleStatsValue = voidResultValue- resultItemToDoubleTimingStatsValue = voidResultValue+ resultItemAsDoubleValue = const Nothing+ resultItemAsDoubleListValue = const Nothing+ resultItemAsDoubleStatsValue = const Nothing+ resultItemAsDoubleTimingStatsValue = const Nothing - resultItemToStringValue = fmap show+ resultItemAsStringValue = Just . fmap show resultItemExpansion = ResultItemSource . ResultItem resultItemSummary = ResultItemSource . ResultItem@@ -754,17 +858,17 @@ resultItemId = resultValueId resultItemSignal = resultValueSignal - resultItemToIntValue = voidResultValue- resultItemToIntListValue = voidResultValue- resultItemToIntStatsValue = voidResultValue- resultItemToIntTimingStatsValue = voidResultValue+ resultItemAsIntValue = const Nothing+ resultItemAsIntListValue = const Nothing+ resultItemAsIntStatsValue = const Nothing+ resultItemAsIntTimingStatsValue = const Nothing - resultItemToDoubleValue = voidResultValue- resultItemToDoubleListValue = voidResultValue- resultItemToDoubleStatsValue = voidResultValue- resultItemToDoubleTimingStatsValue = voidResultValue+ resultItemAsDoubleValue = const Nothing+ resultItemAsDoubleListValue = const Nothing+ resultItemAsDoubleStatsValue = const Nothing+ resultItemAsDoubleTimingStatsValue = const Nothing - resultItemToStringValue = fmap show+ resultItemAsStringValue = Just . fmap show resultItemExpansion = ResultItemSource . ResultItem resultItemSummary = ResultItemSource . ResultItem@@ -775,17 +879,17 @@ resultItemId = resultValueId resultItemSignal = resultValueSignal - resultItemToIntValue = voidResultValue- resultItemToIntListValue = voidResultValue- resultItemToIntStatsValue = voidResultValue- resultItemToIntTimingStatsValue = voidResultValue+ resultItemAsIntValue = const Nothing+ resultItemAsIntListValue = const Nothing+ resultItemAsIntStatsValue = const Nothing+ resultItemAsIntTimingStatsValue = const Nothing - resultItemToDoubleValue = voidResultValue- resultItemToDoubleListValue = voidResultValue- resultItemToDoubleStatsValue = voidResultValue- resultItemToDoubleTimingStatsValue = voidResultValue+ resultItemAsDoubleValue = const Nothing+ resultItemAsDoubleListValue = const Nothing+ resultItemAsDoubleStatsValue = const Nothing+ resultItemAsDoubleTimingStatsValue = const Nothing - resultItemToStringValue = fmap show+ resultItemAsStringValue = Just . fmap show resultItemExpansion = ResultItemSource . ResultItem resultItemSummary = ResultItemSource . ResultItem@@ -796,17 +900,17 @@ resultItemId = resultValueId resultItemSignal = resultValueSignal - resultItemToIntValue = voidResultValue- resultItemToIntListValue = voidResultValue- resultItemToIntStatsValue = voidResultValue- resultItemToIntTimingStatsValue = voidResultValue+ resultItemAsIntValue = const Nothing+ resultItemAsIntListValue = const Nothing+ resultItemAsIntStatsValue = const Nothing+ resultItemAsIntTimingStatsValue = const Nothing - resultItemToDoubleValue = voidResultValue- resultItemToDoubleListValue = voidResultValue- resultItemToDoubleStatsValue = voidResultValue- resultItemToDoubleTimingStatsValue = voidResultValue+ resultItemAsDoubleValue = const Nothing+ resultItemAsDoubleListValue = const Nothing+ resultItemAsDoubleStatsValue = const Nothing+ resultItemAsDoubleTimingStatsValue = const Nothing - resultItemToStringValue = fmap show+ resultItemAsStringValue = Just . fmap show resultItemExpansion = ResultItemSource . ResultItem resultItemSummary = ResultItemSource . ResultItem@@ -1152,190 +1256,6 @@ pureResultSignal rs (ResultSignalMix s) = void (resultSignalInIntegTimes rs) <> s --- | Defines a final result extract: its name, values and other data.-data ResultExtract e =- ResultExtract { resultExtractName :: ResultName,- -- ^ The result name.- resultExtractId :: ResultId,- -- ^ The result identifier.- resultExtractData :: Event e,- -- ^ The result values.- resultExtractSignal :: ResultSignal- -- ^ Whether the result emits a signal.- }---- | Extract the results as integer values, or raise a conversion error.-extractIntResults :: Results -> [ResultExtract Int]-extractIntResults rs = flip map (resultsToIntValues rs) $ \x ->- let n = resultValueName x- i = resultValueId x- a = resultValueData x- s = resultValueSignal x- in case a of- Nothing ->- error $- "Cannot represent variable " ++ n ++- " as a source of integer values: extractIntResults"- Just a ->- ResultExtract n i a s---- | Extract the results as lists of integer values, or raise a conversion error.-extractIntListResults :: Results -> [ResultExtract [Int]]-extractIntListResults rs = flip map (resultsToIntListValues rs) $ \x ->- let n = resultValueName x- i = resultValueId x- a = resultValueData x- s = resultValueSignal x- in case a of- Nothing ->- error $- "Cannot represent variable " ++ n ++- " as a source of lists of integer values: extractIntListResults"- Just a ->- ResultExtract n i a s---- | Extract the results as statistics based on integer values,--- or raise a conversion error.-extractIntStatsResults :: Results -> [ResultExtract (SamplingStats Int)]-extractIntStatsResults rs = flip map (resultsToIntStatsValues rs) $ \x ->- let n = resultValueName x- i = resultValueId x- a = resultValueData x- s = resultValueSignal x- in case a of- Nothing ->- error $- "Cannot represent variable " ++ n ++- " as a source of statistics based on integer values: extractIntStatsResults"- Just a ->- ResultExtract n i a s---- | Extract the results as statistics based on integer values and optimised--- for fast aggregation, or raise a conversion error.-extractIntStatsEitherResults :: Results -> [ResultExtract (Either Int (SamplingStats Int))]-extractIntStatsEitherResults rs = flip map (resultsToIntStatsEitherValues rs) $ \x ->- let n = resultValueName x- i = resultValueId x- a = resultValueData x- s = resultValueSignal x- in case a of- Nothing ->- error $- "Cannot represent variable " ++ n ++- " as a source of statistics based on integer values: extractIntStatsEitherResults"- Just a ->- ResultExtract n i a s---- | Extract the results as timing statistics based on integer values,--- or raise a conversion error.-extractIntTimingStatsResults :: Results -> [ResultExtract (TimingStats Int)]-extractIntTimingStatsResults rs = flip map (resultsToIntTimingStatsValues rs) $ \x ->- let n = resultValueName x- i = resultValueId x- a = resultValueData x- s = resultValueSignal x- in case a of- Nothing ->- error $- "Cannot represent variable " ++ n ++- " as a source of timing statistics based on integer values: extractIntTimingStatsResults"- Just a ->- ResultExtract n i a s---- | Extract the results as double floating point values, or raise a conversion error.-extractDoubleResults :: Results -> [ResultExtract Double]-extractDoubleResults rs = flip map (resultsToDoubleValues rs) $ \x ->- let n = resultValueName x- i = resultValueId x- a = resultValueData x- s = resultValueSignal x- in case a of- Nothing ->- error $- "Cannot represent variable " ++ n ++- " as a source of double floating point values: extractDoubleResults"- Just a ->- ResultExtract n i a s---- | Extract the results as lists of double floating point values,--- or raise a conversion error.-extractDoubleListResults :: Results -> [ResultExtract [Double]]-extractDoubleListResults rs = flip map (resultsToDoubleListValues rs) $ \x ->- let n = resultValueName x- i = resultValueId x- a = resultValueData x- s = resultValueSignal x- in case a of- Nothing ->- error $- "Cannot represent variable " ++ n ++- " as a source of lists of double floating point values: extractDoubleListResults"- Just a ->- ResultExtract n i a s---- | Extract the results as statistics based on double floating point values,--- or raise a conversion error.-extractDoubleStatsResults :: Results -> [ResultExtract (SamplingStats Double)]-extractDoubleStatsResults rs = flip map (resultsToDoubleStatsValues rs) $ \x ->- let n = resultValueName x- i = resultValueId x- a = resultValueData x- s = resultValueSignal x- in case a of- Nothing ->- error $- "Cannot represent variable " ++ n ++- " as a source of statistics based on double floating point values: extractDoubleStatsResults"- Just a ->- ResultExtract n i a s---- | Extract the results as statistics based on double floating point values--- and optimised for fast aggregation, or raise a conversion error.-extractDoubleStatsEitherResults :: Results -> [ResultExtract (Either Double (SamplingStats Double))]-extractDoubleStatsEitherResults rs = flip map (resultsToDoubleStatsEitherValues rs) $ \x ->- let n = resultValueName x- i = resultValueId x- a = resultValueData x- s = resultValueSignal x- in case a of- Nothing ->- error $- "Cannot represent variable " ++ n ++- " as a source of statistics based on double floating point values: extractDoubleStatsEitherResults"- Just a ->- ResultExtract n i a s---- | Extract the results as timing statistics based on double floating point values,--- or raise a conversion error.-extractDoubleTimingStatsResults :: Results -> [ResultExtract (TimingStats Double)]-extractDoubleTimingStatsResults rs = flip map (resultsToDoubleTimingStatsValues rs) $ \x ->- let n = resultValueName x- i = resultValueId x- a = resultValueData x- s = resultValueSignal x- in case a of- Nothing ->- error $- "Cannot represent variable " ++ n ++- " as a source of timing statistics based on double floating point values: extractDoubleTimingStatsResults"- Just a ->- ResultExtract n i a s---- | Extract the results as string values, or raise a conversion error.-extractStringResults :: Results -> [ResultExtract String]-extractStringResults rs = flip map (resultsToStringValues rs) $ \x ->- let n = resultValueName x- i = resultValueId x- a = resultValueData x- s = resultValueSignal x- in case a of- Nothing ->- error $- "Cannot represent variable " ++ n ++- " as a source of string values: extractStringResults"- Just a ->- ResultExtract n i a s- -- | Represents a computation that can return the simulation data. class ResultComputing m where @@ -1376,42 +1296,42 @@ instance ResultComputing Parameter where - computeResultData = Just . liftParameter+ computeResultData = liftParameter computeResultSignal = const UnknownResultSignal instance ResultComputing Simulation where - computeResultData = Just . liftSimulation+ computeResultData = liftSimulation computeResultSignal = const UnknownResultSignal instance ResultComputing Dynamics where - computeResultData = Just . liftDynamics+ computeResultData = liftDynamics computeResultSignal = const UnknownResultSignal instance ResultComputing Event where - computeResultData = Just . id+ computeResultData = id computeResultSignal = const UnknownResultSignal instance ResultComputing Ref where - computeResultData = Just . readRef+ computeResultData = readRef computeResultSignal = ResultSignal . refChanged_ instance ResultComputing LR.Ref where - computeResultData = Just . LR.readRef+ computeResultData = LR.readRef computeResultSignal = const UnknownResultSignal instance ResultComputing Var where - computeResultData = Just . readVar+ computeResultData = readVar computeResultSignal = ResultSignal . varChanged_ instance ResultComputing Signalable where - computeResultData = Just . readSignalable+ computeResultData = readSignalable computeResultSignal = ResultSignal . signalableChanged_ -- | Return a source by the specified statistics.
Simulation/Aivika/Results/IO.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Results.IO--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -107,24 +107,18 @@ -- ^ a localisation -> ResultSourcePrint hPrintResultSourceIndentedLabelled h indent label loc (ResultItemSource (ResultItem x)) =- case resultValueData (resultItemToStringValue x) of- Just m ->- do a <- m- let tab = replicate indent ' '- liftIO $- do hPutStr h tab- hPutStr h "-- "- hPutStr h (loc $ resultItemId x)- hPutStrLn h ""- hPutStr h tab- hPutStr h label- hPutStr h " = "- hPutStrLn h a- hPutStrLn h ""- _ ->- error $- "Expected to see a string value for variable " ++- (resultItemName x) ++ ": hPrintResultSourceIndentedLabelled"+ do a <- resultValueData $ resultItemToStringValue x+ let tab = replicate indent ' '+ liftIO $+ do hPutStr h tab+ hPutStr h "-- "+ hPutStr h (loc $ resultItemId x)+ hPutStrLn h ""+ hPutStr h tab+ hPutStr h label+ hPutStr h " = "+ hPutStrLn h a+ hPutStrLn h "" hPrintResultSourceIndentedLabelled h indent label loc (ResultVectorSource x) = do let tab = replicate indent ' ' liftIO $@@ -229,24 +223,18 @@ -- ^ a localisation -> ResultSourceShowS showResultSourceIndentedLabelled indent label loc (ResultItemSource (ResultItem x)) =- case resultValueData (resultItemToStringValue x) of- Just m ->- do a <- m- let tab = replicate indent ' '- return $- showString tab .- showString "-- " .- showString (loc $ resultItemId x) .- showString "\n" .- showString tab .- showString label .- showString " = " .- showString a .- showString "\n\n"- _ ->- error $- "Expected to see a string value for variable " ++- (resultItemName x) ++ ": showResultSourceIndentedLabelled"+ do a <- resultValueData $ resultItemToStringValue x+ let tab = replicate indent ' '+ return $+ showString tab .+ showString "-- " .+ showString (loc $ resultItemId x) .+ showString "\n" .+ showString tab .+ showString label .+ showString " = " .+ showString a .+ showString "\n\n" showResultSourceIndentedLabelled indent label loc (ResultVectorSource x) = do let tab = replicate indent ' ' items = A.elems (resultVectorItems x)
Simulation/Aivika/Results/Locale.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Results.Locale--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Server.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Server--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -71,7 +71,7 @@ import Simulation.Aivika.Simulation import Simulation.Aivika.Dynamics import Simulation.Aivika.Internal.Event-import Simulation.Aivika.Internal.Signal+import Simulation.Aivika.Signal import Simulation.Aivika.Resource import Simulation.Aivika.Cont import Simulation.Aivika.Process@@ -215,7 +215,7 @@ -- -- The queue processors usually have the prefetching capabilities per se, where -- the items are already stored in the queue. Therefore, the server processor--- should not be prefetched if it is connected directly with the queue processor.+-- should not be prefetched if it is connected directly to the queue processor. serverProcessor :: Server s a b -> Processor a b serverProcessor server = Processor $ \xs -> loop (serverInitState server) Nothing xs
Simulation/Aivika/Signal.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Signal--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -52,4 +52,336 @@ -- * Debugging traceSignal) where -import Simulation.Aivika.Internal.Signal+import Data.IORef+import Data.Monoid+import Data.List+import Data.Array++import Control.Monad+import Control.Monad.Trans++import Simulation.Aivika.Internal.Specs+import Simulation.Aivika.Internal.Parameter+import Simulation.Aivika.Internal.Simulation+import Simulation.Aivika.Internal.Event+import Simulation.Aivika.Internal.Arrival++import qualified Simulation.Aivika.Vector as V+import qualified Simulation.Aivika.Vector.Unboxed as UV++-- | The signal source that can publish its signal.+data SignalSource a =+ SignalSource { publishSignal :: Signal a,+ -- ^ Publish the signal.+ triggerSignal :: a -> Event ()+ -- ^ Trigger the signal actuating + -- all its handlers at the current + -- simulation time point.+ }+ +-- | The signal that can have disposable handlers. +data Signal a =+ Signal { handleSignal :: (a -> Event ()) -> Event DisposableEvent+ -- ^ Subscribe the handler to the specified + -- signal and return a nested computation+ -- within a disposable object that, being applied,+ -- unsubscribes the handler from this signal.+ }+ +-- | The queue of signal handlers.+data SignalHandlerQueue a =+ SignalHandlerQueue { queueList :: IORef [SignalHandler a] }+ +-- | It contains the information about the disposable queue handler.+data SignalHandler a =+ SignalHandler { handlerComp :: a -> Event (),+ handlerRef :: IORef () }++instance Eq (SignalHandler a) where+ x == y = (handlerRef x) == (handlerRef y)++-- | Subscribe the handler to the specified signal forever.+-- To subscribe the disposable handlers, use function 'handleSignal'.+handleSignal_ :: Signal a -> (a -> Event ()) -> Event ()+handleSignal_ signal h = + do x <- handleSignal signal h+ return ()+ +-- | Create a new signal source.+newSignalSource :: Simulation (SignalSource a)+newSignalSource =+ Simulation $ \r ->+ do list <- newIORef []+ let queue = SignalHandlerQueue { queueList = list }+ signal = Signal { handleSignal = handle }+ source = SignalSource { publishSignal = signal, + triggerSignal = trigger }+ handle h =+ Event $ \p ->+ do x <- enqueueSignalHandler queue h+ return $+ DisposableEvent $+ Event $ \p -> dequeueSignalHandler queue x+ trigger a =+ Event $ \p -> triggerSignalHandlers queue a p+ return source++-- | Trigger all next signal handlers.+triggerSignalHandlers :: SignalHandlerQueue a -> a -> Point -> IO ()+{-# INLINE triggerSignalHandlers #-}+triggerSignalHandlers q a p =+ do hs <- readIORef (queueList q)+ forM_ hs $ \h ->+ invokeEvent p $ handlerComp h a+ +-- | Enqueue the handler and return its representative in the queue. +enqueueSignalHandler :: SignalHandlerQueue a -> (a -> Event ()) -> IO (SignalHandler a)+{-# INLINE enqueueSignalHandler #-}+enqueueSignalHandler q h = + do r <- newIORef ()+ let handler = SignalHandler { handlerComp = h,+ handlerRef = r }+ modifyIORef (queueList q) (handler :)+ return handler++-- | Dequeue the handler representative.+dequeueSignalHandler :: SignalHandlerQueue a -> SignalHandler a -> IO ()+{-# INLINE dequeueSignalHandler #-}+dequeueSignalHandler q h = + modifyIORef (queueList q) (delete h)++instance Functor Signal where+ fmap = mapSignal+ +instance Monoid (Signal a) where + + mempty = emptySignal+ + mappend = merge2Signals+ + mconcat [] = emptySignal+ mconcat [x1] = x1+ mconcat [x1, x2] = merge2Signals x1 x2+ mconcat [x1, x2, x3] = merge3Signals x1 x2 x3+ mconcat [x1, x2, x3, x4] = merge4Signals x1 x2 x3 x4+ mconcat [x1, x2, x3, x4, x5] = merge5Signals x1 x2 x3 x4 x5+ mconcat (x1 : x2 : x3 : x4 : x5 : xs) = + mconcat $ merge5Signals x1 x2 x3 x4 x5 : xs+ +-- | Map the signal according the specified function.+mapSignal :: (a -> b) -> Signal a -> Signal b+mapSignal f m =+ Signal { handleSignal = \h -> + handleSignal m $ h . f }++-- | Filter only those signal values that satisfy to +-- the specified predicate.+filterSignal :: (a -> Bool) -> Signal a -> Signal a+filterSignal p m =+ Signal { handleSignal = \h ->+ handleSignal m $ \a ->+ when (p a) $ h a }+ +-- | Filter only those signal values that satisfy to +-- the specified predicate.+filterSignalM :: (a -> Event Bool) -> Signal a -> Signal a+filterSignalM p m =+ Signal { handleSignal = \h ->+ handleSignal m $ \a ->+ do x <- p a+ when x $ h a }+ +-- | Merge two signals.+merge2Signals :: Signal a -> Signal a -> Signal a+merge2Signals m1 m2 =+ Signal { handleSignal = \h ->+ do x1 <- handleSignal m1 h+ x2 <- handleSignal m2 h+ return $ x1 <> x2 }++-- | Merge three signals.+merge3Signals :: Signal a -> Signal a -> Signal a -> Signal a+merge3Signals m1 m2 m3 =+ Signal { handleSignal = \h ->+ do x1 <- handleSignal m1 h+ x2 <- handleSignal m2 h+ x3 <- handleSignal m3 h+ return $ x1 <> x2 <> x3 }++-- | Merge four signals.+merge4Signals :: Signal a -> Signal a -> Signal a -> + Signal a -> Signal a+merge4Signals m1 m2 m3 m4 =+ Signal { handleSignal = \h ->+ do x1 <- handleSignal m1 h+ x2 <- handleSignal m2 h+ x3 <- handleSignal m3 h+ x4 <- handleSignal m4 h+ return $ x1 <> x2 <> x3 <> x4 }+ +-- | Merge five signals.+merge5Signals :: Signal a -> Signal a -> Signal a -> + Signal a -> Signal a -> Signal a+merge5Signals m1 m2 m3 m4 m5 =+ Signal { handleSignal = \h ->+ do x1 <- handleSignal m1 h+ x2 <- handleSignal m2 h+ x3 <- handleSignal m3 h+ x4 <- handleSignal m4 h+ x5 <- handleSignal m5 h+ return $ x1 <> x2 <> x3 <> x4 <> x5 }++-- | Compose the signal.+mapSignalM :: (a -> Event b) -> Signal a -> Signal b+mapSignalM f m =+ Signal { handleSignal = \h ->+ handleSignal m (f >=> h) }+ +-- | Transform the signal.+apSignal :: Event (a -> b) -> Signal a -> Signal b+apSignal f m =+ Signal { handleSignal = \h ->+ handleSignal m $ \a -> do { x <- f; h (x a) } }++-- | An empty signal which is never triggered.+emptySignal :: Signal a+emptySignal =+ Signal { handleSignal = \h -> return mempty }+ +-- | Represents the history of the signal values.+data SignalHistory a =+ SignalHistory { signalHistorySignal :: Signal a, + -- ^ The signal for which the history is created.+ signalHistoryTimes :: UV.Vector Double,+ signalHistoryValues :: V.Vector a }++-- | Create a history of the signal values.+newSignalHistory :: Signal a -> Event (SignalHistory a)+newSignalHistory =+ newSignalHistoryStartingWith Nothing++-- | Create a history of the signal values starting with+-- the optional initial value.+newSignalHistoryStartingWith :: Maybe a -> Signal a -> Event (SignalHistory a)+newSignalHistoryStartingWith init signal =+ Event $ \p ->+ do ts <- UV.newVector+ xs <- V.newVector+ case init of+ Nothing -> return ()+ Just a ->+ do UV.appendVector ts (pointTime p)+ V.appendVector xs a+ invokeEvent p $+ handleSignal_ signal $ \a ->+ Event $ \p ->+ do UV.appendVector ts (pointTime p)+ V.appendVector xs a+ return SignalHistory { signalHistorySignal = signal,+ signalHistoryTimes = ts,+ signalHistoryValues = xs }+ +-- | Read the history of signal values.+readSignalHistory :: SignalHistory a -> Event (Array Int Double, Array Int a)+readSignalHistory history =+ do xs <- liftIO $ UV.freezeVector (signalHistoryTimes history)+ ys <- liftIO $ V.freezeVector (signalHistoryValues history)+ return (xs, ys) + +-- | Trigger the signal with the current time.+triggerSignalWithCurrentTime :: SignalSource Double -> Event ()+triggerSignalWithCurrentTime s =+ Event $ \p -> invokeEvent p $ triggerSignal s (pointTime p)++-- | Return a signal that is triggered in the specified time points.+newSignalInTimes :: [Double] -> Event (Signal Double)+newSignalInTimes xs =+ do s <- liftSimulation newSignalSource+ enqueueEventWithTimes xs $ triggerSignalWithCurrentTime s+ return $ publishSignal s+ +-- | Return a signal that is triggered in the integration time points.+-- It should be called with help of 'runEventInStartTime'.+newSignalInIntegTimes :: Event (Signal Double)+newSignalInIntegTimes =+ do s <- liftSimulation newSignalSource+ enqueueEventWithIntegTimes $ triggerSignalWithCurrentTime s+ return $ publishSignal s+ +-- | Return a signal that is triggered in the start time.+-- It should be called with help of 'runEventInStartTime'.+newSignalInStartTime :: Event (Signal Double)+newSignalInStartTime =+ do s <- liftSimulation newSignalSource+ t <- liftParameter starttime+ enqueueEvent t $ triggerSignalWithCurrentTime s+ return $ publishSignal s++-- | Return a signal that is triggered in the final time.+newSignalInStopTime :: Event (Signal Double)+newSignalInStopTime =+ do s <- liftSimulation newSignalSource+ t <- liftParameter stoptime+ enqueueEvent t $ triggerSignalWithCurrentTime s+ return $ publishSignal s++-- | Describes a computation that also signals when changing its value.+data Signalable a =+ Signalable { readSignalable :: Event a,+ -- ^ Return a computation of the value.+ signalableChanged_ :: Signal ()+ -- ^ Return a signal notifying that the value has changed+ -- but without providing the information about the changed value.+ }++-- | Return a signal notifying that the value has changed.+signalableChanged :: Signalable a -> Signal a+signalableChanged x = mapSignalM (const $ readSignalable x) $ signalableChanged_ x++instance Functor Signalable where+ fmap f x = x { readSignalable = fmap f (readSignalable x) }++instance Monoid a => Monoid (Signalable a) where++ mempty = emptySignalable+ mappend = appendSignalable++-- | Return an identity.+emptySignalable :: Monoid a => Signalable a+emptySignalable =+ Signalable { readSignalable = return mempty,+ signalableChanged_ = mempty }++-- | An associative operation.+appendSignalable :: Monoid a => Signalable a -> Signalable a -> Signalable a+appendSignalable m1 m2 =+ Signalable { readSignalable = liftM2 (<>) (readSignalable m1) (readSignalable m2),+ signalableChanged_ = (signalableChanged_ m1) <> (signalableChanged_ m2) }++-- | Transform a signal so that the resulting signal returns a sequence of arrivals+-- saving the information about the time points at which the original signal was received.+arrivalSignal :: Signal a -> Signal (Arrival a)+arrivalSignal m = + Signal { handleSignal = \h ->+ Event $ \p ->+ do r <- newIORef Nothing+ invokeEvent p $+ handleSignal m $ \a ->+ Event $ \p ->+ do t0 <- readIORef r+ let t = pointTime p+ writeIORef r (Just t)+ invokeEvent p $+ h Arrival { arrivalValue = a,+ arrivalTime = t,+ arrivalDelay =+ case t0 of+ Nothing -> Nothing+ Just t0 -> Just (t - t0) }+ }++-- | Show the debug message with the current simulation time.+traceSignal :: String -> Signal a -> Signal a +traceSignal message m =+ Signal { handleSignal = \h ->+ handleSignal m $ traceEvent message . h }
Simulation/Aivika/Simulation.hs view
@@ -1,13 +1,14 @@ -- | -- Module : Simulation.Aivika.Simulation--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental -- Tested with: GHC 7.8.3 ----- The module defines the 'Simulation' monad that represents a simulation run.+-- The module defines the 'Simulation' monad that represents a computation within+-- the simulation run. -- module Simulation.Aivika.Simulation (-- * Simulation
Simulation/Aivika/Specs.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Specs--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Statistics.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Statistics--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Statistics/Accumulator.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Statistics.Accumulator--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Stream.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Stream--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -50,6 +50,10 @@ apStreamM, filterStream, filterStreamM,+ singletonStream,+ joinStream,+ -- * Failover+ failoverStream, -- * Integrating with Signals signalStream, streamSignal,@@ -97,6 +101,12 @@ (<*>) = apStream +instance Alternative Stream where++ empty = emptyStream++ (<|>) = mergeStreams+ instance Monoid (Stream a) where mempty = emptyStream@@ -534,6 +544,57 @@ -- | Delay the stream by one step using the specified initial value. delayStream :: a -> Stream a -> Stream a delayStream a0 s = Cons $ return (a0, s)++-- | Return a stream consisting of exactly one element and inifinite tail.+singletonStream :: a -> Stream a+singletonStream a = Cons $ return (a, emptyStream)++-- | Removes one level of the computation, projecting its bound stream into the outer level.+joinStream :: Process (Stream a) -> Stream a+joinStream m = Cons $ m >>= runStream++-- | Takes the next stream from the list after the current stream fails because of cancelling the underlying process.+failoverStream :: [Stream a] -> Stream a+failoverStream ps = Cons z where+ z = do reading <- liftSimulation $ newResourceWithMaxCount FCFS 0 (Just 1)+ writing <- liftSimulation $ newResourceWithMaxCount FCFS 0 (Just 1)+ ref <- liftIO $ newIORef Nothing+ pid <- processId+ let writer p =+ do requestResource writing+ pid' <- processId+ (a, xs) <-+ finallyProcess (runStream p) $+ liftEvent $+ do cancelled' <- processCancelled pid'+ when cancelled' $+ releaseResourceWithinEvent writing+ liftIO $ writeIORef ref (Just a)+ releaseResource reading+ writer xs+ reader =+ do releaseResource writing+ requestResource reading+ Just a <- liftIO $ readIORef ref+ liftIO $ writeIORef ref Nothing+ return a+ loop [] = return ()+ loop (p: ps) =+ do pid' <- processId+ h' <- liftEvent $+ handleSignal (processCancelling pid) $ \() ->+ cancelProcessWithId pid'+ finallyProcess (writer p) $+ liftEvent $+ do disposeEvent h'+ cancelled <- processCancelled pid+ unless cancelled $+ do cancelled' <- processCancelled pid'+ unless cancelled' $+ error "Expected the sub-process to be cancelled: failoverStream"+ runProcess $ loop ps+ liftEvent $ runProcess $ loop ps+ runStream $ repeatProcess reader -- | Show the debug messages with the current simulation time. traceStream :: Maybe String
Simulation/Aivika/Stream/Random.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Stream.Random--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/SystemDynamics.hs view
@@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.SystemDynamics--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Table.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Table--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Task.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Task--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -34,7 +34,10 @@ spawnTaskUsingIdWith, -- * Enqueueing Task enqueueTask,- enqueueTaskUsingId) where+ enqueueTaskUsingId,+ -- * Parallel Tasks+ taskParallelResult,+ taskParallelProcess) where import Data.IORef import Data.Monoid@@ -48,7 +51,7 @@ import Simulation.Aivika.Internal.Event import Simulation.Aivika.Internal.Cont import Simulation.Aivika.Internal.Process-import Simulation.Aivika.Internal.Signal+import Simulation.Aivika.Signal -- | The task represents a process that was already started in background. data Task a =@@ -168,12 +171,58 @@ do pid <- liftSimulation newProcessId spawnTaskUsingIdWith cancellation pid p --- | Return an outer process that behaves like the task itself except for one thing:--- if the outer process is cancelled then it is not enough to cancel the task. +-- | Return an outer process that behaves like the task itself, for example,+-- when the task is cancelled if the outer process is cancelled. taskProcess :: Task a -> Process a taskProcess t =- do x <- taskResult t+ do x <- finallyProcess+ (taskResult t)+ (do pid <- processId+ liftEvent $+ do cancelled <- processCancelled pid+ when cancelled $+ cancelTask t) case x of TaskCompleted a -> return a TaskError e -> throwProcess e TaskCancelled -> cancelProcess++-- | Return the result of two parallel tasks.+taskParallelResult :: Task a -> Task a -> Process (TaskResult a, Task a)+taskParallelResult t1 t2 =+ do x1 <- liftIO $ readIORef (taskResultRef t1)+ case x1 of+ Just x1 -> return (x1, t2)+ Nothing ->+ do x2 <- liftIO $ readIORef (taskResultRef t2)+ case x2 of+ Just x2 -> return (x2, t1)+ Nothing ->+ do let s1 = fmap Left $ taskResultReceived t1+ s2 = fmap Right $ taskResultReceived t2+ x <- processAwait $ s1 <> s2+ case x of+ Left x1 -> return (x1, t2)+ Right x2 -> return (x2, t1) ++-- | Return an outer process for two parallel tasks returning the result of+-- the first finished task and the rest task in pair. +taskParallelProcess :: Task a -> Task a -> Process (a, Task a)+taskParallelProcess t1 t2 =+ do (x, t) <-+ finallyProcess+ (taskParallelResult t1 t2)+ (do pid <- processId+ liftEvent $+ do cancelled <- processCancelled pid+ when cancelled $+ do cancelTask t1+ cancelTask t2)+ case x of+ TaskCompleted a -> return (a, t)+ TaskError e ->+ do liftEvent $ cancelTask t+ throwProcess e+ TaskCancelled ->+ do liftEvent $ cancelTask t+ cancelProcess
Simulation/Aivika/Transform.hs view
@@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Transform--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Transform/Extra.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Transform.Extra--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Transform/Memo.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Transform.Memo--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Transform/Memo/Unboxed.hs view
@@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Transform.Memo.Unboxed--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Unboxed.hs view
@@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Unboxed--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Var.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Var--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -30,7 +30,6 @@ import Simulation.Aivika.Internal.Simulation import Simulation.Aivika.Internal.Dynamics import Simulation.Aivika.Internal.Event-import Simulation.Aivika.Internal.Signal import Simulation.Aivika.Ref import Simulation.Aivika.Signal
Simulation/Aivika/Var/Unboxed.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Var.Unboxed--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -30,7 +30,6 @@ import Simulation.Aivika.Internal.Simulation import Simulation.Aivika.Internal.Dynamics import Simulation.Aivika.Internal.Event-import Simulation.Aivika.Internal.Signal import Simulation.Aivika.Ref import Simulation.Aivika.Signal import Simulation.Aivika.Unboxed
Simulation/Aivika/Vector.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Vector--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
Simulation/Aivika/Vector/Unboxed.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Vector.Unboxed--- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2009-2015, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental
aivika.cabal view
@@ -1,5 +1,5 @@ name: aivika-version: 3.0+version: 3.1 synopsis: A multi-paradigm simulation library description: Aivika is a multi-paradigm simulation library with a strong emphasis@@ -81,7 +81,7 @@ category: Simulation license: BSD3 license-file: LICENSE-copyright: (c) 2009-2014. David Sorokin <david.sorokin@gmail.com>+copyright: (c) 2009-2015. David Sorokin <david.sorokin@gmail.com> author: David Sorokin maintainer: David Sorokin <david.sorokin@gmail.com> homepage: http://github.com/dsorokin/aivika@@ -108,6 +108,7 @@ examples/TimeOut.hs examples/TimeOutInt.hs examples/TimeOutWait.hs+ CHANGELOG.md flag haste-inst @@ -172,7 +173,6 @@ Simulation.Aivika.Internal.Event Simulation.Aivika.Internal.Parameter Simulation.Aivika.Internal.Process- Simulation.Aivika.Internal.Signal Simulation.Aivika.Internal.Simulation Simulation.Aivika.Internal.Specs Simulation.Aivika.Internal.Arrival
examples/BassDiffusion.hs view
@@ -42,7 +42,7 @@ return (i, p) return $ array (1, n) list -definePerson :: Person -> Array Int Person -> Ref Int -> Ref Int -> Simulation ()+definePerson :: Person -> Array Int Person -> Ref Int -> Ref Int -> Event () definePerson p ps potentialAdopters adopters = do setStateActivation (personPotentialAdopter p) $ do modifyRef potentialAdopters $ \a -> a + 1@@ -71,7 +71,7 @@ setStateDeactivation (personAdopter p) $ modifyRef adopters $ \a -> a - 1 -definePersons :: Array Int Person -> Ref Int -> Ref Int -> Simulation ()+definePersons :: Array Int Person -> Ref Int -> Ref Int -> Event () definePersons ps potentialAdopters adopters = forM_ (elems ps) $ \p -> definePerson p ps potentialAdopters adopters@@ -88,13 +88,13 @@ do potentialAdopters <- newRef 0 adopters <- newRef 0 ps <- createPersons- definePersons ps potentialAdopters adopters runEventInStartTime $- activatePersons ps+ do definePersons ps potentialAdopters adopters+ activatePersons ps return $ results [resultSource - "potentialAdopter" "potential adopters" potentialAdopters,+ "potentialAdopters" "potential adopters" potentialAdopters, resultSource "adopters" "adopters" adopters]
examples/InventorySystem.hs view
@@ -69,7 +69,7 @@ lostSalesCount <- newRef (0 :: Int) -- whether the procurement initiated? procuring <- newRef False- -- the inventotyPosition+ -- the inventory position let inventoryPosition = do x1 <- readRef radioStock x2 <- readRef orderCount
examples/MachineBreakdowns.hs view
@@ -12,6 +12,7 @@ import Control.Category import Data.Monoid+import Data.List import Simulation.Aivika import qualified Simulation.Aivika.Queue.Infinite as IQ@@ -54,81 +55,99 @@ -- ^ the remaining processing time (may differ after return). } +-- | Return the remaining job after interruption.+remainingJobInput :: ServerInterruption (Arrival Job) -> Arrival Job+remainingJobInput x = a'+ where+ t1 = serverStartProcessingTime x+ t2 = serverInterruptionTime x+ dt = t2 - t1+ a = serverInterruptedInput x+ a' = a { arrivalValue = job' }+ job = arrivalValue a+ job' = job { jobRemainingTime =+ max 0 $ jobRemainingTime job - dt }+ model :: Simulation Results model = do -- create an input queue- inputQueue <- runEventInStartTime $ IQ.newFCFSQueue+ inputQueue <- runEventInStartTime IQ.newPriorityQueue -- a counter of jobs completed jobsCompleted <- newArrivalTimer+ -- a counter of interrupted jobs but then returned for the further processing+ jobsInterrupted <- newRef (0 :: Int) -- create an input stream let inputStream = traceStream Nothing (Just "taking a job from the queue") $ repeatProcess $ IQ.dequeue inputQueue -- create the setting up phase of processing machineSettingUp <-- newServer $ \a ->+ newInterruptibleServer True $ \a -> do -- set up the machine setUpTime <- liftParameter $ randomUniform minSetUpTime maxSetUpTime- holdProcess setUpTime+ traceProcess "setting up the machine" $+ holdProcess setUpTime return a -- create the processing phase itself machineProcessing <- newInterruptibleServer True $ \a -> do -- process the job let job = arrivalValue a- holdProcess $ jobRemainingTime job+ traceProcess "processing the job" $+ holdProcess $ jobRemainingTime job -- return the completed job return a { arrivalValue = job { jobRemainingTime = 0 } }- -- define the network- let network =- traceProcessor Nothing (Just "the job completed") $- serverProcessor machineSettingUp >>>- serverProcessor machineProcessing >>>- arrivalTimerProcessor jobsCompleted -- enqueue the interrupted jobs again runEventInStartTime $- handleSignal_ (serverTaskInterrupted machineProcessing) $ \x ->- traceEvent "interrupting the job.." $- do let t1 = serverStartProcessingTime x- t2 = serverInterruptionTime x- dt = t2 - t1- a = serverInterruptedInput x- a' = a { arrivalValue = job' }- job = arrivalValue a- job' = job { jobRemainingTime =- max 0 $ jobRemainingTime job - dt }- IQ.enqueue inputQueue a'- -- launch the machine tool- let launch = do- -- breakdown the machine tool in time (a bound child process)- spawnProcess $ do- breakdownTime <-- liftParameter $- randomNormal breakdownMu breakdownSigma- holdProcess breakdownTime- traceProcess "breakdown" $- cancelProcess- -- model the machine tool itself- let loop =- -- process the jobs until interrupting- sinkStream $- runProcessor network inputStream- -- model the repairing of the tool- let repair = do- -- at first repair the machine- repairTime <- liftParameter $- randomErlang repairMu 3- holdProcess repairTime- -- then launch it again (an independent process)- traceProcess "repaired" $- liftEvent $- runProcess launch- -- start simulating the machine tool with an ability to repair- finallyProcess loop repair+ do handleSignal_ (serverTaskInterrupted machineSettingUp) $ \x ->+ traceEvent "returning the job..." $+ do let a = serverInterruptedInput x+ t = arrivalTime a+ IQ.enqueueWithStoringPriority inputQueue t a+ handleSignal_ (serverTaskInterrupted machineProcessing) $ \x ->+ traceEvent "interrupting the job..." $+ do let a = remainingJobInput x+ t = arrivalTime a+ modifyRef jobsInterrupted (+ 1)+ IQ.enqueueWithStoringPriority inputQueue t a+ let -- launch the machine tool again and again+ machineLaunch =+ joinProcessor $+ do spawnProcess $+ do -- breakdown the machine tool in time (a bound child process)+ breakdownTime <-+ liftParameter $+ randomNormal breakdownMu breakdownSigma+ when (breakdownTime > 0) $+ holdProcess breakdownTime+ traceProcess "breakdown" $+ cancelProcess+ return $+ serverProcessor machineSettingUp >>>+ serverProcessor machineProcessing+ -- repair the machine tool+ machineRepair =+ do repairTime <- liftParameter $+ randomErlang repairMu 3+ holdProcess repairTime+ -- launch after repairing the machine tool+ machineRepairAndLaunch =+ joinProcessor $+ do machineRepair+ traceProcess "repaired" $+ return machineLaunch+ -- machine loop+ machineLoop = machineLaunch : repeat machineRepairAndLaunch+ -- the network+ network = + traceProcessor Nothing (Just "the job completed") $+ failoverProcessor machineLoop >>>+ arrivalTimerProcessor jobsCompleted -- start the machine tool- runProcessInStartTime launch+ runProcessInStartTime $+ sinkStream $ runProcessor network inputStream -- model a stream of jobs let jobs = traceStream Nothing (Just "a new job") $@@ -142,9 +161,10 @@ liftParameter $ randomNormal jobProcessingMu jobProcessingSigma -- enqueue the job- IQ.enqueue inputQueue $- a { arrivalValue =- Job jobProcessingTime jobProcessingTime }+ let t0 = arrivalTime a+ dt = max 0 jobProcessingTime+ IQ.enqueueWithStoringPriority inputQueue t0 $+ a { arrivalValue = Job dt dt } -- return the simulation results in start time return $ results@@ -159,6 +179,10 @@ resultSource "machineProcessing" "the machine tool (the processing phase)" machineProcessing,+ --+ resultSource+ "jobsInterrupted" "a counter of the interrupted jobs"+ jobsInterrupted, -- resultSource "jobsCompleted" "a counter of the completed jobs"
examples/WorkStationsInSeries.hs view
@@ -59,10 +59,6 @@ randomExponential meanTime) return a --- interpose the prefetch processor between two processors-interposePrefetchProcessor x y = - x >>> prefetchProcessor >>> y- model :: Simulation Results model = do -- it will gather the statistics of the processing time@@ -97,10 +93,10 @@ let entireProcessor = queueProcessor1 >>> processorParallel (map serverProcessor workStation1s) >>>- -- foldr1 interposePrefetchProcessor (map serverProcessor workStation1s) >>>+ -- processorSeq (map serverProcessor workStation1s) >>> queueProcessor2 >>> processorParallel (map serverProcessor workStation2s) >>>- -- foldr1 interposePrefetchProcessor (map serverProcessor workStation2s) >>>+ -- processorSeq (map serverProcessor workStation2s) >>> arrivalTimerProcessor arrivalTimer -- start simulating the model runProcessInStartTime $