--
-- Copyright (c) 2009 - 2010 Brendan Hickey - http://bhickey.net
-- New BSD License (see http://www.opensource.org/licenses/bsd-license.php)
--

module Data.Heap.Binomial 
(BinomialHeap, head, tail, merge, singleton, empty, null, fromList, toList, insert) 
where

import Prelude hiding (head, tail, null)
import Data.List (delete)

data (Ord a, Ord b, Eq a, Eq b) => HeapNode a b = HeapNode a {-# UNPACK #-} !Int [b]

data (Ord a, Eq a) => BinomialHeap a = 
    EmptyHeap
  | Heap {-# UNPACK #-} ![HeapNode a (BinomialHeap a)] deriving (BinomialHeap a -> BinomialHeap a -> Bool
(BinomialHeap a -> BinomialHeap a -> Bool)
-> (BinomialHeap a -> BinomialHeap a -> Bool)
-> Eq (BinomialHeap a)
forall a. Ord a => BinomialHeap a -> BinomialHeap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Ord a => BinomialHeap a -> BinomialHeap a -> Bool
== :: BinomialHeap a -> BinomialHeap a -> Bool
$c/= :: forall a. Ord a => BinomialHeap a -> BinomialHeap a -> Bool
/= :: BinomialHeap a -> BinomialHeap a -> Bool
Eq, Eq (BinomialHeap a)
Eq (BinomialHeap a) =>
(BinomialHeap a -> BinomialHeap a -> Ordering)
-> (BinomialHeap a -> BinomialHeap a -> Bool)
-> (BinomialHeap a -> BinomialHeap a -> Bool)
-> (BinomialHeap a -> BinomialHeap a -> Bool)
-> (BinomialHeap a -> BinomialHeap a -> Bool)
-> (BinomialHeap a -> BinomialHeap a -> BinomialHeap a)
-> (BinomialHeap a -> BinomialHeap a -> BinomialHeap a)
-> Ord (BinomialHeap a)
BinomialHeap a -> BinomialHeap a -> Bool
BinomialHeap a -> BinomialHeap a -> Ordering
BinomialHeap a -> BinomialHeap a -> BinomialHeap a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (BinomialHeap a)
forall a. Ord a => BinomialHeap a -> BinomialHeap a -> Bool
forall a. Ord a => BinomialHeap a -> BinomialHeap a -> Ordering
forall a.
Ord a =>
BinomialHeap a -> BinomialHeap a -> BinomialHeap a
$ccompare :: forall a. Ord a => BinomialHeap a -> BinomialHeap a -> Ordering
compare :: BinomialHeap a -> BinomialHeap a -> Ordering
$c< :: forall a. Ord a => BinomialHeap a -> BinomialHeap a -> Bool
< :: BinomialHeap a -> BinomialHeap a -> Bool
$c<= :: forall a. Ord a => BinomialHeap a -> BinomialHeap a -> Bool
<= :: BinomialHeap a -> BinomialHeap a -> Bool
$c> :: forall a. Ord a => BinomialHeap a -> BinomialHeap a -> Bool
> :: BinomialHeap a -> BinomialHeap a -> Bool
$c>= :: forall a. Ord a => BinomialHeap a -> BinomialHeap a -> Bool
>= :: BinomialHeap a -> BinomialHeap a -> Bool
$cmax :: forall a.
Ord a =>
BinomialHeap a -> BinomialHeap a -> BinomialHeap a
max :: BinomialHeap a -> BinomialHeap a -> BinomialHeap a
$cmin :: forall a.
Ord a =>
BinomialHeap a -> BinomialHeap a -> BinomialHeap a
min :: BinomialHeap a -> BinomialHeap a -> BinomialHeap a
Ord)

instance (Ord a, Ord b, Eq a, Eq b) => Ord (HeapNode a b) where
  compare :: HeapNode a b -> HeapNode a b -> Ordering
compare (HeapNode a
e1 Int
_ [b]
_) (HeapNode a
e2 Int
_ [b]
_) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
e1 a
e2

instance (Ord a, Ord b, Eq a, Eq b) => Eq (HeapNode a b) where
  (HeapNode a
e1 Int
_ [b]
_) == :: HeapNode a b -> HeapNode a b -> Bool
== (HeapNode a
e2 Int
_ [b]
_) = a
e1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
e2
 
rank :: (Ord a, Ord b, Eq a, Eq b) => HeapNode a b -> Int
rank :: forall a b. (Ord a, Ord b, Eq a, Eq b) => HeapNode a b -> Int
rank (HeapNode a
_ Int
n [b]
_) = Int
n

hRank :: (Ord a, Ord b, Eq a, Eq b) => [HeapNode a b] -> Int
hRank :: forall a b. (Ord a, Ord b, Eq a, Eq b) => [HeapNode a b] -> Int
hRank [] = Int
0
hRank (HeapNode a b
hd:[HeapNode a b]
_) = HeapNode a b -> Int
forall a b. (Ord a, Ord b, Eq a, Eq b) => HeapNode a b -> Int
rank HeapNode a b
hd

extract :: (Ord a, Ord b, Eq a, Eq b) => HeapNode a b -> a
extract :: forall a b. (Ord a, Ord b, Eq a, Eq b) => HeapNode a b -> a
extract (HeapNode a
n Int
_ [b]
_) = a
n

empty :: (Ord a) => BinomialHeap a
empty :: forall a. Ord a => BinomialHeap a
empty = BinomialHeap a
forall a. BinomialHeap a
EmptyHeap

null :: (Ord a) => BinomialHeap a -> Bool
null :: forall a. Ord a => BinomialHeap a -> Bool
null BinomialHeap a
EmptyHeap = Bool
True
null BinomialHeap a
_         = Bool
False

-- | /O(1)/.
singleton :: (Ord a) => a -> BinomialHeap a
singleton :: forall a. Ord a => a -> BinomialHeap a
singleton a
n = [HeapNode a (BinomialHeap a)] -> BinomialHeap a
forall a.
(Ord a, Eq a) =>
[HeapNode a (BinomialHeap a)] -> BinomialHeap a
Heap [a -> Int -> [BinomialHeap a] -> HeapNode a (BinomialHeap a)
forall a b.
(Ord a, Ord b, Eq a, Eq b) =>
a -> Int -> [b] -> HeapNode a b
HeapNode a
n Int
1 []]

-- | /O(lg n)/
insert :: (Ord a) => a -> BinomialHeap a -> BinomialHeap a
insert :: forall a. Ord a => a -> BinomialHeap a -> BinomialHeap a
insert a
a = BinomialHeap a -> BinomialHeap a -> BinomialHeap a
forall a.
Ord a =>
BinomialHeap a -> BinomialHeap a -> BinomialHeap a
merge (a -> BinomialHeap a
forall a. Ord a => a -> BinomialHeap a
singleton a
a)

-- | /O(lg n)/.
merge :: (Ord a) => BinomialHeap a -> BinomialHeap a -> BinomialHeap a
merge :: forall a.
Ord a =>
BinomialHeap a -> BinomialHeap a -> BinomialHeap a
merge BinomialHeap a
EmptyHeap BinomialHeap a
n = BinomialHeap a
n
merge BinomialHeap a
n BinomialHeap a
EmptyHeap = BinomialHeap a
n
merge (Heap [HeapNode a (BinomialHeap a)]
h1) (Heap [HeapNode a (BinomialHeap a)]
h2) = [HeapNode a (BinomialHeap a)] -> BinomialHeap a
forall a.
(Ord a, Eq a) =>
[HeapNode a (BinomialHeap a)] -> BinomialHeap a
Heap ([HeapNode a (BinomialHeap a)] -> BinomialHeap a)
-> [HeapNode a (BinomialHeap a)] -> BinomialHeap a
forall a b. (a -> b) -> a -> b
$! [HeapNode a (BinomialHeap a)]
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
forall a.
(Ord a, Eq a) =>
[HeapNode a (BinomialHeap a)]
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
mergeNodes [HeapNode a (BinomialHeap a)]
h1 [HeapNode a (BinomialHeap a)]
h2

mergeNodes :: (Ord a, Eq a) => [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
mergeNodes :: forall a.
(Ord a, Eq a) =>
[HeapNode a (BinomialHeap a)]
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
mergeNodes [] [HeapNode a (BinomialHeap a)]
h  = [HeapNode a (BinomialHeap a)]
h
mergeNodes [HeapNode a (BinomialHeap a)]
h  [] = [HeapNode a (BinomialHeap a)]
h
mergeNodes f :: [HeapNode a (BinomialHeap a)]
f@(HeapNode a (BinomialHeap a)
h1 : [HeapNode a (BinomialHeap a)]
t1) s :: [HeapNode a (BinomialHeap a)]
s@(HeapNode a (BinomialHeap a)
h2 : [HeapNode a (BinomialHeap a)]
t2)
    | HeapNode a (BinomialHeap a) -> Int
forall a b. (Ord a, Ord b, Eq a, Eq b) => HeapNode a b -> Int
rank HeapNode a (BinomialHeap a)
h1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== HeapNode a (BinomialHeap a) -> Int
forall a b. (Ord a, Ord b, Eq a, Eq b) => HeapNode a b -> Int
rank HeapNode a (BinomialHeap a)
h2 =
      let merged :: HeapNode a (BinomialHeap a)
merged = HeapNode a (BinomialHeap a)
-> HeapNode a (BinomialHeap a) -> HeapNode a (BinomialHeap a)
forall a.
(Ord a, Eq a) =>
HeapNode a (BinomialHeap a)
-> HeapNode a (BinomialHeap a) -> HeapNode a (BinomialHeap a)
combine HeapNode a (BinomialHeap a)
h1 HeapNode a (BinomialHeap a)
h2
          r :: Int
r = HeapNode a (BinomialHeap a) -> Int
forall a b. (Ord a, Ord b, Eq a, Eq b) => HeapNode a b -> Int
rank HeapNode a (BinomialHeap a)
merged
        in
        if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [HeapNode a (BinomialHeap a)] -> Int
forall a b. (Ord a, Ord b, Eq a, Eq b) => [HeapNode a b] -> Int
hRank [HeapNode a (BinomialHeap a)]
t1 then
          if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [HeapNode a (BinomialHeap a)] -> Int
forall a b. (Ord a, Ord b, Eq a, Eq b) => [HeapNode a b] -> Int
hRank [HeapNode a (BinomialHeap a)]
t2 then HeapNode a (BinomialHeap a)
merged HeapNode a (BinomialHeap a)
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
forall a. a -> [a] -> [a]
: [HeapNode a (BinomialHeap a)]
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
forall a.
(Ord a, Eq a) =>
[HeapNode a (BinomialHeap a)]
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
mergeNodes [HeapNode a (BinomialHeap a)]
t1 [HeapNode a (BinomialHeap a)]
t2 else
            [HeapNode a (BinomialHeap a)]
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
forall a.
(Ord a, Eq a) =>
[HeapNode a (BinomialHeap a)]
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
mergeNodes (HeapNode a (BinomialHeap a)
merged HeapNode a (BinomialHeap a)
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
forall a. a -> [a] -> [a]
: [HeapNode a (BinomialHeap a)]
t1) [HeapNode a (BinomialHeap a)]
t2
          else
          if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [HeapNode a (BinomialHeap a)] -> Int
forall a b. (Ord a, Ord b, Eq a, Eq b) => [HeapNode a b] -> Int
hRank [HeapNode a (BinomialHeap a)]
t2 then [HeapNode a (BinomialHeap a)]
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
forall a.
(Ord a, Eq a) =>
[HeapNode a (BinomialHeap a)]
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
mergeNodes [HeapNode a (BinomialHeap a)]
t1 (HeapNode a (BinomialHeap a)
merged HeapNode a (BinomialHeap a)
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
forall a. a -> [a] -> [a]
: [HeapNode a (BinomialHeap a)]
t2) else
            HeapNode a (BinomialHeap a)
merged HeapNode a (BinomialHeap a)
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
forall a. a -> [a] -> [a]
: [HeapNode a (BinomialHeap a)]
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
forall a.
(Ord a, Eq a) =>
[HeapNode a (BinomialHeap a)]
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
mergeNodes [HeapNode a (BinomialHeap a)]
t1 [HeapNode a (BinomialHeap a)]
t2
    | HeapNode a (BinomialHeap a) -> Int
forall a b. (Ord a, Ord b, Eq a, Eq b) => HeapNode a b -> Int
rank HeapNode a (BinomialHeap a)
h1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< HeapNode a (BinomialHeap a) -> Int
forall a b. (Ord a, Ord b, Eq a, Eq b) => HeapNode a b -> Int
rank HeapNode a (BinomialHeap a)
h2 = HeapNode a (BinomialHeap a)
h1 HeapNode a (BinomialHeap a)
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
forall a. a -> [a] -> [a]
: [HeapNode a (BinomialHeap a)]
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
forall a.
(Ord a, Eq a) =>
[HeapNode a (BinomialHeap a)]
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
mergeNodes [HeapNode a (BinomialHeap a)]
t1 [HeapNode a (BinomialHeap a)]
s
    | Bool
otherwise = HeapNode a (BinomialHeap a)
h2 HeapNode a (BinomialHeap a)
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
forall a. a -> [a] -> [a]
: [HeapNode a (BinomialHeap a)]
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
forall a.
(Ord a, Eq a) =>
[HeapNode a (BinomialHeap a)]
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
mergeNodes [HeapNode a (BinomialHeap a)]
t2 [HeapNode a (BinomialHeap a)]
f

combine :: (Ord a, Eq a) => HeapNode a (BinomialHeap a) -> HeapNode a (BinomialHeap a) -> HeapNode a (BinomialHeap a)
combine :: forall a.
(Ord a, Eq a) =>
HeapNode a (BinomialHeap a)
-> HeapNode a (BinomialHeap a) -> HeapNode a (BinomialHeap a)
combine h1 :: HeapNode a (BinomialHeap a)
h1@(HeapNode a
e1 Int
n1 [BinomialHeap a]
l1) HeapNode a (BinomialHeap a)
h2 =
  if HeapNode a (BinomialHeap a)
h1 HeapNode a (BinomialHeap a) -> HeapNode a (BinomialHeap a) -> Bool
forall a. Ord a => a -> a -> Bool
<= HeapNode a (BinomialHeap a)
h2
  then a -> Int -> [BinomialHeap a] -> HeapNode a (BinomialHeap a)
forall a b.
(Ord a, Ord b, Eq a, Eq b) =>
a -> Int -> [b] -> HeapNode a b
HeapNode a
e1 (Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([BinomialHeap a]
l1 [BinomialHeap a] -> [BinomialHeap a] -> [BinomialHeap a]
forall a. [a] -> [a] -> [a]
++ [[HeapNode a (BinomialHeap a)] -> BinomialHeap a
forall a.
(Ord a, Eq a) =>
[HeapNode a (BinomialHeap a)] -> BinomialHeap a
Heap [HeapNode a (BinomialHeap a)
h2]])
  else HeapNode a (BinomialHeap a)
-> HeapNode a (BinomialHeap a) -> HeapNode a (BinomialHeap a)
forall a.
(Ord a, Eq a) =>
HeapNode a (BinomialHeap a)
-> HeapNode a (BinomialHeap a) -> HeapNode a (BinomialHeap a)
combine HeapNode a (BinomialHeap a)
h2 HeapNode a (BinomialHeap a)
h1

-- | /O(lg n)/
head :: (Ord a) => BinomialHeap a -> a
head :: forall a. Ord a => BinomialHeap a -> a
head BinomialHeap a
EmptyHeap = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Heap: empty list"
head (Heap [HeapNode a (BinomialHeap a)]
hn) = HeapNode a (BinomialHeap a) -> a
forall a b. (Ord a, Ord b, Eq a, Eq b) => HeapNode a b -> a
extract (HeapNode a (BinomialHeap a) -> a)
-> HeapNode a (BinomialHeap a) -> a
forall a b. (a -> b) -> a -> b
$! [HeapNode a (BinomialHeap a)] -> HeapNode a (BinomialHeap a)
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [HeapNode a (BinomialHeap a)]
hn

-- | /O(lg n)/
tail :: (Ord a) => BinomialHeap a -> BinomialHeap a
tail :: forall a. Ord a => BinomialHeap a -> BinomialHeap a
tail BinomialHeap a
EmptyHeap = [Char] -> BinomialHeap a
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Heap: empty list"
tail (Heap [HeapNode a (BinomialHeap a)]
hn) = 
  let n :: HeapNode a (BinomialHeap a)
n@(HeapNode a
_ Int
_ [BinomialHeap a]
hd) = ([HeapNode a (BinomialHeap a)] -> HeapNode a (BinomialHeap a)
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [HeapNode a (BinomialHeap a)]
hn) in
    (BinomialHeap a -> BinomialHeap a -> BinomialHeap a)
-> BinomialHeap a -> [BinomialHeap a] -> BinomialHeap a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl BinomialHeap a -> BinomialHeap a -> BinomialHeap a
forall a.
Ord a =>
BinomialHeap a -> BinomialHeap a -> BinomialHeap a
merge ([HeapNode a (BinomialHeap a)] -> BinomialHeap a
forall a.
(Ord a, Eq a) =>
[HeapNode a (BinomialHeap a)] -> BinomialHeap a
Heap (HeapNode a (BinomialHeap a)
-> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
forall a. Eq a => a -> [a] -> [a]
delete HeapNode a (BinomialHeap a)
n [HeapNode a (BinomialHeap a)]
hn)) [BinomialHeap a]
hd

-- | /O(n)/
fromList :: (Ord a, Eq a) => [a] -> BinomialHeap a
fromList :: forall a. (Ord a, Eq a) => [a] -> BinomialHeap a
fromList =  (BinomialHeap a -> BinomialHeap a -> BinomialHeap a)
-> BinomialHeap a -> [BinomialHeap a] -> BinomialHeap a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl BinomialHeap a -> BinomialHeap a -> BinomialHeap a
forall a.
Ord a =>
BinomialHeap a -> BinomialHeap a -> BinomialHeap a
merge BinomialHeap a
forall a. BinomialHeap a
EmptyHeap ([BinomialHeap a] -> BinomialHeap a)
-> ([a] -> [BinomialHeap a]) -> [a] -> BinomialHeap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> BinomialHeap a) -> [a] -> [BinomialHeap a]
forall a b. (a -> b) -> [a] -> [b]
map a -> BinomialHeap a
forall a. Ord a => a -> BinomialHeap a
singleton

-- | /O(n lg n)/
toList :: (Ord a) => BinomialHeap a -> [a]
toList :: forall a. Ord a => BinomialHeap a -> [a]
toList BinomialHeap a
EmptyHeap  = []
toList (Heap [])  = []
toList h :: BinomialHeap a
h@(Heap [HeapNode a (BinomialHeap a)]
_) = BinomialHeap a -> a
forall a. Ord a => BinomialHeap a -> a
head BinomialHeap a
h a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (BinomialHeap a -> [a]
forall a. Ord a => BinomialHeap a -> [a]
toList (BinomialHeap a -> [a]) -> BinomialHeap a -> [a]
forall a b. (a -> b) -> a -> b
$ if BinomialHeap a -> Bool
forall a. Ord a => BinomialHeap a -> Bool
null BinomialHeap a
h then BinomialHeap a
h else BinomialHeap a -> BinomialHeap a
forall a. Ord a => BinomialHeap a -> BinomialHeap a
tail BinomialHeap a
h)