module Simulation.Aivika.Trans.Queue.Infinite
(
FCFSQueue,
LCFSQueue,
SIROQueue,
PriorityQueue,
Queue,
newFCFSQueue,
newLCFSQueue,
newSIROQueue,
newPriorityQueue,
newQueue,
enqueueStoringStrategy,
dequeueStrategy,
queueNull,
queueCount,
queueCountStats,
enqueueStoreCount,
dequeueCount,
dequeueExtractCount,
enqueueStoreRate,
dequeueRate,
dequeueExtractRate,
queueWaitTime,
dequeueWaitTime,
queueRate,
dequeue,
dequeueWithOutputPriority,
tryDequeue,
enqueue,
enqueueWithStoringPriority,
queueDelete,
queueDelete_,
queueDeleteBy,
queueDeleteBy_,
queueContains,
queueContainsBy,
clearQueue,
resetQueue,
queueSummary,
queueNullChanged,
queueNullChanged_,
queueCountChanged,
queueCountChanged_,
enqueueStoreCountChanged,
enqueueStoreCountChanged_,
dequeueCountChanged,
dequeueCountChanged_,
dequeueExtractCountChanged,
dequeueExtractCountChanged_,
queueWaitTimeChanged,
queueWaitTimeChanged_,
dequeueWaitTimeChanged,
dequeueWaitTimeChanged_,
queueRateChanged,
queueRateChanged_,
enqueueStored,
dequeueRequested,
dequeueExtracted,
queueChanged_) where
import Data.Monoid
import Data.Maybe
import Control.Monad
import Control.Monad.Trans
import Simulation.Aivika.Trans.Ref.Base
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Parameter
import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Dynamics
import Simulation.Aivika.Trans.Internal.Event
import Simulation.Aivika.Trans.Internal.Process
import Simulation.Aivika.Trans.Signal
import Simulation.Aivika.Trans.Resource.Base
import Simulation.Aivika.Trans.QueueStrategy
import Simulation.Aivika.Trans.Statistics
type FCFSQueue m a = Queue m FCFS FCFS a
type LCFSQueue m a = Queue m LCFS FCFS a
type SIROQueue m a = Queue m SIRO FCFS a
type PriorityQueue m a = Queue m StaticPriorities FCFS a
data Queue m sm so a =
Queue { enqueueStoringStrategy :: sm,
dequeueStrategy :: so,
queueStore :: StrategyQueue m sm (QueueItem a),
dequeueRes :: Resource m so,
queueCountRef :: Ref m Int,
queueCountStatsRef :: Ref m (TimingStats Int),
enqueueStoreCountRef :: Ref m Int,
dequeueCountRef :: Ref m Int,
dequeueExtractCountRef :: Ref m Int,
queueWaitTimeRef :: Ref m (SamplingStats Double),
dequeueWaitTimeRef :: Ref m (SamplingStats Double),
enqueueStoredSource :: SignalSource m a,
dequeueRequestedSource :: SignalSource m (),
dequeueExtractedSource :: SignalSource m a }
data QueueItem a =
QueueItem { itemValue :: a,
itemStoringTime :: Double
}
newFCFSQueue :: MonadDES m => Event m (FCFSQueue m a)
newFCFSQueue = newQueue FCFS FCFS
newLCFSQueue :: MonadDES m => Event m (LCFSQueue m a)
newLCFSQueue = newQueue LCFS FCFS
newSIROQueue :: (MonadDES m, QueueStrategy m SIRO) => Event m (SIROQueue m a)
newSIROQueue = newQueue SIRO FCFS
newPriorityQueue :: (MonadDES m, QueueStrategy m StaticPriorities) => Event m (PriorityQueue m a)
newPriorityQueue = newQueue StaticPriorities FCFS
newQueue :: (MonadDES m,
QueueStrategy m sm,
QueueStrategy m so) =>
sm
-> so
-> Event m (Queue m sm so a)
newQueue sm so =
do t <- liftDynamics time
i <- liftSimulation $ newRef 0
is <- liftSimulation $ newRef $ returnTimingStats t 0
cm <- liftSimulation $ newRef 0
cr <- liftSimulation $ newRef 0
co <- liftSimulation $ newRef 0
qm <- liftSimulation $ newStrategyQueue sm
ro <- liftSimulation $ newResourceWithMaxCount so 0 Nothing
w <- liftSimulation $ newRef mempty
wo <- liftSimulation $ newRef mempty
s3 <- liftSimulation newSignalSource
s4 <- liftSimulation newSignalSource
s5 <- liftSimulation newSignalSource
return Queue { enqueueStoringStrategy = sm,
dequeueStrategy = so,
queueStore = qm,
dequeueRes = ro,
queueCountRef = i,
queueCountStatsRef = is,
enqueueStoreCountRef = cm,
dequeueCountRef = cr,
dequeueExtractCountRef = co,
queueWaitTimeRef = w,
dequeueWaitTimeRef = wo,
enqueueStoredSource = s3,
dequeueRequestedSource = s4,
dequeueExtractedSource = s5 }
queueNull :: MonadDES m => Queue m sm so a -> Event m Bool
queueNull q =
Event $ \p ->
do n <- invokeEvent p $ readRef (queueCountRef q)
return (n == 0)
queueNullChanged :: MonadDES m => Queue m sm so a -> Signal m Bool
queueNullChanged q =
mapSignalM (const $ queueNull q) (queueNullChanged_ q)
queueNullChanged_ :: MonadDES m => Queue m sm so a -> Signal m ()
queueNullChanged_ = queueCountChanged_
queueCount :: MonadDES m => Queue m sm so a -> Event m Int
queueCount q =
Event $ \p -> invokeEvent p $ readRef (queueCountRef q)
queueCountStats :: MonadDES m => Queue m sm so a -> Event m (TimingStats Int)
queueCountStats q =
Event $ \p -> invokeEvent p $ readRef (queueCountStatsRef q)
queueCountChanged :: MonadDES m => Queue m sm so a -> Signal m Int
queueCountChanged q =
mapSignalM (const $ queueCount q) (queueCountChanged_ q)
queueCountChanged_ :: MonadDES m => Queue m sm so a -> Signal m ()
queueCountChanged_ q =
mapSignal (const ()) (enqueueStored q) <>
mapSignal (const ()) (dequeueExtracted q)
enqueueStoreCount :: MonadDES m => Queue m sm so a -> Event m Int
enqueueStoreCount q =
Event $ \p -> invokeEvent p $ readRef (enqueueStoreCountRef q)
enqueueStoreCountChanged :: MonadDES m => Queue m sm so a -> Signal m Int
enqueueStoreCountChanged q =
mapSignalM (const $ enqueueStoreCount q) (enqueueStoreCountChanged_ q)
enqueueStoreCountChanged_ :: MonadDES m => Queue m sm so a -> Signal m ()
enqueueStoreCountChanged_ q =
mapSignal (const ()) (enqueueStored q)
dequeueCount :: MonadDES m => Queue m sm so a -> Event m Int
dequeueCount q =
Event $ \p -> invokeEvent p $ readRef (dequeueCountRef q)
dequeueCountChanged :: MonadDES m => Queue m sm so a -> Signal m Int
dequeueCountChanged q =
mapSignalM (const $ dequeueCount q) (dequeueCountChanged_ q)
dequeueCountChanged_ :: MonadDES m => Queue m sm so a -> Signal m ()
dequeueCountChanged_ q =
mapSignal (const ()) (dequeueRequested q)
dequeueExtractCount :: MonadDES m => Queue m sm so a -> Event m Int
dequeueExtractCount q =
Event $ \p -> invokeEvent p $ readRef (dequeueExtractCountRef q)
dequeueExtractCountChanged :: MonadDES m => Queue m sm so a -> Signal m Int
dequeueExtractCountChanged q =
mapSignalM (const $ dequeueExtractCount q) (dequeueExtractCountChanged_ q)
dequeueExtractCountChanged_ :: MonadDES m => Queue m sm so a -> Signal m ()
dequeueExtractCountChanged_ q =
mapSignal (const ()) (dequeueExtracted q)
enqueueStoreRate :: MonadDES m => Queue m sm so a -> Event m Double
enqueueStoreRate q =
Event $ \p ->
do x <- invokeEvent p $ readRef (enqueueStoreCountRef q)
let t0 = spcStartTime $ pointSpecs p
t = pointTime p
return (fromIntegral x / (t t0))
dequeueRate :: MonadDES m => Queue m sm so a -> Event m Double
dequeueRate q =
Event $ \p ->
do x <- invokeEvent p $ readRef (dequeueCountRef q)
let t0 = spcStartTime $ pointSpecs p
t = pointTime p
return (fromIntegral x / (t t0))
dequeueExtractRate :: MonadDES m => Queue m sm so a -> Event m Double
dequeueExtractRate q =
Event $ \p ->
do x <- invokeEvent p $ readRef (dequeueExtractCountRef q)
let t0 = spcStartTime $ pointSpecs p
t = pointTime p
return (fromIntegral x / (t t0))
queueWaitTime :: MonadDES m => Queue m sm so a -> Event m (SamplingStats Double)
queueWaitTime q =
Event $ \p -> invokeEvent p $ readRef (queueWaitTimeRef q)
queueWaitTimeChanged :: MonadDES m => Queue m sm so a -> Signal m (SamplingStats Double)
queueWaitTimeChanged q =
mapSignalM (const $ queueWaitTime q) (queueWaitTimeChanged_ q)
queueWaitTimeChanged_ :: MonadDES m => Queue m sm so a -> Signal m ()
queueWaitTimeChanged_ q =
mapSignal (const ()) (dequeueExtracted q)
dequeueWaitTime :: MonadDES m => Queue m sm so a -> Event m (SamplingStats Double)
dequeueWaitTime q =
Event $ \p -> invokeEvent p $ readRef (dequeueWaitTimeRef q)
dequeueWaitTimeChanged :: MonadDES m => Queue m sm so a -> Signal m (SamplingStats Double)
dequeueWaitTimeChanged q =
mapSignalM (const $ dequeueWaitTime q) (dequeueWaitTimeChanged_ q)
dequeueWaitTimeChanged_ :: MonadDES m => Queue m sm so a -> Signal m ()
dequeueWaitTimeChanged_ q =
mapSignal (const ()) (dequeueExtracted q)
queueRate :: MonadDES m => Queue m sm so a -> Event m Double
queueRate q =
Event $ \p ->
do x <- invokeEvent p $ readRef (queueCountStatsRef q)
y <- invokeEvent p $ readRef (queueWaitTimeRef q)
return (timingStatsMean x / samplingStatsMean y)
queueRateChanged :: MonadDES m => Queue m sm so a -> Signal m Double
queueRateChanged q =
mapSignalM (const $ queueRate q) (queueRateChanged_ q)
queueRateChanged_ :: MonadDES m => Queue m sm so a -> Signal m ()
queueRateChanged_ q =
mapSignal (const ()) (enqueueStored q) <>
mapSignal (const ()) (dequeueExtracted q)
dequeue :: (MonadDES m,
DequeueStrategy m sm,
EnqueueStrategy m so)
=> Queue m sm so a
-> Process m a
dequeue q =
do t <- liftEvent $ dequeueRequest q
requestResource (dequeueRes q)
liftEvent $ dequeueExtract q t
dequeueWithOutputPriority :: (MonadDES m,
DequeueStrategy m sm,
PriorityQueueStrategy m so po)
=> Queue m sm so a
-> po
-> Process m a
dequeueWithOutputPriority q po =
do t <- liftEvent $ dequeueRequest q
requestResourceWithPriority (dequeueRes q) po
liftEvent $ dequeueExtract q t
tryDequeue :: (MonadDES m, DequeueStrategy m sm)
=> Queue m sm so a
-> Event m (Maybe a)
tryDequeue q =
do x <- tryRequestResourceWithinEvent (dequeueRes q)
if x
then do t <- dequeueRequest q
fmap Just $ dequeueExtract q t
else return Nothing
queueDelete :: (MonadDES m,
Eq a,
DeletingQueueStrategy m sm,
DequeueStrategy m so)
=> Queue m sm so a
-> a
-> Event m Bool
queueDelete q a = fmap isJust $ queueDeleteBy q (== a)
queueDelete_ :: (MonadDES m,
Eq a,
DeletingQueueStrategy m sm,
DequeueStrategy m so)
=> Queue m sm so a
-> a
-> Event m ()
queueDelete_ q a = fmap (const ()) $ queueDeleteBy q (== a)
queueDeleteBy :: (MonadDES m,
DeletingQueueStrategy m sm,
DequeueStrategy m so)
=> Queue m sm so a
-> (a -> Bool)
-> Event m (Maybe a)
queueDeleteBy q pred =
do x <- tryRequestResourceWithinEvent (dequeueRes q)
if x
then do i <- strategyQueueDeleteBy (queueStore q) (pred . itemValue)
case i of
Nothing ->
do releaseResourceWithinEvent (dequeueRes q)
return Nothing
Just i ->
do t <- dequeueRequest q
fmap Just $ dequeuePostExtract q t i
else return Nothing
queueDeleteBy_ :: (MonadDES m,
DeletingQueueStrategy m sm,
DequeueStrategy m so)
=> Queue m sm so a
-> (a -> Bool)
-> Event m ()
queueDeleteBy_ q pred = fmap (const ()) $ queueDeleteBy q pred
queueContains :: (MonadDES m,
Eq a,
DeletingQueueStrategy m sm)
=> Queue m sm so a
-> a
-> Event m Bool
queueContains q a = fmap isJust $ queueContainsBy q (== a)
queueContainsBy :: (MonadDES m,
DeletingQueueStrategy m sm)
=> Queue m sm so a
-> (a -> Bool)
-> Event m (Maybe a)
queueContainsBy q pred =
do x <- strategyQueueContainsBy (queueStore q) (pred . itemValue)
case x of
Nothing -> return Nothing
Just i -> return $ Just (itemValue i)
clearQueue :: (MonadDES m,
DequeueStrategy m sm)
=> Queue m sm so a
-> Event m ()
clearQueue q =
do x <- tryDequeue q
case x of
Nothing -> return ()
Just a -> clearQueue q
enqueue :: (MonadDES m,
EnqueueStrategy m sm,
DequeueStrategy m so)
=> Queue m sm so a
-> a
-> Event m ()
enqueue = enqueueStore
enqueueWithStoringPriority :: (MonadDES m,
PriorityQueueStrategy m sm pm,
DequeueStrategy m so)
=> Queue m sm so a
-> pm
-> a
-> Event m ()
enqueueWithStoringPriority = enqueueStoreWithPriority
enqueueStored :: MonadDES m => Queue m sm so a -> Signal m a
enqueueStored q = publishSignal (enqueueStoredSource q)
dequeueRequested :: MonadDES m => Queue m sm so a -> Signal m ()
dequeueRequested q = publishSignal (dequeueRequestedSource q)
dequeueExtracted :: MonadDES m => Queue m sm so a -> Signal m a
dequeueExtracted q = publishSignal (dequeueExtractedSource q)
enqueueStore :: (MonadDES m,
EnqueueStrategy m sm,
DequeueStrategy m so)
=> Queue m sm so a
-> a
-> Event m ()
enqueueStore q a =
Event $ \p ->
do let i = QueueItem { itemValue = a,
itemStoringTime = pointTime p }
invokeEvent p $
strategyEnqueue (queueStore q) i
c <- invokeEvent p $
readRef (queueCountRef q)
let c' = c + 1
t = pointTime p
c' `seq` invokeEvent p $
writeRef (queueCountRef q) c'
invokeEvent p $
modifyRef (queueCountStatsRef q) (addTimingStats t c')
invokeEvent p $
modifyRef (enqueueStoreCountRef q) (+ 1)
invokeEvent p $
releaseResourceWithinEvent (dequeueRes q)
invokeEvent p $
triggerSignal (enqueueStoredSource q) (itemValue i)
enqueueStoreWithPriority :: (MonadDES m,
PriorityQueueStrategy m sm pm,
DequeueStrategy m so)
=> Queue m sm so a
-> pm
-> a
-> Event m ()
enqueueStoreWithPriority q pm a =
Event $ \p ->
do let i = QueueItem { itemValue = a,
itemStoringTime = pointTime p }
invokeEvent p $
strategyEnqueueWithPriority (queueStore q) pm i
c <- invokeEvent p $
readRef (queueCountRef q)
let c' = c + 1
t = pointTime p
c' `seq` invokeEvent p $
writeRef (queueCountRef q) c'
invokeEvent p $
modifyRef (queueCountStatsRef q) (addTimingStats t c')
invokeEvent p $
modifyRef (enqueueStoreCountRef q) (+ 1)
invokeEvent p $
releaseResourceWithinEvent (dequeueRes q)
invokeEvent p $
triggerSignal (enqueueStoredSource q) (itemValue i)
dequeueRequest :: MonadDES m
=> Queue m sm so a
-> Event m Double
dequeueRequest q =
Event $ \p ->
do invokeEvent p $
modifyRef (dequeueCountRef q) (+ 1)
invokeEvent p $
triggerSignal (dequeueRequestedSource q) ()
return $ pointTime p
dequeueExtract :: (MonadDES m, DequeueStrategy m sm)
=> Queue m sm so a
-> Double
-> Event m a
dequeueExtract q t' =
Event $ \p ->
do i <- invokeEvent p $
strategyDequeue (queueStore q)
invokeEvent p $
dequeuePostExtract q t' i
dequeuePostExtract :: (MonadDES m,
DequeueStrategy m sm)
=> Queue m sm so a
-> Double
-> QueueItem a
-> Event m a
dequeuePostExtract q t' i =
Event $ \p ->
do c <- invokeEvent p $
readRef (queueCountRef q)
let c' = c 1
t = pointTime p
c' `seq` invokeEvent p $
writeRef (queueCountRef q) c'
invokeEvent p $
modifyRef (queueCountStatsRef q) (addTimingStats t c')
invokeEvent p $
modifyRef (dequeueExtractCountRef q) (+ 1)
invokeEvent p $
dequeueStat q t' i
invokeEvent p $
triggerSignal (dequeueExtractedSource q) (itemValue i)
return $ itemValue i
dequeueStat :: MonadDES m
=> Queue m sm so a
-> Double
-> QueueItem a
-> Event m ()
dequeueStat q t' i =
Event $ \p ->
do let t1 = itemStoringTime i
t = pointTime p
invokeEvent p $
modifyRef (dequeueWaitTimeRef q) $
addSamplingStats (t t')
invokeEvent p $
modifyRef (queueWaitTimeRef q) $
addSamplingStats (t t1)
queueChanged_ :: MonadDES m => Queue m sm so a -> Signal m ()
queueChanged_ q =
mapSignal (const ()) (enqueueStored q) <>
dequeueRequested q <>
mapSignal (const ()) (dequeueExtracted q)
queueSummary :: (MonadDES m, Show sm, Show so) => Queue m sm so a -> Int -> Event m ShowS
queueSummary q indent =
do let sm = enqueueStoringStrategy q
so = dequeueStrategy q
null <- queueNull q
count <- queueCount q
countStats <- queueCountStats q
enqueueStoreCount <- enqueueStoreCount q
dequeueCount <- dequeueCount q
dequeueExtractCount <- dequeueExtractCount q
enqueueStoreRate <- enqueueStoreRate q
dequeueRate <- dequeueRate q
dequeueExtractRate <- dequeueExtractRate q
waitTime <- queueWaitTime q
dequeueWaitTime <- dequeueWaitTime q
let tab = replicate indent ' '
return $
showString tab .
showString "the storing (memory) strategy = " .
shows sm .
showString "\n" .
showString tab .
showString "the dequeueing (output) strategy = " .
shows so .
showString "\n" .
showString tab .
showString "empty? = " .
shows null .
showString "\n" .
showString tab .
showString "the current size = " .
shows count .
showString "\n" .
showString tab .
showString "the size statistics = \n\n" .
timingStatsSummary countStats (2 + indent) .
showString "\n\n" .
showString tab .
showString "the enqueue store count (number of the input items that were stored) = " .
shows enqueueStoreCount .
showString "\n" .
showString tab .
showString "the dequeue count (number of requests for dequeueing an item) = " .
shows dequeueCount .
showString "\n" .
showString tab .
showString "the dequeue extract count (number of the output items that were dequeued) = " .
shows dequeueExtractCount .
showString "\n" .
showString tab .
showString "the enqueue store rate (how many input items were stored per time) = " .
shows enqueueStoreRate .
showString "\n" .
showString tab .
showString "the dequeue rate (how many requests for dequeueing per time) = " .
shows dequeueRate .
showString "\n" .
showString tab .
showString "the dequeue extract rate (how many output items were dequeued per time) = " .
shows dequeueExtractRate .
showString "\n" .
showString tab .
showString "the wait time (when was stored -> when was dequeued) = \n\n" .
samplingStatsSummary waitTime (2 + indent) .
showString "\n\n" .
showString tab .
showString "the dequeue wait time (when was requested for dequeueing -> when was dequeued) = \n\n" .
samplingStatsSummary dequeueWaitTime (2 + indent)
resetQueue :: MonadDES m => Queue m sm so a -> Event m ()
resetQueue q =
Event $ \p ->
do let t = pointTime p
queueCount <- invokeEvent p $ readRef (queueCountRef q)
invokeEvent p $ writeRef (queueCountStatsRef q) $
returnTimingStats t queueCount
invokeEvent p $ writeRef (enqueueStoreCountRef q) 0
invokeEvent p $ writeRef (dequeueCountRef q) 0
invokeEvent p $ writeRef (dequeueExtractCountRef q) 0
invokeEvent p $ writeRef (queueWaitTimeRef q) mempty
invokeEvent p $ writeRef (dequeueWaitTimeRef q) mempty