module Simulation.Aivika.PriorityQueue.EventQueue.Pure
(PriorityQueue,
Priority,
queueNull,
queueCount,
emptyQueue,
enqueue,
dequeue,
queueFront) where
import Control.Monad
type Priority = Int
data PriorityQueue a = EmptyQueue
| Queue !Int !Double !Priority a !Int (PriorityQueue a) (PriorityQueue a)
deriving Priority -> PriorityQueue a -> ShowS
[PriorityQueue a] -> ShowS
PriorityQueue a -> String
(Priority -> PriorityQueue a -> ShowS)
-> (PriorityQueue a -> String)
-> ([PriorityQueue a] -> ShowS)
-> Show (PriorityQueue a)
forall a. Show a => Priority -> PriorityQueue a -> ShowS
forall a. Show a => [PriorityQueue a] -> ShowS
forall a. Show a => PriorityQueue a -> String
forall a.
(Priority -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Priority -> PriorityQueue a -> ShowS
showsPrec :: Priority -> PriorityQueue a -> ShowS
$cshow :: forall a. Show a => PriorityQueue a -> String
show :: PriorityQueue a -> String
$cshowList :: forall a. Show a => [PriorityQueue a] -> ShowS
showList :: [PriorityQueue a] -> ShowS
Show
queueNull :: PriorityQueue a -> Bool
queueNull :: forall a. PriorityQueue a -> Bool
queueNull PriorityQueue a
EmptyQueue = Bool
True
queueNull PriorityQueue a
_ = Bool
False
queueCount :: PriorityQueue a -> Int
queueCount :: forall a. PriorityQueue a -> Priority
queueCount PriorityQueue a
EmptyQueue = Priority
0
queueCount (Queue Priority
n Double
k Priority
p a
v Priority
r PriorityQueue a
a PriorityQueue a
b) = Priority
n
emptyQueue :: PriorityQueue a
emptyQueue :: forall a. PriorityQueue a
emptyQueue = PriorityQueue a
forall a. PriorityQueue a
EmptyQueue
enqueue :: PriorityQueue a -> Double -> Priority -> a -> PriorityQueue a
enqueue :: forall a.
PriorityQueue a -> Double -> Priority -> a -> PriorityQueue a
enqueue PriorityQueue a
pq Double
k Priority
p a
v = PriorityQueue a -> PriorityQueue a -> PriorityQueue a
forall a. PriorityQueue a -> PriorityQueue a -> PriorityQueue a
mergeQueues PriorityQueue a
pq (Priority
-> Double
-> Priority
-> a
-> Priority
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
forall a.
Priority
-> Double
-> Priority
-> a
-> Priority
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
Queue Priority
1 Double
k Priority
p a
v Priority
1 PriorityQueue a
forall a. PriorityQueue a
EmptyQueue PriorityQueue a
forall a. PriorityQueue a
EmptyQueue)
dequeue :: PriorityQueue a -> PriorityQueue a
dequeue :: forall a. PriorityQueue a -> PriorityQueue a
dequeue PriorityQueue a
EmptyQueue = String -> PriorityQueue a
forall a. HasCallStack => String -> a
error String
"The queue is empty: dequeue"
dequeue (Queue Priority
n Double
k Priority
p a
v Priority
r PriorityQueue a
a PriorityQueue a
b) = PriorityQueue a -> PriorityQueue a -> PriorityQueue a
forall a. PriorityQueue a -> PriorityQueue a -> PriorityQueue a
mergeQueues PriorityQueue a
a PriorityQueue a
b
queueFront :: PriorityQueue a -> (Double, Priority, a)
queueFront :: forall a. PriorityQueue a -> (Double, Priority, a)
queueFront PriorityQueue a
EmptyQueue = String -> (Double, Priority, a)
forall a. HasCallStack => String -> a
error String
"The queue is empty: queueFront"
queueFront (Queue Priority
n Double
k Priority
p a
v Priority
r PriorityQueue a
a PriorityQueue a
b) = (Double
k, Priority
p, a
v)
queueRank :: PriorityQueue a -> Int
queueRank :: forall a. PriorityQueue a -> Priority
queueRank PriorityQueue a
EmptyQueue = Priority
0
queueRank (Queue Priority
n Double
k Priority
p a
v Priority
r PriorityQueue a
a PriorityQueue a
b) = Priority
r
makeQueue :: Double -> Priority -> a -> PriorityQueue a -> PriorityQueue a -> PriorityQueue a
makeQueue :: forall a.
Double
-> Priority
-> a
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
makeQueue Double
k Priority
p a
v PriorityQueue a
a PriorityQueue a
b
| PriorityQueue a -> Priority
forall a. PriorityQueue a -> Priority
queueRank PriorityQueue a
a Priority -> Priority -> Bool
forall a. Ord a => a -> a -> Bool
>= PriorityQueue a -> Priority
forall a. PriorityQueue a -> Priority
queueRank PriorityQueue a
b = Priority
n Priority -> PriorityQueue a -> PriorityQueue a
forall a b. a -> b -> b
`seq` Priority
-> Double
-> Priority
-> a
-> Priority
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
forall a.
Priority
-> Double
-> Priority
-> a
-> Priority
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
Queue Priority
n Double
k Priority
p a
v (PriorityQueue a -> Priority
forall a. PriorityQueue a -> Priority
queueRank PriorityQueue a
b Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
1) PriorityQueue a
a PriorityQueue a
b
| Bool
otherwise = Priority
n Priority -> PriorityQueue a -> PriorityQueue a
forall a b. a -> b -> b
`seq` Priority
-> Double
-> Priority
-> a
-> Priority
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
forall a.
Priority
-> Double
-> Priority
-> a
-> Priority
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
Queue Priority
n Double
k Priority
p a
v (PriorityQueue a -> Priority
forall a. PriorityQueue a -> Priority
queueRank PriorityQueue a
a Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
1) PriorityQueue a
b PriorityQueue a
a
where n :: Priority
n = PriorityQueue a -> Priority
forall a. PriorityQueue a -> Priority
queueCount PriorityQueue a
a Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ PriorityQueue a -> Priority
forall a. PriorityQueue a -> Priority
queueCount PriorityQueue a
b Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
1
mergeQueues :: PriorityQueue a -> PriorityQueue a -> PriorityQueue a
mergeQueues :: forall a. PriorityQueue a -> PriorityQueue a -> PriorityQueue a
mergeQueues PriorityQueue a
h PriorityQueue a
EmptyQueue = PriorityQueue a
h
mergeQueues PriorityQueue a
EmptyQueue PriorityQueue a
h = PriorityQueue a
h
mergeQueues h1 :: PriorityQueue a
h1@(Queue Priority
_ Double
k1 Priority
p1 a
v1 Priority
_ PriorityQueue a
a1 PriorityQueue a
b1) h2 :: PriorityQueue a
h2@(Queue Priority
_ Double
k2 Priority
p2 a
v2 Priority
_ PriorityQueue a
a2 PriorityQueue a
b2)
| Double -> Priority -> Double -> Priority -> Bool
lte Double
k1 Priority
p1 Double
k2 Priority
p2 = Double
-> Priority
-> a
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
forall a.
Double
-> Priority
-> a
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
makeQueue Double
k1 Priority
p1 a
v1 PriorityQueue a
a1 (PriorityQueue a -> PriorityQueue a -> PriorityQueue a
forall a. PriorityQueue a -> PriorityQueue a -> PriorityQueue a
mergeQueues PriorityQueue a
b1 PriorityQueue a
h2)
| Bool
otherwise = Double
-> Priority
-> a
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
forall a.
Double
-> Priority
-> a
-> PriorityQueue a
-> PriorityQueue a
-> PriorityQueue a
makeQueue Double
k2 Priority
p2 a
v2 PriorityQueue a
a2 (PriorityQueue a -> PriorityQueue a -> PriorityQueue a
forall a. PriorityQueue a -> PriorityQueue a -> PriorityQueue a
mergeQueues PriorityQueue a
h1 PriorityQueue a
b2)
gt :: Double -> Priority -> Double -> Priority -> Bool
{-# INLINE gt #-}
gt :: Double -> Priority -> Double -> Priority -> Bool
gt Double
k1 Priority
p1 Double
k2 Priority
p2 = (Double
k1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
k2) Bool -> Bool -> Bool
|| (Double
k1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
k2 Bool -> Bool -> Bool
&& Priority
p1 Priority -> Priority -> Bool
forall a. Ord a => a -> a -> Bool
< Priority
p2)
gte :: Double -> Priority -> Double -> Priority -> Bool
{-# INLINE gte #-}
gte :: Double -> Priority -> Double -> Priority -> Bool
gte Double
k1 Priority
p1 Double
k2 Priority
p2 = (Double
k1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
k2) Bool -> Bool -> Bool
|| (Double
k1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
k2 Bool -> Bool -> Bool
&& Priority
p1 Priority -> Priority -> Bool
forall a. Ord a => a -> a -> Bool
<= Priority
p2)
lt :: Double -> Priority -> Double -> Priority -> Bool
{-# INLINE lt #-}
lt :: Double -> Priority -> Double -> Priority -> Bool
lt Double
k1 Priority
p1 Double
k2 Priority
p2 = Double -> Priority -> Double -> Priority -> Bool
gt Double
k2 Priority
p2 Double
k1 Priority
p1
lte :: Double -> Priority -> Double -> Priority -> Bool
{-# INLINE lte #-}
lte :: Double -> Priority -> Double -> Priority -> Bool
lte Double
k1 Priority
p1 Double
k2 Priority
p2 = Double -> Priority -> Double -> Priority -> Bool
gte Double
k2 Priority
p2 Double
k1 Priority
p1