module Simulation.Aivika.Trans.Activity
(
Activity,
newActivity,
newStateActivity,
activityNet,
activityInitState,
activityState,
activityTotalUtilisationTime,
activityTotalIdleTime,
activityUtilisationTime,
activityIdleTime,
activityUtilisationFactor,
activityIdleFactor,
activitySummary,
activityStateChanged,
activityStateChanged_,
activityTotalUtilisationTimeChanged,
activityTotalUtilisationTimeChanged_,
activityTotalIdleTimeChanged,
activityTotalIdleTimeChanged_,
activityUtilisationTimeChanged,
activityUtilisationTimeChanged_,
activityIdleTimeChanged,
activityIdleTimeChanged_,
activityUtilisationFactorChanged,
activityUtilisationFactorChanged_,
activityIdleFactorChanged,
activityIdleFactorChanged_,
activityUtilising,
activityUtilised,
activityChanged_) where
import Data.Monoid
import Control.Monad.Trans
import Control.Arrow
import Simulation.Aivika.Trans.Session
import Simulation.Aivika.Trans.ProtoRef
import Simulation.Aivika.Trans.Comp
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.Internal.Signal
import Simulation.Aivika.Trans.Resource
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 :: ProtoRef m s,
activityProcess :: s -> a -> Process m (s, b),
activityTotalUtilisationTimeRef :: ProtoRef m Double,
activityTotalIdleTimeRef :: ProtoRef m Double,
activityUtilisationTimeRef :: ProtoRef m (SamplingStats Double),
activityIdleTimeRef :: ProtoRef m (SamplingStats Double),
activityUtilisingSource :: SignalSource m a,
activityUtilisedSource :: SignalSource m (a, b)
}
newActivity :: MonadComp m
=> (a -> Process m b)
-> Simulation m (Activity m () a b)
newActivity provide =
flip newStateActivity () $ \s a ->
do b <- provide a
return (s, b)
newStateActivity :: MonadComp m
=> (s -> a -> Process m (s, b))
-> s
-> Simulation m (Activity m s a b)
newStateActivity provide state =
do sn <- liftParameter simulationSession
r0 <- liftComp $ newProtoRef sn state
r1 <- liftComp $ newProtoRef sn 0
r2 <- liftComp $ newProtoRef sn 0
r3 <- liftComp $ newProtoRef sn emptySamplingStats
r4 <- liftComp $ newProtoRef sn emptySamplingStats
s1 <- newSignalSource
s2 <- newSignalSource
return Activity { activityInitState = state,
activityStateRef = r0,
activityProcess = provide,
activityTotalUtilisationTimeRef = r1,
activityTotalIdleTimeRef = r2,
activityUtilisationTimeRef = r3,
activityIdleTimeRef = r4,
activityUtilisingSource = s1,
activityUtilisedSource = s2 }
activityNet :: MonadComp 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' ->
liftComp $
do modifyProtoRef' (activityTotalIdleTimeRef act) (+ (t0 t'))
modifyProtoRef' (activityIdleTimeRef act) $
addSamplingStats (t0 t')
triggerSignal (activityUtilisingSource act) a
(s', b) <- activityProcess act s a
t1 <- liftDynamics time
liftEvent $
do liftComp $
do writeProtoRef (activityStateRef act) $! s'
modifyProtoRef' (activityTotalUtilisationTimeRef act) (+ (t1 t0))
modifyProtoRef' (activityUtilisationTimeRef act) $
addSamplingStats (t1 t0)
triggerSignal (activityUtilisedSource act) (a, b)
return (b, Net $ loop s' (Just t1))
activityState :: MonadComp m => Activity m s a b -> Event m s
activityState act =
Event $ \p -> readProtoRef (activityStateRef act)
activityStateChanged :: MonadComp m => Activity m s a b -> Signal m s
activityStateChanged act =
mapSignalM (const $ activityState act) (activityStateChanged_ act)
activityStateChanged_ :: MonadComp m => Activity m s a b -> Signal m ()
activityStateChanged_ act =
mapSignal (const ()) (activityUtilised act)
activityTotalUtilisationTime :: MonadComp m => Activity m s a b -> Event m Double
activityTotalUtilisationTime act =
Event $ \p -> readProtoRef (activityTotalUtilisationTimeRef act)
activityTotalUtilisationTimeChanged :: MonadComp m => Activity m s a b -> Signal m Double
activityTotalUtilisationTimeChanged act =
mapSignalM (const $ activityTotalUtilisationTime act) (activityTotalUtilisationTimeChanged_ act)
activityTotalUtilisationTimeChanged_ :: MonadComp m => Activity m s a b -> Signal m ()
activityTotalUtilisationTimeChanged_ act =
mapSignal (const ()) (activityUtilised act)
activityTotalIdleTime :: MonadComp m => Activity m s a b -> Event m Double
activityTotalIdleTime act =
Event $ \p -> readProtoRef (activityTotalIdleTimeRef act)
activityTotalIdleTimeChanged :: MonadComp m => Activity m s a b -> Signal m Double
activityTotalIdleTimeChanged act =
mapSignalM (const $ activityTotalIdleTime act) (activityTotalIdleTimeChanged_ act)
activityTotalIdleTimeChanged_ :: MonadComp m => Activity m s a b -> Signal m ()
activityTotalIdleTimeChanged_ act =
mapSignal (const ()) (activityUtilising act)
activityUtilisationTime :: MonadComp m => Activity m s a b -> Event m (SamplingStats Double)
activityUtilisationTime act =
Event $ \p -> readProtoRef (activityUtilisationTimeRef act)
activityUtilisationTimeChanged :: MonadComp m => Activity m s a b -> Signal m (SamplingStats Double)
activityUtilisationTimeChanged act =
mapSignalM (const $ activityUtilisationTime act) (activityUtilisationTimeChanged_ act)
activityUtilisationTimeChanged_ :: MonadComp m => Activity m s a b -> Signal m ()
activityUtilisationTimeChanged_ act =
mapSignal (const ()) (activityUtilised act)
activityIdleTime :: MonadComp m => Activity m s a b -> Event m (SamplingStats Double)
activityIdleTime act =
Event $ \p -> readProtoRef (activityIdleTimeRef act)
activityIdleTimeChanged :: MonadComp m => Activity m s a b -> Signal m (SamplingStats Double)
activityIdleTimeChanged act =
mapSignalM (const $ activityIdleTime act) (activityIdleTimeChanged_ act)
activityIdleTimeChanged_ :: MonadComp m => Activity m s a b -> Signal m ()
activityIdleTimeChanged_ act =
mapSignal (const ()) (activityUtilising act)
activityUtilisationFactor :: MonadComp m => Activity m s a b -> Event m Double
activityUtilisationFactor act =
Event $ \p ->
do x1 <- readProtoRef (activityTotalUtilisationTimeRef act)
x2 <- readProtoRef (activityTotalIdleTimeRef act)
return (x1 / (x1 + x2))
activityUtilisationFactorChanged :: MonadComp m => Activity m s a b -> Signal m Double
activityUtilisationFactorChanged act =
mapSignalM (const $ activityUtilisationFactor act) (activityUtilisationFactorChanged_ act)
activityUtilisationFactorChanged_ :: MonadComp m => Activity m s a b -> Signal m ()
activityUtilisationFactorChanged_ act =
mapSignal (const ()) (activityUtilising act) <>
mapSignal (const ()) (activityUtilised act)
activityIdleFactor :: MonadComp m => Activity m s a b -> Event m Double
activityIdleFactor act =
Event $ \p ->
do x1 <- readProtoRef (activityTotalUtilisationTimeRef act)
x2 <- readProtoRef (activityTotalIdleTimeRef act)
return (x2 / (x1 + x2))
activityIdleFactorChanged :: MonadComp m => Activity m s a b -> Signal m Double
activityIdleFactorChanged act =
mapSignalM (const $ activityIdleFactor act) (activityIdleFactorChanged_ act)
activityIdleFactorChanged_ :: MonadComp m => Activity m s a b -> Signal m ()
activityIdleFactorChanged_ act =
mapSignal (const ()) (activityUtilising act) <>
mapSignal (const ()) (activityUtilised 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
activityChanged_ :: MonadComp m => Activity m s a b -> Signal m ()
activityChanged_ act =
mapSignal (const ()) (activityUtilising act) <>
mapSignal (const ()) (activityUtilised act)
activitySummary :: MonadComp m => Activity m s a b -> Int -> Event m ShowS
activitySummary act indent =
Event $ \p ->
do tx1 <- readProtoRef (activityTotalUtilisationTimeRef act)
tx2 <- readProtoRef (activityTotalIdleTimeRef act)
let xf1 = tx1 / (tx1 + tx2)
xf2 = tx2 / (tx1 + tx2)
xs1 <- readProtoRef (activityUtilisationTimeRef act)
xs2 <- readProtoRef (activityIdleTimeRef 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 "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 "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)