summaryrefslogtreecommitdiff log msg author committer range
path: root/Data/Heap/Binary.hs
blob: c9bd084905a0bb0fc770f1682fb2483b4d6bbcca (plain)
 ```1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 ``` ``````-- -- Copyright (c) 2009 Brendan Hickey - http://bhickey.net -- Simplified BSD License (see http://www.opensource.org/licenses/bsd-license.php) -- -- | 'Data.Heap.Binary' provides a binary min-heap. Balance is maintained through descendant counting. 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 -- | /O(1)/. 'empty' produces an empty heap. empty :: (Ord a) => BinaryHeap a empty = Leaf -- | /O(1)/. 'singleton' consumes an element and constructs a singleton heap. singleton :: (Ord a) => a -> BinaryHeap a singleton a = Node a 1 Leaf Leaf -- | 'merge' consumes two binary heaps and merges them. 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 _ d2 _ _) = if head h1 == head h2 || h1 <= h2 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 -- | /O(lg n)/. insert :: (Ord a) => BinaryHeap a -> a -> BinaryHeap a insert h a = merge h (singleton a) -- | /O(1)/. null :: (Ord a) => BinaryHeap a -> Bool null Leaf = True null _ = False -- | /O(n lg n)/. toList :: (Ord a) => BinaryHeap a -> [a] toList Leaf = [] toList h@(Node _ _ _ _) = (head h):(toList \$ tail h) -- | /O(n)/. 'fromList' constructs a binary heap from an unsorted list. fromList :: (Ord a) => [a] -> BinaryHeap a fromList [] = Leaf fromList l = (\ ((hd:_):_) -> hd) \$! dropWhile (\ x -> length x > 1) \$ iterate (pairWise merge) \$ map singleton l pairWise :: (a -> a -> a) -> [a] -> [a] pairWise _ [] = [] pairWise f (a:b:tl) = (f a b):(pairWise f tl) pairWise _ a = a -- | /O(1)/. 'head' returns the element root of the heap. head :: (Ord a) => BinaryHeap a -> a head Leaf = error "Data.Tree.Heap: empty list" head (Node n _ _ _) = n -- | /O(lg n)/. 'tail' discards the root of the heap and merges the subtrees. tail :: (Ord a) => BinaryHeap a -> BinaryHeap a tail Leaf = error "Data.Heap empty list" tail (Node _ _ h1 h2) = merge h1 h2 ``````