{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.PQueue.Prio.Internals (
  MinPQueue(..),
  BinomForest(..),
  BinomHeap,
  BinomTree(..),
  Zero(..),
  Succ(..),
  empty,
  null,
  size,
  singleton,
  insert,
  insertBehind,
  insertEager,
  union,
  getMin,
  adjustMinWithKey,
  adjustMinWithKeyA',
  updateMinWithKey,
  updateMinWithKeyA',
  minViewWithKey,
  mapWithKey,
  mapKeysMonotonic,
  mapMaybeWithKey,
  mapEitherWithKey,
  foldrWithKey,
  foldlWithKey,
  foldrU,
  toAscList,
  toDescList,
  toListU,
  insertMin,
  insertMin',
  insertMax',
  fromList,
  fromAscList,
  foldrWithKeyU,
  foldMapWithKeyU,
  foldlWithKeyU,
  foldlWithKeyU',
  traverseWithKey,
  mapMWithKey,
  traverseWithKeyU,
  seqSpine,
  unions
  ) where

import Control.Applicative (liftA2, liftA3, Const (..))
import Control.DeepSeq (NFData(rnf), deepseq)
import Data.Coerce (coerce)
import Data.Functor.Identity (Identity(Identity, runIdentity))
import qualified Data.List as List

#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..), stimesMonoid, Endo (..), Dual (..))
#else
import Data.Monoid ((<>), Endo (..), Dual (..))
#endif

import Prelude hiding (null, map)
#ifdef __GLASGOW_HASKELL__
import Data.Data
import GHC.Exts (build, inline)
import Text.Read (Lexeme(Ident), lexP, parens, prec,
  readPrec, readListPrec, readListPrecDefault)
#endif

import Data.Functor.WithIndex
import Data.Foldable.WithIndex
import Data.Traversable.WithIndex
import Nattish (Nattish (..))

#ifndef __GLASGOW_HASKELL__
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build f = f (:) []
#endif

#if __GLASGOW_HASKELL__

-- | Treats the priority queue as an empty queue or a minimal
-- key-value pair and a priority queue. The constructors, conceptually,
-- are 'Data.PQueue.Prio.Min.Empty' and '(Data.PQueue.Prio.Min.:<)'.
--
-- 'gfoldl' is nondeterministic; any minimal pair may be chosen as
-- the first. All constructed queues maintain the queue invariants.
instance (Ord k, Data k, Data a) => Data (MinPQueue k a) where
  gfoldl :: forall (c :: * -> *).
(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
q = case forall k a. Ord k => MinPQueue k a -> Maybe ((k, a), MinPQueue k a)
minViewWithKey MinPQueue k a
q of
    Maybe ((k, a), MinPQueue k a)
Nothing      -> forall g. g -> c g
z forall k a. MinPQueue k a
Empty
    Just ((k, a)
x, MinPQueue k a
q') -> forall g. g -> c g
z (\(k
k, a
a) -> forall k a. Ord k => k -> a -> MinPQueue k a -> MinPQueue k a
insert k
k a
a) forall d b. Data d => c (d -> b) -> d -> c b
`f` (k, a)
x forall d b. Data d => c (d -> b) -> d -> c b
`f` MinPQueue k a
q'

  gunfold :: forall (c :: * -> *).
(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
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
    Int
1 -> forall r. r -> c r
z forall k a. MinPQueue k a
Empty
    Int
2 -> forall b r. Data b => c (b -> r) -> c r
k (forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z (\(k
key, a
val) -> forall k a. Ord k => k -> a -> MinPQueue k a -> MinPQueue k a
insert k
key a
val)))
    Int
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold: invalid constructor for MinPQueue"

  toConstr :: MinPQueue k a -> Constr
toConstr MinPQueue k a
q
    | forall k a. MinPQueue k a -> Bool
null MinPQueue k a
q = Constr
emptyConstr
    | Bool
otherwise = Constr
consConstr

  dataTypeOf :: MinPQueue k a -> DataType
dataTypeOf MinPQueue k a
_ = DataType
queueDataType
  dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (MinPQueue k a))
dataCast1 forall d. Data d => c (t d)
f  = forall {k1} {k2} (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 forall d. Data d => c (t d)
f
  dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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  = 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 forall d e. (Data d, Data e) => c (t d e)
f

queueDataType :: DataType
queueDataType :: DataType
queueDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Data.PQueue.Prio.Min.MinPQueue" [Constr
emptyConstr, Constr
consConstr]

emptyConstr, consConstr :: Constr
emptyConstr :: Constr
emptyConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
queueDataType [Char]
"Empty" [] Fixity
Prefix
consConstr :: Constr
consConstr  = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
queueDataType [Char]
":<" [] Fixity
Infix
#endif

#if MIN_VERSION_base(4,9,0)
instance Ord k => Semigroup (MinPQueue k a) where
  <> :: MinPQueue k a -> MinPQueue k a -> MinPQueue k a
(<>) = forall k a.
Ord k =>
MinPQueue k a -> MinPQueue k a -> MinPQueue k a
union
  stimes :: forall b. Integral b => b -> MinPQueue k a -> MinPQueue k a
stimes = forall b a. (Integral b, Monoid a) => b -> a -> a
stimesMonoid
  {-# INLINABLE stimes #-}
#endif

instance Ord k => Monoid (MinPQueue k a) where
  mempty :: MinPQueue k a
mempty = forall k a. MinPQueue k a
empty
#if !MIN_VERSION_base(4,11,0)
  mappend = union
#endif
  mconcat :: [MinPQueue k a] -> MinPQueue k a
mconcat = forall k a. Ord k => [MinPQueue k a] -> MinPQueue k a
unions

instance (Ord k, Show k, Show a) => Show (MinPQueue k a) where
  showsPrec :: Int -> MinPQueue k a -> ShowS
showsPrec Int
p MinPQueue k a
xs = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
    [Char] -> ShowS
showString [Char]
"fromAscList " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall k a. Ord k => MinPQueue k a -> [(k, a)]
toAscList MinPQueue k a
xs)

instance (Read k, Read a) => Read (MinPQueue k a) where
#ifdef __GLASGOW_HASKELL__
  readPrec :: ReadPrec (MinPQueue k a)
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
    Ident [Char]
"fromAscList" <- ReadPrec Lexeme
lexP
    [(k, a)]
xs <- forall a. Read a => ReadPrec a
readPrec
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. [(k, a)] -> MinPQueue k a
fromAscList [(k, a)]
xs)

  readListPrec :: ReadPrec [MinPQueue k a]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault
#else
  readsPrec p = readParen (p > 10) $ \r -> do
    ("fromAscList",s) <- lex r
    (xs,t) <- reads s
    return (fromAscList xs,t)
#endif

-- | The union of a list of queues: (@'unions' == 'List.foldl' 'union' 'empty'@).
unions :: Ord k => [MinPQueue k a] -> MinPQueue k a
unions :: forall k a. Ord k => [MinPQueue k a] -> MinPQueue k a
unions = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' forall k a.
Ord k =>
MinPQueue k a -> MinPQueue k a -> MinPQueue k a
union forall k a. MinPQueue k a
empty


(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(c -> d
f .: :: forall c d a b. (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)

infixr 8 .:

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

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 (rk k a)
newtype Zero k a = Zero a
data Succ rk k a = Succ {-# UNPACK #-} !(BinomTree rk k a) (rk k a)

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 forall a. Eq a => a -> a -> Bool
== Int
n2 Bool -> Bool -> Bool
&& forall k a.
(Ord k, Eq a) =>
k -> a -> BinomHeap k a -> k -> a -> BinomHeap 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 -> BinomHeap k a -> k -> a -> BinomHeap k a -> Bool
eqExtract :: forall k a.
(Ord k, Eq a) =>
k -> a -> BinomHeap k a -> k -> a -> BinomHeap k a -> Bool
eqExtract k
k10 a
a10 BinomHeap k a
ts10 k
k20 a
a20 BinomHeap k a
ts20 =
  k
k10 forall a. Eq a => a -> a -> Bool
== k
k20 Bool -> Bool -> Bool
&& a
a10 forall a. Eq a => a -> a -> Bool
== a
a20 Bool -> Bool -> Bool
&&
  case (forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
extract BinomHeap k a
ts10, forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
extract BinomHeap k a
ts20) of
    (Yes (Extract k
k1 (Zero a
a1) BinomHeap k a
ts1'), Yes (Extract k
k2 (Zero a
a2) BinomHeap k a
ts2'))
             -> forall k a.
(Ord k, Eq a) =>
k -> a -> BinomHeap k a -> k -> a -> BinomHeap k a -> Bool
eqExtract k
k1 a
a1 BinomHeap k a
ts1' k
k2 a
a2 BinomHeap k a
ts2'
    (MExtract Zero k a
No, MExtract Zero k a
No) -> Bool
True
    (MExtract Zero k a, MExtract Zero 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 =
    forall k a.
(Ord k, Ord a) =>
k -> a -> BinomHeap k a -> k -> a -> BinomHeap 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 -> BinomHeap k a -> k -> a -> BinomHeap k a -> Ordering
cmpExtract :: forall k a.
(Ord k, Ord a) =>
k -> a -> BinomHeap k a -> k -> a -> BinomHeap k a -> Ordering
cmpExtract k
k10 a
a10 BinomHeap k a
ts10 k
k20 a
a20 BinomHeap k a
ts20 =
  k
k10 forall a. Ord a => a -> a -> Ordering
`compare` k
k20 forall a. Semigroup a => a -> a -> a
<> a
a10 forall a. Ord a => a -> a -> Ordering
`compare` a
a20 forall a. Semigroup a => a -> a -> a
<>
  case (forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
extract BinomHeap k a
ts10, forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
extract BinomHeap k a
ts20) of
    (Yes (Extract k
k1 (Zero a
a1) BinomHeap k a
ts1'), Yes (Extract k
k2 (Zero a
a2) BinomHeap k a
ts2'))
                -> forall k a.
(Ord k, Ord a) =>
k -> a -> BinomHeap k a -> k -> a -> BinomHeap k a -> Ordering
cmpExtract k
k1 a
a1 BinomHeap k a
ts1' k
k2 a
a2 BinomHeap k a
ts2'
    (MExtract Zero k a
No, Yes{}) -> Ordering
LT
    (Yes{}, MExtract Zero k a
No) -> Ordering
GT
    (MExtract Zero k a
No, MExtract Zero k a
No)    -> Ordering
EQ

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

-- | \(O(1)\). Checks if this priority queue is empty.
null :: MinPQueue k a -> Bool
null :: forall k a. 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 :: forall k a. 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 :: forall k a. k -> a -> MinPQueue k a
singleton k
k a
a = forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ Int
1 k
k a
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 :: forall k a. Ord k => k -> a -> MinPQueue k a -> MinPQueue k a
insert k
k a
a MinPQueue k a
Empty = forall k a. k -> a -> MinPQueue k a
singleton k
k a
a
insert k
k a
a (MinPQ Int
n k
k' a
a' BinomHeap k a
ts)
  | k
k forall a. Ord a => a -> a -> Bool
<= k
k' = forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (Int
n forall a. Num a => a -> a -> a
+ Int
1) k
k  a
a  (forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incrMin (forall k a. k -> a -> BinomTree Zero k a
tip k
k' a
a') BinomHeap k a
ts)
  | Bool
otherwise = forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (Int
n forall a. Num a => a -> a -> a
+ Int
1) k
k' a
a' (forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr (forall k a. k -> a -> BinomTree Zero k a
tip k
k  a
a ) BinomHeap k a
ts)

insertEager :: Ord k => k -> a -> MinPQueue k a -> MinPQueue k a
insertEager :: forall k a. Ord k => k -> a -> MinPQueue k a -> MinPQueue k a
insertEager k
k a
a MinPQueue k a
Empty = forall k a. k -> a -> MinPQueue k a
singleton k
k a
a
insertEager k
k a
a (MinPQ Int
n k
k' a
a' BinomHeap k a
ts)
  | k
k forall a. Ord a => a -> a -> Bool
<= k
k' = forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (Int
n forall a. Num a => a -> a -> a
+ Int
1) k
k a
a  (forall k a. Ord k => k -> a -> BinomHeap k a -> BinomHeap k a
insertEagerHeap k
k' a
a' BinomHeap k a
ts)
  | Bool
otherwise = forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (Int
n forall a. Num a => a -> a -> a
+ Int
1) k
k' a
a' (forall k a. Ord k => k -> a -> BinomHeap k a -> BinomHeap k a
insertEagerHeap k
k a
a BinomHeap k a
ts)

-- | \(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.
{-# DEPRECATED insertBehind "This function is not reliable." #-}
insertBehind :: Ord k => k -> a -> MinPQueue k a -> MinPQueue k a
insertBehind :: forall k a. Ord k => 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) = forall k a.
Ord k =>
(k -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)
spanKey (forall a. Ord a => a -> a -> Bool
<= k
k) MinPQueue k a
q
  in  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k a. Ord k => k -> a -> MinPQueue k a -> MinPQueue k a
insert) (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 :: forall k a.
Ord k =>
(k -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)
spanKey k -> Bool
p MinPQueue k a
q = case 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'') = 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 forall a. a -> [a] -> [a]
: [(k, a)]
kas, MinPQueue k a
q'')
  Maybe ((k, a), MinPQueue k a)
_ -> ([], MinPQueue k a
q)

-- | Amortized \(O(\log \min(n_1,n_2))\), worst-case \(O(\log \max(n_1,n_2))\). Returns the union
-- of the two specified queues.
union :: Ord k => MinPQueue k a -> MinPQueue k a -> MinPQueue k a
union :: forall k a.
Ord k =>
MinPQueue k a -> MinPQueue k a -> MinPQueue k a
union (MinPQ Int
n1 k
k1 a
a1 BinomHeap k a
ts1) (MinPQ Int
n2 k
k2 a
a2 BinomHeap k a
ts2)
  | k
k1 forall a. Ord a => a -> a -> Bool
<= k
k2 = forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (Int
n1 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  = forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (Int
n1 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 = forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a
-> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
carryForest (forall k a. k -> a -> BinomTree Zero k a
tip k
k a
a) BinomHeap k a
ts1 BinomHeap k a
ts2
union MinPQueue k a
Empty MinPQueue k a
q2 = MinPQueue k a
q2
union 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 :: forall k a. MinPQueue k a -> Maybe (k, a)
getMin (MinPQ Int
_ k
k a
a BinomHeap k a
_) = forall a. a -> Maybe a
Just (k
k, a
a)
getMin MinPQueue 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 :: forall k a. (k -> a -> a) -> MinPQueue k a -> MinPQueue k a
adjustMinWithKey k -> a -> a
_ MinPQueue k a
Empty = forall k a. MinPQueue k a
Empty
adjustMinWithKey k -> a -> a
f (MinPQ Int
n k
k a
a BinomHeap k a
ts) = 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(1)\) per operation. Alter the value at the minimum key in an 'Applicative' context. If the
-- queue is empty, does nothing.
adjustMinWithKeyA' :: Applicative f => (MinPQueue k a -> r) -> (k -> a -> f a) -> MinPQueue k a -> f r
adjustMinWithKeyA' :: forall (f :: * -> *) k a r.
Applicative f =>
(MinPQueue k a -> r) -> (k -> a -> f a) -> MinPQueue k a -> f r
adjustMinWithKeyA' MinPQueue k a -> r
g k -> a -> f a
_ MinPQueue k a
Empty = forall (f :: * -> *) a. Applicative f => a -> f a
pure (MinPQueue k a -> r
g forall k a. MinPQueue k a
Empty)
adjustMinWithKeyA' MinPQueue k a -> r
g k -> a -> f a
f (MinPQ Int
n k
k a
a BinomHeap k a
ts) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a' -> MinPQueue k a -> r
g (forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ Int
n k
k a
a' BinomHeap k a
ts)) (k -> a -> f a
f k
k a
a)

-- | \(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 :: forall k a.
Ord k =>
(k -> a -> Maybe a) -> MinPQueue k a -> MinPQueue k a
updateMinWithKey k -> a -> Maybe a
_ MinPQueue k a
Empty = 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  -> forall k a. Ord k => Int -> BinomHeap k a -> MinPQueue k a
extractHeap Int
n BinomHeap k a
ts
  Just a
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)\) per operation. (Actually \(O(1)\) if there's no deletion.) Update
-- the value at the minimum key in an 'Applicative' context. If the queue is
-- empty, does nothing.
updateMinWithKeyA'
  :: (Applicative f, Ord k)
  => (MinPQueue k a -> r)
  -> (k -> a -> f (Maybe a))
  -> MinPQueue k a
  -> f r
updateMinWithKeyA' :: forall (f :: * -> *) k a r.
(Applicative f, Ord k) =>
(MinPQueue k a -> r)
-> (k -> a -> f (Maybe a)) -> MinPQueue k a -> f r
updateMinWithKeyA' MinPQueue k a -> r
g k -> a -> f (Maybe a)
_ MinPQueue k a
Empty = forall (f :: * -> *) a. Applicative f => a -> f a
pure (MinPQueue k a -> r
g forall k a. MinPQueue k a
Empty)
updateMinWithKeyA' MinPQueue k a -> r
g k -> a -> f (Maybe a)
f (MinPQ Int
n k
k a
a BinomHeap k a
ts) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MinPQueue k a -> r
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> MinPQueue k a
tweak) (k -> a -> f (Maybe a)
f k
k a
a)
  where
    tweak :: Maybe a -> MinPQueue k a
tweak Maybe a
Nothing = forall k a. Ord k => Int -> BinomHeap k a -> MinPQueue k a
extractHeap Int
n BinomHeap k a
ts
    tweak (Just a
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 :: forall k a. Ord k => MinPQueue k a -> Maybe ((k, a), MinPQueue k a)
minViewWithKey MinPQueue k a
Empty            = forall a. Maybe a
Nothing
minViewWithKey (MinPQ Int
n k
k a
a BinomHeap k a
ts) = forall a. a -> Maybe a
Just ((k
k, a
a), forall k a. Ord k => Int -> BinomHeap k a -> MinPQueue k a
extractHeap 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 :: forall k a b. (k -> a -> b) -> MinPQueue k a -> MinPQueue k b
mapWithKey k -> a -> b
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverseWithKeyU (coerce :: forall a b. Coercible a b => a -> b
coerce k -> a -> b
f)

-- | \(O(n)\). @'mapKeysMonotonic' f q == 'mapKeys' f q@, but only works when
-- @f@ is (weakly) monotonic. /The precondition is not checked./ This function
-- has better performance than 'mapKeys'.
--
-- Note: if the given function returns bottom for any of the keys in the queue, then the
-- portion of the queue which is bottom is /unspecified/.
mapKeysMonotonic :: (k -> k') -> MinPQueue k a -> MinPQueue k' a
mapKeysMonotonic :: forall k k' a. (k -> k') -> MinPQueue k a -> MinPQueue k' a
mapKeysMonotonic k -> k'
_ MinPQueue k a
Empty = forall k a. MinPQueue k a
Empty
mapKeysMonotonic k -> k'
f (MinPQ Int
n k
k a
a BinomHeap k a
ts) = forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ Int
n (k -> k'
f k
k) a
a forall a b. (a -> b) -> a -> b
$! forall k k' a. (k -> k') -> BinomHeap k a -> BinomHeap k' a
mapKeysMonoHeap k -> k'
f BinomHeap k a
ts

mapKeysMonoHeap :: forall k k' a. (k -> k') -> BinomHeap k a -> BinomHeap k' a
mapKeysMonoHeap :: forall k k' a. (k -> k') -> BinomHeap k a -> BinomHeap k' a
mapKeysMonoHeap k -> k'
f = forall (rk :: * -> * -> *).
Ranky rk -> BinomForest rk k a -> BinomForest rk k' a
mapKeysMonoForest forall {k} (zero :: k) (succ :: k -> k). Nattish zero succ zero
Zeroy
  where
    mapKeysMonoForest :: Ranky rk -> BinomForest rk k a -> BinomForest rk k' a
    mapKeysMonoForest :: forall (rk :: * -> * -> *).
Ranky rk -> BinomForest rk k a -> BinomForest rk k' a
mapKeysMonoForest !Ranky rk
_rky BinomForest rk k a
Nil = forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil
    mapKeysMonoForest !Ranky rk
rky (Skip BinomForest (Succ rk) k a
rest) = forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip forall a b. (a -> b) -> a -> b
$! forall (rk :: * -> * -> *).
Ranky rk -> BinomForest rk k a -> BinomForest rk k' a
mapKeysMonoForest (forall {k} (zero :: k) (succ :: k -> k) (n :: k).
Nattish zero succ n -> Nattish zero succ (succ n)
Succy Ranky rk
rky) BinomForest (Succ rk) k a
rest
    mapKeysMonoForest !Ranky rk
rky (Cons BinomTree rk k a
t BinomForest (Succ rk) k a
rest) = forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons (forall (rk :: * -> * -> *).
Ranky rk -> BinomTree rk k a -> BinomTree rk k' a
mapKeysMonoTree Ranky rk
rky BinomTree rk k a
t) forall a b. (a -> b) -> a -> b
$! forall (rk :: * -> * -> *).
Ranky rk -> BinomForest rk k a -> BinomForest rk k' a
mapKeysMonoForest (forall {k} (zero :: k) (succ :: k -> k) (n :: k).
Nattish zero succ n -> Nattish zero succ (succ n)
Succy Ranky rk
rky) BinomForest (Succ rk) k a
rest

    {-# INLINE mapKeysMonoTree #-}
    mapKeysMonoTree :: Ranky rk -> BinomTree rk k a -> BinomTree rk k' a
    mapKeysMonoTree :: forall (rk :: * -> * -> *).
Ranky rk -> BinomTree rk k a -> BinomTree rk k' a
mapKeysMonoTree Nattish Zero Succ rk
Zeroy (BinomTree k
k (Zero a
a)) =
      -- We've reached a value, which we must not force.
      forall (rk :: * -> * -> *) k a. k -> rk k a -> BinomTree rk k a
BinomTree (k -> k'
f k
k) (forall k a. a -> Zero k a
Zero a
a)
      -- We're not at a value; we force the result.
    mapKeysMonoTree (Succy Nattish Zero Succ n
rky) (BinomTree k
k rk k a
ts) = forall (rk :: * -> * -> *) k a. k -> rk k a -> BinomTree rk k a
BinomTree (k -> k'
f k
k) forall a b. (a -> b) -> a -> b
$! forall (rk :: * -> * -> *). Ranky rk -> Succ rk k a -> Succ rk k' a
mapKeysMonoTrees Nattish Zero Succ n
rky rk k a
ts

    mapKeysMonoTrees :: Ranky rk -> Succ rk k a -> Succ rk k' a
    mapKeysMonoTrees :: forall (rk :: * -> * -> *). Ranky rk -> Succ rk k a -> Succ rk k' a
mapKeysMonoTrees Nattish Zero Succ rk
Zeroy (Succ BinomTree rk k a
t (Zero a
a)) =
      -- Don't force the value!
      forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> rk k a -> Succ rk k a
Succ (forall (rk :: * -> * -> *).
Ranky rk -> BinomTree rk k a -> BinomTree rk k' a
mapKeysMonoTree forall {k} (zero :: k) (succ :: k -> k). Nattish zero succ zero
Zeroy BinomTree rk k a
t) (forall k a. a -> Zero k a
Zero a
a)
    mapKeysMonoTrees (Succy Nattish Zero Succ n
rky) (Succ BinomTree rk k a
t rk k a
ts) =
      -- Whew, no values; force the trees.
      forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> rk k a -> Succ rk k a
Succ (forall (rk :: * -> * -> *).
Ranky rk -> BinomTree rk k a -> BinomTree rk k' a
mapKeysMonoTree (forall {k} (zero :: k) (succ :: k -> k) (n :: k).
Nattish zero succ n -> Nattish zero succ (succ n)
Succy Nattish Zero Succ n
rky) BinomTree rk k a
t) forall a b. (a -> b) -> a -> b
$! forall (rk :: * -> * -> *). Ranky rk -> Succ rk k a -> Succ rk k' a
mapKeysMonoTrees Nattish Zero Succ n
rky rk 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 :: forall k a b.
Ord k =>
(k -> a -> Maybe b) -> MinPQueue k a -> MinPQueue k b
mapMaybeWithKey k -> a -> Maybe b
f = forall k a. Ord k => BinomHeap k a -> MinPQueue k a
fromBare forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall b k a. (b -> k -> a -> b) -> b -> MinPQueue k a -> b
foldlWithKeyU'
    (\BinomHeap k b
q k
k a
a -> case k -> a -> Maybe b
f k
k a
a of
        Maybe b
Nothing -> BinomHeap k b
q
        Just b
b -> forall k a. Ord k => k -> a -> BinomHeap k a -> BinomHeap k a
insertEagerHeap k
k b
b BinomHeap k b
q)
    forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil
{-# INLINABLE mapMaybeWithKey #-}

-- | \(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 :: forall k a b c.
Ord k =>
(k -> a -> Either b c)
-> MinPQueue k a -> (MinPQueue k b, MinPQueue k c)
mapEitherWithKey k -> a -> Either b c
f MinPQueue k a
q
  | (BinomHeap k b
l, BinomHeap k c
r) <- forall k a b c.
Ord k =>
(k -> a -> Either b c)
-> MinPQueue k a -> (BinomHeap k b, BinomHeap k c)
mapEitherHeap k -> a -> Either b c
f MinPQueue k a
q
  , let
      !l' :: MinPQueue k b
l' = forall k a. Ord k => BinomHeap k a -> MinPQueue k a
fromBare BinomHeap k b
l
      !r' :: MinPQueue k c
r' = forall k a. Ord k => BinomHeap k a -> MinPQueue k a
fromBare BinomHeap k c
r
  = (MinPQueue k b
l', MinPQueue k c
r')
{-# INLINABLE mapEitherWithKey #-}

data Partition k a b = Partition !(BinomHeap k a) !(BinomHeap k b)

fromPartition :: Partition k a b -> (BinomHeap k a, BinomHeap k b)
fromPartition :: forall k a b. Partition k a b -> (BinomHeap k a, BinomHeap k b)
fromPartition (Partition BinomHeap k a
p BinomHeap k b
q) = (BinomHeap k a
p, BinomHeap k b
q)

mapEitherHeap :: Ord k => (k -> a -> Either b c) -> MinPQueue k a -> (BinomHeap k b, BinomHeap k c)
mapEitherHeap :: forall k a b c.
Ord k =>
(k -> a -> Either b c)
-> MinPQueue k a -> (BinomHeap k b, BinomHeap k c)
mapEitherHeap k -> a -> Either b c
f = forall k a b. Partition k a b -> (BinomHeap k a, BinomHeap k b)
fromPartition forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall b k a. (b -> k -> a -> b) -> b -> MinPQueue k a -> b
foldlWithKeyU'
    (\(Partition BinomHeap k b
ls BinomHeap k c
rs) k
k a
a ->
         case k -> a -> Either b c
f k
k a
a of
           Left b
b -> forall k a b. BinomHeap k a -> BinomHeap k b -> Partition k a b
Partition (forall k a. Ord k => k -> a -> BinomHeap k a -> BinomHeap k a
insertEagerHeap k
k b
b BinomHeap k b
ls) BinomHeap k c
rs
           Right c
b -> forall k a b. BinomHeap k a -> BinomHeap k b -> Partition k a b
Partition BinomHeap k b
ls (forall k a. Ord k => k -> a -> BinomHeap k a -> BinomHeap k a
insertEagerHeap k
k c
b BinomHeap k c
rs))
    (forall k a b. BinomHeap k a -> BinomHeap k b -> Partition k a b
Partition forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil)

insertEagerHeap :: Ord k => k -> a -> BinomHeap k a -> BinomHeap k a
insertEagerHeap :: forall k a. Ord k => k -> a -> BinomHeap k a -> BinomHeap k a
insertEagerHeap k
k a
a BinomHeap k a
h = forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr' (forall k a. k -> a -> BinomTree Zero k a
tip k
k a
a) BinomHeap k a
h
{-# INLINE insertEagerHeap #-}

-- | \(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 :: forall k a b.
Ord k =>
(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
foldF BinomHeap k a
ts0) where
  foldF :: BinomHeap k a -> b
foldF BinomHeap k a
ts = case forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
extract BinomHeap k a
ts of
    Yes (Extract k
k (Zero a
a) BinomHeap k a
ts') -> k -> a -> b -> b
f k
k a
a (BinomHeap k a -> b
foldF BinomHeap k a
ts')
    MExtract Zero k a
No                           -> 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 :: forall k b a.
Ord k =>
(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
foldF (b -> k -> a -> b
f b
z0 k
k0 a
a0) BinomHeap k a
ts0 where
  foldF :: b -> BinomHeap k a -> b
foldF b
z BinomHeap k a
ts = case forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
extract BinomHeap k a
ts of
    Yes (Extract k
k (Zero a
a) BinomHeap k a
ts') -> b -> BinomHeap k a -> b
foldF (b -> k -> a -> b
f b
z k
k a
a) BinomHeap k a
ts'
    MExtract Zero k a
No                           -> b
z

{-# INLINABLE [1] toAscList #-}
-- | \(O(n \log n)\). Return all (key, value) pairs in ascending order by key.
toAscList :: Ord k => MinPQueue k a -> [(k, a)]
toAscList :: forall k a. Ord k => MinPQueue k a -> [(k, a)]
toAscList = forall k a b.
Ord k =>
(k -> a -> b -> b) -> b -> MinPQueue k a -> b
foldrWithKey (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (:)) []

{-# INLINABLE [1] toDescList #-}
-- | \(O(n \log n)\). Return all (key, value) pairs in descending order by key.
toDescList :: Ord k => MinPQueue k a -> [(k, a)]
toDescList :: forall k a. Ord k => MinPQueue k a -> [(k, a)]
toDescList = forall k b a.
Ord k =>
(b -> k -> a -> b) -> b -> MinPQueue k a -> b
foldlWithKey (\[(k, a)]
z k
k a
a -> (k
k, a
a) forall a. a -> [a] -> [a]
: [(k, a)]
z) []

-- | \(O(n)\). Build a priority queue from an ascending list of (key, value) pairs. /The precondition is not checked./
fromAscList :: [(k, a)] -> MinPQueue k a
{-# INLINE fromAscList #-}
fromAscList :: forall k a. [(k, a)] -> MinPQueue k a
fromAscList [(k, a)]
xs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\MinPQueue k a
q (k
k, a
a) -> forall k a. k -> a -> MinPQueue k a -> MinPQueue k a
insertMax' k
k a
a MinPQueue k a
q) forall k a. MinPQueue k a
empty [(k, a)]
xs

{-# RULES
  "toAscList" toAscList = \q -> build (\c n -> foldrWithKey (curry c) n q);
  "toDescList" toDescList = \q -> build (\c n -> foldlWithKey (\z k a -> (k, a) `c` z) n q);
  "toListU" toListU = \q -> build (\c n -> foldrWithKeyU (curry c) n q);
  #-}

{-# NOINLINE toListU #-}
-- | \(O(n)\). Returns all (key, value) pairs in the queue in no particular order.
toListU :: MinPQueue k a -> [(k, a)]
toListU :: forall k a. MinPQueue k a -> [(k, a)]
toListU = forall k a b. (k -> a -> b -> b) -> b -> MinPQueue k a -> b
foldrWithKeyU (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (:)) []

-- | \(O(n)\). An unordered right fold over the elements of the queue, in no particular order.
foldrU :: (a -> b -> b) -> b -> MinPQueue k a -> b
foldrU :: forall a b k. (a -> b -> b) -> b -> MinPQueue k a -> b
foldrU = forall k a b. (k -> a -> b -> b) -> b -> MinPQueue k a -> b
foldrWithKeyU forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

-- | 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 :: forall k a. k -> a -> MinPQueue k a -> MinPQueue k a
insertMin k
k a
a MinPQueue k a
Empty = forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ Int
1 k
k a
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) = forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (Int
n forall a. Num a => a -> a -> a
+ Int
1) k
k a
a (forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incrMin (forall k a. k -> a -> BinomTree Zero k a
tip k
k' a
a') BinomHeap k a
ts)

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

-- | Inserts an entry with key @>=@ every key in the map. Assumes and preserves
-- an extra invariant: the roots of the binomial trees are decreasing along
-- the spine.
insertMax' :: k -> a -> MinPQueue k a -> MinPQueue k a
insertMax' :: forall k a. k -> a -> MinPQueue k a -> MinPQueue k a
insertMax' k
k a
a MinPQueue k a
Empty = forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ Int
1 k
k a
a forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil
insertMax' k
k a
a (MinPQ Int
n k
k' a
a' BinomHeap k a
ts) = forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (Int
n forall a. Num a => a -> a -> a
+ Int
1) k
k' a
a' (forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incrMax' (forall k a. k -> a -> BinomTree Zero k a
tip k
k a
a) BinomHeap k a
ts)

{-# INLINE fromList #-}
-- | \(O(n)\). Constructs a priority queue from an unordered list.
fromList :: Ord k => [(k, a)] -> MinPQueue k a
-- We build a forest first and then extract its minimum at the end.  Why not
-- just build the 'MinQueue' directly? This way typically saves us one
-- comparison per element, which roughly halves comparisons.
fromList :: forall k a. Ord k => [(k, a)] -> MinPQueue k a
fromList [(k, a)]
xs = forall k a. Ord k => BinomHeap k a -> MinPQueue k a
fromBare (forall k a. Ord k => [(k, a)] -> BinomHeap k a
fromListHeap [(k, a)]
xs)

fromBare :: Ord k => BinomHeap k a -> MinPQueue k a
fromBare :: forall k a. Ord k => BinomHeap k a -> MinPQueue k a
fromBare BinomHeap k a
xs = case forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
extract BinomHeap k a
xs of
  MExtract Zero k a
No -> forall k a. MinPQueue k a
Empty
  -- Should we track the size as we go instead? That saves O(log n)
  -- at the end, but it needs an extra register all along the way.
  -- The nodes should probably all be in L1 cache already thanks to the
  -- extractHeap.
  Yes (Extract k
k (Zero a
v) BinomHeap k a
f) -> forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (forall k a. BinomHeap k a -> Int
sizeHeap BinomHeap k a
f forall a. Num a => a -> a -> a
+ Int
1) k
k a
v BinomHeap k a
f

{-# INLINE fromListHeap #-}
fromListHeap :: Ord k => [(k, a)] -> BinomHeap k a
fromListHeap :: forall k a. Ord k => [(k, a)] -> BinomHeap k a
fromListHeap [(k, a)]
xs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' forall {k} {a}. Ord k => BinomHeap k a -> (k, a) -> BinomHeap k a
go forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil [(k, a)]
xs
  where
    go :: BinomHeap k a -> (k, a) -> BinomHeap k a
go BinomHeap k a
fr (k
k, a
a) = forall k a. Ord k => k -> a -> BinomHeap k a -> BinomHeap k a
insertEagerHeap k
k a
a BinomHeap k a
fr

sizeHeap :: BinomHeap k a -> Int
sizeHeap :: forall k a. BinomHeap k a -> Int
sizeHeap = forall (rk :: * -> * -> *) k a.
Int -> Int -> BinomForest rk k a -> Int
go Int
0 Int
1
  where
    go :: Int -> Int -> BinomForest rk k a -> Int
    go :: forall (rk :: * -> * -> *) k a.
Int -> Int -> BinomForest rk k a -> Int
go Int
acc Int
rk BinomForest rk k a
Nil = Int
rk seq :: forall a b. a -> b -> b
`seq` Int
acc
    go Int
acc Int
rk (Skip BinomForest (Succ rk) k a
f) = forall (rk :: * -> * -> *) k a.
Int -> Int -> BinomForest rk k a -> Int
go Int
acc (Int
2 forall a. Num a => a -> a -> a
* Int
rk) BinomForest (Succ rk) k a
f
    go Int
acc Int
rk (Cons BinomTree rk k a
_t BinomForest (Succ rk) k a
f) = forall (rk :: * -> * -> *) k a.
Int -> Int -> BinomForest rk k a -> Int
go (Int
acc forall a. Num a => a -> a -> a
+ Int
rk) (Int
2 forall a. Num a => a -> a -> a
* Int
rk) BinomForest (Succ rk) k a
f

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

-- | \(O(1)\). Takes the union of two binomial trees of the same rank.
meld :: Ord k => BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
meld :: forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
meld t1 :: BinomTree rk k a
t1@(BinomTree k
k1 rk k a
ts1) t2 :: BinomTree rk k a
t2@(BinomTree k
k2 rk k a
ts2)
  | k
k1 forall a. Ord a => a -> a -> Bool
<= k
k2 = forall (rk :: * -> * -> *) k a. k -> rk k a -> BinomTree rk k a
BinomTree k
k1 (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  = forall (rk :: * -> * -> *) k a. k -> rk k a -> BinomTree rk k a
BinomTree k
k2 (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 :: Ord k => BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
mergeForest :: forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
mergeForest 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)       -> forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip forall a b. (a -> b) -> a -> b
$! forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
mergeForest 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)    -> forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t2 forall a b. (a -> b) -> a -> b
$! forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
mergeForest 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)    -> forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t1 forall a b. (a -> b) -> a -> b
$! forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
mergeForest 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) -> forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip forall a b. (a -> b) -> a -> b
$! forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a
-> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
carryForest (forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
meld 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 :: Ord k => BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
carryForest :: forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a
-> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
carryForest BinomTree rk k a
t0 BinomForest rk k a
f1 BinomForest rk k a
f2 = BinomTree rk k a
t0 seq :: forall a b. a -> b -> b
`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) -> forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t0 forall a b. (a -> b) -> a -> b
$! 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)    -> forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip forall a b. (a -> b) -> a -> b
$! 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)    -> forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip forall a b. (a -> b) -> a -> b
$! 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)       -> forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t0 forall a b. (a -> b) -> a -> b
$! forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
mergeForest BinomForest (Succ rk) k a
ts1 BinomForest (Succ rk) k a
ts2
  -- Why do these use incr and not incr'? We want the merge to take
  -- O(log(min(|f1|, |f2|))) amortized time. If we performed this final
  -- increment eagerly, that would degrade to O(log(max(|f1|, |f2|))) time.
  (BinomForest rk k a
Nil, BinomForest rk k a
_)                   -> forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr BinomTree rk k a
t0 BinomForest rk k a
f2
  (BinomForest rk k a
_, BinomForest rk k a
Nil)                   -> forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr 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 = forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a
-> BinomForest rk k a -> BinomForest rk k a -> BinomForest rk k a
carryForest forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
meld

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

-- | Inserts a binomial tree into a binomial forest. Analogous to binary incrementation.
-- Forces the rebuilt portion of the spine.
incr' :: Ord k => BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr' :: forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr' BinomTree rk k a
t BinomForest rk k a
ts = BinomTree rk k a
t seq :: forall a b. a -> b -> b
`seq` case BinomForest rk k a
ts of
  BinomForest rk k a
Nil         -> forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil
  Skip BinomForest (Succ rk) k a
ts'    -> 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' -> forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip forall a b. (a -> b) -> a -> b
$! forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr' (forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
meld 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 :: forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incrMin t :: BinomTree rk k a
t@(BinomTree k
k rk k a
ts) BinomForest rk k a
tss = case BinomForest rk k a
tss of
  BinomForest rk k a
Nil          -> forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil
  Skip BinomForest (Succ rk) k a
tss'    -> 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
tss' seq :: forall a b. a -> b -> b
`seq` forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip (forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incrMin (forall (rk :: * -> * -> *) k a. k -> rk k a -> BinomTree rk k a
BinomTree k
k (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')

-- | 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)@. Forces the rebuilt portion of the spine.
incrMin' :: BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incrMin' :: forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incrMin' t :: BinomTree rk k a
t@(BinomTree k
k rk k a
ts) BinomForest rk k a
tss = case BinomForest rk k a
tss of
  BinomForest rk k a
Nil          -> forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil
  Skip BinomForest (Succ rk) k a
tss'    -> 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' -> forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip forall a b. (a -> b) -> a -> b
$! forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incrMin' (forall (rk :: * -> * -> *) k a. k -> rk k a -> BinomTree rk k a
BinomTree k
k (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'

-- | See 'insertMax'' for invariant info.
incrMax' :: BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incrMax' :: forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incrMax' BinomTree rk k a
t BinomForest rk k a
tss = BinomTree rk k a
t seq :: forall a b. a -> b -> b
`seq` case BinomForest rk k a
tss of
  BinomForest rk k a
Nil          -> forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
t forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil
  Skip BinomForest (Succ rk) k a
tss'    -> 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 k
k rk k a
ts) BinomForest (Succ rk) k a
tss' -> forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip forall a b. (a -> b) -> a -> b
$! forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incrMax' (forall (rk :: * -> * -> *) k a. k -> rk k a -> BinomTree rk k a
BinomTree k
k (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 :: Ord k => Int -> BinomHeap k a -> MinPQueue k a
extractHeap :: forall k a. Ord k => Int -> BinomHeap k a -> MinPQueue k a
extractHeap Int
n BinomHeap k a
ts = Int
n seq :: forall a b. a -> b -> b
`seq` case forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
extract BinomHeap k a
ts of
  MExtract Zero k a
No                      -> forall k a. MinPQueue k a
Empty
  Yes (Extract k
k (Zero a
a) BinomHeap k a
ts') -> forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ (Int
n 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 (rk k a) !(BinomForest rk k a)
data MExtract rk k a = No | Yes {-# UNPACK #-} !(Extract rk k a)

incrExtract :: Extract (Succ rk) k a -> Extract rk k a
incrExtract :: forall (rk :: * -> * -> *) k a.
Extract (Succ rk) k a -> Extract rk k a
incrExtract (Extract k
minKey (Succ BinomTree rk k a
kChild rk k a
kChildren) BinomForest (Succ rk) k a
ts)
  = forall (rk :: * -> * -> *) k a.
k -> rk k a -> BinomForest rk k a -> Extract rk k a
Extract k
minKey rk k a
kChildren (forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k a
kChild BinomForest (Succ rk) k a
ts)

incrExtract' :: Ord k => BinomTree rk k a -> Extract (Succ rk) k a -> Extract rk k a
incrExtract' :: forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> Extract (Succ rk) k a -> Extract rk k a
incrExtract' BinomTree rk k a
t (Extract k
minKey (Succ BinomTree rk k a
kChild rk k a
kChildren) BinomForest (Succ rk) k a
ts)
  = forall (rk :: * -> * -> *) k a.
k -> rk k a -> BinomForest rk k a -> Extract rk k a
Extract k
minKey rk k a
kChildren (forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip forall a b. (a -> b) -> a -> b
$! forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> BinomForest rk k a -> BinomForest rk k a
incr' (BinomTree rk k a
t forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> BinomTree rk k a -> BinomTree (Succ rk) k a
`meld` BinomTree rk k a
kChild) BinomForest (Succ rk) k a
ts)

-- | 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.
extract :: Ord k => BinomForest rk k a -> MExtract rk k a
extract :: forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
extract = forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
start
  where
    start :: Ord k => BinomForest rk k a -> MExtract rk k a
    start :: forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
start BinomForest rk k a
Nil = forall (rk :: * -> * -> *) k a. MExtract rk k a
No
    start (Skip BinomForest (Succ rk) k a
f) = case forall k (rk :: * -> * -> *) a.
Ord k =>
BinomForest rk k a -> MExtract rk k a
start BinomForest (Succ rk) k a
f of
      MExtract (Succ rk) k a
No     -> forall (rk :: * -> * -> *) k a. MExtract rk k a
No
      Yes Extract (Succ rk) k a
ex -> forall (rk :: * -> * -> *) k a. Extract rk k a -> MExtract rk k a
Yes (forall (rk :: * -> * -> *) k a.
Extract (Succ rk) k a -> Extract rk k a
incrExtract Extract (Succ rk) k a
ex)
    start (Cons t :: BinomTree rk k a
t@(BinomTree k
k rk k a
ts) BinomForest (Succ rk) k a
f) = forall (rk :: * -> * -> *) k a. Extract rk k a -> MExtract rk k a
Yes forall a b. (a -> b) -> a -> b
$ case forall k (rk :: * -> * -> *) a.
Ord k =>
k -> BinomForest rk k a -> MExtract rk k a
go k
k BinomForest (Succ rk) k a
f of
      MExtract (Succ rk) k a
No -> forall (rk :: * -> * -> *) k a.
k -> rk k a -> BinomForest rk k a -> Extract rk k a
Extract k
k rk k a
ts (forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
skip BinomForest (Succ rk) k a
f)
      Yes Extract (Succ rk) k a
ex -> forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> Extract (Succ rk) k a -> Extract rk k a
incrExtract' BinomTree rk k a
t Extract (Succ rk) k a
ex

    go :: Ord k => k -> BinomForest rk k a -> MExtract rk k a
    go :: forall k (rk :: * -> * -> *) a.
Ord k =>
k -> BinomForest rk k a -> MExtract rk k a
go k
_min_above BinomForest rk k a
Nil = k
_min_above seq :: forall a b. a -> b -> b
`seq` forall (rk :: * -> * -> *) k a. MExtract rk k a
No
    go k
min_above (Skip BinomForest (Succ rk) k a
f) = case forall k (rk :: * -> * -> *) a.
Ord k =>
k -> BinomForest rk k a -> MExtract rk k a
go k
min_above BinomForest (Succ rk) k a
f of
      MExtract (Succ rk) k a
No -> forall (rk :: * -> * -> *) k a. MExtract rk k a
No
      Yes Extract (Succ rk) k a
ex -> forall (rk :: * -> * -> *) k a. Extract rk k a -> MExtract rk k a
Yes (forall (rk :: * -> * -> *) k a.
Extract (Succ rk) k a -> Extract rk k a
incrExtract Extract (Succ rk) k a
ex)
    go k
min_above (Cons t :: BinomTree rk k a
t@(BinomTree k
k rk k a
ts) BinomForest (Succ rk) k a
f)
      | k
min_above forall a. Ord a => a -> a -> Bool
<= k
k = case forall k (rk :: * -> * -> *) a.
Ord k =>
k -> BinomForest rk k a -> MExtract rk k a
go k
min_above BinomForest (Succ rk) k a
f of
          MExtract (Succ rk) k a
No -> forall (rk :: * -> * -> *) k a. MExtract rk k a
No
          Yes Extract (Succ rk) k a
ex -> forall (rk :: * -> * -> *) k a. Extract rk k a -> MExtract rk k a
Yes (forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> Extract (Succ rk) k a -> Extract rk k a
incrExtract' BinomTree rk k a
t Extract (Succ rk) k a
ex)
      | Bool
otherwise = case forall k (rk :: * -> * -> *) a.
Ord k =>
k -> BinomForest rk k a -> MExtract rk k a
go k
k BinomForest (Succ rk) k a
f of
          MExtract (Succ rk) k a
No -> forall (rk :: * -> * -> *) k a. Extract rk k a -> MExtract rk k a
Yes (forall (rk :: * -> * -> *) k a.
k -> rk k a -> BinomForest rk k a -> Extract rk k a
Extract k
k rk k a
ts (forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
skip BinomForest (Succ rk) k a
f))
          Yes Extract (Succ rk) k a
ex -> forall (rk :: * -> * -> *) k a. Extract rk k a -> MExtract rk k a
Yes (forall k (rk :: * -> * -> *) a.
Ord k =>
BinomTree rk k a -> Extract (Succ rk) k a -> Extract rk k a
incrExtract' BinomTree rk k a
t Extract (Succ rk) k a
ex)

skip :: BinomForest (Succ rk) k a -> BinomForest rk k a
skip :: forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
skip BinomForest (Succ rk) k a
Nil = forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil
skip BinomForest (Succ rk) k a
f = forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip BinomForest (Succ rk) k a
f
{-# INLINE skip #-}

-- | \(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 :: forall k a b. (k -> a -> b -> b) -> b -> MinPQueue k a -> b
foldrWithKeyU k -> a -> b -> b
c b
n = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Endo a -> a -> a
appEndo b
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a
inline forall m k a. Monoid m => (k -> a -> m) -> MinPQueue k a -> m
foldMapWithKeyU (coerce :: forall a b. Coercible a b => a -> b
coerce k -> a -> b -> b
c)

-- | \(O(n)\). An unordered monoidal fold over the elements of the queue, in no particular order.
--
-- @since 1.4.2
foldMapWithKeyU :: forall m k a. Monoid m => (k -> a -> m) -> MinPQueue k a -> m
foldMapWithKeyU :: forall m k a. Monoid m => (k -> a -> m) -> MinPQueue k a -> m
foldMapWithKeyU = coerce :: forall a b. Coercible a b => a -> b
coerce
  (forall a. a -> a
inline forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverseWithKeyU :: (k -> a -> Const m ()) -> MinPQueue k a -> Const m (MinPQueue k ()))

-- | \(O(n)\). An unordered left fold over the elements of the queue, in no
-- particular order. This is rarely what you want; 'foldrWithKeyU' and
-- 'foldlWithKeyU'' are more likely to perform well.
foldlWithKeyU :: (b -> k -> a -> b) -> b -> MinPQueue k a -> b
foldlWithKeyU :: forall b k a. (b -> k -> a -> b) -> b -> MinPQueue k a -> b
foldlWithKeyU b -> k -> a -> b
f b
b = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Endo a -> a -> a
appEndo b
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Dual a -> a
getDual forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall m k a. Monoid m => (k -> a -> m) -> MinPQueue k a -> m
foldMapWithKeyU (\k
k a
a -> forall a. a -> Dual a
Dual forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ \b
r -> b -> k -> a -> b
f b
r k
k a
a)

-- | \(O(n)\). An unordered strict left fold over the elements of the queue, in no particular order.
--
-- @since 1.4.2
foldlWithKeyU' :: (b -> k -> a -> b) -> b -> MinPQueue k a -> b
foldlWithKeyU' :: forall b k a. (b -> k -> a -> b) -> b -> MinPQueue k a -> b
foldlWithKeyU' b -> k -> a -> b
f !b
b MinPQueue k a
q =
  case MinPQueue k a
q of
    MinPQueue k a
Empty -> b
b
    MinPQ Int
_n k
k a
a BinomHeap k a
ts -> forall k a b. (b -> k -> a -> b) -> b -> BinomHeap k a -> b
foldlHeapU' b -> k -> a -> b
f (b -> k -> a -> b
f b
b k
k a
a) BinomHeap k a
ts

foldlHeapU' :: forall k a b. (b -> k -> a -> b) -> b -> BinomHeap k a -> b
foldlHeapU' :: forall k a b. (b -> k -> a -> b) -> b -> BinomHeap k a -> b
foldlHeapU' b -> k -> a -> b
f = \b
b -> forall (rk :: * -> * -> *).
Ranky rk -> b -> BinomForest rk k a -> b
foldlForest' forall {k} (zero :: k) (succ :: k -> k). Nattish zero succ zero
Zeroy b
b
  where
    foldlForest' :: Ranky rk -> b -> BinomForest rk k a -> b
    foldlForest' :: forall (rk :: * -> * -> *).
Ranky rk -> b -> BinomForest rk k a -> b
foldlForest' !Ranky rk
_rky !b
acc BinomForest rk k a
Nil = b
acc
    foldlForest' !Ranky rk
rky !b
acc (Skip BinomForest (Succ rk) k a
rest) = forall (rk :: * -> * -> *).
Ranky rk -> b -> BinomForest rk k a -> b
foldlForest' (forall {k} (zero :: k) (succ :: k -> k) (n :: k).
Nattish zero succ n -> Nattish zero succ (succ n)
Succy Ranky rk
rky) b
acc BinomForest (Succ rk) k a
rest
    foldlForest' !Ranky rk
rky !b
acc (Cons BinomTree rk k a
t BinomForest (Succ rk) k a
rest) =
      forall (rk :: * -> * -> *).
Ranky rk -> b -> BinomForest rk k a -> b
foldlForest' (forall {k} (zero :: k) (succ :: k -> k) (n :: k).
Nattish zero succ n -> Nattish zero succ (succ n)
Succy Ranky rk
rky) (forall (rk :: * -> * -> *). Ranky rk -> b -> BinomTree rk k a -> b
foldlTree' Ranky rk
rky b
acc BinomTree rk k a
t) BinomForest (Succ rk) k a
rest

    {-# INLINE foldlTree' #-}
    foldlTree' :: Ranky rk -> b -> BinomTree rk k a -> b
    foldlTree' :: forall (rk :: * -> * -> *). Ranky rk -> b -> BinomTree rk k a -> b
foldlTree' !Ranky rk
rky !b
acc (BinomTree k
k rk k a
ts) = forall (rk :: * -> * -> *). Ranky rk -> b -> k -> rk k a -> b
foldlTrees' Ranky rk
rky b
acc k
k rk k a
ts

    foldlTrees' :: Ranky rk -> b -> k -> rk k a -> b
    foldlTrees' :: forall (rk :: * -> * -> *). Ranky rk -> b -> k -> rk k a -> b
foldlTrees' Nattish Zero Succ rk
Zeroy !b
acc !k
k (Zero a
a) = b -> k -> a -> b
f b
acc k
k a
a
    foldlTrees' (Succy Nattish Zero Succ n
rky) !b
acc !k
k (Succ BinomTree n k a
t n k a
ts) =
      forall (rk :: * -> * -> *). Ranky rk -> b -> k -> rk k a -> b
foldlTrees' Nattish Zero Succ n
rky (forall (rk :: * -> * -> *). Ranky rk -> b -> BinomTree rk k a -> b
foldlTree' Nattish Zero Succ n
rky b
acc BinomTree n k a
t) k
k n k a
ts

-- | \(O(n \log n)\). Traverses the elements of the queue in ascending order by key.
-- (@'traverseWithKey' f q == 'fromAscList' <$> 'traverse' ('uncurry' f) ('toAscList' q)@)
--
-- If you do not care about the /order/ of the traversal, consider using 'traverseWithKeyU'.
--
-- If you are working in a strict monad, consider using 'mapMWithKey'.
traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverseWithKey :: forall k (f :: * -> *) a b.
(Ord k, Applicative f) =>
(k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverseWithKey k -> a -> f b
f MinPQueue k a
q = case forall k a. Ord k => MinPQueue k a -> Maybe ((k, a), MinPQueue k a)
minViewWithKey MinPQueue k a
q of
  Maybe ((k, a), MinPQueue k a)
Nothing      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k a. MinPQueue k a
empty
  Just ((k
k, a
a), MinPQueue k a
q')  -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall k a. k -> a -> MinPQueue k a -> MinPQueue k a
insertMin k
k) (k -> a -> f b
f k
k a
a) (forall k (f :: * -> *) a b.
(Ord k, Applicative f) =>
(k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverseWithKey k -> a -> f b
f MinPQueue k a
q')

-- | A strictly accumulating version of 'traverseWithKey'. This works well in
-- 'IO' and strict @State@, and is likely what you want for other "strict" monads,
-- where @⊥ >>= pure () = ⊥@.
mapMWithKey :: (Ord k, Monad m) => (k -> a -> m b) -> MinPQueue k a -> m (MinPQueue k b)
mapMWithKey :: forall k (m :: * -> *) a b.
(Ord k, Monad m) =>
(k -> a -> m b) -> MinPQueue k a -> m (MinPQueue k b)
mapMWithKey k -> a -> m b
f = MinPQueue k b -> MinPQueue k a -> m (MinPQueue k b)
go forall k a. MinPQueue k a
empty
  where
    go :: MinPQueue k b -> MinPQueue k a -> m (MinPQueue k b)
go !MinPQueue k b
acc MinPQueue k a
q =
      case forall k a. Ord k => MinPQueue k a -> Maybe ((k, a), MinPQueue k a)
minViewWithKey MinPQueue k a
q of
        Maybe ((k, a), MinPQueue k a)
Nothing           -> forall (f :: * -> *) a. Applicative f => a -> f a
pure MinPQueue k b
acc
        Just ((k
k, a
a), MinPQueue k a
q') -> do
          b
b <- k -> a -> m b
f k
k a
a
          let !acc' :: MinPQueue k b
acc' = forall k a. k -> a -> MinPQueue k a -> MinPQueue k a
insertMax' k
k b
b MinPQueue k b
acc
          MinPQueue k b -> MinPQueue k a -> m (MinPQueue k b)
go MinPQueue k b
acc' MinPQueue k a
q'

-- | Natural numbers revealing whether something is 'Zero' or 'Succ'.
type Ranky = Nattish Zero Succ

-- | \(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.
{-# INLINABLE traverseWithKeyU #-}
traverseWithKeyU :: forall f k a b. Applicative f => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverseWithKeyU :: forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverseWithKeyU k -> a -> f b
_ MinPQueue k a
Empty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k a. MinPQueue k a
Empty
traverseWithKeyU k -> a -> f b
f (MinPQ Int
n k
k a
a BinomHeap k a
ts) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\b
a' !BinomHeap k b
ts' -> forall k a. Int -> k -> a -> BinomHeap k a -> MinPQueue k a
MinPQ Int
n k
k b
a' BinomHeap k b
ts') (k -> a -> f b
f k
k a
a) (forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f b) -> BinomHeap k a -> f (BinomHeap k b)
traverseHeapU k -> a -> f b
f BinomHeap k a
ts)

{-# INLINABLE traverseHeapU #-}
traverseHeapU :: forall f k a b. Applicative f => (k -> a -> f b) -> BinomHeap k a -> f (BinomHeap k b)
traverseHeapU :: forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f b) -> BinomHeap k a -> f (BinomHeap k b)
traverseHeapU k -> a -> f b
f = forall (rk :: * -> * -> *).
Ranky rk -> BinomForest rk k a -> f (BinomForest rk k b)
traverseForest forall {k} (zero :: k) (succ :: k -> k). Nattish zero succ zero
Zeroy
  where
    traverseForest :: Ranky rk -> BinomForest rk k a -> f (BinomForest rk k b)
    traverseForest :: forall (rk :: * -> * -> *).
Ranky rk -> BinomForest rk k a -> f (BinomForest rk k b)
traverseForest !Ranky rk
_rky BinomForest rk k a
Nil = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (rk :: * -> * -> *) k a. BinomForest rk k a
Nil
    traverseForest !Ranky rk
rky (Skip BinomForest (Succ rk) k a
rest) = (forall (rk :: * -> * -> *) k a.
BinomForest (Succ rk) k a -> BinomForest rk k a
Skip forall a b. (a -> b) -> a -> b
$!) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (rk :: * -> * -> *).
Ranky rk -> BinomForest rk k a -> f (BinomForest rk k b)
traverseForest (forall {k} (zero :: k) (succ :: k -> k) (n :: k).
Nattish zero succ n -> Nattish zero succ (succ n)
Succy Ranky rk
rky) BinomForest (Succ rk) k a
rest
    traverseForest !Ranky rk
rky (Cons BinomTree rk k a
t BinomForest (Succ rk) k a
rest) =
      forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\ !BinomTree rk k b
t' !BinomForest (Succ rk) k b
rest' -> forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> BinomForest (Succ rk) k a -> BinomForest rk k a
Cons BinomTree rk k b
t' BinomForest (Succ rk) k b
rest') (forall (rk :: * -> * -> *).
Ranky rk -> BinomTree rk k a -> f (BinomTree rk k b)
traverseTree Ranky rk
rky BinomTree rk k a
t) (forall (rk :: * -> * -> *).
Ranky rk -> BinomForest rk k a -> f (BinomForest rk k b)
traverseForest (forall {k} (zero :: k) (succ :: k -> k) (n :: k).
Nattish zero succ n -> Nattish zero succ (succ n)
Succy Ranky rk
rky) BinomForest (Succ rk) k a
rest)

    {-# INLINE traverseTree #-}
    traverseTree :: Ranky rk -> BinomTree rk k a -> f (BinomTree rk k b)
    traverseTree :: forall (rk :: * -> * -> *).
Ranky rk -> BinomTree rk k a -> f (BinomTree rk k b)
traverseTree Nattish Zero Succ rk
Zeroy (BinomTree k
k (Zero a
a)) =
      -- We've reached a value, so we don't force the result.
      forall (rk :: * -> * -> *) k a. k -> rk k a -> BinomTree rk k a
BinomTree k
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. a -> Zero k a
Zero forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> f b
f k
k a
a
    traverseTree (Succy Nattish Zero Succ n
rky) (BinomTree k
k rk k a
ts) =
      -- We're not at a value, so we force the tree list.
      (forall (rk :: * -> * -> *) k a. k -> rk k a -> BinomTree rk k a
BinomTree k
k forall a b. (a -> b) -> a -> b
$!) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (rk :: * -> * -> *).
Ranky rk -> k -> Succ rk k a -> f (Succ rk k b)
traverseTrees Nattish Zero Succ n
rky k
k rk k a
ts

    traverseTrees :: Ranky rk -> k -> Succ rk k a -> f (Succ rk k b)
    traverseTrees :: forall (rk :: * -> * -> *).
Ranky rk -> k -> Succ rk k a -> f (Succ rk k b)
traverseTrees Nattish Zero Succ rk
Zeroy !k
k2 (Succ (BinomTree k
k1 (Zero a
a1)) (Zero a
a2)) =
      -- The right subtree is a value, so we don't force it.
      forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\b
b1 b
b2 -> forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> rk k a -> Succ rk k a
Succ (forall (rk :: * -> * -> *) k a. k -> rk k a -> BinomTree rk k a
BinomTree k
k1 (forall k a. a -> Zero k a
Zero b
b1)) (forall k a. a -> Zero k a
Zero b
b2)) (k -> a -> f b
f k
k1 a
a1) (k -> a -> f b
f k
k2 a
a2)
    traverseTrees (Succy Nattish Zero Succ n
rky) !k
k (Succ BinomTree rk k a
t rk k a
ts) =
      -- Whew; no values. We're safe to force.
      forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\ !BinomTree rk k b
t' !rk k b
ts' -> forall (rk :: * -> * -> *) k a.
BinomTree rk k a -> rk k a -> Succ rk k a
Succ BinomTree rk k b
t' rk k b
ts') (forall (rk :: * -> * -> *).
Ranky rk -> BinomTree rk k a -> f (BinomTree rk k b)
traverseTree (forall {k} (zero :: k) (succ :: k -> k) (n :: k).
Nattish zero succ n -> Nattish zero succ (succ n)
Succy Nattish Zero Succ n
rky) BinomTree rk k a
t) (forall (rk :: * -> * -> *).
Ranky rk -> k -> Succ rk k a -> f (Succ rk k b)
traverseTrees Nattish Zero Succ n
rky k
k rk k a
ts)

-- | \(O(\log n)\). @seqSpine q r@ forces the spine of @q@ and returns @r@.
--
-- Note: The spine of a 'MinPQueue' is stored somewhat lazily. In earlier
-- versions of this package, some operations could produce chains of thunks
-- along the spine, occasionally necessitating manual forcing. Now, all
-- operations are careful to force enough to avoid this problem.
{-# DEPRECATED seqSpine "This function is no longer necessary or useful." #-}
seqSpine :: MinPQueue k a -> b -> b
seqSpine :: forall k a b. 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 forall (rk :: * -> * -> *) k a b. BinomForest rk k a -> b -> b
`seqSpineF` b
z0 where
  seqSpineF :: BinomForest rk k a -> b -> b
  seqSpineF :: forall (rk :: * -> * -> *) k a b. 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'   -> 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' -> 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 :: forall k a. (NFData k, NFData a) => Zero k a -> ()
rnfRk (Zero a
a) = forall a. NFData a => a -> ()
rnf a
a

instance NFRank rk => NFRank (Succ rk) where
  rnfRk :: forall k a. (NFData k, NFData a) => Succ rk k a -> ()
rnfRk (Succ BinomTree rk k a
t rk k a
ts) = BinomTree rk k a
t forall a b. NFData a => a -> b -> b
`deepseq` 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 rk k a
ts) = k
k forall a b. NFData a => a -> b -> b
`deepseq` 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) = 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 forall a b. NFData a => a -> b -> b
`deepseq` 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 forall a b. NFData a => a -> b -> b
`deepseq` a
a forall a b. NFData a => a -> b -> b
`deepseq` forall a. NFData a => a -> ()
rnf BinomHeap k a
ts

instance Functor (MinPQueue k) where
  fmap :: forall a b. (a -> b) -> MinPQueue k a -> MinPQueue k b
fmap = forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

instance FunctorWithIndex k (MinPQueue k) where
  imap :: forall a b. (k -> a -> b) -> MinPQueue k a -> MinPQueue k b
imap = coerce :: forall a b. Coercible a b => a -> b
coerce
    (forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverseWithKeyU :: (k -> a -> Identity b) -> MinPQueue k a -> Identity (MinPQueue k b))

instance Ord k => Foldable (MinPQueue k) where
  foldr :: forall a b. (a -> b -> b) -> b -> MinPQueue k a -> b
foldr   = forall k a b.
Ord k =>
(k -> a -> b -> b) -> b -> MinPQueue k a -> b
foldrWithKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
  foldl :: forall b a. (b -> a -> b) -> b -> MinPQueue k a -> b
foldl b -> a -> b
f = forall k b a.
Ord k =>
(b -> k -> a -> b) -> b -> MinPQueue k a -> b
foldlWithKey (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a -> b
f)
  length :: forall a. MinPQueue k a -> Int
length = forall k a. MinPQueue k a -> Int
size
  null :: forall a. MinPQueue k a -> Bool
null = forall k a. MinPQueue k a -> Bool
null

instance Ord k => FoldableWithIndex k (MinPQueue k) where
  ifoldr :: forall a b. (k -> a -> b -> b) -> b -> MinPQueue k a -> b
ifoldr   = forall k a b.
Ord k =>
(k -> a -> b -> b) -> b -> MinPQueue k a -> b
foldrWithKey
  ifoldl :: forall b a. (k -> b -> a -> b) -> b -> MinPQueue k a -> b
ifoldl k -> b -> a -> b
f = forall k b a.
Ord k =>
(b -> k -> a -> b) -> b -> MinPQueue k a -> b
foldlWithKey (forall a b c. (a -> b -> c) -> b -> a -> c
flip k -> b -> a -> b
f)

-- | Traverses in ascending order. 'mapM' is strictly accumulating like
-- 'mapMWithKey'.
instance Ord k => Traversable (MinPQueue k) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverse = forall k (f :: * -> *) a b.
(Ord k, Applicative f) =>
(k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverseWithKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
  mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MinPQueue k a -> m (MinPQueue k b)
mapM = forall k (m :: * -> *) a b.
(Ord k, Monad m) =>
(k -> a -> m b) -> MinPQueue k a -> m (MinPQueue k b)
mapMWithKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
  sequence :: forall (m :: * -> *) a.
Monad m =>
MinPQueue k (m a) -> m (MinPQueue k a)
sequence = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. a -> a
id

instance Ord k => TraversableWithIndex k (MinPQueue k) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
itraverse = forall k (f :: * -> *) a b.
(Ord k, Applicative f) =>
(k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverseWithKey