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 (Eq, Ord)
instance (Ord n, Show n) => Show (BinaryHeap n) where
show Leaf = "Leaf"
show (Node n _ h1 h2) = "Node " ++ show n ++ " (" ++ show h1 ++ " " ++ show h2 ++ ")"
rank :: (Ord n) => BinaryHeap n -> Int
rank Leaf = 0
rank (Node _ d _ _) = d
empty :: (Ord a) => BinaryHeap a
empty = Leaf
singleton :: (Ord a) => a -> BinaryHeap a
singleton a = Node a 1 Leaf Leaf
merge :: (Ord a) => BinaryHeap a -> BinaryHeap a -> BinaryHeap a
merge Leaf n = n
merge n Leaf = n
merge h1@(Node n1 d1 h1l h1r) h2@(Node n2 d2 _ _) =
if n1<n2 || (n1==n2 && d1<=d2)
then if rank h1l < rank h1r
then Node n1 (d1 + d2) (merge h1l h2) h1r
else Node n1 (d1 + d2) h1l (merge h1r h2)
else merge h2 h1
insert :: (Ord a) => a -> BinaryHeap a -> BinaryHeap a
insert a h = merge h (singleton a)
null :: (Ord a) => BinaryHeap a -> Bool
null Leaf = True
null _ = False
toList :: (Ord a) => BinaryHeap a -> [a]
toList Leaf = []
toList h@(Node _ _ _ _) = head h : toList (tail h)
fromList :: (Ord a) => [a] -> BinaryHeap a
fromList [] = Leaf
fromList l = mergeList (map singleton l)
where mergeList [a] = a
mergeList x = mergeList (mergePairs x)
mergePairs (a:b:c) = merge a b : mergePairs c
mergePairs x = x
head :: (Ord a) => BinaryHeap a -> a
head Leaf = error "Data.Tree.Heap: empty list"
head (Node n _ _ _) = n
tail :: (Ord a) => BinaryHeap a -> BinaryHeap a
tail Leaf = error "Data.Heap empty list"
tail (Node _ _ h1 h2) = merge h1 h2