Create a gist now

Instantly share code, notes, and snippets.

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]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment