Instantly share code, notes, and snippets.

# codecontemplator/BinomialHeap.hs Last active Oct 30, 2016

What would you like to do?
Implementation of Binomial heap from the book Purely functional data structures by Chris Okasaki
 data BTree a = Node Int a [(BTree a)] deriving Show data BHeap a = Heap [BTree a] deriving Show empty :: BHeap a empty = Heap [] link :: Ord a => BTree a -> BTree a -> BTree a link t1@(Node r x1 c1) t2@(Node _ x2 c2) = if x1 < x2 then Node (r+1) x1 (t2:c1) else Node (r+1) x2 (t1:c2) rank :: BTree a -> Int rank (Node r _ _) = r telem :: BTree a -> a telem (Node _ x _) = x insTree :: Ord a => BTree a -> [BTree a] -> [BTree a] insTree t [] = [t] insTree t ts1@(t1':ts1') = if rank t < rank t1' then t:ts1 else insTree (link t t1') ts1' insert :: Ord a => BHeap a -> a -> BHeap a insert (Heap ts) x = Heap \$ insTree (Node 0 x []) ts removeMinTree :: Ord a => [BTree a] -> (BTree a,[BTree a]) removeMinTree [] = error "Cannot remove from empty heap" removeMinTree [t] = (t, []) removeMinTree (t:ts) = let (t',ts') = removeMinTree ts in if telem t < telem t' then (t,ts) else (t',t:ts') findMin :: Ord a => BHeap a -> a findMin (Heap ts) = let (t,_) = removeMinTree ts in telem t merge :: Ord a => [BTree a] -> [BTree a] -> [BTree a] merge [] ts = ts merge ts [] = ts merge ts1@(t1:ts1') ts2@(t2:ts2') = if rank t1 < rank t2 then t1 : merge ts1' ts2 else if rank t2 < rank t1 then t2 : merge ts1 ts2' else insTree (link t1 t2) (merge ts1' ts2') deleteMin :: Ord a => BHeap a -> BHeap a deleteMin (Heap ts) = let ((Node _ _ c) ,ts') = removeMinTree ts in Heap \$ merge (reverse c) ts' sampleHeap :: BHeap Int sampleHeap = foldl insert empty [20,2,5,84,-5]