module Simulation.Aivika.Trans.Activity
(
Activity,
newActivity,
newStateActivity,
newPreemptibleActivity,
newPreemptibleStateActivity,
activityNet,
activityInitState,
activityState,
activityTotalUtilisationTime,
activityTotalIdleTime,
activityTotalPreemptionTime,
activityUtilisationTime,
activityIdleTime,
activityPreemptionTime,
activityUtilisationFactor,
activityIdleFactor,
activityPreemptionFactor,
resetActivity,
activitySummary,
activityStateChanged,
activityStateChanged_,
activityTotalUtilisationTimeChanged,
activityTotalUtilisationTimeChanged_,
activityTotalIdleTimeChanged,
activityTotalIdleTimeChanged_,
activityTotalPreemptionTimeChanged,
activityTotalPreemptionTimeChanged_,
activityUtilisationTimeChanged,
activityUtilisationTimeChanged_,
activityIdleTimeChanged,
activityIdleTimeChanged_,
activityPreemptionTimeChanged,
activityPreemptionTimeChanged_,
activityUtilisationFactorChanged,
activityUtilisationFactorChanged_,
activityIdleFactorChanged,
activityIdleFactorChanged_,
activityPreemptionFactorChanged,
activityPreemptionFactorChanged_,
activityUtilising,
activityUtilised,
activityPreemptionBeginning,
activityPreemptionEnding,
activityChanged_) where
import Data.Monoid
import Control.Monad
import Control.Monad.Trans
import Control.Arrow
import Simulation.Aivika.Trans.Ref.Base
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Parameter
import Simulation.Aivika.Trans.Simulation
import Simulation.Aivika.Trans.Dynamics
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Event
import Simulation.Aivika.Trans.Signal
import Simulation.Aivika.Trans.Cont
import Simulation.Aivika.Trans.Process
import Simulation.Aivika.Trans.Net
import Simulation.Aivika.Trans.Server
import Simulation.Aivika.Trans.Statistics
data Activity m s a b =
Activity { activityInitState :: s,
activityStateRef :: Ref m s,
activityProcess :: s -> a -> Process m (s, b),
activityProcessPreemptible :: Bool,
activityTotalUtilisationTimeRef :: Ref m Double,
activityTotalIdleTimeRef :: Ref m Double,
activityTotalPreemptionTimeRef :: Ref m Double,
activityUtilisationTimeRef :: Ref m (SamplingStats Double),
activityIdleTimeRef :: Ref m (SamplingStats Double),
activityPreemptionTimeRef :: Ref m (SamplingStats Double),
activityUtilisingSource :: SignalSource m a,
activityUtilisedSource :: SignalSource m (a, b),
activityPreemptionBeginningSource :: SignalSource m a,
activityPreemptionEndingSource :: SignalSource m a
}
newActivity :: MonadDES m
=> (a -> Process m b)
-> Simulation m (Activity m () a b)
{-# INLINABLE newActivity #-}
newActivity = newPreemptibleActivity False
newStateActivity :: MonadDES m
=> (s -> a -> Process m (s, b))
-> s
-> Simulation m (Activity m s a b)
{-# INLINABLE newStateActivity #-}
newStateActivity = newPreemptibleStateActivity False
newPreemptibleActivity :: MonadDES m
=> Bool
-> (a -> Process m b)
-> Simulation m (Activity m () a b)
{-# INLINABLE newPreemptibleActivity #-}
newPreemptibleActivity preemptible provide =
flip (newPreemptibleStateActivity preemptible) () $ \s a ->
do b <- provide a
return (s, b)
newPreemptibleStateActivity :: MonadDES m
=> Bool
-> (s -> a -> Process m (s, b))
-> s
-> Simulation m (Activity m s a b)
{-# INLINABLE newPreemptibleStateActivity #-}
newPreemptibleStateActivity preemptible provide state =
do r0 <- newRef state
r1 <- newRef 0
r2 <- newRef 0
r3 <- newRef 0
r4 <- newRef emptySamplingStats
r5 <- newRef emptySamplingStats
r6 <- newRef emptySamplingStats
s1 <- newSignalSource
s2 <- newSignalSource
s3 <- newSignalSource
s4 <- newSignalSource
return Activity { activityInitState = state,
activityStateRef = r0,
activityProcess = provide,
activityProcessPreemptible = preemptible,
activityTotalUtilisationTimeRef = r1,
activityTotalIdleTimeRef = r2,
activityTotalPreemptionTimeRef = r3,
activityUtilisationTimeRef = r4,
activityIdleTimeRef = r5,
activityPreemptionTimeRef = r6,
activityUtilisingSource = s1,
activityUtilisedSource = s2,
activityPreemptionBeginningSource = s3,
activityPreemptionEndingSource = s4 }
activityNet :: MonadDES m => Activity m s a b -> Net m a b
{-# INLINABLE activityNet #-}
activityNet act = Net $ loop (activityInitState act) Nothing
where
loop s r a =
do t0 <- liftDynamics time
liftEvent $
do case r of
Nothing -> return ()
Just t' ->
do modifyRef (activityTotalIdleTimeRef act) (+ (t0 - t'))
modifyRef (activityIdleTimeRef act) $
addSamplingStats (t0 - t')
triggerSignal (activityUtilisingSource act) a
(s', b, dt) <- if activityProcessPreemptible act
then activityProcessPreempting act s a
else do (s', b) <- activityProcess act s a
return (s', b, 0)
t1 <- liftDynamics time
liftEvent $
do writeRef (activityStateRef act) $! s'
modifyRef (activityTotalUtilisationTimeRef act) (+ (t1 - t0 - dt))
modifyRef (activityUtilisationTimeRef act) $
addSamplingStats (t1 - t0 - dt)
triggerSignal (activityUtilisedSource act) (a, b)
return (b, Net $ loop s' (Just t1))
activityProcessPreempting :: MonadDES m => Activity m s a b -> s -> a -> Process m (s, b, Double)
{-# INLINABLE activityProcessPreempting #-}
activityProcessPreempting act s a =
do pid <- processId
t0 <- liftDynamics time
rs <- liftSimulation $ newRef 0
r0 <- liftSimulation $ newRef t0
h1 <- liftEvent $
handleSignal (processPreemptionBeginning pid) $ \() ->
do t0 <- liftDynamics time
writeRef r0 t0
triggerSignal (activityPreemptionBeginningSource act) a
h2 <- liftEvent $
handleSignal (processPreemptionEnding pid) $ \() ->
do t0 <- readRef r0
t1 <- liftDynamics time
let dt = t1 - t0
modifyRef rs (+ dt)
modifyRef (activityTotalPreemptionTimeRef act) (+ dt)
modifyRef (activityPreemptionTimeRef act) $
addSamplingStats dt
triggerSignal (activityPreemptionEndingSource act) a
let m1 =
do (s', b) <- activityProcess act s a
dt <- liftEvent $ readRef rs
return (s', b, dt)
m2 =
liftEvent $
do disposeEvent h1
disposeEvent h2
finallyProcess m1 m2
activityState :: MonadDES m => Activity m s a b -> Event m s
{-# INLINABLE activityState #-}
activityState act =
Event $ \p -> invokeEvent p $ readRef (activityStateRef act)
activityStateChanged :: MonadDES m => Activity m s a b -> Signal m s
{-# INLINABLE activityStateChanged #-}
activityStateChanged act =
mapSignalM (const $ activityState act) (activityStateChanged_ act)
activityStateChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
{-# INLINABLE activityStateChanged_ #-}
activityStateChanged_ act =
mapSignal (const ()) (activityUtilised act)
activityTotalUtilisationTime :: MonadDES m => Activity m s a b -> Event m Double
{-# INLINABLE activityTotalUtilisationTime #-}
activityTotalUtilisationTime act =
Event $ \p -> invokeEvent p $ readRef (activityTotalUtilisationTimeRef act)
activityTotalUtilisationTimeChanged :: MonadDES m => Activity m s a b -> Signal m Double
{-# INLINABLE activityTotalUtilisationTimeChanged #-}
activityTotalUtilisationTimeChanged act =
mapSignalM (const $ activityTotalUtilisationTime act) (activityTotalUtilisationTimeChanged_ act)
activityTotalUtilisationTimeChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
{-# INLINABLE activityTotalUtilisationTimeChanged_ #-}
activityTotalUtilisationTimeChanged_ act =
mapSignal (const ()) (activityUtilised act)
activityTotalIdleTime :: MonadDES m => Activity m s a b -> Event m Double
{-# INLINABLE activityTotalIdleTime #-}
activityTotalIdleTime act =
Event $ \p -> invokeEvent p $ readRef (activityTotalIdleTimeRef act)
activityTotalIdleTimeChanged :: MonadDES m => Activity m s a b -> Signal m Double
{-# INLINABLE activityTotalIdleTimeChanged #-}
activityTotalIdleTimeChanged act =
mapSignalM (const $ activityTotalIdleTime act) (activityTotalIdleTimeChanged_ act)
activityTotalIdleTimeChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
{-# INLINABLE activityTotalIdleTimeChanged_ #-}
activityTotalIdleTimeChanged_ act =
mapSignal (const ()) (activityUtilising act)
activityTotalPreemptionTime :: MonadDES m => Activity m s a b -> Event m Double
{-# INLINABLE activityTotalPreemptionTime #-}
activityTotalPreemptionTime act =
Event $ \p -> invokeEvent p $ readRef (activityTotalPreemptionTimeRef act)
activityTotalPreemptionTimeChanged :: MonadDES m => Activity m s a b -> Signal m Double
{-# INLINABLE activityTotalPreemptionTimeChanged #-}
activityTotalPreemptionTimeChanged act =
mapSignalM (const $ activityTotalPreemptionTime act) (activityTotalPreemptionTimeChanged_ act)
activityTotalPreemptionTimeChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
{-# INLINABLE activityTotalPreemptionTimeChanged_ #-}
activityTotalPreemptionTimeChanged_ act =
mapSignal (const ()) (activityPreemptionEnding act)
activityUtilisationTime :: MonadDES m => Activity m s a b -> Event m (SamplingStats Double)
{-# INLINABLE activityUtilisationTime #-}
activityUtilisationTime act =
Event $ \p -> invokeEvent p $ readRef (activityUtilisationTimeRef act)
activityUtilisationTimeChanged :: MonadDES m => Activity m s a b -> Signal m (SamplingStats Double)
{-# INLINABLE activityUtilisationTimeChanged #-}
activityUtilisationTimeChanged act =
mapSignalM (const $ activityUtilisationTime act) (activityUtilisationTimeChanged_ act)
activityUtilisationTimeChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
{-# INLINABLE activityUtilisationTimeChanged_ #-}
activityUtilisationTimeChanged_ act =
mapSignal (const ()) (activityUtilised act)
activityIdleTime :: MonadDES m => Activity m s a b -> Event m (SamplingStats Double)
{-# INLINABLE activityIdleTime #-}
activityIdleTime act =
Event $ \p -> invokeEvent p $ readRef (activityIdleTimeRef act)
activityIdleTimeChanged :: MonadDES m => Activity m s a b -> Signal m (SamplingStats Double)
{-# INLINABLE activityIdleTimeChanged #-}
activityIdleTimeChanged act =
mapSignalM (const $ activityIdleTime act) (activityIdleTimeChanged_ act)
activityIdleTimeChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
{-# INLINABLE activityIdleTimeChanged_ #-}
activityIdleTimeChanged_ act =
mapSignal (const ()) (activityUtilising act)
activityPreemptionTime :: MonadDES m => Activity m s a b -> Event m (SamplingStats Double)
{-# INLINABLE activityPreemptionTime #-}
activityPreemptionTime act =
Event $ \p -> invokeEvent p $ readRef (activityPreemptionTimeRef act)
activityPreemptionTimeChanged :: MonadDES m => Activity m s a b -> Signal m (SamplingStats Double)
{-# INLINABLE activityPreemptionTimeChanged #-}
activityPreemptionTimeChanged act =
mapSignalM (const $ activityPreemptionTime act) (activityPreemptionTimeChanged_ act)
activityPreemptionTimeChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
{-# INLINABLE activityPreemptionTimeChanged_ #-}
activityPreemptionTimeChanged_ act =
mapSignal (const ()) (activityPreemptionEnding act)
activityUtilisationFactor :: MonadDES m => Activity m s a b -> Event m Double
{-# INLINABLE activityUtilisationFactor #-}
activityUtilisationFactor act =
Event $ \p ->
do x1 <- invokeEvent p $ readRef (activityTotalUtilisationTimeRef act)
x2 <- invokeEvent p $ readRef (activityTotalIdleTimeRef act)
x3 <- invokeEvent p $ readRef (activityTotalPreemptionTimeRef act)
return (x1 / (x1 + x2 + x3))
activityUtilisationFactorChanged :: MonadDES m => Activity m s a b -> Signal m Double
{-# INLINABLE activityUtilisationFactorChanged #-}
activityUtilisationFactorChanged act =
mapSignalM (const $ activityUtilisationFactor act) (activityUtilisationFactorChanged_ act)
activityUtilisationFactorChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
{-# INLINABLE activityUtilisationFactorChanged_ #-}
activityUtilisationFactorChanged_ act =
mapSignal (const ()) (activityUtilising act) <>
mapSignal (const ()) (activityUtilised act) <>
mapSignal (const ()) (activityPreemptionEnding act)
activityIdleFactor :: MonadDES m => Activity m s a b -> Event m Double
{-# INLINABLE activityIdleFactor #-}
activityIdleFactor act =
Event $ \p ->
do x1 <- invokeEvent p $ readRef (activityTotalUtilisationTimeRef act)
x2 <- invokeEvent p $ readRef (activityTotalIdleTimeRef act)
x3 <- invokeEvent p $ readRef (activityTotalPreemptionTimeRef act)
return (x2 / (x1 + x2 + x3))
activityIdleFactorChanged :: MonadDES m => Activity m s a b -> Signal m Double
{-# INLINABLE activityIdleFactorChanged #-}
activityIdleFactorChanged act =
mapSignalM (const $ activityIdleFactor act) (activityIdleFactorChanged_ act)
activityIdleFactorChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
{-# INLINABLE activityIdleFactorChanged_ #-}
activityIdleFactorChanged_ act =
mapSignal (const ()) (activityUtilising act) <>
mapSignal (const ()) (activityUtilised act) <>
mapSignal (const ()) (activityPreemptionEnding act)
activityPreemptionFactor :: MonadDES m => Activity m s a b -> Event m Double
{-# INLINABLE activityPreemptionFactor #-}
activityPreemptionFactor act =
Event $ \p ->
do x1 <- invokeEvent p $ readRef (activityTotalUtilisationTimeRef act)
x2 <- invokeEvent p $ readRef (activityTotalIdleTimeRef act)
x3 <- invokeEvent p $ readRef (activityTotalPreemptionTimeRef act)
return (x3 / (x1 + x2 + x3))
activityPreemptionFactorChanged :: MonadDES m => Activity m s a b -> Signal m Double
{-# INLINABLE activityPreemptionFactorChanged #-}
activityPreemptionFactorChanged act =
mapSignalM (const $ activityPreemptionFactor act) (activityPreemptionFactorChanged_ act)
activityPreemptionFactorChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
{-# INLINABLE activityPreemptionFactorChanged_ #-}
activityPreemptionFactorChanged_ act =
mapSignal (const ()) (activityUtilising act) <>
mapSignal (const ()) (activityUtilised act) <>
mapSignal (const ()) (activityPreemptionEnding act)
activityUtilising :: Activity m s a b -> Signal m a
{-# INLINABLE activityUtilising #-}
activityUtilising = publishSignal . activityUtilisingSource
activityUtilised :: Activity m s a b -> Signal m (a, b)
{-# INLINABLE activityUtilised #-}
activityUtilised = publishSignal . activityUtilisedSource
activityPreemptionBeginning :: Activity m s a b -> Signal m a
{-# INLINABLE activityPreemptionBeginning #-}
activityPreemptionBeginning = publishSignal . activityPreemptionBeginningSource
activityPreemptionEnding :: Activity m s a b -> Signal m a
{-# INLINABLE activityPreemptionEnding #-}
activityPreemptionEnding = publishSignal . activityPreemptionEndingSource
activityChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
{-# INLINABLE activityChanged_ #-}
activityChanged_ act =
mapSignal (const ()) (activityUtilising act) <>
mapSignal (const ()) (activityUtilised act) <>
mapSignal (const ()) (activityPreemptionEnding act)
activitySummary :: MonadDES m => Activity m s a b -> Int -> Event m ShowS
{-# INLINABLE activitySummary #-}
activitySummary act indent =
Event $ \p ->
do tx1 <- invokeEvent p $ readRef (activityTotalUtilisationTimeRef act)
tx2 <- invokeEvent p $ readRef (activityTotalIdleTimeRef act)
tx3 <- invokeEvent p $ readRef (activityTotalPreemptionTimeRef act)
let xf1 = tx1 / (tx1 + tx2 + tx3)
xf2 = tx2 / (tx1 + tx2 + tx3)
xf3 = tx3 / (tx1 + tx2 + tx3)
xs1 <- invokeEvent p $ readRef (activityUtilisationTimeRef act)
xs2 <- invokeEvent p $ readRef (activityIdleTimeRef act)
xs3 <- invokeEvent p $ readRef (activityPreemptionTimeRef act)
let tab = replicate indent ' '
return $
showString tab .
showString "total utilisation time = " . shows tx1 .
showString "\n" .
showString tab .
showString "total idle time = " . shows tx2 .
showString "\n" .
showString tab .
showString "total preemption time = " . shows tx3 .
showString "\n" .
showString tab .
showString "utilisation factor (from 0 to 1) = " . shows xf1 .
showString "\n" .
showString tab .
showString "idle factor (from 0 to 1) = " . shows xf2 .
showString "\n" .
showString tab .
showString "preemption factor (from 0 to 1) = " . shows xf3 .
showString "\n" .
showString tab .
showString "utilisation time (locked while awaiting the input):\n\n" .
samplingStatsSummary xs1 (2 + indent) .
showString "\n\n" .
showString tab .
showString "idle time:\n\n" .
samplingStatsSummary xs2 (2 + indent) .
showString tab .
showString "preemption time:\n\n" .
samplingStatsSummary xs3 (2 + indent)
resetActivity :: MonadDES m => Activity m s a b -> Event m ()
{-# INLINABLE resetActivity #-}
resetActivity act =
do writeRef (activityTotalUtilisationTimeRef act) 0
writeRef (activityTotalIdleTimeRef act) 0
writeRef (activityTotalPreemptionTimeRef act) 0
writeRef (activityUtilisationTimeRef act) mempty
writeRef (activityIdleTimeRef act) mempty
writeRef (activityPreemptionTimeRef act) mempty