{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module     : Simulation.Aivika.PriorityQueue
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- An imperative heap-based priority queue.
--
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

-- | The 'PriorityQueue' type represents an imperative heap-based 
-- priority queue.
data PriorityQueue a = 
  PriorityQueue { PriorityQueue a -> IORef (IOUArray Int Double)
pqKeys  :: IORef (IOUArray Int Double),
                  PriorityQueue a -> IORef (IOArray Int a)
pqVals  :: IORef (IOArray Int a),
                  PriorityQueue a -> IORef Int
pqSize  :: IORef Int }

increase :: PriorityQueue a -> Int -> IO ()
increase :: PriorityQueue a -> Int -> IO ()
increase PriorityQueue a
pq Int
capacity = 
  do let keyRef :: IORef (IOUArray Int Double)
keyRef = PriorityQueue a -> IORef (IOUArray Int Double)
forall a. PriorityQueue a -> IORef (IOUArray Int Double)
pqKeys PriorityQueue a
pq
         valRef :: IORef (IOArray Int a)
valRef = PriorityQueue a -> IORef (IOArray Int a)
forall a. PriorityQueue a -> IORef (IOArray Int a)
pqVals PriorityQueue a
pq
     IOUArray Int Double
keys <- IORef (IOUArray Int Double) -> IO (IOUArray Int Double)
forall a. IORef a -> IO a
readIORef IORef (IOUArray Int Double)
keyRef
     IOArray Int a
vals <- IORef (IOArray Int a) -> IO (IOArray Int a)
forall a. IORef a -> IO a
readIORef IORef (IOArray Int a)
valRef
     (Int
il, Int
iu)  <- IOUArray Int Double -> IO (Int, Int)
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
il) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
         capacity' :: Int
capacity' | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
64  = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
capacity ((Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
                   | Bool
otherwise = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
capacity ((Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3)
         il' :: Int
il' = Int
il
         iu' :: Int
iu' = Int
il Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
capacity' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
     IOUArray Int Double
keys' <- (Int, Int) -> IO (IOUArray Int Double)
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' <- (Int, Int) -> IO (IOArray Int a)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (Int
il', Int
iu')
     (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
i -> do { Double
k <- IOUArray Int Double -> Int -> IO Double
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Int Double
keys Int
i; IOUArray Int Double -> Int -> Double -> IO ()
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]
     (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
i -> do { a
v <- IOArray Int a -> Int -> IO a
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
i; IOArray Int a -> Int -> a -> IO ()
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]
     IORef (IOUArray Int Double) -> IOUArray Int Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (IOUArray Int Double)
keyRef IOUArray Int Double
keys'
     IORef (IOArray Int a) -> IOArray Int a -> IO ()
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 :: 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 
  then do IOUArray Int Double -> Int -> Double -> IO ()
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
          IOArray Int a -> Int -> a -> IO ()
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
          Double
kn <- IOUArray Int Double -> Int -> IO Double
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 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
kn 
            then do IOUArray Int Double -> Int -> Double -> IO ()
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
                    IOArray Int a -> Int -> a -> IO ()
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 <- IOArray Int a -> Int -> IO a
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
n
                    IOUArray Int Double -> Int -> Double -> IO ()
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
                    IOArray Int a -> Int -> a -> IO ()
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
                    IOUArray Int Double -> IOArray Int a -> Int -> Double -> a -> IO ()
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 :: 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
size Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
  then do IOUArray Int Double -> Int -> Double -> IO ()
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
          IOArray Int a -> Int -> a -> IO ()
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
              n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
          Double
kn  <- IOUArray Int Double -> Int -> IO Double
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' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
size 
            then if Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
kn
                 then do IOUArray Int Double -> Int -> Double -> IO ()
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
                         IOArray Int a -> Int -> a -> IO ()
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 <- IOArray Int a -> Int -> IO a
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
n
                         IOUArray Int Double -> Int -> Double -> IO ()
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
                         IOArray Int a -> Int -> a -> IO ()
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
                         IOUArray Int Double
-> IOArray Int a -> Int -> Int -> Double -> a -> IO ()
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' <- IOUArray Int Double -> Int -> IO Double
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 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
kn' then Int
n' else Int
n
                        kn'' :: Double
kn'' = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
kn' Double
kn
                    if Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
kn''
                      then do IOUArray Int Double -> Int -> Double -> IO ()
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
                              IOArray Int a -> Int -> a -> IO ()
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'' <- IOArray Int a -> Int -> IO a
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
n''
                              IOUArray Int Double -> Int -> Double -> IO ()
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''
                              IOArray Int a -> Int -> a -> IO ()
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''
                              IOUArray Int Double
-> IOArray Int a -> Int -> Int -> Double -> a -> IO ()
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

-- | Test whether the priority queue is empty.
queueNull :: PriorityQueue a -> IO Bool
queueNull :: PriorityQueue a -> IO Bool
queueNull PriorityQueue a
pq =
  do Int
size <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef Int
forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq)
     Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

-- | Return the number of elements in the priority queue.
queueCount :: PriorityQueue a -> IO Int
queueCount :: PriorityQueue a -> IO Int
queueCount PriorityQueue a
pq = IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef Int
forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq)

-- | Create a new priority queue.
newQueue :: IO (PriorityQueue a)
newQueue :: IO (PriorityQueue a)
newQueue =
  do IOUArray Int Double
keys <- (Int, Int) -> IO (IOUArray Int Double)
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 <- (Int, Int) -> IO (IOArray Int a)
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  <- IOUArray Int Double -> IO (IORef (IOUArray Int Double))
forall a. a -> IO (IORef a)
newIORef IOUArray Int Double
keys
     IORef (IOArray Int a)
valRef  <- IOArray Int a -> IO (IORef (IOArray Int a))
forall a. a -> IO (IORef a)
newIORef IOArray Int a
vals
     IORef Int
sizeRef <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
     PriorityQueue a -> IO (PriorityQueue a)
forall (m :: * -> *) a. Monad m => a -> m a
return PriorityQueue :: forall a.
IORef (IOUArray Int Double)
-> IORef (IOArray Int a) -> IORef Int -> PriorityQueue a
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 a new element with the specified priority.
enqueue :: PriorityQueue a -> Double -> a -> IO ()
enqueue :: PriorityQueue a -> Double -> a -> IO ()
enqueue PriorityQueue a
pq Double
k a
v =
  do Int
i <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef Int
forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq)
     IOUArray Int Double
keys <- IORef (IOUArray Int Double) -> IO (IOUArray Int Double)
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef (IOUArray Int Double)
forall a. PriorityQueue a -> IORef (IOUArray Int Double)
pqKeys PriorityQueue a
pq)
     (Int
il, Int
iu) <- IOUArray Int Double -> IO (Int, Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds IOUArray Int Double
keys
     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iu Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
il) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PriorityQueue a -> Int -> IO ()
forall a. PriorityQueue a -> Int -> IO ()
increase PriorityQueue a
pq (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)  -- plus one element on the end
     IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (PriorityQueue a -> IORef Int
forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
     IOUArray Int Double
keys <- IORef (IOUArray Int Double) -> IO (IOUArray Int Double)
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef (IOUArray Int Double)
forall a. PriorityQueue a -> IORef (IOUArray Int Double)
pqKeys PriorityQueue a
pq)  -- it can be another! (side-effect)
     IOArray Int a
vals <- IORef (IOArray Int a) -> IO (IOArray Int a)
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef (IOArray Int a)
forall a. PriorityQueue a -> IORef (IOArray Int a)
pqVals PriorityQueue a
pq)
     IOUArray Int Double -> IOArray Int a -> Int -> Double -> a -> IO ()
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 the element with the minimal priority.
dequeue :: PriorityQueue a -> IO ()
dequeue :: PriorityQueue a -> IO ()
dequeue PriorityQueue a
pq =
  do Int
size <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef Int
forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq)
     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Empty priority queue: dequeue"
     let i :: Int
i = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
     IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (PriorityQueue a -> IORef Int
forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq) Int
i
     IOUArray Int Double
keys <- IORef (IOUArray Int Double) -> IO (IOUArray Int Double)
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef (IOUArray Int Double)
forall a. PriorityQueue a -> IORef (IOUArray Int Double)
pqKeys PriorityQueue a
pq)
     IOArray Int a
vals <- IORef (IOArray Int a) -> IO (IOArray Int a)
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef (IOArray Int a)
forall a. PriorityQueue a -> IORef (IOArray Int a)
pqVals PriorityQueue a
pq)
     Double
k  <- IOUArray Int Double -> Int -> IO Double
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  <- IOArray Int a -> Int -> IO a
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 = a
forall a. HasCallStack => a
undefined
     -- k0 <- readArray keys size
     -- v0 <- readArray vals size
     IOUArray Int Double -> Int -> Double -> IO ()
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
     IOArray Int a -> Int -> a -> IO ()
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
forall a. a
v0
     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       IOUArray Int Double
-> IOArray Int a -> Int -> Int -> Double -> a -> IO ()
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

-- | Return the element with the minimal priority.
queueFront :: PriorityQueue a -> IO (Double, a)
queueFront :: PriorityQueue a -> IO (Double, a)
queueFront PriorityQueue a
pq =
  do Int
size <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef Int
forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq)
     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Empty priority queue: front"
     IOUArray Int Double
keys <- IORef (IOUArray Int Double) -> IO (IOUArray Int Double)
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef (IOUArray Int Double)
forall a. PriorityQueue a -> IORef (IOUArray Int Double)
pqKeys PriorityQueue a
pq)
     IOArray Int a
vals <- IORef (IOArray Int a) -> IO (IOArray Int a)
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef (IOArray Int a)
forall a. PriorityQueue a -> IORef (IOArray Int a)
pqVals PriorityQueue a
pq)
     Double
k <- IOUArray Int Double -> Int -> IO Double
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 <- IOArray Int a -> Int -> IO a
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
0
     (Double, a) -> IO (Double, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
k, a
v)

-- | Remove the specified element from the queue and return a computation of the flag
-- indicating whether the element was actually removed.
--
-- Note that unlike other functions it has complexity O(n).
queueDelete :: Eq a => PriorityQueue a -> a -> IO Bool
queueDelete :: PriorityQueue a -> a -> IO Bool
queueDelete PriorityQueue a
pq a
a = (Maybe a -> Bool) -> IO (Maybe a) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (IO (Maybe a) -> IO Bool) -> IO (Maybe a) -> IO Bool
forall a b. (a -> b) -> a -> b
$ PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
forall a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
queueDeleteBy PriorityQueue a
pq (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a)

-- | Remove an element satisfying the predicate and return a computation of
-- the element if found.
--
-- Note that unlike other functions it has complexity O(n).
queueDeleteBy :: PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
queueDeleteBy :: PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
queueDeleteBy PriorityQueue a
pq a -> Bool
pred =
  do Int
index <- PriorityQueue a -> (a -> Bool) -> IO Int
forall a. PriorityQueue a -> (a -> Bool) -> IO Int
queueIndexBy PriorityQueue a
pq a -> Bool
pred
     if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
       then Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
       else do Int
size <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef Int
forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq)
               Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                 [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal error in the priority queue implementation: queueDeleteBy"
               let i :: Int
i = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
               IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (PriorityQueue a -> IORef Int
forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq) Int
i
               IOUArray Int Double
keys <- IORef (IOUArray Int Double) -> IO (IOUArray Int Double)
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef (IOUArray Int Double)
forall a. PriorityQueue a -> IORef (IOUArray Int Double)
pqKeys PriorityQueue a
pq)
               IOArray Int a
vals <- IORef (IOArray Int a) -> IO (IOArray Int a)
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef (IOArray Int a)
forall a. PriorityQueue a -> IORef (IOArray Int a)
pqVals PriorityQueue a
pq)
               a
x <- IOArray Int a -> Int -> IO a
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 <- IOUArray Int Double -> Int -> IO Double
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 <- IOArray Int a -> Int -> IO a
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 = a
forall a. HasCallStack => a
undefined
               IOUArray Int Double -> Int -> Double -> IO ()
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
               IOArray Int a -> Int -> a -> IO ()
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
forall a. a
v0
               Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                 IOUArray Int Double
-> IOArray Int a -> Int -> Int -> Double -> a -> IO ()
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
               Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)

-- | Detect whether the specified element is contained in the queue.
--
-- Note that unlike other functions it has complexity O(n).
queueContains :: Eq a => PriorityQueue a -> a -> IO Bool
queueContains :: PriorityQueue a -> a -> IO Bool
queueContains PriorityQueue a
pq a
a = (Maybe a -> Bool) -> IO (Maybe a) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (IO (Maybe a) -> IO Bool) -> IO (Maybe a) -> IO Bool
forall a b. (a -> b) -> a -> b
$ PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
forall a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
queueContainsBy PriorityQueue a
pq (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a)

-- | Detect whether an element satisfying the predicate is contained in the queue.
--
-- Note that unlike other functions it has complexity O(n).
queueContainsBy :: PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
queueContainsBy :: PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
queueContainsBy PriorityQueue a
pq a -> Bool
pred =
  do Int
index <- PriorityQueue a -> (a -> Bool) -> IO Int
forall a. PriorityQueue a -> (a -> Bool) -> IO Int
queueIndexBy PriorityQueue a
pq a -> Bool
pred
     if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
       then Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
       else do IOArray Int a
vals <- IORef (IOArray Int a) -> IO (IOArray Int a)
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef (IOArray Int a)
forall a. PriorityQueue a -> IORef (IOArray Int a)
pqVals PriorityQueue a
pq)
               a
x <- IOArray Int a -> Int -> IO a
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
vals Int
index
               Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
     
-- | Return the index of the item satisfying the predicate or -1.     
queueIndexBy :: PriorityQueue a -> (a -> Bool) -> IO Int
queueIndexBy :: PriorityQueue a -> (a -> Bool) -> IO Int
queueIndexBy PriorityQueue a
pq a -> Bool
pred =
  do Int
size <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef Int
forall a. PriorityQueue a -> IORef Int
pqSize PriorityQueue a
pq)
     IOArray Int a
vals <- IORef (IOArray Int a) -> IO (IOArray Int a)
forall a. IORef a -> IO a
readIORef (PriorityQueue a -> IORef (IOArray Int a)
forall a. PriorityQueue a -> IORef (IOArray Int a)
pqVals PriorityQueue a
pq)
     let loop :: Int -> m Int
loop Int
index =
           if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
size
           then Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
           else do a
x <- IOArray Int a -> Int -> m a
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 Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
index
                     else Int -> m Int
loop (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
     Int -> IO Int
forall (m :: * -> *). MArray IOArray a m => Int -> m Int
loop Int
0

-- | Use 'queueDelete' instead.
remove :: Eq a => PriorityQueue a -> a -> IO Bool
{-# DEPRECATED remove "Use queueDelete instead." #-}
remove :: PriorityQueue a -> a -> IO Bool
remove = PriorityQueue a -> a -> IO Bool
forall a. Eq a => PriorityQueue a -> a -> IO Bool
queueDelete

-- | Use 'queueDeleteBy' instead.
removeBy :: PriorityQueue a -> (a -> Bool) -> IO Bool
{-# DEPRECATED removeBy "Use queueDeleteBy instead." #-}
removeBy :: PriorityQueue a -> (a -> Bool) -> IO Bool
removeBy PriorityQueue a
pq a -> Bool
pred = (Maybe a -> Bool) -> IO (Maybe a) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (IO (Maybe a) -> IO Bool) -> IO (Maybe a) -> IO Bool
forall a b. (a -> b) -> a -> b
$ PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
forall a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
queueDeleteBy PriorityQueue a
pq a -> Bool
pred