module Simulation.Aivika.Trans.Activity
(
Activity,
newActivity,
newStateActivity,
newPreemptibleActivity,
newPreemptibleStateActivity,
activityNet,
activityInitState,
activityState,
activityTotalUtilisationTime,
activityTotalIdleTime,
activityTotalPreemptionTime,
activityUtilisationTime,
activityIdleTime,
activityPreemptionTime,
activityUtilisationFactor,
activityIdleFactor,
activityPreemptionFactor,
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)
newActivity = newPreemptibleActivity False
newStateActivity :: MonadDES m
=> (s -> a -> Process m (s, b))
-> s
-> Simulation m (Activity m s a b)
newStateActivity = newPreemptibleStateActivity False
newPreemptibleActivity :: MonadDES m
=> Bool
-> (a -> Process m b)
-> Simulation m (Activity m () a b)
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)
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
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)
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
activityState act =
Event $ \p -> invokeEvent p $ readRef (activityStateRef act)
activityStateChanged :: MonadDES m => Activity m s a b -> Signal m s
activityStateChanged act =
mapSignalM (const $ activityState act) (activityStateChanged_ act)
activityStateChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
activityStateChanged_ act =
mapSignal (const ()) (activityUtilised act)
activityTotalUtilisationTime :: MonadDES m => Activity m s a b -> Event m Double
activityTotalUtilisationTime act =
Event $ \p -> invokeEvent p $ readRef (activityTotalUtilisationTimeRef act)
activityTotalUtilisationTimeChanged :: MonadDES m => Activity m s a b -> Signal m Double
activityTotalUtilisationTimeChanged act =
mapSignalM (const $ activityTotalUtilisationTime act) (activityTotalUtilisationTimeChanged_ act)
activityTotalUtilisationTimeChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
activityTotalUtilisationTimeChanged_ act =
mapSignal (const ()) (activityUtilised act)
activityTotalIdleTime :: MonadDES m => Activity m s a b -> Event m Double
activityTotalIdleTime act =
Event $ \p -> invokeEvent p $ readRef (activityTotalIdleTimeRef act)
activityTotalIdleTimeChanged :: MonadDES m => Activity m s a b -> Signal m Double
activityTotalIdleTimeChanged act =
mapSignalM (const $ activityTotalIdleTime act) (activityTotalIdleTimeChanged_ act)
activityTotalIdleTimeChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
activityTotalIdleTimeChanged_ act =
mapSignal (const ()) (activityUtilising act)
activityTotalPreemptionTime :: MonadDES m => Activity m s a b -> Event m Double
activityTotalPreemptionTime act =
Event $ \p -> invokeEvent p $ readRef (activityTotalPreemptionTimeRef act)
activityTotalPreemptionTimeChanged :: MonadDES m => Activity m s a b -> Signal m Double
activityTotalPreemptionTimeChanged act =
mapSignalM (const $ activityTotalPreemptionTime act) (activityTotalPreemptionTimeChanged_ act)
activityTotalPreemptionTimeChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
activityTotalPreemptionTimeChanged_ act =
mapSignal (const ()) (activityPreemptionEnding act)
activityUtilisationTime :: MonadDES m => Activity m s a b -> Event m (SamplingStats Double)
activityUtilisationTime act =
Event $ \p -> invokeEvent p $ readRef (activityUtilisationTimeRef act)
activityUtilisationTimeChanged :: MonadDES m => Activity m s a b -> Signal m (SamplingStats Double)
activityUtilisationTimeChanged act =
mapSignalM (const $ activityUtilisationTime act) (activityUtilisationTimeChanged_ act)
activityUtilisationTimeChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
activityUtilisationTimeChanged_ act =
mapSignal (const ()) (activityUtilised act)
activityIdleTime :: MonadDES m => Activity m s a b -> Event m (SamplingStats Double)
activityIdleTime act =
Event $ \p -> invokeEvent p $ readRef (activityIdleTimeRef act)
activityIdleTimeChanged :: MonadDES m => Activity m s a b -> Signal m (SamplingStats Double)
activityIdleTimeChanged act =
mapSignalM (const $ activityIdleTime act) (activityIdleTimeChanged_ act)
activityIdleTimeChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
activityIdleTimeChanged_ act =
mapSignal (const ()) (activityUtilising act)
activityPreemptionTime :: MonadDES m => Activity m s a b -> Event m (SamplingStats Double)
activityPreemptionTime act =
Event $ \p -> invokeEvent p $ readRef (activityPreemptionTimeRef act)
activityPreemptionTimeChanged :: MonadDES m => Activity m s a b -> Signal m (SamplingStats Double)
activityPreemptionTimeChanged act =
mapSignalM (const $ activityPreemptionTime act) (activityPreemptionTimeChanged_ act)
activityPreemptionTimeChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
activityPreemptionTimeChanged_ act =
mapSignal (const ()) (activityPreemptionEnding act)
activityUtilisationFactor :: MonadDES m => Activity m s a b -> Event m Double
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
activityUtilisationFactorChanged act =
mapSignalM (const $ activityUtilisationFactor act) (activityUtilisationFactorChanged_ act)
activityUtilisationFactorChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
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
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
activityIdleFactorChanged act =
mapSignalM (const $ activityIdleFactor act) (activityIdleFactorChanged_ act)
activityIdleFactorChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
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
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
activityPreemptionFactorChanged act =
mapSignalM (const $ activityPreemptionFactor act) (activityPreemptionFactorChanged_ act)
activityPreemptionFactorChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
activityPreemptionFactorChanged_ act =
mapSignal (const ()) (activityUtilising act) <>
mapSignal (const ()) (activityUtilised act) <>
mapSignal (const ()) (activityPreemptionEnding act)
activityUtilising :: Activity m s a b -> Signal m a
activityUtilising = publishSignal . activityUtilisingSource
activityUtilised :: Activity m s a b -> Signal m (a, b)
activityUtilised = publishSignal . activityUtilisedSource
activityPreemptionBeginning :: Activity m s a b -> Signal m a
activityPreemptionBeginning = publishSignal . activityPreemptionBeginningSource
activityPreemptionEnding :: Activity m s a b -> Signal m a
activityPreemptionEnding = publishSignal . activityPreemptionEndingSource
activityChanged_ :: MonadDES m => Activity m s a b -> Signal m ()
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
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)