module Simulation.Aivika.Arrival
(Arrival(..),
ArrivalTimer,
newArrivalTimer,
arrivalTimerProcessor,
arrivalTimerSignal,
arrivalTimerChannel,
arrivalProcessingTime,
arrivalProcessingTimeChanged,
arrivalProcessingTimeChanged_,
resetArrivalTimer) where
import Control.Monad
import Control.Monad.Trans
import Simulation.Aivika.Simulation
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Event
import Simulation.Aivika.Composite
import Simulation.Aivika.Processor
import Simulation.Aivika.Stream
import Simulation.Aivika.Statistics
import Simulation.Aivika.Ref
import Simulation.Aivika.Signal
import Simulation.Aivika.Channel
import Simulation.Aivika.Internal.Arrival
data ArrivalTimer =
ArrivalTimer { ArrivalTimer -> Ref (SamplingStats Double)
arrivalProcessingTimeRef :: Ref (SamplingStats Double),
ArrivalTimer -> SignalSource ()
arrivalProcessingTimeChangedSource :: SignalSource () }
newArrivalTimer :: Simulation ArrivalTimer
newArrivalTimer :: Simulation ArrivalTimer
newArrivalTimer =
do Ref (SamplingStats Double)
r <- SamplingStats Double -> Simulation (Ref (SamplingStats Double))
forall a. a -> Simulation (Ref a)
newRef SamplingStats Double
forall a. SamplingData a => SamplingStats a
emptySamplingStats
SignalSource ()
s <- Simulation (SignalSource ())
forall a. Simulation (SignalSource a)
newSignalSource
ArrivalTimer -> Simulation ArrivalTimer
forall a. a -> Simulation a
forall (m :: * -> *) a. Monad m => a -> m a
return ArrivalTimer { arrivalProcessingTimeRef :: Ref (SamplingStats Double)
arrivalProcessingTimeRef = Ref (SamplingStats Double)
r,
arrivalProcessingTimeChangedSource :: SignalSource ()
arrivalProcessingTimeChangedSource = SignalSource ()
s }
arrivalProcessingTime :: ArrivalTimer -> Event (SamplingStats Double)
arrivalProcessingTime :: ArrivalTimer -> Event (SamplingStats Double)
arrivalProcessingTime = Ref (SamplingStats Double) -> Event (SamplingStats Double)
forall a. Ref a -> Event a
readRef (Ref (SamplingStats Double) -> Event (SamplingStats Double))
-> (ArrivalTimer -> Ref (SamplingStats Double))
-> ArrivalTimer
-> Event (SamplingStats Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrivalTimer -> Ref (SamplingStats Double)
arrivalProcessingTimeRef
arrivalProcessingTimeChanged :: ArrivalTimer -> Signal (SamplingStats Double)
arrivalProcessingTimeChanged :: ArrivalTimer -> Signal (SamplingStats Double)
arrivalProcessingTimeChanged ArrivalTimer
timer =
(() -> Event (SamplingStats Double))
-> Signal () -> Signal (SamplingStats Double)
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event (SamplingStats Double) -> () -> Event (SamplingStats Double)
forall a b. a -> b -> a
const (Event (SamplingStats Double)
-> () -> Event (SamplingStats Double))
-> Event (SamplingStats Double)
-> ()
-> Event (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ ArrivalTimer -> Event (SamplingStats Double)
arrivalProcessingTime ArrivalTimer
timer) (ArrivalTimer -> Signal ()
arrivalProcessingTimeChanged_ ArrivalTimer
timer)
arrivalProcessingTimeChanged_ :: ArrivalTimer -> Signal ()
arrivalProcessingTimeChanged_ :: ArrivalTimer -> Signal ()
arrivalProcessingTimeChanged_ ArrivalTimer
timer =
SignalSource () -> Signal ()
forall a. SignalSource a -> Signal a
publishSignal (ArrivalTimer -> SignalSource ()
arrivalProcessingTimeChangedSource ArrivalTimer
timer)
arrivalTimerProcessor :: ArrivalTimer -> Processor (Arrival a) (Arrival a)
arrivalTimerProcessor :: forall a. ArrivalTimer -> Processor (Arrival a) (Arrival a)
arrivalTimerProcessor ArrivalTimer
timer =
(Stream (Arrival a) -> Stream (Arrival a))
-> Processor (Arrival a) (Arrival a)
forall a b. (Stream a -> Stream b) -> Processor a b
Processor ((Stream (Arrival a) -> Stream (Arrival a))
-> Processor (Arrival a) (Arrival a))
-> (Stream (Arrival a) -> Stream (Arrival a))
-> Processor (Arrival a) (Arrival a)
forall a b. (a -> b) -> a -> b
$ \Stream (Arrival a)
xs -> Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a)
forall a. Process (a, Stream a) -> Stream a
Cons (Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a))
-> Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a)
forall a b. (a -> b) -> a -> b
$ Stream (Arrival a) -> Process (Arrival a, Stream (Arrival a))
forall {a}.
Stream (Arrival a) -> Process (Arrival a, Stream (Arrival a))
loop Stream (Arrival a)
xs where
loop :: Stream (Arrival a) -> Process (Arrival a, Stream (Arrival a))
loop Stream (Arrival a)
xs =
do (Arrival a
a, Stream (Arrival a)
xs) <- Stream (Arrival a) -> Process (Arrival a, Stream (Arrival a))
forall a. Stream a -> Process (a, Stream a)
runStream Stream (Arrival a)
xs
Event () -> Process ()
forall a. Event a -> Process a
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
forall a b. (a -> b) -> a -> b
$
do Double
t <- Dynamics Double -> Event Double
forall a. Dynamics a -> Event a
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
Ref (SamplingStats Double)
-> (SamplingStats Double -> SamplingStats Double) -> Event ()
forall a. Ref a -> (a -> a) -> Event ()
modifyRef (ArrivalTimer -> Ref (SamplingStats Double)
arrivalProcessingTimeRef ArrivalTimer
timer) ((SamplingStats Double -> SamplingStats Double) -> Event ())
-> (SamplingStats Double -> SamplingStats Double) -> Event ()
forall a b. (a -> b) -> a -> b
$
Double -> SamplingStats Double -> SamplingStats Double
forall a. SamplingData a => a -> SamplingStats a -> SamplingStats a
addSamplingStats (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Arrival a -> Double
forall a. Arrival a -> Double
arrivalTime Arrival a
a)
SignalSource () -> () -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (ArrivalTimer -> SignalSource ()
arrivalProcessingTimeChangedSource ArrivalTimer
timer) ()
(Arrival a, Stream (Arrival a))
-> Process (Arrival a, Stream (Arrival a))
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Arrival a
a, Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a)
forall a. Process (a, Stream a) -> Stream a
Cons (Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a))
-> Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a)
forall a b. (a -> b) -> a -> b
$ Stream (Arrival a) -> Process (Arrival a, Stream (Arrival a))
loop Stream (Arrival a)
xs)
arrivalTimerSignal :: ArrivalTimer -> Signal (Arrival a) -> Signal (Arrival a)
arrivalTimerSignal :: forall a. ArrivalTimer -> Signal (Arrival a) -> Signal (Arrival a)
arrivalTimerSignal ArrivalTimer
timer Signal (Arrival a)
sa =
Signal { handleSignal :: (Arrival a -> Event ()) -> Event DisposableEvent
handleSignal = \Arrival a -> Event ()
h ->
Signal (Arrival a)
-> (Arrival a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal (Arrival a)
sa ((Arrival a -> Event ()) -> Event DisposableEvent)
-> (Arrival a -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ \Arrival a
a ->
do Double
t <- Dynamics Double -> Event Double
forall a. Dynamics a -> Event a
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
Ref (SamplingStats Double)
-> (SamplingStats Double -> SamplingStats Double) -> Event ()
forall a. Ref a -> (a -> a) -> Event ()
modifyRef (ArrivalTimer -> Ref (SamplingStats Double)
arrivalProcessingTimeRef ArrivalTimer
timer) ((SamplingStats Double -> SamplingStats Double) -> Event ())
-> (SamplingStats Double -> SamplingStats Double) -> Event ()
forall a b. (a -> b) -> a -> b
$
Double -> SamplingStats Double -> SamplingStats Double
forall a. SamplingData a => a -> SamplingStats a -> SamplingStats a
addSamplingStats (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Arrival a -> Double
forall a. Arrival a -> Double
arrivalTime Arrival a
a)
Arrival a -> Event ()
h Arrival a
a
}
arrivalTimerChannel :: ArrivalTimer -> Channel (Arrival a) (Arrival a)
arrivalTimerChannel :: forall a. ArrivalTimer -> Channel (Arrival a) (Arrival a)
arrivalTimerChannel ArrivalTimer
timer =
(Signal (Arrival a) -> Composite (Signal (Arrival a)))
-> Channel (Arrival a) (Arrival a)
forall a b. (Signal a -> Composite (Signal b)) -> Channel a b
Channel ((Signal (Arrival a) -> Composite (Signal (Arrival a)))
-> Channel (Arrival a) (Arrival a))
-> (Signal (Arrival a) -> Composite (Signal (Arrival a)))
-> Channel (Arrival a) (Arrival a)
forall a b. (a -> b) -> a -> b
$ \Signal (Arrival a)
sa ->
Signal (Arrival a) -> Composite (Signal (Arrival a))
forall a. a -> Composite a
forall (m :: * -> *) a. Monad m => a -> m a
return (Signal (Arrival a) -> Composite (Signal (Arrival a)))
-> Signal (Arrival a) -> Composite (Signal (Arrival a))
forall a b. (a -> b) -> a -> b
$ ArrivalTimer -> Signal (Arrival a) -> Signal (Arrival a)
forall a. ArrivalTimer -> Signal (Arrival a) -> Signal (Arrival a)
arrivalTimerSignal ArrivalTimer
timer Signal (Arrival a)
sa
resetArrivalTimer :: ArrivalTimer -> Event ()
resetArrivalTimer :: ArrivalTimer -> Event ()
resetArrivalTimer ArrivalTimer
timer =
do Ref (SamplingStats Double) -> SamplingStats Double -> Event ()
forall a. Ref a -> a -> Event ()
writeRef (ArrivalTimer -> Ref (SamplingStats Double)
arrivalProcessingTimeRef ArrivalTimer
timer) SamplingStats Double
forall a. SamplingData a => SamplingStats a
emptySamplingStats
SignalSource () -> () -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (ArrivalTimer -> SignalSource ()
arrivalProcessingTimeChangedSource ArrivalTimer
timer) ()