{-# LANGUAGE CPP #-}

module Data.PQueue.Prio.Internals (
  MinPQueue(..),
  BinomForest(..),
  BinomHeap,
  BinomTree(..),
  Zero(..),
  Succ(..),
  CompF,
  empty,
  null,
  size,
  singleton,
  insert,
  insertBehind,
  union,
  getMin,
  adjustMinWithKey,
  updateMinWithKey,
  minViewWithKey,
  mapWithKey,
  mapKeysMonotonic,
  mapMaybeWithKey,
  mapEitherWithKey,
  foldrWithKey,
  foldlWithKey,
  insertMin,
  foldrWithKeyU,
  foldlWithKeyU,
  traverseWithKeyU,
  seqSpine,
  mapForest
  ) where

import Control.Applicative.Identity (Identity(Identity, runIdentity))
import Control.DeepSeq (NFData(rnf), deepseq)

import Data.Monoid ((<>))

import Prelude hiding (null)

#if __GLASGOW_HASKELL__

import Data.Data

instance (Data k, Data a, Ord k) => Data (MinPQueue k a) where
  gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MinPQueue k a -> c (MinPQueue k a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z MinPQueue k a
m = ([(k, a)] -> MinPQueue k a) -> c ([(k, a)] -> MinPQueue k a)
forall g. g -> c g
z (((k, a) -> MinPQueue k a -> MinPQueue k a)
-> MinPQueue k a -> [(k, a)] -> MinPQueue k a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((k -> a -> MinPQueue k a -> MinPQueue k a)
-> (k, a) -> MinPQueue k a -> MinPQueue k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry' k -> a -> MinPQueue k a -> MinPQueue k a
forall k a. k -> a -> MinPQueue k a -> MinPQueue k a
insertMin) MinPQueue k a
forall k a. MinPQueue k a
empty) c ([(k, a)] -> MinPQueue k a) -> [(k, a)] -> c (MinPQueue k a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` (k -> a -> [(k, a)] -> [(k, a)])
-> [(k, a)] -> MinPQueue k a -> [(k, a)]
forall k a b.
Ord k =>
(k -> a -> b -> b) -> b -> MinPQueue k a -> b
foldrWithKey (((k, a) -> [(k, a)] -> [(k, a)]) -> k -> a -> [(k, a)] -> [(k, a)]
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (:)) [] MinPQueue k a
m
  toConstr :: MinPQueue k a -> Constr
toConstr MinPQueue k a
_   = [Char] -> Constr
forall a. HasCallStack => [Char] -> a
error [Char]
"toConstr"
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (MinPQueue k a)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = [Char] -> Constr -> c (MinPQueue k a)
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
  dataTypeOf :: MinPQueue k a -> DataType
dataTypeOf MinPQueue k a
_ = [Char] -> DataType
mkNoRepType [Char]
"Data.PQueue.Prio.Min.MinPQueue"
  dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (MinPQueue k a))
dataCast2 forall d e. (Data d, Data e) => c (t d e)
f  = c (t k a) -> Maybe (c (MinPQueue k a))
forall k1 k2 k3 (c :: k1 -> *) (t :: k2 -> k3 -> k1)
       (t' :: k2 -> k3 -> k1) (a :: k2) (b :: k3).
(Typeable t, Typeable t') =>
c (t a b) -> Maybe (c (t' a b))
gcast2 c (t k a)
forall d e. (Data d, Data e) => c (t d e)
f

#endif

(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(c -> d
f .: :: (c -> d) -> (a -> b -> c) -> a -> b -> d
.: a -> b -> c
g) a
x b
y = c -> d
f (a -> b -> c
g a
x b
y)

first' :: (a -> b) -> (a, c) -> (b, c)
first' :: (a -> b) -> (a, c) -> (b, c)
first' a -> b
f (a
a, c
c) = (a -> b
f a
a, c
c)

second' :: (b -> c) -> (a, b) -> (a, c)
second' :: (b -> c) -> (a, b) -> (a, c)
second' b -> c
f (a
a, b
b) = (a
a, b -> c
f b
b)

uncurry' :: (a -> b -> c) -> (a, b) -> c
uncurry' :: (a -> b -> c) -> (a, b) -> c
uncurry' a -> b -> c
f (a
a, b
b) = a -> b -> c
f a
a b
b

infixr 8 .:

-- | A priority queue where values of type @a@ are annotated with keys of type @k@.
-- The queue supports extracting the element with minimum key.
data MinPQueue k a = Empty | MinPQ {-# UNPACK #-} !Int k a (BinomHeap k a)
#if __GLASGOW_HASKELL__
  deriving (Typeable)
#endif

data BinomForest rk k a =
  Nil |
  Skip (BinomForest (Succ rk) k a) |
  Cons {-# UNPACK #-} !(BinomTree rk k a) (BinomForest (Succ rk) k a)
type BinomHeap = BinomForest Zero

data BinomTree rk k a = BinomTree k a (rk k a)
data Zero k a = Zero
data Succ rk k a = Succ {-# UNPACK #-} !(BinomTree rk k a) (rk k a)

type CompF a = a -> a -> Bool

instance (Ord k, Eq a) => Eq (MinPQueue k a) where
  MinPQ Int
n1 k
k1 a
a1 BinomHeap k a
ts1 == :: MinPQueue k a -> MinPQueue k a -> Bool
== MinPQ Int
n2 k
k2 a
a2 BinomHeap k a
ts2 =
    Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n2 Bool -> Bool -> Bool
&& k -> a -> BinomHeap k a -> k -> a -> BinomHeap k a -> Bool
forall k a (rk :: * -> * -> *).
(Ord k, Eq a) =>
k
-> a -> BinomForest rk k a -> k -> a -> BinomForest rk k a -> Bool
eqExtract k
k1 a
a1 BinomHeap k a
ts1 k
k2 a
a2 BinomHeap k a
ts2
  MinPQueue k a
Empty == MinPQueue k a
Empty = Bool
True
  MinPQueue k a
_     == MinPQueue k a
_     = Bool
False

eqExtract :: (Ord k, Eq a) => k -> a -> BinomForest rk k a -> k -> a -> BinomForest rk k a -> Bool
eqExtract :: k
-> a -> BinomForest rk k a -> k -> a -> BinomForest rk k a -> Bool
eqExtract k
k10 a
a10 BinomForest rk k a
ts10 k
k20 a
a20 BinomForest rk k a
ts20 =
  k
k10 k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k20 Bool -> Bool -> Bool
&& a
a10 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a20 Bool -> Bool -> Bool
&&
  case (BinomForest rk k a -> MExtract rk k a
forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
extract BinomForest rk k a
ts10, BinomForest rk k a -> MExtract rk k a
forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
extract BinomForest rk k a
ts20) of
    (Yes (Extract k
k1 a
a1 rk k a
_ BinomForest rk k a
ts1'), Yes (Extract k
k2 a
a2 rk k a
_ BinomForest rk k a
ts2'))
             -> k
-> a -> BinomForest rk k a -> k -> a -> BinomForest rk k a -> Bool
forall k a (rk :: * -> * -> *).
(Ord k, Eq a) =>
k
-> a -> BinomForest rk k a -> k -> a -> BinomForest rk k a -> Bool
eqExtract k
k1 a
a1 BinomForest rk k a
ts1' k
k2 a
a2 BinomForest rk k a
ts2'
    (MExtract rk k a
No, MExtract rk k a
No) -> Bool
True
    (MExtract rk k a, MExtract rk k a)
_        -> Bool
False

instance (Ord k, Ord a) => Ord (MinPQueue k a) where
  MinPQ Int
_n1 k
k10 a
a10 BinomHeap k a
ts10 compare :: MinPQueue k a -> MinPQueue k a -> Ordering
`compare` MinPQ Int
_n2 k
k20 a
a20 BinomHeap k a
ts20 =
    k -> a -> BinomHeap k a -> k -> a -> BinomHeap k a -> Ordering
forall k a (rk :: * -> * -> *).
(Ord k, Ord a) =>
k
-> a
-> BinomForest rk k a
-> k
-> a
-> BinomForest rk k a
-> Ordering
cmpExtract k
k10 a
a10 BinomHeap k a
ts10 k
k20 a
a20 BinomHeap k a
ts20
  MinPQueue k a
Empty `compare` MinPQueue k a
Empty   = Ordering
EQ
  MinPQueue k a
Empty `compare` MinPQ{} = Ordering
LT
  MinPQ{} `compare` MinPQueue k a
Empty = Ordering
GT

cmpExtract :: (Ord k, Ord a) => k -> a -> BinomForest rk k a -> k -> a -> BinomForest rk k a -> Ordering
cmpExtract :: k
-> a
-> BinomForest rk k a
-> k
-> a
-> BinomForest rk k a
-> Ordering
cmpExtract k
k10 a
a10 BinomForest rk k a
ts10 k
k20 a
a20 BinomForest rk k a
ts20 =
  k
k10 k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` k
k20 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> a
a10 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` a
a20 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<>
  case (BinomForest rk k a -> MExtract rk k a
forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
extract BinomForest rk k a
ts10, BinomForest rk k a -> MExtract rk k a
forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
extract BinomForest rk k a
ts20) of
    (Yes (Extract k
k1 a
a1 rk k a
_ BinomForest rk k a
ts1'), Yes (Extract k
k2 a
a2 rk k a
_ BinomForest rk k a
ts2'))
                -> k
-> a
-> BinomForest rk k a
-> k
-> a
-> BinomForest rk k a
-> Ordering
forall k a (rk :: * -> * -> *).
(Ord k, Ord a) =>
k
-> a
-> BinomForest rk k a
-> k
-> a
-> BinomForest rk k a
-> Ordering
cmpExtract k
k1 a
a1 BinomForest rk k a
ts1' k
k2 a
a2 BinomForest rk k a
ts2'
    (MExtract rk k a
No, Yes{}) -> Ordering
LT
    (Yes{}, MExtract rk k a
No) -> Ordering
GT
    (MExtract rk k a
No, MExtract rk k a
No)    -> Ordering
EQ

-- | /O(1)/. Returns the empty priority queue.
empty :: MinPQueue k a
empty :: MinPQueue k a
empty = MinPQueue k a
forall k a. MinPQueue k a
Empty

-- | /O(1)/. Checks if this priority queue is empty.
null :: MinPQueue k a -> Bool
null :: MinPQueue k a -> Bool
null MinPQueue k a
Empty = Bool
True
null MinPQueue k a
_     = Bool
False

-- | /O(1)/. Returns the size of this priority queue.
size :: MinPQueue k a -> Int
size :: MinPQueue k a -> Int
size MinPQueue k a
Empty           = Int
0
size (MinPQ Int
n k
_ a
_ BinomHeap k a
_) = Int
n

-- | /O(1)/. Constructs a singleton priority queue.
singleton :: k -> a -> MinPQueue k a
singleton :: k -> a -> MinPQueue k a
singleton k
k a
a = Int -> k -> a -> BinomHeap k a -> MinPQueue k a
forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ Int
1 k
k a
a BinomHeap k a
forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil

-- | Amortized /O(1)/, worst-case /O(log n)/. Inserts
-- an element with the specified key into the queue.
insert :: Ord k => k -> a -> MinPQueue k a -> MinPQueue k a
insert :: k -> a -> MinPQueue k a -> MinPQueue k a
insert = CompF k -> k -> a -> MinPQueue k a -> MinPQueue k a
forall k a. CompF k -> k -> a -> MinPQueue k a -> MinPQueue k a
insert' CompF k
forall a. Ord a => a -> a -> Bool
(<=)

-- | /O(n)/ (an earlier implementation had /O(1)/ but was buggy).
-- Insert an element with the specified key into the priority queue,
-- putting it behind elements whose key compares equal to the
-- inserted one.
insertBehind :: Ord k => k -> a -> MinPQueue k a -> MinPQueue k a
insertBehind :: k -> a -> MinPQueue k a -> MinPQueue k a
insertBehind k
k a
v MinPQueue k a
q =
  let ([(k, a)]
smaller, MinPQueue k a
larger) = (k -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)
forall k a.
Ord k =>
(k -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)
spanKey (k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
k) MinPQueue k a
q
  in  ((k, a) -> MinPQueue k a -> MinPQueue k a)
-> MinPQueue k a -> [(k, a)] -> MinPQueue k a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((k -> a -> MinPQueue k a -> MinPQueue k a)
-> (k, a) -> MinPQueue k a -> MinPQueue k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> a -> MinPQueue k a -> MinPQueue k a
forall k a. Ord k => k -> a -> MinPQueue k a -> MinPQueue k a
insert) (k -> a -> MinPQueue k a -> MinPQueue k a
forall k a. Ord k => k -> a -> MinPQueue k a -> MinPQueue k a
insert k
k a
v MinPQueue k a
larger) [(k, a)]
smaller

spanKey :: Ord k => (k -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)
spanKey :: (k -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)
spanKey k -> Bool
p MinPQueue k a
q = case MinPQueue k a -> Maybe ((k, a), MinPQueue k a)
forall k a. Ord k => MinPQueue k a -> Maybe ((k, a), MinPQueue k a)
minViewWithKey MinPQueue k a
q of
  Just (t :: (k, a)
t@(k
k, a
_), MinPQueue k a
q') | k -> Bool
p k
k ->
    let ([(k, a)]
kas, MinPQueue k a
q'') = (k -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)
forall k a.
Ord k =>
(k -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)
spanKey k -> Bool
p MinPQueue k a
q' in ((k, a)
t (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: [(k, a)]
kas, MinPQueue k a
q'')
  Maybe ((k, a), MinPQueue k a)
_ -> ([], MinPQueue k a
q)

-- | Internal helper method, using a specific comparator function.
insert' :: CompF k -> k -> a -> MinPQueue k a -> MinPQueue k a
insert' :: CompF k -> k -> a -> MinPQueue k a -> MinPQueue k a
insert' CompF k
_ k
k a
a MinPQueue k a
Empty = k -> a -> MinPQueue k a
forall k a. k -> a -> MinPQueue k a
singleton k
k a
a
insert' CompF k
le k
k a
a (MinPQ Int
n k
k' a
a' BinomHeap k a
ts)
  | k
k CompF k
`le` k
k' = Int -> k -> a -> BinomHeap k a -> MinPQueue k a
forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) k
k  a
a  (CompF k -> BinomTree Zero k a -> BinomHeap k a -> BinomHeap k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr CompF k
le (k -> a -> BinomTree Zero k a
forall k a. k -> a -> BinomTree Zero k a
tip k
k' a
a') BinomHeap k a
ts)
  | Bool
otherwise = Int -> k -> a -> BinomHeap k a -> MinPQueue k a
forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) k
k' a
a' (CompF k -> BinomTree Zero k a -> BinomHeap k a -> BinomHeap k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr CompF k
le (k -> a -> BinomTree Zero k a
forall k a. k -> a -> BinomTree Zero k a
tip k
k  a
a ) BinomHeap k a
ts)

-- | Amortized /O(log(min(n1, n2)))/, worst-case /O(log(max(n1, n2)))/. Returns the union
-- of the two specified queues.
union :: Ord k => MinPQueue k a -> MinPQueue k a -> MinPQueue k a
union :: MinPQueue k a -> MinPQueue k a -> MinPQueue k a
union = CompF k -> MinPQueue k a -> MinPQueue k a -> MinPQueue k a
forall k a.
CompF k -> MinPQueue k a -> MinPQueue k a -> MinPQueue k a
union' CompF k
forall a. Ord a => a -> a -> Bool
(<=)

-- | Takes the union of the two specified queues, using the given comparison function.
union' :: CompF k -> MinPQueue k a -> MinPQueue k a -> MinPQueue k a
union' :: CompF k -> MinPQueue k a -> MinPQueue k a -> MinPQueue k a
union' CompF k
le (MinPQ Int
n1 k
k1 a
a1 BinomHeap k a
ts1) (MinPQ Int
n2 k
k2 a
a2 BinomHeap k a
ts2)
  | k
k1 CompF k
`le` k
k2 = Int -> k -> a -> BinomHeap k a -> MinPQueue k a
forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2) k
k1 a
a1 (k -> a -> BinomHeap k a
insMerge k
k2 a
a2)
  | Bool
otherwise  = Int -> k -> a -> BinomHeap k a -> MinPQueue k a
forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2) k
k2 a
a2 (k -> a -> BinomHeap k a
insMerge k
k1 a
a1)
  where  insMerge :: k -> a -> BinomHeap k a
insMerge k
k a
a = CompF k
-> BinomTree Zero k a
-> BinomHeap k a
-> BinomHeap k a
-> BinomHeap k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomTree rk k a
-> BinomForest rk k a
-> BinomForest rk k a
-> BinomForest rk k a
carryForest CompF k
le (k -> a -> BinomTree Zero k a
forall k a. k -> a -> BinomTree Zero k a
tip k
k a
a) BinomHeap k a
ts1 BinomHeap k a
ts2
union' CompF k
_ MinPQueue k a
Empty MinPQueue k a
q2 = MinPQueue k a
q2
union' CompF k
_ MinPQueue k a
q1 MinPQueue k a
Empty = MinPQueue k a
q1

-- | /O(1)/. The minimal (key, element) in the queue, if the queue is nonempty.
getMin :: MinPQueue k a -> Maybe (k, a)
getMin :: MinPQueue k a -> Maybe (k, a)
getMin (MinPQ Int
_ k
k a
a BinomHeap k a
_) = (k, a) -> Maybe (k, a)
forall a. a -> Maybe a
Just (k
k, a
a)
getMin MinPQueue k a
_               = Maybe (k, a)
forall a. Maybe a
Nothing

-- | /O(1)/. Alter the value at the minimum key. If the queue is empty, does nothing.
adjustMinWithKey :: (k -> a -> a) -> MinPQueue k a -> MinPQueue k a
adjustMinWithKey :: (k -> a -> a) -> MinPQueue k a -> MinPQueue k a
adjustMinWithKey k -> a -> a
_ MinPQueue k a
Empty = MinPQueue k a
forall k a. MinPQueue k a
Empty
adjustMinWithKey k -> a -> a
f (MinPQ Int
n k
k a
a BinomHeap k a
ts) = Int -> k -> a -> BinomHeap k a -> MinPQueue k a
forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ Int
n k
k (k -> a -> a
f k
k a
a) BinomHeap k a
ts

-- | /O(log n)/. (Actually /O(1)/ if there's no deletion.) Update the value at the minimum key.
-- If the queue is empty, does nothing.
updateMinWithKey :: Ord k => (k -> a -> Maybe a) -> MinPQueue k a -> MinPQueue k a
updateMinWithKey :: (k -> a -> Maybe a) -> MinPQueue k a -> MinPQueue k a
updateMinWithKey k -> a -> Maybe a
_ MinPQueue k a
Empty = MinPQueue k a
forall k a. MinPQueue k a
Empty
updateMinWithKey k -> a -> Maybe a
f (MinPQ Int
n k
k a
a BinomHeap k a
ts) = case k -> a -> Maybe a
f k
k a
a of
  Maybe a
Nothing  -> CompF k -> Int -> BinomHeap k a -> MinPQueue k a
forall k a. CompF k -> Int -> BinomHeap k a -> MinPQueue k a
extractHeap CompF k
forall a. Ord a => a -> a -> Bool
(<=) Int
n BinomHeap k a
ts
  Just a
a'  -> Int -> k -> a -> BinomHeap k a -> MinPQueue k a
forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ Int
n k
k a
a' BinomHeap k a
ts

-- | /O(log n)/. Retrieves the minimal (key, value) pair of the map, and the map stripped of that
-- element, or 'Nothing' if passed an empty map.
minViewWithKey :: Ord k => MinPQueue k a -> Maybe ((k, a), MinPQueue k a)
minViewWithKey :: MinPQueue k a -> Maybe ((k, a), MinPQueue k a)
minViewWithKey MinPQueue k a
Empty            = Maybe ((k, a), MinPQueue k a)
forall a. Maybe a
Nothing
minViewWithKey (MinPQ Int
n k
k a
a BinomHeap k a
ts) = ((k, a), MinPQueue k a) -> Maybe ((k, a), MinPQueue k a)
forall a. a -> Maybe a
Just ((k
k, a
a), CompF k -> Int -> BinomHeap k a -> MinPQueue k a
forall k a. CompF k -> Int -> BinomHeap k a -> MinPQueue k a
extractHeap CompF k
forall a. Ord a => a -> a -> Bool
(<=) Int
n BinomHeap k a
ts)

-- | /O(n)/. Map a function over all values in the queue.
mapWithKey :: (k -> a -> b) -> MinPQueue k a -> MinPQueue k b
mapWithKey :: (k -> a -> b) -> MinPQueue k a -> MinPQueue k b
mapWithKey k -> a -> b
f = Identity (MinPQueue k b) -> MinPQueue k b
forall a. Identity a -> a
runIdentity (Identity (MinPQueue k b) -> MinPQueue k b)
-> (MinPQueue k a -> Identity (MinPQueue k b))
-> MinPQueue k a
-> MinPQueue k b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> a -> Identity b) -> MinPQueue k a -> Identity (MinPQueue k b)
forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverseWithKeyU (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (k -> a -> b) -> k -> a -> Identity b
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: k -> a -> b
f)

-- | /O(n)/. @'mapKeysMonotonic' f q == 'mapKeys' f q@, but only works when @f@ is strictly
-- monotonic. /The precondition is not checked./ This function has better performance than
-- 'mapKeys'.
mapKeysMonotonic :: (k -> k') -> MinPQueue k a -> MinPQueue k' a
mapKeysMonotonic :: (k -> k') -> MinPQueue k a -> MinPQueue k' a
mapKeysMonotonic k -> k'
_ MinPQueue k a
Empty = MinPQueue k' a
forall k a. MinPQueue k a
Empty
mapKeysMonotonic k -> k'
f (MinPQ Int
n k
k a
a BinomHeap k a
ts) = Int -> k' -> a -> BinomHeap k' a -> MinPQueue k' a
forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ Int
n (k -> k'
f k
k) a
a ((k -> k')
-> (Zero k a -> Zero k' a) -> BinomHeap k a -> BinomHeap k' a
forall k k' (rk :: * -> * -> *) a.
(k -> k')
-> (rk k a -> rk k' a) -> BinomForest rk k a -> BinomForest rk k' a
mapKeysMonoF k -> k'
f (Zero k' a -> Zero k a -> Zero k' a
forall a b. a -> b -> a
const Zero k' a
forall k a. Zero k a
Zero) BinomHeap k a
ts)

-- | /O(n)/. Map values and collect the 'Just' results.
mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> MinPQueue k a -> MinPQueue k b
mapMaybeWithKey :: (k -> a -> Maybe b) -> MinPQueue k a -> MinPQueue k b
mapMaybeWithKey k -> a -> Maybe b
_ MinPQueue k a
Empty            = MinPQueue k b
forall k a. MinPQueue k a
Empty
mapMaybeWithKey k -> a -> Maybe b
f (MinPQ Int
_ k
k a
a BinomHeap k a
ts) = (MinPQueue k b -> MinPQueue k b)
-> (b -> MinPQueue k b -> MinPQueue k b)
-> Maybe b
-> MinPQueue k b
-> MinPQueue k b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MinPQueue k b -> MinPQueue k b
forall a. a -> a
id (k -> b -> MinPQueue k b -> MinPQueue k b
forall k a. Ord k => k -> a -> MinPQueue k a -> MinPQueue k a
insert k
k) (k -> a -> Maybe b
f k
k a
a) (CompF k
-> (k -> a -> Maybe b)
-> (Zero k a -> MinPQueue k b)
-> BinomHeap k a
-> MinPQueue k b
forall k a b (rk :: * -> * -> *).
CompF k
-> (k -> a -> Maybe b)
-> (rk k a -> MinPQueue k b)
-> BinomForest rk k a
-> MinPQueue k b
mapMaybeF CompF k
forall a. Ord a => a -> a -> Bool
(<=) k -> a -> Maybe b
f (MinPQueue k b -> Zero k a -> MinPQueue k b
forall a b. a -> b -> a
const MinPQueue k b
forall k a. MinPQueue k a
Empty) BinomHeap k a
ts)

-- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> MinPQueue k a -> (MinPQueue k b, MinPQueue k c)
mapEitherWithKey :: (k -> a -> Either b c)
-> MinPQueue k a -> (MinPQueue k b, MinPQueue k c)
mapEitherWithKey k -> a -> Either b c
_ MinPQueue k a
Empty            = (MinPQueue k b
forall k a. MinPQueue k a
Empty, MinPQueue k c
forall k a. MinPQueue k a
Empty)
mapEitherWithKey k -> a -> Either b c
f (MinPQ Int
_ k
k a
a BinomHeap k a
ts) = (b
 -> (MinPQueue k b, MinPQueue k c)
 -> (MinPQueue k b, MinPQueue k c))
-> (c
    -> (MinPQueue k b, MinPQueue k c)
    -> (MinPQueue k b, MinPQueue k c))
-> Either b c
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((MinPQueue k b -> MinPQueue k b)
-> (MinPQueue k b, MinPQueue k c) -> (MinPQueue k b, MinPQueue k c)
forall a b c. (a -> b) -> (a, c) -> (b, c)
first' ((MinPQueue k b -> MinPQueue k b)
 -> (MinPQueue k b, MinPQueue k c)
 -> (MinPQueue k b, MinPQueue k c))
-> (b -> MinPQueue k b -> MinPQueue k b)
-> b
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> b -> MinPQueue k b -> MinPQueue k b
forall k a. Ord k => k -> a -> MinPQueue k a -> MinPQueue k a
insert k
k) ((MinPQueue k c -> MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c) -> (MinPQueue k b, MinPQueue k c)
forall b c a. (b -> c) -> (a, b) -> (a, c)
second' ((MinPQueue k c -> MinPQueue k c)
 -> (MinPQueue k b, MinPQueue k c)
 -> (MinPQueue k b, MinPQueue k c))
-> (c -> MinPQueue k c -> MinPQueue k c)
-> c
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> c -> MinPQueue k c -> MinPQueue k c
forall k a. Ord k => k -> a -> MinPQueue k a -> MinPQueue k a
insert k
k) (k -> a -> Either b c
f k
k a
a)
  (CompF k
-> (k -> a -> Either b c)
-> (Zero k a -> (MinPQueue k b, MinPQueue k c))
-> BinomHeap k a
-> (MinPQueue k b, MinPQueue k c)
forall k a b c (rk :: * -> * -> *).
CompF k
-> (k -> a -> Either b c)
-> (rk k a -> (MinPQueue k b, MinPQueue k c))
-> BinomForest rk k a
-> (MinPQueue k b, MinPQueue k c)
mapEitherF CompF k
forall a. Ord a => a -> a -> Bool
(<=) k -> a -> Either b c
f ((MinPQueue k b, MinPQueue k c)
-> Zero k a -> (MinPQueue k b, MinPQueue k c)
forall a b. a -> b -> a
const (MinPQueue k b
forall k a. MinPQueue k a
Empty, MinPQueue k c
forall k a. MinPQueue k a
Empty)) BinomHeap k a
ts)

-- | /O(n log n)/. Fold the keys and values in the map, such that
-- @'foldrWithKey' f z q == 'List.foldr' ('uncurry' f) z ('toAscList' q)@.
--
-- If you do not care about the traversal order, consider using 'foldrWithKeyU'.
foldrWithKey :: Ord k => (k -> a -> b -> b) -> b -> MinPQueue k a -> b
foldrWithKey :: (k -> a -> b -> b) -> b -> MinPQueue k a -> b
foldrWithKey k -> a -> b -> b
_ b
z MinPQueue k a
Empty = b
z
foldrWithKey k -> a -> b -> b
f b
z (MinPQ Int
_ k
k0 a
a0 BinomHeap k a
ts0) = k -> a -> b -> b
f k
k0 a
a0 (BinomHeap k a -> b
forall (rk :: * -> * -> *). BinomForest rk k a -> b
foldF BinomHeap k a
ts0) where
  foldF :: BinomForest rk k a -> b
foldF BinomForest rk k a
ts = case BinomForest rk k a -> MExtract rk k a
forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
extract BinomForest rk k a
ts of
    Yes (Extract k
k a
a rk k a
_ BinomForest rk k a
ts') -> k -> a -> b -> b
f k
k a
a (BinomForest rk k a -> b
foldF BinomForest rk k a
ts')
    MExtract rk k a
_                       -> b
z

-- | /O(n log n)/. Fold the keys and values in the map, such that
-- @'foldlWithKey' f z q == 'List.foldl' ('uncurry' . f) z ('toAscList' q)@.
--
-- If you do not care about the traversal order, consider using 'foldlWithKeyU'.
foldlWithKey :: Ord k => (b -> k -> a -> b) -> b -> MinPQueue k a -> b
foldlWithKey :: (b -> k -> a -> b) -> b -> MinPQueue k a -> b
foldlWithKey b -> k -> a -> b
_ b
z MinPQueue k a
Empty = b
z
foldlWithKey b -> k -> a -> b
f b
z0 (MinPQ Int
_ k
k0 a
a0 BinomHeap k a
ts0) = b -> BinomHeap k a -> b
forall (rk :: * -> * -> *). b -> BinomForest rk k a -> b
foldF (b -> k -> a -> b
f b
z0 k
k0 a
a0) BinomHeap k a
ts0 where
  foldF :: b -> BinomForest rk k a -> b
foldF b
z BinomForest rk k a
ts = case BinomForest rk k a -> MExtract rk k a
forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
extract BinomForest rk k a
ts of
    Yes (Extract k
k a
a rk k a
_ BinomForest rk k a
ts') -> b -> BinomForest rk k a -> b
foldF (b -> k -> a -> b
f b
z k
k a
a) BinomForest rk k a
ts'
    MExtract rk k a
_                       -> b
z

-- | Equivalent to 'insert', save the assumption that this key is @<=@
-- every other key in the map. /The precondition is not checked./
insertMin :: k -> a -> MinPQueue k a -> MinPQueue k a
insertMin :: k -> a -> MinPQueue k a -> MinPQueue k a
insertMin k
k a
a MinPQueue k a
Empty = Int -> k -> a -> BinomHeap k a -> MinPQueue k a
forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ Int
1 k
k a
a BinomHeap k a
forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil
insertMin k
k a
a (MinPQ Int
n k
k' a
a' BinomHeap k a
ts) = Int -> k -> a -> BinomHeap k a -> MinPQueue k a
forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) k
k a
a (BinomTree Zero k a -> BinomHeap k a -> BinomHeap k a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incrMin (k -> a -> BinomTree Zero k a
forall k a. k -> a -> BinomTree Zero k a
tip k
k' a
a') BinomHeap k a
ts)

-- | /O(1)/. Returns a binomial tree of rank zero containing this
-- key and value.
tip :: k -> a -> BinomTree Zero k a
tip :: k -> a -> BinomTree Zero k a
tip k
k a
a = k -> a -> Zero k a -> BinomTree Zero k a
forall (rk :: * -> * -> *) k a.
k -> a -> rk k a -> BinomTree rk k a
BinomTree k
k a
a Zero k a
forall k a. Zero k a
Zero

-- | /O(1)/. Takes the union of two binomial trees of the same rank.
meld :: CompF k -> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
meld :: CompF k
-> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
meld CompF k
le t1 :: BinomTree rk k a
t1@(BinomTree k
k1 a
v1 rk k a
ts1) t2 :: BinomTree rk k a
t2@(BinomTree k
k2 a
v2 rk k a
ts2)
  | k
k1 CompF k
`le` k
k2 = k -> a -> Succ rk k a -> BinomTree (Succ rk) k a
forall (rk :: * -> * -> *) k a.
k -> a -> rk k a -> BinomTree rk k a
BinomTree k
k1 a
v1 (BinomTree rk k a -> rk k a -> Succ rk k a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> rk k a -> Succ rk k a
Succ BinomTree rk k a
t2 rk k a
ts1)
  | Bool
otherwise  = k -> a -> Succ rk k a -> BinomTree (Succ rk) k a
forall (rk :: * -> * -> *) k a.
k -> a -> rk k a -> BinomTree rk k a
BinomTree k
k2 a
v2 (BinomTree rk k a -> rk k a -> Succ rk k a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> rk k a -> Succ rk k a
Succ BinomTree rk k a
t1 rk k a
ts2)

-- | Takes the union of two binomial forests, starting at the same rank. Analogous to binary addition.
mergeForest :: CompF k -> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
mergeForest :: CompF k
-> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
mergeForest CompF k
le BinomForest rk k a
f1 BinomForest rk k a
f2 = case (BinomForest rk k a
f1, BinomForest rk k a
f2) of
  (Skip BinomForest (Succ rk) k a
ts1, Skip BinomForest (Succ rk) k a
ts2)       -> BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip (CompF k
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
mergeForest CompF k
le BinomForest (Succ rk) k a
ts1 BinomForest (Succ rk) k a
ts2)
  (Skip BinomForest (Succ rk) k a
ts1, Cons BinomTree rk k a
t2 BinomForest (Succ rk) k a
ts2)    -> BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t2 (CompF k
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
mergeForest CompF k
le BinomForest (Succ rk) k a
ts1 BinomForest (Succ rk) k a
ts2)
  (Cons BinomTree rk k a
t1 BinomForest (Succ rk) k a
ts1, Skip BinomForest (Succ rk) k a
ts2)    -> BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t1 (CompF k
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
mergeForest CompF k
le BinomForest (Succ rk) k a
ts1 BinomForest (Succ rk) k a
ts2)
  (Cons BinomTree rk k a
t1 BinomForest (Succ rk) k a
ts1, Cons BinomTree rk k a
t2 BinomForest (Succ rk) k a
ts2) -> BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip (CompF k
-> BinomTree (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomTree rk k a
-> BinomForest rk k a
-> BinomForest rk k a
-> BinomForest rk k a
carryForest CompF k
le (CompF k
-> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
meld CompF k
le BinomTree rk k a
t1 BinomTree rk k a
t2) BinomForest (Succ rk) k a
ts1 BinomForest (Succ rk) k a
ts2)
  (BinomForest rk k a
Nil, BinomForest rk k a
_)                   -> BinomForest rk k a
f2
  (BinomForest rk k a
_, BinomForest rk k a
Nil)                   -> BinomForest rk k a
f1

-- | Takes the union of two binomial forests, starting at the same rank, with an additional tree.
-- Analogous to binary addition when a digit has been carried.
carryForest :: CompF k -> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
carryForest :: CompF k
-> BinomTree rk k a
-> BinomForest rk k a
-> BinomForest rk k a
-> BinomForest rk k a
carryForest CompF k
le BinomTree rk k a
t0 BinomForest rk k a
f1 BinomForest rk k a
f2 = BinomTree rk k a
t0 BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
`seq` case (BinomForest rk k a
f1, BinomForest rk k a
f2) of
  (Cons BinomTree rk k a
t1 BinomForest (Succ rk) k a
ts1, Cons BinomTree rk k a
t2 BinomForest (Succ rk) k a
ts2) -> BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t0 (BinomTree rk k a
-> BinomTree rk k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
forall (rk :: * -> * -> *) a.
BinomTree rk k a
-> BinomTree rk k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
carryMeld BinomTree rk k a
t1 BinomTree rk k a
t2 BinomForest (Succ rk) k a
ts1 BinomForest (Succ rk) k a
ts2)
  (Cons BinomTree rk k a
t1 BinomForest (Succ rk) k a
ts1, Skip BinomForest (Succ rk) k a
ts2)    -> BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip (BinomTree rk k a
-> BinomTree rk k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
forall (rk :: * -> * -> *) a.
BinomTree rk k a
-> BinomTree rk k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
carryMeld BinomTree rk k a
t0 BinomTree rk k a
t1 BinomForest (Succ rk) k a
ts1 BinomForest (Succ rk) k a
ts2)
  (Skip BinomForest (Succ rk) k a
ts1, Cons BinomTree rk k a
t2 BinomForest (Succ rk) k a
ts2)    -> BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip (BinomTree rk k a
-> BinomTree rk k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
forall (rk :: * -> * -> *) a.
BinomTree rk k a
-> BinomTree rk k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
carryMeld BinomTree rk k a
t0 BinomTree rk k a
t2 BinomForest (Succ rk) k a
ts1 BinomForest (Succ rk) k a
ts2)
  (Skip BinomForest (Succ rk) k a
ts1, Skip BinomForest (Succ rk) k a
ts2)       -> BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t0 (CompF k
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
mergeForest CompF k
le BinomForest (Succ rk) k a
ts1 BinomForest (Succ rk) k a
ts2)
  (BinomForest rk k a
Nil, BinomForest rk k a
_)                   -> CompF k
-> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr CompF k
le BinomTree rk k a
t0 BinomForest rk k a
f2
  (BinomForest rk k a
_, BinomForest rk k a
Nil)                   -> CompF k
-> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr CompF k
le BinomTree rk k a
t0 BinomForest rk k a
f1
  where  carryMeld :: BinomTree rk k a
-> BinomTree rk k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
carryMeld = CompF k
-> BinomTree (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomTree rk k a
-> BinomForest rk k a
-> BinomForest rk k a
-> BinomForest rk k a
carryForest CompF k
le (BinomTree (Succ rk) k a
 -> BinomForest (Succ rk) k a
 -> BinomForest (Succ rk) k a
 -> BinomForest (Succ rk) k a)
-> (BinomTree rk k a
    -> BinomTree rk k a -> BinomTree (Succ rk) k a)
-> BinomTree rk k a
-> BinomTree rk k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: CompF k
-> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
meld CompF k
le

-- | Inserts a binomial tree into a binomial forest. Analogous to binary incrementation.
incr :: CompF k -> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr :: CompF k
-> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr CompF k
le BinomTree rk k a
t BinomForest rk k a
ts = BinomTree rk k a
t BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
`seq` case BinomForest rk k a
ts of
  BinomForest rk k a
Nil         -> BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t BinomForest (Succ rk) k a
forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil
  Skip BinomForest (Succ rk) k a
ts'    -> BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t BinomForest (Succ rk) k a
ts'
  Cons BinomTree rk k a
t' BinomForest (Succ rk) k a
ts' -> BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip (CompF k
-> BinomTree (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr CompF k
le (CompF k
-> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
meld CompF k
le BinomTree rk k a
t BinomTree rk k a
t') BinomForest (Succ rk) k a
ts')

-- | Inserts a binomial tree into a binomial forest. Assumes that the root of this tree
-- is less than all other roots. Analogous to binary incrementation. Equivalent to
-- @'incr' (\_ _ -> True)@.
incrMin :: BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incrMin :: BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incrMin t :: BinomTree rk k a
t@(BinomTree k
k a
a rk k a
ts) BinomForest rk k a
tss = case BinomForest rk k a
tss of
  BinomForest rk k a
Nil          -> BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t BinomForest (Succ rk) k a
forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil
  Skip BinomForest (Succ rk) k a
tss'    -> BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t BinomForest (Succ rk) k a
tss'
  Cons BinomTree rk k a
t' BinomForest (Succ rk) k a
tss' -> BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip (BinomTree (Succ rk) k a
-> BinomForest (Succ rk) k a -> BinomForest (Succ rk) k a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incrMin (k -> a -> Succ rk k a -> BinomTree (Succ rk) k a
forall (rk :: * -> * -> *) k a.
k -> a -> rk k a -> BinomTree rk k a
BinomTree k
k a
a (BinomTree rk k a -> rk k a -> Succ rk k a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> rk k a -> Succ rk k a
Succ BinomTree rk k a
t' rk k a
ts)) BinomForest (Succ rk) k a
tss')

extractHeap :: CompF k -> Int -> BinomHeap k a -> MinPQueue k a
extractHeap :: CompF k -> Int -> BinomHeap k a -> MinPQueue k a
extractHeap CompF k
le Int
n BinomHeap k a
ts = Int
n Int -> MinPQueue k a -> MinPQueue k a
`seq` case CompF k -> BinomHeap k a -> MExtract Zero k a
forall k (rk :: * -> * -> *) a.
CompF k -> BinomForest rk k a -> MExtract rk k a
extractForest CompF k
le BinomHeap k a
ts of
  MExtract Zero k a
No                      -> MinPQueue k a
forall k a. MinPQueue k a
Empty
  Yes (Extract k
k a
a Zero k a
_ BinomHeap k a
ts') -> Int -> k -> a -> BinomHeap k a -> MinPQueue k a
forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) k
k a
a BinomHeap k a
ts'

-- | A specialized type intended to organize the return of extract-min queries
-- from a binomial forest. We walk all the way through the forest, and then
-- walk backwards. @Extract rk a@ is the result type of an extract-min
-- operation that has walked as far backwards of rank @rk@ -- that is, it
-- has visited every root of rank @>= rk@.
--
-- The interpretation of @Extract minKey minVal children forest@ is
--
--   * @minKey@ is the key of the minimum root visited so far. It may have
--     any rank @>= rk@. We will denote the root corresponding to
--     @minKey@ as @minRoot@.
--
--   * @minVal@ is the value corresponding to @minKey@.
--
--   * @children@ is those children of @minRoot@ which have not yet been
--     merged with the rest of the forest. Specifically, these are
--     the children with rank @< rk@.
--
--   * @forest@ is an accumulating parameter that maintains the partial
--     reconstruction of the binomial forest without @minRoot@. It is
--     the union of all old roots with rank @>= rk@ (except @minRoot@),
--     with the set of all children of @minRoot@ with rank @>= rk@.
--     Note that @forest@ is lazy, so if we discover a smaller key
--     than @minKey@ later, we haven't wasted significant work.

data Extract rk k a = Extract k a (rk k a) (BinomForest rk k a)
data MExtract rk k a = No | Yes {-# UNPACK #-} !(Extract rk k a)

incrExtract :: CompF k -> Maybe (BinomTree rk k a) -> Extract (Succ rk) k a -> Extract rk k a
incrExtract :: CompF k
-> Maybe (BinomTree rk k a)
-> Extract (Succ rk) k a
-> Extract rk k a
incrExtract CompF k
_ Maybe (BinomTree rk k a)
Nothing (Extract k
k a
a (Succ BinomTree rk k a
t rk k a
ts) BinomForest (Succ rk) k a
tss)
  = k -> a -> rk k a -> BinomForest rk k a -> Extract rk k a
forall (rk :: * -> * -> *) k a.
k -> a -> rk k a -> BinomForest rk k a -> Extract rk k a
Extract k
k a
a rk k a
ts (BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t BinomForest (Succ rk) k a
tss)
incrExtract CompF k
le (Just BinomTree rk k a
t) (Extract k
k a
a (Succ BinomTree rk k a
t' rk k a
ts) BinomForest (Succ rk) k a
tss)
  = k -> a -> rk k a -> BinomForest rk k a -> Extract rk k a
forall (rk :: * -> * -> *) k a.
k -> a -> rk k a -> BinomForest rk k a -> Extract rk k a
Extract k
k a
a rk k a
ts (BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip (CompF k
-> BinomTree (Succ rk) k a
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr CompF k
le (CompF k
-> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
forall k (rk :: * -> * -> *) a.
CompF k
-> BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
meld CompF k
le BinomTree rk k a
t BinomTree rk k a
t') BinomForest (Succ rk) k a
tss))

-- | Walks backward from the biggest key in the forest, as far as rank @rk@.
-- Returns its progress. Each successive application of @extractBin@ takes
-- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time.
extractForest :: CompF k -> BinomForest rk k a -> MExtract rk k a
extractForest :: CompF k -> BinomForest rk k a -> MExtract rk k a
extractForest CompF k
_ BinomForest rk k a
Nil = MExtract rk k a
forall (rk :: * -> * -> *) k a. MExtract rk k a
No
extractForest CompF k
le (Skip BinomForest (Succ rk) k a
tss) = case CompF k -> BinomForest (Succ rk) k a -> MExtract (Succ rk) k a
forall k (rk :: * -> * -> *) a.
CompF k -> BinomForest rk k a -> MExtract rk k a
extractForest CompF k
le BinomForest (Succ rk) k a
tss of
  MExtract (Succ rk) k a
No     -> MExtract rk k a
forall (rk :: * -> * -> *) k a. MExtract rk k a
No
  Yes Extract (Succ rk) k a
ex -> Extract rk k a -> MExtract rk k a
forall (rk :: * -> * -> *) k a. Extract rk k a -> MExtract rk k a
Yes (CompF k
-> Maybe (BinomTree rk k a)
-> Extract (Succ rk) k a
-> Extract rk k a
forall k (rk :: * -> * -> *) a.
CompF k
-> Maybe (BinomTree rk k a)
-> Extract (Succ rk) k a
-> Extract rk k a
incrExtract CompF k
le Maybe (BinomTree rk k a)
forall a. Maybe a
Nothing Extract (Succ rk) k a
ex)
extractForest CompF k
le (Cons t :: BinomTree rk k a
t@(BinomTree k
k a
a0 rk k a
ts) BinomForest (Succ rk) k a
tss) = Extract rk k a -> MExtract rk k a
forall (rk :: * -> * -> *) k a. Extract rk k a -> MExtract rk k a
Yes (Extract rk k a -> MExtract rk k a)
-> Extract rk k a -> MExtract rk k a
forall a b. (a -> b) -> a -> b
$ case CompF k -> BinomForest (Succ rk) k a -> MExtract (Succ rk) k a
forall k (rk :: * -> * -> *) a.
CompF k -> BinomForest rk k a -> MExtract rk k a
extractForest CompF k
le BinomForest (Succ rk) k a
tss of
  Yes ex :: Extract (Succ rk) k a
ex@(Extract k
k' a
_ Succ rk k a
_ BinomForest (Succ rk) k a
_)
    | k
k' CompF k
<? k
k  -> CompF k
-> Maybe (BinomTree rk k a)
-> Extract (Succ rk) k a
-> Extract rk k a
forall k (rk :: * -> * -> *) a.
CompF k
-> Maybe (BinomTree rk k a)
-> Extract (Succ rk) k a
-> Extract rk k a
incrExtract CompF k
le (BinomTree rk k a -> Maybe (BinomTree rk k a)
forall a. a -> Maybe a
Just BinomTree rk k a
t) Extract (Succ rk) k a
ex
  MExtract (Succ rk) k a
_            -> k -> a -> rk k a -> BinomForest rk k a -> Extract rk k a
forall (rk :: * -> * -> *) k a.
k -> a -> rk k a -> BinomForest rk k a -> Extract rk k a
Extract k
k a
a0 rk k a
ts (BinomForest (Succ rk) k a -> BinomForest rk k a
forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip BinomForest (Succ rk) k a
tss)
  where
    k
a <? :: CompF k
<? k
b = Bool -> Bool
not (k
b CompF k
`le` k
a)

extract :: (Ord k) => BinomForest rk k a -> MExtract rk k a
extract :: BinomForest rk k a -> MExtract rk k a
extract = CompF k -> BinomForest rk k a -> MExtract rk k a
forall k (rk :: * -> * -> *) a.
CompF k -> BinomForest rk k a -> MExtract rk k a
extractForest CompF k
forall a. Ord a => a -> a -> Bool
(<=)

-- | Utility function for mapping over a forest.
mapForest :: (k -> a -> b) -> (rk k a -> rk k b) -> BinomForest rk k a -> BinomForest rk k b
mapForest :: (k -> a -> b)
-> (rk k a -> rk k b) -> BinomForest rk k a -> BinomForest rk k b
mapForest k -> a -> b
f rk k a -> rk k b
fCh BinomForest rk k a
ts0 = case BinomForest rk k a
ts0 of
  BinomForest rk k a
Nil      -> BinomForest rk k b
forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil
  Skip BinomForest (Succ rk) k a
ts' -> BinomForest (Succ rk) k b -> BinomForest rk k b
forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip ((k -> a -> b)
-> (Succ rk k a -> Succ rk k b)
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k b
forall k a b (rk :: * -> * -> *).
(k -> a -> b)
-> (rk k a -> rk k b) -> BinomForest rk k a -> BinomForest rk k b
mapForest k -> a -> b
f Succ rk k a -> Succ rk k b
fCh' BinomForest (Succ rk) k a
ts')
  Cons (BinomTree k
k a
a rk k a
ts) BinomForest (Succ rk) k a
tss
           -> BinomTree rk k b -> BinomForest (Succ rk) k b -> BinomForest rk k b
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons (k -> b -> rk k b -> BinomTree rk k b
forall (rk :: * -> * -> *) k a.
k -> a -> rk k a -> BinomTree rk k a
BinomTree k
k (k -> a -> b
f k
k a
a) (rk k a -> rk k b
fCh rk k a
ts)) ((k -> a -> b)
-> (Succ rk k a -> Succ rk k b)
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k b
forall k a b (rk :: * -> * -> *).
(k -> a -> b)
-> (rk k a -> rk k b) -> BinomForest rk k a -> BinomForest rk k b
mapForest k -> a -> b
f Succ rk k a -> Succ rk k b
fCh' BinomForest (Succ rk) k a
tss)
  where fCh' :: Succ rk k a -> Succ rk k b
fCh' (Succ (BinomTree k
k a
a rk k a
ts) rk k a
tss)
           = BinomTree rk k b -> rk k b -> Succ rk k b
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> rk k a -> Succ rk k a
Succ (k -> b -> rk k b -> BinomTree rk k b
forall (rk :: * -> * -> *) k a.
k -> a -> rk k a -> BinomTree rk k a
BinomTree k
k (k -> a -> b
f k
k a
a) (rk k a -> rk k b
fCh rk k a
ts)) (rk k a -> rk k b
fCh rk k a
tss)

-- | Utility function for mapping a 'Maybe' function over a forest.
mapMaybeF :: CompF k -> (k -> a -> Maybe b) -> (rk k a -> MinPQueue k b) ->
  BinomForest rk k a -> MinPQueue k b
mapMaybeF :: CompF k
-> (k -> a -> Maybe b)
-> (rk k a -> MinPQueue k b)
-> BinomForest rk k a
-> MinPQueue k b
mapMaybeF CompF k
le k -> a -> Maybe b
f rk k a -> MinPQueue k b
fCh BinomForest rk k a
ts0 = case BinomForest rk k a
ts0 of
  BinomForest rk k a
Nil    -> MinPQueue k b
forall k a. MinPQueue k a
Empty
  Skip BinomForest (Succ rk) k a
ts'  -> CompF k
-> (k -> a -> Maybe b)
-> (Succ rk k a -> MinPQueue k b)
-> BinomForest (Succ rk) k a
-> MinPQueue k b
forall k a b (rk :: * -> * -> *).
CompF k
-> (k -> a -> Maybe b)
-> (rk k a -> MinPQueue k b)
-> BinomForest rk k a
-> MinPQueue k b
mapMaybeF CompF k
le k -> a -> Maybe b
f Succ rk k a -> MinPQueue k b
fCh' BinomForest (Succ rk) k a
ts'
  Cons (BinomTree k
k a
a rk k a
ts) BinomForest (Succ rk) k a
ts'
      -> k -> a -> MinPQueue k b -> MinPQueue k b -> MinPQueue k b
insF k
k a
a (rk k a -> MinPQueue k b
fCh rk k a
ts) (CompF k
-> (k -> a -> Maybe b)
-> (Succ rk k a -> MinPQueue k b)
-> BinomForest (Succ rk) k a
-> MinPQueue k b
forall k a b (rk :: * -> * -> *).
CompF k
-> (k -> a -> Maybe b)
-> (rk k a -> MinPQueue k b)
-> BinomForest rk k a
-> MinPQueue k b
mapMaybeF CompF k
le k -> a -> Maybe b
f Succ rk k a -> MinPQueue k b
fCh' BinomForest (Succ rk) k a
ts')
  where  insF :: k -> a -> MinPQueue k b -> MinPQueue k b -> MinPQueue k b
insF k
k a
a = (MinPQueue k b -> MinPQueue k b)
-> (b -> MinPQueue k b -> MinPQueue k b)
-> Maybe b
-> MinPQueue k b
-> MinPQueue k b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MinPQueue k b -> MinPQueue k b
forall a. a -> a
id (CompF k -> k -> b -> MinPQueue k b -> MinPQueue k b
forall k a. CompF k -> k -> a -> MinPQueue k a -> MinPQueue k a
insert' CompF k
le k
k) (k -> a -> Maybe b
f k
k a
a) (MinPQueue k b -> MinPQueue k b)
-> (MinPQueue k b -> MinPQueue k b -> MinPQueue k b)
-> MinPQueue k b
-> MinPQueue k b
-> MinPQueue k b
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: CompF k -> MinPQueue k b -> MinPQueue k b -> MinPQueue k b
forall k a.
CompF k -> MinPQueue k a -> MinPQueue k a -> MinPQueue k a
union' CompF k
le
         fCh' :: Succ rk k a -> MinPQueue k b
fCh' (Succ (BinomTree k
k a
a rk k a
ts) rk k a
tss) =
           k -> a -> MinPQueue k b -> MinPQueue k b -> MinPQueue k b
insF k
k a
a (rk k a -> MinPQueue k b
fCh rk k a
ts) (rk k a -> MinPQueue k b
fCh rk k a
tss)

-- | Utility function for mapping an 'Either' function over a forest.
mapEitherF :: CompF k -> (k -> a -> Either b c) -> (rk k a -> (MinPQueue k b, MinPQueue k c)) ->
  BinomForest rk k a -> (MinPQueue k b, MinPQueue k c)
mapEitherF :: CompF k
-> (k -> a -> Either b c)
-> (rk k a -> (MinPQueue k b, MinPQueue k c))
-> BinomForest rk k a
-> (MinPQueue k b, MinPQueue k c)
mapEitherF CompF k
le k -> a -> Either b c
f0 rk k a -> (MinPQueue k b, MinPQueue k c)
fCh BinomForest rk k a
ts0 = case BinomForest rk k a
ts0 of
  BinomForest rk k a
Nil    -> (MinPQueue k b
forall k a. MinPQueue k a
Empty, MinPQueue k c
forall k a. MinPQueue k a
Empty)
  Skip BinomForest (Succ rk) k a
ts'  -> CompF k
-> (k -> a -> Either b c)
-> (Succ rk k a -> (MinPQueue k b, MinPQueue k c))
-> BinomForest (Succ rk) k a
-> (MinPQueue k b, MinPQueue k c)
forall k a b c (rk :: * -> * -> *).
CompF k
-> (k -> a -> Either b c)
-> (rk k a -> (MinPQueue k b, MinPQueue k c))
-> BinomForest rk k a
-> (MinPQueue k b, MinPQueue k c)
mapEitherF CompF k
le k -> a -> Either b c
f0 Succ rk k a -> (MinPQueue k b, MinPQueue k c)
fCh' BinomForest (Succ rk) k a
ts'
  Cons (BinomTree k
k a
a rk k a
ts) BinomForest (Succ rk) k a
ts'
      -> k
-> a
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
insF k
k a
a (rk k a -> (MinPQueue k b, MinPQueue k c)
fCh rk k a
ts) (CompF k
-> (k -> a -> Either b c)
-> (Succ rk k a -> (MinPQueue k b, MinPQueue k c))
-> BinomForest (Succ rk) k a
-> (MinPQueue k b, MinPQueue k c)
forall k a b c (rk :: * -> * -> *).
CompF k
-> (k -> a -> Either b c)
-> (rk k a -> (MinPQueue k b, MinPQueue k c))
-> BinomForest rk k a
-> (MinPQueue k b, MinPQueue k c)
mapEitherF CompF k
le k -> a -> Either b c
f0 Succ rk k a -> (MinPQueue k b, MinPQueue k c)
fCh' BinomForest (Succ rk) k a
ts')
  where
    insF :: k
-> a
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
insF k
k a
a = (b
 -> (MinPQueue k b, MinPQueue k c)
 -> (MinPQueue k b, MinPQueue k c))
-> (c
    -> (MinPQueue k b, MinPQueue k c)
    -> (MinPQueue k b, MinPQueue k c))
-> Either b c
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((MinPQueue k b -> MinPQueue k b)
-> (MinPQueue k b, MinPQueue k c) -> (MinPQueue k b, MinPQueue k c)
forall a b c. (a -> b) -> (a, c) -> (b, c)
first' ((MinPQueue k b -> MinPQueue k b)
 -> (MinPQueue k b, MinPQueue k c)
 -> (MinPQueue k b, MinPQueue k c))
-> (b -> MinPQueue k b -> MinPQueue k b)
-> b
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompF k -> k -> b -> MinPQueue k b -> MinPQueue k b
forall k a. CompF k -> k -> a -> MinPQueue k a -> MinPQueue k a
insert' CompF k
le k
k) ((MinPQueue k c -> MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c) -> (MinPQueue k b, MinPQueue k c)
forall b c a. (b -> c) -> (a, b) -> (a, c)
second' ((MinPQueue k c -> MinPQueue k c)
 -> (MinPQueue k b, MinPQueue k c)
 -> (MinPQueue k b, MinPQueue k c))
-> (c -> MinPQueue k c -> MinPQueue k c)
-> c
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompF k -> k -> c -> MinPQueue k c -> MinPQueue k c
forall k a. CompF k -> k -> a -> MinPQueue k a -> MinPQueue k a
insert' CompF k
le k
k) (k -> a -> Either b c
f0 k
k a
a) ((MinPQueue k b, MinPQueue k c) -> (MinPQueue k b, MinPQueue k c))
-> ((MinPQueue k b, MinPQueue k c)
    -> (MinPQueue k b, MinPQueue k c)
    -> (MinPQueue k b, MinPQueue k c))
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.:
      (CompF k -> MinPQueue k b -> MinPQueue k b -> MinPQueue k b
forall k a.
CompF k -> MinPQueue k a -> MinPQueue k a -> MinPQueue k a
union' CompF k
le (MinPQueue k b -> MinPQueue k b -> MinPQueue k b)
-> (MinPQueue k c -> MinPQueue k c -> MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
forall t t a t t b.
(t -> t -> a) -> (t -> t -> b) -> (t, t) -> (t, t) -> (a, b)
`both` CompF k -> MinPQueue k c -> MinPQueue k c -> MinPQueue k c
forall k a.
CompF k -> MinPQueue k a -> MinPQueue k a -> MinPQueue k a
union' CompF k
le)
    fCh' :: Succ rk k a -> (MinPQueue k b, MinPQueue k c)
fCh' (Succ (BinomTree k
k a
a rk k a
ts) rk k a
tss) =
      k
-> a
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
-> (MinPQueue k b, MinPQueue k c)
insF k
k a
a (rk k a -> (MinPQueue k b, MinPQueue k c)
fCh rk k a
ts) (rk k a -> (MinPQueue k b, MinPQueue k c)
fCh rk k a
tss)
    both :: (t -> t -> a) -> (t -> t -> b) -> (t, t) -> (t, t) -> (a, b)
both t -> t -> a
f t -> t -> b
g (t
x1, t
x2) (t
y1, t
y2) = (t -> t -> a
f t
x1 t
y1, t -> t -> b
g t
x2 t
y2)

-- | /O(n)/. An unordered right fold over the elements of the queue, in no particular order.
foldrWithKeyU :: (k -> a -> b -> b) -> b -> MinPQueue k a -> b
foldrWithKeyU :: (k -> a -> b -> b) -> b -> MinPQueue k a -> b
foldrWithKeyU k -> a -> b -> b
_ b
z MinPQueue k a
Empty            = b
z
foldrWithKeyU k -> a -> b -> b
f b
z (MinPQ Int
_ k
k a
a BinomHeap k a
ts) = k -> a -> b -> b
f k
k a
a ((k -> a -> b -> b)
-> (Zero k a -> b -> b) -> BinomHeap k a -> b -> b
forall k a b (rk :: * -> * -> *).
(k -> a -> b -> b)
-> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b
foldrWithKeyF_ k -> a -> b -> b
f ((b -> b) -> Zero k a -> b -> b
forall a b. a -> b -> a
const b -> b
forall a. a -> a
id) BinomHeap k a
ts b
z)

-- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order.
foldlWithKeyU :: (b -> k -> a -> b) -> b -> MinPQueue k a -> b
foldlWithKeyU :: (b -> k -> a -> b) -> b -> MinPQueue k a -> b
foldlWithKeyU b -> k -> a -> b
_ b
z MinPQueue k a
Empty = b
z
foldlWithKeyU b -> k -> a -> b
f b
z0 (MinPQ Int
_ k
k0 a
a0 BinomHeap k a
ts) = (k -> a -> b -> b)
-> (Zero k a -> b -> b) -> BinomHeap k a -> b -> b
forall k a b (rk :: * -> * -> *).
(k -> a -> b -> b)
-> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b
foldlWithKeyF_ (\k
k a
a b
z -> b -> k -> a -> b
f b
z k
k a
a) ((b -> b) -> Zero k a -> b -> b
forall a b. a -> b -> a
const b -> b
forall a. a -> a
id) BinomHeap k a
ts (b -> k -> a -> b
f b
z0 k
k0 a
a0)

-- | /O(n)/. An unordered traversal over a priority queue, in no particular order.
-- While there is no guarantee in which order the elements are traversed, the resulting
-- priority queue will be perfectly valid.
traverseWithKeyU :: Applicative f => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverseWithKeyU :: (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverseWithKeyU k -> a -> f b
_ MinPQueue k a
Empty = MinPQueue k b -> f (MinPQueue k b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MinPQueue k b
forall k a. MinPQueue k a
Empty
traverseWithKeyU k -> a -> f b
f (MinPQ Int
n k
k a
a BinomHeap k a
ts) = Int -> k -> b -> BinomHeap k b -> MinPQueue k b
forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ Int
n k
k (b -> BinomHeap k b -> MinPQueue k b)
-> f b -> f (BinomHeap k b -> MinPQueue k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> f b
f k
k a
a f (BinomHeap k b -> MinPQueue k b)
-> f (BinomHeap k b) -> f (MinPQueue k b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (k -> a -> f b)
-> (Zero k a -> f (Zero k b)) -> BinomHeap k a -> f (BinomHeap k b)
forall (f :: * -> *) k a b (rk :: * -> * -> *).
Applicative f =>
(k -> a -> f b)
-> (rk k a -> f (rk k b))
-> BinomForest rk k a
-> f (BinomForest rk k b)
traverseForest k -> a -> f b
f (f (Zero k b) -> Zero k a -> f (Zero k b)
forall a b. a -> b -> a
const (Zero k b -> f (Zero k b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Zero k b
forall k a. Zero k a
Zero)) BinomHeap k a
ts

{-# SPECIALIZE traverseForest :: (k -> a -> Identity b) -> (rk k a -> Identity (rk k b)) -> BinomForest rk k a ->
  Identity (BinomForest rk k b) #-}
traverseForest :: (Applicative f) => (k -> a -> f b) -> (rk k a -> f (rk k b)) -> BinomForest rk k a -> f (BinomForest rk k b)
traverseForest :: (k -> a -> f b)
-> (rk k a -> f (rk k b))
-> BinomForest rk k a
-> f (BinomForest rk k b)
traverseForest k -> a -> f b
f rk k a -> f (rk k b)
fCh BinomForest rk k a
ts0 = case BinomForest rk k a
ts0 of
  BinomForest rk k a
Nil       -> BinomForest rk k b -> f (BinomForest rk k b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinomForest rk k b
forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil
  Skip BinomForest (Succ rk) k a
ts'  -> BinomForest (Succ rk) k b -> BinomForest rk k b
forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip (BinomForest (Succ rk) k b -> BinomForest rk k b)
-> f (BinomForest (Succ rk) k b) -> f (BinomForest rk k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (k -> a -> f b)
-> (Succ rk k a -> f (Succ rk k b))
-> BinomForest (Succ rk) k a
-> f (BinomForest (Succ rk) k b)
forall (f :: * -> *) k a b (rk :: * -> * -> *).
Applicative f =>
(k -> a -> f b)
-> (rk k a -> f (rk k b))
-> BinomForest rk k a
-> f (BinomForest rk k b)
traverseForest k -> a -> f b
f Succ rk k a -> f (Succ rk k b)
fCh' BinomForest (Succ rk) k a
ts'
  Cons (BinomTree k
k a
a rk k a
ts) BinomForest (Succ rk) k a
tss
    -> BinomTree rk k b -> BinomForest (Succ rk) k b -> BinomForest rk k b
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons (BinomTree rk k b
 -> BinomForest (Succ rk) k b -> BinomForest rk k b)
-> f (BinomTree rk k b)
-> f (BinomForest (Succ rk) k b -> BinomForest rk k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (k -> b -> rk k b -> BinomTree rk k b
forall (rk :: * -> * -> *) k a.
k -> a -> rk k a -> BinomTree rk k a
BinomTree k
k (b -> rk k b -> BinomTree rk k b)
-> f b -> f (rk k b -> BinomTree rk k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> f b
f k
k a
a f (rk k b -> BinomTree rk k b)
-> f (rk k b) -> f (BinomTree rk k b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> rk k a -> f (rk k b)
fCh rk k a
ts) f (BinomForest (Succ rk) k b -> BinomForest rk k b)
-> f (BinomForest (Succ rk) k b) -> f (BinomForest rk k b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (k -> a -> f b)
-> (Succ rk k a -> f (Succ rk k b))
-> BinomForest (Succ rk) k a
-> f (BinomForest (Succ rk) k b)
forall (f :: * -> *) k a b (rk :: * -> * -> *).
Applicative f =>
(k -> a -> f b)
-> (rk k a -> f (rk k b))
-> BinomForest rk k a
-> f (BinomForest rk k b)
traverseForest k -> a -> f b
f Succ rk k a -> f (Succ rk k b)
fCh' BinomForest (Succ rk) k a
tss
  where
    fCh' :: Succ rk k a -> f (Succ rk k b)
fCh' (Succ (BinomTree k
k a
a rk k a
ts) rk k a
tss)
      = BinomTree rk k b -> rk k b -> Succ rk k b
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> rk k a -> Succ rk k a
Succ (BinomTree rk k b -> rk k b -> Succ rk k b)
-> f (BinomTree rk k b) -> f (rk k b -> Succ rk k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (k -> b -> rk k b -> BinomTree rk k b
forall (rk :: * -> * -> *) k a.
k -> a -> rk k a -> BinomTree rk k a
BinomTree k
k (b -> rk k b -> BinomTree rk k b)
-> f b -> f (rk k b -> BinomTree rk k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> f b
f k
k a
a f (rk k b -> BinomTree rk k b)
-> f (rk k b) -> f (BinomTree rk k b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> rk k a -> f (rk k b)
fCh rk k a
ts) f (rk k b -> Succ rk k b) -> f (rk k b) -> f (Succ rk k b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> rk k a -> f (rk k b)
fCh rk k a
tss

-- | Unordered right fold on a binomial forest.
foldrWithKeyF_ :: (k -> a -> b -> b) -> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b
foldrWithKeyF_ :: (k -> a -> b -> b)
-> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b
foldrWithKeyF_ k -> a -> b -> b
f rk k a -> b -> b
fCh BinomForest rk k a
ts0 b
z0 = case BinomForest rk k a
ts0 of
  BinomForest rk k a
Nil    -> b
z0
  Skip BinomForest (Succ rk) k a
ts'  -> (k -> a -> b -> b)
-> (Succ rk k a -> b -> b) -> BinomForest (Succ rk) k a -> b -> b
forall k a b (rk :: * -> * -> *).
(k -> a -> b -> b)
-> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b
foldrWithKeyF_ k -> a -> b -> b
f Succ rk k a -> b -> b
fCh' BinomForest (Succ rk) k a
ts' b
z0
  Cons (BinomTree k
k a
a rk k a
ts) BinomForest (Succ rk) k a
ts'
    -> k -> a -> b -> b
f k
k a
a (rk k a -> b -> b
fCh rk k a
ts ((k -> a -> b -> b)
-> (Succ rk k a -> b -> b) -> BinomForest (Succ rk) k a -> b -> b
forall k a b (rk :: * -> * -> *).
(k -> a -> b -> b)
-> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b
foldrWithKeyF_ k -> a -> b -> b
f Succ rk k a -> b -> b
fCh' BinomForest (Succ rk) k a
ts' b
z0))
  where
    fCh' :: Succ rk k a -> b -> b
fCh' (Succ (BinomTree k
k a
a rk k a
ts) rk k a
tss) b
z =
      k -> a -> b -> b
f k
k a
a (rk k a -> b -> b
fCh rk k a
ts (rk k a -> b -> b
fCh rk k a
tss b
z))

-- | Unordered left fold on a binomial forest.
foldlWithKeyF_ :: (k -> a -> b -> b) -> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b
foldlWithKeyF_ :: (k -> a -> b -> b)
-> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b
foldlWithKeyF_ k -> a -> b -> b
f rk k a -> b -> b
fCh BinomForest rk k a
ts0 = case BinomForest rk k a
ts0 of
  BinomForest rk k a
Nil    -> b -> b
forall a. a -> a
id
  Skip BinomForest (Succ rk) k a
ts'  -> (k -> a -> b -> b)
-> (Succ rk k a -> b -> b) -> BinomForest (Succ rk) k a -> b -> b
forall k a b (rk :: * -> * -> *).
(k -> a -> b -> b)
-> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b
foldlWithKeyF_ k -> a -> b -> b
f Succ rk k a -> b -> b
fCh' BinomForest (Succ rk) k a
ts'
  Cons (BinomTree k
k a
a rk k a
ts) BinomForest (Succ rk) k a
ts'
    -> (k -> a -> b -> b)
-> (Succ rk k a -> b -> b) -> BinomForest (Succ rk) k a -> b -> b
forall k a b (rk :: * -> * -> *).
(k -> a -> b -> b)
-> (rk k a -> b -> b) -> BinomForest rk k a -> b -> b
foldlWithKeyF_ k -> a -> b -> b
f Succ rk k a -> b -> b
fCh' BinomForest (Succ rk) k a
ts' (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. rk k a -> b -> b
fCh rk k a
ts (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> a -> b -> b
f k
k a
a
  where
    fCh' :: Succ rk k a -> b -> b
fCh' (Succ (BinomTree k
k a
a rk k a
ts) rk k a
tss) =
      rk k a -> b -> b
fCh rk k a
tss (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. rk k a -> b -> b
fCh rk k a
ts (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> a -> b -> b
f k
k a
a

-- | Maps a monotonic function over the keys in a binomial forest.
mapKeysMonoF :: (k -> k') -> (rk k a -> rk k' a) -> BinomForest rk k a -> BinomForest rk k' a
mapKeysMonoF :: (k -> k')
-> (rk k a -> rk k' a) -> BinomForest rk k a -> BinomForest rk k' a
mapKeysMonoF k -> k'
f rk k a -> rk k' a
fCh BinomForest rk k a
ts0 = case BinomForest rk k a
ts0 of
  BinomForest rk k a
Nil    -> BinomForest rk k' a
forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil
  Skip BinomForest (Succ rk) k a
ts'  -> BinomForest (Succ rk) k' a -> BinomForest rk k' a
forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip ((k -> k')
-> (Succ rk k a -> Succ rk k' a)
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k' a
forall k k' (rk :: * -> * -> *) a.
(k -> k')
-> (rk k a -> rk k' a) -> BinomForest rk k a -> BinomForest rk k' a
mapKeysMonoF k -> k'
f Succ rk k a -> Succ rk k' a
fCh' BinomForest (Succ rk) k a
ts')
  Cons (BinomTree k
k a
a rk k a
ts) BinomForest (Succ rk) k a
ts'
    -> BinomTree rk k' a
-> BinomForest (Succ rk) k' a -> BinomForest rk k' a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons (k' -> a -> rk k' a -> BinomTree rk k' a
forall (rk :: * -> * -> *) k a.
k -> a -> rk k a -> BinomTree rk k a
BinomTree (k -> k'
f k
k) a
a (rk k a -> rk k' a
fCh rk k a
ts)) ((k -> k')
-> (Succ rk k a -> Succ rk k' a)
-> BinomForest (Succ rk) k a
-> BinomForest (Succ rk) k' a
forall k k' (rk :: * -> * -> *) a.
(k -> k')
-> (rk k a -> rk k' a) -> BinomForest rk k a -> BinomForest rk k' a
mapKeysMonoF k -> k'
f Succ rk k a -> Succ rk k' a
fCh' BinomForest (Succ rk) k a
ts')
  where
    fCh' :: Succ rk k a -> Succ rk k' a
fCh' (Succ (BinomTree k
k a
a rk k a
ts) rk k a
tss) =
      BinomTree rk k' a -> rk k' a -> Succ rk k' a
forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> rk k a -> Succ rk k a
Succ (k' -> a -> rk k' a -> BinomTree rk k' a
forall (rk :: * -> * -> *) k a.
k -> a -> rk k a -> BinomTree rk k a
BinomTree (k -> k'
f k
k) a
a (rk k a -> rk k' a
fCh rk k a
ts)) (rk k a -> rk k' a
fCh rk k a
tss)

-- | /O(log n)/. Analogous to @deepseq@ in the @deepseq@ package, but only forces the spine of the binomial heap.
seqSpine :: MinPQueue k a -> b -> b
seqSpine :: MinPQueue k a -> b -> b
seqSpine MinPQueue k a
Empty b
z0 = b
z0
seqSpine (MinPQ Int
_ k
_ a
_ BinomHeap k a
ts0) b
z0 = BinomHeap k a
ts0 BinomHeap k a -> b -> b
forall (rk :: * -> * -> *) k a b. BinomForest rk k a -> b -> b
`seqSpineF` b
z0 where
  seqSpineF :: BinomForest rk k a -> b -> b
  seqSpineF :: BinomForest rk k a -> b -> b
seqSpineF BinomForest rk k a
ts b
z = case BinomForest rk k a
ts of
    BinomForest rk k a
Nil        -> b
z
    Skip BinomForest (Succ rk) k a
ts'   -> BinomForest (Succ rk) k a -> b -> b
forall (rk :: * -> * -> *) k a b. BinomForest rk k a -> b -> b
seqSpineF BinomForest (Succ rk) k a
ts' b
z
    Cons BinomTree rk k a
_ BinomForest (Succ rk) k a
ts' -> BinomForest (Succ rk) k a -> b -> b
forall (rk :: * -> * -> *) k a b. BinomForest rk k a -> b -> b
seqSpineF BinomForest (Succ rk) k a
ts' b
z

class NFRank rk where
  rnfRk :: (NFData k, NFData a) => rk k a -> ()

instance NFRank Zero where
  rnfRk :: Zero k a -> ()
rnfRk Zero k a
_ = ()

instance NFRank rk => NFRank (Succ rk) where
  rnfRk :: Succ rk k a -> ()
rnfRk (Succ BinomTree rk k a
t rk k a
ts) = BinomTree rk k a
t BinomTree rk k a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` rk k a -> ()
forall (rk :: * -> * -> *) k a.
(NFRank rk, NFData k, NFData a) =>
rk k a -> ()
rnfRk rk k a
ts

instance (NFData k, NFData a, NFRank rk) => NFData (BinomTree rk k a) where
  rnf :: BinomTree rk k a -> ()
rnf (BinomTree k
k a
a rk k a
ts) = k
k k -> a -> a
forall a b. NFData a => a -> b -> b
`deepseq` a
a a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` rk k a -> ()
forall (rk :: * -> * -> *) k a.
(NFRank rk, NFData k, NFData a) =>
rk k a -> ()
rnfRk rk k a
ts

instance (NFData k, NFData a, NFRank rk) => NFData (BinomForest rk k a) where
  rnf :: BinomForest rk k a -> ()
rnf BinomForest rk k a
Nil = ()
  rnf (Skip BinomForest (Succ rk) k a
tss) = BinomForest (Succ rk) k a -> ()
forall a. NFData a => a -> ()
rnf BinomForest (Succ rk) k a
tss
  rnf (Cons BinomTree rk k a
t BinomForest (Succ rk) k a
tss) = BinomTree rk k a
t BinomTree rk k a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` BinomForest (Succ rk) k a -> ()
forall a. NFData a => a -> ()
rnf BinomForest (Succ rk) k a
tss

instance (NFData k, NFData a) => NFData (MinPQueue k a) where
  rnf :: MinPQueue k a -> ()
rnf MinPQueue k a
Empty = ()
  rnf (MinPQ Int
_ k
k a
a BinomHeap k a
ts) = k
k k -> a -> a
forall a b. NFData a => a -> b -> b
`deepseq` a
a a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` BinomHeap k a -> ()
forall a. NFData a => a -> ()
rnf BinomHeap k a
ts