{-# LANGUAGE FlexibleContexts #-}
module Simulation.Aivika.PriorityQueue.EventQueue
(PriorityQueue,
Priority,
queueNull,
queueCount,
newQueue,
enqueue,
dequeue,
queueFront) where
import Data.Array
import Data.Array.MArray.Safe
import Data.Array.IO.Safe
import Data.IORef
import Data.Maybe
import Control.Monad
type Priority = Int
data PriorityQueue a =
PriorityQueue { forall a. PriorityQueue a -> IORef (IOUArray Priority Double)
pqKeys :: IORef (IOUArray Int Double),
forall a. PriorityQueue a -> IORef (IOUArray Priority Priority)
pqPris :: IORef (IOUArray Int Priority),
forall a. PriorityQueue a -> IORef (IOArray Priority a)
pqVals :: IORef (IOArray Int a),
forall a. PriorityQueue a -> IORef Priority
pqSize :: IORef Int }
increase :: PriorityQueue a -> Int -> IO ()
increase :: forall a. PriorityQueue a -> Priority -> IO ()
increase PriorityQueue a
pq Priority
capacity =
do let keyRef :: IORef (IOUArray Priority Double)
keyRef = forall a. PriorityQueue a -> IORef (IOUArray Priority Double)
pqKeys PriorityQueue a
pq
priRef :: IORef (IOUArray Priority Priority)
priRef = forall a. PriorityQueue a -> IORef (IOUArray Priority Priority)
pqPris PriorityQueue a
pq
valRef :: IORef (IOArray Priority a)
valRef = forall a. PriorityQueue a -> IORef (IOArray Priority a)
pqVals PriorityQueue a
pq
IOUArray Priority Double
keys <- forall a. IORef a -> IO a
readIORef IORef (IOUArray Priority Double)
keyRef
IOUArray Priority Priority
pris <- forall a. IORef a -> IO a
readIORef IORef (IOUArray Priority Priority)
priRef
IOArray Priority a
vals <- forall a. IORef a -> IO a
readIORef IORef (IOArray Priority a)
valRef
(Priority
il, Priority
iu) <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds IOUArray Priority Double
keys
let len :: Priority
len = (Priority
iu forall a. Num a => a -> a -> a
- Priority
il) forall a. Num a => a -> a -> a
+ Priority
1
capacity' :: Priority
capacity' | Priority
len forall a. Ord a => a -> a -> Bool
< Priority
64 = forall a. Ord a => a -> a -> a
max Priority
capacity ((Priority
len forall a. Num a => a -> a -> a
+ Priority
1) forall a. Num a => a -> a -> a
* Priority
2)
| Bool
otherwise = forall a. Ord a => a -> a -> a
max Priority
capacity ((Priority
len forall a. Integral a => a -> a -> a
`div` Priority
2) forall a. Num a => a -> a -> a
* Priority
3)
il' :: Priority
il' = Priority
il
iu' :: Priority
iu' = Priority
il forall a. Num a => a -> a -> a
+ Priority
capacity' forall a. Num a => a -> a -> a
- Priority
1
IOUArray Priority Double
keys' <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (Priority
il', Priority
iu')
IOUArray Priority Priority
pris' <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (Priority
il', Priority
iu')
IOArray Priority a
vals' <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (Priority
il', Priority
iu')
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Priority
i -> do { Double
k <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Priority Double
keys Priority
i; forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Double
keys' Priority
i Double
k }) [Priority
il..Priority
iu]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Priority
i -> do { Priority
p <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Priority Priority
pris Priority
i; forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Priority
pris' Priority
i Priority
p }) [Priority
il..Priority
iu]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Priority
i -> do { a
v <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Priority a
vals Priority
i; forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Priority a
vals' Priority
i a
v }) [Priority
il..Priority
iu]
forall a. IORef a -> a -> IO ()
writeIORef IORef (IOUArray Priority Double)
keyRef IOUArray Priority Double
keys'
forall a. IORef a -> a -> IO ()
writeIORef IORef (IOUArray Priority Priority)
priRef IOUArray Priority Priority
pris'
forall a. IORef a -> a -> IO ()
writeIORef IORef (IOArray Priority a)
valRef IOArray Priority a
vals'
siftUp :: IOUArray Int Double
-> IOUArray Int Priority
-> IOArray Int a
-> Int
-> Double
-> Priority
-> a
-> IO ()
siftUp :: forall a.
IOUArray Priority Double
-> IOUArray Priority Priority
-> IOArray Priority a
-> Priority
-> Double
-> Priority
-> a
-> IO ()
siftUp IOUArray Priority Double
keys IOUArray Priority Priority
pris IOArray Priority a
vals Priority
i Double
k Priority
p a
v = forall {m :: * -> *}.
(MArray IOUArray Double m, MArray IOUArray Priority m,
MArray IOArray a m) =>
Priority -> m ()
loop Priority
i
where loop :: Priority -> m ()
loop Priority
i =
if Priority
i forall a. Eq a => a -> a -> Bool
== Priority
0
then do forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Double
keys Priority
i Double
k
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Priority
pris Priority
i Priority
p
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Priority a
vals Priority
i a
v
else do let n :: Priority
n = (Priority
i forall a. Num a => a -> a -> a
- Priority
1) forall a. Integral a => a -> a -> a
`div` Priority
2
Double
kn <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Priority Double
keys Priority
n
Priority
pn <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Priority Priority
pris Priority
n
if Double -> Priority -> Double -> Priority -> Bool
gte Double
k Priority
p Double
kn Priority
pn
then do forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Double
keys Priority
i Double
k
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Priority
pris Priority
i Priority
p
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Priority a
vals Priority
i a
v
else do Priority
pn <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Priority Priority
pris Priority
n
a
vn <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Priority a
vals Priority
n
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Double
keys Priority
i Double
kn
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Priority
pris Priority
i Priority
pn
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Priority a
vals Priority
i a
vn
Priority -> m ()
loop Priority
n
siftDown :: IOUArray Int Double
-> IOUArray Int Priority
-> IOArray Int a
-> Int
-> Int
-> Double
-> Priority
-> a
-> IO ()
siftDown :: forall a.
IOUArray Priority Double
-> IOUArray Priority Priority
-> IOArray Priority a
-> Priority
-> Priority
-> Double
-> Priority
-> a
-> IO ()
siftDown IOUArray Priority Double
keys IOUArray Priority Priority
pris IOArray Priority a
vals Priority
size Priority
i Double
k Priority
p a
v = forall {m :: * -> *}.
(MArray IOUArray Double m, MArray IOUArray Priority m,
MArray IOArray a m) =>
Priority -> m ()
loop Priority
i
where loop :: Priority -> m ()
loop Priority
i =
if Priority
i forall a. Ord a => a -> a -> Bool
>= (Priority
size forall a. Integral a => a -> a -> a
`div` Priority
2)
then do forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Double
keys Priority
i Double
k
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Priority
pris Priority
i Priority
p
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Priority a
vals Priority
i a
v
else do let n :: Priority
n = Priority
2 forall a. Num a => a -> a -> a
* Priority
i forall a. Num a => a -> a -> a
+ Priority
1
n' :: Priority
n' = Priority
n forall a. Num a => a -> a -> a
+ Priority
1
Double
kn <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Priority Double
keys Priority
n
Priority
pn <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Priority Priority
pris Priority
n
if Priority
n' forall a. Ord a => a -> a -> Bool
>= Priority
size
then if Double -> Priority -> Double -> Priority -> Bool
lte Double
k Priority
p Double
kn Priority
pn
then do forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Double
keys Priority
i Double
k
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Priority
pris Priority
i Priority
p
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Priority a
vals Priority
i a
v
else do Priority
pn <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Priority Priority
pris Priority
n
a
vn <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Priority a
vals Priority
n
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Double
keys Priority
i Double
kn
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Priority
pris Priority
i Priority
pn
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Priority a
vals Priority
i a
vn
Priority -> m ()
loop Priority
n
else do Double
kn' <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Priority Double
keys Priority
n'
Priority
pn' <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Priority Priority
pris Priority
n'
let n'' :: Priority
n'' = if Double -> Priority -> Double -> Priority -> Bool
gt Double
kn Priority
pn Double
kn' Priority
pn' then Priority
n' else Priority
n
kn'' :: Double
kn'' = if Priority
n'' forall a. Eq a => a -> a -> Bool
== Priority
n' then Double
kn' else Double
kn
pn'' :: Priority
pn'' = if Priority
n'' forall a. Eq a => a -> a -> Bool
== Priority
n' then Priority
pn' else Priority
pn
if Double -> Priority -> Double -> Priority -> Bool
lte Double
k Priority
p Double
kn'' Priority
pn''
then do forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Double
keys Priority
i Double
k
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Priority
pris Priority
i Priority
p
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Priority a
vals Priority
i a
v
else do Priority
pn'' <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Priority Priority
pris Priority
n''
a
vn'' <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Priority a
vals Priority
n''
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Double
keys Priority
i Double
kn''
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Priority
pris Priority
i Priority
pn''
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Priority a
vals Priority
i a
vn''
Priority -> m ()
loop Priority
n''
queueNull :: PriorityQueue a -> IO Bool
queueNull :: forall a. PriorityQueue a -> IO Bool
queueNull PriorityQueue a
pq =
do Priority
size <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef Priority
pqSize PriorityQueue a
pq)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Priority
size forall a. Eq a => a -> a -> Bool
== Priority
0
queueCount :: PriorityQueue a -> IO Int
queueCount :: forall a. PriorityQueue a -> IO Priority
queueCount PriorityQueue a
pq = forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef Priority
pqSize PriorityQueue a
pq)
newQueue :: IO (PriorityQueue a)
newQueue :: forall a. IO (PriorityQueue a)
newQueue =
do IOUArray Priority Double
keys <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (Priority
0, Priority
10)
IOUArray Priority Priority
pris <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (Priority
0, Priority
10)
IOArray Priority a
vals <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (Priority
0, Priority
10)
IORef (IOUArray Priority Double)
keyRef <- forall a. a -> IO (IORef a)
newIORef IOUArray Priority Double
keys
IORef (IOUArray Priority Priority)
priRef <- forall a. a -> IO (IORef a)
newIORef IOUArray Priority Priority
pris
IORef (IOArray Priority a)
valRef <- forall a. a -> IO (IORef a)
newIORef IOArray Priority a
vals
IORef Priority
sizeRef <- forall a. a -> IO (IORef a)
newIORef Priority
0
forall (m :: * -> *) a. Monad m => a -> m a
return PriorityQueue { pqKeys :: IORef (IOUArray Priority Double)
pqKeys = IORef (IOUArray Priority Double)
keyRef,
pqPris :: IORef (IOUArray Priority Priority)
pqPris = IORef (IOUArray Priority Priority)
priRef,
pqVals :: IORef (IOArray Priority a)
pqVals = IORef (IOArray Priority a)
valRef,
pqSize :: IORef Priority
pqSize = IORef Priority
sizeRef }
enqueue :: PriorityQueue a -> Double -> Priority -> a -> IO ()
enqueue :: forall a. PriorityQueue a -> Double -> Priority -> a -> IO ()
enqueue PriorityQueue a
pq Double
k Priority
p a
v =
do Priority
i <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef Priority
pqSize PriorityQueue a
pq)
IOUArray Priority Double
keys <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOUArray Priority Double)
pqKeys PriorityQueue a
pq)
(Priority
il, Priority
iu) <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds IOUArray Priority Double
keys
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Priority
i forall a. Ord a => a -> a -> Bool
>= Priority
iu forall a. Num a => a -> a -> a
- Priority
il) forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> Priority -> IO ()
increase PriorityQueue a
pq (Priority
i forall a. Num a => a -> a -> a
+ Priority
2)
forall a. IORef a -> a -> IO ()
writeIORef (forall a. PriorityQueue a -> IORef Priority
pqSize PriorityQueue a
pq) (Priority
i forall a. Num a => a -> a -> a
+ Priority
1)
IOUArray Priority Double
keys <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOUArray Priority Double)
pqKeys PriorityQueue a
pq)
IOUArray Priority Priority
pris <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOUArray Priority Priority)
pqPris PriorityQueue a
pq)
IOArray Priority a
vals <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOArray Priority a)
pqVals PriorityQueue a
pq)
forall a.
IOUArray Priority Double
-> IOUArray Priority Priority
-> IOArray Priority a
-> Priority
-> Double
-> Priority
-> a
-> IO ()
siftUp IOUArray Priority Double
keys IOUArray Priority Priority
pris IOArray Priority a
vals Priority
i Double
k Priority
p a
v
dequeue :: PriorityQueue a -> IO ()
dequeue :: forall a. PriorityQueue a -> IO ()
dequeue PriorityQueue a
pq =
do Priority
size <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef Priority
pqSize PriorityQueue a
pq)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Priority
size forall a. Eq a => a -> a -> Bool
== Priority
0) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"Empty priority queue: dequeue"
let i :: Priority
i = Priority
size forall a. Num a => a -> a -> a
- Priority
1
forall a. IORef a -> a -> IO ()
writeIORef (forall a. PriorityQueue a -> IORef Priority
pqSize PriorityQueue a
pq) Priority
i
IOUArray Priority Double
keys <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOUArray Priority Double)
pqKeys PriorityQueue a
pq)
IOUArray Priority Priority
pris <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOUArray Priority Priority)
pqPris PriorityQueue a
pq)
IOArray Priority a
vals <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOArray Priority a)
pqVals PriorityQueue a
pq)
Double
k <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Priority Double
keys Priority
i
Priority
p <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Priority Priority
pris Priority
i
a
v <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Priority a
vals Priority
i
let k0 :: Double
k0 = Double
0.0
p0 :: Priority
p0 = Priority
0
v0 :: a
v0 = forall a. HasCallStack => a
undefined
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Double
keys Priority
i Double
k0
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Priority Priority
pris Priority
i Priority
p0
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Priority a
vals Priority
i forall {a}. a
v0
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Priority
i forall a. Ord a => a -> a -> Bool
> Priority
0) forall a b. (a -> b) -> a -> b
$
forall a.
IOUArray Priority Double
-> IOUArray Priority Priority
-> IOArray Priority a
-> Priority
-> Priority
-> Double
-> Priority
-> a
-> IO ()
siftDown IOUArray Priority Double
keys IOUArray Priority Priority
pris IOArray Priority a
vals Priority
i Priority
0 Double
k Priority
p a
v
queueFront :: PriorityQueue a -> IO (Double, Priority, a)
queueFront :: forall a. PriorityQueue a -> IO (Double, Priority, a)
queueFront PriorityQueue a
pq =
do Priority
size <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef Priority
pqSize PriorityQueue a
pq)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Priority
size forall a. Eq a => a -> a -> Bool
== Priority
0) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"Empty priority queue: front"
IOUArray Priority Double
keys <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOUArray Priority Double)
pqKeys PriorityQueue a
pq)
IOUArray Priority Priority
pris <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOUArray Priority Priority)
pqPris PriorityQueue a
pq)
IOArray Priority a
vals <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOArray Priority a)
pqVals PriorityQueue a
pq)
Double
k <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Priority Double
keys Priority
0
Priority
p <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Priority Priority
pris Priority
0
a
v <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Priority a
vals Priority
0
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
k, Priority
p, a
v)
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 forall a. Ord a => a -> a -> Bool
> Double
k2) Bool -> Bool -> Bool
|| (Double
k1 forall a. Eq a => a -> a -> Bool
== Double
k2 Bool -> Bool -> Bool
&& Priority
p1 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 forall a. Ord a => a -> a -> Bool
> Double
k2) Bool -> Bool -> Bool
|| (Double
k1 forall a. Eq a => a -> a -> Bool
== Double
k2 Bool -> Bool -> Bool
&& Priority
p1 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