aivika 1.3 → 1.4

raw patch · 59 files changed

+3641/−466 lines, 59 filesdep +vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: vector

API changes (from Hackage documentation)

Files

• Simulation/Aivika.hs +9/−1
• Simulation/Aivika/Agent.hs +1/−1
• Simulation/Aivika/Arrival.hs +21/−4
• Simulation/Aivika/Circuit.hs +57/−56
• Simulation/Aivika/Cont.hs +1/−1
• Simulation/Aivika/DoubleLinkedList.hs +1/−1
• Simulation/Aivika/Dynamics.hs +1/−1
• Simulation/Aivika/Dynamics/Random.hs +14/−0
• Simulation/Aivika/Event.hs +4/−2
• Simulation/Aivika/Generator.hs +30/−1
• Simulation/Aivika/Internal/Arrival.hs +1/−1
• Simulation/Aivika/Internal/Cont.hs +27/−21
• Simulation/Aivika/Internal/Dynamics.hs +5/−0
• Simulation/Aivika/Internal/Event.hs +20/−1
• Simulation/Aivika/Internal/Parameter.hs +5/−0
• Simulation/Aivika/Internal/Process.hs +7/−1
• Simulation/Aivika/Internal/Signal.hs +17/−13
• Simulation/Aivika/Internal/Simulation.hs +5/−0
• Simulation/Aivika/Net.hs +242/−0
• Simulation/Aivika/Parameter.hs +1/−1
• Simulation/Aivika/Parameter/Random.hs +10/−0
• Simulation/Aivika/PriorityQueue.hs +1/−1
• Simulation/Aivika/Process.hs +1/−1
• Simulation/Aivika/Processor.hs +7/−2
• Simulation/Aivika/Processor/RoundRobbin.hs +1/−1
• Simulation/Aivika/Queue.hs +76/−21
• Simulation/Aivika/Queue/Infinite.hs +69/−17
• Simulation/Aivika/QueueStrategy.hs +1/−1
• Simulation/Aivika/Ref.hs +1/−1
• Simulation/Aivika/Resource.hs +1/−1
• Simulation/Aivika/Results.hs +1841/−0
• Simulation/Aivika/Results/IO.hs +476/−0
• Simulation/Aivika/Results/Locale.hs +339/−0
• Simulation/Aivika/Server.hs +1/−1
• Simulation/Aivika/Signal.hs +1/−1
• Simulation/Aivika/Simulation.hs +1/−1
• Simulation/Aivika/Specs.hs +1/−1
• Simulation/Aivika/Statistics.hs +12/−5
• Simulation/Aivika/Stream.hs +15/−9
• Simulation/Aivika/Stream/Random.hs +29/−13
• Simulation/Aivika/SystemDynamics.hs +1/−1
• Simulation/Aivika/Table.hs +1/−1
• Simulation/Aivika/Task.hs +1/−1
• Simulation/Aivika/Transform.hs +1/−1
• Simulation/Aivika/Unboxed.hs +8/−3
• Simulation/Aivika/Var.hs +1/−1
• Simulation/Aivika/Vector.hs +1/−1
• aivika.cabal +27/−9
• examples/BassDiffusion.hs +18/−11
• examples/ChemicalReaction.hs +11/−3
• examples/FishBank.hs +12/−3
• examples/Furnace.hs +36/−63
• examples/InspectionAdjustmentStations.hs +38/−92
• examples/MachRep1.hs +17/−7
• examples/MachRep1EventDriven.hs +16/−6
• examples/MachRep1TimeDriven.hs +16/−7
• examples/MachRep2.hs +30/−10
• examples/MachRep3.hs +16/−6
• examples/WorkStationsInSeries.hs +37/−57

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- This module re-exports the most part of the library functionality. -- But there are modules that must be imported explicitly.@@ -22,6 +22,7 @@         module Simulation.Aivika.Dynamics.Random,         module Simulation.Aivika.Event,         module Simulation.Aivika.Generator,+        module Simulation.Aivika.Net,         module Simulation.Aivika.Parameter,         module Simulation.Aivika.Parameter.Random,         module Simulation.Aivika.Process,@@ -30,6 +31,9 @@         module Simulation.Aivika.QueueStrategy,         module Simulation.Aivika.Ref,         module Simulation.Aivika.Resource,+        module Simulation.Aivika.Results,+        module Simulation.Aivika.Results.Locale,+        module Simulation.Aivika.Results.IO,         module Simulation.Aivika.Server,         module Simulation.Aivika.Signal,         module Simulation.Aivika.Simulation,@@ -52,6 +56,7 @@ import Simulation.Aivika.Dynamics.Random import Simulation.Aivika.Event import Simulation.Aivika.Generator+import Simulation.Aivika.Net import Simulation.Aivika.Parameter import Simulation.Aivika.Parameter.Random import Simulation.Aivika.Process@@ -60,6 +65,9 @@ import Simulation.Aivika.QueueStrategy import Simulation.Aivika.Ref import Simulation.Aivika.Resource+import Simulation.Aivika.Results+import Simulation.Aivika.Results.Locale+import Simulation.Aivika.Results.IO import Simulation.Aivika.Server import Simulation.Aivika.Signal import Simulation.Aivika.Simulation

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- This module introduces basic entities for the agent-based modeling. --

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- This module defines the types and functions for working with the events -- that can represent something that arrive from outside the model, or@@ -18,7 +18,9 @@         ArrivalTimer,         newArrivalTimer,         arrivalTimerProcessor,-        arrivalProcessingTime) where+        arrivalProcessingTime,+        arrivalProcessingTimeChanged,+        arrivalProcessingTimeChanged_) where  import Control.Monad import Control.Monad.Trans@@ -30,22 +32,36 @@ import Simulation.Aivika.Stream import Simulation.Aivika.Statistics import Simulation.Aivika.Ref+import Simulation.Aivika.Signal import Simulation.Aivika.Internal.Arrival  -- | Accumulates the statistics about that how long the arrived events are processed. data ArrivalTimer =-  ArrivalTimer { arrivalProcessingTimeRef :: Ref (SamplingStats Double) }+  ArrivalTimer { arrivalProcessingTimeRef :: Ref (SamplingStats Double),+                 arrivalProcessingTimeChangedSource :: SignalSource () }  -- | Create a new timer that measures how long the arrived events are processed. newArrivalTimer :: Simulation ArrivalTimer newArrivalTimer =   do r <- newRef emptySamplingStats-     return ArrivalTimer { arrivalProcessingTimeRef = r }+     s <- newSignalSource+     return ArrivalTimer { arrivalProcessingTimeRef = r,+                           arrivalProcessingTimeChangedSource = s }  -- | Return the statistics about that how long the arrived events were processed. arrivalProcessingTime :: ArrivalTimer -> Event (SamplingStats Double) arrivalProcessingTime = readRef . arrivalProcessingTimeRef +-- | Return a signal raised when the the processing time statistics changes.+arrivalProcessingTimeChanged :: ArrivalTimer -> Signal (SamplingStats Double)+arrivalProcessingTimeChanged timer =+  mapSignalM (const $ arrivalProcessingTime timer) (arrivalProcessingTimeChanged_ timer)++-- | Return a signal raised when the the processing time statistics changes.+arrivalProcessingTimeChanged_ :: ArrivalTimer -> Signal ()+arrivalProcessingTimeChanged_ timer =+  publishSignal (arrivalProcessingTimeChangedSource timer)+ -- | Return a processor that actually measures how much time has passed from -- the time of arriving the events. arrivalTimerProcessor :: ArrivalTimer -> Processor (Arrival a) (Arrival a)@@ -57,4 +73,5 @@            do t <- liftDynamics time               modifyRef (arrivalProcessingTimeRef timer) $                 addSamplingStats (t - arrivalTime a)+              triggerSignal (arrivalProcessingTimeChangedSource timer) ()          return (a, Cons $ loop xs)

@@ -7,7 +7,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- It represents a circuit synchronized with the event queue. -- Also it allows creating the recursive links with help of@@ -65,60 +65,60 @@ -- the proc-notation. -- newtype Circuit a b =-  Circuit { runCircuit :: a -> Event (Circuit a b, b)+  Circuit { runCircuit :: a -> Event (b, Circuit a b)             -- ^ Run the circuit.           }  instance C.Category Circuit where -  id = Circuit $ \a -> return (C.id, a)+  id = Circuit $ \a -> return (a, C.id)    (.) = dot     where        (Circuit g) `dot` (Circuit f) =         Circuit $ \a ->         Event $ \p ->-        do (cir1, b) <- invokeEvent p (f a)-           (cir2, c) <- invokeEvent p (g b)-           return (cir2 `dot` cir1, c)+        do (b, cir1) <- invokeEvent p (f a)+           (c, cir2) <- invokeEvent p (g b)+           return (c, cir2 `dot` cir1)  instance Arrow Circuit where -  arr f = Circuit $ \a -> return (arr f, f a)+  arr f = Circuit $ \a -> return (f a, arr f)    first (Circuit f) =     Circuit $ \(b, d) ->     Event $ \p ->-    do (cir, c) <- invokeEvent p (f b)-       return (first cir, (c, d))+    do (c, cir) <- invokeEvent p (f b)+       return ((c, d), first cir)    second (Circuit f) =     Circuit $ \(d, b) ->     Event $ \p ->-    do (cir, c) <- invokeEvent p (f b)-       return (second cir, (d, c))+    do (c, cir) <- invokeEvent p (f b)+       return ((d, c), second cir)    (Circuit f) *** (Circuit g) =     Circuit $ \(b, b') ->     Event $ \p ->-    do (cir1, c) <- invokeEvent p (f b)-       (cir2, c') <- invokeEvent p (g b')-       return (cir1 *** cir2, (c, c'))+    do (c, cir1) <- invokeEvent p (f b)+       (c', cir2) <- invokeEvent p (g b')+       return ((c, c'), cir1 *** cir2)           (Circuit f) &&& (Circuit g) =     Circuit $ \b ->     Event $ \p ->-    do (cir1, c) <- invokeEvent p (f b)-       (cir2, c') <- invokeEvent p (g b)-       return (cir1 &&& cir2, (c, c'))+    do (c, cir1) <- invokeEvent p (f b)+       (c', cir2) <- invokeEvent p (g b)+       return ((c, c'), cir1 &&& cir2)  instance ArrowLoop Circuit where    loop (Circuit f) =     Circuit $ \b ->     Event $ \p ->-    do rec (cir, (c, d)) <- invokeEvent p (f (b, d))-       return (loop cir, c)+    do rec ((c, d), cir) <- invokeEvent p (f (b, d))+       return (c, loop cir)  instance ArrowChoice Circuit where @@ -127,42 +127,42 @@     Event $ \p ->     case ebd of       Left b ->-        do (cir, c) <- invokeEvent p (f b)-           return (left cir, Left c)+        do (c, cir) <- invokeEvent p (f b)+           return (Left c, left cir)       Right d ->-        return (left x, Right d)+        return (Right d, left x)    right x@(Circuit f) =     Circuit $ \edb ->     Event $ \p ->     case edb of       Right b ->-        do (cir, c) <- invokeEvent p (f b)-           return (right cir, Right c)+        do (c, cir) <- invokeEvent p (f b)+           return (Right c, right cir)       Left d ->-        return (right x, Left d)+        return (Left d, right x)    x@(Circuit f) +++ y@(Circuit g) =     Circuit $ \ebb' ->     Event $ \p ->     case ebb' of       Left b ->-        do (cir1, c) <- invokeEvent p (f b)-           return (cir1 +++ y, Left c)+        do (c, cir1) <- invokeEvent p (f b)+           return (Left c, cir1 +++ y)       Right b' ->-        do (cir2, c') <- invokeEvent p (g b')-           return (x +++ cir2, Right c')+        do (c', cir2) <- invokeEvent p (g b')+           return (Right c', x +++ cir2)    x@(Circuit f) ||| y@(Circuit g) =     Circuit $ \ebc ->     Event $ \p ->     case ebc of       Left b ->-        do (cir1, d) <- invokeEvent p (f b)-           return (cir1 ||| y, d)+        do (d, cir1) <- invokeEvent p (f b)+           return (d, cir1 ||| y)       Right b' ->-        do (cir2, d) <- invokeEvent p (g b')-           return (x ||| cir2, d)+        do (d, cir2) <- invokeEvent p (g b')+           return (d, x ||| cir2)  -- | Get a signal transform by the specified circuit. circuitSignaling :: Circuit a b -> Signal a -> Signal b@@ -174,7 +174,7 @@                  handleSignal sa $ \a ->                  Event $ \p ->                  do cir <- readIORef r-                    (Circuit cir', b) <- invokeEvent p (cir a)+                    (b, Circuit cir') <- invokeEvent p (cir a)                     writeIORef r cir'                     invokeEvent p (f b) } @@ -183,18 +183,19 @@ circuitProcessor (Circuit cir) = Processor $ \sa ->   Cons $   do (a, xs) <- runStream sa-     (cir', b) <- liftEvent (cir a)+     (b, cir') <- liftEvent (cir a)      let f = runProcessor (circuitProcessor cir')      return (b, f xs) --- | Lift the 'Event' function to a curcuit.+-- | Create a simple circuit by the specified handling function+-- that runs the computation for each input value to get an output. arrCircuit :: (a -> Event b) -> Circuit a b arrCircuit f =   let x =         Circuit $ \a ->         Event $ \p ->         do b <- invokeEvent p (f a)-           return (x, b)+           return (b, x)   in x  -- | Accumulator that outputs a value determined by the supplied function.@@ -203,7 +204,7 @@   Circuit $ \a ->   Event $ \p ->   do (acc', b) <- invokeEvent p (f acc a)-     return (accumCircuit f acc', b) +     return (b, accumCircuit f acc')   -- | A circuit that adds the information about the time points at which  -- the values were received.@@ -217,23 +218,23 @@                           arrivalTime  = t,                           arrivalDelay =                              case t0 of-                              Nothing -> 0-                              Just t0 -> t - t0 }-        in return (loop $ Just t, b)+                              Nothing -> Nothing+                              Just t0 -> Just (t - t0) }+        in return (b, loop $ Just t)   in loop Nothing  -- | Delay the input by one step using the specified initial value. delayCircuit :: a -> Circuit a a delayCircuit a0 =   Circuit $ \a ->-  return (delayCircuit a, a0)+  return (a0, delayCircuit a)  -- | A circuit that returns the current modeling time. timeCircuit :: Circuit a Double timeCircuit =   Circuit $ \a ->   Event $ \p ->-  return (timeCircuit, pointTime p)+  return (pointTime p, timeCircuit)  -- | Like '>>>' but processes only the represented events. (>?>) :: Circuit a (Maybe b)@@ -245,13 +246,13 @@ whether >?> process =   Circuit $ \a ->   Event $ \p ->-  do (whether', b) <- invokeEvent p (runCircuit whether a)+  do (b, whether') <- invokeEvent p (runCircuit whether a)      case b of        Nothing ->-         return (whether' >?> process, Nothing)+         return (Nothing, whether' >?> process)        Just b  ->-         do (process', c) <- invokeEvent p (runCircuit process b)-            return (whether' >?> process', Just c)+         do (c, process') <- invokeEvent p (runCircuit process b)+            return (Just c, whether' >?> process')  -- | Like '<<<' but processes only the represented events. (<?<) :: Circuit b c@@ -275,14 +276,14 @@   Event $ \p ->   do x <- invokeEvent p (pred a)      if x-       then do (cir', b) <- invokeEvent p (runCircuit cir a)-               return (filterCircuitM pred cir', Just b)-       else return (filterCircuitM pred cir, Nothing)+       then do (b, cir') <- invokeEvent p (runCircuit cir a)+               return (Just b, filterCircuitM pred cir')+       else return (Nothing, filterCircuitM pred cir)  -- | The source of events that never occur. neverCircuit :: Circuit a (Maybe b) neverCircuit =-  Circuit $ \a -> return (neverCircuit, Nothing)+  Circuit $ \a -> return (Nothing, neverCircuit)  -- | An approximation of the integral using Euler's method. --@@ -314,14 +315,14 @@       Circuit $ \a ->       Event $ \p ->       do let t = pointTime p-         return (next t init a, init)+         return (init, next t init a)     next t0 v0 a0 =       Circuit $ \a ->       Event $ \p ->       do let t  = pointTime p              dt = t - t0              v  = v0 + a0 * dt-         v `seq` return (next t v a, v)+         v `seq` return (v, next t v a)  -- | A sum of differences starting from the specified initial value. --@@ -345,12 +346,12 @@     start =        Circuit $ \a ->       Event $ \p ->-      return (next init a, init)+      return (init, next init a)     next v0 a0 =       Circuit $ \a ->       Event $ \p ->       do let v = v0 + a0-         v `seq` return (next v a, v)+         v `seq` return (v, next v a)  -- | Approximate the circuit as a transform of time varying function, -- calculating the values in the integration time points and then@@ -371,7 +372,7 @@       Dynamics $ \p ->       do a <- invokeDynamics p m          cir <- readIORef ref-         (cir', b) <-+         (b, cir') <-            invokeDynamics p $            runEvent (runCircuit cir a)          writeIORef ref cir'

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- The 'Cont' monad is a variation of the standard Cont monad  -- and F# async workflow, where the result of applying 

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- An imperative double-linked list. --

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- The module defines the 'Dynamics' monad representing a time varying polymorphic function.  --

@@ -21,6 +21,7 @@  module Simulation.Aivika.Dynamics.Random        (memoRandomUniformDynamics,+        memoRandomUniformIntDynamics,         memoRandomNormalDynamics,         memoRandomExponentialDynamics,         memoRandomErlangDynamics,@@ -50,6 +51,19 @@      min' <- invokeDynamics p min      max' <- invokeDynamics p max      generatorUniform g min' max'++-- | Computation that generates random integer numbers distributed uniformly and+-- memoizes them in the integration time points.+memoRandomUniformIntDynamics :: Dynamics Int     -- ^ minimum+                                -> Dynamics Int  -- ^ maximum+                                -> Simulation (Dynamics Int)+memoRandomUniformIntDynamics min max =+  memo0Dynamics $+  Dynamics $ \p ->+  do let g = runGenerator $ pointRun p+     min' <- invokeDynamics p min+     max' <- invokeDynamics p max+     generatorUniformInt g min' max'  -- | Computation that generates random numbers distributed normally and -- memoizes them in the integration time points.

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- 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.@@ -37,6 +37,8 @@         throwEvent,         -- * Memoization         memoEvent,-        memoEventInTime) where+        memoEventInTime,+        -- * Disposable+        DisposableEvent(..)) where  import Simulation.Aivika.Internal.Event

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- Below is defined a type class of the random number generator. --@@ -23,6 +23,9 @@   Generator { generatorUniform :: Double -> Double -> IO Double,               -- ^ Generate an uniform random number               -- with the specified minimum and maximum.+              generatorUniformInt :: Int -> Int -> IO Int,+              -- ^ Generate an uniform integer random number+              -- with the specified minimum and maximum.               generatorNormal :: Double -> Double -> IO Double,               -- ^ Generate the normal random number               -- with the specified mean and deviation.@@ -52,6 +55,20 @@   do x <- g      return $ min + x * (max - min) +-- | Generate the uniform random number with the specified minimum and maximum.+generateUniformInt :: IO Double+                      -- ^ the generator+                      -> Int+                      -- ^ minimum+                      -> Int+                      -- ^ maximum+                      -> IO Int+generateUniformInt g min max =+  do x <- g+     let min' = fromIntegral min+         max' = fromIntegral max+     return $ round (min' + x * (max' - min'))+ -- | Create a normal random number generator with mean 0 and variance 1 -- by the specified generator of uniform random numbers from 0 to 1. newNormalGenerator :: IO Double@@ -159,6 +176,9 @@                      -- ^ The simple random number generator with the specified seed.                    | CustomGenerator (IO Generator)                      -- ^ The custom random number generator.+                   | CustomGenerator01 (IO Double)+                     -- ^ The custom random number generator by the specified uniform+                     -- generator of numbers from 0 to 1.  -- | Create a new random number generator by the specified type. newGenerator :: GeneratorType -> IO Generator@@ -170,6 +190,8 @@       newRandomGenerator $ mkStdGen x     CustomGenerator g ->       g+    CustomGenerator01 g ->+      newRandomGenerator01 g  -- | Create a new random generator by the specified standard generator. newRandomGenerator :: RandomGen g => g -> IO Generator@@ -179,11 +201,18 @@                  let (x, g') = random g                  writeIORef r g'                  return x+     newRandomGenerator01 g1++-- | Create a new random generator by the specified uniform generator of numbers from 0 to 1.+newRandomGenerator01 :: IO Double -> IO Generator+newRandomGenerator01 g =+  do let g1 = g      g2 <- newNormalGenerator g1      let g3 mu nu =            do x <- g2               return $ mu + nu * x      return Generator { generatorUniform = generateUniform g1,+                        generatorUniformInt = generateUniformInt g1,                         generatorNormal = g3,                         generatorExponential = generateExponential g1,                         generatorErlang = generateErlang g1,

@@ -33,7 +33,7 @@             -- ^ the data we received with the event             arrivalTime :: Double,             -- ^ the simulation time at which the event has arrived-            arrivalDelay :: Double+            arrivalDelay :: Maybe Double             -- ^ the delay time which has passed from the time of             -- arriving the previous event           } deriving (Eq, Ord, Show)

@@ -47,6 +47,7 @@  import Control.Monad import Control.Monad.Trans+import Control.Applicative  import Simulation.Aivika.Internal.Specs import Simulation.Aivika.Internal.Parameter@@ -105,7 +106,7 @@   writeIORef (contCancellationActivatedRef x) False  -- | If the main computation is cancelled then all the nested ones will be cancelled too.-contCancellationBind :: ContCancellationSource -> [ContCancellationSource] -> Event (Event ())+contCancellationBind :: ContCancellationSource -> [ContCancellationSource] -> Event DisposableEvent contCancellationBind x ys =   Event $ \p ->   do hs1 <- forM ys $ \y ->@@ -116,8 +117,7 @@        invokeEvent p $        handleSignal (contCancellationInitiating y) $ \_ ->        contCancellationInitiate x-     return $ do sequence_ hs1-                 sequence_ hs2+     return $ mconcat hs1 <> mconcat hs2  -- | Connect the parent computation to the child one. contCancellationConnect :: ContCancellationSource@@ -126,7 +126,7 @@                            -- ^ how to connect                            -> ContCancellationSource                            -- ^ the child-                           -> Event (Event ())+                           -> Event DisposableEvent                            -- ^ computation of the disposable handler contCancellationConnect parent cancellation child =   Event $ \p ->@@ -140,15 +140,15 @@        case cancellation of          CancelTogether -> invokeEvent p m1          CancelChildAfterParent -> invokeEvent p m1-         CancelParentAfterChild -> return $ return ()-         CancelInIsolation -> return $ return ()+         CancelParentAfterChild -> return mempty+         CancelInIsolation -> return mempty      h2 <-        case cancellation of          CancelTogether -> invokeEvent p m2-         CancelChildAfterParent -> return $ return ()+         CancelChildAfterParent -> return mempty          CancelParentAfterChild -> invokeEvent p m2-         CancelInIsolation -> return $ return ()-     return $ h1 >> h2+         CancelInIsolation -> return mempty+     return $ h1 <> h2  -- | Initiate the cancellation. contCancellationInitiate :: ContCancellationSource -> Event ()@@ -197,13 +197,19 @@ instance Functor Cont where   fmap = liftM +instance Applicative Cont where+  pure = return+  (<*>) = ap+ instance MonadIO Cont where   liftIO = liftIOC  +-- | Invoke the computation. invokeCont :: ContParams a -> Cont a -> Event () {-# INLINE invokeCont #-} invokeCont p (Cont m) = m p +-- | Cancel the computation. cancelCont :: Point -> ContParams a -> IO () {-# NOINLINE cancelCont #-} cancelCont p c =@@ -490,7 +496,7 @@                     Event $ \p ->                     do n' <- readIORef counter                        when (n' == n) $-                         do invokeEvent p hs  -- unbind the cancellation sources+                         do invokeEvent p $ disposeEvent hs  -- unbind the cancellation sources                             f1 <- contCanceled c                             f2 <- readIORef catchRef                             case (f1, f2) of@@ -551,7 +557,7 @@                     Event $ \p ->                     do n' <- readIORef counter                        when (n' == n) $-                         do invokeEvent p hs  -- unbind the cancellation sources+                         do invokeEvent p $ disposeEvent hs  -- unbind the cancellation sources                             f1 <- contCanceled c                             f2 <- readIORef catchRef                             case (f1, f2) of@@ -599,15 +605,15 @@                     contCancellationBind (contCancelSource $ contAux c) [cancelSource]               let cont a  =                     Event $ \p ->-                    do invokeEvent p hs  -- unbind the cancellation source+                    do invokeEvent p $ disposeEvent hs  -- unbind the cancellation source                        invokeEvent p $ resumeCont c a                   econt e =                     Event $ \p ->-                    do invokeEvent p hs  -- unbind the cancellation source+                    do invokeEvent p $ disposeEvent hs  -- unbind the cancellation source                        invokeEvent p $ resumeECont c e                   ccont e =                     Event $ \p ->-                    do invokeEvent p hs  -- unbind the cancellation source+                    do invokeEvent p $ disposeEvent hs  -- unbind the cancellation source                        cancelCont p c               invokeEvent p $                 runCont x cont econt ccont cancelSource (contCatchFlag $ contAux c)@@ -627,15 +633,15 @@                     (contCancelSource $ contAux c) cancellation cancelSource               let cont a  =                     Event $ \p ->-                    do invokeEvent p hs  -- unbind the cancellation source+                    do invokeEvent p $ disposeEvent hs  -- unbind the cancellation source                        -- do nothing and it will finish the computation                   econt e =                     Event $ \p ->-                    do invokeEvent p hs  -- unbind the cancellation source+                    do invokeEvent p $ disposeEvent hs  -- unbind the cancellation source                        invokeEvent p $ throwEvent e  -- this is all we can do                   ccont e =                     Event $ \p ->-                    do invokeEvent p hs  -- unbind the cancellation source+                    do invokeEvent p $ disposeEvent hs  -- unbind the cancellation source                        -- do nothing and it will finish the computation               invokeEvent p $                 enqueueEvent (pointTime p) $@@ -663,7 +669,7 @@                Nothing ->                  error "The handler was lost: contFreeze."                Just h ->-                 do invokeEvent p h+                 do invokeEvent p $ disposeEvent h                     c <- readIORef rc                     case c of                       Nothing -> return ()@@ -677,7 +683,7 @@      writeIORef rh (Just h)      return $        Event $ \p ->-       do invokeEvent p h+       do invokeEvent p $ disposeEvent h           c <- readIORef rc           writeIORef rc Nothing           return c@@ -695,9 +701,9 @@                 \p -> do x <- readIORef r                          case x of                            Nothing ->-                             error "The signal was lost: awaitSignal."+                             error "The signal was lost: contAwait."                            Just x ->-                             do invokeEvent p x+                             do invokeEvent p $ disposeEvent x                                 c <- invokeEvent p c                                 case c of                                   Nothing -> return ()

@@ -37,6 +37,7 @@ import Control.Monad import Control.Monad.Trans import Control.Monad.Fix+import Control.Applicative  import Simulation.Aivika.Internal.Specs import Simulation.Aivika.Internal.Parameter@@ -88,6 +89,10 @@  instance Functor Dynamics where   fmap = liftMD++instance Applicative Dynamics where+  pure = return+  (<*>) = ap  instance Eq (Dynamics a) where   x == y = error "Can't compare dynamics." 

@@ -41,9 +41,12 @@         throwEvent,         -- * Memoization         memoEvent,-        memoEventInTime) where+        memoEventInTime,+        -- * Disposable+        DisposableEvent(..)) where  import Data.IORef+import Data.Monoid  import qualified Control.Exception as C import Control.Exception (IOException, throw, finally)@@ -51,6 +54,7 @@ import Control.Monad import Control.Monad.Trans import Control.Monad.Fix+import Control.Applicative  import qualified Simulation.Aivika.PriorityQueue as PQ @@ -82,6 +86,10 @@ instance Functor Event where   fmap = liftME +instance Applicative Event where+  pure = return+  (<*>) = ap+ liftME :: (a -> b) -> Event a -> Event b {-# INLINE liftME #-} liftME f (Event x) =@@ -390,3 +398,14 @@   Event $ \p ->   invokeEvent p $   enqueueEvent (pointTime p) m++-- | Defines a computation disposing some entity.+newtype DisposableEvent =+  DisposableEvent { disposeEvent :: Event ()+                    -- ^ Dispose something within the 'Event' computation.+                  }++instance Monoid DisposableEvent where++  mempty = DisposableEvent $ return ()+  mappend (DisposableEvent x) (DisposableEvent y) = DisposableEvent $ x >> y

@@ -46,6 +46,7 @@ import Control.Monad import Control.Monad.Trans import Control.Monad.Fix+import Control.Applicative  import Data.IORef import qualified Data.IntMap as M@@ -118,6 +119,10 @@  instance Functor Parameter where   fmap = liftMP++instance Applicative Parameter where+  pure = return+  (<*>) = ap  instance Eq (Parameter a) where   x == y = error "Can't compare parameters." 

@@ -79,9 +79,11 @@  import Data.Maybe import Data.IORef+ import Control.Exception (IOException, throw) import Control.Monad import Control.Monad.Trans+import Control.Applicative  import Simulation.Aivika.Internal.Specs import Simulation.Aivika.Internal.Parameter@@ -323,6 +325,10 @@ instance Functor Process where   fmap = liftM +instance Applicative Process where+  pure = return+  (<*>) = ap+ instance ParameterLift Process where   liftParameter = liftPP @@ -394,7 +400,7 @@ -- | Execute the specified computations in parallel within -- the current computation and return their results. The cancellation -- of any of the nested computations affects the current computation.--- The exception raised in any of the nested computations is propogated+-- The exception raised in any of the nested computations is propagated -- to the current computation as well. -- -- Here word @parallel@ literally means that the computations are

@@ -80,11 +80,11 @@    -- | The signal that can have disposable handlers.   data Signal a =-  Signal { handleSignal :: (a -> Event ()) -> Event (Event ())+  Signal { handleSignal :: (a -> Event ()) -> Event DisposableEvent            -- ^ Subscribe the handler to the specified -           -- signal and return a nested computation -           -- that, being applied, unsubscribes the -           -- handler from this signal.+           -- signal and return a nested computation+           -- within a disposable object that, being applied,+           -- unsubscribes the handler from this signal.          }    -- | The queue of signal handlers.@@ -99,7 +99,7 @@ instance Eq (SignalHandler a) where   x == y = (handlerRef x) == (handlerRef y) --- | Subscribe the handler to the specified signal.+-- | 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 = @@ -119,6 +119,7 @@            Event $ \p ->            do x <- enqueueSignalHandler queue h               return $+                DisposableEvent $                 Event $ \p -> dequeueSignalHandler queue x          trigger a =            Event $ \p -> triggerSignalHandlers queue a p@@ -195,7 +196,7 @@   Signal { handleSignal = \h ->             do x1 <- handleSignal m1 h                x2 <- handleSignal m2 h-               return $ do { x1; x2 } }+               return $ x1 <> x2 }  -- | Merge three signals. merge3Signals :: Signal a -> Signal a -> Signal a -> Signal a@@ -204,7 +205,7 @@             do x1 <- handleSignal m1 h                x2 <- handleSignal m2 h                x3 <- handleSignal m3 h-               return $ do { x1; x2; x3 } }+               return $ x1 <> x2 <> x3 }  -- | Merge four signals. merge4Signals :: Signal a -> Signal a -> Signal a -> @@ -215,7 +216,7 @@                x2 <- handleSignal m2 h                x3 <- handleSignal m3 h                x4 <- handleSignal m4 h-               return $ do { x1; x2; x3; x4 } }+               return $ x1 <> x2 <> x3 <> x4 }             -- | Merge five signals. merge5Signals :: Signal a -> Signal a -> Signal a -> @@ -227,7 +228,7 @@                x3 <- handleSignal m3 h                x4 <- handleSignal m4 h                x5 <- handleSignal m5 h-               return $ do { x1; x2; x3; x4; x5 } }+               return $ x1 <> x2 <> x3 <> x4 <> x5 }  -- | Compose the signal. mapSignalM :: (a -> Event b) -> Signal a -> Signal b@@ -244,7 +245,7 @@ -- | An empty signal which is never triggered. emptySignal :: Signal a emptySignal =-  Signal { handleSignal = \h -> return $ return () }+  Signal { handleSignal = \h -> return mempty }                                      -- | Represents the history of the signal values. data SignalHistory a =@@ -362,15 +363,18 @@ arrivalSignal m =    Signal { handleSignal = \h ->              Event $ \p ->-             do r <- newIORef (pointTime p)+             do r <- newIORef Nothing                 invokeEvent p $                   handleSignal m $ \a ->                   Event $ \p ->                   do t0 <- readIORef r                      let t = pointTime p-                     writeIORef r t+                     writeIORef r (Just t)                      invokeEvent p $                        h Arrival { arrivalValue = a,                                    arrivalTime  = t,-                                   arrivalDelay = t - t0 } +                                   arrivalDelay =+                                     case t0 of+                                       Nothing -> Nothing+                                       Just t0 -> Just (t - t0) }          }

@@ -34,6 +34,7 @@ import Control.Monad import Control.Monad.Trans import Control.Monad.Fix+import Control.Applicative  import Data.IORef @@ -90,6 +91,10 @@  instance Functor Simulation where   fmap = liftMS++instance Applicative Simulation where+  pure = return+  (<*>) = ap  liftMS :: (a -> b) -> Simulation a -> Simulation b {-# INLINE liftMS #-}

@@ -0,0 +1,242 @@++-- |+-- Module     : Simulation.Aivika.Net+-- 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+--+-- The module defines a 'Net' arrow that can be applied to modeling the queue networks+-- like the 'Processor' arrow from another module. Only the former has a more efficient+-- implementation of the 'Arrow' interface than the latter, although at the cost of+-- some decreasing in generality.+--+-- While the @Processor@ type is just a function that transforms the input 'Stream' into another,+-- the @Net@ type is actually an automaton that has an implementation very similar to that one+-- which the 'Circuit' type has, only the computations occur in the 'Process' monad. But unlike+-- the @Circuit@ type, the @Net@ type doesn't allow declaring recursive definitions, being based on+-- continuations.+--+-- In a nutshell, the @Net@ type is an interchangeable alternative to the @Processor@ type+-- with its weaknesses and strengths. The @Net@ arrow is useful for constructing computations+-- with help of the proc-notation to be transformed then to the @Processor@ computations that+-- are more general in nature and more easy-to-use but which computations created with help of+-- the proc-notation are not so efficient.+--+module Simulation.Aivika.Net+       (-- * Net Arrow+        Net(..),+        -- * Net Primitives+        emptyNet,+        arrNet,+        accumNet,+        -- * Specifying Identifier+        netUsingId,+        -- * Arrival Net+        arrivalNet,+        -- * Delaying Net+        delayNet,+        -- * Interchanging Nets with Processors+        netProcessor,+        processorNet) where++import qualified Control.Category as C+import Control.Arrow+import Control.Monad.Trans++import Data.IORef++import Simulation.Aivika.Simulation+import Simulation.Aivika.Dynamics+import Simulation.Aivika.Event+import Simulation.Aivika.Cont+import Simulation.Aivika.Process+import Simulation.Aivika.Stream+import Simulation.Aivika.QueueStrategy+import Simulation.Aivika.Resource+import Simulation.Aivika.Processor+import Simulation.Aivika.Ref+import Simulation.Aivika.Circuit+import Simulation.Aivika.Internal.Arrival++-- | Represents the net as an automaton working within the 'Process' computation.+newtype Net a b =+  Net { runNet :: a -> Process (b, Net a b)+        -- ^ Run the net.+      }++instance C.Category Net where++  id = Net $ \a -> return (a, C.id)++  (.) = dot+    where +      (Net g) `dot` (Net f) =+        Net $ \a ->+        do (b, p1) <- f a+           (c, p2) <- g b+           return (c, p2 `dot` p1)++instance Arrow Net where++  arr f = Net $ \a -> return (f a, arr f)++  first (Net f) =+    Net $ \(b, d) ->+    do (c, p) <- f b+       return ((c, d), first p)++  second (Net f) =+    Net $ \(d, b) ->+    do (c, p) <- f b+       return ((d, c), second p)++  (Net f) *** (Net g) =+    Net $ \(b, b') ->+    do (c, p1) <- f b+       (c', p2) <- g b'+       return ((c, c'), p1 *** p2)+       +  (Net f) &&& (Net g) =+    Net $ \b ->+    do (c, p1) <- f b+       (c', p2) <- g b+       return ((c, c'), p1 &&& p2)++instance ArrowChoice Net where++  left x@(Net f) =+    Net $ \ebd ->+    case ebd of+      Left b ->+        do (c, p) <- f b+           return (Left c, left p)+      Right d ->+        return (Right d, left x)++  right x@(Net f) =+    Net $ \edb ->+    case edb of+      Right b ->+        do (c, p) <- f b+           return (Right c, right p)+      Left d ->+        return (Left d, right x)++  x@(Net f) +++ y@(Net g) =+    Net $ \ebb' ->+    case ebb' of+      Left b ->+        do (c, p1) <- f b+           return (Left c, p1 +++ y)+      Right b' ->+        do (c', p2) <- g b'+           return (Right c', x +++ p2)++  x@(Net f) ||| y@(Net g) =+    Net $ \ebc ->+    case ebc of+      Left b ->+        do (d, p1) <- f b+           return (d, p1 ||| y)+      Right b' ->+        do (d, p2) <- g b'+           return (d, x ||| p2)++-- | A net that never finishes its work.+emptyNet :: Net a b+emptyNet = Net $ const neverProcess++-- | Create a simple net by the specified handling function+-- that runs the discontinuous process for each input value to get an output.+arrNet :: (a -> Process b) -> Net a b+arrNet f =+  let x =+        Net $ \a ->+        do b <- f a+           return (b, x)+  in x++-- | Accumulator that outputs a value determined by the supplied function.+accumNet :: (acc -> a -> Process (acc, b)) -> acc -> Net a b+accumNet f acc =+  Net $ \a ->+  do (acc', b) <- f acc a+     return (b, accumNet f acc') ++-- | Create a net that will use the specified process identifier.+-- It can be useful to refer to the underlying 'Process' computation which+-- can be passivated, interrupted, canceled and so on. See also the+-- 'processUsingId' function for more details.+netUsingId :: ProcessId -> Net a b -> Net a b+netUsingId pid (Net f) =+  Net $ processUsingId pid . f++-- | Transform the net to an equivalent processor (a rather cheap transformation).+netProcessor :: Net a b -> Processor a b+netProcessor = Processor . loop+  where loop x as =+          Cons $+          do (a, as') <- runStream as+             (b, x') <- runNet x a+             return (b, loop x' as')++-- | Transform the processor to a similar net (a more costly transformation).+processorNet :: Processor a b -> Net a b+processorNet x =+  Net $ \a ->+  do readingA <- liftSimulation $ newResourceWithMaxCount FCFS 0 (Just 1)+     writingA <- liftSimulation $ newResourceWithMaxCount FCFS 1 (Just 1)+     readingB <- liftSimulation $ newResourceWithMaxCount FCFS 0 (Just 1)+     writingB <- liftSimulation $ newResourceWithMaxCount FCFS 1 (Just 1)+     conting  <- liftSimulation $ newResourceWithMaxCount FCFS 0 (Just 1)+     refA <- liftIO $ newIORef Nothing+     refB <- liftIO $ newIORef Nothing+     let input =+           do requestResource readingA+              Just a <- liftIO $ readIORef refA+              liftIO $ writeIORef refA Nothing+              releaseResource writingA+              return (a, Cons input)+         consume bs =+           do (b, bs') <- runStream bs+              requestResource writingB+              liftIO $ writeIORef refB (Just b)+              releaseResource readingB+              requestResource conting+              consume bs'+         loop a =+           do requestResource writingA+              liftIO $ writeIORef refA (Just a)+              releaseResource readingA+              requestResource readingB+              Just b <- liftIO $ readIORef refB+              liftIO $ writeIORef refB Nothing+              releaseResource writingB+              return (b, Net $ \a -> releaseResource conting >> loop a)+     spawnProcess CancelTogether $+       consume $ runProcessor x (Cons input)+     loop a++-- | A net that adds the information about the time points at which +-- the values were received.+arrivalNet :: Net a (Arrival a)+arrivalNet =+  let loop t0 =+        Net $ \a ->+        do t <- liftDynamics time+           let b = Arrival { arrivalValue = a,+                             arrivalTime  = t,+                             arrivalDelay = +                               case t0 of+                                 Nothing -> Nothing+                                 Just t0 -> Just (t - t0) }+           return (b, loop $ Just t)+  in loop Nothing++-- | Delay the input by one step using the specified initial value.+delayNet :: a -> Net a a+delayNet a0 =+  Net $ \a ->+  return (a0, delayNet a)

@@ -4,7 +4,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- The module defines the 'Parameter' monad that allows representing the model -- parameters. For example, they can be used when running the Monte-Carlo simulation.

@@ -21,6 +21,7 @@  module Simulation.Aivika.Parameter.Random        (randomUniform,+        randomUniformInt,         randomNormal,         randomExponential,         randomErlang,@@ -47,6 +48,15 @@   Parameter $ \r ->   let g = runGenerator r   in generatorUniform g min max++-- | Computation that generates a new random integer number distributed uniformly.+randomUniformInt :: Int     -- ^ minimum+                    -> Int  -- ^ maximum+                    -> Parameter Int+randomUniformInt min max =+  Parameter $ \r ->+  let g = runGenerator r+  in generatorUniformInt g min max  -- | Computation that generates a new random number distributed normally. randomNormal :: Double     -- ^ mean

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- An imperative heap-based priority queue. --

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- 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 

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- The processor of simulation data. --@@ -18,8 +18,9 @@         accumProcessor,         -- * Specifying Identifier         processorUsingId,-        -- * Prefetch Processor+        -- * Prefetch and Delay Processors         prefetchProcessor,+        delayProcessor,         -- * Buffer Processor         bufferProcessor,         bufferProcessorLoop,@@ -451,3 +452,7 @@ -- the original stream items were received by demand. arrivalProcessor :: Processor a (Arrival a) arrivalProcessor = Processor arrivalStream++-- | 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

@@ -41,7 +41,7 @@ roundRobbinProcessorUsingIds =   Processor $ \xs ->   Cons $-  do q <- liftSimulation newFCFSQueue+  do q <- liftEvent newFCFSQueue      let process =            do t@(x, p) <- dequeue q               (timeout, pid) <- x

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- This module defines a queue that can use the specified strategies. So, having only -- the 'FCFS', 'LCFS', 'SIRO' and 'StaticPriorities' strategies, you can build@@ -33,6 +33,7 @@         queueFull,         queueMaxCount,         queueCount,+        queueCountStats,         enqueueCount,         enqueueLostCount,         enqueueStoreCount,@@ -47,6 +48,7 @@         queueTotalWaitTime,         enqueueWaitTime,         dequeueWaitTime,+        queueRate,         -- * Dequeuing and Enqueuing         dequeue,         dequeueWithOutputPriority,@@ -92,6 +94,8 @@         enqueueWaitTimeChanged_,         dequeueWaitTimeChanged,         dequeueWaitTimeChanged_,+        queueRateChanged,+        queueRateChanged_,         -- * Basic Signals         enqueueInitiated,         enqueueStored,@@ -159,6 +163,7 @@           queueStore :: qm (QueueItem a),           dequeueRes :: Resource so qo,           queueCountRef :: IORef Int,+          queueCountStatsRef :: IORef (TimingStats Int),           enqueueCountRef :: IORef Int,           enqueueLostCountRef :: IORef Int,           enqueueStoreCountRef :: IORef Int,@@ -187,19 +192,19 @@             }    -- | Create a new FCFS queue with the specified capacity.  -newFCFSQueue :: Int -> Simulation (FCFSQueue a)  +newFCFSQueue :: Int -> Event (FCFSQueue a)   newFCFSQueue = newQueue FCFS FCFS FCFS    -- | Create a new LCFS queue with the specified capacity.  -newLCFSQueue :: Int -> Simulation (LCFSQueue a)  +newLCFSQueue :: Int -> Event (LCFSQueue a)   newLCFSQueue = newQueue FCFS LCFS FCFS    -- | Create a new SIRO queue with the specified capacity.  -newSIROQueue :: Int -> Simulation (SIROQueue a)  +newSIROQueue :: Int -> Event (SIROQueue a)   newSIROQueue = newQueue FCFS SIRO FCFS    -- | Create a new priority queue with the specified capacity.  -newPriorityQueue :: Int -> Simulation (PriorityQueue a)  +newPriorityQueue :: Int -> Event (PriorityQueue a)   newPriorityQueue = newQueue FCFS StaticPriorities FCFS    -- | Create a new queue with the specified strategies and capacity.  @@ -214,26 +219,28 @@             -- ^ the strategy applied to the dequeueing (output) processes when the queue is empty             -> Int             -- ^ the queue capacity-            -> Simulation (Queue si qi sm qm so qo a)  +            -> Event (Queue si qi sm qm so qo a)   newQueue si sm so count =-  do i  <- liftIO $ newIORef 0+  do t  <- liftDynamics time+     i  <- liftIO $ newIORef 0+     is <- liftIO $ newIORef $ returnTimingStats t 0      ci <- liftIO $ newIORef 0      cl <- liftIO $ newIORef 0      cm <- liftIO $ newIORef 0      cr <- liftIO $ newIORef 0      co <- liftIO $ newIORef 0-     ri <- newResourceWithMaxCount si count (Just count)-     qm <- newStrategyQueue sm-     ro <- newResourceWithMaxCount so 0 (Just count)+     ri <- liftSimulation $ newResourceWithMaxCount si count (Just count)+     qm <- liftSimulation $ newStrategyQueue sm+     ro <- liftSimulation $ newResourceWithMaxCount so 0 (Just count)      w  <- liftIO $ newIORef mempty      wt <- liftIO $ newIORef mempty      wi <- liftIO $ newIORef mempty      wo <- liftIO $ newIORef mempty -     s1 <- newSignalSource-     s2 <- newSignalSource-     s3 <- newSignalSource-     s4 <- newSignalSource-     s5 <- newSignalSource+     s1 <- liftSimulation $ newSignalSource+     s2 <- liftSimulation $ newSignalSource+     s3 <- liftSimulation $ newSignalSource+     s4 <- liftSimulation $ newSignalSource+     s5 <- liftSimulation $ newSignalSource      return Queue { queueMaxCount = count,                     enqueueStrategy = si,                     enqueueStoringStrategy = sm,@@ -242,6 +249,7 @@                     queueStore = qm,                     dequeueRes = ro,                     queueCountRef = i,+                    queueCountStatsRef = is,                     enqueueCountRef = ci,                     enqueueLostCountRef = cl,                     enqueueStoreCountRef = cm,@@ -293,12 +301,17 @@ queueFullChanged_ :: Queue si qi sm qm so qo a -> Signal () queueFullChanged_ = queueCountChanged_ --- | Return the queue size.+-- | Return the current queue size. ----- See also 'queueCountChanged' and 'queueCountChanged_'.+-- See also 'queueCountStats', 'queueCountChanged' and 'queueCountChanged_'. queueCount :: Queue si qi sm qm so qo a -> Event Int queueCount q =   Event $ \p -> readIORef (queueCountRef q)++-- | Return the queue size statistics.+queueCountStats :: Queue si qi sm qm so qo a -> Event (TimingStats Int)+queueCountStats q =+  Event $ \p -> readIORef (queueCountStatsRef q)    -- | Signal when the 'queueCount' property value has changed. queueCountChanged :: Queue si qi sm qm so qo a -> Signal Int@@ -533,7 +546,32 @@ dequeueWaitTimeChanged_ :: Queue si qi sm qm so qo a -> Signal () dequeueWaitTimeChanged_ q =   mapSignal (const ()) (dequeueExtracted q)-  ++-- | Return a long-term average queue rate calculated as+-- the average queue size divided by the average wait time.+--+-- This value may be less than the actual arrival rate as the queue is+-- finite and new arrivals may be locked while the queue remains full.+--+-- See also 'queueRateChanged' and 'queueRateChanged_'.+queueRate :: Queue si qi sm qm so qo a -> Event Double+queueRate q =+  Event $ \p ->+  do x <- readIORef (queueCountStatsRef q)+     y <- readIORef (queueWaitTimeRef q)+     return (timingStatsMean x / samplingStatsMean y) +      +-- | Signal when the 'queueRate' property value has changed.+queueRateChanged :: Queue si qi sm qm so qo a -> Signal Double+queueRateChanged q =+  mapSignalM (const $ queueRate q) (queueRateChanged_ q)+      +-- | Signal when the 'queueRate' property value has changed.+queueRateChanged_ :: Queue si qi sm qm so qo a -> Signal ()+queueRateChanged_ q =+  mapSignal (const ()) (enqueueStored q) <>+  mapSignal (const ()) (dequeueExtracted q)+ -- | Dequeue suspending the process if the queue is empty. dequeue :: (DequeueStrategy si qi,             DequeueStrategy sm qm,@@ -798,7 +836,11 @@   do let i' = i { itemStoringTime = pointTime p }  -- now we have the actual time of storing      invokeEvent p $        strategyEnqueue (enqueueStoringStrategy q) (queueStore q) i'-     modifyIORef' (queueCountRef q) (+ 1)+     c <- readIORef (queueCountRef q)+     let c' = c + 1+         t  = pointTime p +     c' `seq` writeIORef (queueCountRef q) c'+     modifyIORef' (queueCountStatsRef q) (addTimingStats t c')      modifyIORef' (enqueueStoreCountRef q) (+ 1)      invokeEvent p $        enqueueStat q i'@@ -822,7 +864,11 @@   do let i' = i { itemStoringTime = pointTime p }  -- now we have the actual time of storing      invokeEvent p $        strategyEnqueueWithPriority (enqueueStoringStrategy q) (queueStore q) pm i'-     modifyIORef' (queueCountRef q) (+ 1)+     c <- readIORef (queueCountRef q)+     let c' = c + 1+         t  = pointTime p+     c' `seq` writeIORef (queueCountRef q) c'+     modifyIORef' (queueCountStatsRef q) (addTimingStats t c')      modifyIORef' (enqueueStoreCountRef q) (+ 1)      invokeEvent p $        enqueueStat q i'@@ -882,7 +928,11 @@   Event $ \p ->   do i <- invokeEvent p $           strategyDequeue (enqueueStoringStrategy q) (queueStore q)-     modifyIORef' (queueCountRef q) (+ (- 1))+     c <- readIORef (queueCountRef q)+     let c' = c - 1+         t  = pointTime p+     c' `seq` writeIORef (queueCountRef q) c'+     modifyIORef' (queueCountStatsRef q) (addTimingStats t c')      modifyIORef' (dequeueExtractCountRef q) (+ 1)      invokeEvent p $        dequeueStat q t' i@@ -947,6 +997,7 @@      full <- queueFull q      let maxCount = queueMaxCount q      count <- queueCount q+     countStats <- queueCountStats q      enqueueCount <- enqueueCount q      enqueueLostCount <- enqueueLostCount q      enqueueStoreCount <- enqueueStoreCount q@@ -991,6 +1042,10 @@        showString "size = " .        shows count .        showString "\n" .+       showString tab .+       showString "the size statistics = \n\n" .+       timingStatsSummary countStats (2 + indent) .+       showString "\n\n" .        showString tab .        showString "the enqueue count (number of the input items that were enqueued) = " .        shows enqueueCount .

@@ -27,6 +27,7 @@         dequeueStrategy,         queueNull,         queueCount,+        queueCountStats,         enqueueStoreCount,         dequeueCount,         dequeueExtractCount,@@ -35,6 +36,7 @@         dequeueExtractRate,         queueWaitTime,         dequeueWaitTime,+        queueRate,         -- * Dequeuing and Enqueuing         dequeue,         dequeueWithOutputPriority,@@ -58,6 +60,8 @@         queueWaitTimeChanged_,         dequeueWaitTimeChanged,         dequeueWaitTimeChanged_,+        queueRateChanged,+        queueRateChanged_,         -- * Basic Signals         enqueueStored,         dequeueRequested,@@ -118,6 +122,7 @@           queueStore :: qm (QueueItem a),           dequeueRes :: Resource so qo,           queueCountRef :: IORef Int,+          queueCountStatsRef :: IORef (TimingStats Int),           enqueueStoreCountRef :: IORef Int,           dequeueCountRef :: IORef Int,           dequeueExtractCountRef :: IORef Int,@@ -136,19 +141,19 @@             }    -- | Create a new infinite FCFS queue.  -newFCFSQueue :: Simulation (FCFSQueue a)  +newFCFSQueue :: Event (FCFSQueue a)   newFCFSQueue = newQueue FCFS FCFS    -- | Create a new infinite LCFS queue.  -newLCFSQueue :: Simulation (LCFSQueue a)  +newLCFSQueue :: Event (LCFSQueue a)   newLCFSQueue = newQueue LCFS FCFS    -- | Create a new infinite SIRO queue.  -newSIROQueue :: Simulation (SIROQueue a)  +newSIROQueue :: Event (SIROQueue a)   newSIROQueue = newQueue SIRO FCFS    -- | Create a new infinite priority queue.  -newPriorityQueue :: Simulation (PriorityQueue a)  +newPriorityQueue :: Event (PriorityQueue a)   newPriorityQueue = newQueue StaticPriorities FCFS    -- | Create a new infinite queue with the specified strategies.  @@ -158,24 +163,27 @@             -- ^ the strategy applied when storing items in the queue             -> so             -- ^ the strategy applied to the dequeueing (output) processes when the queue is empty-            -> Simulation (Queue sm qm so qo a)  +            -> Event (Queue sm qm so qo a)   newQueue sm so =-  do i  <- liftIO $ newIORef 0+  do t  <- liftDynamics time+     i  <- liftIO $ newIORef 0+     is <- liftIO $ newIORef $ returnTimingStats t 0      cm <- liftIO $ newIORef 0      cr <- liftIO $ newIORef 0      co <- liftIO $ newIORef 0-     qm <- newStrategyQueue sm-     ro <- newResourceWithMaxCount so 0 Nothing+     qm <- liftSimulation $ newStrategyQueue sm+     ro <- liftSimulation $ newResourceWithMaxCount so 0 Nothing      w  <- liftIO $ newIORef mempty      wo <- liftIO $ newIORef mempty -     s3 <- newSignalSource-     s4 <- newSignalSource-     s5 <- newSignalSource+     s3 <- liftSimulation newSignalSource+     s4 <- liftSimulation newSignalSource+     s5 <- liftSimulation newSignalSource      return Queue { enqueueStoringStrategy = sm,                     dequeueStrategy = so,                     queueStore = qm,                     dequeueRes = ro,                     queueCountRef = i,+                    queueCountStatsRef = is,                     enqueueStoreCountRef = cm,                     dequeueCountRef = cr,                     dequeueExtractCountRef = co,@@ -203,12 +211,17 @@ queueNullChanged_ :: Queue sm qm so qo a -> Signal () queueNullChanged_ = queueCountChanged_ --- | Return the queue size.+-- | Return the current queue size. ----- See also 'queueCountChanged' and 'queueCountChanged_'.+-- See also 'queueCountStats', 'queueCountChanged' and 'queueCountChanged_'. queueCount :: Queue sm qm so qo a -> Event Int queueCount q =   Event $ \p -> readIORef (queueCountRef q)++-- | Return the queue size statistics.+queueCountStats :: Queue sm qm so qo a -> Event (TimingStats Int)+queueCountStats q =+  Event $ \p -> readIORef (queueCountStatsRef q)    -- | Signal when the 'queueCount' property value has changed. queueCountChanged :: Queue sm qm so qo a -> Signal Int@@ -340,6 +353,28 @@ dequeueWaitTimeChanged_ :: Queue sm qm so qo a -> Signal () dequeueWaitTimeChanged_ q =   mapSignal (const ()) (dequeueExtracted q)++-- | Return a long-term average queue rate calculated as+-- the average queue size divided by the average wait time.+--+-- See also 'queueRateChanged' and 'queueRateChanged_'.+queueRate :: Queue sm qm so qo a -> Event Double+queueRate q =+  Event $ \p ->+  do x <- readIORef (queueCountStatsRef q)+     y <- readIORef (queueWaitTimeRef q)+     return (timingStatsMean x / samplingStatsMean y) ++-- | Signal when the 'queueRate' property value has changed.+queueRateChanged :: Queue sm qm so qo a -> Signal Double+queueRateChanged q =+  mapSignalM (const $ queueRate q) (queueRateChanged_ q)++-- | Signal when the 'queueRate' property value has changed.+queueRateChanged_ :: Queue sm qm so qo a -> Signal ()+queueRateChanged_ q =+  mapSignal (const ()) (enqueueStored q) <>+  mapSignal (const ()) (dequeueExtracted q)    -- | Dequeue suspending the process if the queue is empty. dequeue :: (DequeueStrategy sm qm,@@ -430,7 +465,11 @@                          itemStoringTime = pointTime p }      invokeEvent p $        strategyEnqueue (enqueueStoringStrategy q) (queueStore q) i-     modifyIORef' (queueCountRef q) (+ 1)+     c <- readIORef (queueCountRef q)+     let c' = c + 1+         t  = pointTime p+     c' `seq` writeIORef (queueCountRef q) c'+     modifyIORef' (queueCountStatsRef q) (addTimingStats t c')      modifyIORef' (enqueueStoreCountRef q) (+ 1)      invokeEvent p $        releaseResourceWithinEvent (dequeueRes q)@@ -453,7 +492,11 @@                          itemStoringTime = pointTime p }      invokeEvent p $        strategyEnqueueWithPriority (enqueueStoringStrategy q) (queueStore q) pm i-     modifyIORef' (queueCountRef q) (+ 1)+     c <- readIORef (queueCountRef q)+     let c' = c + 1+         t  = pointTime p+     c' `seq` writeIORef (queueCountRef q) c'+     modifyIORef' (queueCountStatsRef q) (addTimingStats t c')      modifyIORef' (enqueueStoreCountRef q) (+ 1)      invokeEvent p $        releaseResourceWithinEvent (dequeueRes q)@@ -484,7 +527,11 @@   Event $ \p ->   do i <- invokeEvent p $           strategyDequeue (enqueueStoringStrategy q) (queueStore q)-     modifyIORef' (queueCountRef q) (+ (- 1))+     c <- readIORef (queueCountRef q)+     let c' = c - 1+         t  = pointTime p+     c' `seq` writeIORef (queueCountRef q) c'+     modifyIORef' (queueCountStatsRef q) (addTimingStats t c')      modifyIORef' (dequeueExtractCountRef q) (+ 1)      invokeEvent p $        dequeueStat q t' i@@ -531,6 +578,7 @@          so = dequeueStrategy q      null <- queueNull q      count <- queueCount q+     countStats <- queueCountStats q      enqueueStoreCount <- enqueueStoreCount q      dequeueCount <- dequeueCount q      dequeueExtractCount <- dequeueExtractCount q@@ -554,9 +602,13 @@        shows null .        showString "\n" .        showString tab .-       showString "size = " .+       showString "the current size = " .        shows count .        showString "\n" .+       showString tab .+       showString "the size statistics = \n\n" .+       timingStatsSummary countStats (2 + indent) .+       showString "\n\n" .        showString tab .        showString "the enqueue store count (number of the input items that were stored) = " .        shows enqueueStoreCount .

@@ -7,7 +7,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- This module defines the queue strategies. --

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- This module defines an updatable reference that depends on the event queue. --

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- This module defines the resource which can be acquired and  -- then released by the discontinuous process 'Process'.

@@ -0,0 +1,1841 @@++{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, UndecidableInstances, ExistentialQuantification #-}++-- |+-- Module     : Simulation.Aivika.Results+-- 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+--+-- The module allows exporting the simulation results from the model.+--+module Simulation.Aivika.Results+       (-- * Definitions Focused on Modeling+        Results,+        ResultTransform,+        ResultName,+        ResultProvider(..),+        results,+        expandResults,+        resultSummary,+        resultByName,+        resultByProperty,+        resultByIndex,+        resultBySubscript,+        ResultComputing(..),+        ResultComputation(..),+        ResultListWithSubscript(..),+        ResultArrayWithSubscript(..),+#ifndef __HASTE__+        ResultVectorWithSubscript(..),+#endif+        -- * Definitions Focused on Using the Library+        ResultExtract(..),+        extractIntResults,+        extractIntListResults,+        extractIntStatsResults,+        extractIntStatsEitherResults,+        extractIntTimingStatsResults,+        extractDoubleResults,+        extractDoubleListResults,+        extractDoubleStatsResults,+        extractDoubleStatsEitherResults,+        extractDoubleTimingStatsResults,+        extractStringResults,+        ResultPredefinedSignals(..),+        newResultPredefinedSignals,+        resultSignal,+        pureResultSignal,+        -- * Definitions Focused on Extending the Library +        ResultSourceMap,+        ResultSource(..),+        ResultItem(..),+        ResultItemable(..),+        resultItemToIntStatsEitherValue,+        resultItemToDoubleStatsEitherValue,+        ResultObject(..),+        ResultProperty(..),+        ResultVector(..),+        memoResultVectorSignal,+        memoResultVectorSummary,+        ResultSeparator(..),+        ResultValue(..),+        voidResultValue,+        ResultContainer(..),+        resultContainerPropertySource,+        resultContainerConstProperty,+        resultContainerIntegProperty,+        resultContainerProperty,+        resultContainerMapProperty,+        resultValueToContainer,+        resultContainerToValue,+        ResultData,+        ResultSignal(..),+        maybeResultSignal,+        textResultSource,+        timeResultSource,+        resultSourceToIntValues,+        resultSourceToIntListValues,+        resultSourceToIntStatsValues,+        resultSourceToIntStatsEitherValues,+        resultSourceToIntTimingStatsValues,+        resultSourceToDoubleValues,+        resultSourceToDoubleListValues,+        resultSourceToDoubleStatsValues,+        resultSourceToDoubleStatsEitherValues,+        resultSourceToDoubleTimingStatsValues,+        resultSourceToStringValues,+        resultSourceMap,+        resultSourceList,+        resultsToIntValues,+        resultsToIntListValues,+        resultsToIntStatsValues,+        resultsToIntStatsEitherValues,+        resultsToIntTimingStatsValues,+        resultsToDoubleValues,+        resultsToDoubleListValues,+        resultsToDoubleStatsValues,+        resultsToDoubleStatsEitherValues,+        resultsToDoubleTimingStatsValues,+        resultsToStringValues,+        composeResults,+        computeResultValue) where++import Control.Monad+import Control.Monad.Trans++import qualified Data.Map as M+import qualified Data.Array as A++#ifndef __HASTE__+import qualified Data.Vector as V+#endif++import Data.Ix+import Data.Maybe+import Data.Monoid++import Simulation.Aivika.Parameter+import Simulation.Aivika.Simulation+import Simulation.Aivika.Dynamics+import Simulation.Aivika.Event+import Simulation.Aivika.Signal+import Simulation.Aivika.Statistics+import Simulation.Aivika.Statistics.Accumulator+import Simulation.Aivika.Ref+import qualified Simulation.Aivika.Ref.Light as LR+import Simulation.Aivika.Var+import Simulation.Aivika.QueueStrategy+import qualified Simulation.Aivika.Queue as Q+import qualified Simulation.Aivika.Queue.Infinite as IQ+import Simulation.Aivika.Arrival+import Simulation.Aivika.Server+import Simulation.Aivika.Results.Locale++-- | A name used for indentifying the results when generating output.+type ResultName = String++-- | Represents a provider of the simulation results. It is usually something, or+-- an array of something, or a list of such values which can be simulated to get data.+class ResultProvider p where+  +  -- | Return the source of simulation results by the specified name, description and provider. +  resultSource :: ResultName -> ResultDescription -> p -> ResultSource+  resultSource name descr = resultSource' name (UserDefinedResultId descr)++  -- | Return the source of simulation results by the specified name, identifier and provider. +  resultSource' :: ResultName -> ResultId -> p -> ResultSource++-- | It associates the result sources with their names.+type ResultSourceMap = M.Map ResultName ResultSource++-- | Encapsulates the result source.+data ResultSource = ResultItemSource ResultItem+                    -- ^ The source consisting of a single item.+                  | ResultObjectSource ResultObject+                    -- ^ An object-like source.+                  | ResultVectorSource ResultVector+                    -- ^ A vector-like structure.+                  | ResultSeparatorSource ResultSeparator+                    -- ^ This is a separator text.++-- | The simulation results represented by a single item.+data ResultItem = forall a. ResultItemable a => ResultItem a++-- | Represents a type class for actual representing the items.+class ResultItemable a where++  -- | The item name.+  resultItemName :: a -> ResultName+  +  -- | The item identifier.+  resultItemId :: a -> ResultId++  -- | Whether the item emits a signal.+  resultItemSignal :: a -> ResultSignal++  -- | Return an expanded version of the item, for example,+  -- when the statistics item is exanded to an object+  -- having the corresponded properties for count, average,+  -- deviation, minimum, maximum and so on.+  resultItemExpansion :: a -> ResultSource+  +  -- | Return usually a short version of the item, i.e. its summary,+  -- but values of some data types such as statistics can be+  -- implicitly expanded to an object with the corresponded+  -- properties.+  resultItemSummary :: a -> ResultSource+  +  -- | Return integer numbers in time points.+  resultItemToIntValue :: a -> ResultValue Int++  -- | Return lists of integer numbers in time points. +  resultItemToIntListValue :: a -> ResultValue [Int]++  -- | Return statistics based on integer numbers.+  resultItemToIntStatsValue :: a -> ResultValue (SamplingStats Int)++  -- | Return timing statistics based on integer numbers.+  resultItemToIntTimingStatsValue :: a -> ResultValue (TimingStats Int)++  -- | Return double numbers in time points.+  resultItemToDoubleValue :: a -> ResultValue Double+  +  -- | Return lists of double numbers in time points. +  resultItemToDoubleListValue :: a -> ResultValue [Double]++  -- | Return statistics based on double numbers.+  resultItemToDoubleStatsValue :: a -> ResultValue (SamplingStats Double)++  -- | Return timing statistics based on integer numbers.+  resultItemToDoubleTimingStatsValue :: a -> ResultValue (TimingStats Double)++  -- | Return string representations in time points.+  resultItemToStringValue :: a -> ResultValue String++-- | 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+    Nothing ->+      case resultValueData x2 of+        Just a2 -> fmap Right x2+        Nothing -> voidResultValue x2+  where+    x1 = resultItemToIntValue x+    x2 = resultItemToIntStatsValue x++-- | 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+    Nothing ->+      case resultValueData x2 of+        Just a2 -> fmap Right x2+        Nothing -> voidResultValue x2+  where+    x1 = resultItemToDoubleValue x+    x2 = resultItemToDoubleStatsValue x++-- | The simulation results represented by an object having properties.+data ResultObject =+  ResultObject { resultObjectName :: ResultName,+                 -- ^ The object name.+                 resultObjectId :: ResultId,+                 -- ^ The object identifier.+                 resultObjectTypeId :: ResultId,+                 -- ^ The object type identifier.+                 resultObjectProperties :: [ResultProperty],+                 -- ^ The object properties.+                 resultObjectSignal :: ResultSignal,+                 -- ^ A combined signal if present.+                 resultObjectSummary :: ResultSource+                 -- ^ A short version of the object, i.e. its summary.+               }++-- | The object property containing the simulation results.+data ResultProperty =+  ResultProperty { resultPropertyLabel :: ResultName,+                   -- ^ The property short label.+                   resultPropertyId :: ResultId,+                   -- ^ The property identifier.+                   resultPropertySource :: ResultSource+                   -- ^ The simulation results supplied by the property.+                 }++-- | The simulation results represented by a vector.+data ResultVector =+  ResultVector { resultVectorName :: ResultName,+                 -- ^ The vector name.+                 resultVectorId :: ResultId,+                 -- ^ The vector identifier.+                 resultVectorItems :: A.Array Int ResultSource,+                 -- ^ The results supplied by the vector items.+                 resultVectorSubscript :: A.Array Int ResultName,+                 -- ^ The subscript used as a suffix to create item names.+                 resultVectorSignal :: ResultSignal,+                 -- ^ A combined signal if present.+                 resultVectorSummary :: ResultSource+                 -- ^ A short version of the vector, i.e. summary.+               }++-- | Calculate the result vector signal and memoize it in a new vector.+memoResultVectorSignal :: ResultVector -> ResultVector+memoResultVectorSignal x =+  x { resultVectorSignal =+         foldr (<>) mempty $ map resultSourceSignal $ A.elems $ resultVectorItems x }++-- | Calculate the result vector summary and memoize it in a new vector.+memoResultVectorSummary :: ResultVector -> ResultVector+memoResultVectorSummary x =+  x { resultVectorSummary =+         ResultVectorSource $+         x { resultVectorItems =+                A.array bnds [(i, resultSourceSummary e) | (i, e) <- ies] } }+  where+    arr  = resultVectorItems x+    bnds = A.bounds arr+    ies  = A.assocs arr++-- | It separates the simulation results when printing.+data ResultSeparator =+  ResultSeparator { resultSeparatorText :: String+                    -- ^ The separator text.+                  }++-- | A parameterised value that actually represents a generalised result item that have no parametric type.+data ResultValue e =+  ResultValue { resultValueName :: ResultName,+                -- ^ The value name.+                resultValueId :: ResultId,+                -- ^ The value identifier.+                resultValueData :: ResultData e,+                -- ^ Simulation data supplied by the value.+                resultValueSignal :: ResultSignal+                -- ^ Whether the value emits a signal when changing simulation data.+              }++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 }++-- | A container of the simulation results such as queue, server or array.+data ResultContainer e =+  ResultContainer { resultContainerName :: ResultName,+                    -- ^ The container name.+                    resultContainerId :: ResultId,+                    -- ^ The container identifier.+                    resultContainerData :: e,+                    -- ^ The container data.+                    resultContainerSignal :: ResultSignal+                    -- ^ Whether the container emits a signal when changing simulation data.+                  }++instance Functor ResultContainer where+  fmap f x = x { resultContainerData = f (resultContainerData x) }++-- | Create a new property source by the specified container.+resultContainerPropertySource :: ResultItemable (ResultValue b)+                                 => ResultContainer a+                                 -- ^ the container+                                 -> ResultName+                                 -- ^ the property label+                                 -> ResultId+                                 -- ^ the property identifier+                                 -> (a -> ResultData b)+                                 -- ^ get the specified data from the container+                                 -> (a -> ResultSignal)+                                 -- ^ get the data signal from the container+                                 -> ResultSource+resultContainerPropertySource cont name i f g =+  ResultItemSource $+  ResultItem $+  ResultValue {+    resultValueName   = (resultContainerName cont) ++ "." ++ name,+    resultValueId     = i,+    resultValueData   = f (resultContainerData cont),+    resultValueSignal = g (resultContainerData cont) }++-- | Create a constant property by the specified container.+resultContainerConstProperty :: ResultItemable (ResultValue b)+                                => ResultContainer a+                                -- ^ the container+                                -> ResultName+                                -- ^ the property label+                                -> ResultId+                                -- ^ the property identifier+                                -> (a -> b)+                                -- ^ get the specified data from the container+                                -> ResultProperty+resultContainerConstProperty cont name i f =+  ResultProperty {+    resultPropertyLabel = name,+    resultPropertyId = i,+    resultPropertySource =+      resultContainerPropertySource cont name i (Just . 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)+                                => ResultContainer a+                                -- ^ the container+                                -> ResultName+                                -- ^ the property label+                                -> ResultId+                                -- ^ the property identifier+                                -> (a -> Event b)+                                -- ^ get the specified data from the container+                             -> ResultProperty+resultContainerIntegProperty cont name i f =+  ResultProperty {+    resultPropertyLabel = name,+    resultPropertyId = i,+    resultPropertySource =+      resultContainerPropertySource cont name i (Just . f) (const UnknownResultSignal) }+  +-- | Create a property by the specified container.+resultContainerProperty :: ResultItemable (ResultValue b)+                           => ResultContainer a+                           -- ^ the container+                           -> ResultName+                           -- ^ the property label+                           -> ResultId+                           -- ^ the property identifier+                           -> (a -> Event b)+                           -- ^ get the specified data from the container+                           -> (a -> Signal ())+                           -- ^ get a signal triggered when changing data.+                           -> ResultProperty+resultContainerProperty cont name i f g =                     +  ResultProperty {+    resultPropertyLabel = name,+    resultPropertyId = i,+    resultPropertySource =+      resultContainerPropertySource cont name i (Just . f) (ResultSignal . g) }++-- | Create by the specified container a mapped property which is recomputed each time again and again.+resultContainerMapProperty :: ResultItemable (ResultValue b)+                              => ResultContainer (ResultData a)+                              -- ^ the container+                              -> ResultName+                              -- ^ the property label+                              -> ResultId+                              -- ^ the property identifier+                              -> (a -> b)+                              -- ^ recompute the specified data+                              -> ResultProperty+resultContainerMapProperty cont name i f =                     +  ResultProperty {+    resultPropertyLabel = name,+    resultPropertyId = i,+    resultPropertySource =+      resultContainerPropertySource cont name i (fmap $ fmap f) (const $ resultContainerSignal cont) }++-- | Convert the result value to a container with the specified object identifier. +resultValueToContainer :: ResultValue a -> ResultContainer (ResultData a)+resultValueToContainer x =+  ResultContainer {+    resultContainerName   = resultValueName x,+    resultContainerId     = resultValueId x,+    resultContainerData   = resultValueData x,+    resultContainerSignal = resultValueSignal x }++-- | Convert the result container to a value.+resultContainerToValue :: ResultContainer (ResultData a) -> ResultValue a+resultContainerToValue x =+  ResultValue {+    resultValueName   = resultContainerName x,+    resultValueId     = resultContainerId x,+    resultValueData   = resultContainerData x,+    resultValueSignal = resultContainerSignal x }++-- | Represents the very simulation results.+type ResultData e = Maybe (Event e)++-- | Whether an object containing the results emits a signal notifying about change of data.+data ResultSignal = EmptyResultSignal+                    -- ^ There is no signal at all.+                  | UnknownResultSignal+                    -- ^ The signal is unknown, but the entity probably changes.+                  | ResultSignal (Signal ())+                    -- ^ When the signal is precisely specified.+                  | ResultSignalMix (Signal ())+                    -- ^ When the specified signal was combined with unknown signal.++instance Monoid ResultSignal where++  mempty = EmptyResultSignal++  mappend EmptyResultSignal z = z++  mappend UnknownResultSignal EmptyResultSignal = UnknownResultSignal+  mappend UnknownResultSignal UnknownResultSignal = UnknownResultSignal+  mappend UnknownResultSignal (ResultSignal x) = ResultSignalMix x+  mappend UnknownResultSignal z@(ResultSignalMix x) = z+  +  mappend z@(ResultSignal x) EmptyResultSignal = z+  mappend (ResultSignal x) UnknownResultSignal = ResultSignalMix x+  mappend (ResultSignal x) (ResultSignal y) = ResultSignal (x <> y)+  mappend (ResultSignal x) (ResultSignalMix y) = ResultSignalMix (x <> y)+  +  mappend z@(ResultSignalMix x) EmptyResultSignal = z+  mappend z@(ResultSignalMix x) UnknownResultSignal = z+  mappend (ResultSignalMix x) (ResultSignal y) = ResultSignalMix (x <> y)+  mappend (ResultSignalMix x) (ResultSignalMix y) = ResultSignalMix (x <> y)++-- | Construct a new result signal by the specified optional pure signal.+maybeResultSignal :: Maybe (Signal ()) -> ResultSignal+maybeResultSignal (Just x) = ResultSignal x+maybeResultSignal Nothing  = EmptyResultSignal++instance ResultItemable (ResultValue Int) where++  resultItemName = resultValueName+  resultItemId = resultValueId+  resultItemSignal = resultValueSignal+  +  resultItemToIntValue = id+  resultItemToIntListValue = fmap return+  resultItemToIntStatsValue = fmap returnSamplingStats+  resultItemToIntTimingStatsValue = voidResultValue++  resultItemToDoubleValue = fmap fromIntegral+  resultItemToDoubleListValue = fmap (return . fromIntegral)+  resultItemToDoubleStatsValue = fmap (returnSamplingStats . fromIntegral)+  resultItemToDoubleTimingStatsValue = voidResultValue++  resultItemToStringValue = fmap show++  resultItemExpansion = ResultItemSource . ResultItem+  resultItemSummary = ResultItemSource . ResultItem++instance ResultItemable (ResultValue Double) where++  resultItemName = resultValueName+  resultItemId = resultValueId+  resultItemSignal = resultValueSignal+  +  resultItemToIntValue = voidResultValue+  resultItemToIntListValue = voidResultValue+  resultItemToIntStatsValue = voidResultValue+  resultItemToIntTimingStatsValue = voidResultValue+  +  resultItemToDoubleValue = id+  resultItemToDoubleListValue = fmap return+  resultItemToDoubleStatsValue = fmap returnSamplingStats+  resultItemToDoubleTimingStatsValue = voidResultValue++  resultItemToStringValue = fmap show+  +  resultItemExpansion = ResultItemSource . ResultItem+  resultItemSummary = ResultItemSource . ResultItem++instance ResultItemable (ResultValue [Int]) where++  resultItemName = resultValueName+  resultItemId = resultValueId+  resultItemSignal = resultValueSignal+  +  resultItemToIntValue = voidResultValue+  resultItemToIntListValue = id+  resultItemToIntStatsValue = fmap listSamplingStats+  resultItemToIntTimingStatsValue = voidResultValue++  resultItemToDoubleValue = voidResultValue+  resultItemToDoubleListValue = fmap (map fromIntegral)+  resultItemToDoubleStatsValue = fmap (fromIntSamplingStats . listSamplingStats)+  resultItemToDoubleTimingStatsValue = voidResultValue++  resultItemToStringValue = fmap show+  +  resultItemExpansion = ResultItemSource . ResultItem+  resultItemSummary = ResultItemSource . ResultItem++instance ResultItemable (ResultValue [Double]) where++  resultItemName = resultValueName+  resultItemId = resultValueId+  resultItemSignal = resultValueSignal+  +  resultItemToIntValue = voidResultValue+  resultItemToIntListValue = voidResultValue+  resultItemToIntStatsValue = voidResultValue+  resultItemToIntTimingStatsValue = voidResultValue+  +  resultItemToDoubleValue = voidResultValue+  resultItemToDoubleListValue = id+  resultItemToDoubleStatsValue = fmap listSamplingStats+  resultItemToDoubleTimingStatsValue = voidResultValue++  resultItemToStringValue = fmap show+  +  resultItemExpansion = ResultItemSource . ResultItem+  resultItemSummary = ResultItemSource . ResultItem++instance ResultItemable (ResultValue (SamplingStats Int)) where++  resultItemName = resultValueName+  resultItemId = resultValueId+  resultItemSignal = resultValueSignal+  +  resultItemToIntValue = voidResultValue+  resultItemToIntListValue = voidResultValue+  resultItemToIntStatsValue = id+  resultItemToIntTimingStatsValue = voidResultValue++  resultItemToDoubleValue = voidResultValue+  resultItemToDoubleListValue = voidResultValue+  resultItemToDoubleStatsValue = fmap fromIntSamplingStats+  resultItemToDoubleTimingStatsValue = voidResultValue++  resultItemToStringValue = fmap show+  +  resultItemExpansion = samplingStatsResultSource+  resultItemSummary = samplingStatsResultSummary++instance ResultItemable (ResultValue (SamplingStats Double)) where++  resultItemName = resultValueName+  resultItemId = resultValueId+  resultItemSignal = resultValueSignal+  +  resultItemToIntValue = voidResultValue+  resultItemToIntListValue = voidResultValue+  resultItemToIntStatsValue = voidResultValue+  resultItemToIntTimingStatsValue = voidResultValue+  +  resultItemToDoubleValue = voidResultValue+  resultItemToDoubleListValue = voidResultValue+  resultItemToDoubleStatsValue = id+  resultItemToDoubleTimingStatsValue = voidResultValue++  resultItemToStringValue = fmap show+  +  resultItemExpansion = samplingStatsResultSource+  resultItemSummary = samplingStatsResultSummary++instance ResultItemable (ResultValue (TimingStats Int)) where++  resultItemName = resultValueName+  resultItemId = resultValueId+  resultItemSignal = resultValueSignal+  +  resultItemToIntValue = voidResultValue+  resultItemToIntListValue = voidResultValue+  resultItemToIntStatsValue = voidResultValue+  resultItemToIntTimingStatsValue = id++  resultItemToDoubleValue = voidResultValue+  resultItemToDoubleListValue = voidResultValue+  resultItemToDoubleStatsValue = voidResultValue+  resultItemToDoubleTimingStatsValue = fmap fromIntTimingStats++  resultItemToStringValue = fmap show+  +  resultItemExpansion = timingStatsResultSource+  resultItemSummary = timingStatsResultSummary++instance ResultItemable (ResultValue (TimingStats Double)) where++  resultItemName = resultValueName+  resultItemId = resultValueId+  resultItemSignal = resultValueSignal+  +  resultItemToIntValue = voidResultValue+  resultItemToIntListValue = voidResultValue+  resultItemToIntStatsValue = voidResultValue+  resultItemToIntTimingStatsValue = voidResultValue++  resultItemToDoubleValue = voidResultValue+  resultItemToDoubleListValue = voidResultValue+  resultItemToDoubleStatsValue = voidResultValue+  resultItemToDoubleTimingStatsValue = id++  resultItemToStringValue = fmap show+  +  resultItemExpansion = timingStatsResultSource+  resultItemSummary = timingStatsResultSummary++instance ResultItemable (ResultValue Bool) where++  resultItemName = resultValueName+  resultItemId = resultValueId+  resultItemSignal = resultValueSignal+  +  resultItemToIntValue = voidResultValue+  resultItemToIntListValue = voidResultValue+  resultItemToIntStatsValue = voidResultValue+  resultItemToIntTimingStatsValue = voidResultValue++  resultItemToDoubleValue = voidResultValue+  resultItemToDoubleListValue = voidResultValue+  resultItemToDoubleStatsValue = voidResultValue+  resultItemToDoubleTimingStatsValue = voidResultValue++  resultItemToStringValue = fmap show++  resultItemExpansion = ResultItemSource . ResultItem+  resultItemSummary = ResultItemSource . ResultItem++instance ResultItemable (ResultValue String) where++  resultItemName = resultValueName+  resultItemId = resultValueId+  resultItemSignal = resultValueSignal+  +  resultItemToIntValue = voidResultValue+  resultItemToIntListValue = voidResultValue+  resultItemToIntStatsValue = voidResultValue+  resultItemToIntTimingStatsValue = voidResultValue++  resultItemToDoubleValue = voidResultValue+  resultItemToDoubleListValue = voidResultValue+  resultItemToDoubleStatsValue = voidResultValue+  resultItemToDoubleTimingStatsValue = voidResultValue++  resultItemToStringValue = fmap show++  resultItemExpansion = ResultItemSource . ResultItem+  resultItemSummary = ResultItemSource . ResultItem++instance ResultItemable (ResultValue ()) where++  resultItemName = resultValueName+  resultItemId = resultValueId+  resultItemSignal = resultValueSignal+  +  resultItemToIntValue = voidResultValue+  resultItemToIntListValue = voidResultValue+  resultItemToIntStatsValue = voidResultValue+  resultItemToIntTimingStatsValue = voidResultValue++  resultItemToDoubleValue = voidResultValue+  resultItemToDoubleListValue = voidResultValue+  resultItemToDoubleStatsValue = voidResultValue+  resultItemToDoubleTimingStatsValue = voidResultValue++  resultItemToStringValue = fmap show++  resultItemExpansion = ResultItemSource . ResultItem+  resultItemSummary = ResultItemSource . ResultItem++instance ResultItemable (ResultValue FCFS) where++  resultItemName = resultValueName+  resultItemId = resultValueId+  resultItemSignal = resultValueSignal+  +  resultItemToIntValue = voidResultValue+  resultItemToIntListValue = voidResultValue+  resultItemToIntStatsValue = voidResultValue+  resultItemToIntTimingStatsValue = voidResultValue++  resultItemToDoubleValue = voidResultValue+  resultItemToDoubleListValue = voidResultValue+  resultItemToDoubleStatsValue = voidResultValue+  resultItemToDoubleTimingStatsValue = voidResultValue++  resultItemToStringValue = fmap show++  resultItemExpansion = ResultItemSource . ResultItem+  resultItemSummary = ResultItemSource . ResultItem++instance ResultItemable (ResultValue LCFS) where++  resultItemName = resultValueName+  resultItemId = resultValueId+  resultItemSignal = resultValueSignal+  +  resultItemToIntValue = voidResultValue+  resultItemToIntListValue = voidResultValue+  resultItemToIntStatsValue = voidResultValue+  resultItemToIntTimingStatsValue = voidResultValue++  resultItemToDoubleValue = voidResultValue+  resultItemToDoubleListValue = voidResultValue+  resultItemToDoubleStatsValue = voidResultValue+  resultItemToDoubleTimingStatsValue = voidResultValue++  resultItemToStringValue = fmap show++  resultItemExpansion = ResultItemSource . ResultItem+  resultItemSummary = ResultItemSource . ResultItem++instance ResultItemable (ResultValue SIRO) where++  resultItemName = resultValueName+  resultItemId = resultValueId+  resultItemSignal = resultValueSignal+  +  resultItemToIntValue = voidResultValue+  resultItemToIntListValue = voidResultValue+  resultItemToIntStatsValue = voidResultValue+  resultItemToIntTimingStatsValue = voidResultValue++  resultItemToDoubleValue = voidResultValue+  resultItemToDoubleListValue = voidResultValue+  resultItemToDoubleStatsValue = voidResultValue+  resultItemToDoubleTimingStatsValue = voidResultValue++  resultItemToStringValue = fmap show++  resultItemExpansion = ResultItemSource . ResultItem+  resultItemSummary = ResultItemSource . ResultItem++instance ResultItemable (ResultValue StaticPriorities) where++  resultItemName = resultValueName+  resultItemId = resultValueId+  resultItemSignal = resultValueSignal+  +  resultItemToIntValue = voidResultValue+  resultItemToIntListValue = voidResultValue+  resultItemToIntStatsValue = voidResultValue+  resultItemToIntTimingStatsValue = voidResultValue++  resultItemToDoubleValue = voidResultValue+  resultItemToDoubleListValue = voidResultValue+  resultItemToDoubleStatsValue = voidResultValue+  resultItemToDoubleTimingStatsValue = voidResultValue++  resultItemToStringValue = fmap show++  resultItemExpansion = ResultItemSource . ResultItem+  resultItemSummary = ResultItemSource . ResultItem++-- | Flatten the result source.+flattenResultSource :: ResultSource -> [ResultItem]+flattenResultSource (ResultItemSource x) = [x]+flattenResultSource (ResultObjectSource x) =+  concat $ map (flattenResultSource . resultPropertySource) $ resultObjectProperties x+flattenResultSource (ResultVectorSource x) =+  concat $ map flattenResultSource $ A.elems $ resultVectorItems x+flattenResultSource (ResultSeparatorSource x) = []++-- | Return the result source name.+resultSourceName :: ResultSource -> ResultName+resultSourceName (ResultItemSource (ResultItem x)) = resultItemName x+resultSourceName (ResultObjectSource x) = resultObjectName x+resultSourceName (ResultVectorSource x) = resultVectorName x+resultSourceName (ResultSeparatorSource x) = []++-- | Expand the result source returning a more detailed version expanding the properties as possible.+expandResultSource :: ResultSource -> ResultSource+expandResultSource (ResultItemSource (ResultItem x)) = resultItemExpansion x+expandResultSource (ResultObjectSource x) =+  ResultObjectSource $+  x { resultObjectProperties =+         flip fmap (resultObjectProperties x) $ \p ->+         p { resultPropertySource = expandResultSource (resultPropertySource p) } }+expandResultSource (ResultVectorSource x) =+  ResultVectorSource $+  x { resultVectorItems =+         A.array bnds [(i, expandResultSource e) | (i, e) <- ies] }+    where arr  = resultVectorItems x+          bnds = A.bounds arr+          ies  = A.assocs arr+expandResultSource z@(ResultSeparatorSource x) = z++-- | Return a summarised and usually more short version of the result source expanding the main properties or excluding auxiliary properties if required.+resultSourceSummary :: ResultSource -> ResultSource+resultSourceSummary (ResultItemSource (ResultItem x)) = resultItemSummary x+resultSourceSummary (ResultObjectSource x) = resultObjectSummary x+resultSourceSummary (ResultVectorSource x) = resultVectorSummary x+resultSourceSummary z@(ResultSeparatorSource x) = z++-- | Return a signal emitted by the source.+resultSourceSignal :: ResultSource -> ResultSignal+resultSourceSignal (ResultItemSource (ResultItem x)) = resultItemSignal x+resultSourceSignal (ResultObjectSource x) = resultObjectSignal x+resultSourceSignal (ResultVectorSource x) = resultVectorSignal x+resultSourceSignal (ResultSeparatorSource x) = EmptyResultSignal++-- | Represent the result source as integer numbers.+resultSourceToIntValues :: ResultSource -> [ResultValue Int]+resultSourceToIntValues = map (\(ResultItem x) -> resultItemToIntValue x) . flattenResultSource++-- | Represent the result source as lists of integer numbers.+resultSourceToIntListValues :: ResultSource -> [ResultValue [Int]]+resultSourceToIntListValues = map (\(ResultItem x) -> resultItemToIntListValue x) . flattenResultSource++-- | Represent the result source as statistics based on integer numbers.+resultSourceToIntStatsValues :: ResultSource -> [ResultValue (SamplingStats Int)]+resultSourceToIntStatsValues = map (\(ResultItem x) -> resultItemToIntStatsValue x) . flattenResultSource++-- | Represent the result source as statistics based on integer numbers and optimised for fast aggregation.+resultSourceToIntStatsEitherValues :: ResultSource -> [ResultValue (Either Int (SamplingStats Int))]+resultSourceToIntStatsEitherValues = map (\(ResultItem x) -> resultItemToIntStatsEitherValue x) . flattenResultSource++-- | Represent the result source as timing statistics based on integer numbers.+resultSourceToIntTimingStatsValues :: ResultSource -> [ResultValue (TimingStats Int)]+resultSourceToIntTimingStatsValues = map (\(ResultItem x) -> resultItemToIntTimingStatsValue x) . flattenResultSource++-- | Represent the result source as double floating point numbers.+resultSourceToDoubleValues :: ResultSource -> [ResultValue Double]+resultSourceToDoubleValues = map (\(ResultItem x) -> resultItemToDoubleValue x) . flattenResultSource++-- | Represent the result source as lists of double floating point numbers.+resultSourceToDoubleListValues :: ResultSource -> [ResultValue [Double]]+resultSourceToDoubleListValues = map (\(ResultItem x) -> resultItemToDoubleListValue x) . flattenResultSource++-- | Represent the result source as statistics based on double floating point numbers.+resultSourceToDoubleStatsValues :: ResultSource -> [ResultValue (SamplingStats Double)]+resultSourceToDoubleStatsValues = map (\(ResultItem x) -> resultItemToDoubleStatsValue x) . flattenResultSource++-- | Represent the result source as statistics based on double floating point numbers and optimised for fast aggregation.+resultSourceToDoubleStatsEitherValues :: ResultSource -> [ResultValue (Either Double (SamplingStats Double))]+resultSourceToDoubleStatsEitherValues = map (\(ResultItem x) -> resultItemToDoubleStatsEitherValue x) . flattenResultSource++-- | Represent the result source as timing statistics based on double floating point numbers.+resultSourceToDoubleTimingStatsValues :: ResultSource -> [ResultValue (TimingStats Double)]+resultSourceToDoubleTimingStatsValues = map (\(ResultItem x) -> resultItemToDoubleTimingStatsValue x) . flattenResultSource++-- | Represent the result source as string values.+resultSourceToStringValues :: ResultSource -> [ResultValue String]+resultSourceToStringValues = map (\(ResultItem x) -> resultItemToStringValue x) . flattenResultSource++-- | It contains the results of simulation.+data Results =+  Results { resultSourceMap :: ResultSourceMap,+            -- ^ The sources of simulation results as a map of associated names.+            resultSourceList :: [ResultSource]+            -- ^ The sources of simulation results as an ordered list.+          }++-- | It transforms the results of simulation.+type ResultTransform = Results -> Results++-- | It representes the predefined signals provided by every simulation model.+data ResultPredefinedSignals =+  ResultPredefinedSignals { resultSignalInIntegTimes :: Signal Double,+                            -- ^ The signal triggered in the integration time points.+                            resultSignalInStartTime :: Signal Double,+                            -- ^ The signal triggered in the start time.+                            resultSignalInStopTime :: Signal Double+                            -- ^ The signal triggered in the stop time.+                          }++-- | Create the predefined signals provided by every simulation model.+newResultPredefinedSignals :: Simulation ResultPredefinedSignals+newResultPredefinedSignals = runDynamicsInStartTime $ runEventWith EarlierEvents d where+  d = do signalInIntegTimes <- newSignalInIntegTimes+         signalInStartTime  <- newSignalInStartTime+         signalInStopTime   <- newSignalInStopTime+         return ResultPredefinedSignals { resultSignalInIntegTimes = signalInIntegTimes,+                                          resultSignalInStartTime  = signalInStartTime,+                                          resultSignalInStopTime   = signalInStopTime }++instance Monoid Results where++  mempty      = results mempty+  mappend x y = results $ resultSourceList x <> resultSourceList y++-- | Prepare the simulation results.+results :: [ResultSource] -> Results+results ms =+  Results { resultSourceMap  = M.fromList $ map (\x -> (resultSourceName x, x)) ms,+            resultSourceList = ms }++-- | Represent the results as integer numbers.+resultsToIntValues :: Results -> [ResultValue Int]+resultsToIntValues = concat . map resultSourceToIntValues . resultSourceList++-- | Represent the results as lists of integer numbers.+resultsToIntListValues :: Results -> [ResultValue [Int]]+resultsToIntListValues = concat . map resultSourceToIntListValues . resultSourceList++-- | Represent the results as statistics based on integer numbers.+resultsToIntStatsValues :: Results -> [ResultValue (SamplingStats Int)]+resultsToIntStatsValues = concat . map resultSourceToIntStatsValues . resultSourceList++-- | Represent the results as statistics based on integer numbers and optimised for fast aggregation.+resultsToIntStatsEitherValues :: Results -> [ResultValue (Either Int (SamplingStats Int))]+resultsToIntStatsEitherValues = concat . map resultSourceToIntStatsEitherValues . resultSourceList++-- | Represent the results as timing statistics based on integer numbers.+resultsToIntTimingStatsValues :: Results -> [ResultValue (TimingStats Int)]+resultsToIntTimingStatsValues = concat . map resultSourceToIntTimingStatsValues . resultSourceList++-- | Represent the results as double floating point numbers.+resultsToDoubleValues :: Results -> [ResultValue Double]+resultsToDoubleValues = concat . map resultSourceToDoubleValues . resultSourceList++-- | Represent the results as lists of double floating point numbers.+resultsToDoubleListValues :: Results -> [ResultValue [Double]]+resultsToDoubleListValues = concat . map resultSourceToDoubleListValues . resultSourceList++-- | Represent the results as statistics based on double floating point numbers.+resultsToDoubleStatsValues :: Results -> [ResultValue (SamplingStats Double)]+resultsToDoubleStatsValues = concat . map resultSourceToDoubleStatsValues . resultSourceList++-- | Represent the results as statistics based on double floating point numbers and optimised for fast aggregation.+resultsToDoubleStatsEitherValues :: Results -> [ResultValue (Either Double (SamplingStats Double))]+resultsToDoubleStatsEitherValues = concat . map resultSourceToDoubleStatsEitherValues . resultSourceList++-- | Represent the results as timing statistics based on double floating point numbers.+resultsToDoubleTimingStatsValues :: Results -> [ResultValue (TimingStats Double)]+resultsToDoubleTimingStatsValues = concat . map resultSourceToDoubleTimingStatsValues . resultSourceList++-- | Represent the results as string values.+resultsToStringValues :: Results -> [ResultValue String]+resultsToStringValues = concat . map resultSourceToStringValues . resultSourceList++-- | Return a signal emitted by the specified results.+resultSignal :: Results -> ResultSignal+resultSignal = mconcat . map resultSourceSignal . resultSourceList++-- | Return an expanded version of the simulation results expanding the properties as possible, which+-- takes place for expanding statistics to show the count, average, deviation, minimum, maximum etc.+-- as separate values.+expandResults :: ResultTransform+expandResults = results . map expandResultSource . resultSourceList++-- | Return a short version of the simulation results, i.e. their summary, expanding the main properties+-- or excluding auxiliary properties if required.+resultSummary :: ResultTransform+resultSummary = results . map resultSourceSummary . resultSourceList++-- | Take a result by its name.+resultByName :: ResultName -> ResultTransform+resultByName name rs =+  case M.lookup name (resultSourceMap rs) of+    Just x -> results [x]+    Nothing ->+      error $+      "Not found result source with name " ++ name +++      ": resultByName"++-- | Take a result from the object with the specified property label.+resultByProperty :: ResultName -> ResultTransform+resultByProperty label rs = flip composeResults rs loop+  where+    loop x =+      case x of+        ResultObjectSource s ->+          let ps =+                flip filter (resultObjectProperties s) $ \p ->+                resultPropertyLabel p == label+          in case ps of+            [] ->+              error $+              "Not found property " ++ label +++              " for object " ++ resultObjectName s +++              ": resultByProperty"+            ps ->+              map resultPropertySource ps+        ResultVectorSource s ->+          concat $ map loop $ A.elems $ resultVectorItems s+        x ->+          error $+          "Result source " ++ resultSourceName x +++          " is neither object, nor vector " +++          ": resultByProperty"++-- | Take a result from the vector by the specified integer index.+resultByIndex :: Int -> ResultTransform+resultByIndex index rs = flip composeResults rs loop+  where+    loop x =+      case x of+        ResultVectorSource s ->+          [resultVectorItems s A.! index] +        x ->+          error $+          "Result source " ++ resultSourceName x +++          " is not vector " +++          ": resultByIndex"++-- | Take a result from the vector by the specified string subscript.+resultBySubscript :: ResultName -> ResultTransform+resultBySubscript subscript rs = flip composeResults rs loop+  where+    loop x =+      case x of+        ResultVectorSource s ->+          let ys = A.elems $ resultVectorItems s+              zs = A.elems $ resultVectorSubscript s+              ps =+                flip filter (zip ys zs) $ \(y, z) ->+                z == subscript+          in case ps of+            [] ->+              error $+              "Not found subscript " ++ subscript +++              " for vector " ++ resultVectorName s +++              ": resultBySubscript"+            ps ->+              map fst ps+        x ->+          error $+          "Result source " ++ resultSourceName x +++          " is not vector " +++          ": resultBySubscript"++-- | Compose the results using the specified transformation function.+composeResults :: (ResultSource -> [ResultSource]) -> ResultTransform+composeResults f =+  results . concat . map f . resultSourceList++-- | Concatenate the results using the specified list of transformation functions.+concatResults :: [ResultTransform] -> ResultTransform+concatResults trs rs =+  results $ concat $ map (\tr -> resultSourceList $ tr rs) trs++-- | Append the results using the specified transformation functions.+appendResults :: ResultTransform -> ResultTransform -> ResultTransform+appendResults x y =+  concatResults [x, y]++-- | Return a pure signal as a result of combination of the predefined signals+-- with the specified result signal usually provided by the sources.+--+-- The signal returned is triggered when the source signal is triggered.+-- The pure signal is also triggered in the integration time points+-- if the source signal is unknown or it was combined with any unknown signal.+pureResultSignal :: ResultPredefinedSignals -> ResultSignal -> Signal ()+pureResultSignal rs EmptyResultSignal =+  void (resultSignalInStartTime rs)+pureResultSignal rs UnknownResultSignal =+  void (resultSignalInIntegTimes rs)+pureResultSignal rs (ResultSignal s) =+  void (resultSignalInStartTime rs) <> void (resultSignalInStopTime rs) <> s+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++  -- | Compute data with the results of simulation.+  computeResultData :: m a -> ResultData a++  -- | Return the signal triggered when data change if such a signal exists.+  computeResultSignal :: m a -> ResultSignal++-- | Return a new result value by the specified name, identifier and computation.+computeResultValue :: ResultComputing m+                      => ResultName+                      -- ^ the result name+                      -> ResultId+                      -- ^ the result identifier+                      -> m a+                      -- ^ the result computation+                      -> ResultValue a+computeResultValue name i m =+  ResultValue {+    resultValueName   = name,+    resultValueId     = i,+    resultValueData   = computeResultData m,+    resultValueSignal = computeResultSignal m }++-- | Represents a computation that can return the simulation data.+data ResultComputation a =+  ResultComputation { resultComputationData :: ResultData a,+                      -- ^ Return data from the computation.+                      resultComputationSignal :: ResultSignal+                      -- ^ Return a signal from the computation.+                    }++instance ResultComputing ResultComputation where++  computeResultData = resultComputationData+  computeResultSignal = resultComputationSignal++instance ResultComputing Parameter where++  computeResultData = Just . liftParameter+  computeResultSignal = const UnknownResultSignal++instance ResultComputing Simulation where++  computeResultData = Just . liftSimulation+  computeResultSignal = const UnknownResultSignal++instance ResultComputing Dynamics where++  computeResultData = Just . liftDynamics+  computeResultSignal = const UnknownResultSignal++instance ResultComputing Event where++  computeResultData = Just . id+  computeResultSignal = const UnknownResultSignal++instance ResultComputing Ref where++  computeResultData = Just . readRef+  computeResultSignal = ResultSignal . refChanged_++instance ResultComputing LR.Ref where++  computeResultData = Just . LR.readRef+  computeResultSignal = const UnknownResultSignal++instance ResultComputing Var where++  computeResultData = Just . readVar+  computeResultSignal = ResultSignal . varChanged_++instance ResultComputing Signalable where++  computeResultData = Just . readSignalable+  computeResultSignal = ResultSignal . signalableChanged_+      +-- | Return a source by the specified statistics.+samplingStatsResultSource :: (ResultItemable (ResultValue a),+                              ResultItemable (ResultValue (SamplingStats a)))+                             => ResultValue (SamplingStats a)+                             -- ^ the statistics+                             -> ResultSource+samplingStatsResultSource x =+  ResultObjectSource $+  ResultObject {+    resultObjectName      = resultValueName x,+    resultObjectId        = resultValueId x,+    resultObjectTypeId    = SamplingStatsId,+    resultObjectSignal    = resultValueSignal x,+    resultObjectSummary   = samplingStatsResultSummary x,+    resultObjectProperties = [+      resultContainerMapProperty c "count" SamplingStatsCountId samplingStatsCount,+      resultContainerMapProperty c "mean" SamplingStatsMeanId samplingStatsMean,+      resultContainerMapProperty c "mean2" SamplingStatsMean2Id samplingStatsMean2,+      resultContainerMapProperty c "std" SamplingStatsDeviationId samplingStatsDeviation,+      resultContainerMapProperty c "var" SamplingStatsVarianceId samplingStatsVariance,+      resultContainerMapProperty c "min" SamplingStatsMinId samplingStatsMin,+      resultContainerMapProperty c "max" SamplingStatsMaxId samplingStatsMax ] }+  where+    c = resultValueToContainer x++-- | Return the summary by the specified statistics.+samplingStatsResultSummary :: ResultItemable (ResultValue (SamplingStats a))+                              => ResultValue (SamplingStats a)+                              -- ^ the statistics+                           -> ResultSource+samplingStatsResultSummary = ResultItemSource . ResultItem . resultItemToStringValue +  +-- | Return a source by the specified timing statistics.+timingStatsResultSource :: (TimingData a,+                            ResultItemable (ResultValue a),+                            ResultItemable (ResultValue (TimingStats a)))+                           => ResultValue (TimingStats a)+                           -- ^ the statistics+                           -> ResultSource+timingStatsResultSource x =+  ResultObjectSource $+  ResultObject {+    resultObjectName      = resultValueName x,+    resultObjectId        = resultValueId x,+    resultObjectTypeId    = TimingStatsId,+    resultObjectSignal    = resultValueSignal x,+    resultObjectSummary   = timingStatsResultSummary x,+    resultObjectProperties = [+      resultContainerMapProperty c "count" TimingStatsCountId timingStatsCount,+      resultContainerMapProperty c "mean" TimingStatsMeanId timingStatsMean,+      resultContainerMapProperty c "std" TimingStatsDeviationId timingStatsDeviation,+      resultContainerMapProperty c "var" TimingStatsVarianceId timingStatsVariance,+      resultContainerMapProperty c "min" TimingStatsMinId timingStatsMin,+      resultContainerMapProperty c "max" TimingStatsMaxId timingStatsMax,+      resultContainerMapProperty c "minTime" TimingStatsMinTimeId timingStatsMinTime,+      resultContainerMapProperty c "maxTime" TimingStatsMaxTimeId timingStatsMaxTime,+      resultContainerMapProperty c "startTime" TimingStatsStartTimeId timingStatsStartTime,+      resultContainerMapProperty c "lastTime" TimingStatsLastTimeId timingStatsLastTime,+      resultContainerMapProperty c "sum" TimingStatsSumId timingStatsSum,+      resultContainerMapProperty c "sum2" TimingStatsSum2Id timingStatsSum2 ] }+  where+    c = resultValueToContainer x++-- | Return the summary by the specified timing statistics.+timingStatsResultSummary :: (TimingData a, ResultItemable (ResultValue (TimingStats a)))+                            => ResultValue (TimingStats a) +                            -- ^ the statistics+                            -> ResultSource+timingStatsResultSummary = ResultItemSource . ResultItem . resultItemToStringValue+  +-- | Return a source by the specified finite queue.+queueResultSource :: (Show si, Show sm, Show so,+                      ResultItemable (ResultValue si),+                      ResultItemable (ResultValue sm),+                      ResultItemable (ResultValue so))+                     => ResultContainer (Q.Queue si qi sm qm so qo a)+                     -- ^ the queue container+                     -> ResultSource+queueResultSource c =+  ResultObjectSource $+  ResultObject {+    resultObjectName = resultContainerName c,+    resultObjectId = resultContainerId c,+    resultObjectTypeId = FiniteQueueId,+    resultObjectSignal = resultContainerSignal c,+    resultObjectSummary = queueResultSummary c,+    resultObjectProperties = [+      resultContainerConstProperty c "enqueueStrategy" EnqueueStrategyId Q.enqueueStrategy,+      resultContainerConstProperty c "enqueueStoringStrategy" EnqueueStoringStrategyId Q.enqueueStoringStrategy,+      resultContainerConstProperty c "dequeueStrategy" DequeueStrategyId Q.dequeueStrategy,+      resultContainerProperty c "queueNull" QueueNullId Q.queueNull Q.queueNullChanged_,+      resultContainerProperty c "queueFull" QueueFullId Q.queueFull Q.queueFullChanged_,+      resultContainerConstProperty c "queueMaxCount" QueueMaxCountId Q.queueMaxCount,+      resultContainerProperty c "queueCount" QueueCountId Q.queueCount Q.queueCountChanged_,+      resultContainerProperty c "queueCountStats" QueueCountStatsId Q.queueCountStats Q.queueCountChanged_,+      resultContainerProperty c "enqueueCount" EnqueueCountId Q.enqueueCount Q.enqueueCountChanged_,+      resultContainerProperty c "enqueueLostCount" EnqueueLostCountId Q.enqueueLostCount Q.enqueueLostCountChanged_,+      resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId Q.enqueueStoreCount Q.enqueueStoreCountChanged_,+      resultContainerProperty c "dequeueCount" DequeueCountId Q.dequeueCount Q.dequeueCountChanged_,+      resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId Q.dequeueExtractCount Q.dequeueExtractCountChanged_,+      resultContainerProperty c "queueLoadFactor" QueueLoadFactorId Q.queueLoadFactor Q.queueLoadFactorChanged_,+      resultContainerIntegProperty c "enqueueRate" EnqueueRateId Q.enqueueRate,+      resultContainerIntegProperty c "enqueueStoreRate" EnqueueStoreRateId Q.enqueueStoreRate,+      resultContainerIntegProperty c "dequeueRate" DequeueRateId Q.dequeueRate,+      resultContainerIntegProperty c "dequeueExtractRate" DequeueExtractRateId Q.dequeueExtractRate,+      resultContainerProperty c "queueWaitTime" QueueWaitTimeId Q.queueWaitTime Q.queueWaitTimeChanged_,+      resultContainerProperty c "queueTotalWaitTime" QueueTotalWaitTimeId Q.queueTotalWaitTime Q.queueTotalWaitTimeChanged_,+      resultContainerProperty c "enqueueWaitTime" EnqueueWaitTimeId Q.enqueueWaitTime Q.enqueueWaitTimeChanged_,+      resultContainerProperty c "dequeueWaitTime" DequeueWaitTimeId Q.dequeueWaitTime Q.dequeueWaitTimeChanged_,+      resultContainerProperty c "queueRate" QueueRateId Q.queueRate Q.queueRateChanged_ ] }++-- | Return the summary by the specified finite queue.+queueResultSummary :: (Show si, Show sm, Show so)+                      => ResultContainer (Q.Queue si qi sm qm so qo a)+                      -- ^ the queue container+                      -> ResultSource+queueResultSummary c =+  ResultObjectSource $+  ResultObject {+    resultObjectName = resultContainerName c,+    resultObjectId = resultContainerId c,+    resultObjectTypeId = FiniteQueueId,+    resultObjectSignal = resultContainerSignal c,+    resultObjectSummary = queueResultSummary c,+    resultObjectProperties = [+      resultContainerConstProperty c "queueMaxCount" QueueMaxCountId Q.queueMaxCount,+      resultContainerProperty c "queueCountStats" QueueCountStatsId Q.queueCountStats Q.queueCountChanged_,+      resultContainerProperty c "enqueueCount" EnqueueCountId Q.enqueueCount Q.enqueueCountChanged_,+      resultContainerProperty c "enqueueLostCount" EnqueueLostCountId Q.enqueueLostCount Q.enqueueLostCountChanged_,+      resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId Q.enqueueStoreCount Q.enqueueStoreCountChanged_,+      resultContainerProperty c "dequeueCount" DequeueCountId Q.dequeueCount Q.dequeueCountChanged_,+      resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId Q.dequeueExtractCount Q.dequeueExtractCountChanged_,+      resultContainerProperty c "queueLoadFactor" QueueLoadFactorId Q.queueLoadFactor Q.queueLoadFactorChanged_,+      resultContainerProperty c "queueWaitTime" QueueWaitTimeId Q.queueWaitTime Q.queueWaitTimeChanged_,+      resultContainerProperty c "queueRate" QueueRateId Q.queueRate Q.queueRateChanged_ ] }++-- | Return a source by the specified infinite queue.+infiniteQueueResultSource :: (Show sm, Show so,+                              ResultItemable (ResultValue sm),+                              ResultItemable (ResultValue so))+                             => ResultContainer (IQ.Queue sm qm so qo a)+                             -- ^ the queue container+                             -> ResultSource+infiniteQueueResultSource c =+  ResultObjectSource $+  ResultObject {+    resultObjectName = resultContainerName c,+    resultObjectId = resultContainerId c,+    resultObjectTypeId = FiniteQueueId,+    resultObjectSignal = resultContainerSignal c,+    resultObjectSummary = infiniteQueueResultSummary c,+    resultObjectProperties = [+      resultContainerConstProperty c "enqueueStoringStrategy" EnqueueStoringStrategyId IQ.enqueueStoringStrategy,+      resultContainerConstProperty c "dequeueStrategy" DequeueStrategyId IQ.dequeueStrategy,+      resultContainerProperty c "queueNull" QueueNullId IQ.queueNull IQ.queueNullChanged_,+      resultContainerProperty c "queueCount" QueueCountId IQ.queueCount IQ.queueCountChanged_,+      resultContainerProperty c "queueCountStats" QueueCountStatsId IQ.queueCountStats IQ.queueCountChanged_,+      resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId IQ.enqueueStoreCount IQ.enqueueStoreCountChanged_,+      resultContainerProperty c "dequeueCount" DequeueCountId IQ.dequeueCount IQ.dequeueCountChanged_,+      resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId IQ.dequeueExtractCount IQ.dequeueExtractCountChanged_,+      resultContainerIntegProperty c "enqueueStoreRate" EnqueueStoreRateId IQ.enqueueStoreRate,+      resultContainerIntegProperty c "dequeueRate" DequeueRateId IQ.dequeueRate,+      resultContainerIntegProperty c "dequeueExtractRate" DequeueExtractRateId IQ.dequeueExtractRate,+      resultContainerProperty c "queueWaitTime" QueueWaitTimeId IQ.queueWaitTime IQ.queueWaitTimeChanged_,+      resultContainerProperty c "dequeueWaitTime" DequeueWaitTimeId IQ.dequeueWaitTime IQ.dequeueWaitTimeChanged_,+      resultContainerProperty c "queueRate" QueueRateId IQ.queueRate IQ.queueRateChanged_ ] }++-- | Return the summary by the specified infinite queue.+infiniteQueueResultSummary :: (Show sm, Show so)+                              => ResultContainer (IQ.Queue sm qm so qo a)+                              -- ^ the queue container+                              -> ResultSource+infiniteQueueResultSummary c =+  ResultObjectSource $+  ResultObject {+    resultObjectName = resultContainerName c,+    resultObjectId = resultContainerId c,+    resultObjectTypeId = FiniteQueueId,+    resultObjectSignal = resultContainerSignal c,+    resultObjectSummary = infiniteQueueResultSummary c,+    resultObjectProperties = [+      resultContainerProperty c "queueCountStats" QueueCountStatsId IQ.queueCountStats IQ.queueCountChanged_,+      resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId IQ.enqueueStoreCount IQ.enqueueStoreCountChanged_,+      resultContainerProperty c "dequeueCount" DequeueCountId IQ.dequeueCount IQ.dequeueCountChanged_,+      resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId IQ.dequeueExtractCount IQ.dequeueExtractCountChanged_,+      resultContainerProperty c "queueWaitTime" QueueWaitTimeId IQ.queueWaitTime IQ.queueWaitTimeChanged_,+      resultContainerProperty c "queueRate" QueueRateId IQ.queueRate IQ.queueRateChanged_ ] }+  +-- | Return a source by the specified arrival timer.+arrivalTimerResultSource :: ResultContainer ArrivalTimer+                            -- ^ the arrival timer container+                            -> ResultSource+arrivalTimerResultSource c =+  ResultObjectSource $+  ResultObject {+    resultObjectName = resultContainerName c,+    resultObjectId = resultContainerId c,+    resultObjectTypeId = ArrivalTimerId,+    resultObjectSignal = resultContainerSignal c,+    resultObjectSummary = arrivalTimerResultSummary c,+    resultObjectProperties = [+      resultContainerProperty c "processingTime" ArrivalProcessingTimeId arrivalProcessingTime arrivalProcessingTimeChanged_ ] }++-- | Return the summary by the specified arrival timer.+arrivalTimerResultSummary :: ResultContainer ArrivalTimer+                             -- ^ the arrival timer container+                             -> ResultSource+arrivalTimerResultSummary c =+  ResultObjectSource $+  ResultObject {+    resultObjectName = resultContainerName c,+    resultObjectId = resultContainerId c,+    resultObjectTypeId = ArrivalTimerId,+    resultObjectSignal = resultContainerSignal c,+    resultObjectSummary = arrivalTimerResultSummary c,+    resultObjectProperties = [+      resultContainerProperty c "processingTime" ArrivalProcessingTimeId arrivalProcessingTime arrivalProcessingTimeChanged_ ] }++-- | Return a source by the specified server.+serverResultSource :: (Show s, ResultItemable (ResultValue s))+                      => ResultContainer (Server s a b)+                      -- ^ the server container+                      -> ResultSource+serverResultSource c =+  ResultObjectSource $+  ResultObject {+    resultObjectName = resultContainerName c,+    resultObjectId = resultContainerId c,+    resultObjectTypeId = ServerId,+    resultObjectSignal = resultContainerSignal c,+    resultObjectSummary = serverResultSummary c,+    resultObjectProperties = [+      resultContainerConstProperty c "initState" ServerInitStateId serverInitState,+      resultContainerProperty c "state" ServerStateId serverState serverStateChanged_,+      resultContainerProperty c "totalInputWaitTime" ServerTotalInputWaitTimeId serverTotalInputWaitTime serverTotalInputWaitTimeChanged_,+      resultContainerProperty c "totalProcessingTime" ServerTotalProcessingTimeId serverTotalProcessingTime serverTotalProcessingTimeChanged_,+      resultContainerProperty c "totalOutputWaitTime" ServerTotalOutputWaitTimeId serverTotalOutputWaitTime serverTotalOutputWaitTimeChanged_,+      resultContainerProperty c "inputWaitTime" ServerInputWaitTimeId serverInputWaitTime serverInputWaitTimeChanged_,+      resultContainerProperty c "processingTime" ServerProcessingTimeId serverProcessingTime serverProcessingTimeChanged_,+      resultContainerProperty c "outputWaitTime" ServerOutputWaitTimeId serverOutputWaitTime serverOutputWaitTimeChanged_,+      resultContainerProperty c "inputWaitFactor" ServerInputWaitFactorId serverInputWaitFactor serverInputWaitFactorChanged_,+      resultContainerProperty c "processingFactor" ServerProcessingFactorId serverProcessingFactor serverProcessingFactorChanged_,+      resultContainerProperty c "outputWaitFactor" ServerOutputWaitFactorId serverOutputWaitFactor serverOutputWaitFactorChanged_ ] }++-- | Return the summary by the specified server.+serverResultSummary :: ResultContainer (Server s a b)+                       -- ^ the server container+                       -> ResultSource+serverResultSummary c =+  ResultObjectSource $+  ResultObject {+    resultObjectName = resultContainerName c,+    resultObjectId = resultContainerId c,+    resultObjectTypeId = ServerId,+    resultObjectSignal = resultContainerSignal c,+    resultObjectSummary = serverResultSummary c,+    resultObjectProperties = [+      resultContainerProperty c "inputWaitTime" ServerInputWaitTimeId serverInputWaitTime serverInputWaitTimeChanged_,+      resultContainerProperty c "processingTime" ServerProcessingTimeId serverProcessingTime serverProcessingTimeChanged_,+      resultContainerProperty c "outputWaitTime" ServerOutputWaitTimeId serverOutputWaitTime serverOutputWaitTimeChanged_,+      resultContainerProperty c "inputWaitFactor" ServerInputWaitFactorId serverInputWaitFactor serverInputWaitFactorChanged_,+      resultContainerProperty c "processingFactor" ServerProcessingFactorId serverProcessingFactor serverProcessingFactorChanged_,+      resultContainerProperty c "outputWaitFactor" ServerOutputWaitFactorId serverOutputWaitFactor serverOutputWaitFactorChanged_ ] }++-- | Return an arbitrary text as a separator source.+textResultSource :: String -> ResultSource+textResultSource text =+  ResultSeparatorSource $+  ResultSeparator { resultSeparatorText = text }++-- | Return the source of the modeling time.+timeResultSource :: ResultSource+timeResultSource = resultSource' "t" TimeId time+                         +-- | Make an integer subscript+intSubscript :: Int -> ResultName+intSubscript i = "[" ++ show i ++ "]"++instance ResultComputing m => ResultProvider (m Double) where++  resultSource' name i m =+    ResultItemSource $ ResultItem $ computeResultValue name i m++instance ResultComputing m => ResultProvider (m [Double]) where++  resultSource' name i m =+    ResultItemSource $ ResultItem $ computeResultValue name i m++instance ResultComputing m => ResultProvider (m (SamplingStats Double)) where++  resultSource' name i m =+    ResultItemSource $ ResultItem $ computeResultValue name i m++instance ResultComputing m => ResultProvider (m (TimingStats Double)) where++  resultSource' name i m =+    ResultItemSource $ ResultItem $ computeResultValue name i m++instance ResultComputing m => ResultProvider (m Int) where++  resultSource' name i m =+    ResultItemSource $ ResultItem $ computeResultValue name i m++instance ResultComputing m => ResultProvider (m [Int]) where++  resultSource' name i m =+    ResultItemSource $ ResultItem $ computeResultValue name i m++instance ResultComputing m => ResultProvider (m (SamplingStats Int)) where++  resultSource' name i m =+    ResultItemSource $ ResultItem $ computeResultValue name i m++instance ResultComputing m => ResultProvider (m (TimingStats Int)) where++  resultSource' name i m =+    ResultItemSource $ ResultItem $ computeResultValue name i m++instance ResultComputing m => ResultProvider (m String) where++  resultSource' name i m =+    ResultItemSource $ ResultItem $ computeResultValue name i m++instance ResultProvider p => ResultProvider [p] where++  resultSource' name i m =+    resultSource' name i $ ResultListWithSubscript m subscript where+      subscript = map snd $ zip m $ map intSubscript [0..]++instance (Show i, Ix i, ResultProvider p) => ResultProvider (A.Array i p) where++  resultSource' name i m =+    resultSource' name i $ ResultListWithSubscript items subscript where+      items = A.elems m+      subscript = map (\i -> "[" ++ show i ++ "]") (A.indices m)++#ifndef __HASTE__++instance ResultProvider p => ResultProvider (V.Vector p) where+  +  resultSource' name i m =+    resultSource' name i $ ResultVectorWithSubscript m subscript where+      subscript = V.imap (\i x -> intSubscript i) m++#endif++-- | Represents a list with the specified subscript.+data ResultListWithSubscript p =+  ResultListWithSubscript [p] [String]++-- | Represents an array with the specified subscript.+data ResultArrayWithSubscript i p =+  ResultArrayWithSubscript (A.Array i p) (A.Array i String)++#ifndef __HASTE__++-- | Represents a vector with the specified subscript.+data ResultVectorWithSubscript p =+  ResultVectorWithSubscript (V.Vector p) (V.Vector String)++#endif++instance ResultProvider p => ResultProvider (ResultListWithSubscript p) where++  resultSource' name i (ResultListWithSubscript xs ys) =+    ResultVectorSource $+    memoResultVectorSignal $+    memoResultVectorSummary $+    ResultVector { resultVectorName = name,+                   resultVectorId = i,+                   resultVectorItems = axs,+                   resultVectorSubscript = ays,+                   resultVectorSignal = undefined,+                   resultVectorSummary = undefined }+    where+      bnds   = (0, length xs - 1)+      axs    = A.listArray bnds items+      ays    = A.listArray bnds ys+      items  =+        flip map (zip ys xs) $ \(y, x) ->+        let name' = name ++ y+        in resultSource' name' (VectorItemId y) x+      items' = map resultSourceSummary items+    +instance (Show i, Ix i, ResultProvider p) => ResultProvider (ResultArrayWithSubscript i p) where++  resultSource' name i (ResultArrayWithSubscript xs ys) =+    resultSource' name i $ ResultListWithSubscript items subscript where+      items = A.elems xs+      subscript = A.elems ys+      +#ifndef __HASTE__++instance ResultProvider p => ResultProvider (ResultVectorWithSubscript p) where++  resultSource' name i (ResultVectorWithSubscript xs ys) =+    ResultVectorSource $+    memoResultVectorSignal $+    memoResultVectorSummary $+    ResultVector { resultVectorName = name,+                   resultVectorId = i,+                   resultVectorItems = axs,+                   resultVectorSubscript = ays,+                   resultVectorSignal = undefined,+                   resultVectorSummary = undefined }+    where+      bnds   = (0, V.length xs - 1)+      axs    = A.listArray bnds (V.toList items)+      ays    = A.listArray bnds (V.toList ys)+      items =+        V.generate (V.length xs) $ \i ->+        let x = xs V.! i+            y = ys V.! i+            name' = name ++ y+        in resultSource' name' (VectorItemId y) x+      items' = V.map resultSourceSummary items++#endif++instance (Ix i, Show i, ResultComputing m) => ResultProvider (m (A.Array i Double)) where++  resultSource' name i m =+    ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name i m++instance (Ix i, Show i, ResultComputing m) => ResultProvider (m (A.Array i Int)) where++  resultSource' name i m =+    ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name i m++#ifndef __HASTE__++instance ResultComputing m => ResultProvider (m (V.Vector Double)) where++  resultSource' name i m =+    ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name i m++instance ResultComputing m => ResultProvider (m (V.Vector Int)) where++  resultSource' name i m =+    ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name i m++#endif++instance (Show si, Show sm, Show so,+          ResultItemable (ResultValue si),+          ResultItemable (ResultValue sm),+          ResultItemable (ResultValue so))+         => ResultProvider (Q.Queue si qi sm qm so qo a) where++  resultSource' name i m =+    queueResultSource $ ResultContainer name i m (ResultSignal $ Q.queueChanged_ m)++instance (Show sm, Show so,+          ResultItemable (ResultValue sm),+          ResultItemable (ResultValue so))+         => ResultProvider (IQ.Queue sm qm so qo a) where++  resultSource' name i m =+    infiniteQueueResultSource $ ResultContainer name i m (ResultSignal $ IQ.queueChanged_ m)++instance ResultProvider ArrivalTimer where++  resultSource' name i m =+    arrivalTimerResultSource $ ResultContainer name i m (ResultSignal $ arrivalProcessingTimeChanged_ m)++instance (Show s, ResultItemable (ResultValue s)) => ResultProvider (Server s a b) where++  resultSource' name i m =+    serverResultSource $ ResultContainer name i m (ResultSignal $ serverChanged_ m)

@@ -0,0 +1,476 @@++-- |+-- Module     : Simulation.Aivika.Results.IO+-- 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.6.3+--+-- The module allows printing and converting the 'Simulation' 'Results' to a 'String'.+--+module Simulation.Aivika.Results.IO+       (-- * Basic Types+        ResultSourcePrint,+        ResultSourceShowS,+        -- * Printing the Results+        printResultsWithTime,+        printResultsInStartTime,+        printResultsInStopTime,+        printResultsInIntegTimes,+        printResultsInTime,+        printResultsInTimes,+        -- * Simulating and Printing the Results+        printSimulationResultsInStartTime,+        printSimulationResultsInStopTime,+        printSimulationResultsInIntegTimes,+        printSimulationResultsInTime,+        printSimulationResultsInTimes,+        -- * Showing the Results+        showResultsWithTime,+        showResultsInStartTime,+        showResultsInStopTime,+        showResultsInIntegTimes,+        showResultsInTime,+        showResultsInTimes,+        -- * Simulating and Showing the Results+        showSimulationResultsInStartTime,+        showSimulationResultsInStopTime,+        showSimulationResultsInIntegTimes,+        showSimulationResultsInTime,+        showSimulationResultsInTimes,+        -- * Printing the Result Source+        hPrintResultSourceIndented,+        hPrintResultSource,+        hPrintResultSourceInRussian,+        hPrintResultSourceInEnglish,+        printResultSourceIndented,+        printResultSource,+        printResultSourceInRussian,+        printResultSourceInEnglish,+        -- * Showing the Result Source+        showResultSourceIndented,+        showResultSource,+        showResultSourceInRussian,+        showResultSourceInEnglish) where++import Control.Monad+import Control.Monad.Trans++import qualified Data.Map as M+import qualified Data.Array as A++import System.IO++import Simulation.Aivika.Specs+import Simulation.Aivika.Simulation+import Simulation.Aivika.Dynamics+import Simulation.Aivika.Event+import Simulation.Aivika.Results+import Simulation.Aivika.Results.Locale++-- | This is a function that shows the simulation results within+-- the 'Event' computation synchronized with the event queue.+type ResultSourceShowS = ResultSource -> Event ShowS++-- | This is a function that prints the simulation results within+-- the 'Event' computation synchronized with the event queue.+type ResultSourcePrint = ResultSource -> Event ()++-- | Print a localised text representation of the results by the specified source+-- and with the given indent.+hPrintResultSourceIndented :: Handle+                              -- ^ a handle+                              -> Int+                              -- ^ an indent+                              -> ResultLocalisation+                              -- ^ a localisation+                              -> ResultSourcePrint+hPrintResultSourceIndented h indent loc source@(ResultItemSource (ResultItem x)) =+  hPrintResultSourceIndentedLabelled h indent (resultItemName x) loc source+hPrintResultSourceIndented h indent loc source@(ResultVectorSource x) =+  hPrintResultSourceIndentedLabelled h indent (resultVectorName x) loc source+hPrintResultSourceIndented h indent loc source@(ResultObjectSource x) =+  hPrintResultSourceIndentedLabelled h indent (resultObjectName x) loc source+hPrintResultSourceIndented h indent loc source@(ResultSeparatorSource x) =+  hPrintResultSourceIndentedLabelled h indent (resultSeparatorText x) loc source++-- | Print an indented and labelled text representation of the results by+-- the specified source.+hPrintResultSourceIndentedLabelled :: Handle+                                      -- ^ a handle+                                      -> Int+                                      -- ^ an indent+                                      -> ResultName+                                      -- ^ a label+                                      -> ResultLocalisation+                                      -- ^ 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"+hPrintResultSourceIndentedLabelled h indent label loc (ResultVectorSource x) =+  do let tab = replicate indent ' '+     liftIO $+       do hPutStr h tab+          hPutStr h "-- "+          hPutStr h (loc $ resultVectorId x)+          hPutStrLn h ""+          hPutStr h tab+          hPutStr h label+          hPutStrLn h ":"+          hPutStrLn h ""+     let items = A.elems (resultVectorItems x)+         subscript = A.elems (resultVectorSubscript x)+     forM_ (zip items subscript) $ \(i, s) ->+       hPrintResultSourceIndentedLabelled h (indent + 2) (label ++ s) loc i+hPrintResultSourceIndentedLabelled h indent label loc (ResultObjectSource x) =+  do let tab = replicate indent ' '+     liftIO $+       do hPutStr h tab+          hPutStr h "-- "+          hPutStr h (loc $ resultObjectId x)+          hPutStrLn h ""+          hPutStr h tab+          hPutStr h label+          hPutStrLn h ":"+          hPutStrLn h ""+     forM_ (resultObjectProperties x) $ \p ->+       do let indent' = 2 + indent+              tab'    = "  " ++ tab+              label'  = resultPropertyLabel p+              source' = resultPropertySource p+          hPrintResultSourceIndentedLabelled h indent' label' loc source'+hPrintResultSourceIndentedLabelled h indent label loc (ResultSeparatorSource x) =+  do let tab = replicate indent ' '+     liftIO $+       do hPutStr h tab+          hPutStr h label+          hPutStrLn h ""+          hPutStrLn h ""++-- | Print a localised text representation of the results by the specified source+-- and with the given indent.+printResultSourceIndented :: Int+                             -- ^ an indent+                             -> ResultLocalisation+                             -- ^ a localisation+                             -> ResultSourcePrint+printResultSourceIndented = hPrintResultSourceIndented stdout++-- | Print a localised text representation of the results by the specified source.+hPrintResultSource :: Handle+                      -- ^ a handle+                      -> ResultLocalisation+                      -- ^ a localisation+                      -> ResultSourcePrint+hPrintResultSource h = hPrintResultSourceIndented h 0++-- | Print a localised text representation of the results by the specified source.+printResultSource :: ResultLocalisation+                     -- ^ a localisation+                     -> ResultSourcePrint+printResultSource = hPrintResultSource stdout++-- | Print in Russian a text representation of the results by the specified source.+hPrintResultSourceInRussian :: Handle -> ResultSourcePrint+hPrintResultSourceInRussian h = hPrintResultSource h russianResultLocalisation++-- | Print in English a text representation of the results by the specified source.+hPrintResultSourceInEnglish :: Handle -> ResultSourcePrint+hPrintResultSourceInEnglish h = hPrintResultSource h englishResultLocalisation++-- | Print in Russian a text representation of the results by the specified source.+printResultSourceInRussian :: ResultSourcePrint+printResultSourceInRussian = hPrintResultSourceInRussian stdout++-- | Print in English a text representation of the results by the specified source.+printResultSourceInEnglish :: ResultSourcePrint+printResultSourceInEnglish = hPrintResultSourceInEnglish stdout++-- | Show a localised text representation of the results by the specified source+-- and with the given indent.+showResultSourceIndented :: Int+                            -- ^ an indent+                            -> ResultLocalisation+                            -- ^ a localisation+                            -> ResultSourceShowS+showResultSourceIndented indent loc source@(ResultItemSource (ResultItem x)) =+  showResultSourceIndentedLabelled indent (resultItemName x) loc source+showResultSourceIndented indent loc source@(ResultVectorSource x) =+  showResultSourceIndentedLabelled indent (resultVectorName x) loc source+showResultSourceIndented indent loc source@(ResultObjectSource x) =+  showResultSourceIndentedLabelled indent (resultObjectName x) loc source+showResultSourceIndented indent loc source@(ResultSeparatorSource x) =+  showResultSourceIndentedLabelled indent (resultSeparatorText x) loc source++-- | Show an indented and labelled text representation of the results by the specified source.+showResultSourceIndentedLabelled :: Int+                                   -- ^ an indent+                                   -> String+                                   -- ^ a label+                                   -> ResultLocalisation+                                   -- ^ 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"+showResultSourceIndentedLabelled indent label loc (ResultVectorSource x) =+  do let tab = replicate indent ' '+         items = A.elems (resultVectorItems x)+         subscript = A.elems (resultVectorSubscript x)+     contents <-+       forM (zip items subscript) $ \(i, s) ->+       showResultSourceIndentedLabelled (indent + 2) (label ++ s) loc i+     let showContents = foldr (.) id contents+     return $+       showString tab .+       showString "-- " .+       showString (loc $ resultVectorId x) .+       showString "\n" .+       showString tab .+       showString label .+       showString ":\n\n" .+       showContents+showResultSourceIndentedLabelled indent label loc (ResultObjectSource x) =+  do let tab = replicate indent ' '+     contents <-+       forM (resultObjectProperties x) $ \p ->+       do let indent' = 2 + indent+              tab'    = "  " ++ tab+              label'  = resultPropertyLabel p+              output' = resultPropertySource p+          showResultSourceIndentedLabelled indent' label' loc output'+     let showContents = foldr (.) id contents+     return $+       showString tab .+       showString "-- " .+       showString (loc $ resultObjectId x) .+       showString "\n" .+       showString tab .+       showString label .+       showString ":\n\n" .+       showContents+showResultSourceIndentedLabelled indent label loc (ResultSeparatorSource x) =+  do let tab = replicate indent ' '+     return $+       showString tab .+       showString label .+       showString "\n\n"++-- | Show a localised text representation of the results by the specified source.+showResultSource :: ResultLocalisation+                    -- ^ a localisation+                    -> ResultSourceShowS+showResultSource = showResultSourceIndented 0++-- | Show in Russian a text representation of the results by the specified source.+showResultSourceInRussian :: ResultSourceShowS+showResultSourceInRussian = showResultSource russianResultLocalisation++-- | Show in English a text representation of the results by the specified source.+showResultSourceInEnglish :: ResultSourceShowS+showResultSourceInEnglish = showResultSource englishResultLocalisation++-- | Print the results with the information about the modeling time.+printResultsWithTime :: ResultSourcePrint -> Results -> Event ()+printResultsWithTime print results =+  do let x1 = textResultSource "----------"+         x2 = timeResultSource+         x3 = textResultSource ""+         xs = resultSourceList results+     print x1+     print x2+     -- print x3+     mapM_ print xs+     -- print x3++-- | Print the simulation results in start time.+printResultsInStartTime :: ResultSourcePrint -> Results -> Simulation ()+printResultsInStartTime print results =+  runEventInStartTime $ printResultsWithTime print results++-- | Print the simulation results in stop time.+printResultsInStopTime :: ResultSourcePrint -> Results -> Simulation ()+printResultsInStopTime print results =+  runEventInStopTime $ printResultsWithTime print results++-- | Print the simulation results in the integration time points.+printResultsInIntegTimes :: ResultSourcePrint -> Results -> Simulation ()+printResultsInIntegTimes print results =+  do let loop (m : ms) = m >> loop ms+         loop [] = return ()+     ms <- runDynamicsInIntegTimes $ runEvent $+           printResultsWithTime print results+     liftIO $ loop ms++-- | Print the simulation results in the specified time.+printResultsInTime :: Double -> ResultSourcePrint -> Results -> Simulation ()+printResultsInTime t print results =+  runDynamicsInTime t $ runEvent $+  printResultsWithTime print results++-- | Print the simulation results in the specified time points.+printResultsInTimes :: [Double] -> ResultSourcePrint -> Results -> Simulation ()+printResultsInTimes ts print results =+  do let loop (m : ms) = m >> loop ms+         loop [] = return ()+     ms <- runDynamicsInTimes ts $ runEvent $+           printResultsWithTime print results+     liftIO $ loop ms++-- | Show the results with the information about the modeling time.+showResultsWithTime :: ResultSourceShowS -> Results -> Event ShowS+showResultsWithTime f results =+  do let x1 = textResultSource "----------"+         x2 = timeResultSource+         x3 = textResultSource ""+         xs = resultSourceList results+     y1 <- f x1+     y2 <- f x2+     y3 <- f x3+     ys <- forM xs f+     return $+       y1 .+       y2 .+       -- y3 .+       foldr (.) id ys+       -- y3++-- | Show the simulation results in start time.+showResultsInStartTime :: ResultSourceShowS -> Results -> Simulation ShowS+showResultsInStartTime f results =+  runEventInStartTime $ showResultsWithTime f results++-- | Show the simulation results in stop time.+showResultsInStopTime :: ResultSourceShowS -> Results -> Simulation ShowS+showResultsInStopTime f results =+  runEventInStopTime $ showResultsWithTime f results++-- | Show the simulation results in the integration time points.+--+-- It may consume much memory, for we have to traverse all the integration+-- points to create the resulting function within the 'Simulation' computation.+showResultsInIntegTimes :: ResultSourceShowS -> Results -> Simulation ShowS+showResultsInIntegTimes f results =+  do let loop (m : ms) = return (.) `ap` m `ap` loop ms+         loop [] = return id+     ms <- runDynamicsInIntegTimes $ runEvent $+           showResultsWithTime f results+     liftIO $ loop ms++-- | Show the simulation results in the specified time point.+showResultsInTime :: Double -> ResultSourceShowS -> Results -> Simulation ShowS+showResultsInTime t f results =+  runDynamicsInTime t $ runEvent $+  showResultsWithTime f results++-- | Show the simulation results in the specified time points.+--+-- It may consume much memory, for we have to traverse all the specified+-- points to create the resulting function within the 'Simulation' computation.+showResultsInTimes :: [Double] -> ResultSourceShowS -> Results -> Simulation ShowS+showResultsInTimes ts f results =+  do let loop (m : ms) = return (.) `ap` m `ap` loop ms+         loop [] = return id+     ms <- runDynamicsInTimes ts $ runEvent $+           showResultsWithTime f results+     liftIO $ loop ms++-- | Run the simulation and then print the results in the start time.+printSimulationResultsInStartTime :: ResultSourcePrint -> Simulation Results -> Specs -> IO ()+printSimulationResultsInStartTime print model specs =+  flip runSimulation specs $+  model >>= printResultsInStartTime print++-- | Run the simulation and then print the results in the final time.+printSimulationResultsInStopTime :: ResultSourcePrint -> Simulation Results -> Specs -> IO ()+printSimulationResultsInStopTime print model specs =+  flip runSimulation specs $+  model >>= printResultsInStopTime print++-- | Run the simulation and then print the results in the integration time points.+printSimulationResultsInIntegTimes :: ResultSourcePrint -> Simulation Results -> Specs -> IO ()+printSimulationResultsInIntegTimes print model specs =+  flip runSimulation specs $+  model >>= printResultsInIntegTimes print++-- | Run the simulation and then print the results in the specified time point.+printSimulationResultsInTime :: Double -> ResultSourcePrint -> Simulation Results -> Specs -> IO ()+printSimulationResultsInTime t print model specs =+  flip runSimulation specs $+  model >>= printResultsInTime t print++-- | Run the simulation and then print the results in the specified time points.+printSimulationResultsInTimes :: [Double] -> ResultSourcePrint -> Simulation Results -> Specs -> IO ()+printSimulationResultsInTimes ts print model specs =+  flip runSimulation specs $+  model >>= printResultsInTimes ts print++-- | Run the simulation and then show the results in the start time.+showSimulationResultsInStartTime :: ResultSourceShowS -> Simulation Results -> Specs -> IO ShowS+showSimulationResultsInStartTime f model specs =+  flip runSimulation specs $+  model >>= showResultsInStartTime f++-- | Run the simulation and then show the results in the final time.+showSimulationResultsInStopTime :: ResultSourceShowS -> Simulation Results -> Specs -> IO ShowS+showSimulationResultsInStopTime f model specs =+  flip runSimulation specs $+  model >>= showResultsInStopTime f++-- | Run the simulation and then show the results in the integration time points.+--+-- It may consume much memory, for we have to traverse all the integration+-- points to create the resulting function within the 'IO' computation.+showSimulationResultsInIntegTimes :: ResultSourceShowS -> Simulation Results -> Specs -> IO ShowS+showSimulationResultsInIntegTimes f model specs =+  flip runSimulation specs $+  model >>= showResultsInIntegTimes f++-- | Run the simulation and then show the results in the integration time point.+showSimulationResultsInTime :: Double -> ResultSourceShowS -> Simulation Results -> Specs -> IO ShowS+showSimulationResultsInTime t f model specs =+  flip runSimulation specs $+  model >>= showResultsInTime t f++-- | Run the simulation and then show the results in the specified time points.+--+-- It may consume much memory, for we have to traverse all the specified+-- points to create the resulting function within the 'IO' computation.+showSimulationResultsInTimes :: [Double] -> ResultSourceShowS -> Simulation Results -> Specs -> IO ShowS+showSimulationResultsInTimes ts f model specs =+  flip runSimulation specs $+  model >>= showResultsInTimes ts f

@@ -0,0 +1,339 @@++-- |+-- Module     : Simulation.Aivika.Results.Locale+-- 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.6.3+--+-- The module defines locales for outputting and printing the simulation results.+--+module Simulation.Aivika.Results.Locale+       (-- * Basic Types+        ResultLocale,+        ResultLocalisation,+        ResultDescription,+        -- * Locale Codes+        russianResultLocale,+        englishResultLocale,+        -- * Localisations+        lookupResultLocalisation,+        russianResultLocalisation,+        englishResultLocalisation,+        -- * Unique Identifiers+        ResultId(..)) where++import qualified Data.Map as M++import Simulation.Aivika.Dynamics+import Simulation.Aivika.Statistics+import Simulation.Aivika.Statistics.Accumulator+import qualified Simulation.Aivika.Queue as Q+import qualified Simulation.Aivika.Queue.Infinite as IQ+import Simulation.Aivika.Arrival+import Simulation.Aivika.Server++-- | A locale to output the simulation results.+--+-- Examples are: @\"ru\", @\"en\" etc.+type ResultLocale = String++-- | It localises the description of simulation results.+type ResultLocalisation = ResultId -> ResultDescription++-- | A description used for describing the results when generating output.+type ResultDescription = String++-- | The result entity identifier.+data ResultId = TimeId+                -- ^ A 'time' computation.+              | VectorId+                -- ^ Describes a vector.+              | VectorItemId String+                -- ^ Describes a vector item with the specified subscript.+              | SamplingStatsId+                -- ^ A 'SamplingStats' value.+              | SamplingStatsCountId+                -- ^ Property 'samplingStatsCount'.+              | SamplingStatsMinId+                -- ^ Property 'samplingStatsMin'.+              | SamplingStatsMaxId+                -- ^ Property 'samplingStatsMax'.+              | SamplingStatsMeanId+                -- ^ Property 'samplingStatsMean'.+              | SamplingStatsMean2Id+                -- ^ Property 'samplingStatsMean2'.+              | SamplingStatsVarianceId+                -- ^ Property 'samplingStatsVariance'.+              | SamplingStatsDeviationId+                -- ^ Property 'samplingStatsDeviation'.+              | TimingStatsId+                -- ^ A 'TimingStats' value.+              | TimingStatsCountId+                -- ^ Property 'timingStatsCount'.+              | TimingStatsMinId+                -- ^ Property 'timingStatsMin'.+              | TimingStatsMaxId+                -- ^ Property 'timingStatsMax'.+              | TimingStatsMeanId+                -- ^ Property 'timingStatsMean'.+              | TimingStatsVarianceId+                -- ^ Property 'timingStatsVariance'.+              | TimingStatsDeviationId+                -- ^ Property 'timingStatsDeviation'.+              | TimingStatsMinTimeId+                -- ^ Property 'timingStatsMinTime'.+              | TimingStatsMaxTimeId+                -- ^ Property 'timingStatsMaxTime'.+              | TimingStatsStartTimeId+                -- ^ Property 'timingStatsStartTime'.+              | TimingStatsLastTimeId+                -- ^ Property 'timingStatsLastTime'.+              | TimingStatsSumId+                -- ^ Property 'timingStatsSum'.+              | TimingStatsSum2Id+                -- ^ Property 'timingStatsSum2'.+              | FiniteQueueId+                -- ^ A finite 'Q.Queue'.+              | InfiniteQueueId+                -- ^ An infinite 'IQ.Queue'.+              | EnqueueStrategyId+                -- ^ Property 'Q.enqueueStrategy'.+              | EnqueueStoringStrategyId+                -- ^ Property 'Q.enqueueStoringStrategy'.+              | DequeueStrategyId+                -- ^ Property 'Q.dequeueStrategy'.+              | QueueNullId+                -- ^ Property 'Q.queueNull'.+              | QueueFullId+                -- ^ Property 'Q.queueFull'.+              | QueueMaxCountId+                -- ^ Property 'Q.queueMaxCount'.+              | QueueCountId+                -- ^ Property 'Q.queueCount'.+              | QueueCountStatsId+                -- ^ Property 'Q.queueCountStats'.+              | EnqueueCountId+                -- ^ Property 'Q.enqueueCount'.+              | EnqueueLostCountId+                -- ^ Property 'Q.enqueueLostCount'.+              | EnqueueStoreCountId+                -- ^ Property 'Q.enqueueStoreCount'.+              | DequeueCountId+                -- ^ Property 'Q.dequeueCount'.+              | DequeueExtractCountId+                -- ^ Property 'Q.dequeueExtractCount'.+              | QueueLoadFactorId+                -- ^ Property 'Q.queueLoadFactor'.+              | EnqueueRateId+                -- ^ Property 'Q.enqueueRate'.+              | EnqueueStoreRateId+                -- ^ Property 'Q.enqueueStoreRate'.+              | DequeueRateId+                -- ^ Property 'Q.dequeueRate'.+              | DequeueExtractRateId+                -- ^ Property 'Q.dequeueExtractRate'.+              | QueueWaitTimeId+                -- ^ Property 'Q.queueWaitTime'.+              | QueueTotalWaitTimeId+                -- ^ Property 'Q.queueTotalWaitTime'.+              | EnqueueWaitTimeId+                -- ^ Property 'Q.enqueueWaitTime'.+              | DequeueWaitTimeId+                -- ^ Property 'Q.dequeueWaitTime'.+              | QueueRateId+                -- ^ Property 'Q.queueRate'.+              | ArrivalTimerId+                -- ^ An 'ArrivalTimer'.+              | ArrivalProcessingTimeId+                -- ^ Property 'arrivalProcessingTime'.+              | ServerId+                -- ^ Represents a 'Server'.+              | ServerInitStateId+                -- ^ Property 'serverInitState'.+              | ServerStateId+                -- ^ Property 'serverState'.+              | ServerTotalInputWaitTimeId+                -- ^ Property 'serverTotalInputWaitTime'.+              | ServerTotalProcessingTimeId+                -- ^ Property 'serverTotalProcessingTime'.+              | ServerTotalOutputWaitTimeId+                -- ^ Property 'serverTotalOutputWaitTime'.+              | ServerInputWaitTimeId+                -- ^ Property 'serverInputWaitTime'.+              | ServerProcessingTimeId+                -- ^ Property 'serverProcessingTime'.+              | ServerOutputWaitTimeId+                -- ^ Property 'serverOutputWaitTime'.+              | ServerInputWaitFactorId+                -- ^ Property 'serverInputWaitFactor'.+              | ServerProcessingFactorId+                -- ^ Property 'serverProcessingFactor'.+              | ServerOutputWaitFactorId+                -- ^ Property 'serverOutputWaitFactor'.+              | UserDefinedResultId ResultDescription+                -- ^ An user defined description.+              | LocalisedResultId (M.Map ResultLocale ResultDescription)+                -- ^ A localised property or object name.++-- | The Russian locale.+russianResultLocale :: ResultLocale+russianResultLocale = "ru"++-- | The English locale.+englishResultLocale :: ResultLocale+englishResultLocale = "en"++-- | The Russian localisation of the simulation results.+russianResultLocalisation :: ResultLocalisation+russianResultLocalisation TimeId = "модельное время"+russianResultLocalisation VectorId = "вектор"+russianResultLocalisation (VectorItemId x) = "элемент с индексом " ++ x+russianResultLocalisation SamplingStatsId = "сводная статистика"+russianResultLocalisation SamplingStatsCountId = "количество"+russianResultLocalisation SamplingStatsMinId = "минимальное значение"+russianResultLocalisation SamplingStatsMaxId = "максимальное значение"+russianResultLocalisation SamplingStatsMeanId = "среднее значение"+russianResultLocalisation SamplingStatsMean2Id = "среднее квадратов"+russianResultLocalisation SamplingStatsVarianceId = "дисперсия"+russianResultLocalisation SamplingStatsDeviationId = "среднеквадратическое отклонение"+russianResultLocalisation TimingStatsId = "временная статистика"+russianResultLocalisation TimingStatsCountId = "количество"+russianResultLocalisation TimingStatsMinId = "минимальное значение"+russianResultLocalisation TimingStatsMaxId = "максимальное значение"+russianResultLocalisation TimingStatsMeanId = "среднее значение"+russianResultLocalisation TimingStatsVarianceId = "дисперсия"+russianResultLocalisation TimingStatsDeviationId = "среднеквадратическое отклонение"+russianResultLocalisation TimingStatsMinTimeId = "время достижения минимума"+russianResultLocalisation TimingStatsMaxTimeId = "время достижения максимума"+russianResultLocalisation TimingStatsStartTimeId = "начальное время сбора статистики"+russianResultLocalisation TimingStatsLastTimeId = "конечное время сбора статистики"+russianResultLocalisation TimingStatsSumId = "сумма"+russianResultLocalisation TimingStatsSum2Id = "сумма квадратов"+russianResultLocalisation FiniteQueueId = "конечная очередь"+russianResultLocalisation InfiniteQueueId = "бесконечная очередь"+russianResultLocalisation EnqueueStrategyId = "стратегия добавления элементов"+russianResultLocalisation EnqueueStoringStrategyId = "стратегия хранения элементов"+russianResultLocalisation DequeueStrategyId = "стратегия извлечения элементов"+russianResultLocalisation QueueNullId = "очередь пуста?"+russianResultLocalisation QueueFullId = "очередь заполнена?"+russianResultLocalisation QueueMaxCountId = "емкость очереди"+russianResultLocalisation QueueCountId = "текущий размер очереди"+russianResultLocalisation QueueCountStatsId = "статистика по размеру очереди"+russianResultLocalisation EnqueueCountId = "общее количество попыток добавить элементы"+russianResultLocalisation EnqueueLostCountId = "общее количество неудачных попыток добавить элементы"+russianResultLocalisation EnqueueStoreCountId = "общее количество сохраненных элементов"+russianResultLocalisation DequeueCountId = "общее количество запросов на извлечение элементов"+russianResultLocalisation DequeueExtractCountId = "общее количество извлеченных элементов"+russianResultLocalisation QueueLoadFactorId = "коэфф. загрузки (размер, поделенный на емкость)"+russianResultLocalisation EnqueueRateId = "количество попыток добавить на ед. времени"+russianResultLocalisation EnqueueStoreRateId = "количество сохраненных на ед. времени"+russianResultLocalisation DequeueRateId = "количество запросов на извлечение в ед. времени"+russianResultLocalisation DequeueExtractRateId = "количество извлеченных на ед. времени"+russianResultLocalisation QueueWaitTimeId = "время ожидания (сохранили -> извлекли)"+russianResultLocalisation QueueTotalWaitTimeId = "общее время ожидания (попытались добавить -> извлекли)"+russianResultLocalisation EnqueueWaitTimeId = "время ожидания добавления (попытались добавить -> сохранили)"+russianResultLocalisation DequeueWaitTimeId = "время ожидания извлечения (запросили извлечь -> извлекли)"+russianResultLocalisation QueueRateId = "усредненная скорость (как средняя длина очереди на среднее время ожидания)"+russianResultLocalisation ArrivalTimerId = "как долго обрабатываются заявки?"+russianResultLocalisation ArrivalProcessingTimeId = "время обработки заявки"+russianResultLocalisation ServerId = "сервер"+russianResultLocalisation ServerInitStateId = "начальное состояние"+russianResultLocalisation ServerStateId = "текущее состояние"+russianResultLocalisation ServerTotalInputWaitTimeId = "общее время блокировки в ожидании ввода"+russianResultLocalisation ServerTotalProcessingTimeId = "общее время, потраченное на саму обработку заданий"+russianResultLocalisation ServerTotalOutputWaitTimeId = "общее время блокировки при попытке доставить вывод"+russianResultLocalisation ServerInputWaitTimeId = "время блокировки в ожидании ввода"+russianResultLocalisation ServerProcessingTimeId = "время, потраченное на саму обработку заданий"+russianResultLocalisation ServerOutputWaitTimeId = "время блокировки при попытке доставить вывод"+russianResultLocalisation ServerInputWaitFactorId = "относительное время блокировки в ожидании ввода (от 0 до 1)"+russianResultLocalisation ServerProcessingFactorId = "относительное время, потраченное на саму обработку заданий (от 0 до 1)"+russianResultLocalisation ServerOutputWaitFactorId = "относительное время блокировки при попытке доставить вывод (от 0 до 1)"+russianResultLocalisation (UserDefinedResultId m) = m+russianResultLocalisation x@(LocalisedResultId m) =+  lookupResultLocalisation russianResultLocale x++-- | The English localisation of the simulation results.+englishResultLocalisation :: ResultLocalisation+englishResultLocalisation TimeId = "simulation time"+englishResultLocalisation VectorId = "vector"+englishResultLocalisation (VectorItemId x) = "item #" ++ x+englishResultLocalisation SamplingStatsId = "statistics summary"+englishResultLocalisation SamplingStatsCountId = "count"+englishResultLocalisation SamplingStatsMinId = "minimum"+englishResultLocalisation SamplingStatsMaxId = "maximum"+englishResultLocalisation SamplingStatsMeanId = "mean"+englishResultLocalisation SamplingStatsMean2Id = "mean square"+englishResultLocalisation SamplingStatsVarianceId = "variance"+englishResultLocalisation SamplingStatsDeviationId = "deviation"+englishResultLocalisation TimingStatsId = "timing statistics"+englishResultLocalisation TimingStatsCountId = "count"+englishResultLocalisation TimingStatsMinId = "minimum"+englishResultLocalisation TimingStatsMaxId = "maximum"+englishResultLocalisation TimingStatsMeanId = "mean"+englishResultLocalisation TimingStatsVarianceId = "variance"+englishResultLocalisation TimingStatsDeviationId = "deviation"+englishResultLocalisation TimingStatsMinTimeId = "the time of minimum"+englishResultLocalisation TimingStatsMaxTimeId = "the time of maximum"+englishResultLocalisation TimingStatsStartTimeId = "the start time"+englishResultLocalisation TimingStatsLastTimeId = "the last time"+englishResultLocalisation TimingStatsSumId = "sum"+englishResultLocalisation TimingStatsSum2Id = "sum square"+englishResultLocalisation FiniteQueueId = "the finite queue"+englishResultLocalisation InfiniteQueueId = "the infinite queue"+englishResultLocalisation EnqueueStrategyId = "the enqueueing strategy"+englishResultLocalisation EnqueueStoringStrategyId = "the storing strategy"+englishResultLocalisation DequeueStrategyId = "the dequeueing strategy"+englishResultLocalisation QueueNullId = "is the queue empty?"+englishResultLocalisation QueueFullId = "is the queue full?"+englishResultLocalisation QueueMaxCountId = "the queue capacity"+englishResultLocalisation QueueCountId = "the current queue size"+englishResultLocalisation QueueCountStatsId = "the queue size statistics"+englishResultLocalisation EnqueueCountId = "a total number of attempts to enqueue the items"+englishResultLocalisation EnqueueLostCountId = "a total number of the lost items when trying to enqueue"+englishResultLocalisation EnqueueStoreCountId = "a total number of the stored items"+englishResultLocalisation DequeueCountId = "a total number of requests for dequeueing"+englishResultLocalisation DequeueExtractCountId = "a total number of the dequeued items"+englishResultLocalisation QueueLoadFactorId = "the queue load (its size divided by its capacity)"+englishResultLocalisation EnqueueRateId = "how many attempts to enqueue per time?"+englishResultLocalisation EnqueueStoreRateId = "how many items were stored per time?"+englishResultLocalisation DequeueRateId = "how many requests for dequeueing per time?"+englishResultLocalisation DequeueExtractRateId = "how many items were dequeued per time?"+englishResultLocalisation QueueWaitTimeId = "the wait time (stored -> dequeued)"+englishResultLocalisation QueueTotalWaitTimeId = "the total wait time (tried to enqueue -> dequeued)"+englishResultLocalisation EnqueueWaitTimeId = "the enqueue wait time (tried to enqueue -> stored)"+englishResultLocalisation DequeueWaitTimeId = "the dequeue wait time (requested for dequeueing -> dequeued)"+englishResultLocalisation QueueRateId = "the average queue rate (= queue size / wait time)"+englishResultLocalisation ArrivalTimerId = "how long the arrivals are processed?"+englishResultLocalisation ArrivalProcessingTimeId = "the processing time of arrivals"+englishResultLocalisation ServerId = "the server"+englishResultLocalisation ServerInitStateId = "the initial state"+englishResultLocalisation ServerStateId = "the current state"+englishResultLocalisation ServerTotalInputWaitTimeId = "the total time spent while waiting for input"+englishResultLocalisation ServerTotalProcessingTimeId = "the total time spent on actual processing the tasks"+englishResultLocalisation ServerTotalOutputWaitTimeId = "the total time spent on delivering the output"+englishResultLocalisation ServerInputWaitTimeId = "the time spent while waiting for input"+englishResultLocalisation ServerProcessingTimeId = "the time spent on processing the tasks"+englishResultLocalisation ServerOutputWaitTimeId = "the time spent on delivering the output"+englishResultLocalisation ServerInputWaitFactorId = "the relative time spent while waiting for input (from 0 to 1)"+englishResultLocalisation ServerProcessingFactorId = "the relative time spent on processing the tasks (from 0 to 1)"+englishResultLocalisation ServerOutputWaitFactorId = "the relative time spent on delivering the output (from 0 to 1)"+englishResultLocalisation (UserDefinedResultId m) = m+englishResultLocalisation x@(LocalisedResultId m) =+  lookupResultLocalisation englishResultLocale x++-- | Lookup a localisation by the specified locale.+lookupResultLocalisation :: ResultLocale -> ResultLocalisation+lookupResultLocalisation loc (UserDefinedResultId m) = m+lookupResultLocalisation loc (LocalisedResultId m) =+  case M.lookup loc m of+    Just x -> x+    Nothing ->+      case M.lookup russianResultLocale m of+        Just x -> x+        Nothing ->+          case M.lookup englishResultLocale m of+            Just x -> x+            Nothing -> ""+lookupResultLocalisation loc resultId = russianResultLocalisation resultId

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- It models the server that prodives a service. module Simulation.Aivika.Server

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- 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 

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- The module defines the 'Simulation' monad that represents a simulation run. -- 

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- It defines the simulation specs and functions for this data type. module Simulation.Aivika.Specs

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- Represents statistics. --@@ -14,6 +14,7 @@        (-- * Simple Statistics         SamplingStats(..),         SamplingData(..),+        combineSamplingStatsEither,         samplingStatsVariance,         samplingStatsDeviation,         samplingStatsSummary,@@ -156,6 +157,11 @@         k1     = n1 / n         k2     = n2 / n +-- | If allows combining statistics more efficiently if we know that the first argument can be a scalar.+combineSamplingStatsEither :: SamplingData a => Either a (SamplingStats a) -> SamplingStats a -> SamplingStats a+combineSamplingStatsEither (Left a) stats2 = addSamplingStats a stats2+combineSamplingStatsEither (Right stats1) stats2 = combineSamplingStats stats1 stats2+ -- | Return the variance. samplingStatsVariance :: SamplingStats a -> Double samplingStatsVariance stats@@ -187,11 +193,12 @@ -- | Show the summary of the statistics.        showSamplingStats :: (Show a) => SamplingStats a -> ShowS showSamplingStats stats =-  showString "count = " . shows (samplingStatsCount stats) . +  showString "{ count = " . shows (samplingStatsCount stats) .    showString ", mean = " . shows (samplingStatsMean stats) .    showString ", std = " . shows (samplingStatsDeviation stats) .    showString ", min = " . shows (samplingStatsMin stats) . -  showString ", max = " . shows (samplingStatsMax stats)+  showString ", max = " . shows (samplingStatsMax stats) .+  showString " }"  instance Show a => Show (SamplingStats a) where   showsPrec prec = showSamplingStats@@ -369,7 +376,7 @@ -- | Show the summary of the statistics.        showTimingStats :: (Show a, TimingData a) => TimingStats a -> ShowS showTimingStats stats =-  showString "count = " . shows (timingStatsCount stats) . +  showString "{ count = " . shows (timingStatsCount stats) .    showString ", mean = " . shows (timingStatsMean stats) .    showString ", std = " . shows (timingStatsDeviation stats) .    showString ", min = " . shows (timingStatsMin stats) . @@ -378,7 +385,7 @@   showString " (t = " . shows (timingStatsMaxTime stats) .   showString "), t in [" . shows (timingStatsStartTime stats) .   showString ", " . shows (timingStatsLastTime stats) .-  showString "]"+  showString "] }"  instance (Show a, TimingData a) => Show (TimingStats a) where   showsPrec prec = showTimingStats

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- The infinite stream of data in time. --@@ -25,8 +25,9 @@         splitStreamPrioritising,         -- * Specifying Identifier         streamUsingId,-        -- * Prefetching Stream+        -- * Prefetching and Delaying Stream         prefetchStream,+        delayStream,         -- * Stream Arriving         arrivalStream,         -- * Memoizing, Zipping and Uzipping Stream@@ -494,11 +495,11 @@ -- Cancel the stream's process to unsubscribe from the specified signal. signalStream :: Signal a -> Process (Stream a) signalStream s =-  do q <- liftSimulation newFCFSQueue+  do q <- liftEvent newFCFSQueue      h <- liftEvent $           handleSignal s $            enqueue q-     whenCancellingProcess h+     whenCancellingProcess $ disposeEvent h      return $ repeatProcess $ dequeue q  -- | Return a computation of the signal that triggers values from the specified stream,@@ -517,12 +518,17 @@ -- saving the information about the time points at which the original stream items  -- were received by demand. arrivalStream :: Stream a -> Stream (Arrival a)-arrivalStream s = Cons z where-  z = do t <- liftDynamics time-         loop s t+arrivalStream s = Cons $ loop s Nothing where   loop s t0 = do (a, xs) <- runStream s                  t <- liftDynamics time                  let b = Arrival { arrivalValue = a,                                    arrivalTime  = t,-                                   arrivalDelay = t - t0 }-                 return (b, Cons $ loop xs t)+                                   arrivalDelay =+                                     case t0 of+                                       Nothing -> Nothing+                                       Just t0 -> Just (t - t0) }+                 return (b, Cons $ loop xs (Just t))++-- | Delay the stream by one step using the specified initial value.+delayStream :: a -> Stream a -> Stream a+delayStream a0 s = Cons $ return (a0, s)

@@ -15,6 +15,7 @@        (-- * Stream of Random Events         randomStream,         randomUniformStream,+        randomUniformIntStream,         randomNormalStream,         randomExponentialStream,         randomErlangStream,@@ -43,26 +44,29 @@                 -- ^ compute a pair of the delay and event of type @a@                 -> Stream (Arrival a)                 -- ^ a stream of delayed events-randomStream delay = Cons z0 where-  z0 =-    do t0 <- liftDynamics time-       loop t0+randomStream delay = Cons $ loop Nothing where   loop t0 =     do t1 <- liftDynamics time-       when (t1 /= t0) $-         error $-         "The time of requesting for a new random event is different from " ++-         "the time when the previous event has arrived. Probably, your model " ++-         "contains a logical error. The random events should be requested permanently. " ++-         "At least, they can be lost, for example, when trying to enqueue them, but " ++-         "the random stream itself must always work: randomStream."+       case t0 of+         Nothing -> return ()+         Just t0 ->+           when (t1 /= t0) $+           error $+           "The time of requesting for a new random event is different from " +++           "the time when the previous event has arrived. Probably, your model " +++           "contains a logical error. The random events should be requested permanently. " +++           "At least, they can be lost, for example, when trying to enqueue them, but " +++           "the random stream itself must always work: randomStream."        (delay, a) <- liftParameter delay        holdProcess delay        t2 <- liftDynamics time        let arrival = Arrival { arrivalValue = a,                                arrivalTime  = t2,-                               arrivalDelay = delay }-       return (arrival, Cons $ loop t2)+                               arrivalDelay =+                                 case t0 of+                                   Nothing -> Nothing+                                   Just t0 -> Just delay }+       return (arrival, Cons $ loop (Just t2))  -- | Create a new stream with delays distributed uniformly. randomUniformStream :: Double@@ -75,6 +79,18 @@   randomStream $   randomUniform min max >>= \x ->   return (x, x)++-- | Create a new stream with integer delays distributed uniformly.+randomUniformIntStream :: Int+                          -- ^ the minimum delay+                          -> Int+                          -- ^ the maximum delay+                          -> Stream (Arrival Int)+                          -- ^ the stream of random events with the delays generated+randomUniformIntStream min max =+  randomStream $+  randomUniformInt min max >>= \x ->+  return (fromIntegral x, x)  -- | Create a new stream with delays distributed normally. randomNormalStream :: Double

@@ -7,7 +7,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- This module defines integrals and other functions of System Dynamics. --

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- It defines the table functions. --

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- The 'Task' value represents a process that was already started in background. -- We can check the completion of the task, receive notifications about changing

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- The module defines a transform of one time varying function to another -- usually specified in the integration time points and then interpolated in

@@ -1,5 +1,5 @@ -{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP, FlexibleContexts #-}  -- | -- Module     : Simulation.Aivika.Unboxed@@ -7,7 +7,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- The 'Unboxed' class allows creating unboxed arrays in monad 'IO'. --@@ -35,9 +35,14 @@ instance Unboxed Int8	  instance Unboxed Int16	  instance Unboxed Int32	 -instance Unboxed Int64	  instance Unboxed Word	  instance Unboxed Word8	  instance Unboxed Word16	  instance Unboxed Word32	 ++#ifndef __HASTE__++instance Unboxed Int64 instance Unboxed Word64++#endif

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- This module defines a variable that is bound up with the event queue and  -- that keeps the history of changes storing the values in an array, which

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- An imperative vector. --

@@ -1,5 +1,5 @@ name:            aivika-version:         1.3+version:         1.4 synopsis:        A multi-paradigm simulation library description:     Aivika is a multi-paradigm simulation library with a strong emphasis@@ -85,9 +85,9 @@ author:          David Sorokin maintainer:      David Sorokin <david.sorokin@gmail.com> homepage:        http://github.com/dsorokin/aivika-cabal-version:   >= 1.6+cabal-version:   >= 1.10 build-type:      Simple-tested-with:     GHC == 7.6.3+tested-with:     GHC == 7.8.3  extra-source-files:  examples/BassDiffusion.hs                      examples/ChemicalReaction.hs@@ -105,6 +105,11 @@                      examples/TimeOutInt.hs                      examples/TimeOutWait.hs +flag haste-inst+    +    description: The package is built using haste-inst+    default:     False+ library      exposed-modules: Simulation.Aivika@@ -121,6 +126,7 @@                      Simulation.Aivika.Dynamics.Random                      Simulation.Aivika.Event                      Simulation.Aivika.Generator+                     Simulation.Aivika.Net                      Simulation.Aivika.Parameter                      Simulation.Aivika.Parameter.Random                      Simulation.Aivika.PriorityQueue@@ -133,6 +139,9 @@                      Simulation.Aivika.Ref                      Simulation.Aivika.Ref.Light                      Simulation.Aivika.Resource+                     Simulation.Aivika.Results.Locale+                     Simulation.Aivika.Results+                     Simulation.Aivika.Results.IO                      Simulation.Aivika.Server                      Simulation.Aivika.Signal                      Simulation.Aivika.Simulation@@ -167,14 +176,23 @@                      containers >= 0.4.0.0,                      random >= 1.0.0.3 -    extensions:      FlexibleContexts,-                     BangPatterns,-                     RecursiveDo,-                     Arrows,-                     MultiParamTypeClasses,-                     FunctionalDependencies+    if !flag(haste-inst)+       build-depends:   vector >= 0.10.0.1++    other-extensions:   FlexibleContexts,+                        FlexibleInstances,+                        UndecidableInstances,+                        BangPatterns,+                        RecursiveDo,+                        Arrows,+                        MultiParamTypeClasses,+                        FunctionalDependencies,+                        ExistentialQuantification,+                        CPP                           ghc-options:     -O2++    default-language:   Haskell2010  source-repository head 

@@ -1,6 +1,10 @@ -import System.Random+-- This is the Bass Diffusion model solved with help of +-- the Agent-based Modeling as described in the AnyLogic +-- documentation.+ import Data.Array+ import Control.Monad import Control.Monad.Trans @@ -54,7 +58,8 @@           let t = liftParameter $                   randomExponential (1 / contactRate)    -- many times!           addTimer (personAdopter p) t $-            do i <- liftIO $ getStdRandom $ randomR (1, n)+            do i <- liftParameter $+                    randomUniformInt 1 n                let p' = ps ! i                st <- selectedState (personAgent p')                when (st == Just (personPotentialAdopter p')) $@@ -78,7 +83,7 @@ activatePersons ps =   forM_ (elems ps) $ \p -> activatePerson p -model :: Simulation [IO [Int]]+model :: Simulation Results model =   do potentialAdopters <- newRef 0      adopters <- newRef 0@@ -86,12 +91,14 @@      definePersons ps potentialAdopters adopters      runEventInStartTime $        activatePersons ps-     runDynamicsInIntegTimes $-       runEvent $-       do i1 <- readRef potentialAdopters-          i2 <- readRef adopters-          return [i1, i2]+     return $ +       results+       [resultSource +        "potentialAdopter" "potential adopters" potentialAdopters,+        resultSource +        "adopters" "adopters" adopters] -main = -  do xs <- runSimulation model specs-     forM_ xs $ \x -> x >>= print+main =+  printSimulationResultsInIntegTimes+  printResultSourceInEnglish+  model specs

@@ -4,19 +4,27 @@ import Simulation.Aivika import Simulation.Aivika.SystemDynamics +import qualified Data.Vector as V+ specs = Specs { spcStartTime = 0,                  spcStopTime = 13,                  spcDT = 0.01,                 spcMethod = RungeKutta4,                 spcGeneratorType = SimpleGenerator } -model :: Simulation [Double]+model :: Simulation Results model =    mdo a <- integ (- ka * a) 100       b <- integ (ka * a - kb * b) 0       c <- integ (kb * b) 0       let ka = 1           kb = 1-      runDynamicsInStopTime $ sequence [a, b, c]+      return $ results+        [resultSource "a" "variable A" a,+         resultSource "b" "variable B" b,+         resultSource "c" "variable C" c] -main = runSimulation model specs >>= print+main =+  printSimulationResultsInStopTime+  printResultSourceInEnglish+  model specs

@@ -13,7 +13,7 @@                 spcMethod = RungeKutta4,                 spcGeneratorType = SimpleGenerator } -model :: Simulation Double+model :: Simulation Results model =   mdo let annualProfit = profit           area = 100@@ -46,6 +46,15 @@       totalProfit <- integ annualProfit 0       let totalCatchPerYear = maxDynamics 0 (ships * catchPerShip)       -- results ---      runDynamicsInStopTime annualProfit+      return $ results+        [resultSource "fish" "fish" fish,+         resultSource "annualProfit" "the annual profit" annualProfit,+         resultSource "totalProfit" "the total profit" totalProfit] -main = runSimulation model specs >>= print+main =+  flip runSimulation specs $+  model >>= \results -> do+    printResultsInStartTime+      printResultSourceInEnglish results+    printResultsInStopTime+      printResultSourceInEnglish results

@@ -1,4 +1,10 @@ +-- This is a model of the Furnace. It is described in different sources [1, 2].+--+-- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed.+--+-- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006+ import Data.Maybe import System.Random import Control.Monad@@ -72,7 +78,7 @@ newFurnace =   do pits <- sequence [newPit | i <- [1..10]]      pitCount <- newRef 0-     queue <- newFCFSQueue+     queue <- runEventInStartTime newFCFSQueue      heatingTime <- newRef emptySamplingStats      h <- newRef 1650.0      readyCount <- newRef 0@@ -268,7 +274,7 @@      writeRef (furnaceTemp furnace) 1650.0       -- | The simulation model.-model :: Simulation ()+model :: Simulation Results model =   do furnace <- newFurnace   @@ -284,67 +290,34 @@      -- load permanently the input ingots in the furnace      runProcessInStartTime $        loadingProcess furnace-     -     -- run the model in the final time point-     runEventInStopTime $-       do -- the ingots-          c0 <- enqueueStoreCount (furnaceQueue furnace)-          c1 <- dequeueCount (furnaceQueue furnace)-          c2 <- readRef (furnaceReadyCount furnace)-              -          liftIO $ do-            putStrLn "The count of ingots:"-            putStrLn ""-            putStrLn $ "  total  = " ++ show c0-            putStrLn $ "  loaded = " ++ show c1-            putStrLn $ "  ready  = " ++ show c2-            putStrLn ""-         -          -- the temperature of the ready ingots-          temps <- readRef (furnaceReadyTemps furnace)-            -          liftIO $ do -            putStrLn "The temperature of ready ingots:"-            putStrLn ""-            putStrLn $ samplingStatsSummary (listSamplingStats temps) 2 []-            putStrLn ""-              -          -- the mean heating time-          r5 <- readRef (furnaceHeatingTime furnace)-            -          liftIO $ do-            putStrLn "The heating time:"-            putStrLn ""-            putStrLn $ samplingStatsSummary r5 2 []-            putStrLn ""-                -          -- the ingots in pits-          r2 <- readRef (furnacePitCount furnace)-              -          liftIO $ do-            putStr "The ingots in pits (in the final time): "-            putStrLn $ show r2-            putStrLn ""-              -          -- the queue size and mean wait time-          r3 <- queueCount (furnaceQueue furnace)-          -          r4 <- fmap samplingStatsMean $-                queueWaitTime (furnaceQueue furnace) -     -          liftIO $ do-            putStrLn "The queue summary: "-            putStrLn ""-            putStrLn $ "  size (in the final time) = " ++ show r3-            putStrLn $ "  mean wait time = " ++ show r4-            putStrLn "" -          summary <- queueSummary (furnaceQueue furnace) 2--          liftIO $ do-            putStrLn "The detailed info about the queue (in the final time): "-            putStrLn ""-            putStrLn $ summary []+     -- return the simulation results+     return $+       resultSummary $+       results+       [resultSource "inputIngotCount" "the input ingot count" $+        enqueueStoreCount (furnaceQueue furnace),+        --+        resultSource "loadedIngotCount" "the loaded ingot count" $+        dequeueCount (furnaceQueue furnace),+        --+        resultSource "outputIngotCount" "the output ingot count" $+        furnaceReadyCount furnace,+        --+        resultSource "outputIngotTemp" "the output ingot temperature" $+        fmap listSamplingStats $ readRef $ furnaceReadyTemps furnace,+        --+        resultSource "heatingTime" "the heating time" $+        furnaceHeatingTime furnace,+        --+        resultSource "pitCount" "the number of ingots in pits" $+        furnacePitCount furnace,+        --+        resultSource "furnaceQueue" "the furnace queue" $+        furnaceQueue furnace]  -- | The main program.-main = runSimulation model specs+main =+  printSimulationResultsInStopTime+  printResultSourceInEnglish+  model specs

@@ -11,28 +11,6 @@ -- -- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 --- CAUTION:------ This model is not yet fully tested and it may contain logical errors but it seems to be working,--- although some results may differ slightly but it can be related to a great value of the deviation--- for some variables as well as to a small number of samples in [1].------ The results for the queue sizes in [2] seem doubtful for me, while my results for these queue sizes--- are similar to [1] but I also made 1000 runs (see the aivika-experiment-chart package) versus 1 run--- in [1]. In comparison with [1] I see a difference in the queue size for the adjustment station and--- it can be realized as there was a too small number of samples (= 13) in [1], for the TV settings must--- fail when inspecting to be directed to the adjustor.------ Also I have received more small values for the wait time in comparison with [1] but they have--- a relatively great deviation, which may be acceptable (??), taking into account a small number of--- samples used in [1].------ At the same time, all my other results except for these queue sizes correspond to [2], where the author--- launched 1000 simulation runs too.------ Some new things that I have added the past summer (2013), i.e. Streams / Processors / Queues / Servers,--- should be yet verified for other models but, as I wrote, they seem to be working.- import Prelude hiding (id, (.))   import Control.Monad@@ -77,11 +55,6 @@ -- how many are adjustment stations? adjustmentStationCount = 1 --- create an accumulator to gather the queue size statistics -newQueueSizeAccumulator queue =-  newTimingStatsAccumulator $-  Signalable (queueCount queue) (queueCountChanged_ queue)- -- create an inspection station (server) newInspectionStation =   newServer $ \a ->@@ -103,7 +76,7 @@         randomUniform minAdjustmentTime maxAdjustmentTime)      return a   -model :: Simulation ()+model :: Simulation Results model = mdo   -- to count the arrived TV sets for inspecting and adjusting   inputArrivalTimer <- newArrivalTimer@@ -113,17 +86,11 @@   let inputStream =         randomUniformStream minArrivalDelay maxArrivalDelay    -- create a queue before the inspection stations-  inspectionQueue <- newFCFSQueue+  inspectionQueue <-+    runEventInStartTime newFCFSQueue   -- create a queue before the adjustment stations-  adjustmentQueue <- newFCFSQueue-  -- the inspection stations' queue size statistics-  inspectionQueueSizeAcc <- -    runEventInStartTime $-    newQueueSizeAccumulator inspectionQueue-  -- the adjustment stations' queue size statistics-  adjustmentQueueSizeAcc <- -    runEventInStartTime $-    newQueueSizeAccumulator adjustmentQueue+  adjustmentQueue <-+    runEventInStartTime newFCFSQueue   -- create the inspection stations (servers)   inspectionStations <-     forM [1 .. inspectionStationCount] $ \_ ->@@ -158,58 +125,37 @@   -- start simulating the model   runProcessInStartTime $     sinkStream $ runProcessor entireProcessor inputStream-  -- show the results in the final time-  runEventInStopTime $-    do let indent = 2-       inspectionQueueSum <- queueSummary inspectionQueue indent-       adjustmentQueueSum <- queueSummary adjustmentQueue indent-       inspectionStationSums <- -         forM inspectionStations $ \x -> serverSummary x indent-       adjustmentStationSums <- -         forM adjustmentStations $ \x -> serverSummary x indent-       inputProcessingTime  <- arrivalProcessingTime inputArrivalTimer-       outputProcessingTime <- arrivalProcessingTime outputArrivalTimer-       inspectionQueueSize <- timingStatsAccumulated inspectionQueueSizeAcc-       adjustmentQueueSize <- timingStatsAccumulated adjustmentQueueSizeAcc-       liftIO $-         do putStrLn ""-            putStrLn "--- the inspection stations' queue summary (in the final time) ---"-            putStrLn ""-            putStrLn $ inspectionQueueSum []-            putStrLn ""-            forM_ (zip [1..] inspectionStationSums) $ \(i, x) ->-              do putStrLn $ "--- the inspection station no. "-                   ++ show i ++ " (in the final time) ---"-                 putStrLn ""-                 putStrLn $ x []-                 putStrLn ""-            putStrLn "--- the adjustment stations' queue summary (in the final time) ---"-            putStrLn ""-            putStrLn $ adjustmentQueueSum []-            putStrLn ""-            forM_ (zip [1..] adjustmentStationSums) $ \(i, x) ->-              do putStrLn $ "--- the adjustment station no. "-                   ++ show i ++ " (in the final time) ---"-                 putStrLn ""-                 putStrLn $ x []-                 putStrLn ""-            putStrLn "--- the input arrival time summary (we are interested in their count) ---"-            putStrLn ""-            putStrLn $ samplingStatsSummary inputProcessingTime indent []-            putStrLn ""-            putStrLn "--- the arrival processing time summary ---"-            putStrLn ""-            putStrLn $ samplingStatsSummary outputProcessingTime indent []-            putStrLn ""-            putStrLn $ "--- the inspection stations' queue size summary "-              ++ "(updated when enqueueing and dequeueing) ---"-            putStrLn ""-            putStrLn $ timingStatsSummary inspectionQueueSize indent []-            putStrLn ""-            putStrLn $ "--- the adjustment stations' queue size summary "-              ++ "(updated when enqueueing and dequeueing) ---"-            putStrLn ""-            putStrLn $ timingStatsSummary adjustmentQueueSize indent []-            putStrLn ""+  -- return the simulation results in start time+  return $+    results+    [resultSource+     "inspectionQueue" "the inspection queue"+     inspectionQueue,+     --+     resultSource+     "adjustmentQueue" "the adjustment queue"+     adjustmentQueue,+     --+     resultSource+     "inputArrivalTimer" "the input arrival timer"+     inputArrivalTimer,+     --+     resultSource+     "outputArrivalTimer" "the output arrival timer"+     outputArrivalTimer,+     --+     resultSource+     "inspectionStations" "the inspection stations"+     inspectionStations,+     --+     resultSource+     "adjustmentStations" "the adjustment stations"+     adjustmentStations] -main = runSimulation model specs+modelSummary :: Simulation Results+modelSummary = fmap resultSummary model++main =+  printSimulationResultsInStopTime+  printResultSourceInEnglish+  modelSummary specs

@@ -28,7 +28,7 @@                 spcMethod = RungeKutta4,                 spcGeneratorType = SimpleGenerator }         -model :: Simulation Double+model :: Simulation Results model =   do totalUpTime <- newRef 0.0      @@ -48,10 +48,20 @@       runProcessInStartTime machine      runProcessInStartTime machine-     -     runEventInStopTime $-       do x <- readRef totalUpTime-          y <- liftParameter stoptime-          return $ x / (2 * y)++     let upTimeProp =+           do x <- readRef totalUpTime+              y <- liftDynamics time+              return $ x / (2 * y)++     return $+       results+       [resultSource+        "upTimeProp"+        "The long-run proportion of up time (~ 0.66)"+        upTimeProp]   -main = runSimulation model specs >>= print+main =+  printSimulationResultsInStopTime+  printResultSourceInEnglish+  model specs

@@ -28,7 +28,7 @@                 spcMethod = RungeKutta4,                 spcGeneratorType = SimpleGenerator }         -model :: Simulation Double+model :: Simulation Results model =   do totalUpTime <- newRef 0.0      @@ -63,9 +63,19 @@           -- start the second machine           machineRepaired -     runEventInStopTime $-       do x <- readRef totalUpTime-          y <- liftParameter stoptime-          return $ x / (2 * y)+     let upTimeProp =+           do x <- readRef totalUpTime+              y <- liftDynamics time+              return $ x / (2 * y)++     return $+       results+       [resultSource+        "upTimeProp"+        "The long-run proportion of up time (~ 0.66)"+        upTimeProp]   -main = runSimulation model specs >>= print+main =+  printSimulationResultsInStopTime+  printResultSourceInEnglish+  model specs

@@ -28,7 +28,7 @@                 spcMethod = RungeKutta4,                 spcGeneratorType = SimpleGenerator }         -model :: Simulation Double+model :: Simulation Results model =   do totalUpTime <- newRef 0.0      @@ -100,10 +100,19 @@        do m1           m2 -     -- return the result in the stop time-     runEventInStopTime $-       do x <- readRef totalUpTime-          y <- liftParameter stoptime-          return $ x / (2 * y)+     let upTimeProp =+           do x <- readRef totalUpTime+              y <- liftDynamics time+              return $ x / (2 * y)++     return $+       results+       [resultSource+        "upTimeProp"+        "The long-run proportion of up time (~ 0.66)"+        upTimeProp]   -main = runSimulation model specs >>= print+main =+  printSimulationResultsInStopTime+  printResultSourceInEnglish+  model specs

@@ -31,7 +31,7 @@                 spcMethod = RungeKutta4,                 spcGeneratorType = SimpleGenerator }      -model :: Simulation (Double, Double)+model :: Simulation Results model =   do -- number of times the machines have broken down      nRep <- newRef 0 @@ -72,13 +72,33 @@       runProcessInStartTime machine      runProcessInStartTime machine-          -     runEventInStopTime $-       do x <- readRef totalUpTime-          y <- liftParameter stoptime-          n <- readRef nRep-          nImmed <- readRef nImmedRep-          return (x / (2 * y), -                  fromIntegral nImmed / fromIntegral n)++     let upTimeProp =+           do x <- readRef totalUpTime+              y <- liftDynamics time+              return $ x / (2 * y)++         immedProp :: Event Double+         immedProp =+           do n <- readRef nRep+              nImmed <- readRef nImmedRep+              return $+                fromIntegral nImmed /+                fromIntegral n++     return $+       results+       [resultSource+        "upTimeProp"+        "The long-run proportion of up time (~ 0.6)"+        upTimeProp,+        --+        resultSource+        "immedProp"+        "The proption of time of immediate access (~0.67)"+        immedProp]   -main = runSimulation model specs >>= print+main =+  printSimulationResultsInStopTime+  printResultSourceInEnglish+  model specs

@@ -27,7 +27,7 @@                 spcMethod = RungeKutta4,                 spcGeneratorType = SimpleGenerator }      -model :: Simulation Double+model :: Simulation Results model =   do -- number of machines currently up      nUp <- newRef 2@@ -76,9 +76,19 @@      runProcessInStartTimeUsingId        pid2 (machine pid1) -     runEventInStopTime $-       do x <- readRef totalUpTime-          y <- liftDynamics time-          return $ x / (2 * y)+     let upTimeProp =+           do x <- readRef totalUpTime+              y <- liftDynamics time+              return $ x / (2 * y)++     return $+       results+       [resultSource+        "upTimeProp"+        "The long-run proportion of up time (~ 0.45)"+        upTimeProp]   -main = runSimulation model specs >>= print+main =+  printSimulationResultsInStopTime+  printResultSourceInEnglish+  model specs

@@ -51,11 +51,6 @@ -- (in parallel but the commented code allocates them sequentially) workStationCount2 = 1 --- create an accumulator to gather the queue size statistics -newQueueSizeAccumulator queue =-  newTimingStatsAccumulator $-  Signalable (queueCount queue) (queueCountChanged_ queue)- -- create a work station (server) with the exponential processing time newWorkStationExponential meanTime =   newServer $ \a ->@@ -68,24 +63,20 @@ interposePrefetchProcessor x y =    x >>> prefetchProcessor >>> y -model :: Simulation ()+model :: Simulation Results model = do   -- it will gather the statistics of the processing time   arrivalTimer <- newArrivalTimer   -- define a stream of input events   let inputStream = randomExponentialStream meanOrderDelay    -- create a queue before the first work stations-  queue1 <- newFCFSQueue queueMaxCount1-  -- create a queue before the second work stations-  queue2 <- newFCFSQueue queueMaxCount2-  -- the first queue size statistics-  queueSizeAcc1 <- +  queue1 <-     runEventInStartTime $-    newQueueSizeAccumulator queue1-  -- the second queue size statistics-  queueSizeAcc2 <- +    newFCFSQueue queueMaxCount1+  -- create a queue before the second work stations+  queue2 <-     runEventInStartTime $-    newQueueSizeAccumulator queue2+    newFCFSQueue queueMaxCount2   -- create the first work stations (servers)   workStation1s <- forM [1 .. workStationCount1] $ \_ ->     newWorkStationExponential meanProcessingTime1@@ -114,46 +105,35 @@   -- start simulating the model   runProcessInStartTime $     sinkStream $ runProcessor entireProcessor inputStream-  -- show the results in the final time-  runEventInStopTime $-    do queueSum1 <- queueSummary queue1 2-       queueSum2 <- queueSummary queue2 2-       workStationSum1s <- forM workStation1s $ \x -> serverSummary x 2-       workStationSum2s <- forM workStation2s $ \x -> serverSummary x 2-       processingTime <- arrivalProcessingTime arrivalTimer-       queueSize1 <- timingStatsAccumulated queueSizeAcc1-       queueSize2 <- timingStatsAccumulated queueSizeAcc2-       liftIO $-         do putStrLn ""-            putStrLn "--- the first queue summary (in the final time) ---"-            putStrLn ""-            putStrLn $ queueSum1 []-            putStrLn ""-            forM_ (zip [1..] workStationSum1s) $ \(i, x) ->-              do putStrLn $ "--- the first work station no. " ++ show i ++ " (in the final time) ---"-                 putStrLn ""-                 putStrLn $ x []-                 putStrLn ""-            putStrLn "--- the second queue summary (in the final time) ---"-            putStrLn ""-            putStrLn $ queueSum2 []-            putStrLn ""-            forM_ (zip [1..] workStationSum2s) $ \(i, x) ->-              do putStrLn $ "--- the second work station no. " ++ show i ++ " (in the final time) ---"-                 putStrLn ""-                 putStrLn $ x []-                 putStrLn ""-            putStrLn "--- the processing time summary ---"-            putStrLn ""-            putStrLn $ samplingStatsSummary processingTime 2 []-            putStrLn ""-            putStrLn "--- the first queue size summary ---"-            putStrLn ""-            putStrLn $ timingStatsSummary queueSize1 2 []-            putStrLn ""-            putStrLn "--- the second queue size summary ---"-            putStrLn ""-            putStrLn $ timingStatsSummary queueSize2 2 []-            putStrLn ""+  -- return the simulation results+  return $+    results+    [resultSource+     "queue1" "Queue no. 1"+     queue1,+     --+     resultSource+     "workStation1s" "Work Stations of line no. 1"+     workStation1s,+     --+     resultSource+     "queue2" "Queue no. 2"+     queue2,+     --+     resultSource+     "workStation2s" "Work Stations of line no. 2"+     workStation2s,+     --+     resultSource+     "arrivalTimer" "The arrival timer"+     arrivalTimer] -main = runSimulation model specs+modelSummary :: Simulation Results+modelSummary =+  fmap resultSummary model++main =+  printSimulationResultsInStopTime+  printResultSourceInEnglish+  -- model specs+  modelSummary specs