summaryrefslogtreecommitdiff
path: root/Data/Heap/Binary.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Data/Heap/Binary.hs')
-rw-r--r--Data/Heap/Binary.hs33
1 files changed, 16 insertions, 17 deletions
diff --git a/Data/Heap/Binary.hs b/Data/Heap/Binary.hs
index c9bd084..de1aacb 100644
--- a/Data/Heap/Binary.hs
+++ b/Data/Heap/Binary.hs
@@ -1,6 +1,6 @@
--
--- Copyright (c) 2009 Brendan Hickey - http://bhickey.net
--- Simplified BSD License (see http://www.opensource.org/licenses/bsd-license.php)
+-- Copyright (c) 2009 - 2010 Brendan Hickey - http://bhickey.net
+-- New 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.
@@ -12,11 +12,11 @@ import Prelude hiding (head, tail, null)
data (Ord n) => BinaryHeap n =
Leaf
- | Node n Int (BinaryHeap n) (BinaryHeap n) deriving (Eq, Ord)
+ | 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) ++ ")"
+ show (Node n _ h1 h2) = "Node " ++ show n ++ " (" ++ show h1 ++ " " ++ show h2 ++ ")"
rank :: (Ord n) => BinaryHeap n -> Int
rank Leaf = 0
@@ -34,16 +34,16 @@ singleton a = Node a 1 Leaf Leaf
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
+merge h1@(Node n1 d1 h1l h1r) h2@(Node n2 d2 _ _) =
+ if n1<n2 || (n1==n2 && d1<=d2)
then if rank h1l < rank h1r
- then (Node n1 (d1 + d2) (merge h1l h2) h1r)
- else (Node n1 (d1 + d2) h1l (merge h1r h2))
+ 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)
+insert :: (Ord a) => a -> BinaryHeap a -> BinaryHeap a
+insert a h = merge h (singleton a)
-- | /O(1)/.
null :: (Ord a) => BinaryHeap a -> Bool
@@ -53,17 +53,16 @@ null _ = False
-- | /O(n lg n)/.
toList :: (Ord a) => BinaryHeap a -> [a]
toList Leaf = []
-toList h@(Node _ _ _ _) = (head h):(toList $ tail h)
+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
+fromList l = mergeList (map singleton l)
+ where mergeList [a] = a
+ mergeList x = mergeList (mergePairs x)
+ mergePairs (a:b:c) = merge a b : mergePairs c
+ mergePairs x = x
-- | /O(1)/. 'head' returns the element root of the heap.
head :: (Ord a) => BinaryHeap a -> a