{-# LANGUAGE FlexibleContexts #-}
module Simulation.Aivika.PriorityQueue
(PriorityQueue,
queueNull,
queueCount,
newQueue,
enqueue,
dequeue,
queueFront,
queueDelete,
queueDeleteBy,
queueContains,
queueContainsBy,
remove,
removeBy) where
import Data.Array
import Data.Array.MArray.Safe
import Data.Array.IO.Safe
import Data.IORef
import Data.Maybe
import Control.Monad
data PriorityQueue a =
PriorityQueue { forall a. PriorityQueue a -> IORef (IOUArray Int Double)
pqKeys :: IORef (IOUArray Int Double),
forall a. PriorityQueue a -> IORef (IOArray Int a)
pqVals :: IORef (IOArray Int a),
forall a. PriorityQueue a -> IORef Int
pqSize :: IORef Int }
increase :: PriorityQueue a -> Int -> IO ()
increase :: forall a. PriorityQueue a -> Int -> IO ()
increase PriorityQueue a
pq Int
capacity =
do let keyRef :: IORef (IOUArray Int Double)
keyRef = forall a. PriorityQueue a -> IORef (IOUArray Int Double)
pqKeys PriorityQueue a
pq
valRef :: IORef (IOArray Int a)
valRef = forall a. PriorityQueue a -> IORef (IOArray Int a)
pqVals PriorityQueue a
pq
IOUArray Int Double
keys <- forall a. IORef a -> IO a
readIORef IORef (IOUArray Int Double)
keyRef
IOArray Int a
vals <- forall a. IORef a -> IO a
readIORef IORef (IOArray Int a)
valRef
(Int
il, Int
iu) <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds IOUArray Int Double
keys
let len :: Int
len = (Int
iu forall a. Num a => a -> a -> a
- Int
il) forall a. Num a => a -> a -> a
+ Int
1
capacity' :: Int
capacity' | Int
len forall a. Ord a => a -> a -> Bool
< Int
64 = forall a. Ord a => a -> a -> a
max Int
capacity ((Int
len forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
* Int
2)
| Bool
otherwise = forall a. Ord a => a -> a -> a
max Int
capacity ((Int
len forall a. Integral a => a -> a -> a
`div` Int
2) forall a. Num a => a -> a -> a
* Int
3)
il' :: Int
il' = Int
il
iu' :: Int
iu' = Int
il forall a. Num a => a -> a -> a
+ Int
capacity' forall a. Num a => a -> a -> a
- Int
1
IOUArray Int Double
keys' <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (Int
il', Int
iu')
IOArray Int a
vals' <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (Int
il', Int
iu')
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
i -> do { Double
k <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Int Double
keys Int
i; forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Int Double
keys' Int
i Double
k }) [Int
il..Int
iu]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
i -> do { a
v <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
i; forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int a
vals' Int
i a
v }) [Int
il..Int
iu]
forall a. IORef a -> a -> IO ()
writeIORef IORef (IOUArray Int Double)
keyRef IOUArray Int Double
keys'
forall a. IORef a -> a -> IO ()
writeIORef IORef (IOArray Int a)
valRef IOArray Int a
vals'
siftUp :: IOUArray Int Double
-> IOArray Int a
-> Int -> Double -> a
-> IO ()
siftUp :: forall a.
IOUArray Int Double -> IOArray Int a -> Int -> Double -> a -> IO ()
siftUp IOUArray Int Double
keys IOArray Int a
vals Int
i Double
k a
v =
if Int
i forall a. Eq a => a -> a -> Bool
== Int
0
then do forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Int Double
keys Int
i Double
k
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int a
vals Int
i a
v
else do let n :: Int
n = (Int
i forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`div` Int
2
Double
kn <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Int Double
keys Int
n
if Double
k forall a. Ord a => a -> a -> Bool
>= Double
kn
then do forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Int Double
keys Int
i Double
k
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int a
vals Int
i a
v
else do a
vn <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
n
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Int Double
keys Int
i Double
kn
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int a
vals Int
i a
vn
forall a.
IOUArray Int Double -> IOArray Int a -> Int -> Double -> a -> IO ()
siftUp IOUArray Int Double
keys IOArray Int a
vals Int
n Double
k a
v
siftDown :: IOUArray Int Double
-> IOArray Int a -> Int
-> Int -> Double -> a
-> IO ()
siftDown :: forall a.
IOUArray Int Double
-> IOArray Int a -> Int -> Int -> Double -> a -> IO ()
siftDown IOUArray Int Double
keys IOArray Int a
vals Int
size Int
i Double
k a
v =
if Int
i forall a. Ord a => a -> a -> Bool
>= (Int
size forall a. Integral a => a -> a -> a
`div` Int
2)
then do forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Int Double
keys Int
i Double
k
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int a
vals Int
i a
v
else do let n :: Int
n = Int
2 forall a. Num a => a -> a -> a
* Int
i forall a. Num a => a -> a -> a
+ Int
1
n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
+ Int
1
Double
kn <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Int Double
keys Int
n
if Int
n' forall a. Ord a => a -> a -> Bool
>= Int
size
then if Double
k forall a. Ord a => a -> a -> Bool
<= Double
kn
then do forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Int Double
keys Int
i Double
k
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int a
vals Int
i a
v
else do a
vn <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
n
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Int Double
keys Int
i Double
kn
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int a
vals Int
i a
vn
forall a.
IOUArray Int Double
-> IOArray Int a -> Int -> Int -> Double -> a -> IO ()
siftDown IOUArray Int Double
keys IOArray Int a
vals Int
size Int
n Double
k a
v
else do Double
kn' <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Int Double
keys Int
n'
let n'' :: Int
n'' = if Double
kn forall a. Ord a => a -> a -> Bool
> Double
kn' then Int
n' else Int
n
kn'' :: Double
kn'' = forall a. Ord a => a -> a -> a
min Double
kn' Double
kn
if Double
k forall a. Ord a => a -> a -> Bool
<= Double
kn''
then do forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Int Double
keys Int
i Double
k
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int a
vals Int
i a
v
else do a
vn'' <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
n''
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Int Double
keys Int
i Double
kn''
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int a
vals Int
i a
vn''
forall a.
IOUArray Int Double
-> IOArray Int a -> Int -> Int -> Double -> a -> IO ()
siftDown IOUArray Int Double
keys IOArray Int a
vals Int
size Int
n'' Double
k a
v
queueNull :: PriorityQueue a -> IO Bool
queueNull :: forall a. PriorityQueue a -> IO Bool
queueNull PriorityQueue a
pq =
do Int
size <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
size forall a. Eq a => a -> a -> Bool
== Int
0
queueCount :: PriorityQueue a -> IO Int
queueCount :: forall a. PriorityQueue a -> IO Int
queueCount PriorityQueue a
pq = forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq)
newQueue :: IO (PriorityQueue a)
newQueue :: forall a. IO (PriorityQueue a)
newQueue =
do IOUArray Int Double
keys <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (Int
0, Int
10)
IOArray Int a
vals <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (Int
0, Int
10)
IORef (IOUArray Int Double)
keyRef <- forall a. a -> IO (IORef a)
newIORef IOUArray Int Double
keys
IORef (IOArray Int a)
valRef <- forall a. a -> IO (IORef a)
newIORef IOArray Int a
vals
IORef Int
sizeRef <- forall a. a -> IO (IORef a)
newIORef Int
0
forall (m :: * -> *) a. Monad m => a -> m a
return PriorityQueue { pqKeys :: IORef (IOUArray Int Double)
pqKeys = IORef (IOUArray Int Double)
keyRef,
pqVals :: IORef (IOArray Int a)
pqVals = IORef (IOArray Int a)
valRef,
pqSize :: IORef Int
pqSize = IORef Int
sizeRef }
enqueue :: PriorityQueue a -> Double -> a -> IO ()
enqueue :: forall a. PriorityQueue a -> Double -> a -> IO ()
enqueue PriorityQueue a
pq Double
k a
v =
do Int
i <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq)
IOUArray Int Double
keys <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOUArray Int Double)
pqKeys PriorityQueue a
pq)
(Int
il, Int
iu) <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds IOUArray Int Double
keys
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
>= Int
iu forall a. Num a => a -> a -> a
- Int
il) forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> Int -> IO ()
increase PriorityQueue a
pq (Int
i forall a. Num a => a -> a -> a
+ Int
2)
forall a. IORef a -> a -> IO ()
writeIORef (forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq) (Int
i forall a. Num a => a -> a -> a
+ Int
1)
IOUArray Int Double
keys <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOUArray Int Double)
pqKeys PriorityQueue a
pq)
IOArray Int a
vals <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOArray Int a)
pqVals PriorityQueue a
pq)
forall a.
IOUArray Int Double -> IOArray Int a -> Int -> Double -> a -> IO ()
siftUp IOUArray Int Double
keys IOArray Int a
vals Int
i Double
k a
v
dequeue :: PriorityQueue a -> IO ()
dequeue :: forall a. PriorityQueue a -> IO ()
dequeue PriorityQueue a
pq =
do Int
size <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
size forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"Empty priority queue: dequeue"
let i :: Int
i = Int
size forall a. Num a => a -> a -> a
- Int
1
forall a. IORef a -> a -> IO ()
writeIORef (forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq) Int
i
IOUArray Int Double
keys <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOUArray Int Double)
pqKeys PriorityQueue a
pq)
IOArray Int a
vals <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOArray Int 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 Int Double
keys Int
i
a
v <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
i
let k0 :: Double
k0 = Double
0.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 Int Double
keys Int
i Double
k0
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int a
vals Int
i forall {a}. a
v0
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
forall a.
IOUArray Int Double
-> IOArray Int a -> Int -> Int -> Double -> a -> IO ()
siftDown IOUArray Int Double
keys IOArray Int a
vals Int
i Int
0 Double
k a
v
queueFront :: PriorityQueue a -> IO (Double, a)
queueFront :: forall a. PriorityQueue a -> IO (Double, a)
queueFront PriorityQueue a
pq =
do Int
size <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
size forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"Empty priority queue: front"
IOUArray Int Double
keys <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOUArray Int Double)
pqKeys PriorityQueue a
pq)
IOArray Int a
vals <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOArray Int 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 Int Double
keys Int
0
a
v <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
0
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
k, a
v)
queueDelete :: Eq a => PriorityQueue a -> a -> IO Bool
queueDelete :: forall a. Eq a => PriorityQueue a -> a -> IO Bool
queueDelete PriorityQueue a
pq a
a = 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 a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
queueDeleteBy PriorityQueue a
pq (forall a. Eq a => a -> a -> Bool
== a
a)
queueDeleteBy :: PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
queueDeleteBy :: forall a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
queueDeleteBy PriorityQueue a
pq a -> Bool
pred =
do Int
index <- forall a. PriorityQueue a -> (a -> Bool) -> IO Int
queueIndexBy PriorityQueue a
pq a -> Bool
pred
if Int
index forall a. Ord a => a -> a -> Bool
< Int
0
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else do Int
size <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
size forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal error in the priority queue implementation: queueDeleteBy"
let i :: Int
i = Int
size forall a. Num a => a -> a -> a
- Int
1
forall a. IORef a -> a -> IO ()
writeIORef (forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq) Int
i
IOUArray Int Double
keys <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOUArray Int Double)
pqKeys PriorityQueue a
pq)
IOArray Int a
vals <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOArray Int a)
pqVals PriorityQueue a
pq)
a
x <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
index
Double
k <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Int Double
keys Int
i
a
v <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
i
let k0 :: Double
k0 = Double
0.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 Int Double
keys Int
i Double
k0
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int a
vals Int
i forall {a}. a
v0
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
forall a.
IOUArray Int Double
-> IOArray Int a -> Int -> Int -> Double -> a -> IO ()
siftDown IOUArray Int Double
keys IOArray Int a
vals Int
i Int
index Double
k a
v
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x)
queueContains :: Eq a => PriorityQueue a -> a -> IO Bool
queueContains :: forall a. Eq a => PriorityQueue a -> a -> IO Bool
queueContains PriorityQueue a
pq a
a = 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 a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
queueContainsBy PriorityQueue a
pq (forall a. Eq a => a -> a -> Bool
== a
a)
queueContainsBy :: PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
queueContainsBy :: forall a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
queueContainsBy PriorityQueue a
pq a -> Bool
pred =
do Int
index <- forall a. PriorityQueue a -> (a -> Bool) -> IO Int
queueIndexBy PriorityQueue a
pq a -> Bool
pred
if Int
index forall a. Ord a => a -> a -> Bool
< Int
0
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else do IOArray Int a
vals <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOArray Int a)
pqVals PriorityQueue a
pq)
a
x <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
index
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x)
queueIndexBy :: PriorityQueue a -> (a -> Bool) -> IO Int
queueIndexBy :: forall a. PriorityQueue a -> (a -> Bool) -> IO Int
queueIndexBy PriorityQueue a
pq a -> Bool
pred =
do Int
size <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq)
IOArray Int a
vals <- forall a. IORef a -> IO a
readIORef (forall a. PriorityQueue a -> IORef (IOArray Int a)
pqVals PriorityQueue a
pq)
let loop :: Int -> m Int
loop Int
index =
if Int
index forall a. Ord a => a -> a -> Bool
>= Int
size
then forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
else do a
x <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
index
if a -> Bool
pred a
x
then forall (m :: * -> *) a. Monad m => a -> m a
return Int
index
else Int -> m Int
loop forall a b. (a -> b) -> a -> b
$ Int
index forall a. Num a => a -> a -> a
+ Int
1
forall {m :: * -> *}. MArray IOArray a m => Int -> m Int
loop Int
0
remove :: Eq a => PriorityQueue a -> a -> IO Bool
{-# DEPRECATED remove "Use queueDelete instead." #-}
remove :: forall a. Eq a => PriorityQueue a -> a -> IO Bool
remove = forall a. Eq a => PriorityQueue a -> a -> IO Bool
queueDelete
removeBy :: PriorityQueue a -> (a -> Bool) -> IO Bool
{-# DEPRECATED removeBy "Use queueDeleteBy instead." #-}
removeBy :: forall a. PriorityQueue a -> (a -> Bool) -> IO Bool
removeBy PriorityQueue a
pq a -> Bool
pred = 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 a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
queueDeleteBy PriorityQueue a
pq a -> Bool
pred