module Simulation.Aivika.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.IORef
import Data.Monoid
import Control.Monad
import Control.Monad.Trans
import Control.Arrow
import Simulation.Aivika.Simulation
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Signal
import Simulation.Aivika.Cont
import Simulation.Aivika.Process
import Simulation.Aivika.Net
import Simulation.Aivika.Server
import Simulation.Aivika.Statistics
data Activity s a b =
Activity { activityInitState :: s,
activityStateRef :: IORef s,
activityProcess :: s -> a -> Process (s, b),
activityProcessPreemptible :: Bool,
activityTotalUtilisationTimeRef :: IORef Double,
activityTotalIdleTimeRef :: IORef Double,
activityTotalPreemptionTimeRef :: IORef Double,
activityUtilisationTimeRef :: IORef (SamplingStats Double),
activityIdleTimeRef :: IORef (SamplingStats Double),
activityPreemptionTimeRef :: IORef (SamplingStats Double),
activityUtilisingSource :: SignalSource a,
activityUtilisedSource :: SignalSource (a, b),
activityPreemptionBeginningSource :: SignalSource a,
activityPreemptionEndingSource :: SignalSource a
}
newActivity :: (a -> Process b)
-> Simulation (Activity () a b)
newActivity = newPreemptibleActivity False
newStateActivity :: (s -> a -> Process (s, b))
-> s
-> Simulation (Activity s a b)
newStateActivity = newPreemptibleStateActivity False
newPreemptibleActivity :: Bool
-> (a -> Process b)
-> Simulation (Activity () a b)
newPreemptibleActivity preemptible provide =
flip (newPreemptibleStateActivity preemptible) () $ \s a ->
do b <- provide a
return (s, b)
newPreemptibleStateActivity :: Bool
-> (s -> a -> Process (s, b))
-> s
-> Simulation (Activity s a b)
newPreemptibleStateActivity preemptible provide state =
do r0 <- liftIO $ newIORef state
r1 <- liftIO $ newIORef 0
r2 <- liftIO $ newIORef 0
r3 <- liftIO $ newIORef 0
r4 <- liftIO $ newIORef emptySamplingStats
r5 <- liftIO $ newIORef emptySamplingStats
r6 <- liftIO $ newIORef 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 :: Activity s a b -> Net 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' ->
liftIO $
do modifyIORef' (activityTotalIdleTimeRef act) (+ (t0 t'))
modifyIORef' (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 liftIO $
do writeIORef (activityStateRef act) $! s'
modifyIORef' (activityTotalUtilisationTimeRef act) (+ (t1 t0 dt))
modifyIORef' (activityUtilisationTimeRef act) $
addSamplingStats (t1 t0 dt)
triggerSignal (activityUtilisedSource act) (a, b)
return (b, Net $ loop s' (Just t1))
activityProcessPreempting :: Activity s a b -> s -> a -> Process (s, b, Double)
activityProcessPreempting act s a =
do pid <- processId
t0 <- liftDynamics time
rs <- liftIO $ newIORef 0
r0 <- liftIO $ newIORef t0
h1 <- liftEvent $
handleSignal (processPreemptionBeginning pid) $ \() ->
do t0 <- liftDynamics time
liftIO $ writeIORef r0 t0
triggerSignal (activityPreemptionBeginningSource act) a
h2 <- liftEvent $
handleSignal (processPreemptionEnding pid) $ \() ->
do t0 <- liftIO $ readIORef r0
t1 <- liftDynamics time
let dt = t1 t0
liftIO $
do modifyIORef' rs (+ dt)
modifyIORef' (activityTotalPreemptionTimeRef act) (+ dt)
modifyIORef' (activityPreemptionTimeRef act) $
addSamplingStats dt
triggerSignal (activityPreemptionEndingSource act) a
let m1 =
do (s', b) <- activityProcess act s a
dt <- liftIO $ readIORef rs
return (s', b, dt)
m2 =
liftEvent $
do disposeEvent h1
disposeEvent h2
finallyProcess m1 m2
activityState :: Activity s a b -> Event s
activityState act =
Event $ \p -> readIORef (activityStateRef act)
activityStateChanged :: Activity s a b -> Signal s
activityStateChanged act =
mapSignalM (const $ activityState act) (activityStateChanged_ act)
activityStateChanged_ :: Activity s a b -> Signal ()
activityStateChanged_ act =
mapSignal (const ()) (activityUtilised act)
activityTotalUtilisationTime :: Activity s a b -> Event Double
activityTotalUtilisationTime act =
Event $ \p -> readIORef (activityTotalUtilisationTimeRef act)
activityTotalUtilisationTimeChanged :: Activity s a b -> Signal Double
activityTotalUtilisationTimeChanged act =
mapSignalM (const $ activityTotalUtilisationTime act) (activityTotalUtilisationTimeChanged_ act)
activityTotalUtilisationTimeChanged_ :: Activity s a b -> Signal ()
activityTotalUtilisationTimeChanged_ act =
mapSignal (const ()) (activityUtilised act)
activityTotalIdleTime :: Activity s a b -> Event Double
activityTotalIdleTime act =
Event $ \p -> readIORef (activityTotalIdleTimeRef act)
activityTotalIdleTimeChanged :: Activity s a b -> Signal Double
activityTotalIdleTimeChanged act =
mapSignalM (const $ activityTotalIdleTime act) (activityTotalIdleTimeChanged_ act)
activityTotalIdleTimeChanged_ :: Activity s a b -> Signal ()
activityTotalIdleTimeChanged_ act =
mapSignal (const ()) (activityUtilising act)
activityTotalPreemptionTime :: Activity s a b -> Event Double
activityTotalPreemptionTime act =
Event $ \p -> readIORef (activityTotalPreemptionTimeRef act)
activityTotalPreemptionTimeChanged :: Activity s a b -> Signal Double
activityTotalPreemptionTimeChanged act =
mapSignalM (const $ activityTotalPreemptionTime act) (activityTotalPreemptionTimeChanged_ act)
activityTotalPreemptionTimeChanged_ :: Activity s a b -> Signal ()
activityTotalPreemptionTimeChanged_ act =
mapSignal (const ()) (activityPreemptionEnding act)
activityUtilisationTime :: Activity s a b -> Event (SamplingStats Double)
activityUtilisationTime act =
Event $ \p -> readIORef (activityUtilisationTimeRef act)
activityUtilisationTimeChanged :: Activity s a b -> Signal (SamplingStats Double)
activityUtilisationTimeChanged act =
mapSignalM (const $ activityUtilisationTime act) (activityUtilisationTimeChanged_ act)
activityUtilisationTimeChanged_ :: Activity s a b -> Signal ()
activityUtilisationTimeChanged_ act =
mapSignal (const ()) (activityUtilised act)
activityIdleTime :: Activity s a b -> Event (SamplingStats Double)
activityIdleTime act =
Event $ \p -> readIORef (activityIdleTimeRef act)
activityIdleTimeChanged :: Activity s a b -> Signal (SamplingStats Double)
activityIdleTimeChanged act =
mapSignalM (const $ activityIdleTime act) (activityIdleTimeChanged_ act)
activityIdleTimeChanged_ :: Activity s a b -> Signal ()
activityIdleTimeChanged_ act =
mapSignal (const ()) (activityUtilising act)
activityPreemptionTime :: Activity s a b -> Event (SamplingStats Double)
activityPreemptionTime act =
Event $ \p -> readIORef (activityPreemptionTimeRef act)
activityPreemptionTimeChanged :: Activity s a b -> Signal (SamplingStats Double)
activityPreemptionTimeChanged act =
mapSignalM (const $ activityPreemptionTime act) (activityPreemptionTimeChanged_ act)
activityPreemptionTimeChanged_ :: Activity s a b -> Signal ()
activityPreemptionTimeChanged_ act =
mapSignal (const ()) (activityPreemptionEnding act)
activityUtilisationFactor :: Activity s a b -> Event Double
activityUtilisationFactor act =
Event $ \p ->
do x1 <- readIORef (activityTotalUtilisationTimeRef act)
x2 <- readIORef (activityTotalIdleTimeRef act)
x3 <- readIORef (activityTotalPreemptionTimeRef act)
return (x1 / (x1 + x2 + x3))
activityUtilisationFactorChanged :: Activity s a b -> Signal Double
activityUtilisationFactorChanged act =
mapSignalM (const $ activityUtilisationFactor act) (activityUtilisationFactorChanged_ act)
activityUtilisationFactorChanged_ :: Activity s a b -> Signal ()
activityUtilisationFactorChanged_ act =
mapSignal (const ()) (activityUtilising act) <>
mapSignal (const ()) (activityUtilised act) <>
mapSignal (const ()) (activityPreemptionEnding act)
activityIdleFactor :: Activity s a b -> Event Double
activityIdleFactor act =
Event $ \p ->
do x1 <- readIORef (activityTotalUtilisationTimeRef act)
x2 <- readIORef (activityTotalIdleTimeRef act)
x3 <- readIORef (activityTotalPreemptionTimeRef act)
return (x2 / (x1 + x2 + x3))
activityIdleFactorChanged :: Activity s a b -> Signal Double
activityIdleFactorChanged act =
mapSignalM (const $ activityIdleFactor act) (activityIdleFactorChanged_ act)
activityIdleFactorChanged_ :: Activity s a b -> Signal ()
activityIdleFactorChanged_ act =
mapSignal (const ()) (activityUtilising act) <>
mapSignal (const ()) (activityUtilised act) <>
mapSignal (const ()) (activityPreemptionEnding act)
activityPreemptionFactor :: Activity s a b -> Event Double
activityPreemptionFactor act =
Event $ \p ->
do x1 <- readIORef (activityTotalUtilisationTimeRef act)
x2 <- readIORef (activityTotalIdleTimeRef act)
x3 <- readIORef (activityTotalPreemptionTimeRef act)
return (x3 / (x1 + x2 + x3))
activityPreemptionFactorChanged :: Activity s a b -> Signal Double
activityPreemptionFactorChanged act =
mapSignalM (const $ activityPreemptionFactor act) (activityPreemptionFactorChanged_ act)
activityPreemptionFactorChanged_ :: Activity s a b -> Signal ()
activityPreemptionFactorChanged_ act =
mapSignal (const ()) (activityUtilising act) <>
mapSignal (const ()) (activityUtilised act) <>
mapSignal (const ()) (activityPreemptionEnding act)
activityUtilising :: Activity s a b -> Signal a
activityUtilising = publishSignal . activityUtilisingSource
activityUtilised :: Activity s a b -> Signal (a, b)
activityUtilised = publishSignal . activityUtilisedSource
activityPreemptionBeginning :: Activity s a b -> Signal a
activityPreemptionBeginning = publishSignal . activityPreemptionBeginningSource
activityPreemptionEnding :: Activity s a b -> Signal a
activityPreemptionEnding = publishSignal . activityPreemptionEndingSource
activityChanged_ :: Activity s a b -> Signal ()
activityChanged_ act =
mapSignal (const ()) (activityUtilising act) <>
mapSignal (const ()) (activityUtilised act) <>
mapSignal (const ()) (activityPreemptionEnding act)
activitySummary :: Activity s a b -> Int -> Event ShowS
activitySummary act indent =
Event $ \p ->
do tx1 <- readIORef (activityTotalUtilisationTimeRef act)
tx2 <- readIORef (activityTotalIdleTimeRef act)
tx3 <- readIORef (activityTotalPreemptionTimeRef act)
let xf1 = tx1 / (tx1 + tx2 + tx3)
xf2 = tx2 / (tx1 + tx2 + tx3)
xf3 = tx3 / (tx1 + tx2 + tx3)
xs1 <- readIORef (activityUtilisationTimeRef act)
xs2 <- readIORef (activityIdleTimeRef act)
xs3 <- readIORef (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:\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)