Heap.hs

module Heap where
import Test.QuickCheck (verboseCheck)

data Heap a = E | T Int a (Heap a) (Heap a)

instance Show a => Show (Heap a) where
    showsPrec _ E = showString "_"
    showsPrec _ (T r x E E) = showElement r x
    showsPrec _ (T r x a b) = showChar '(' . showElement r x . showChar ' ' . shows a . showChar ' ' . shows b . showChar ')'

showElement r x = shows r . showChar ':' . shows x

empty :: Heap a
empty = E

merge :: Ord a => Heap a -> Heap a -> Heap a
merge h E = h
merge E h = h
merge h1@(T _ x a1 b1) h2@(T _ y a2 b2) | x < y      = makeT x a1 (merge b1 h2)
                                        | otherwise  = makeT y a2 (merge h1 b2)

rank :: Heap a -> Int
rank E = 0
rank (T r _ _ _) = r

makeT :: Ord a => a -> Heap a -> Heap a -> Heap a
makeT x a b | rank a >= rank b = T (rank b + 1) x a b
            | otherwise        = T (rank a + 1) x b a

insert :: Ord a => a -> Heap a -> Heap a
insert x h = merge (T 1 x E E) h

findMin :: Heap a -> a
findMin (T _ x a b) = x

deleteMin :: Ord a => Heap a -> Heap a
deleteMin (T _ x a b) = merge a b

listToHeap :: Ord a => [a] -> Heap a
listToHeap = foldr insert E

heapToList :: Ord a => Heap a -> [a]
heapToList E = []
heapToList h = findMin h : heapToList (deleteMin h)

-- test = heapToList (listToHeap [7, 3, 8, 10, 6, 1, 9, 4, 2, 5])

prop_Heap :: [Int] -> Bool
prop_Heap xs = isSorted (heapToList (listToHeap xs))

isSorted       [] = True
isSorted   (x:[]) = True
isSorted (x:y:xs) = x <= y && isSorted (y:xs)

test = verboseCheck prop_Heap