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

-- | 'Data.Heap.Binary' provides a binary min-heap. Balance is maintained through descendant counting.
module Data.Heap.Binary 
(BinaryHeap, head, tail, merge, singleton, empty, null, fromList, toList, insert) 
where

import Prelude hiding (head, tail, null)

data (Ord n) => BinaryHeap n =
    Leaf
  | Node n !Int (BinaryHeap n) (BinaryHeap n) deriving (BinaryHeap n -> BinaryHeap n -> Bool
(BinaryHeap n -> BinaryHeap n -> Bool)
-> (BinaryHeap n -> BinaryHeap n -> Bool) -> Eq (BinaryHeap n)
forall n. Ord n => BinaryHeap n -> BinaryHeap n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall n. Ord n => BinaryHeap n -> BinaryHeap n -> Bool
== :: BinaryHeap n -> BinaryHeap n -> Bool
$c/= :: forall n. Ord n => BinaryHeap n -> BinaryHeap n -> Bool
/= :: BinaryHeap n -> BinaryHeap n -> Bool
Eq, Eq (BinaryHeap n)
Eq (BinaryHeap n) =>
(BinaryHeap n -> BinaryHeap n -> Ordering)
-> (BinaryHeap n -> BinaryHeap n -> Bool)
-> (BinaryHeap n -> BinaryHeap n -> Bool)
-> (BinaryHeap n -> BinaryHeap n -> Bool)
-> (BinaryHeap n -> BinaryHeap n -> Bool)
-> (BinaryHeap n -> BinaryHeap n -> BinaryHeap n)
-> (BinaryHeap n -> BinaryHeap n -> BinaryHeap n)
-> Ord (BinaryHeap n)
BinaryHeap n -> BinaryHeap n -> Bool
BinaryHeap n -> BinaryHeap n -> Ordering
BinaryHeap n -> BinaryHeap n -> BinaryHeap n
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 n. Ord n => Eq (BinaryHeap n)
forall n. Ord n => BinaryHeap n -> BinaryHeap n -> Bool
forall n. Ord n => BinaryHeap n -> BinaryHeap n -> Ordering
forall n. Ord n => BinaryHeap n -> BinaryHeap n -> BinaryHeap n
$ccompare :: forall n. Ord n => BinaryHeap n -> BinaryHeap n -> Ordering
compare :: BinaryHeap n -> BinaryHeap n -> Ordering
$c< :: forall n. Ord n => BinaryHeap n -> BinaryHeap n -> Bool
< :: BinaryHeap n -> BinaryHeap n -> Bool
$c<= :: forall n. Ord n => BinaryHeap n -> BinaryHeap n -> Bool
<= :: BinaryHeap n -> BinaryHeap n -> Bool
$c> :: forall n. Ord n => BinaryHeap n -> BinaryHeap n -> Bool
> :: BinaryHeap n -> BinaryHeap n -> Bool
$c>= :: forall n. Ord n => BinaryHeap n -> BinaryHeap n -> Bool
>= :: BinaryHeap n -> BinaryHeap n -> Bool
$cmax :: forall n. Ord n => BinaryHeap n -> BinaryHeap n -> BinaryHeap n
max :: BinaryHeap n -> BinaryHeap n -> BinaryHeap n
$cmin :: forall n. Ord n => BinaryHeap n -> BinaryHeap n -> BinaryHeap n
min :: BinaryHeap n -> BinaryHeap n -> BinaryHeap n
Ord)

instance (Ord n, Show n) => Show (BinaryHeap n) where
  show :: BinaryHeap n -> String
show BinaryHeap n
Leaf = String
"Leaf"
  show (Node n
n Int
_ BinaryHeap n
h1 BinaryHeap n
h2) = String
"Node " String -> ShowS
forall a. [a] -> [a] -> [a]
++ n -> String
forall a. Show a => a -> String
show n
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ BinaryHeap n -> String
forall a. Show a => a -> String
show BinaryHeap n
h1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ BinaryHeap n -> String
forall a. Show a => a -> String
show BinaryHeap n
h2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

rank :: (Ord n) => BinaryHeap n -> Int
rank :: forall n. Ord n => BinaryHeap n -> Int
rank BinaryHeap n
Leaf = Int
0
rank (Node n
_ Int
d BinaryHeap n
_ BinaryHeap n
_) = Int
d

-- | /O(1)/. 'empty' produces an empty heap.
empty :: (Ord a) => BinaryHeap a
empty :: forall a. Ord a => BinaryHeap a
empty = BinaryHeap a
forall n. BinaryHeap n
Leaf 

-- | /O(1)/. 'singleton' consumes an element and constructs a singleton heap.
singleton :: (Ord a) => a -> BinaryHeap a
singleton :: forall a. Ord a => a -> BinaryHeap a
singleton a
a = a -> Int -> BinaryHeap a -> BinaryHeap a -> BinaryHeap a
forall n.
Ord n =>
n -> Int -> BinaryHeap n -> BinaryHeap n -> BinaryHeap n
Node a
a Int
1 BinaryHeap a
forall n. BinaryHeap n
Leaf BinaryHeap a
forall n. BinaryHeap n
Leaf

-- | 'merge' consumes two binary heaps and merges them.
merge :: (Ord a) => BinaryHeap a -> BinaryHeap a -> BinaryHeap a
merge :: forall n. Ord n => BinaryHeap n -> BinaryHeap n -> BinaryHeap n
merge BinaryHeap a
Leaf BinaryHeap a
n = BinaryHeap a
n
merge BinaryHeap a
n BinaryHeap a
Leaf = BinaryHeap a
n
merge h1 :: BinaryHeap a
h1@(Node a
n1 Int
d1 BinaryHeap a
h1l BinaryHeap a
h1r) h2 :: BinaryHeap a
h2@(Node a
n2 Int
d2 BinaryHeap a
_ BinaryHeap a
_) = 
  if  a
n1a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
n2 Bool -> Bool -> Bool
|| (a
n1a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
n2 Bool -> Bool -> Bool
&& Int
d1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
d2)
  then if BinaryHeap a -> Int
forall n. Ord n => BinaryHeap n -> Int
rank BinaryHeap a
h1l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< BinaryHeap a -> Int
forall n. Ord n => BinaryHeap n -> Int
rank BinaryHeap a
h1r
       then a -> Int -> BinaryHeap a -> BinaryHeap a -> BinaryHeap a
forall n.
Ord n =>
n -> Int -> BinaryHeap n -> BinaryHeap n -> BinaryHeap n
Node a
n1 (Int
d1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d2) (BinaryHeap a -> BinaryHeap a -> BinaryHeap a
forall n. Ord n => BinaryHeap n -> BinaryHeap n -> BinaryHeap n
merge BinaryHeap a
h1l BinaryHeap a
h2) BinaryHeap a
h1r
       else a -> Int -> BinaryHeap a -> BinaryHeap a -> BinaryHeap a
forall n.
Ord n =>
n -> Int -> BinaryHeap n -> BinaryHeap n -> BinaryHeap n
Node a
n1 (Int
d1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d2) BinaryHeap a
h1l (BinaryHeap a -> BinaryHeap a -> BinaryHeap a
forall n. Ord n => BinaryHeap n -> BinaryHeap n -> BinaryHeap n
merge BinaryHeap a
h1r BinaryHeap a
h2)
  else BinaryHeap a -> BinaryHeap a -> BinaryHeap a
forall n. Ord n => BinaryHeap n -> BinaryHeap n -> BinaryHeap n
merge BinaryHeap a
h2 BinaryHeap a
h1

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

-- | /O(1)/.
null :: (Ord a) => BinaryHeap a -> Bool
null :: forall a. Ord a => BinaryHeap a -> Bool
null BinaryHeap a
Leaf = Bool
True
null BinaryHeap a
_    = Bool
False

-- | /O(n lg n)/.
toList :: (Ord a) => BinaryHeap a -> [a]
toList :: forall a. Ord a => BinaryHeap a -> [a]
toList BinaryHeap a
Leaf = []
toList h :: BinaryHeap a
h@(Node a
_ Int
_ BinaryHeap a
_ BinaryHeap a
_) = BinaryHeap a -> a
forall a. Ord a => BinaryHeap a -> a
head BinaryHeap a
h a -> [a] -> [a]
forall a. a -> [a] -> [a]
: BinaryHeap a -> [a]
forall a. Ord a => BinaryHeap a -> [a]
toList (BinaryHeap a -> BinaryHeap a
forall a. Ord a => BinaryHeap a -> BinaryHeap a
tail BinaryHeap a
h)

-- | /O(n)/. 'fromList' constructs a binary heap from an unsorted list.
fromList :: (Ord a) => [a] -> BinaryHeap a
fromList :: forall a. Ord a => [a] -> BinaryHeap a
fromList [] = BinaryHeap a
forall n. BinaryHeap n
Leaf
fromList [a]
l = [BinaryHeap a] -> BinaryHeap a
forall {a}. Ord a => [BinaryHeap a] -> BinaryHeap a
mergeList ((a -> BinaryHeap a) -> [a] -> [BinaryHeap a]
forall a b. (a -> b) -> [a] -> [b]
map a -> BinaryHeap a
forall a. Ord a => a -> BinaryHeap a
singleton [a]
l)
              where mergeList :: [BinaryHeap a] -> BinaryHeap a
mergeList [BinaryHeap a
a] = BinaryHeap a
a
                    mergeList [BinaryHeap a]
x = [BinaryHeap a] -> BinaryHeap a
mergeList ([BinaryHeap a] -> [BinaryHeap a]
forall {a}. Ord a => [BinaryHeap a] -> [BinaryHeap a]
mergePairs [BinaryHeap a]
x)
                    mergePairs :: [BinaryHeap a] -> [BinaryHeap a]
mergePairs (BinaryHeap a
a:BinaryHeap a
b:[BinaryHeap a]
c) = BinaryHeap a -> BinaryHeap a -> BinaryHeap a
forall n. Ord n => BinaryHeap n -> BinaryHeap n -> BinaryHeap n
merge BinaryHeap a
a BinaryHeap a
b BinaryHeap a -> [BinaryHeap a] -> [BinaryHeap a]
forall a. a -> [a] -> [a]
: [BinaryHeap a] -> [BinaryHeap a]
mergePairs [BinaryHeap a]
c
                    mergePairs [BinaryHeap a]
x = [BinaryHeap a]
x

-- | /O(1)/. 'head' returns the element root of the heap.
head :: (Ord a) => BinaryHeap a -> a
head :: forall a. Ord a => BinaryHeap a -> a
head BinaryHeap a
Leaf = String -> a
forall a. HasCallStack => String -> a
error String
"Data.Tree.Heap: empty list"
head (Node a
n Int
_ BinaryHeap a
_ BinaryHeap a
_) = a
n

-- | /O(lg n)/. 'tail' discards the root of the heap and merges the subtrees.
tail :: (Ord a) => BinaryHeap a -> BinaryHeap a
tail :: forall a. Ord a => BinaryHeap a -> BinaryHeap a
tail BinaryHeap a
Leaf = String -> BinaryHeap a
forall a. HasCallStack => String -> a
error String
"Data.Heap empty list"
tail (Node a
_ Int
_ BinaryHeap a
h1 BinaryHeap a
h2) = BinaryHeap a -> BinaryHeap a -> BinaryHeap a
forall n. Ord n => BinaryHeap n -> BinaryHeap n -> BinaryHeap n
merge BinaryHeap a
h1 BinaryHeap a
h2