{-# LANGUAGE CPP, StandaloneDeriving #-}
module Data.PQueue.Internals (
MinQueue (..),
BinomHeap,
BinomForest(..),
BinomTree(..),
Succ(..),
Zero(..),
LEq,
empty,
null,
size,
getMin,
minView,
singleton,
insert,
union,
mapMaybe,
mapEither,
mapMonotonic,
foldrAsc,
foldlAsc,
insertMinQ,
foldrU,
foldlU,
keysQueue,
seqSpine
) where
import Control.DeepSeq (NFData(rnf), deepseq)
import qualified Data.PQueue.Prio.Internals as Prio
#ifdef __GLASGOW_HASKELL__
import Data.Data
#endif
import Prelude hiding (null)
data MinQueue a = Empty | MinQueue {-# UNPACK #-} !Int a !(BinomHeap a)
#if __GLASGOW_HASKELL__>=707
deriving Typeable
#else
#include "Typeable.h"
INSTANCE_TYPEABLE1(MinQueue,minQTC,"MinQueue")
#endif
#ifdef __GLASGOW_HASKELL__
instance (Ord a, Data a) => Data (MinQueue a) where
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MinQueue a -> c (MinQueue a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z MinQueue a
q = case MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView MinQueue a
q of
Maybe (a, MinQueue a)
Nothing -> MinQueue a -> c (MinQueue a)
forall g. g -> c g
z MinQueue a
forall a. MinQueue a
Empty
Just (a
x, MinQueue a
q') -> (a -> MinQueue a -> MinQueue a)
-> c (a -> MinQueue a -> MinQueue a)
forall g. g -> c g
z a -> MinQueue a -> MinQueue a
forall a. a -> MinQueue a -> MinQueue a
insertMinQ c (a -> MinQueue a -> MinQueue a)
-> a -> c (MinQueue a -> MinQueue a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` a
x c (MinQueue a -> MinQueue a) -> MinQueue a -> c (MinQueue a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` MinQueue a
q'
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (MinQueue 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 -> MinQueue a -> c (MinQueue a)
forall r. r -> c r
z MinQueue a
forall a. MinQueue a
Empty
Int
2 -> c (MinQueue a -> MinQueue a) -> c (MinQueue a)
forall b r. Data b => c (b -> r) -> c r
k (c (a -> MinQueue a -> MinQueue a) -> c (MinQueue a -> MinQueue a)
forall b r. Data b => c (b -> r) -> c r
k ((a -> MinQueue a -> MinQueue a)
-> c (a -> MinQueue a -> MinQueue a)
forall r. r -> c r
z a -> MinQueue a -> MinQueue a
forall a. a -> MinQueue a -> MinQueue a
insertMinQ))
Int
_ -> [Char] -> c (MinQueue a)
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (MinQueue a))
dataCast1 forall d. Data d => c (t d)
x = c (t a) -> Maybe (c (MinQueue a))
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 c (t a)
forall d. Data d => c (t d)
x
toConstr :: MinQueue a -> Constr
toConstr MinQueue a
q
| MinQueue a -> Bool
forall a. MinQueue a -> Bool
null MinQueue a
q = Constr
emptyConstr
| Bool
otherwise = Constr
consConstr
dataTypeOf :: MinQueue a -> DataType
dataTypeOf MinQueue a
_ = DataType
queueDataType
queueDataType :: DataType
queueDataType :: DataType
queueDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Data.PQueue.Min.MinQueue" [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
type BinomHeap = BinomForest Zero
instance Ord a => Eq (MinQueue a) where
MinQueue a
Empty == :: MinQueue a -> MinQueue a -> Bool
== MinQueue a
Empty = Bool
True
MinQueue Int
n1 a
x1 BinomHeap a
q1 == MinQueue Int
n2 a
x2 BinomHeap a
q2 =
Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n2 Bool -> Bool -> Bool
&& (a, BinomHeap a) -> (a, BinomHeap a) -> Bool
forall a. Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Bool
eqExtract (a
x1,BinomHeap a
q1) (a
x2,BinomHeap a
q2)
MinQueue a
_ == MinQueue a
_ = Bool
False
eqExtract :: Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Bool
(a
x1,BinomHeap a
q1) (a
x2,BinomHeap a
q2) =
a
x1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x2 Bool -> Bool -> Bool
&&
case (BinomHeap a -> Maybe (a, BinomHeap a)
forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
q1, BinomHeap a -> Maybe (a, BinomHeap a)
forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
q2) of
(Just (a, BinomHeap a)
h1, Just (a, BinomHeap a)
h2) -> (a, BinomHeap a) -> (a, BinomHeap a) -> Bool
forall a. Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Bool
eqExtract (a, BinomHeap a)
h1 (a, BinomHeap a)
h2
(Maybe (a, BinomHeap a)
Nothing, Maybe (a, BinomHeap a)
Nothing) -> Bool
True
(Maybe (a, BinomHeap a), Maybe (a, BinomHeap a))
_ -> Bool
False
instance Ord a => Ord (MinQueue a) where
MinQueue a
Empty compare :: MinQueue a -> MinQueue a -> Ordering
`compare` MinQueue a
Empty = Ordering
EQ
MinQueue a
Empty `compare` MinQueue a
_ = Ordering
LT
MinQueue a
_ `compare` MinQueue a
Empty = Ordering
GT
MinQueue Int
_n1 a
x1 BinomHeap a
q1 `compare` MinQueue Int
_n2 a
x2 BinomHeap a
q2 = (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering
forall a. Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering
cmpExtract (a
x1,BinomHeap a
q1) (a
x2,BinomHeap a
q2)
cmpExtract :: Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering
(a
x1,BinomHeap a
q1) (a
x2,BinomHeap a
q2) =
a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x1 a
x2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
case (BinomHeap a -> Maybe (a, BinomHeap a)
forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
q1, BinomHeap a -> Maybe (a, BinomHeap a)
forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
q2) of
(Just (a, BinomHeap a)
h1, Just (a, BinomHeap a)
h2) -> (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering
forall a. Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering
cmpExtract (a, BinomHeap a)
h1 (a, BinomHeap a)
h2
(Maybe (a, BinomHeap a)
Nothing, Maybe (a, BinomHeap a)
Nothing) -> Ordering
EQ
(Just (a, BinomHeap a)
_, Maybe (a, BinomHeap a)
Nothing) -> Ordering
GT
(Maybe (a, BinomHeap a)
Nothing, Just (a, BinomHeap a)
_) -> Ordering
LT
data BinomForest rk a = Nil | Skip (BinomForest (Succ rk) a) |
Cons {-# UNPACK #-} !(BinomTree rk a) (BinomForest (Succ rk) a)
data BinomTree rk a = BinomTree a (rk a)
data Succ rk a = Succ {-# UNPACK #-} !(BinomTree rk a) (rk a)
data Zero a = Zero
type LEq a = a -> a -> Bool
empty :: MinQueue a
empty :: MinQueue a
empty = MinQueue a
forall a. MinQueue a
Empty
null :: MinQueue a -> Bool
null :: MinQueue a -> Bool
null MinQueue a
Empty = Bool
True
null MinQueue a
_ = Bool
False
size :: MinQueue a -> Int
size :: MinQueue a -> Int
size MinQueue a
Empty = Int
0
size (MinQueue Int
n a
_ BinomHeap a
_) = Int
n
getMin :: MinQueue a -> Maybe a
getMin :: MinQueue a -> Maybe a
getMin (MinQueue Int
_ a
x BinomHeap a
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
getMin MinQueue a
_ = Maybe a
forall a. Maybe a
Nothing
minView :: Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView :: MinQueue a -> Maybe (a, MinQueue a)
minView MinQueue a
Empty = Maybe (a, MinQueue a)
forall a. Maybe a
Nothing
minView (MinQueue Int
n a
x BinomHeap a
ts) = (a, MinQueue a) -> Maybe (a, MinQueue a)
forall a. a -> Maybe a
Just (a
x, case BinomHeap a -> Maybe (a, BinomHeap a)
forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
ts of
Maybe (a, BinomHeap a)
Nothing -> MinQueue a
forall a. MinQueue a
Empty
Just (a
x', BinomHeap a
ts') -> Int -> a -> BinomHeap a -> MinQueue a
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
x' BinomHeap a
ts')
singleton :: a -> MinQueue a
singleton :: a -> MinQueue a
singleton a
x = Int -> a -> BinomHeap a -> MinQueue a
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue Int
1 a
x BinomHeap a
forall (rk :: * -> *) a. BinomForest rk a
Nil
insert :: Ord a => a -> MinQueue a -> MinQueue a
insert :: a -> MinQueue a -> MinQueue a
insert = LEq a -> a -> MinQueue a -> MinQueue a
forall a. LEq a -> a -> MinQueue a -> MinQueue a
insert' LEq a
forall a. Ord a => a -> a -> Bool
(<=)
union :: Ord a => MinQueue a -> MinQueue a -> MinQueue a
union :: MinQueue a -> MinQueue a -> MinQueue a
union = LEq a -> MinQueue a -> MinQueue a -> MinQueue a
forall a. LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq a
forall a. Ord a => a -> a -> Bool
(<=)
mapMaybe :: Ord b => (a -> Maybe b) -> MinQueue a -> MinQueue b
mapMaybe :: (a -> Maybe b) -> MinQueue a -> MinQueue b
mapMaybe a -> Maybe b
_ MinQueue a
Empty = MinQueue b
forall a. MinQueue a
Empty
mapMaybe a -> Maybe b
f (MinQueue Int
_ a
x BinomHeap a
ts) = MinQueue b -> (b -> MinQueue b) -> Maybe b -> MinQueue b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MinQueue b
q' (b -> MinQueue b -> MinQueue b
forall a. Ord a => a -> MinQueue a -> MinQueue a
`insert` MinQueue b
q') (a -> Maybe b
f a
x)
where
q' :: MinQueue b
q' = (a -> Maybe b)
-> LEq b
-> (Zero a -> MinQueue b)
-> MinQueue b
-> BinomHeap a
-> MinQueue b
forall a b (rk :: * -> *).
(a -> Maybe b)
-> LEq b
-> (rk a -> MinQueue b)
-> MinQueue b
-> BinomForest rk a
-> MinQueue b
mapMaybeQueue a -> Maybe b
f LEq b
forall a. Ord a => a -> a -> Bool
(<=) (MinQueue b -> Zero a -> MinQueue b
forall a b. a -> b -> a
const MinQueue b
forall a. MinQueue a
Empty) MinQueue b
forall a. MinQueue a
Empty BinomHeap a
ts
mapEither :: (Ord b, Ord c) => (a -> Either b c) -> MinQueue a -> (MinQueue b, MinQueue c)
mapEither :: (a -> Either b c) -> MinQueue a -> (MinQueue b, MinQueue c)
mapEither a -> Either b c
_ MinQueue a
Empty = (MinQueue b
forall a. MinQueue a
Empty, MinQueue c
forall a. MinQueue a
Empty)
mapEither a -> Either b c
f (MinQueue Int
_ a
x BinomHeap a
ts) = case ((a -> Either b c)
-> LEq b
-> LEq c
-> (Zero a -> (MinQueue b, MinQueue c))
-> (MinQueue b, MinQueue c)
-> BinomHeap a
-> (MinQueue b, MinQueue c)
forall a b c (rk :: * -> *).
(a -> Either b c)
-> LEq b
-> LEq c
-> (rk a -> Partition b c)
-> Partition b c
-> BinomForest rk a
-> Partition b c
mapEitherQueue a -> Either b c
f LEq b
forall a. Ord a => a -> a -> Bool
(<=) LEq c
forall a. Ord a => a -> a -> Bool
(<=) ((MinQueue b, MinQueue c) -> Zero a -> (MinQueue b, MinQueue c)
forall a b. a -> b -> a
const (MinQueue b
forall a. MinQueue a
Empty, MinQueue c
forall a. MinQueue a
Empty)) (MinQueue b
forall a. MinQueue a
Empty, MinQueue c
forall a. MinQueue a
Empty) BinomHeap a
ts, a -> Either b c
f a
x) of
((MinQueue b
qL, MinQueue c
qR), Left b
b) -> (b -> MinQueue b -> MinQueue b
forall a. Ord a => a -> MinQueue a -> MinQueue a
insert b
b MinQueue b
qL, MinQueue c
qR)
((MinQueue b
qL, MinQueue c
qR), Right c
c) -> (MinQueue b
qL, c -> MinQueue c -> MinQueue c
forall a. Ord a => a -> MinQueue a -> MinQueue a
insert c
c MinQueue c
qR)
mapMonotonic :: (a -> b) -> MinQueue a -> MinQueue b
mapMonotonic :: (a -> b) -> MinQueue a -> MinQueue b
mapMonotonic = (a -> b) -> MinQueue a -> MinQueue b
forall a b. (a -> b) -> MinQueue a -> MinQueue b
mapU
{-# INLINE foldrAsc #-}
foldrAsc :: Ord a => (a -> b -> b) -> b -> MinQueue a -> b
foldrAsc :: (a -> b -> b) -> b -> MinQueue a -> b
foldrAsc a -> b -> b
_ b
z MinQueue a
Empty = b
z
foldrAsc a -> b -> b
f b
z (MinQueue Int
_ a
x BinomHeap a
ts) = a
x a -> b -> b
`f` (a -> b -> b)
-> b -> (BinomHeap a -> Maybe (a, BinomHeap a)) -> BinomHeap a -> b
forall a c b. (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldrUnfold a -> b -> b
f b
z BinomHeap a -> Maybe (a, BinomHeap a)
forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
ts
{-# INLINE foldrUnfold #-}
foldrUnfold :: (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldrUnfold :: (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldrUnfold a -> c -> c
f c
z b -> Maybe (a, b)
suc b
s0 = b -> c
unf b
s0 where
unf :: b -> c
unf b
s = case b -> Maybe (a, b)
suc b
s of
Maybe (a, b)
Nothing -> c
z
Just (a
x, b
s') -> a
x a -> c -> c
`f` b -> c
unf b
s'
foldlAsc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b
foldlAsc :: (b -> a -> b) -> b -> MinQueue a -> b
foldlAsc b -> a -> b
_ b
z MinQueue a
Empty = b
z
foldlAsc b -> a -> b
f b
z (MinQueue Int
_ a
x BinomHeap a
ts) = (b -> a -> b)
-> b -> (BinomHeap a -> Maybe (a, BinomHeap a)) -> BinomHeap a -> b
forall c a b. (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldlUnfold b -> a -> b
f (b
z b -> a -> b
`f` a
x) BinomHeap a -> Maybe (a, BinomHeap a)
forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
ts
{-# INLINE foldlUnfold #-}
foldlUnfold :: (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldlUnfold :: (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldlUnfold c -> a -> c
f c
z0 b -> Maybe (a, b)
suc b
s0 = c -> b -> c
unf c
z0 b
s0 where
unf :: c -> b -> c
unf c
z b
s = case b -> Maybe (a, b)
suc b
s of
Maybe (a, b)
Nothing -> c
z
Just (a
x, b
s') -> c -> b -> c
unf (c
z c -> a -> c
`f` a
x) b
s'
insert' :: LEq a -> a -> MinQueue a -> MinQueue a
insert' :: LEq a -> a -> MinQueue a -> MinQueue a
insert' LEq a
_ a
x MinQueue a
Empty = a -> MinQueue a
forall a. a -> MinQueue a
singleton a
x
insert' LEq a
le a
x (MinQueue Int
n a
x' BinomHeap a
ts)
| a
x LEq a
`le` a
x' = Int -> a -> BinomHeap a -> MinQueue a
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x (LEq a -> BinomTree Zero a -> BinomHeap a -> BinomHeap a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr LEq a
le (a -> BinomTree Zero a
forall a. a -> BinomTree Zero a
tip a
x') BinomHeap a
ts)
| Bool
otherwise = Int -> a -> BinomHeap a -> MinQueue a
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x' (LEq a -> BinomTree Zero a -> BinomHeap a -> BinomHeap a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr LEq a
le (a -> BinomTree Zero a
forall a. a -> BinomTree Zero a
tip a
x) BinomHeap a
ts)
{-# INLINE union' #-}
union' :: LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' :: LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq a
_ MinQueue a
Empty MinQueue a
q = MinQueue a
q
union' LEq a
_ MinQueue a
q MinQueue a
Empty = MinQueue a
q
union' LEq a
le (MinQueue Int
n1 a
x1 BinomHeap a
f1) (MinQueue Int
n2 a
x2 BinomHeap a
f2)
| a
x1 LEq a
`le` a
x2 = Int -> a -> BinomHeap a -> MinQueue a
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue (Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2) a
x1 (LEq a
-> BinomTree Zero a -> BinomHeap a -> BinomHeap a -> BinomHeap a
forall a (rk :: * -> *).
LEq a
-> BinomTree rk a
-> BinomForest rk a
-> BinomForest rk a
-> BinomForest rk a
carry LEq a
le (a -> BinomTree Zero a
forall a. a -> BinomTree Zero a
tip a
x2) BinomHeap a
f1 BinomHeap a
f2)
| Bool
otherwise = Int -> a -> BinomHeap a -> MinQueue a
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue (Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2) a
x2 (LEq a
-> BinomTree Zero a -> BinomHeap a -> BinomHeap a -> BinomHeap a
forall a (rk :: * -> *).
LEq a
-> BinomTree rk a
-> BinomForest rk a
-> BinomForest rk a
-> BinomForest rk a
carry LEq a
le (a -> BinomTree Zero a
forall a. a -> BinomTree Zero a
tip a
x1) BinomHeap a
f1 BinomHeap a
f2)
extractHeap :: Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
BinomHeap a
ts = case LEq a -> BinomHeap a -> MExtract Zero a
forall a (rk :: * -> *). LEq a -> BinomForest rk a -> MExtract rk a
extractBin LEq a
forall a. Ord a => a -> a -> Bool
(<=) BinomHeap a
ts of
Yes (Extract a
x Zero a
_ BinomHeap a
ts') -> (a, BinomHeap a) -> Maybe (a, BinomHeap a)
forall a. a -> Maybe a
Just (a
x, BinomHeap a
ts')
MExtract Zero a
_ -> Maybe (a, BinomHeap a)
forall a. Maybe a
Nothing
data rk a = a (rk a) (BinomForest rk a)
data rk a = No | Yes {-# UNPACK #-} !(Extract rk a)
incrExtract :: Extract (Succ rk) a -> Extract rk a
(Extract a
minKey (Succ BinomTree rk a
kChild rk a
kChildren) BinomForest (Succ rk) a
ts)
= a -> rk a -> BinomForest rk a -> Extract rk a
forall (rk :: * -> *) a.
a -> rk a -> BinomForest rk a -> Extract rk a
Extract a
minKey rk a
kChildren (BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
kChild BinomForest (Succ rk) a
ts)
incrExtract' :: LEq a -> BinomTree rk a -> Extract (Succ rk) a -> Extract rk a
LEq a
le BinomTree rk a
t (Extract a
minKey (Succ BinomTree rk a
kChild rk a
kChildren) BinomForest (Succ rk) a
ts)
= a -> rk a -> BinomForest rk a -> Extract rk a
forall (rk :: * -> *) a.
a -> rk a -> BinomForest rk a -> Extract rk a
Extract a
minKey rk a
kChildren (BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (LEq a
-> BinomTree (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr LEq a
le (BinomTree rk a
t BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall (rk :: * -> *).
BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
`cat` BinomTree rk a
kChild) BinomForest (Succ rk) a
ts))
where
cat :: BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
cat = LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
joinBin LEq a
le
extractBin :: LEq a -> BinomForest rk a -> MExtract rk a
LEq a
_ BinomForest rk a
Nil = MExtract rk a
forall (rk :: * -> *) a. MExtract rk a
No
extractBin LEq a
le (Skip BinomForest (Succ rk) a
f) = case LEq a -> BinomForest (Succ rk) a -> MExtract (Succ rk) a
forall a (rk :: * -> *). LEq a -> BinomForest rk a -> MExtract rk a
extractBin LEq a
le BinomForest (Succ rk) a
f of
Yes Extract (Succ rk) a
ex -> Extract rk a -> MExtract rk a
forall (rk :: * -> *) a. Extract rk a -> MExtract rk a
Yes (Extract (Succ rk) a -> Extract rk a
forall (rk :: * -> *) a. Extract (Succ rk) a -> Extract rk a
incrExtract Extract (Succ rk) a
ex)
MExtract (Succ rk) a
No -> MExtract rk a
forall (rk :: * -> *) a. MExtract rk a
No
extractBin LEq a
le (Cons t :: BinomTree rk a
t@(BinomTree a
x rk a
ts) BinomForest (Succ rk) a
f) = Extract rk a -> MExtract rk a
forall (rk :: * -> *) a. Extract rk a -> MExtract rk a
Yes (Extract rk a -> MExtract rk a) -> Extract rk a -> MExtract rk a
forall a b. (a -> b) -> a -> b
$ case LEq a -> BinomForest (Succ rk) a -> MExtract (Succ rk) a
forall a (rk :: * -> *). LEq a -> BinomForest rk a -> MExtract rk a
extractBin LEq a
le BinomForest (Succ rk) a
f of
Yes ex :: Extract (Succ rk) a
ex@(Extract a
minKey Succ rk a
_ BinomForest (Succ rk) a
_)
| a
minKey LEq a
`lt` a
x -> LEq a -> BinomTree rk a -> Extract (Succ rk) a -> Extract rk a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> Extract (Succ rk) a -> Extract rk a
incrExtract' LEq a
le BinomTree rk a
t Extract (Succ rk) a
ex
MExtract (Succ rk) a
_ -> a -> rk a -> BinomForest rk a -> Extract rk a
forall (rk :: * -> *) a.
a -> rk a -> BinomForest rk a -> Extract rk a
Extract a
x rk a
ts (BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip BinomForest (Succ rk) a
f)
where a
a lt :: LEq a
`lt` a
b = Bool -> Bool
not (a
b LEq a
`le` a
a)
mapMaybeQueue :: (a -> Maybe b) -> LEq b -> (rk a -> MinQueue b) -> MinQueue b -> BinomForest rk a -> MinQueue b
mapMaybeQueue :: (a -> Maybe b)
-> LEq b
-> (rk a -> MinQueue b)
-> MinQueue b
-> BinomForest rk a
-> MinQueue b
mapMaybeQueue a -> Maybe b
f LEq b
le rk a -> MinQueue b
fCh MinQueue b
q0 BinomForest rk a
forest = MinQueue b
q0 MinQueue b -> MinQueue b -> MinQueue b
`seq` case BinomForest rk a
forest of
BinomForest rk a
Nil -> MinQueue b
q0
Skip BinomForest (Succ rk) a
forest' -> (a -> Maybe b)
-> LEq b
-> (Succ rk a -> MinQueue b)
-> MinQueue b
-> BinomForest (Succ rk) a
-> MinQueue b
forall a b (rk :: * -> *).
(a -> Maybe b)
-> LEq b
-> (rk a -> MinQueue b)
-> MinQueue b
-> BinomForest rk a
-> MinQueue b
mapMaybeQueue a -> Maybe b
f LEq b
le Succ rk a -> MinQueue b
fCh' MinQueue b
q0 BinomForest (Succ rk) a
forest'
Cons BinomTree rk a
t BinomForest (Succ rk) a
forest' -> (a -> Maybe b)
-> LEq b
-> (Succ rk a -> MinQueue b)
-> MinQueue b
-> BinomForest (Succ rk) a
-> MinQueue b
forall a b (rk :: * -> *).
(a -> Maybe b)
-> LEq b
-> (rk a -> MinQueue b)
-> MinQueue b
-> BinomForest rk a
-> MinQueue b
mapMaybeQueue a -> Maybe b
f LEq b
le Succ rk a -> MinQueue b
fCh' (LEq b -> MinQueue b -> MinQueue b -> MinQueue b
forall a. LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq b
le (BinomTree rk a -> MinQueue b
mapMaybeT BinomTree rk a
t) MinQueue b
q0) BinomForest (Succ rk) a
forest'
where fCh' :: Succ rk a -> MinQueue b
fCh' (Succ BinomTree rk a
t rk a
tss) = LEq b -> MinQueue b -> MinQueue b -> MinQueue b
forall a. LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq b
le (BinomTree rk a -> MinQueue b
mapMaybeT BinomTree rk a
t) (rk a -> MinQueue b
fCh rk a
tss)
mapMaybeT :: BinomTree rk a -> MinQueue b
mapMaybeT (BinomTree a
x0 rk a
ts) = MinQueue b -> (b -> MinQueue b) -> Maybe b -> MinQueue b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (rk a -> MinQueue b
fCh rk a
ts) (\b
x -> LEq b -> b -> MinQueue b -> MinQueue b
forall a. LEq a -> a -> MinQueue a -> MinQueue a
insert' LEq b
le b
x (rk a -> MinQueue b
fCh rk a
ts)) (a -> Maybe b
f a
x0)
type Partition a b = (MinQueue a, MinQueue b)
mapEitherQueue :: (a -> Either b c) -> LEq b -> LEq c -> (rk a -> Partition b c) -> Partition b c ->
BinomForest rk a -> Partition b c
mapEitherQueue :: (a -> Either b c)
-> LEq b
-> LEq c
-> (rk a -> Partition b c)
-> Partition b c
-> BinomForest rk a
-> Partition b c
mapEitherQueue a -> Either b c
f0 LEq b
leB LEq c
leC rk a -> Partition b c
fCh (MinQueue b
q00, MinQueue c
q10) BinomForest rk a
ts0 = MinQueue b
q00 MinQueue b -> Partition b c -> Partition b c
`seq` MinQueue c
q10 MinQueue c -> Partition b c -> Partition b c
`seq` case BinomForest rk a
ts0 of
BinomForest rk a
Nil -> (MinQueue b
q00, MinQueue c
q10)
Skip BinomForest (Succ rk) a
ts' -> (a -> Either b c)
-> LEq b
-> LEq c
-> (Succ rk a -> Partition b c)
-> Partition b c
-> BinomForest (Succ rk) a
-> Partition b c
forall a b c (rk :: * -> *).
(a -> Either b c)
-> LEq b
-> LEq c
-> (rk a -> Partition b c)
-> Partition b c
-> BinomForest rk a
-> Partition b c
mapEitherQueue a -> Either b c
f0 LEq b
leB LEq c
leC Succ rk a -> Partition b c
fCh' (MinQueue b
q00, MinQueue c
q10) BinomForest (Succ rk) a
ts'
Cons BinomTree rk a
t BinomForest (Succ rk) a
ts' -> (a -> Either b c)
-> LEq b
-> LEq c
-> (Succ rk a -> Partition b c)
-> Partition b c
-> BinomForest (Succ rk) a
-> Partition b c
forall a b c (rk :: * -> *).
(a -> Either b c)
-> LEq b
-> LEq c
-> (rk a -> Partition b c)
-> Partition b c
-> BinomForest rk a
-> Partition b c
mapEitherQueue a -> Either b c
f0 LEq b
leB LEq c
leC Succ rk a -> Partition b c
fCh' ((MinQueue b -> MinQueue b -> MinQueue b)
-> (MinQueue c -> MinQueue c -> MinQueue c)
-> Partition b c
-> Partition b c
-> Partition b c
forall t t a t t b.
(t -> t -> a) -> (t -> t -> b) -> (t, t) -> (t, t) -> (a, b)
both (LEq b -> MinQueue b -> MinQueue b -> MinQueue b
forall a. LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq b
leB) (LEq c -> MinQueue c -> MinQueue c -> MinQueue c
forall a. LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq c
leC) (BinomTree rk a -> Partition b c
partitionT BinomTree rk a
t) (MinQueue b
q00, MinQueue c
q10)) BinomForest (Succ rk) a
ts'
where 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)
fCh' :: Succ rk a -> Partition b c
fCh' (Succ BinomTree rk a
t rk a
tss) = (MinQueue b -> MinQueue b -> MinQueue b)
-> (MinQueue c -> MinQueue c -> MinQueue c)
-> Partition b c
-> Partition b c
-> Partition b c
forall t t a t t b.
(t -> t -> a) -> (t -> t -> b) -> (t, t) -> (t, t) -> (a, b)
both (LEq b -> MinQueue b -> MinQueue b -> MinQueue b
forall a. LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq b
leB) (LEq c -> MinQueue c -> MinQueue c -> MinQueue c
forall a. LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq c
leC) (BinomTree rk a -> Partition b c
partitionT BinomTree rk a
t) (rk a -> Partition b c
fCh rk a
tss)
partitionT :: BinomTree rk a -> Partition b c
partitionT (BinomTree a
x rk a
ts) = case rk a -> Partition b c
fCh rk a
ts of
(MinQueue b
q0, MinQueue c
q1) -> case a -> Either b c
f0 a
x of
Left b
b -> (LEq b -> b -> MinQueue b -> MinQueue b
forall a. LEq a -> a -> MinQueue a -> MinQueue a
insert' LEq b
leB b
b MinQueue b
q0, MinQueue c
q1)
Right c
c -> (MinQueue b
q0, LEq c -> c -> MinQueue c -> MinQueue c
forall a. LEq a -> a -> MinQueue a -> MinQueue a
insert' LEq c
leC c
c MinQueue c
q1)
{-# INLINE tip #-}
tip :: a -> BinomTree Zero a
tip :: a -> BinomTree Zero a
tip a
x = a -> Zero a -> BinomTree Zero a
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree a
x Zero a
forall a. Zero a
Zero
insertMinQ :: a -> MinQueue a -> MinQueue a
insertMinQ :: a -> MinQueue a -> MinQueue a
insertMinQ a
x MinQueue a
Empty = a -> MinQueue a
forall a. a -> MinQueue a
singleton a
x
insertMinQ a
x (MinQueue Int
n a
x' BinomHeap a
f) = Int -> a -> BinomHeap a -> MinQueue a
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x (BinomTree Zero a -> BinomHeap a -> BinomHeap a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin (a -> BinomTree Zero a
forall a. a -> BinomTree Zero a
tip a
x') BinomHeap a
f)
insertMin :: BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin :: BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin BinomTree rk a
t BinomForest rk a
Nil = BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t BinomForest (Succ rk) a
forall (rk :: * -> *) a. BinomForest rk a
Nil
insertMin BinomTree rk a
t (Skip BinomForest (Succ rk) a
f) = BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t BinomForest (Succ rk) a
f
insertMin (BinomTree a
x rk a
ts) (Cons BinomTree rk a
t' BinomForest (Succ rk) a
f) = BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (BinomTree (Succ rk) a
-> BinomForest (Succ rk) a -> BinomForest (Succ rk) a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin (a -> Succ rk a -> BinomTree (Succ rk) a
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree a
x (BinomTree rk a -> rk a -> Succ rk a
forall (rk :: * -> *) a. BinomTree rk a -> rk a -> Succ rk a
Succ BinomTree rk a
t' rk a
ts)) BinomForest (Succ rk) a
f)
merge :: LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge :: LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge LEq a
le BinomForest rk a
f1 BinomForest rk a
f2 = case (BinomForest rk a
f1, BinomForest rk a
f2) of
(Skip BinomForest (Succ rk) a
f1', Skip BinomForest (Succ rk) a
f2') -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (LEq a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge LEq a
le BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
(Skip BinomForest (Succ rk) a
f1', Cons BinomTree rk a
t2 BinomForest (Succ rk) a
f2') -> BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t2 (LEq a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge LEq a
le BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
(Cons BinomTree rk a
t1 BinomForest (Succ rk) a
f1', Skip BinomForest (Succ rk) a
f2') -> BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t1 (LEq a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge LEq a
le BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
(Cons BinomTree rk a
t1 BinomForest (Succ rk) a
f1', Cons BinomTree rk a
t2 BinomForest (Succ rk) a
f2')
-> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (LEq a
-> BinomTree (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a
-> BinomTree rk a
-> BinomForest rk a
-> BinomForest rk a
-> BinomForest rk a
carry LEq a
le (BinomTree rk a
t1 BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall (rk :: * -> *).
BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
`cat` BinomTree rk a
t2) BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
(BinomForest rk a
Nil, BinomForest rk a
_) -> BinomForest rk a
f2
(BinomForest rk a
_, BinomForest rk a
Nil) -> BinomForest rk a
f1
where cat :: BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
cat = LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
joinBin LEq a
le
carry :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
carry :: LEq a
-> BinomTree rk a
-> BinomForest rk a
-> BinomForest rk a
-> BinomForest rk a
carry LEq a
le BinomTree rk a
t0 BinomForest rk a
f1 BinomForest rk a
f2 = BinomTree rk a
t0 BinomTree rk a -> BinomForest rk a -> BinomForest rk a
`seq` case (BinomForest rk a
f1, BinomForest rk a
f2) of
(Skip BinomForest (Succ rk) a
f1', Skip BinomForest (Succ rk) a
f2') -> BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t0 (LEq a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge LEq a
le BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
(Skip BinomForest (Succ rk) a
f1', Cons BinomTree rk a
t2 BinomForest (Succ rk) a
f2') -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (BinomTree rk a
-> BinomTree rk a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall (rk :: * -> *).
BinomTree rk a
-> BinomTree rk a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
mergeCarry BinomTree rk a
t0 BinomTree rk a
t2 BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
(Cons BinomTree rk a
t1 BinomForest (Succ rk) a
f1', Skip BinomForest (Succ rk) a
f2') -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (BinomTree rk a
-> BinomTree rk a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall (rk :: * -> *).
BinomTree rk a
-> BinomTree rk a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
mergeCarry BinomTree rk a
t0 BinomTree rk a
t1 BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
(Cons BinomTree rk a
t1 BinomForest (Succ rk) a
f1', Cons BinomTree rk a
t2 BinomForest (Succ rk) a
f2')
-> BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t0 (BinomTree rk a
-> BinomTree rk a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall (rk :: * -> *).
BinomTree rk a
-> BinomTree rk a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
mergeCarry BinomTree rk a
t1 BinomTree rk a
t2 BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
(BinomForest rk a
Nil, BinomForest rk a
_f2) -> LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr LEq a
le BinomTree rk a
t0 BinomForest rk a
f2
(BinomForest rk a
_f1, BinomForest rk a
Nil) -> LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr LEq a
le BinomTree rk a
t0 BinomForest rk a
f1
where cat :: BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
cat = LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
joinBin LEq a
le
mergeCarry :: BinomTree rk a
-> BinomTree rk a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
mergeCarry BinomTree rk a
tA BinomTree rk a
tB = LEq a
-> BinomTree (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a
-> BinomTree rk a
-> BinomForest rk a
-> BinomForest rk a
-> BinomForest rk a
carry LEq a
le (BinomTree rk a
tA BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall (rk :: * -> *).
BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
`cat` BinomTree rk a
tB)
incr :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr LEq a
le BinomTree rk a
t BinomForest rk a
f0 = BinomTree rk a
t BinomTree rk a -> BinomForest rk a -> BinomForest rk a
`seq` case BinomForest rk a
f0 of
BinomForest rk a
Nil -> BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t BinomForest (Succ rk) a
forall (rk :: * -> *) a. BinomForest rk a
Nil
Skip BinomForest (Succ rk) a
f -> BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t BinomForest (Succ rk) a
f
Cons BinomTree rk a
t' BinomForest (Succ rk) a
f' -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (LEq a
-> BinomTree (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr LEq a
le (BinomTree rk a
t BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall (rk :: * -> *).
BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
`cat` BinomTree rk a
t') BinomForest (Succ rk) a
f')
where cat :: BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
cat = LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
joinBin LEq a
le
joinBin :: LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
joinBin :: LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
joinBin LEq a
le t1 :: BinomTree rk a
t1@(BinomTree a
x1 rk a
ts1) t2 :: BinomTree rk a
t2@(BinomTree a
x2 rk a
ts2)
| a
x1 LEq a
`le` a
x2 = a -> Succ rk a -> BinomTree (Succ rk) a
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree a
x1 (BinomTree rk a -> rk a -> Succ rk a
forall (rk :: * -> *) a. BinomTree rk a -> rk a -> Succ rk a
Succ BinomTree rk a
t2 rk a
ts1)
| Bool
otherwise = a -> Succ rk a -> BinomTree (Succ rk) a
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree a
x2 (BinomTree rk a -> rk a -> Succ rk a
forall (rk :: * -> *) a. BinomTree rk a -> rk a -> Succ rk a
Succ BinomTree rk a
t1 rk a
ts2)
instance Functor Zero where
fmap :: (a -> b) -> Zero a -> Zero b
fmap a -> b
_ Zero a
_ = Zero b
forall a. Zero a
Zero
instance Functor rk => Functor (Succ rk) where
fmap :: (a -> b) -> Succ rk a -> Succ rk b
fmap a -> b
f (Succ BinomTree rk a
t rk a
ts) = BinomTree rk b -> rk b -> Succ rk b
forall (rk :: * -> *) a. BinomTree rk a -> rk a -> Succ rk a
Succ ((a -> b) -> BinomTree rk a -> BinomTree rk b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BinomTree rk a
t) ((a -> b) -> rk a -> rk b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f rk a
ts)
instance Functor rk => Functor (BinomTree rk) where
fmap :: (a -> b) -> BinomTree rk a -> BinomTree rk b
fmap a -> b
f (BinomTree a
x rk a
ts) = b -> rk b -> BinomTree rk b
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree (a -> b
f a
x) ((a -> b) -> rk a -> rk b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f rk a
ts)
instance Functor rk => Functor (BinomForest rk) where
fmap :: (a -> b) -> BinomForest rk a -> BinomForest rk b
fmap a -> b
_ BinomForest rk a
Nil = BinomForest rk b
forall (rk :: * -> *) a. BinomForest rk a
Nil
fmap a -> b
f (Skip BinomForest (Succ rk) a
ts) = BinomForest (Succ rk) b -> BinomForest rk b
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip ((a -> b) -> BinomForest (Succ rk) a -> BinomForest (Succ rk) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BinomForest (Succ rk) a
ts)
fmap a -> b
f (Cons BinomTree rk a
t BinomForest (Succ rk) a
ts) = BinomTree rk b -> BinomForest (Succ rk) b -> BinomForest rk b
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons ((a -> b) -> BinomTree rk a -> BinomTree rk b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BinomTree rk a
t) ((a -> b) -> BinomForest (Succ rk) a -> BinomForest (Succ rk) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BinomForest (Succ rk) a
ts)
instance Foldable Zero where
foldr :: (a -> b -> b) -> b -> Zero a -> b
foldr a -> b -> b
_ b
z Zero a
_ = b
z
foldl :: (b -> a -> b) -> b -> Zero a -> b
foldl b -> a -> b
_ b
z Zero a
_ = b
z
instance Foldable rk => Foldable (Succ rk) where
foldr :: (a -> b -> b) -> b -> Succ rk a -> b
foldr a -> b -> b
f b
z (Succ BinomTree rk a
t rk a
ts) = (a -> b -> b) -> b -> BinomTree rk a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f ((a -> b -> b) -> b -> rk a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z rk a
ts) BinomTree rk a
t
foldl :: (b -> a -> b) -> b -> Succ rk a -> b
foldl b -> a -> b
f b
z (Succ BinomTree rk a
t rk a
ts) = (b -> a -> b) -> b -> rk a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f ((b -> a -> b) -> b -> BinomTree rk a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z BinomTree rk a
t) rk a
ts
instance Foldable rk => Foldable (BinomTree rk) where
foldr :: (a -> b -> b) -> b -> BinomTree rk a -> b
foldr a -> b -> b
f b
z (BinomTree a
x rk a
ts) = a
x a -> b -> b
`f` (a -> b -> b) -> b -> rk a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z rk a
ts
foldl :: (b -> a -> b) -> b -> BinomTree rk a -> b
foldl b -> a -> b
f b
z (BinomTree a
x rk a
ts) = (b -> a -> b) -> b -> rk a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f (b
z b -> a -> b
`f` a
x) rk a
ts
instance Foldable rk => Foldable (BinomForest rk) where
foldr :: (a -> b -> b) -> b -> BinomForest rk a -> b
foldr a -> b -> b
_ b
z BinomForest rk a
Nil = b
z
foldr a -> b -> b
f b
z (Skip BinomForest (Succ rk) a
tss) = (a -> b -> b) -> b -> BinomForest (Succ rk) a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z BinomForest (Succ rk) a
tss
foldr a -> b -> b
f b
z (Cons BinomTree rk a
t BinomForest (Succ rk) a
tss) = (a -> b -> b) -> b -> BinomTree rk a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f ((a -> b -> b) -> b -> BinomForest (Succ rk) a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z BinomForest (Succ rk) a
tss) BinomTree rk a
t
foldl :: (b -> a -> b) -> b -> BinomForest rk a -> b
foldl b -> a -> b
_ b
z BinomForest rk a
Nil = b
z
foldl b -> a -> b
f b
z (Skip BinomForest (Succ rk) a
tss) = (b -> a -> b) -> b -> BinomForest (Succ rk) a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z BinomForest (Succ rk) a
tss
foldl b -> a -> b
f b
z (Cons BinomTree rk a
t BinomForest (Succ rk) a
tss) = (b -> a -> b) -> b -> BinomForest (Succ rk) a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f ((b -> a -> b) -> b -> BinomTree rk a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z BinomTree rk a
t) BinomForest (Succ rk) a
tss
mapU :: (a -> b) -> MinQueue a -> MinQueue b
mapU :: (a -> b) -> MinQueue a -> MinQueue b
mapU a -> b
_ MinQueue a
Empty = MinQueue b
forall a. MinQueue a
Empty
mapU a -> b
f (MinQueue Int
n a
x BinomHeap a
ts) = Int -> b -> BinomHeap b -> MinQueue b
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue Int
n (a -> b
f a
x) (a -> b
f (a -> b) -> BinomHeap a -> BinomHeap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinomHeap a
ts)
foldrU :: (a -> b -> b) -> b -> MinQueue a -> b
foldrU :: (a -> b -> b) -> b -> MinQueue a -> b
foldrU a -> b -> b
_ b
z MinQueue a
Empty = b
z
foldrU a -> b -> b
f b
z (MinQueue Int
_ a
x BinomHeap a
ts) = a
x a -> b -> b
`f` (a -> b -> b) -> b -> BinomHeap a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z BinomHeap a
ts
foldlU :: (b -> a -> b) -> b -> MinQueue a -> b
foldlU :: (b -> a -> b) -> b -> MinQueue a -> b
foldlU b -> a -> b
_ b
z MinQueue a
Empty = b
z
foldlU b -> a -> b
f b
z (MinQueue Int
_ a
x BinomHeap a
ts) = (b -> a -> b) -> b -> BinomHeap a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f (b
z b -> a -> b
`f` a
x) BinomHeap a
ts
seqSpine :: MinQueue a -> b -> b
seqSpine :: MinQueue a -> b -> b
seqSpine MinQueue a
Empty b
z = b
z
seqSpine (MinQueue Int
_ a
_ BinomHeap a
ts) b
z = BinomHeap a -> b -> b
forall (rk :: * -> *) a b. BinomForest rk a -> b -> b
seqSpineF BinomHeap a
ts b
z
seqSpineF :: BinomForest rk a -> b -> b
seqSpineF :: BinomForest rk a -> b -> b
seqSpineF BinomForest rk a
Nil b
z = b
z
seqSpineF (Skip BinomForest (Succ rk) a
ts') b
z = BinomForest (Succ rk) a -> b -> b
forall (rk :: * -> *) a b. BinomForest rk a -> b -> b
seqSpineF BinomForest (Succ rk) a
ts' b
z
seqSpineF (Cons BinomTree rk a
_ BinomForest (Succ rk) a
ts') b
z = BinomForest (Succ rk) a -> b -> b
forall (rk :: * -> *) a b. BinomForest rk a -> b -> b
seqSpineF BinomForest (Succ rk) a
ts' b
z
keysQueue :: Prio.MinPQueue k a -> MinQueue k
keysQueue :: MinPQueue k a -> MinQueue k
keysQueue MinPQueue k a
Prio.Empty = MinQueue k
forall a. MinQueue a
Empty
keysQueue (Prio.MinPQ Int
n k
k a
_ BinomHeap k a
ts) = Int -> k -> BinomHeap k -> MinQueue k
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue Int
n k
k ((Zero k a -> Zero k) -> BinomHeap k a -> BinomHeap k
forall (pRk :: * -> * -> *) k a (rk :: * -> *).
(pRk k a -> rk k) -> BinomForest pRk k a -> BinomForest rk k
keysF (Zero k -> Zero k a -> Zero k
forall a b. a -> b -> a
const Zero k
forall a. Zero a
Zero) BinomHeap k a
ts)
keysF :: (pRk k a -> rk k) -> Prio.BinomForest pRk k a -> BinomForest rk k
keysF :: (pRk k a -> rk k) -> BinomForest pRk k a -> BinomForest rk k
keysF pRk k a -> rk k
f BinomForest pRk k a
ts0 = case BinomForest pRk k a
ts0 of
BinomForest pRk k a
Prio.Nil -> BinomForest rk k
forall (rk :: * -> *) a. BinomForest rk a
Nil
Prio.Skip BinomForest (Succ pRk) k a
ts' -> BinomForest (Succ rk) k -> BinomForest rk k
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip ((Succ pRk k a -> Succ rk k)
-> BinomForest (Succ pRk) k a -> BinomForest (Succ rk) k
forall (pRk :: * -> * -> *) k a (rk :: * -> *).
(pRk k a -> rk k) -> BinomForest pRk k a -> BinomForest rk k
keysF Succ pRk k a -> Succ rk k
f' BinomForest (Succ pRk) k a
ts')
Prio.Cons (Prio.BinomTree k
k a
_ pRk k a
ts) BinomForest (Succ pRk) k a
ts'
-> BinomTree rk k -> BinomForest (Succ rk) k -> BinomForest rk k
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons (k -> rk k -> BinomTree rk k
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree k
k (pRk k a -> rk k
f pRk k a
ts)) ((Succ pRk k a -> Succ rk k)
-> BinomForest (Succ pRk) k a -> BinomForest (Succ rk) k
forall (pRk :: * -> * -> *) k a (rk :: * -> *).
(pRk k a -> rk k) -> BinomForest pRk k a -> BinomForest rk k
keysF Succ pRk k a -> Succ rk k
f' BinomForest (Succ pRk) k a
ts')
where f' :: Succ pRk k a -> Succ rk k
f' (Prio.Succ (Prio.BinomTree k
k a
_ pRk k a
ts) pRk k a
tss) = BinomTree rk k -> rk k -> Succ rk k
forall (rk :: * -> *) a. BinomTree rk a -> rk a -> Succ rk a
Succ (k -> rk k -> BinomTree rk k
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree k
k (pRk k a -> rk k
f pRk k a
ts)) (pRk k a -> rk k
f pRk k a
tss)
class NFRank rk where
rnfRk :: NFData a => rk a -> ()
instance NFRank Zero where
rnfRk :: Zero a -> ()
rnfRk Zero a
_ = ()
instance NFRank rk => NFRank (Succ rk) where
rnfRk :: Succ rk a -> ()
rnfRk (Succ BinomTree rk a
t rk a
ts) = BinomTree rk a
t BinomTree rk a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` rk a -> ()
forall (rk :: * -> *) a. (NFRank rk, NFData a) => rk a -> ()
rnfRk rk a
ts
instance (NFData a, NFRank rk) => NFData (BinomTree rk a) where
rnf :: BinomTree rk a -> ()
rnf (BinomTree a
x rk a
ts) = a
x a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` rk a -> ()
forall (rk :: * -> *) a. (NFRank rk, NFData a) => rk a -> ()
rnfRk rk a
ts
instance (NFData a, NFRank rk) => NFData (BinomForest rk a) where
rnf :: BinomForest rk a -> ()
rnf BinomForest rk a
Nil = ()
rnf (Skip BinomForest (Succ rk) a
ts) = BinomForest (Succ rk) a -> ()
forall a. NFData a => a -> ()
rnf BinomForest (Succ rk) a
ts
rnf (Cons BinomTree rk a
t BinomForest (Succ rk) a
ts) = BinomTree rk a
t BinomTree rk a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` BinomForest (Succ rk) a -> ()
forall a. NFData a => a -> ()
rnf BinomForest (Succ rk) a
ts
instance NFData a => NFData (MinQueue a) where
rnf :: MinQueue a -> ()
rnf MinQueue a
Empty = ()
rnf (MinQueue Int
_ a
x BinomHeap a
ts) = a
x a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` BinomHeap a -> ()
forall a. NFData a => a -> ()
rnf BinomHeap a
ts