module Simulation.Aivika.GPSS.Queue
(
Queue,
QueueEntry(..),
newQueue,
queueNull,
queueContent,
queueContentStats,
enqueueCount,
enqueueZeroEntryCount,
queueWaitTime,
queueNonZeroEntryWaitTime,
queueRate,
enqueue,
dequeue,
resetQueue,
queueNullChanged,
queueNullChanged_,
queueContentChanged,
queueContentChanged_,
enqueueCountChanged,
enqueueCountChanged_,
enqueueZeroEntryCountChanged,
enqueueZeroEntryCountChanged_,
queueWaitTimeChanged,
queueWaitTimeChanged_,
queueNonZeroEntryWaitTimeChanged,
queueNonZeroEntryWaitTimeChanged_,
queueRateChanged,
queueRateChanged_,
enqueued,
dequeued,
queueChanged_) where
import Data.IORef
import Data.Monoid
import Data.Maybe
import Data.Hashable
import Control.Monad
import Control.Monad.Trans
import Simulation.Aivika
import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Dynamics
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Internal.Process
import Simulation.Aivika.Signal
import Simulation.Aivika.Statistics
import Simulation.Aivika.GPSS.Transact
data Queue =
Queue { Queue -> Int
queueSequenceNo :: Int,
Queue -> IORef Int
queueContentRef :: IORef Int,
Queue -> IORef (TimingStats Int)
queueContentStatsRef :: IORef (TimingStats Int),
Queue -> IORef Int
enqueueCountRef :: IORef Int,
Queue -> IORef Int
enqueueZeroEntryCountRef :: IORef Int,
Queue -> IORef (SamplingStats Double)
queueWaitTimeRef :: IORef (SamplingStats Double),
Queue -> IORef (SamplingStats Double)
queueNonZeroEntryWaitTimeRef :: IORef (SamplingStats Double),
Queue -> SignalSource ()
enqueuedSource :: SignalSource (),
Queue -> SignalSource ()
dequeuedSource :: SignalSource ()
}
data QueueEntry =
QueueEntry { QueueEntry -> Queue
entryQueue :: Queue,
QueueEntry -> Double
entryEnqueueTime :: Double
} deriving QueueEntry -> QueueEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueueEntry -> QueueEntry -> Bool
$c/= :: QueueEntry -> QueueEntry -> Bool
== :: QueueEntry -> QueueEntry -> Bool
$c== :: QueueEntry -> QueueEntry -> Bool
Eq
instance Eq Queue where
Queue
x == :: Queue -> Queue -> Bool
== Queue
y = (Queue -> IORef Int
queueContentRef Queue
x) forall a. Eq a => a -> a -> Bool
== (Queue -> IORef Int
queueContentRef Queue
y)
instance Hashable Queue where
hashWithSalt :: Int -> Queue -> Int
hashWithSalt Int
salt Queue
x = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Queue -> Int
queueSequenceNo Queue
x)
newQueue :: Event Queue
newQueue :: Event Queue
newQueue =
do Double
t <- forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
Generator
g <- forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter Generator
generatorParameter
Int
no <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Generator -> IO Int
generateSequenceNo Generator
g
IORef Int
i <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Int
0
IORef (TimingStats Int)
is <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ forall a. TimingData a => Double -> a -> TimingStats a
returnTimingStats Double
t Int
0
IORef Int
e <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Int
0
IORef Int
z <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Int
0
IORef (SamplingStats Double)
w <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty
IORef (SamplingStats Double)
w2 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty
SignalSource ()
s1 <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall a. Simulation (SignalSource a)
newSignalSource
SignalSource ()
s2 <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall a. Simulation (SignalSource a)
newSignalSource
forall (m :: * -> *) a. Monad m => a -> m a
return Queue { queueSequenceNo :: Int
queueSequenceNo = Int
no,
queueContentRef :: IORef Int
queueContentRef = IORef Int
i,
queueContentStatsRef :: IORef (TimingStats Int)
queueContentStatsRef = IORef (TimingStats Int)
is,
enqueueCountRef :: IORef Int
enqueueCountRef = IORef Int
e,
enqueueZeroEntryCountRef :: IORef Int
enqueueZeroEntryCountRef = IORef Int
z,
queueWaitTimeRef :: IORef (SamplingStats Double)
queueWaitTimeRef = IORef (SamplingStats Double)
w,
queueNonZeroEntryWaitTimeRef :: IORef (SamplingStats Double)
queueNonZeroEntryWaitTimeRef = IORef (SamplingStats Double)
w2,
enqueuedSource :: SignalSource ()
enqueuedSource = SignalSource ()
s1,
dequeuedSource :: SignalSource ()
dequeuedSource = SignalSource ()
s2 }
queueNull :: Queue -> Event Bool
queueNull :: Queue -> Event Bool
queueNull Queue
q =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do Int
n <- forall a. IORef a -> IO a
readIORef (Queue -> IORef Int
queueContentRef Queue
q)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n forall a. Eq a => a -> a -> Bool
== Int
0)
queueNullChanged :: Queue -> Signal Bool
queueNullChanged :: Queue -> Signal Bool
queueNullChanged Queue
q =
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Queue -> Event Bool
queueNull Queue
q) (Queue -> Signal ()
queueNullChanged_ Queue
q)
queueNullChanged_ :: Queue -> Signal ()
queueNullChanged_ :: Queue -> Signal ()
queueNullChanged_ = Queue -> Signal ()
queueContentChanged_
queueContent :: Queue -> Event Int
queueContent :: Queue -> Event Int
queueContent Queue
q =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> forall a. IORef a -> IO a
readIORef (Queue -> IORef Int
queueContentRef Queue
q)
queueContentStats :: Queue -> Event (TimingStats Int)
queueContentStats :: Queue -> Event (TimingStats Int)
queueContentStats Queue
q =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> forall a. IORef a -> IO a
readIORef (Queue -> IORef (TimingStats Int)
queueContentStatsRef Queue
q)
queueContentChanged :: Queue -> Signal Int
queueContentChanged :: Queue -> Signal Int
queueContentChanged Queue
q =
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Queue -> Event Int
queueContent Queue
q) (Queue -> Signal ()
queueContentChanged_ Queue
q)
queueContentChanged_ :: Queue -> Signal ()
queueContentChanged_ :: Queue -> Signal ()
queueContentChanged_ Queue
q =
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) (Queue -> Signal ()
enqueued Queue
q) forall a. Semigroup a => a -> a -> a
<>
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) (Queue -> Signal ()
dequeued Queue
q)
enqueueCount :: Queue -> Event Int
enqueueCount :: Queue -> Event Int
enqueueCount Queue
q =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> forall a. IORef a -> IO a
readIORef (Queue -> IORef Int
enqueueCountRef Queue
q)
enqueueCountChanged :: Queue -> Signal Int
enqueueCountChanged :: Queue -> Signal Int
enqueueCountChanged Queue
q =
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Queue -> Event Int
enqueueCount Queue
q) (Queue -> Signal ()
enqueueCountChanged_ Queue
q)
enqueueCountChanged_ :: Queue -> Signal ()
enqueueCountChanged_ :: Queue -> Signal ()
enqueueCountChanged_ Queue
q =
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) (Queue -> Signal ()
enqueued Queue
q)
enqueueZeroEntryCount :: Queue -> Event Int
enqueueZeroEntryCount :: Queue -> Event Int
enqueueZeroEntryCount Queue
q =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> forall a. IORef a -> IO a
readIORef (Queue -> IORef Int
enqueueZeroEntryCountRef Queue
q)
enqueueZeroEntryCountChanged :: Queue -> Signal Int
enqueueZeroEntryCountChanged :: Queue -> Signal Int
enqueueZeroEntryCountChanged Queue
q =
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Queue -> Event Int
enqueueZeroEntryCount Queue
q) (Queue -> Signal ()
enqueueZeroEntryCountChanged_ Queue
q)
enqueueZeroEntryCountChanged_ :: Queue -> Signal ()
enqueueZeroEntryCountChanged_ :: Queue -> Signal ()
enqueueZeroEntryCountChanged_ Queue
q =
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) (Queue -> Signal ()
dequeued Queue
q)
queueWaitTime :: Queue -> Event (SamplingStats Double)
queueWaitTime :: Queue -> Event (SamplingStats Double)
queueWaitTime Queue
q =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> forall a. IORef a -> IO a
readIORef (Queue -> IORef (SamplingStats Double)
queueWaitTimeRef Queue
q)
queueWaitTimeChanged :: Queue -> Signal (SamplingStats Double)
queueWaitTimeChanged :: Queue -> Signal (SamplingStats Double)
queueWaitTimeChanged Queue
q =
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Queue -> Event (SamplingStats Double)
queueWaitTime Queue
q) (Queue -> Signal ()
queueWaitTimeChanged_ Queue
q)
queueWaitTimeChanged_ :: Queue -> Signal ()
queueWaitTimeChanged_ :: Queue -> Signal ()
queueWaitTimeChanged_ Queue
q =
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) (Queue -> Signal ()
dequeued Queue
q)
queueNonZeroEntryWaitTime :: Queue -> Event (SamplingStats Double)
queueNonZeroEntryWaitTime :: Queue -> Event (SamplingStats Double)
queueNonZeroEntryWaitTime Queue
q =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> forall a. IORef a -> IO a
readIORef (Queue -> IORef (SamplingStats Double)
queueNonZeroEntryWaitTimeRef Queue
q)
queueNonZeroEntryWaitTimeChanged :: Queue -> Signal (SamplingStats Double)
queueNonZeroEntryWaitTimeChanged :: Queue -> Signal (SamplingStats Double)
queueNonZeroEntryWaitTimeChanged Queue
q =
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Queue -> Event (SamplingStats Double)
queueNonZeroEntryWaitTime Queue
q) (Queue -> Signal ()
queueNonZeroEntryWaitTimeChanged_ Queue
q)
queueNonZeroEntryWaitTimeChanged_ :: Queue -> Signal ()
queueNonZeroEntryWaitTimeChanged_ :: Queue -> Signal ()
queueNonZeroEntryWaitTimeChanged_ Queue
q =
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) (Queue -> Signal ()
dequeued Queue
q)
queueRate :: Queue -> Event Double
queueRate :: Queue -> Event Double
queueRate Queue
q =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do TimingStats Int
x <- forall a. IORef a -> IO a
readIORef (Queue -> IORef (TimingStats Int)
queueContentStatsRef Queue
q)
SamplingStats Double
y <- forall a. IORef a -> IO a
readIORef (Queue -> IORef (SamplingStats Double)
queueWaitTimeRef Queue
q)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. TimingData a => TimingStats a -> Double
timingStatsMean TimingStats Int
x forall a. Fractional a => a -> a -> a
/ forall a. SamplingStats a -> Double
samplingStatsMean SamplingStats Double
y)
queueRateChanged :: Queue -> Signal Double
queueRateChanged :: Queue -> Signal Double
queueRateChanged Queue
q =
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Queue -> Event Double
queueRate Queue
q) (Queue -> Signal ()
queueRateChanged_ Queue
q)
queueRateChanged_ :: Queue -> Signal ()
queueRateChanged_ :: Queue -> Signal ()
queueRateChanged_ Queue
q =
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) (Queue -> Signal ()
enqueued Queue
q) forall a. Semigroup a => a -> a -> a
<>
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) (Queue -> Signal ()
dequeued Queue
q)
enqueued:: Queue -> Signal ()
enqueued :: Queue -> Signal ()
enqueued Queue
q = forall a. SignalSource a -> Signal a
publishSignal (Queue -> SignalSource ()
enqueuedSource Queue
q)
dequeued :: Queue -> Signal ()
dequeued :: Queue -> Signal ()
dequeued Queue
q = forall a. SignalSource a -> Signal a
publishSignal (Queue -> SignalSource ()
dequeuedSource Queue
q)
enqueue :: Queue
-> Transact a
-> Int
-> Event ()
enqueue :: forall a. Queue -> Transact a -> Int -> Event ()
enqueue Queue
q Transact a
transact Int
increment =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do let t :: Double
t = Point -> Double
pointTime Point
p
e :: QueueEntry
e = QueueEntry { entryQueue :: Queue
entryQueue = Queue
q,
entryEnqueueTime :: Double
entryEnqueueTime = Double
t }
Int
n <- forall a. IORef a -> IO a
readIORef (Queue -> IORef Int
enqueueCountRef Queue
q)
let n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
+ Int
1
Int
n' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef Int
enqueueCountRef Queue
q) Int
n'
Int
c <- forall a. IORef a -> IO a
readIORef (Queue -> IORef Int
queueContentRef Queue
q)
let c' :: Int
c' = Int
c forall a. Num a => a -> a -> a
+ Int
increment
Int
c' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef Int
queueContentRef Queue
q) Int
c'
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Queue -> IORef (TimingStats Int)
queueContentStatsRef Queue
q) (forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats Double
t Int
c')
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
forall a. Transact a -> QueueEntry -> Event ()
registerTransactQueueEntry Transact a
transact QueueEntry
e
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
forall a. SignalSource a -> a -> Event ()
triggerSignal (Queue -> SignalSource ()
enqueuedSource Queue
q) ()
dequeue :: Queue
-> Transact a
-> Int
-> Event ()
dequeue :: forall a. Queue -> Transact a -> Int -> Event ()
dequeue Queue
q Transact a
transact Int
decrement =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do QueueEntry
e <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
forall a. Transact a -> Queue -> Event QueueEntry
unregisterTransactQueueEntry Transact a
transact Queue
q
let t :: Double
t = Point -> Double
pointTime Point
p
t0 :: Double
t0 = QueueEntry -> Double
entryEnqueueTime QueueEntry
e
dt :: Double
dt = Double
t forall a. Num a => a -> a -> a
- Double
t0
Int
c <- forall a. IORef a -> IO a
readIORef (Queue -> IORef Int
queueContentRef Queue
q)
let c' :: Int
c' = Int
c forall a. Num a => a -> a -> a
- Int
decrement
Int
c' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef Int
queueContentRef Queue
q) Int
c'
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Queue -> IORef (TimingStats Int)
queueContentStatsRef Queue
q) (forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats Double
t Int
c')
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Queue -> IORef (SamplingStats Double)
queueWaitTimeRef Queue
q) forall a b. (a -> b) -> a -> b
$
forall a. SamplingData a => a -> SamplingStats a -> SamplingStats a
addSamplingStats Double
dt
if Double
t forall a. Eq a => a -> a -> Bool
== Double
t0
then forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Queue -> IORef Int
enqueueZeroEntryCountRef Queue
q) (forall a. Num a => a -> a -> a
+ Int
1)
else forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Queue -> IORef (SamplingStats Double)
queueNonZeroEntryWaitTimeRef Queue
q) forall a b. (a -> b) -> a -> b
$
forall a. SamplingData a => a -> SamplingStats a -> SamplingStats a
addSamplingStats Double
dt
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
forall a. SignalSource a -> a -> Event ()
triggerSignal (Queue -> SignalSource ()
dequeuedSource Queue
q) ()
queueChanged_ :: Queue -> Signal ()
queueChanged_ :: Queue -> Signal ()
queueChanged_ Queue
q =
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) (Queue -> Signal ()
enqueued Queue
q) forall a. Semigroup a => a -> a -> a
<>
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) (Queue -> Signal ()
dequeued Queue
q)
resetQueue :: Queue -> Event ()
resetQueue :: Queue -> Event ()
resetQueue Queue
q =
do Double
t <- forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
Int
content <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (Queue -> IORef Int
queueContentRef Queue
q)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef (TimingStats Int)
queueContentStatsRef Queue
q) forall a b. (a -> b) -> a -> b
$
forall a. TimingData a => Double -> a -> TimingStats a
returnTimingStats Double
t Int
content
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef Int
enqueueCountRef Queue
q) Int
0
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef Int
enqueueZeroEntryCountRef Queue
q) Int
0
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef (SamplingStats Double)
queueWaitTimeRef Queue
q) forall a. Monoid a => a
mempty
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef (Queue -> IORef (SamplingStats Double)
queueNonZeroEntryWaitTimeRef Queue
q) forall a. Monoid a => a
mempty