{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FunctionalDependencies #-}
module Simulation.Aivika.QueueStrategy where
import Control.Monad.Trans
import Data.Maybe
import Simulation.Aivika.Parameter
import Simulation.Aivika.Parameter.Random
import Simulation.Aivika.Simulation
import Simulation.Aivika.Event
import Simulation.Aivika.DoubleLinkedList
import qualified Simulation.Aivika.PriorityQueue as PQ
import qualified Simulation.Aivika.Vector as V
class QueueStrategy s where
data StrategyQueue s :: * -> *
newStrategyQueue :: s
-> Simulation (StrategyQueue s i)
strategyQueueNull :: StrategyQueue s i
-> Event Bool
class QueueStrategy s => DequeueStrategy s where
strategyDequeue :: StrategyQueue s i
-> Event i
class DequeueStrategy s => EnqueueStrategy s where
strategyEnqueue :: StrategyQueue s i
-> i
-> Event ()
class DequeueStrategy s => PriorityQueueStrategy s p | s -> p where
strategyEnqueueWithPriority :: StrategyQueue s i
-> p
-> i
-> Event ()
class DequeueStrategy s => DeletingQueueStrategy s where
strategyQueueDelete :: Eq i
=> StrategyQueue s i
-> i
-> Event Bool
strategyQueueDelete StrategyQueue s i
s i
i = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall s i.
DeletingQueueStrategy s =>
StrategyQueue s i -> (i -> Bool) -> Event (Maybe i)
strategyQueueDeleteBy StrategyQueue s i
s (forall a. Eq a => a -> a -> Bool
== i
i)
strategyQueueDeleteBy :: StrategyQueue s i
-> (i -> Bool)
-> Event (Maybe i)
strategyQueueContains :: Eq i
=> StrategyQueue s i
-> i
-> Event Bool
strategyQueueContains StrategyQueue s i
s i
i = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall s i.
DeletingQueueStrategy s =>
StrategyQueue s i -> (i -> Bool) -> Event (Maybe i)
strategyQueueContainsBy StrategyQueue s i
s (forall a. Eq a => a -> a -> Bool
== i
i)
strategyQueueContainsBy :: StrategyQueue s i
-> (i -> Bool)
-> Event (Maybe i)
data FCFS = FCFS deriving (FCFS -> FCFS -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FCFS -> FCFS -> Bool
$c/= :: FCFS -> FCFS -> Bool
== :: FCFS -> FCFS -> Bool
$c== :: FCFS -> FCFS -> Bool
Eq, Eq FCFS
FCFS -> FCFS -> Bool
FCFS -> FCFS -> Ordering
FCFS -> FCFS -> FCFS
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FCFS -> FCFS -> FCFS
$cmin :: FCFS -> FCFS -> FCFS
max :: FCFS -> FCFS -> FCFS
$cmax :: FCFS -> FCFS -> FCFS
>= :: FCFS -> FCFS -> Bool
$c>= :: FCFS -> FCFS -> Bool
> :: FCFS -> FCFS -> Bool
$c> :: FCFS -> FCFS -> Bool
<= :: FCFS -> FCFS -> Bool
$c<= :: FCFS -> FCFS -> Bool
< :: FCFS -> FCFS -> Bool
$c< :: FCFS -> FCFS -> Bool
compare :: FCFS -> FCFS -> Ordering
$ccompare :: FCFS -> FCFS -> Ordering
Ord, Int -> FCFS -> ShowS
[FCFS] -> ShowS
FCFS -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FCFS] -> ShowS
$cshowList :: [FCFS] -> ShowS
show :: FCFS -> String
$cshow :: FCFS -> String
showsPrec :: Int -> FCFS -> ShowS
$cshowsPrec :: Int -> FCFS -> ShowS
Show)
data LCFS = LCFS deriving (LCFS -> LCFS -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LCFS -> LCFS -> Bool
$c/= :: LCFS -> LCFS -> Bool
== :: LCFS -> LCFS -> Bool
$c== :: LCFS -> LCFS -> Bool
Eq, Eq LCFS
LCFS -> LCFS -> Bool
LCFS -> LCFS -> Ordering
LCFS -> LCFS -> LCFS
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LCFS -> LCFS -> LCFS
$cmin :: LCFS -> LCFS -> LCFS
max :: LCFS -> LCFS -> LCFS
$cmax :: LCFS -> LCFS -> LCFS
>= :: LCFS -> LCFS -> Bool
$c>= :: LCFS -> LCFS -> Bool
> :: LCFS -> LCFS -> Bool
$c> :: LCFS -> LCFS -> Bool
<= :: LCFS -> LCFS -> Bool
$c<= :: LCFS -> LCFS -> Bool
< :: LCFS -> LCFS -> Bool
$c< :: LCFS -> LCFS -> Bool
compare :: LCFS -> LCFS -> Ordering
$ccompare :: LCFS -> LCFS -> Ordering
Ord, Int -> LCFS -> ShowS
[LCFS] -> ShowS
LCFS -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LCFS] -> ShowS
$cshowList :: [LCFS] -> ShowS
show :: LCFS -> String
$cshow :: LCFS -> String
showsPrec :: Int -> LCFS -> ShowS
$cshowsPrec :: Int -> LCFS -> ShowS
Show)
data SIRO = SIRO deriving (SIRO -> SIRO -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SIRO -> SIRO -> Bool
$c/= :: SIRO -> SIRO -> Bool
== :: SIRO -> SIRO -> Bool
$c== :: SIRO -> SIRO -> Bool
Eq, Eq SIRO
SIRO -> SIRO -> Bool
SIRO -> SIRO -> Ordering
SIRO -> SIRO -> SIRO
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SIRO -> SIRO -> SIRO
$cmin :: SIRO -> SIRO -> SIRO
max :: SIRO -> SIRO -> SIRO
$cmax :: SIRO -> SIRO -> SIRO
>= :: SIRO -> SIRO -> Bool
$c>= :: SIRO -> SIRO -> Bool
> :: SIRO -> SIRO -> Bool
$c> :: SIRO -> SIRO -> Bool
<= :: SIRO -> SIRO -> Bool
$c<= :: SIRO -> SIRO -> Bool
< :: SIRO -> SIRO -> Bool
$c< :: SIRO -> SIRO -> Bool
compare :: SIRO -> SIRO -> Ordering
$ccompare :: SIRO -> SIRO -> Ordering
Ord, Int -> SIRO -> ShowS
[SIRO] -> ShowS
SIRO -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SIRO] -> ShowS
$cshowList :: [SIRO] -> ShowS
show :: SIRO -> String
$cshow :: SIRO -> String
showsPrec :: Int -> SIRO -> ShowS
$cshowsPrec :: Int -> SIRO -> ShowS
Show)
data StaticPriorities = StaticPriorities deriving (StaticPriorities -> StaticPriorities -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaticPriorities -> StaticPriorities -> Bool
$c/= :: StaticPriorities -> StaticPriorities -> Bool
== :: StaticPriorities -> StaticPriorities -> Bool
$c== :: StaticPriorities -> StaticPriorities -> Bool
Eq, Eq StaticPriorities
StaticPriorities -> StaticPriorities -> Bool
StaticPriorities -> StaticPriorities -> Ordering
StaticPriorities -> StaticPriorities -> StaticPriorities
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StaticPriorities -> StaticPriorities -> StaticPriorities
$cmin :: StaticPriorities -> StaticPriorities -> StaticPriorities
max :: StaticPriorities -> StaticPriorities -> StaticPriorities
$cmax :: StaticPriorities -> StaticPriorities -> StaticPriorities
>= :: StaticPriorities -> StaticPriorities -> Bool
$c>= :: StaticPriorities -> StaticPriorities -> Bool
> :: StaticPriorities -> StaticPriorities -> Bool
$c> :: StaticPriorities -> StaticPriorities -> Bool
<= :: StaticPriorities -> StaticPriorities -> Bool
$c<= :: StaticPriorities -> StaticPriorities -> Bool
< :: StaticPriorities -> StaticPriorities -> Bool
$c< :: StaticPriorities -> StaticPriorities -> Bool
compare :: StaticPriorities -> StaticPriorities -> Ordering
$ccompare :: StaticPriorities -> StaticPriorities -> Ordering
Ord, Int -> StaticPriorities -> ShowS
[StaticPriorities] -> ShowS
StaticPriorities -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaticPriorities] -> ShowS
$cshowList :: [StaticPriorities] -> ShowS
show :: StaticPriorities -> String
$cshow :: StaticPriorities -> String
showsPrec :: Int -> StaticPriorities -> ShowS
$cshowsPrec :: Int -> StaticPriorities -> ShowS
Show)
instance QueueStrategy FCFS where
newtype StrategyQueue FCFS i = FCFSQueue (DoubleLinkedList i)
newStrategyQueue :: forall i. FCFS -> Simulation (StrategyQueue FCFS i)
newStrategyQueue FCFS
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall i. DoubleLinkedList i -> StrategyQueue FCFS i
FCFSQueue forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (DoubleLinkedList a)
newList
strategyQueueNull :: forall i. StrategyQueue FCFS i -> Event Bool
strategyQueueNull (FCFSQueue DoubleLinkedList i
q) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. DoubleLinkedList a -> IO Bool
listNull DoubleLinkedList i
q
instance DequeueStrategy FCFS where
strategyDequeue :: forall i. StrategyQueue FCFS i -> Event i
strategyDequeue (FCFSQueue DoubleLinkedList i
q) =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do i
i <- forall a. DoubleLinkedList a -> IO a
listFirst DoubleLinkedList i
q
forall a. DoubleLinkedList a -> IO ()
listRemoveFirst DoubleLinkedList i
q
forall (m :: * -> *) a. Monad m => a -> m a
return i
i
instance EnqueueStrategy FCFS where
strategyEnqueue :: forall i. StrategyQueue FCFS i -> i -> Event ()
strategyEnqueue (FCFSQueue DoubleLinkedList i
q) i
i = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. DoubleLinkedList a -> a -> IO ()
listAddLast DoubleLinkedList i
q i
i
instance DeletingQueueStrategy FCFS where
strategyQueueDeleteBy :: forall i. StrategyQueue FCFS i -> (i -> Bool) -> Event (Maybe i)
strategyQueueDeleteBy (FCFSQueue DoubleLinkedList i
q) i -> Bool
p = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
listRemoveBy DoubleLinkedList i
q i -> Bool
p
strategyQueueContainsBy :: forall i. StrategyQueue FCFS i -> (i -> Bool) -> Event (Maybe i)
strategyQueueContainsBy (FCFSQueue DoubleLinkedList i
q) i -> Bool
p = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
listContainsBy DoubleLinkedList i
q i -> Bool
p
instance QueueStrategy LCFS where
newtype StrategyQueue LCFS i = LCFSQueue (DoubleLinkedList i)
newStrategyQueue :: forall i. LCFS -> Simulation (StrategyQueue LCFS i)
newStrategyQueue LCFS
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall i. DoubleLinkedList i -> StrategyQueue LCFS i
LCFSQueue forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (DoubleLinkedList a)
newList
strategyQueueNull :: forall i. StrategyQueue LCFS i -> Event Bool
strategyQueueNull (LCFSQueue DoubleLinkedList i
q) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. DoubleLinkedList a -> IO Bool
listNull DoubleLinkedList i
q
instance DequeueStrategy LCFS where
strategyDequeue :: forall i. StrategyQueue LCFS i -> Event i
strategyDequeue (LCFSQueue DoubleLinkedList i
q) =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do i
i <- forall a. DoubleLinkedList a -> IO a
listFirst DoubleLinkedList i
q
forall a. DoubleLinkedList a -> IO ()
listRemoveFirst DoubleLinkedList i
q
forall (m :: * -> *) a. Monad m => a -> m a
return i
i
instance EnqueueStrategy LCFS where
strategyEnqueue :: forall i. StrategyQueue LCFS i -> i -> Event ()
strategyEnqueue (LCFSQueue DoubleLinkedList i
q) i
i = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. DoubleLinkedList a -> a -> IO ()
listInsertFirst DoubleLinkedList i
q i
i
instance DeletingQueueStrategy LCFS where
strategyQueueDeleteBy :: forall i. StrategyQueue LCFS i -> (i -> Bool) -> Event (Maybe i)
strategyQueueDeleteBy (LCFSQueue DoubleLinkedList i
q) i -> Bool
p = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
listRemoveBy DoubleLinkedList i
q i -> Bool
p
strategyQueueContainsBy :: forall i. StrategyQueue LCFS i -> (i -> Bool) -> Event (Maybe i)
strategyQueueContainsBy (LCFSQueue DoubleLinkedList i
q) i -> Bool
p = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. DoubleLinkedList a -> (a -> Bool) -> IO (Maybe a)
listContainsBy DoubleLinkedList i
q i -> Bool
p
instance QueueStrategy StaticPriorities where
newtype StrategyQueue StaticPriorities i = StaticPriorityQueue (PQ.PriorityQueue i)
newStrategyQueue :: forall i.
StaticPriorities -> Simulation (StrategyQueue StaticPriorities i)
newStrategyQueue StaticPriorities
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall i. PriorityQueue i -> StrategyQueue StaticPriorities i
StaticPriorityQueue forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (PriorityQueue a)
PQ.newQueue
strategyQueueNull :: forall i. StrategyQueue StaticPriorities i -> Event Bool
strategyQueueNull (StaticPriorityQueue PriorityQueue i
q) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> IO Bool
PQ.queueNull PriorityQueue i
q
instance DequeueStrategy StaticPriorities where
strategyDequeue :: forall i. StrategyQueue StaticPriorities i -> Event i
strategyDequeue (StaticPriorityQueue PriorityQueue i
q) =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do (Double
_, i
i) <- forall a. PriorityQueue a -> IO (Double, a)
PQ.queueFront PriorityQueue i
q
forall a. PriorityQueue a -> IO ()
PQ.dequeue PriorityQueue i
q
forall (m :: * -> *) a. Monad m => a -> m a
return i
i
instance PriorityQueueStrategy StaticPriorities Double where
strategyEnqueueWithPriority :: forall i.
StrategyQueue StaticPriorities i -> Double -> i -> Event ()
strategyEnqueueWithPriority (StaticPriorityQueue PriorityQueue i
q) Double
p i
i = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue PriorityQueue i
q Double
p i
i
instance DeletingQueueStrategy StaticPriorities where
strategyQueueDeleteBy :: forall i.
StrategyQueue StaticPriorities i -> (i -> Bool) -> Event (Maybe i)
strategyQueueDeleteBy (StaticPriorityQueue PriorityQueue i
q) i -> Bool
p = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
PQ.queueDeleteBy PriorityQueue i
q i -> Bool
p
strategyQueueContainsBy :: forall i.
StrategyQueue StaticPriorities i -> (i -> Bool) -> Event (Maybe i)
strategyQueueContainsBy (StaticPriorityQueue PriorityQueue i
q) i -> Bool
p = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
PQ.queueContainsBy PriorityQueue i
q i -> Bool
p
instance QueueStrategy SIRO where
newtype StrategyQueue SIRO i = SIROQueue (V.Vector i)
newStrategyQueue :: forall i. SIRO -> Simulation (StrategyQueue SIRO i)
newStrategyQueue SIRO
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall i. Vector i -> StrategyQueue SIRO i
SIROQueue forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (Vector a)
V.newVector
strategyQueueNull :: forall i. StrategyQueue SIRO i -> Event Bool
strategyQueueNull (SIROQueue Vector i
q) =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do Int
n <- forall a. Vector a -> IO Int
V.vectorCount Vector i
q
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n forall a. Eq a => a -> a -> Bool
== Int
0)
instance DequeueStrategy SIRO where
strategyDequeue :: forall i. StrategyQueue SIRO i -> Event i
strategyDequeue (SIROQueue Vector i
q) =
do Int
n <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> IO Int
V.vectorCount Vector i
q
Int
i <- forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter forall a b. (a -> b) -> a -> b
$ Int -> Int -> Parameter Int
randomUniformInt Int
0 (Int
n forall a. Num a => a -> a -> a
- Int
1)
i
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> Int -> IO a
V.readVector Vector i
q Int
i
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> Int -> IO ()
V.vectorDeleteAt Vector i
q Int
i
forall (m :: * -> *) a. Monad m => a -> m a
return i
x
instance EnqueueStrategy SIRO where
strategyEnqueue :: forall i. StrategyQueue SIRO i -> i -> Event ()
strategyEnqueue (SIROQueue Vector i
q) i
i = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> a -> IO ()
V.appendVector Vector i
q i
i
instance DeletingQueueStrategy SIRO where
strategyQueueDeleteBy :: forall i. StrategyQueue SIRO i -> (i -> Bool) -> Event (Maybe i)
strategyQueueDeleteBy (SIROQueue Vector i
q) i -> Bool
p = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> (a -> Bool) -> IO (Maybe a)
V.vectorDeleteBy Vector i
q i -> Bool
p
strategyQueueContainsBy :: forall i. StrategyQueue SIRO i -> (i -> Bool) -> Event (Maybe i)
strategyQueueContainsBy (SIROQueue Vector i
q) i -> Bool
p = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> (a -> Bool) -> IO (Maybe a)
V.vectorContainsBy Vector i
q i -> Bool
p