{-# LANGUAGE CPP #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE TypeFamilies #-}
#endif

{- |
= Finite priority heaps

The @'PrioHeap' k a@ type represents a finite heap (or priority queue) from keys/priorities of type @k@ to values of type @a@.
A 'PrioHeap' is strict in its spine. Unlike with maps, duplicate keys/priorities are allowed.

== Performance

The worst case running time complexities are given, with /n/ referring the the number of elements in the heap.

== Warning

The length of a 'PrioHeap' must not exceed @'maxBound' :: 'Int'@.
Violation of this condition is not detected and if the length limit is exceeded, the behaviour of the heap is undefined.

== Implementation

The implementation uses skew binomial heaps, as described by:

* Chris Okasaki, \"Purely Functional Data Structures\", 1998.
-}

module Data.PrioHeap
    ( PrioHeap
    -- * Construction
    , empty, singleton
    , fromHeap
    -- ** From Lists
    , fromList
    -- * Insertion/Union
    , insert
    , union, unions
    -- * Traversal/Filter
    , map, mapWithKey
    , traverseWithKey
    , filter, filterWithKey
    , partition, partitionWithKey
    , mapMaybe, mapMaybeWithKey
    , mapEither, mapEitherWithKey
    -- * Folds
    , foldMapWithKey
    , foldlWithKey, foldrWithKey
    , foldlWithKey', foldrWithKey'
    , foldMapOrd
    , foldlOrd, foldrOrd
    , foldlOrd', foldrOrd'
    , foldMapWithKeyOrd
    , foldlWithKeyOrd, foldrWithKeyOrd
    , foldlWithKeyOrd', foldrWithKeyOrd'
    -- * Query
    , size
    , member, notMember
    -- * Min
    , adjustMin, adjustMinWithKey
    , lookupMin
    , findMin
    , deleteMin
    , deleteFindMin
    , updateMin, updateMinWithKey
    , minView
    -- * Subranges
    , take
    , drop
    , splitAt
    , takeWhile, takeWhileWithKey
    , dropWhile, dropWhileWithKey
    , span, spanWithKey
    , break, breakWithKey
    , nub
    -- * Conversion
    , keysHeap
    -- ** To Lists
    , toList, toAscList, toDescList
    ) where

import Control.Exception (assert)
import Data.Foldable (foldl', foldr')
import Data.Functor.Classes
import Data.Maybe (fromMaybe)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup((<>)))
#endif
#ifdef __GLASGOW_HASKELL__
import GHC.Exts (IsList)
import qualified GHC.Exts as Exts
#endif
import Prelude hiding (break, drop, dropWhile, filter, map, reverse, span, splitAt, take, takeWhile, uncurry)
import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec)

import Control.DeepSeq (NFData(..))

import qualified Data.Heap.Internal as Heap
import Util.Internal.StrictList

-- | A skew binomial heap with associated priorities.
data PrioHeap k a
    = Empty
    | Heap
        {-# UNPACK #-} !Int  -- size
        !k  -- root key
        a  -- root value
        !(Forest k a)  -- forest

type Forest k a = List (Tree k a)

data Pair k a = Pair !k a

data Tree k a = Node
    { Tree k a -> Int
_rank :: {-# UNPACK #-} !Int
    , Tree k a -> k
_root :: !k
    , Tree k a -> a
_value :: a
    , Tree k a -> List (Pair k a)
_elements :: !(List (Pair k a))
    , Tree k a -> Forest k a
_children :: !(Forest k a)
    }

instance (NFData k, NFData a) => NFData (Pair k a) where
    rnf :: Pair k a -> ()
rnf (Pair k
k a
x) = k -> ()
forall a. NFData a => a -> ()
rnf k
k () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
x

instance (NFData k, NFData a) => NFData (Tree k a) where
    rnf :: Tree k a -> ()
rnf (Node Int
_ k
k a
x List (Pair k a)
xs Forest k a
c) = k -> ()
forall a. NFData a => a -> ()
rnf k
k () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
x () -> () -> ()
`seq` List (Pair k a) -> ()
forall a. NFData a => a -> ()
rnf List (Pair k a)
xs () -> () -> ()
`seq` Forest k a -> ()
forall a. NFData a => a -> ()
rnf Forest k a
c

errorEmpty :: String -> a
errorEmpty :: String -> a
errorEmpty String
s = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"PrioHeap." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": empty heap"

uncurry :: (a -> b -> c) -> Pair a b -> c
uncurry :: (a -> b -> c) -> Pair a b -> c
uncurry a -> b -> c
f (Pair a
x b
y) = a -> b -> c
f a
x b
y
{-# INLINE uncurry #-}

link :: Ord k => Tree k a -> Tree k a -> Tree k a
link :: Tree k a -> Tree k a -> Tree k a
link t1 :: Tree k a
t1@(Node Int
r1 k
key1 a
x1 List (Pair k a)
xs1 Forest k a
c1) t2 :: Tree k a
t2@(Node Int
r2 k
key2 a
x2 List (Pair k a)
xs2 Forest k a
c2) = Bool -> Tree k a -> Tree k a
forall a. HasCallStack => Bool -> a -> a
assert (Int
r1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r2) (Tree k a -> Tree k a) -> Tree k a -> Tree k a
forall a b. (a -> b) -> a -> b
$
    if k
key1 k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
key2
        then Int -> k -> a -> List (Pair k a) -> Forest k a -> Tree k a
forall k a.
Int -> k -> a -> List (Pair k a) -> Forest k a -> Tree k a
Node (Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) k
key1 a
x1 List (Pair k a)
xs1 (Tree k a
t2 Tree k a -> Forest k a -> Forest k a
forall a. a -> List a -> List a
`Cons` Forest k a
c1)
        else Int -> k -> a -> List (Pair k a) -> Forest k a -> Tree k a
forall k a.
Int -> k -> a -> List (Pair k a) -> Forest k a -> Tree k a
Node (Int
r2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) k
key2 a
x2 List (Pair k a)
xs2 (Tree k a
t1 Tree k a -> Forest k a -> Forest k a
forall a. a -> List a -> List a
`Cons` Forest k a
c2)

skewLink :: Ord k => k -> a -> Tree k a -> Tree k a -> Tree k a
skewLink :: k -> a -> Tree k a -> Tree k a -> Tree k a
skewLink k
kx a
x Tree k a
t1 Tree k a
t2 = let Node Int
r k
ky a
y List (Pair k a)
ys Forest k a
c = Tree k a -> Tree k a -> Tree k a
forall k a. Ord k => Tree k a -> Tree k a -> Tree k a
link Tree k a
t1 Tree k a
t2
    in if k
kx k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
ky
        then Int -> k -> a -> List (Pair k a) -> Forest k a -> Tree k a
forall k a.
Int -> k -> a -> List (Pair k a) -> Forest k a -> Tree k a
Node Int
r k
kx a
x (k -> a -> Pair k a
forall k a. k -> a -> Pair k a
Pair k
ky a
y Pair k a -> List (Pair k a) -> List (Pair k a)
forall a. a -> List a -> List a
`Cons` List (Pair k a)
ys) Forest k a
c
        else Int -> k -> a -> List (Pair k a) -> Forest k a -> Tree k a
forall k a.
Int -> k -> a -> List (Pair k a) -> Forest k a -> Tree k a
Node Int
r k
ky a
y (k -> a -> Pair k a
forall k a. k -> a -> Pair k a
Pair k
kx a
x Pair k a -> List (Pair k a) -> List (Pair k a)
forall a. a -> List a -> List a
`Cons` List (Pair k a)
ys) Forest k a
c

insTree :: Ord k => Tree k a -> Forest k a -> Forest k a
insTree :: Tree k a -> Forest k a -> Forest k a
insTree Tree k a
t Forest k a
Nil = Tree k a
t Tree k a -> Forest k a -> Forest k a
forall a. a -> List a -> List a
`Cons` Forest k a
forall a. List a
Nil
insTree Tree k a
t1 f :: Forest k a
f@(Tree k a
t2 `Cons` Forest k a
ts)
    | Tree k a -> Int
forall k a. Tree k a -> Int
_rank Tree k a
t1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Tree k a -> Int
forall k a. Tree k a -> Int
_rank Tree k a
t2 = Tree k a
t1 Tree k a -> Forest k a -> Forest k a
forall a. a -> List a -> List a
`Cons` Forest k a
f
    | Bool
otherwise = Tree k a -> Forest k a -> Forest k a
forall k a. Ord k => Tree k a -> Forest k a -> Forest k a
insTree (Tree k a -> Tree k a -> Tree k a
forall k a. Ord k => Tree k a -> Tree k a -> Tree k a
link Tree k a
t1 Tree k a
t2) Forest k a
ts

mergeTrees :: Ord k => Forest k a -> Forest k a -> Forest k a
mergeTrees :: Forest k a -> Forest k a -> Forest k a
mergeTrees Forest k a
f Forest k a
Nil = Forest k a
f
mergeTrees Forest k a
Nil Forest k a
f = Forest k a
f
mergeTrees f1 :: Forest k a
f1@(Tree k a
t1 `Cons` Forest k a
ts1) f2 :: Forest k a
f2@(Tree k a
t2 `Cons` Forest k a
ts2) = case Tree k a -> Int
forall k a. Tree k a -> Int
_rank Tree k a
t1 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Tree k a -> Int
forall k a. Tree k a -> Int
_rank Tree k a
t2 of
    Ordering
LT -> Tree k a
t1 Tree k a -> Forest k a -> Forest k a
forall a. a -> List a -> List a
`Cons` Forest k a -> Forest k a -> Forest k a
forall k a. Ord k => Forest k a -> Forest k a -> Forest k a
mergeTrees Forest k a
ts1 Forest k a
f2
    Ordering
GT -> Tree k a
t2 Tree k a -> Forest k a -> Forest k a
forall a. a -> List a -> List a
`Cons` Forest k a -> Forest k a -> Forest k a
forall k a. Ord k => Forest k a -> Forest k a -> Forest k a
mergeTrees Forest k a
f1 Forest k a
ts2
    Ordering
EQ -> Tree k a -> Forest k a -> Forest k a
forall k a. Ord k => Tree k a -> Forest k a -> Forest k a
insTree (Tree k a -> Tree k a -> Tree k a
forall k a. Ord k => Tree k a -> Tree k a -> Tree k a
link Tree k a
t1 Tree k a
t2) (Forest k a -> Forest k a -> Forest k a
forall k a. Ord k => Forest k a -> Forest k a -> Forest k a
mergeTrees Forest k a
ts1 Forest k a
ts2)

merge :: Ord k => Forest k a -> Forest k a -> Forest k a
merge :: Forest k a -> Forest k a -> Forest k a
merge Forest k a
f1 Forest k a
f2 = Forest k a -> Forest k a -> Forest k a
forall k a. Ord k => Forest k a -> Forest k a -> Forest k a
mergeTrees (Forest k a -> Forest k a
forall k a. Ord k => Forest k a -> Forest k a
normalize Forest k a
f1) (Forest k a -> Forest k a
forall k a. Ord k => Forest k a -> Forest k a
normalize Forest k a
f2)
{-# INLINE merge #-}

normalize :: Ord k => Forest k a -> Forest k a
normalize :: Forest k a -> Forest k a
normalize Forest k a
Nil = Forest k a
forall a. List a
Nil
normalize (Tree k a
t `Cons` Forest k a
ts) = Tree k a -> Forest k a -> Forest k a
forall k a. Ord k => Tree k a -> Forest k a -> Forest k a
insTree Tree k a
t Forest k a
ts
{-# INLiNE normalize #-}

ins :: Ord k => k -> a -> Forest k a -> Forest k a
ins :: k -> a -> Forest k a -> Forest k a
ins k
key a
x (Tree k a
t1 `Cons` Tree k a
t2 `Cons` Forest k a
ts)
    | Tree k a -> Int
forall k a. Tree k a -> Int
_rank Tree k a
t1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Tree k a -> Int
forall k a. Tree k a -> Int
_rank Tree k a
t2 = k
key k -> Forest k a -> Forest k a
`seq` k -> a -> Tree k a -> Tree k a -> Tree k a
forall k a. Ord k => k -> a -> Tree k a -> Tree k a -> Tree k a
skewLink k
key a
x Tree k a
t1 Tree k a
t2 Tree k a -> Forest k a -> Forest k a
forall a. a -> List a -> List a
`Cons` Forest k a
ts
ins k
key a
x Forest k a
ts = k
key k -> Forest k a -> Forest k a
`seq` Int -> k -> a -> List (Pair k a) -> Forest k a -> Tree k a
forall k a.
Int -> k -> a -> List (Pair k a) -> Forest k a -> Tree k a
Node Int
0 k
key a
x List (Pair k a)
forall a. List a
Nil Forest k a
forall a. List a
Nil Tree k a -> Forest k a -> Forest k a
forall a. a -> List a -> List a
`Cons` Forest k a
ts

fromForest :: Ord k => Int -> Forest k a -> PrioHeap k a
fromForest :: Int -> Forest k a -> PrioHeap k a
fromForest Int
_ Forest k a
Nil = PrioHeap k a
forall k a. PrioHeap k a
Empty
fromForest Int
s f :: Forest k a
f@(Tree k a
_ `Cons` Forest k a
_) =
    let (Node Int
_ k
key a
x List (Pair k a)
xs Forest k a
ts1, Forest k a
ts2) = Forest k a -> (Tree k a, Forest k a)
forall k a. Ord k => Forest k a -> (Tree k a, Forest k a)
removeMinTree Forest k a
f
    in Int -> k -> a -> Forest k a -> PrioHeap k a
forall k a. Int -> k -> a -> Forest k a -> PrioHeap k a
Heap Int
s k
key a
x ((Forest k a -> Pair k a -> Forest k a)
-> Forest k a -> List (Pair k a) -> Forest k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Forest k a
acc (Pair k
key a
x) -> k -> a -> Forest k a -> Forest k a
forall k a. Ord k => k -> a -> Forest k a -> Forest k a
ins k
key a
x Forest k a
acc) (Forest k a -> Forest k a -> Forest k a
forall k a. Ord k => Forest k a -> Forest k a -> Forest k a
merge (Forest k a -> Forest k a
forall a. List a -> List a
reverse Forest k a
ts1) Forest k a
ts2) List (Pair k a)
xs)

removeMinTree :: Ord k => Forest k a -> (Tree k a, Forest k a)
removeMinTree :: Forest k a -> (Tree k a, Forest k a)
removeMinTree Forest k a
Nil = String -> (Tree k a, Forest k a)
forall a. HasCallStack => String -> a
error String
"removeMinTree: empty heap"
removeMinTree (Tree k a
t `Cons` Forest k a
Nil) = (Tree k a
t, Forest k a
forall a. List a
Nil)
removeMinTree (Tree k a
t `Cons` Forest k a
ts) =
    let (Tree k a
t', Forest k a
ts') = Forest k a -> (Tree k a, Forest k a)
forall k a. Ord k => Forest k a -> (Tree k a, Forest k a)
removeMinTree Forest k a
ts
    in if Tree k a -> k
forall k a. Tree k a -> k
_root Tree k a
t k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= Tree k a -> k
forall k a. Tree k a -> k
_root Tree k a
t'
        then (Tree k a
t, Forest k a
ts)
        else (Tree k a
t', Tree k a
t Tree k a -> Forest k a -> Forest k a
forall a. a -> List a -> List a
`Cons` Forest k a
ts')

instance Show2 PrioHeap where
    liftShowsPrec2 :: (Int -> a -> String -> String)
-> ([a] -> String -> String)
-> (Int -> b -> String -> String)
-> ([b] -> String -> String)
-> Int
-> PrioHeap a b
-> String
-> String
liftShowsPrec2 Int -> a -> String -> String
spk [a] -> String -> String
slk Int -> b -> String -> String
spv [b] -> String -> String
slv Int
p PrioHeap a b
heap = (Int -> [(a, b)] -> String -> String)
-> String -> Int -> [(a, b)] -> String -> String
forall a.
(Int -> a -> String -> String)
-> String -> Int -> a -> String -> String
showsUnaryWith ((Int -> (a, b) -> String -> String)
-> ([(a, b)] -> String -> String)
-> Int
-> [(a, b)]
-> String
-> String
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> f a -> String -> String
liftShowsPrec Int -> (a, b) -> String -> String
sp [(a, b)] -> String -> String
sl) String
"fromList" Int
p (PrioHeap a b -> [(a, b)]
forall k a. PrioHeap k a -> [(k, a)]
toList PrioHeap a b
heap)
      where
        sp :: Int -> (a, b) -> String -> String
sp = (Int -> a -> String -> String)
-> ([a] -> String -> String)
-> (Int -> b -> String -> String)
-> ([b] -> String -> String)
-> Int
-> (a, b)
-> String
-> String
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> String -> String)
-> ([a] -> String -> String)
-> (Int -> b -> String -> String)
-> ([b] -> String -> String)
-> Int
-> f a b
-> String
-> String
liftShowsPrec2 Int -> a -> String -> String
spk [a] -> String -> String
slk Int -> b -> String -> String
spv [b] -> String -> String
slv
        sl :: [(a, b)] -> String -> String
sl = (Int -> a -> String -> String)
-> ([a] -> String -> String)
-> (Int -> b -> String -> String)
-> ([b] -> String -> String)
-> [(a, b)]
-> String
-> String
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> String -> String)
-> ([a] -> String -> String)
-> (Int -> b -> String -> String)
-> ([b] -> String -> String)
-> [f a b]
-> String
-> String
liftShowList2 Int -> a -> String -> String
spk [a] -> String -> String
slk Int -> b -> String -> String
spv [b] -> String -> String
slv

instance Show k => Show1 (PrioHeap k) where
    liftShowsPrec :: (Int -> a -> String -> String)
-> ([a] -> String -> String)
-> Int
-> PrioHeap k a
-> String
-> String
liftShowsPrec = (Int -> k -> String -> String)
-> ([k] -> String -> String)
-> (Int -> a -> String -> String)
-> ([a] -> String -> String)
-> Int
-> PrioHeap k a
-> String
-> String
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> String -> String)
-> ([a] -> String -> String)
-> (Int -> b -> String -> String)
-> ([b] -> String -> String)
-> Int
-> f a b
-> String
-> String
liftShowsPrec2 Int -> k -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec [k] -> String -> String
forall a. Show a => [a] -> String -> String
showList

instance (Show k, Show a) => Show (PrioHeap k a) where
    showsPrec :: Int -> PrioHeap k a -> String -> String
showsPrec = Int -> PrioHeap k a -> String -> String
forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
Int -> f a b -> String -> String
showsPrec2

instance (Ord k, Read k) => Read1 (PrioHeap k) where
    liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (PrioHeap k a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = (String -> ReadS (PrioHeap k a)) -> Int -> ReadS (PrioHeap k a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (PrioHeap k a)) -> Int -> ReadS (PrioHeap k a))
-> (String -> ReadS (PrioHeap k a)) -> Int -> ReadS (PrioHeap k a)
forall a b. (a -> b) -> a -> b
$ (Int -> ReadS [(k, a)])
-> String
-> ([(k, a)] -> PrioHeap k a)
-> String
-> ReadS (PrioHeap k a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith ((Int -> ReadS (k, a)) -> ReadS [(k, a)] -> Int -> ReadS [(k, a)]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS (k, a)
rp' ReadS [(k, a)]
rl') String
"fromList" [(k, a)] -> PrioHeap k a
forall k a. Ord k => [(k, a)] -> PrioHeap k a
fromList
      where
        rp' :: Int -> ReadS (k, a)
rp' = (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (k, a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl
        rl' :: ReadS [(k, a)]
rl' = (Int -> ReadS a) -> ReadS [a] -> ReadS [(k, a)]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList Int -> ReadS a
rp ReadS [a]
rl

instance (Ord k, Read k, Read a) => Read (PrioHeap k a) where
#ifdef __GLASGOW_HASKELL__
    readPrec :: ReadPrec (PrioHeap k a)
readPrec = ReadPrec (PrioHeap k a) -> ReadPrec (PrioHeap k a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (PrioHeap k a) -> ReadPrec (PrioHeap k a))
-> ReadPrec (PrioHeap k a) -> ReadPrec (PrioHeap k a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (PrioHeap k a) -> ReadPrec (PrioHeap k a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (PrioHeap k a) -> ReadPrec (PrioHeap k a))
-> ReadPrec (PrioHeap k a) -> ReadPrec (PrioHeap k a)
forall a b. (a -> b) -> a -> b
$ do
        Ident String
"fromList" <- ReadPrec Lexeme
lexP
        [(k, a)]
xs <- ReadPrec [(k, a)]
forall a. Read a => ReadPrec a
readPrec
        PrioHeap k a -> ReadPrec (PrioHeap k a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(k, a)] -> PrioHeap k a
forall k a. Ord k => [(k, a)] -> PrioHeap k a
fromList [(k, a)]
xs)
#else
    readsPrec = readsPrec1
#endif

instance Ord k => Eq1 (PrioHeap k) where
    liftEq :: (a -> b -> Bool) -> PrioHeap k a -> PrioHeap k b -> Bool
liftEq a -> b -> Bool
f PrioHeap k a
heap1 PrioHeap k b
heap2 = PrioHeap k a -> Int
forall k a. PrioHeap k a -> Int
size PrioHeap k a
heap1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== PrioHeap k b -> Int
forall k a. PrioHeap k a -> Int
size PrioHeap k b
heap2 Bool -> Bool -> Bool
&& ((k, a) -> (k, b) -> Bool) -> [(k, a)] -> [(k, b)] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq ((a -> b -> Bool) -> (k, a) -> (k, b) -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
f) (PrioHeap k a -> [(k, a)]
forall k a. Ord k => PrioHeap k a -> [(k, a)]
toAscList PrioHeap k a
heap1) (PrioHeap k b -> [(k, b)]
forall k a. Ord k => PrioHeap k a -> [(k, a)]
toAscList PrioHeap k b
heap2)

instance (Ord k, Eq a) => Eq (PrioHeap k a) where
    == :: PrioHeap k a -> PrioHeap k a -> Bool
(==) = PrioHeap k a -> PrioHeap k a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1

instance Ord k => Ord1 (PrioHeap k) where
    liftCompare :: (a -> b -> Ordering) -> PrioHeap k a -> PrioHeap k b -> Ordering
liftCompare a -> b -> Ordering
f PrioHeap k a
heap1 PrioHeap k b
heap2 = ((k, a) -> (k, b) -> Ordering) -> [(k, a)] -> [(k, b)] -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((a -> b -> Ordering) -> (k, a) -> (k, b) -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
f) (PrioHeap k a -> [(k, a)]
forall k a. Ord k => PrioHeap k a -> [(k, a)]
toAscList PrioHeap k a
heap1) (PrioHeap k b -> [(k, b)]
forall k a. Ord k => PrioHeap k a -> [(k, a)]
toAscList PrioHeap k b
heap2)

instance (Ord k, Ord a) => Ord (PrioHeap k a) where
    compare :: PrioHeap k a -> PrioHeap k a -> Ordering
compare = PrioHeap k a -> PrioHeap k a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1

instance Ord k => Semigroup (PrioHeap k a) where
    <> :: PrioHeap k a -> PrioHeap k a -> PrioHeap k a
(<>) = PrioHeap k a -> PrioHeap k a -> PrioHeap k a
forall k a. Ord k => PrioHeap k a -> PrioHeap k a -> PrioHeap k a
union

instance Ord k => Monoid (PrioHeap k a) where
    mempty :: PrioHeap k a
mempty = PrioHeap k a
forall k a. PrioHeap k a
empty

    mappend :: PrioHeap k a -> PrioHeap k a -> PrioHeap k a
mappend = PrioHeap k a -> PrioHeap k a -> PrioHeap k a
forall a. Semigroup a => a -> a -> a
(<>)

instance Functor (PrioHeap k) where
    fmap :: (a -> b) -> PrioHeap k a -> PrioHeap k b
fmap = (a -> b) -> PrioHeap k a -> PrioHeap k b
forall a b k. (a -> b) -> PrioHeap k a -> PrioHeap k b
map

instance Foldable (PrioHeap k) where
    foldMap :: (a -> m) -> PrioHeap k a -> m
foldMap a -> m
f = (k -> a -> m) -> PrioHeap k a -> m
forall m k a. Monoid m => (k -> a -> m) -> PrioHeap k a -> m
foldMapWithKey ((a -> m) -> k -> a -> m
forall a b. a -> b -> a
const a -> m
f)
    {-# INLINE foldMap #-}

    foldr :: (a -> b -> b) -> b -> PrioHeap k a -> b
foldr a -> b -> b
f = (k -> a -> b -> b) -> b -> PrioHeap k a -> b
forall k a b. (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKey ((a -> b -> b) -> k -> a -> b -> b
forall a b. a -> b -> a
const a -> b -> b
f)
    {-# INLINE foldr #-}

    foldl :: (b -> a -> b) -> b -> PrioHeap k a -> b
foldl b -> a -> b
f = (b -> k -> a -> b) -> b -> PrioHeap k a -> b
forall b k a. (b -> k -> a -> b) -> b -> PrioHeap k a -> b
foldlWithKey ((a -> b) -> k -> a -> b
forall a b. a -> b -> a
const ((a -> b) -> k -> a -> b) -> (b -> a -> b) -> b -> k -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a -> b
f)
    {-# INLINE foldl #-}

    foldr' :: (a -> b -> b) -> b -> PrioHeap k a -> b
foldr' a -> b -> b
f = (k -> a -> b -> b) -> b -> PrioHeap k a -> b
forall k a b. (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKey' ((a -> b -> b) -> k -> a -> b -> b
forall a b. a -> b -> a
const a -> b -> b
f)
    {-# INLINE foldr' #-}

    foldl' :: (b -> a -> b) -> b -> PrioHeap k a -> b
foldl' b -> a -> b
f = (b -> k -> a -> b) -> b -> PrioHeap k a -> b
forall b k a. (b -> k -> a -> b) -> b -> PrioHeap k a -> b
foldlWithKey' ((a -> b) -> k -> a -> b
forall a b. a -> b -> a
const ((a -> b) -> k -> a -> b) -> (b -> a -> b) -> b -> k -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a -> b
f)
    {-# INLINE foldl' #-}

    null :: PrioHeap k a -> Bool
null PrioHeap k a
Empty = Bool
True
    null Heap{} = Bool
False

    length :: PrioHeap k a -> Int
length = PrioHeap k a -> Int
forall k a. PrioHeap k a -> Int
size

instance Traversable (PrioHeap k) where
    traverse :: (a -> f b) -> PrioHeap k a -> f (PrioHeap k b)
traverse a -> f b
f = (k -> a -> f b) -> PrioHeap k a -> f (PrioHeap k b)
forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f b) -> PrioHeap k a -> f (PrioHeap k b)
traverseWithKey ((a -> f b) -> k -> a -> f b
forall a b. a -> b -> a
const a -> f b
f)
    {-# INLINE traverse #-}

#ifdef __GLASGOW_HASKELL__
instance Ord k => IsList (PrioHeap k a) where
    type Item (PrioHeap k a) = (k, a)

    fromList :: [Item (PrioHeap k a)] -> PrioHeap k a
fromList = [Item (PrioHeap k a)] -> PrioHeap k a
forall k a. Ord k => [(k, a)] -> PrioHeap k a
fromList

    toList :: PrioHeap k a -> [Item (PrioHeap k a)]
toList = PrioHeap k a -> [Item (PrioHeap k a)]
forall k a. PrioHeap k a -> [(k, a)]
toList
#endif

instance (NFData k, NFData a) => NFData (PrioHeap k a) where
    rnf :: PrioHeap k a -> ()
rnf PrioHeap k a
Empty = ()
    rnf (Heap Int
_ k
k a
x Forest k a
forest) = k -> ()
forall a. NFData a => a -> ()
rnf k
k () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
x () -> () -> ()
`seq` Forest k a -> ()
forall a. NFData a => a -> ()
rnf Forest k a
forest


-- | /O(1)/. The empty heap.
--
-- > empty = fromList []
empty :: PrioHeap k a
empty :: PrioHeap k a
empty = PrioHeap k a
forall k a. PrioHeap k a
Empty

-- | /O(1)/. A heap with a single element.
--
-- > singleton x = fromList [x]
singleton :: k -> a -> PrioHeap k a
singleton :: k -> a -> PrioHeap k a
singleton k
k a
x = Int -> k -> a -> Forest k a -> PrioHeap k a
forall k a. Int -> k -> a -> Forest k a -> PrioHeap k a
Heap Int
1 k
k a
x Forest k a
forall a. List a
Nil

-- | /O(n * log n)/. Create a heap from a list.
fromList :: Ord k => [(k, a)] -> PrioHeap k a
fromList :: [(k, a)] -> PrioHeap k a
fromList = (PrioHeap k a -> (k, a) -> PrioHeap k a)
-> PrioHeap k a -> [(k, a)] -> PrioHeap k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\PrioHeap k a
acc (k
key, a
x) -> k -> a -> PrioHeap k a -> PrioHeap k a
forall k a. Ord k => k -> a -> PrioHeap k a -> PrioHeap k a
insert k
key a
x PrioHeap k a
acc) PrioHeap k a
forall k a. PrioHeap k a
empty

-- | /O(1)/. Insert a new key and value into the heap.
insert :: Ord k => k -> a -> PrioHeap k a -> PrioHeap k a
insert :: k -> a -> PrioHeap k a -> PrioHeap k a
insert k
key a
x PrioHeap k a
Empty = k -> a -> PrioHeap k a
forall k a. k -> a -> PrioHeap k a
singleton k
key a
x
insert k
kx a
x (Heap Int
s k
ky a
y Forest k a
f)
    | k
kx k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
ky = Int -> k -> a -> Forest k a -> PrioHeap k a
forall k a. Int -> k -> a -> Forest k a -> PrioHeap k a
Heap (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) k
kx a
x (k -> a -> Forest k a -> Forest k a
forall k a. Ord k => k -> a -> Forest k a -> Forest k a
ins k
ky a
y Forest k a
f)
    | Bool
otherwise = Int -> k -> a -> Forest k a -> PrioHeap k a
forall k a. Int -> k -> a -> Forest k a -> PrioHeap k a
Heap (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) k
ky a
y (k -> a -> Forest k a -> Forest k a
forall k a. Ord k => k -> a -> Forest k a -> Forest k a
ins k
kx a
x Forest k a
f)

-- | /O(log n)/. The union of two heaps.
union :: Ord k => PrioHeap k a -> PrioHeap k a -> PrioHeap k a
union :: PrioHeap k a -> PrioHeap k a -> PrioHeap k a
union PrioHeap k a
heap PrioHeap k a
Empty = PrioHeap k a
heap
union PrioHeap k a
Empty PrioHeap k a
heap = PrioHeap k a
heap
union (Heap Int
s1 k
key1 a
x1 Forest k a
f1) (Heap Int
s2 k
key2 a
x2 Forest k a
f2)
    | k
key1 k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
key2 = Int -> k -> a -> Forest k a -> PrioHeap k a
forall k a. Int -> k -> a -> Forest k a -> PrioHeap k a
Heap (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2) k
key1 a
x1 (k -> a -> Forest k a -> Forest k a
forall k a. Ord k => k -> a -> Forest k a -> Forest k a
ins k
key2 a
x2 (Forest k a -> Forest k a -> Forest k a
forall k a. Ord k => Forest k a -> Forest k a -> Forest k a
merge Forest k a
f1 Forest k a
f2))
    | Bool
otherwise = Int -> k -> a -> Forest k a -> PrioHeap k a
forall k a. Int -> k -> a -> Forest k a -> PrioHeap k a
Heap (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2) k
key2 a
x2 (k -> a -> Forest k a -> Forest k a
forall k a. Ord k => k -> a -> Forest k a -> Forest k a
ins k
key1 a
x1 (Forest k a -> Forest k a -> Forest k a
forall k a. Ord k => Forest k a -> Forest k a -> Forest k a
merge Forest k a
f1 Forest k a
f2))

-- | The union of a foldable of heaps.
--
-- > unions = foldl union empty
unions :: (Foldable f, Ord k) => f (PrioHeap k a) -> PrioHeap k a
unions :: f (PrioHeap k a) -> PrioHeap k a
unions = (PrioHeap k a -> PrioHeap k a -> PrioHeap k a)
-> PrioHeap k a -> f (PrioHeap k a) -> PrioHeap k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' PrioHeap k a -> PrioHeap k a -> PrioHeap k a
forall k a. Ord k => PrioHeap k a -> PrioHeap k a -> PrioHeap k a
union PrioHeap k a
forall k a. PrioHeap k a
empty

-- | /O(n)/. Map a function over the heap.
map :: (a -> b) -> PrioHeap k a -> PrioHeap k b
map :: (a -> b) -> PrioHeap k a -> PrioHeap k b
map a -> b
f = (k -> a -> b) -> PrioHeap k a -> PrioHeap k b
forall k a b. (k -> a -> b) -> PrioHeap k a -> PrioHeap k b
mapWithKey ((a -> b) -> k -> a -> b
forall a b. a -> b -> a
const a -> b
f)
{-# INLINE map #-}

-- | /O(n)/. Map a function that has access to the key associated with a value over the heap.
mapWithKey :: (k -> a -> b) -> PrioHeap k a -> PrioHeap k b
mapWithKey :: (k -> a -> b) -> PrioHeap k a -> PrioHeap k b
mapWithKey k -> a -> b
_ PrioHeap k a
Empty = PrioHeap k b
forall k a. PrioHeap k a
Empty
mapWithKey k -> a -> b
f (Heap Int
s k
key a
x Forest k a
forest) = Int -> k -> b -> Forest k b -> PrioHeap k b
forall k a. Int -> k -> a -> Forest k a -> PrioHeap k a
Heap Int
s k
key (k -> a -> b
f k
key a
x) ((Tree k a -> Tree k b) -> Forest k a -> Forest k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tree k a -> Tree k b
mapTree Forest k a
forest)
  where
    mapTree :: Tree k a -> Tree k b
mapTree (Node Int
r k
key a
x List (Pair k a)
xs Forest k a
c) = Int -> k -> b -> List (Pair k b) -> Forest k b -> Tree k b
forall k a.
Int -> k -> a -> List (Pair k a) -> Forest k a -> Tree k a
Node Int
r k
key (k -> a -> b
f k
key a
x) ((Pair k a -> Pair k b) -> List (Pair k a) -> List (Pair k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pair k a -> Pair k b
mapPair List (Pair k a)
xs) ((Tree k a -> Tree k b) -> Forest k a -> Forest k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tree k a -> Tree k b
mapTree Forest k a
c)

    mapPair :: Pair k a -> Pair k b
mapPair (Pair k
key a
x) = k -> b -> Pair k b
forall k a. k -> a -> Pair k a
Pair k
key (k -> a -> b
f k
key a
x)

-- | /O(n)/. Traverse the heap with a function that has access to the key associated with a value.
traverseWithKey :: Applicative f => (k -> a -> f b) -> PrioHeap k a -> f (PrioHeap k b)
traverseWithKey :: (k -> a -> f b) -> PrioHeap k a -> f (PrioHeap k b)
traverseWithKey k -> a -> f b
f = PrioHeap k a -> f (PrioHeap k b)
go
  where
    go :: PrioHeap k a -> f (PrioHeap k b)
go PrioHeap k a
Empty = PrioHeap k b -> f (PrioHeap k b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrioHeap k b
forall k a. PrioHeap k a
Empty
    go (Heap Int
s k
key a
x Forest k a
forest) = Int -> k -> b -> Forest k b -> PrioHeap k b
forall k a. Int -> k -> a -> Forest k a -> PrioHeap k a
Heap Int
s k
key (b -> Forest k b -> PrioHeap k b)
-> f b -> f (Forest k b -> PrioHeap k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> f b
f k
key a
x f (Forest k b -> PrioHeap k b)
-> f (Forest k b) -> f (PrioHeap k b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Tree k a -> f (Tree k b)) -> Forest k a -> f (Forest k b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Tree k a -> f (Tree k b)
traverseTree Forest k a
forest

    traverseTree :: Tree k a -> f (Tree k b)
traverseTree (Node Int
r k
key a
x List (Pair k a)
xs Forest k a
c) = Int -> k -> b -> List (Pair k b) -> Forest k b -> Tree k b
forall k a.
Int -> k -> a -> List (Pair k a) -> Forest k a -> Tree k a
Node Int
r k
key (b -> List (Pair k b) -> Forest k b -> Tree k b)
-> f b -> f (List (Pair k b) -> Forest k b -> Tree k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> f b
f k
key a
x f (List (Pair k b) -> Forest k b -> Tree k b)
-> f (List (Pair k b)) -> f (Forest k b -> Tree k b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Pair k a -> f (Pair k b))
-> List (Pair k a) -> f (List (Pair k b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Pair k a -> f (Pair k b)
traversePair List (Pair k a)
xs f (Forest k b -> Tree k b) -> f (Forest k b) -> f (Tree k b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Tree k a -> f (Tree k b)) -> Forest k a -> f (Forest k b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Tree k a -> f (Tree k b)
traverseTree Forest k a
c
    traversePair :: Pair k a -> f (Pair k b)
traversePair (Pair k
key a
x) = k -> b -> Pair k b
forall k a. k -> a -> Pair k a
Pair k
key (b -> Pair k b) -> f b -> f (Pair k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> f b
f k
key a
x
{-# INLINE traverseWithKey #-}

-- | /O(n)/. Filter all elements that satisfy the predicate.
filter :: Ord k => (a -> Bool) -> PrioHeap k a -> PrioHeap k a
filter :: (a -> Bool) -> PrioHeap k a -> PrioHeap k a
filter a -> Bool
f = (k -> a -> Bool) -> PrioHeap k a -> PrioHeap k a
forall k a.
Ord k =>
(k -> a -> Bool) -> PrioHeap k a -> PrioHeap k a
filterWithKey ((a -> Bool) -> k -> a -> Bool
forall a b. a -> b -> a
const a -> Bool
f)
{-# INLINE filter #-}

-- | /O(n)/. Filter all elements that satisfy the predicate.
filterWithKey :: Ord k => (k -> a -> Bool) -> PrioHeap k a -> PrioHeap k a
filterWithKey :: (k -> a -> Bool) -> PrioHeap k a -> PrioHeap k a
filterWithKey k -> a -> Bool
f = (k -> a -> PrioHeap k a -> PrioHeap k a)
-> PrioHeap k a -> PrioHeap k a -> PrioHeap k a
forall k a b. (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKey k -> a -> PrioHeap k a -> PrioHeap k a
f' PrioHeap k a
forall k a. PrioHeap k a
empty
  where
    f' :: k -> a -> PrioHeap k a -> PrioHeap k a
f' k
key a
x PrioHeap k a
heap
        | k -> a -> Bool
f k
key a
x = k -> a -> PrioHeap k a -> PrioHeap k a
forall k a. Ord k => k -> a -> PrioHeap k a -> PrioHeap k a
insert k
key a
x PrioHeap k a
heap
        | Bool
otherwise = PrioHeap k a
heap
{-# INLINE filterWithKey #-}

-- | /O(n)/. Partition the heap into two heaps, one with all elements that satisfy the predicate
-- and one with all elements that don't satisfy the predicate.
partition :: Ord k => (a -> Bool) -> PrioHeap k a -> (PrioHeap k a, PrioHeap k a)
partition :: (a -> Bool) -> PrioHeap k a -> (PrioHeap k a, PrioHeap k a)
partition a -> Bool
f = (k -> a -> Bool) -> PrioHeap k a -> (PrioHeap k a, PrioHeap k a)
forall k a.
Ord k =>
(k -> a -> Bool) -> PrioHeap k a -> (PrioHeap k a, PrioHeap k a)
partitionWithKey ((a -> Bool) -> k -> a -> Bool
forall a b. a -> b -> a
const a -> Bool
f)
{-# INLINE partition #-}

-- | /O(n)/. Partition the heap into two heaps, one with all elements that satisfy the predicate
-- and one with all elements that don't satisfy the predicate.
partitionWithKey :: Ord k => (k -> a -> Bool) -> PrioHeap k a -> (PrioHeap k a, PrioHeap k a)
partitionWithKey :: (k -> a -> Bool) -> PrioHeap k a -> (PrioHeap k a, PrioHeap k a)
partitionWithKey k -> a -> Bool
f = (k
 -> a
 -> (PrioHeap k a, PrioHeap k a)
 -> (PrioHeap k a, PrioHeap k a))
-> (PrioHeap k a, PrioHeap k a)
-> PrioHeap k a
-> (PrioHeap k a, PrioHeap k a)
forall k a b. (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKey k
-> a
-> (PrioHeap k a, PrioHeap k a)
-> (PrioHeap k a, PrioHeap k a)
f' (PrioHeap k a
forall k a. PrioHeap k a
empty, PrioHeap k a
forall k a. PrioHeap k a
empty)
  where
    f' :: k
-> a
-> (PrioHeap k a, PrioHeap k a)
-> (PrioHeap k a, PrioHeap k a)
f' k
key a
x (PrioHeap k a
heap1, PrioHeap k a
heap2)
        | k -> a -> Bool
f k
key a
x = (k -> a -> PrioHeap k a -> PrioHeap k a
forall k a. Ord k => k -> a -> PrioHeap k a -> PrioHeap k a
insert k
key a
x PrioHeap k a
heap1, PrioHeap k a
heap2)
        | Bool
otherwise = (PrioHeap k a
heap1, k -> a -> PrioHeap k a -> PrioHeap k a
forall k a. Ord k => k -> a -> PrioHeap k a -> PrioHeap k a
insert k
key a
x PrioHeap k a
heap2)
{-# INLINE partitionWithKey #-}

-- | /O(n)/. Map and collect the 'Just' results.
mapMaybe :: Ord k => (a -> Maybe b) -> PrioHeap k a -> PrioHeap k b
mapMaybe :: (a -> Maybe b) -> PrioHeap k a -> PrioHeap k b
mapMaybe a -> Maybe b
f = (k -> a -> Maybe b) -> PrioHeap k a -> PrioHeap k b
forall k a b.
Ord k =>
(k -> a -> Maybe b) -> PrioHeap k a -> PrioHeap k b
mapMaybeWithKey ((a -> Maybe b) -> k -> a -> Maybe b
forall a b. a -> b -> a
const a -> Maybe b
f)
{-# INLINE mapMaybe #-}

-- | /O(n)/. Map and collect the 'Just' results.
mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> PrioHeap k a -> PrioHeap k b
mapMaybeWithKey :: (k -> a -> Maybe b) -> PrioHeap k a -> PrioHeap k b
mapMaybeWithKey k -> a -> Maybe b
f = (k -> a -> PrioHeap k b -> PrioHeap k b)
-> PrioHeap k b -> PrioHeap k a -> PrioHeap k b
forall k a b. (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKey k -> a -> PrioHeap k b -> PrioHeap k b
f' PrioHeap k b
forall k a. PrioHeap k a
empty
  where
    f' :: k -> a -> PrioHeap k b -> PrioHeap k b
f' k
key a
x PrioHeap k b
heap = case k -> a -> Maybe b
f k
key a
x of
        Just b
y -> k -> b -> PrioHeap k b -> PrioHeap k b
forall k a. Ord k => k -> a -> PrioHeap k a -> PrioHeap k a
insert k
key b
y PrioHeap k b
heap
        Maybe b
Nothing -> PrioHeap k b
heap
{-# INLINE mapMaybeWithKey #-}

-- | /O(n)/. Map and separate the 'Left' and 'Right' results.
mapEither :: Ord k => (a -> Either b c) -> PrioHeap k a -> (PrioHeap k b, PrioHeap k c)
mapEither :: (a -> Either b c) -> PrioHeap k a -> (PrioHeap k b, PrioHeap k c)
mapEither a -> Either b c
f = (k -> a -> Either b c)
-> PrioHeap k a -> (PrioHeap k b, PrioHeap k c)
forall k a b c.
Ord k =>
(k -> a -> Either b c)
-> PrioHeap k a -> (PrioHeap k b, PrioHeap k c)
mapEitherWithKey ((a -> Either b c) -> k -> a -> Either b c
forall a b. a -> b -> a
const a -> Either b c
f)
{-# INLINE mapEither #-}

-- | /O(n)/. Map and separate the 'Left' and 'Right' results.
mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> PrioHeap k a -> (PrioHeap k b, PrioHeap k c)
mapEitherWithKey :: (k -> a -> Either b c)
-> PrioHeap k a -> (PrioHeap k b, PrioHeap k c)
mapEitherWithKey k -> a -> Either b c
f = (k
 -> a
 -> (PrioHeap k b, PrioHeap k c)
 -> (PrioHeap k b, PrioHeap k c))
-> (PrioHeap k b, PrioHeap k c)
-> PrioHeap k a
-> (PrioHeap k b, PrioHeap k c)
forall k a b. (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKey k
-> a
-> (PrioHeap k b, PrioHeap k c)
-> (PrioHeap k b, PrioHeap k c)
f' (PrioHeap k b
forall k a. PrioHeap k a
empty, PrioHeap k c
forall k a. PrioHeap k a
empty)
  where
    f' :: k
-> a
-> (PrioHeap k b, PrioHeap k c)
-> (PrioHeap k b, PrioHeap k c)
f' k
key a
x (PrioHeap k b
heap1, PrioHeap k c
heap2) = case k -> a -> Either b c
f k
key a
x of
        Left b
y -> (k -> b -> PrioHeap k b -> PrioHeap k b
forall k a. Ord k => k -> a -> PrioHeap k a -> PrioHeap k a
insert k
key b
y PrioHeap k b
heap1, PrioHeap k c
heap2)
        Right c
y -> (PrioHeap k b
heap1, k -> c -> PrioHeap k c -> PrioHeap k c
forall k a. Ord k => k -> a -> PrioHeap k a -> PrioHeap k a
insert k
key c
y PrioHeap k c
heap2)
{-# INLINE mapEitherWithKey #-}

-- | /O(n)/. Fold the keys and values in the heap, using the given monoid.
foldMapWithKey :: Monoid m => (k -> a -> m) -> PrioHeap k a -> m
foldMapWithKey :: (k -> a -> m) -> PrioHeap k a -> m
foldMapWithKey k -> a -> m
f = (k -> a -> m -> m) -> m -> PrioHeap k a -> m
forall k a b. (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKey (\k
key a
x m
acc -> k -> a -> m
f k
key a
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` m
acc) m
forall a. Monoid a => a
mempty
{-# INLINE foldMapWithKey #-}

-- | /O(n)/. Fold the keys and values in the heap, using the given right-associative function.
foldrWithKey :: (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKey :: (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKey k -> a -> b -> b
f b
acc = PrioHeap k a -> b
go
  where
    go :: PrioHeap k a -> b
go PrioHeap k a
Empty = b
acc
    go (Heap Int
_ k
key a
x Forest k a
forest) = k -> a -> b -> b
f k
key a
x ((Tree k a -> b -> b) -> b -> Forest k a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Tree k a -> b -> b
foldTree b
acc Forest k a
forest)

    foldTree :: Tree k a -> b -> b
foldTree (Node Int
_ k
key a
x List (Pair k a)
xs Forest k a
c) b
acc = k -> a -> b -> b
f k
key a
x ((Pair k a -> b -> b) -> b -> List (Pair k a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((k -> a -> b -> b) -> Pair k a -> b -> b
forall a b c. (a -> b -> c) -> Pair a b -> c
uncurry k -> a -> b -> b
f) ((Tree k a -> b -> b) -> b -> Forest k a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Tree k a -> b -> b
foldTree b
acc Forest k a
c) List (Pair k a)
xs)
{-# INLINE foldrWithKey #-}

-- | /O(n)/. Fold the keys and values in the heap, using the given left-associative function.
foldlWithKey :: (b -> k -> a -> b) -> b -> PrioHeap k a -> b
foldlWithKey :: (b -> k -> a -> b) -> b -> PrioHeap k a -> b
foldlWithKey b -> k -> a -> b
f b
acc = PrioHeap k a -> b
go
  where
    go :: PrioHeap k a -> b
go PrioHeap k a
Empty = b
acc
    go (Heap Int
_ k
key a
x Forest k a
forest) = (b -> Tree k a -> b) -> b -> Forest k a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> Tree k a -> b
foldTree (b -> k -> a -> b
f b
acc k
key a
x) Forest k a
forest

    foldTree :: b -> Tree k a -> b
foldTree b
acc (Node Int
_ k
key a
x List (Pair k a)
xs Forest k a
c) = (b -> Tree k a -> b) -> b -> Forest k a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> Tree k a -> b
foldTree ((b -> Pair k a -> b) -> b -> List (Pair k a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((k -> a -> b) -> Pair k a -> b
forall a b c. (a -> b -> c) -> Pair a b -> c
uncurry ((k -> a -> b) -> Pair k a -> b)
-> (b -> k -> a -> b) -> b -> Pair k a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> k -> a -> b
f) (b -> k -> a -> b
f b
acc k
key a
x) List (Pair k a)
xs) Forest k a
c
{-# INLINE foldlWithKey #-}

-- | /O(n)/. A strict version of 'foldrWithKey'.
-- Each application of the function is evaluated before using the result in the next application.
foldrWithKey' :: (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKey' :: (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKey' k -> a -> b -> b
f b
acc PrioHeap k a
h = ((b -> b) -> k -> a -> b -> b)
-> (b -> b) -> PrioHeap k a -> b -> b
forall b k a. (b -> k -> a -> b) -> b -> PrioHeap k a -> b
foldlWithKey (b -> b) -> k -> a -> b -> b
f' b -> b
forall a. a -> a
id PrioHeap k a
h b
acc
  where
    f' :: (b -> b) -> k -> a -> b -> b
f' b -> b
k k
key a
x b
z = b -> b
k (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! k -> a -> b -> b
f k
key a
x b
z
{-# INLINE foldrWithKey' #-}

-- | /O(n)/. A strict version of 'foldlWithKey'.
-- Each application of the function is evaluated before using the result in the next application.
foldlWithKey' :: (b -> k -> a -> b) -> b -> PrioHeap k a -> b
foldlWithKey' :: (b -> k -> a -> b) -> b -> PrioHeap k a -> b
foldlWithKey' b -> k -> a -> b
f b
acc PrioHeap k a
h = (k -> a -> (b -> b) -> b -> b)
-> (b -> b) -> PrioHeap k a -> b -> b
forall k a b. (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKey k -> a -> (b -> b) -> b -> b
f' b -> b
forall a. a -> a
id PrioHeap k a
h b
acc
  where
    f' :: k -> a -> (b -> b) -> b -> b
f' k
key a
x b -> b
k b
z = b -> b
k (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! b -> k -> a -> b
f b
z k
key a
x
{-# INLINE foldlWithKey' #-}

-- | /O(n * log n)/. Fold the values in the heap in order, using the given monoid.
foldMapOrd :: (Ord k, Monoid m) => (a -> m) -> PrioHeap k a -> m
foldMapOrd :: (a -> m) -> PrioHeap k a -> m
foldMapOrd a -> m
f = (k -> a -> m) -> PrioHeap k a -> m
forall k m a.
(Ord k, Monoid m) =>
(k -> a -> m) -> PrioHeap k a -> m
foldMapWithKeyOrd ((a -> m) -> k -> a -> m
forall a b. a -> b -> a
const a -> m
f)
{-# INLINE foldMapOrd #-}

-- | /O(n * log n)/. Fold the values in the heap in order, using the given right-associative function.
foldrOrd :: Ord k => (a -> b -> b) -> b -> PrioHeap k a -> b
foldrOrd :: (a -> b -> b) -> b -> PrioHeap k a -> b
foldrOrd a -> b -> b
f = (k -> a -> b -> b) -> b -> PrioHeap k a -> b
forall k a b. Ord k => (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKeyOrd ((a -> b -> b) -> k -> a -> b -> b
forall a b. a -> b -> a
const a -> b -> b
f)
{-# INLINE foldrOrd #-}

-- | /O(n * log n)/. Fold the values in the heap in order, using the given left-associative function.
foldlOrd :: Ord k => (b -> a -> b) -> b -> PrioHeap k a -> b
foldlOrd :: (b -> a -> b) -> b -> PrioHeap k a -> b
foldlOrd b -> a -> b
f = (b -> k -> a -> b) -> b -> PrioHeap k a -> b
forall k b a. Ord k => (b -> k -> a -> b) -> b -> PrioHeap k a -> b
foldlWithKeyOrd ((a -> b) -> k -> a -> b
forall a b. a -> b -> a
const ((a -> b) -> k -> a -> b) -> (b -> a -> b) -> b -> k -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a -> b
f)
{-# INLINE foldlOrd #-}

-- | /O(n * log n)/. A strict version of 'foldrOrd'.
-- Each application of the function is evaluated before using the result in the next application.
foldrOrd' :: Ord k => (a -> b -> b) -> b -> PrioHeap k a -> b
foldrOrd' :: (a -> b -> b) -> b -> PrioHeap k a -> b
foldrOrd' a -> b -> b
f = (k -> a -> b -> b) -> b -> PrioHeap k a -> b
forall k a b. Ord k => (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKeyOrd' ((a -> b -> b) -> k -> a -> b -> b
forall a b. a -> b -> a
const a -> b -> b
f)
{-# INLINE foldrOrd' #-}

-- | /O(n)/. A strict version of 'foldlOrd'.
-- Each application of the function is evaluated before using the result in the next application.
foldlOrd' :: Ord k => (b -> a -> b) -> b -> PrioHeap k a -> b
foldlOrd' :: (b -> a -> b) -> b -> PrioHeap k a -> b
foldlOrd' b -> a -> b
f = (b -> k -> a -> b) -> b -> PrioHeap k a -> b
forall k b a. Ord k => (b -> k -> a -> b) -> b -> PrioHeap k a -> b
foldlWithKeyOrd' ((a -> b) -> k -> a -> b
forall a b. a -> b -> a
const ((a -> b) -> k -> a -> b) -> (b -> a -> b) -> b -> k -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a -> b
f)
{-# INLINE foldlOrd' #-}

-- | /O(n * log n)/. Fold the keys and values in the heap in order, using the given monoid.
foldMapWithKeyOrd :: (Ord k, Monoid m) => (k -> a -> m) -> PrioHeap k a -> m
foldMapWithKeyOrd :: (k -> a -> m) -> PrioHeap k a -> m
foldMapWithKeyOrd k -> a -> m
f = (k -> a -> m -> m) -> m -> PrioHeap k a -> m
forall k a b. Ord k => (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKeyOrd (\k
key a
x m
acc -> k -> a -> m
f k
key a
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` m
acc) m
forall a. Monoid a => a
mempty
{-# INLINE foldMapWithKeyOrd #-}

-- | /O(n * log n)/. Fold the keys and values in the heap in order, using the given right-associative function.
foldrWithKeyOrd :: Ord k => (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKeyOrd :: (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKeyOrd k -> a -> b -> b
f b
acc = PrioHeap k a -> b
go
  where
    go :: PrioHeap k a -> b
go PrioHeap k a
h = case PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
forall k a. Ord k => PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
minView PrioHeap k a
h of
        Maybe ((k, a), PrioHeap k a)
Nothing -> b
acc
        Just ((k
key, a
x), PrioHeap k a
h') -> k -> a -> b -> b
f k
key a
x (PrioHeap k a -> b
go PrioHeap k a
h')
{-# INLINE foldrWithKeyOrd #-}

-- | /O(n * log n)/. Fold the keys and values in the heap in order, using the given left-associative function.
foldlWithKeyOrd :: Ord k => (b -> k -> a -> b) -> b -> PrioHeap k a -> b
foldlWithKeyOrd :: (b -> k -> a -> b) -> b -> PrioHeap k a -> b
foldlWithKeyOrd b -> k -> a -> b
f = b -> PrioHeap k a -> b
go
  where
    go :: b -> PrioHeap k a -> b
go b
acc PrioHeap k a
h = case PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
forall k a. Ord k => PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
minView PrioHeap k a
h of
        Maybe ((k, a), PrioHeap k a)
Nothing -> b
acc
        Just ((k
key, a
x), PrioHeap k a
h') -> b -> PrioHeap k a -> b
go (b -> k -> a -> b
f b
acc k
key a
x) PrioHeap k a
h'
{-# INLINE foldlWithKeyOrd #-}

-- | /O(n * log n)/. A strict version of 'foldrWithKeyOrd'.
-- Each application of the function is evaluated before using the result in the next application.
foldrWithKeyOrd' :: Ord k => (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKeyOrd' :: (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKeyOrd' k -> a -> b -> b
f b
acc PrioHeap k a
h = ((b -> b) -> k -> a -> b -> b)
-> (b -> b) -> PrioHeap k a -> b -> b
forall k b a. Ord k => (b -> k -> a -> b) -> b -> PrioHeap k a -> b
foldlWithKeyOrd (b -> b) -> k -> a -> b -> b
f' b -> b
forall a. a -> a
id PrioHeap k a
h b
acc
  where
    f' :: (b -> b) -> k -> a -> b -> b
f' b -> b
k k
key a
x b
z = b -> b
k (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! k -> a -> b -> b
f k
key a
x b
z
{-# INLINE foldrWithKeyOrd' #-}

-- | /O(n)/. A strict version of 'foldlWithKeyOrd'.
-- Each application of the function is evaluated before using the result in the next application.
foldlWithKeyOrd' :: Ord k => (b -> k -> a -> b) -> b -> PrioHeap k a -> b
foldlWithKeyOrd' :: (b -> k -> a -> b) -> b -> PrioHeap k a -> b
foldlWithKeyOrd' b -> k -> a -> b
f b
acc PrioHeap k a
h = (k -> a -> (b -> b) -> b -> b)
-> (b -> b) -> PrioHeap k a -> b -> b
forall k a b. Ord k => (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKeyOrd k -> a -> (b -> b) -> b -> b
f' b -> b
forall a. a -> a
id PrioHeap k a
h b
acc
  where
    f' :: k -> a -> (b -> b) -> b -> b
f' k
key a
x b -> b
k b
z = b -> b
k (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! b -> k -> a -> b
f b
z k
key a
x
{-# INLINE foldlWithKeyOrd' #-}

-- | /O(1)/. The number of elements in the heap.
size :: PrioHeap k a -> Int
size :: PrioHeap k a -> Int
size PrioHeap k a
Empty = Int
0
size (Heap Int
s k
_ a
_ Forest k a
_) = Int
s

-- | /O(n)/. Is the key a member of the heap?
member :: Ord k => k -> PrioHeap k a -> Bool
member :: k -> PrioHeap k a -> Bool
member k
_ PrioHeap k a
Empty = Bool
False
member k
kx (Heap Int
_ k
ky a
_ Forest k a
forest) = k
kx k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
ky Bool -> Bool -> Bool
&& (Tree k a -> Bool) -> Forest k a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (k
kx k -> Tree k a -> Bool
forall t a. Ord t => t -> Tree t a -> Bool
`elemTree`) Forest k a
forest
  where
    t
kx elemTree :: t -> Tree t a -> Bool
`elemTree` (Node Int
_ t
ky a
_ List (Pair t a)
ys Forest t a
c) = t
kx t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
ky Bool -> Bool -> Bool
&& ((Pair t a -> Bool) -> List (Pair t a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(Pair t
a a
_) -> t
kx t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
a) List (Pair t a)
ys Bool -> Bool -> Bool
|| (Tree t a -> Bool) -> Forest t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (t
kx t -> Tree t a -> Bool
`elemTree`) Forest t a
c)

-- | /O(n)/. Is the value not a member of the heap?
notMember :: Ord k => k -> PrioHeap k a -> Bool
notMember :: k -> PrioHeap k a -> Bool
notMember k
key = Bool -> Bool
not (Bool -> Bool) -> (PrioHeap k a -> Bool) -> PrioHeap k a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> PrioHeap k a -> Bool
forall k a. Ord k => k -> PrioHeap k a -> Bool
member k
key

-- | /O(1)/. Adjust the value at the minimal key.
adjustMin :: (a -> a) -> PrioHeap k a -> PrioHeap k a
adjustMin :: (a -> a) -> PrioHeap k a -> PrioHeap k a
adjustMin a -> a
f = (k -> a -> a) -> PrioHeap k a -> PrioHeap k a
forall k a. (k -> a -> a) -> PrioHeap k a -> PrioHeap k a
adjustMinWithKey ((a -> a) -> k -> a -> a
forall a b. a -> b -> a
const a -> a
f)
{-# INLINE adjustMin #-}

-- | /O(1)/. Adjust the value at the minimal key.
adjustMinWithKey :: (k -> a -> a) -> PrioHeap k a -> PrioHeap k a
adjustMinWithKey :: (k -> a -> a) -> PrioHeap k a -> PrioHeap k a
adjustMinWithKey k -> a -> a
_ PrioHeap k a
Empty = PrioHeap k a
forall k a. PrioHeap k a
Empty
adjustMinWithKey k -> a -> a
f (Heap Int
s k
key a
x Forest k a
forest) = Int -> k -> a -> Forest k a -> PrioHeap k a
forall k a. Int -> k -> a -> Forest k a -> PrioHeap k a
Heap Int
s k
key (k -> a -> a
f k
key a
x) Forest k a
forest

-- | /O(1)/. The minimal element in the heap or 'Nothing' if the heap is empty.
lookupMin :: PrioHeap k a -> Maybe (k, a)
lookupMin :: PrioHeap k a -> Maybe (k, a)
lookupMin PrioHeap k a
Empty = Maybe (k, a)
forall a. Maybe a
Nothing
lookupMin (Heap Int
_ k
key a
x Forest k a
_) = (k, a) -> Maybe (k, a)
forall a. a -> Maybe a
Just (k
key, a
x)

-- | /O(1)/. The minimal element in the heap. Calls 'error' if the heap is empty.
findMin :: PrioHeap k a -> (k, a)
findMin :: PrioHeap k a -> (k, a)
findMin PrioHeap k a
heap = (k, a) -> Maybe (k, a) -> (k, a)
forall a. a -> Maybe a -> a
fromMaybe (String -> (k, a)
forall a. String -> a
errorEmpty String
"findMin") (PrioHeap k a -> Maybe (k, a)
forall k a. PrioHeap k a -> Maybe (k, a)
lookupMin PrioHeap k a
heap)

-- | /O(log n)/. Delete the minimal element. Returns the empty heap if the heap is empty.
deleteMin :: Ord k => PrioHeap k a -> PrioHeap k a
deleteMin :: PrioHeap k a -> PrioHeap k a
deleteMin PrioHeap k a
Empty = PrioHeap k a
forall k a. PrioHeap k a
Empty
deleteMin (Heap Int
s k
_ a
_ Forest k a
f) = Int -> Forest k a -> PrioHeap k a
forall k a. Ord k => Int -> Forest k a -> PrioHeap k a
fromForest (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Forest k a
f

-- | /O(log n)/. Delete and find the minimal element. Calls 'error' if the heap is empty.
--
-- > deleteFindMin heap = (findMin heap, deleteMin heap)
deleteFindMin :: Ord k => PrioHeap k a -> ((k, a), PrioHeap k a)
deleteFindMin :: PrioHeap k a -> ((k, a), PrioHeap k a)
deleteFindMin PrioHeap k a
heap = ((k, a), PrioHeap k a)
-> Maybe ((k, a), PrioHeap k a) -> ((k, a), PrioHeap k a)
forall a. a -> Maybe a -> a
fromMaybe (String -> ((k, a), PrioHeap k a)
forall a. String -> a
errorEmpty String
"deleteFindMin") (PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
forall k a. Ord k => PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
minView PrioHeap k a
heap)

-- | /O(log n)/. Update the value at the minimal key.
updateMin :: Ord k => (a -> Maybe a) -> PrioHeap k a -> PrioHeap k a
updateMin :: (a -> Maybe a) -> PrioHeap k a -> PrioHeap k a
updateMin a -> Maybe a
f = (k -> a -> Maybe a) -> PrioHeap k a -> PrioHeap k a
forall k a.
Ord k =>
(k -> a -> Maybe a) -> PrioHeap k a -> PrioHeap k a
updateMinWithKey ((a -> Maybe a) -> k -> a -> Maybe a
forall a b. a -> b -> a
const a -> Maybe a
f)
{-# INLINE updateMin #-}

-- | /O(log n)/. Update the value at the minimal key.
updateMinWithKey :: Ord k => (k -> a -> Maybe a) -> PrioHeap k a -> PrioHeap k a
updateMinWithKey :: (k -> a -> Maybe a) -> PrioHeap k a -> PrioHeap k a
updateMinWithKey k -> a -> Maybe a
_ PrioHeap k a
Empty = PrioHeap k a
forall k a. PrioHeap k a
Empty
updateMinWithKey k -> a -> Maybe a
f (Heap Int
s k
key a
x Forest k a
forest) = case k -> a -> Maybe a
f k
key a
x of
    Maybe a
Nothing -> Int -> Forest k a -> PrioHeap k a
forall k a. Ord k => Int -> Forest k a -> PrioHeap k a
fromForest (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Forest k a
forest
    Just a
x' -> Int -> k -> a -> Forest k a -> PrioHeap k a
forall k a. Int -> k -> a -> Forest k a -> PrioHeap k a
Heap Int
s k
key a
x' Forest k a
forest

-- | /O(log n)/. Retrieves the minimal key/value pair of the heap and the heap stripped of that element or 'Nothing' if the heap is empty.
minView :: Ord k => PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
minView :: PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
minView PrioHeap k a
Empty = Maybe ((k, a), PrioHeap k a)
forall a. Maybe a
Nothing
minView (Heap Int
s k
key a
x Forest k a
f) = ((k, a), PrioHeap k a) -> Maybe ((k, a), PrioHeap k a)
forall a. a -> Maybe a
Just ((k
key, a
x), Int -> Forest k a -> PrioHeap k a
forall k a. Ord k => Int -> Forest k a -> PrioHeap k a
fromForest (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Forest k a
f)

-- | /O(n * log n)/. @take n heap@ takes the @n@ smallest elements of @heap@, in ascending order.
--
-- > take n heap = take n (toAscList heap)
take :: Ord k => Int -> PrioHeap k a -> [(k, a)]
take :: Int -> PrioHeap k a -> [(k, a)]
take Int
n PrioHeap k a
h
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
    | Bool
otherwise = case PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
forall k a. Ord k => PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
minView PrioHeap k a
h of
        Maybe ((k, a), PrioHeap k a)
Nothing -> []
        Just ((k, a)
x, PrioHeap k a
h') -> (k, a)
x (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: Int -> PrioHeap k a -> [(k, a)]
forall k a. Ord k => Int -> PrioHeap k a -> [(k, a)]
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) PrioHeap k a
h'

-- | /O(n * log n)/. @drop n heap@ drops the @n@ smallest elements from @heap@.
drop :: Ord k => Int -> PrioHeap k a -> PrioHeap k a
drop :: Int -> PrioHeap k a -> PrioHeap k a
drop Int
n PrioHeap k a
h
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = PrioHeap k a
h
    | Bool
otherwise = Int -> PrioHeap k a -> PrioHeap k a
forall k a. Ord k => Int -> PrioHeap k a -> PrioHeap k a
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (PrioHeap k a -> PrioHeap k a
forall k a. Ord k => PrioHeap k a -> PrioHeap k a
deleteMin PrioHeap k a
h)

-- | /O(n * log n)/. @splitAt n heap@ takes and drops the @n@ smallest elements from @heap@.
splitAt :: Ord k => Int -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
splitAt :: Int -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
splitAt Int
n PrioHeap k a
h
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ([], PrioHeap k a
h)
    | Bool
otherwise = case PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
forall k a. Ord k => PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
minView PrioHeap k a
h of
        Maybe ((k, a), PrioHeap k a)
Nothing -> ([], PrioHeap k a
h)
        Just ((k, a)
x, PrioHeap k a
h') -> let ([(k, a)]
xs, PrioHeap k a
h'') = Int -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
forall k a.
Ord k =>
Int -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
splitAt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) PrioHeap k a
h' in ((k, a)
x (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: [(k, a)]
xs, PrioHeap k a
h'')

-- | /O(n * log n)/. @takeWhile p heap@ takes the elements from @heap@ in ascending order, while @p@ holds.
takeWhile :: Ord k => (a -> Bool) -> PrioHeap k a -> [(k, a)]
takeWhile :: (a -> Bool) -> PrioHeap k a -> [(k, a)]
takeWhile a -> Bool
p = (k -> a -> Bool) -> PrioHeap k a -> [(k, a)]
forall k a. Ord k => (k -> a -> Bool) -> PrioHeap k a -> [(k, a)]
takeWhileWithKey ((a -> Bool) -> k -> a -> Bool
forall a b. a -> b -> a
const a -> Bool
p)
{-# INLINE takeWhile #-}

-- | /O(n * log n)/. @takeWhileWithKey p heap@ takes the elements from @heap@ in ascending order, while @p@ holds.
takeWhileWithKey :: Ord k => (k -> a -> Bool) -> PrioHeap k a -> [(k, a)]
takeWhileWithKey :: (k -> a -> Bool) -> PrioHeap k a -> [(k, a)]
takeWhileWithKey k -> a -> Bool
p = PrioHeap k a -> [(k, a)]
go
  where
    go :: PrioHeap k a -> [(k, a)]
go PrioHeap k a
h = case PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
forall k a. Ord k => PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
minView PrioHeap k a
h of
        Maybe ((k, a), PrioHeap k a)
Nothing -> []
        Just ((k
key, a
x), PrioHeap k a
h') -> if k -> a -> Bool
p k
key a
x then (k
key, a
x) (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: PrioHeap k a -> [(k, a)]
go PrioHeap k a
h' else []
{-# INLINE takeWhileWithKey #-}

-- | /O(n * log n)/. @dropWhile p heap@ drops the elements from @heap@ in ascending order, while @p@ holds.
dropWhile :: Ord k => (a -> Bool) -> PrioHeap k a -> PrioHeap k a
dropWhile :: (a -> Bool) -> PrioHeap k a -> PrioHeap k a
dropWhile a -> Bool
p = (k -> a -> Bool) -> PrioHeap k a -> PrioHeap k a
forall k a.
Ord k =>
(k -> a -> Bool) -> PrioHeap k a -> PrioHeap k a
dropWhileWithKey ((a -> Bool) -> k -> a -> Bool
forall a b. a -> b -> a
const a -> Bool
p)
{-# INLINE dropWhile #-}

-- | /O(n * log n)/. @dropWhileWithKey p heap@ drops the elements from @heap@ in ascending order, while @p@ holds.
dropWhileWithKey :: Ord k => (k -> a -> Bool) -> PrioHeap k a -> PrioHeap k a
dropWhileWithKey :: (k -> a -> Bool) -> PrioHeap k a -> PrioHeap k a
dropWhileWithKey k -> a -> Bool
p = PrioHeap k a -> PrioHeap k a
go
  where
    go :: PrioHeap k a -> PrioHeap k a
go PrioHeap k a
h = case PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
forall k a. Ord k => PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
minView PrioHeap k a
h of
        Maybe ((k, a), PrioHeap k a)
Nothing -> PrioHeap k a
h
        Just ((k
key, a
x), PrioHeap k a
h') -> if k -> a -> Bool
p k
key a
x then PrioHeap k a -> PrioHeap k a
go PrioHeap k a
h' else PrioHeap k a
h
{-# INLINE dropWhileWithKey #-}

-- | /O(n * log n)/. @span p heap@ takes and drops the elements from @heap@, while @p@ holds
span :: Ord k => (a -> Bool) -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
span :: (a -> Bool) -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
span a -> Bool
p = (k -> a -> Bool) -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
forall k a.
Ord k =>
(k -> a -> Bool) -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
spanWithKey ((a -> Bool) -> k -> a -> Bool
forall a b. a -> b -> a
const a -> Bool
p)
{-# INLINE span #-}

-- | /O(n * log n)/. @spanWithKey p heap@ takes and drops the elements from @heap@, while @p@ holds
spanWithKey :: Ord k => (k -> a -> Bool) -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
spanWithKey :: (k -> a -> Bool) -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
spanWithKey k -> a -> Bool
p = PrioHeap k a -> ([(k, a)], PrioHeap k a)
go
  where
    go :: PrioHeap k a -> ([(k, a)], PrioHeap k a)
go PrioHeap k a
h = case PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
forall k a. Ord k => PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
minView PrioHeap k a
h of
        Maybe ((k, a), PrioHeap k a)
Nothing -> ([], PrioHeap k a
h)
        Just ((k
key, a
x), PrioHeap k a
h') -> if k -> a -> Bool
p k
key a
x
            then let ([(k, a)]
xs, PrioHeap k a
h'') = PrioHeap k a -> ([(k, a)], PrioHeap k a)
go PrioHeap k a
h' in ((k
key, a
x) (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: [(k, a)]
xs, PrioHeap k a
h'')
            else ([], PrioHeap k a
h)
{-# INLINE spanWithKey #-}

-- | /O(n * log n)/. @span@, but with inverted predicate.
break :: Ord k => (a -> Bool) -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
break :: (a -> Bool) -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
break a -> Bool
p = (a -> Bool) -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
forall k a.
Ord k =>
(a -> Bool) -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
span (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)
{-# INLINE break #-}

-- | /O(n * log n)/. @spanWithKey@, but with inverted predicate.
breakWithKey :: Ord k => (k -> a -> Bool) -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
breakWithKey :: (k -> a -> Bool) -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
breakWithKey k -> a -> Bool
p = (k -> a -> Bool) -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
forall k a.
Ord k =>
(k -> a -> Bool) -> PrioHeap k a -> ([(k, a)], PrioHeap k a)
spanWithKey (\k
key a
x -> Bool -> Bool
not (k -> a -> Bool
p k
key a
x))
{-# INLINE breakWithKey #-}

-- | /O(n * log n)/. Remove duplicate elements from the heap.
nub :: Ord k => PrioHeap k a -> PrioHeap k a
nub :: PrioHeap k a -> PrioHeap k a
nub PrioHeap k a
h = case PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
forall k a. Ord k => PrioHeap k a -> Maybe ((k, a), PrioHeap k a)
minView PrioHeap k a
h of
    Maybe ((k, a), PrioHeap k a)
Nothing -> PrioHeap k a
forall k a. PrioHeap k a
Empty
    Just ((k
key, a
x), PrioHeap k a
h') -> k -> a -> PrioHeap k a -> PrioHeap k a
forall k a. Ord k => k -> a -> PrioHeap k a -> PrioHeap k a
insert k
key a
x (PrioHeap k a -> PrioHeap k a
forall k a. Ord k => PrioHeap k a -> PrioHeap k a
nub ((k -> a -> Bool) -> PrioHeap k a -> PrioHeap k a
forall k a.
Ord k =>
(k -> a -> Bool) -> PrioHeap k a -> PrioHeap k a
dropWhileWithKey (Bool -> a -> Bool
forall a b. a -> b -> a
const (Bool -> a -> Bool) -> (k -> Bool) -> k -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
key)) PrioHeap k a
h'))

-- | /O(n)/. Create a list of key/value pairs from the heap.
toList :: PrioHeap k a -> [(k, a)]
toList :: PrioHeap k a -> [(k, a)]
toList = (k -> a -> [(k, a)] -> [(k, a)])
-> [(k, a)] -> PrioHeap k a -> [(k, a)]
forall k a b. (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKey (\k
key a
x [(k, a)]
acc -> (k
key, a
x) (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: [(k, a)]
acc) []

-- | /O(n * log n)/. Create an ascending list of key/value pairs from the heap.
toAscList :: Ord k => PrioHeap k a -> [(k, a)]
toAscList :: PrioHeap k a -> [(k, a)]
toAscList = (k -> a -> [(k, a)] -> [(k, a)])
-> [(k, a)] -> PrioHeap k a -> [(k, a)]
forall k a b. Ord k => (k -> a -> b -> b) -> b -> PrioHeap k a -> b
foldrWithKeyOrd (\k
key a
x [(k, a)]
acc -> (k
key, a
x) (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: [(k, a)]
acc) []

-- | /O(n * log n)/. Create a descending list of key/value pairs from the heap.
toDescList :: Ord k => PrioHeap k a -> [(k, a)]
toDescList :: PrioHeap k a -> [(k, a)]
toDescList = ([(k, a)] -> k -> a -> [(k, a)])
-> [(k, a)] -> PrioHeap k a -> [(k, a)]
forall k b a. Ord k => (b -> k -> a -> b) -> b -> PrioHeap k a -> b
foldlWithKeyOrd (\[(k, a)]
acc k
key a
x -> (k
key, a
x) (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: [(k, a)]
acc) []

-- | /O(n)/. Create a heap from a 'Data.Heap.Heap' of keys and a function which computes the value for each key.
fromHeap :: (k -> a) -> Heap.Heap k -> PrioHeap k a
fromHeap :: (k -> a) -> Heap k -> PrioHeap k a
fromHeap k -> a
_ Heap k
Heap.Empty = PrioHeap k a
forall k a. PrioHeap k a
Empty
fromHeap k -> a
f (Heap.Heap Int
s k
key Forest k
forest) = Int -> k -> a -> Forest k a -> PrioHeap k a
forall k a. Int -> k -> a -> Forest k a -> PrioHeap k a
Heap Int
s k
key (k -> a
f k
key) ((Tree k -> Tree k a) -> Forest k -> Forest k a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tree k -> Tree k a
fromTree Forest k
forest)
  where
    fromTree :: Tree k -> Tree k a
fromTree (Heap.Node Int
r k
key List k
xs Forest k
c) = Int -> k -> a -> List (Pair k a) -> Forest k a -> Tree k a
forall k a.
Int -> k -> a -> List (Pair k a) -> Forest k a -> Tree k a
Node Int
r k
key (k -> a
f k
key) ((k -> Pair k a) -> List k -> List (Pair k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\k
key -> k -> a -> Pair k a
forall k a. k -> a -> Pair k a
Pair k
key (k -> a
f k
key)) List k
xs) ((Tree k -> Tree k a) -> Forest k -> Forest k a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tree k -> Tree k a
fromTree Forest k
c)

-- | Create a 'Data.Heap.Heap' of all keys of the heap
keysHeap :: PrioHeap k a -> Heap.Heap k
keysHeap :: PrioHeap k a -> Heap k
keysHeap PrioHeap k a
Empty = Heap k
forall a. Heap a
Heap.Empty
keysHeap (Heap Int
s k
key a
_ Forest k a
forest) = Int -> k -> Forest k -> Heap k
forall a. Int -> a -> Forest a -> Heap a
Heap.Heap Int
s k
key ((Tree k a -> Tree k) -> Forest k a -> Forest k
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tree k a -> Tree k
forall b a. Tree b a -> Tree b
fromTree Forest k a
forest)
  where
    fromTree :: Tree b a -> Tree b
fromTree (Node Int
r b
key a
_ List (Pair b a)
xs Forest b a
c) = Int -> b -> List b -> Forest b -> Tree b
forall a. Int -> a -> List a -> Forest a -> Tree a
Heap.Node Int
r b
key ((Pair b a -> b) -> List (Pair b a) -> List b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Pair b
key a
_) -> b
key) List (Pair b a)
xs) ((Tree b a -> Tree b) -> Forest b a -> Forest b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tree b a -> Tree b
fromTree Forest b a
c)