heap 0.3.1 → 0.4.0

raw patch · 4 files changed

+156/−112 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Heap.hs +131/−101
• Test/Heap.hs +22/−8
• Tests.lhs +1/−1
• heap.cabal +2/−2

@@ -1,22 +1,39 @@ {-# LANGUAGE CPP, EmptyDataDecls, FlexibleInstances, MultiParamTypeClasses #-} --- | --- A flexible implementation of min-, max- or custom-priority heaps--- based on the leftist-heaps from Chris Okasaki's book \"Purely Functional Data+-- | A flexible implementation of min-, max- and custom-priority heaps based on+-- the leftist-heaps from Chris Okasaki's book \"Purely Functional Data -- Structures\", Cambridge University Press, 1998, chapter 3.1. ----- If you need a minimum or maximum heap, use 'MinHeap' resp. 'MaxHeap'. If--- you want to define a custom order of the heap elements implement a--- 'HeapPolicy'.+-- There are different flavours of 'Heap's, each of them following a different+-- strategy when ordering its elements: --+--  * Choose 'MinHeap' or 'MaxHeap' if you need a simple minimum or maximum heap+--    (which always keeps the minimum/maximum element at the head of the 'Heap').+--+--  * If you wish to manually annotate a value with a priority, e. g. an+--    @'IO' ()@ action with an 'Int' use 'MinPrioHeap' or 'MaxPrioHeap'. They+--    manage @(priority, value)@ tuples so that only the priority (and not the+--    value) influences the order of elements.+--+--  * If you still need something different, define a custom order for the heap+--    elements by implementing a 'HeapPolicy' and let the maintainer know,+--    what's missing.+-- -- This module is best imported @qualified@ in order to prevent name clashes -- with other modules. module Data.Heap-  ( -- * Heap type-    Heap, MinHeap, MaxHeap-  , HeapPolicy(..), MinPolicy, MaxPolicy+  ( -- * Types+    -- ** Various heap flavours+#ifdef __DEBUG__+    Heap(..)+#else+    Heap+#endif+  , MinHeap, MaxHeap, MinPrioHeap, MaxPrioHeap+    -- ** Ordering policies+  , HeapPolicy(..), MinPolicy, MaxPolicy, FstMinPolicy, FstMaxPolicy     -- * Query-  , null, isEmpty, size, head, tail, extractHead+  , null, isEmpty, size, head, tail, view, extractHead     -- * Construction   , empty, singleton, insert     -- * Union@@ -25,20 +42,20 @@   , filter, partition     -- * Subranges   , take, drop, splitAt-  , takeWhile, span, break+  , takeWhile, dropWhile, span, break     -- * Conversion     -- ** List   , fromList, toList, elems     -- ** Ordered list   , fromAscList, toAscList-    -- * Debugging-  , check   ) where -import Data.Foldable (Foldable(foldMap))-import Data.List (foldl')+import Data.Foldable ( foldl', Foldable(foldMap) )+import qualified Data.Foldable as Foldable ( toList ) import Data.Monoid-import Prelude hiding (break, drop, filter, head, null, tail, span, splitAt, take, takeWhile)+import Data.Ord+import Prelude hiding ( break, drop, dropWhile, filter, head, null, tail, span+                      , splitAt, take, takeWhile ) import Text.Read  -- | The basic 'Heap' type.@@ -52,8 +69,18 @@ -- | A 'Heap' with inverted order: The maximum will be extracted first. type MaxHeap a = Heap MaxPolicy a +-- | A 'Heap' storing priority-value-associations. It only regards the priority+-- for determining the order of elements, the tuple with minimal 'fst' value+-- (i. e. priority) will always be the head of the 'Heap'.+type MinPrioHeap priority value = Heap FstMinPolicy (priority, value)++-- | A 'Heap' storing priority-value-associations. It only regards the priority+-- for determining the order of elements, the tuple with maximal 'fst' value+-- (i. e. priority) will always be the head of the 'Heap'.+type MaxPrioHeap priority value = Heap FstMaxPolicy (priority, value)+ instance (Show a) => Show (Heap p a) where-  show h = "fromList " ++ (show . toList) h+  show = ("fromList " ++) . show . toList  instance (HeapPolicy p a) => Eq (Heap p a) where   h1 == h2 = EQ == compare h1 h2@@ -94,15 +121,14 @@ -- | The 'HeapPolicy' class defines an order on the elements contained within -- a 'Heap'. class HeapPolicy p a where-  -- |-  -- Compare two elements, just like 'compare' of the 'Ord' class,-  -- so this function has to define a mathematical ordering.-  -- When using a 'HeapPolicy' for a 'Heap', the minimal value-  -- (defined by this order) will be the 'head' of the 'Heap'.-  heapCompare :: p    -- ^ /Must not be evaluated/.-    -> a        -- ^ Must be compared to 3rd parameter.-    -> a        -- ^ Must be compared to 2nd parameter.-    -> Ordering -- ^ Result of the comparison.+  -- | Compare two elements, just like 'compare' of the 'Ord' class, so this+  -- function has to define a mathematical ordering. When using a 'HeapPolicy'+  -- for a 'Heap', the minimal value (defined by this order) will be the head+  -- of the 'Heap'.+  heapCompare :: p -- ^ /Must not be evaluated/.+    -> a           -- ^ Must be compared to 3rd parameter.+    -> a           -- ^ Must be compared to 2nd parameter.+    -> Ordering    -- ^ Result of the comparison.  -- | Policy type for a 'MinHeap'. data MinPolicy@@ -110,12 +136,24 @@ instance (Ord a) => HeapPolicy MinPolicy a where   heapCompare = const compare --- | Policy type for a 'MaxHeap'+-- | Policy type for a 'MaxHeap'. data MaxPolicy  instance (Ord a) => HeapPolicy MaxPolicy a where   heapCompare = const (flip compare) +-- | Policy type for a @(priority, value)@ 'MinPrioHeap'.+data FstMinPolicy++instance (Ord priority) => HeapPolicy FstMinPolicy (priority, value) where+  heapCompare = const (comparing fst)++-- | Policy type for a @(priority, value)@ 'MaxPrioHeap'.+data FstMaxPolicy++instance (Ord priority) => HeapPolicy FstMaxPolicy (priority, value) where+  heapCompare = const (flip (comparing fst))+ -- | /O(1)/. Is the 'Heap' empty? null :: Heap p a -> Bool null Empty = True@@ -130,31 +168,45 @@ rank Empty          = 0 rank (Tree r _ _ _) = r --- | Gets the default policy instance for a 'Heap' that can be the first--- parameter of 'heapCompare'. This function always returns 'undefined'.+-- | This function is 'undefined' and just used as a type-helper to determine+-- the first parameter of 'heapCompare'. policy :: Heap p a -> p-policy = const undefined+policy = undefined  -- | /O(n)/. The number of elements in the 'Heap'. size :: (Num n) => Heap p a -> n size Empty          = 0 size (Tree _ _ l r) = 1 + size l + size r --- | /O(1)/. Finds the minimum (depending on the 'HeapPolicy') of the 'Heap'.+-- | /O(1)/. Returns the first item of the 'Heap', according to its 'HeapPolicy'.+--+-- /Warning:/ This function issues an 'error' for empty 'Heap's, please consider+-- using the 'view' function instead, it's not partial. head :: (HeapPolicy p a) => Heap p a -> a head = fst . extractHead --- | /O(log n)/. Delete the minimum (depending on the 'HeapPolicy')--- from the 'Heap'.+-- | /O(log n)/. Returns the 'Heap' with the 'head' removed.+--+-- /Warning:/ This function issues an 'error' for empty 'Heap's, please consider+-- using the 'view' function instead, it's not partial. tail :: (HeapPolicy p a) => Heap p a -> Heap p a tail = snd . extractHead --- | /O(log n)/. Find the minimum (depending on the 'HeapPolicy') and--- delete it from the 'Heap'. This function is undefined for an--- empty 'Heap'.+-- | /O(log n)/ for the tail, /O(1)/ for the head. Find the minimum (depending+-- on the 'HeapPolicy') and delete it from the 'Heap' (i. e. find head and tail+-- of a heap) if it is not empty. Otherwise, 'Nothing' is returned.+view :: (HeapPolicy p a) => Heap p a -> Maybe (a, Heap p a)+view Empty          = Nothing+view (Tree _ x l r) = Just (x, union l r)++{-# INLINE view #-}++-- | /O(log n)/. Returns 'head' and 'tail' of a 'Heap'.+--+-- /Warning:/ This function issues an 'error' for empty 'Heap's, please consider+-- using the 'view' function instead, it's not partial. extractHead :: (HeapPolicy p a) => Heap p a -> (a, Heap p a)-extractHead Empty          = error "empty Heap"-extractHead (Tree _ x l r) = (x, union l r)+extractHead heap = maybe (error "empty heap") id (view heap)  -- | /O(1)/. Constructs an empty 'Heap'. empty :: Heap p a@@ -168,8 +220,8 @@ insert :: (HeapPolicy p a) => a -> Heap p a -> Heap p a insert x h = union h (singleton x) --- | Take the lowest @n@ elements in ascending order of the 'Heap'--- (according to the 'HeapPolicy').+-- | Take the lowest @n@ elements in ascending order of the 'Heap' (according+-- to the 'HeapPolicy'). take :: (HeapPolicy p a) => Int -> Heap p a -> [a] take n = fst . (splitAt n) @@ -178,32 +230,38 @@ drop :: (HeapPolicy p a) => Int -> Heap p a -> Heap p a drop n = snd . (splitAt n) --- | @'splitAt' n h@ returns an ascending list of the lowest @n@--- elements of @h@ (according to its 'HeapPolicy') and a 'Heap'--- like @h@, lacking those elements.+-- | @'splitAt' n h@ returns an ascending list of the lowest @n@ elements of @h@+-- (according to its 'HeapPolicy') and a 'Heap' like @h@, lacking those elements. splitAt :: (HeapPolicy p a) => Int -> Heap p a -> ([a], Heap p a)-splitAt _ Empty     = ([], empty)-splitAt n heap@(Tree _ x l r)-  | n > 0     = let (xs, heap') = splitAt (n-1) (union l r) in (x:xs, heap')+splitAt n heap+  | n > 0     = case view heap of+    Nothing      -> ([], empty)+    Just (h, hs) -> let (xs, heap') = splitAt (n-1) hs in (h:xs, heap')   | otherwise = ([], heap) --- | @'takeWhile' p h@ lists the longest prefix of elements in ascending--- order (according to its 'HeapPolicy') of @h@ that satisfy @p@.+-- | @'takeWhile' p h@ lists the longest prefix of elements in ascending order+-- (according to its 'HeapPolicy') of @h@ that satisfy @p@. takeWhile :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> [a] takeWhile p = fst . (span p) --- | @'span' p h@ returns the longest prefix of elements in ascending--- order (according to its 'HeapPolicy') of @h@ that satisfy @p@ and--- a 'Heap' like @h@, lacking those elements.+-- | @'dropWhile' p h@ removes the longest prefix of elements from @h@ that+-- satisfy @p@.+dropWhile :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> Heap p a+dropWhile p = snd . (span p)++-- | @'span' p h@ returns the longest prefix of elements in ascending order+-- (according to its 'HeapPolicy') of @h@ that satisfy @p@ and a 'Heap' like+-- @h@, with those elements removed. span :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> ([a], Heap p a)-span _ Empty        = ([], empty)-span p heap@(Tree _ x l r)-  | p x       = let (xs, heap') = span p (union l r) in (x:xs, heap')-  | otherwise = ([], heap)+span p heap = case view heap of+  Nothing      -> ([], empty)+  Just (h, hs) -> if p h+    then let (xs, heap') = span p hs in (h:xs, heap')+    else ([], heap) --- | @'break' p h@ returns the longest prefix of elements in ascending--- order (according to its 'HeapPolicy') of @h@ that do /not/ satisfy @p@--- and a 'Heap' like @h@, lacking those elements.+-- | @'break' p h@ returns the longest prefix of elements in ascending order+-- (according to its 'HeapPolicy') of @h@ that do /not/ satisfy @p@ and a 'Heap'+-- like @h@, with those elements removed. break :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> ([a], Heap p a) break p = span (not . p) @@ -217,8 +275,8 @@     else makeT y l2 (union r2 heap1) -- heap into the right branch, it's shorter  -- | Combines a value @x@ and two 'Heap's to one 'Heap'. Therefore, @x@ has to--- be less or equal the minima (depending on the 'HeapPolicy') of both--- 'Heap' parameters. /The precondition is not checked/.+-- be less or equal the minima (depending on the 'HeapPolicy') of both 'Heap'+-- parameters. /The precondition is not checked/. makeT :: a -> Heap p a -> Heap p a -> Heap p a makeT x a b = let   ra = rank a@@ -231,8 +289,7 @@ unions :: (HeapPolicy p a) => [Heap p a] -> Heap p a unions = foldl' union empty --- | Removes all elements from a given 'Heap' that do not fulfil the--- predicate.+-- | Removes all elements from a given 'Heap' that do not fulfil the predicate. filter :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> Heap p a filter p = fst . (partition p) @@ -240,9 +297,8 @@   "filter/filter" forall p1 p2 h. filter p2 (filter p1 h) = filter (\x -> p1 x && p2 x) h   #-} --- | Partition the 'Heap' into two. @'partition' p h = (h1, h2)@:--- All elements in @h1@ fulfil the predicate @p@, those in @h2@ don't.--- @'union' h1 h2 = h@.+-- | Partition the 'Heap' into two. @'partition' p h = (h1, h2)@: All elements+-- in @h1@ fulfil the predicate @p@, those in @h2@ don't. @'union' h1 h2 = h@. partition :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> (Heap p a, Heap p a) partition _ Empty = (empty, empty) partition p (Tree _ x l r)@@ -252,53 +308,27 @@   (l1, l2) = partition p l   (r1, r2) = partition p r --- | Builds a 'Heap' from the given elements.--- You may want to use 'fromAscList', if you have a sorted list.+-- | Builds a 'Heap' from the given elements. You may want to use 'fromAscList',+-- if you have a sorted list. fromList :: (HeapPolicy p a) => [a] -> Heap p a fromList = unions . (map singleton)  -- | /O(n)/. Lists elements of the 'Heap' in no specific order. toList :: Heap p a -> [a]-toList Empty          = []-toList (Tree _ x l r) = x : toList l ++ toList r+toList = Foldable.toList  -- | /O(n)/. Lists elements of the 'Heap' in no specific order. elems :: Heap p a -> [a] elems = toList --- | /O(n)/. Creates a 'Heap' from an ascending list. Note that the list--- has to be ascending corresponding to the 'HeapPolicy', not to its--- 'Ord' instance declaration (if there is one).--- /The precondition is not checked/.+-- | /O(n)/. Creates a 'Heap' from an ascending list. Note that the list has to+-- be ascending corresponding to the 'HeapPolicy', not to its 'Ord' instance+-- declaration (if there is one). /The precondition is not checked/. fromAscList :: (HeapPolicy p a) => [a] -> Heap p a---fromAscList []     = empty---fromAscList (x:xs) = Tree 1 x (fromAscList xs) empty-fromAscList = fromList -- Just as fast, but needs less memory. Why?+fromAscList = fromList --- | /O(n)/. Lists elements of the 'Heap' in ascending order (corresponding--- to the 'HeapPolicy').+-- | /O(n)/. Lists elements of the 'Heap' in ascending order (corresponding to+-- the 'HeapPolicy'). toAscList :: (HeapPolicy p a) => Heap p a -> [a]-toAscList Empty            = []-toAscList h@(Tree _ e l r) = e : mergeLists (toAscList l) (toAscList r)-  where-  mergeLists [] ys = ys-  mergeLists xs [] = xs-  mergeLists xs@(x:xs') ys@(y:ys') = if LT == heapCompare (policy h) x y-    then x : mergeLists xs' ys-    else y : mergeLists xs  ys'---- | Sanity checks for debugging. This includes checking the ranks and--- the heap and leftist (the left rank is at least the right rank) properties.-check :: (HeapPolicy p a) => Heap p a -> Bool-check Empty                   = True-check h@(Tree r x left right) = let-  leftRank  = rank left-  rightRank = rank right-  in-  (null left || LT /= heapCompare (policy h) (head left) x) -- heap property-    && (null right || LT /= heapCompare (policy h) (head right) x) -- dito-    && r == 1 + rightRank    -- rank == length of right spine-    && leftRank >= rightRank -- leftist property-    && check left-    && check right+toAscList = takeWhile (const True) 

@@ -44,7 +44,20 @@     return (Heap.fromList list)  leftistHeapProperty :: (HeapPolicy p a) => Heap p a -> Bool-leftistHeapProperty = Heap.check+leftistHeapProperty Empty                   = True+leftistHeapProperty h@(Tree r x left right) = let+  leftRank  = rank left+  rightRank = rank right+  in+  (maybe True (\(lHead, _) -> LT /= heapCompare (policy h) lHead x) (view left))+    && (maybe True (\(rHead, _) -> LT /= heapCompare (policy h) rHead x) (view right))+    && r == 1 + rightRank    -- rank == length of right spine+    && leftRank >= rightRank -- leftist property+    && leftistHeapProperty left+    && leftistHeapProperty right+    where+    rank Empty          = 0+    rank (Tree r _ _ _) = r  sizeProperty :: Int -> Bool sizeProperty n = let@@ -70,13 +83,13 @@ policy = const undefined  headTailProperty :: [Int] -> Bool-headTailProperty [] = True-headTailProperty xs = let-  heap = fromList xs :: MaxHeap Int-  xs'  = sortBy (heapCompare (policy heap)) xs-  in-  Heap.head heap == List.head xs'-    && Heap.tail heap == (fromAscList (List.tail xs'))+headTailProperty []          = True+headTailProperty list@(x:xs) = let+  heap  = fromList list :: MaxHeap Int+  list' = sortBy (heapCompare (policy heap)) list+  in case view heap of+    Nothing      -> False -- list is not empty+    Just (h, hs) -> h == List.head list' && hs == (fromAscList (List.tail list'))  takeDropSplitAtProperty :: (Ord a) => Int -> MinHeap a -> Bool takeDropSplitAtProperty n heap = let@@ -97,6 +110,7 @@   (xs', heap') = Heap.span p1 heap   in   xs' == Heap.takeWhile p1 heap+    && heap' == Heap.dropWhile p1 heap     && (xs', heap') == Heap.break p2 heap  readShowProperty :: (HeapPolicy p a, Show a, Read a) => Heap p a -> Bool

@@ -1,4 +1,4 @@-#! /usr/bin/env runghc+#! /usr/bin/runghc -D__DEBUG__  > > module Main where

@@ -1,6 +1,6 @@  Name:                heap-Version:             0.3.1+Version:             0.4.0 Stability:           beta  Category:            Data Structures@@ -21,6 +21,6 @@ Library   Build-Depends:     base   Exposed-Modules:   Data.Heap-  ghc-options:       -Wall+  ghc-options:       -O2 -Wall   Extensions:        CPP