commit 8392130801a42fde5603cecd57aa786227ff0a39
parent deb5e7a85739fbcef2ace39db567a8c484813f5d
Author: Jared Tobin <jared@jtobin.ca>
Date: Fri, 21 Nov 2014 22:50:46 +1300
Add binomial heap.
Diffstat:
2 files changed, 56 insertions(+), 2 deletions(-)
diff --git a/BinomialHeap.hs b/BinomialHeap.hs
@@ -0,0 +1,56 @@
+{-# OPTIONS_GHC -Wall #-}
+
+module BinomialHeap where
+
+data Tree a = Node Int a [Tree a]
+
+type Heap a = [Tree a]
+
+link :: Ord a => Tree a -> Tree a -> Tree a
+link t0@(Node r x0 c0) t1@(Node _ x1 c1)
+ | x0 <= x1 = Node (succ r) x0 (t1 : c0)
+ | otherwise = Node (succ r) x1 (t0 : c1)
+
+rank :: Tree a -> Int
+rank (Node r _ _) = r
+
+root :: Tree a -> a
+root (Node _ x _) = x
+
+insertTree :: Ord a => Tree a -> Heap a -> Heap a
+insertTree t [] = [t]
+insertTree t ts@(tree:trees)
+ | rank t < rank tree = t : ts
+ | otherwise = insertTree (link t tree) trees
+
+insert :: Ord a => a -> Heap a -> Heap a
+insert x = insertTree (Node 0 x [])
+
+merge :: Ord a => Heap a -> Heap a -> Heap a
+merge ts [] = ts
+merge [] ts = ts
+merge ts0@(tree0:trees0) ts1@(tree1:trees1)
+ | rank tree0 < rank tree1 = tree0 : merge trees0 ts1
+ | rank tree1 < rank tree0 = tree1 : merge ts0 trees1
+ | otherwise = insertTree (link tree0 tree1) (merge trees0 trees1)
+
+removeMinTree :: Ord a => Heap a -> Maybe (Tree a, Heap a)
+removeMinTree [] = Nothing
+removeMinTree [t] = return (t, [])
+removeMinTree (t:ts) = do
+ (tree, trees) <- removeMinTree ts
+ return $
+ if root t < root tree
+ then (t, ts)
+ else (tree, t:trees)
+
+findMin :: Ord a => Heap a -> Maybe a
+findMin ts = do
+ (t, _) <- removeMinTree ts
+ return $ root t
+
+deleteMin :: Ord a => Heap a -> Heap a
+deleteMin ts = case removeMinTree ts of
+ Nothing -> []
+ Just (Node _ _ ts0, ts1) -> merge (reverse ts0) ts1
+
diff --git a/LeftistHeap.hs b/LeftistHeap.hs
@@ -85,5 +85,3 @@ altFromList es
wrapup [z] = z
wrapup zs = wrapup (foldup zs)
-
-
