heap 0.4.0 → 0.5.0
raw patch · 3 files changed
+197/−214 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Data.Heap: instance Foldable (Heap p)
- Data.Heap: size :: (Num n) => Heap p a -> n
+ Data.Heap: size :: Heap p a -> Int
Files
- Data/Heap.hs +99/−106
- Test/Heap.hs +97/−107
- heap.cabal +1/−1
Data/Heap.hs view
@@ -22,36 +22,35 @@ -- This module is best imported @qualified@ in order to prevent name clashes -- with other modules. module Data.Heap- ( -- * Types- -- ** Various heap flavours+ ( -- * Types+ -- ** Various heap flavours #ifdef __DEBUG__- Heap(..)+ Heap(..), rank, policy #else- Heap+ Heap #endif- , MinHeap, MaxHeap, MinPrioHeap, MaxPrioHeap- -- ** Ordering policies- , HeapPolicy(..), MinPolicy, MaxPolicy, FstMinPolicy, FstMaxPolicy- -- * Query- , null, isEmpty, size, head, tail, view, extractHead- -- * Construction- , empty, singleton, insert- -- * Union- , union, unions- -- * Filter- , filter, partition- -- * Subranges- , take, drop, splitAt- , takeWhile, dropWhile, span, break- -- * Conversion- -- ** List- , fromList, toList, elems- -- ** Ordered list- , fromAscList, toAscList- ) where+ , MinHeap, MaxHeap, MinPrioHeap, MaxPrioHeap+ -- ** Ordering policies+ , HeapPolicy(..), MinPolicy, MaxPolicy, FstMinPolicy, FstMaxPolicy+ -- * Query+ , null, isEmpty, size, head, tail, view, extractHead+ -- * Construction+ , empty, singleton, insert+ -- * Union+ , union, unions+ -- * Filter+ , filter, partition+ -- * Subranges+ , take, drop, splitAt+ , takeWhile, dropWhile, span, break+ -- * Conversion+ -- ** List+ , fromList, toList, elems+ -- ** Ordered list+ , fromAscList, toAscList+ ) where -import Data.Foldable ( foldl', Foldable(foldMap) )-import qualified Data.Foldable as Foldable ( toList )+import Data.Foldable ( foldl' ) import Data.Monoid import Data.Ord import Prelude hiding ( break, drop, dropWhile, filter, head, null, tail, span@@ -60,8 +59,8 @@ -- | The basic 'Heap' type. data Heap p a- = Empty- | Tree {-# UNPACK #-} !Int a !(Heap p a) !(Heap p a)+ = Empty -- rank, size, elem, left, right+ | Tree {-# UNPACK #-} !Int {-# UNPACK #-} !Int a !(Heap p a) !(Heap p a) -- | A 'Heap' which will always extract the minimum first. type MinHeap a = Heap MinPolicy a@@ -80,79 +79,74 @@ type MaxPrioHeap priority value = Heap FstMaxPolicy (priority, value) instance (Show a) => Show (Heap p a) where- show = ("fromList " ++) . show . toList+ show = ("fromList " ++) . show . toList instance (HeapPolicy p a) => Eq (Heap p a) where- h1 == h2 = EQ == compare h1 h2+ h1 == h2 = EQ == compare h1 h2 instance (HeapPolicy p a) => Ord (Heap p a) where- compare h1 h2 = compare' (toAscList h1) (toAscList h2)- where- compare' [] [] = EQ- compare' [] _ = LT- compare' _ [] = GT- compare' (x:xs) (y:ys) = case heapCompare (policy h1) x y of- EQ -> compare' xs ys- c -> c+ compare h1 h2 = compareBy (heapCompare (policy h1)) (toAscList h1) (toAscList h2)+ where+ compareBy :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering+ compareBy _ [] [] = EQ+ compareBy _ [] _ = LT+ compareBy _ _ [] = GT+ compareBy cmp (x:xs) (y:ys) = mappend (cmp x y) (compareBy cmp xs ys) instance (HeapPolicy p a) => Monoid (Heap p a) where- mempty = empty- mappend = union- mconcat = unions--instance Foldable (Heap p) where- foldMap _ Empty = mempty- foldMap f (Tree _ x l r) = foldMap f l `mappend` f x `mappend` foldMap f r+ mempty = empty+ mappend = union+ mconcat = unions instance (HeapPolicy p a, Read a) => Read (Heap p a) where #ifdef __GLASGOW_HASKELL__- readPrec = parens $ prec 10 $ do- Ident "fromList" <- lexP- xs <- readPrec- return (fromList xs)- readListPrec = readListPrecDefault+ readPrec = parens $ prec 10 $ do+ Ident "fromList" <- lexP+ xs <- readPrec+ return (fromList xs)+ readListPrec = readListPrecDefault #else- readsPrec p = readParen (p > 10) $ \r -> do- ("fromList", s) <- lex r- (xs, t) <- reads s- return (fromList xs, t)+ readsPrec p = readParen (p > 10) $ \r -> do+ ("fromList", s) <- lex r+ (xs, t) <- reads s+ return (fromList xs, t) #endif -- | 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 -- ^ Compared to 3rd parameter.+ -> a -- ^ Compared to 2nd parameter.+ -> Ordering -- ^ Result of the comparison. -- | Policy type for a 'MinHeap'. data MinPolicy instance (Ord a) => HeapPolicy MinPolicy a where- heapCompare = const compare+ heapCompare = const compare -- | Policy type for a 'MaxHeap'. data MaxPolicy instance (Ord a) => HeapPolicy MaxPolicy a where- heapCompare = const (flip compare)+ 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)+ 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))+ heapCompare = const (flip (comparing fst)) -- | /O(1)/. Is the 'Heap' empty? null :: Heap p a -> Bool@@ -165,19 +159,19 @@ -- | /O(1)/. Calculate the rank of a 'Heap'. rank :: Heap p a -> Int-rank Empty = 0-rank (Tree r _ _ _) = r+rank Empty = 0+rank (Tree r _ _ _ _) = r +-- | /O(1)/. The number of elements in the 'Heap'.+size :: Heap p a -> Int+size Empty = 0+size (Tree _ s _ _ _) = s+ -- | This function is 'undefined' and just used as a type-helper to determine -- the first parameter of 'heapCompare'. policy :: Heap p a -> p 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)/. Returns the first item of the 'Heap', according to its 'HeapPolicy'. -- -- /Warning:/ This function issues an 'error' for empty 'Heap's, please consider@@ -196,8 +190,8 @@ -- 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)+view Empty = Nothing+view (Tree _ _ x l r) = Just (x, union l r) {-# INLINE view #-} @@ -206,7 +200,7 @@ -- /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 heap = maybe (error "empty heap") id (view heap)+extractHead heap = maybe (error (__FILE__ ++ ": empty heap in extractHead")) id (view heap) -- | /O(1)/. Constructs an empty 'Heap'. empty :: Heap p a@@ -214,7 +208,7 @@ -- | /O(1)/. Create a singleton 'Heap'. singleton :: a -> Heap p a-singleton x = Tree 1 x empty empty+singleton x = Tree 1 1 x empty empty -- | /O(log n)/. Insert an element in the 'Heap'. insert :: (HeapPolicy p a) => a -> Heap p a -> Heap p a@@ -234,10 +228,10 @@ -- (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 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)+ | 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@.@@ -254,10 +248,10 @@ -- @h@, with those elements removed. span :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> ([a], Heap p a) 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)+ 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'@@ -269,21 +263,22 @@ union :: (HeapPolicy p a) => Heap p a -> Heap p a -> Heap p a union h Empty = h union Empty h = h-union heap1@(Tree _ x l1 r1) heap2@(Tree _ y l2 r2) =- if LT == heapCompare (policy heap1) x y- then makeT x l1 (union r1 heap2) -- keep smallest number on top and merge the other- else makeT y l2 (union r2 heap1) -- heap into the right branch, it's shorter+union heap1@(Tree _ _ x l1 r1) heap2@(Tree _ _ y l2 r2) =+ if LT == heapCompare (policy heap1) x y+ then makeT x l1 (union r1 heap2) -- keep smallest number on top and merge the other+ 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/. makeT :: a -> Heap p a -> Heap p a -> Heap p a makeT x a b = let- ra = rank a- rb = rank b- in if ra > rb- then Tree (rb + 1) x a b- else Tree (ra + 1) x b a+ ra = rank a+ rb = rank b+ s = size a + size b + 1+ in if ra > rb+ then Tree (rb + 1) s x a b+ else Tree (ra + 1) s x b a -- | Builds the union over all given 'Heap's. unions :: (HeapPolicy p a) => [Heap p a] -> Heap p a@@ -293,20 +288,16 @@ filter :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> Heap p a filter p = fst . (partition p) -{-# RULES- "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 :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> (Heap p a, Heap p a) partition _ Empty = (empty, empty)-partition p (Tree _ x l r)- | p x = (makeT x l1 r1, union l2 r2)- | otherwise = (union l1 r1, makeT x l2 r2)- where- (l1, l2) = partition p l- (r1, r2) = partition p r+partition p (Tree _ _ x l r)+ | p x = (makeT x l1 r1, union l2 r2)+ | otherwise = (union l1 r1, makeT x l2 r2)+ where+ (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.@@ -315,7 +306,10 @@ -- | /O(n)/. Lists elements of the 'Heap' in no specific order. toList :: Heap p a -> [a]-toList = Foldable.toList+toList Empty = []+toList (Tree _ _ x l r) = x : if size r < size l+ then toList r ++ toList l+ else toList l ++ toList r -- | /O(n)/. Lists elements of the 'Heap' in no specific order. elems :: Heap p a -> [a]@@ -331,4 +325,3 @@ -- the 'HeapPolicy'). toAscList :: (HeapPolicy p a) => Heap p a -> [a] toAscList = takeWhile (const True)-
Test/Heap.hs view
@@ -1,146 +1,136 @@ module Test.Heap- ( testHeap- ) where+ ( testHeap+ ) where -import Data.Foldable (foldl) import Data.Heap as Heap-import Data.List as List hiding (foldl)-import Prelude hiding (foldl)+import Data.List as List import Test.QuickCheck testHeap :: IO () testHeap = do- putStr "Leftist property of MinHeap Int: "- quickCheck (leftistHeapProperty :: MinHeap Int -> Bool)- putStr "Leftist property of MaxHeap Int: "- quickCheck (leftistHeapProperty :: MaxHeap Int -> Bool)- putStr "Size property: "- quickCheck sizeProperty- putStr "Order property: "- quickCheck orderProperty- putStr "head/tail property: "- quickCheck headTailProperty- putStr "take/drop/splitAt "- quickCheck (takeDropSplitAtProperty :: Int -> MinHeap Int -> Bool)- putStr "takeWhile/span/break "- quickCheck takeWhileSpanBreakProperty- putStr "read . show === id "- quickCheck (readShowProperty :: MinHeap Int -> Bool)- putStr "fold "- quickCheck (foldProperty :: MaxHeap Int -> Bool)- putStr "fromList vs. fromAscList "- quickCheck (fromListProperty :: [Int] -> Bool)- putStr "toList === elems "- quickCheck (toListProperty :: MaxHeap Int -> Bool)- putStr "partition and filter "- quickCheck (partitionFilterProperty (\x -> x `mod` 2 == 0) :: MinHeap Int -> Bool)- putStr "ordering property "- quickCheck (orderingProperty :: MinHeap Int -> MinHeap Int -> Bool)+ putStr "Leftist property of MinHeap Int: "+ quickCheck (leftistHeapProperty :: MinHeap Int -> Bool)+ putStr "Leftist property of MaxHeap Int: "+ quickCheck (leftistHeapProperty :: MaxHeap Int -> Bool)+ putStr "Size property: "+ quickCheck sizeProperty+ putStr "Order property: "+ quickCheck orderProperty+ putStr "head/tail property: "+ quickCheck headTailProperty+ putStr "take/drop/splitAt "+ quickCheck (takeDropSplitAtProperty :: Int -> MinHeap Int -> Bool)+ putStr "takeWhile/span/break "+ quickCheck takeWhileSpanBreakProperty+ putStr "read . show === id "+ quickCheck (readShowProperty :: MinHeap Int -> Bool)+ putStr "fromList vs. fromAscList "+ quickCheck (fromListProperty :: [Int] -> Bool)+ putStr "toList === elems "+ quickCheck (toListProperty :: MaxHeap Int -> Bool)+ putStr "partition and filter "+ quickCheck (partitionFilterProperty (\x -> x `mod` 2 == 0) :: MinHeap Int -> Bool)+ putStr "ordering property "+ quickCheck (orderingProperty :: MinHeap Int -> MinHeap Int -> Bool) instance (Arbitrary a, HeapPolicy p a) => Arbitrary (Heap p a) where- arbitrary = do- length <- choose (0, 100)- list <- vector length- return (Heap.fromList list)+ arbitrary = do+ len <- choose (0, 100)+ list <- vector len+ return (Heap.fromList list) leftistHeapProperty :: (HeapPolicy p a) => Heap p a -> Bool-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+leftistHeapProperty Empty = True+leftistHeapProperty h@(Tree r s 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+ && s == 1 + size left + size right -- check size+ && leftistHeapProperty left+ && leftistHeapProperty right sizeProperty :: Int -> Bool sizeProperty n = let- n' = abs n- h = Heap.fromList [1..n'] :: MaxHeap Int- in- Heap.size h == n' && (if n' == 0 then Heap.isEmpty h && Heap.null h else True)+ n' = abs n `mod` 100+ h = Heap.fromList [1..n'] :: MaxHeap Int+ in+ Heap.size h == n' && (if n' == 0 then Heap.isEmpty h && Heap.null h else True) orderProperty :: Int -> [Int] -> Bool-orderProperty n xs = let- heap = Heap.fromList xs :: MaxHeap Int- (a, b) = List.splitAt n (sortBy (heapCompare (policy heap)) xs)- (a', heap') = Heap.splitAt n heap- in- (Heap.fromList b == heap') && equal heap a a'- where- equal _ [] [] = True- equal _ _ [] = False- equal _ [] _ = False- equal h (x:xs) (y:ys) = EQ == heapCompare (policy h) x y--policy :: Heap p a -> p-policy = const undefined+orderProperty n list = let+ n' = signum n * (n `mod` 100)+ heap = Heap.fromList list :: MaxHeap Int+ (a, b) = List.splitAt n' (sortBy (heapCompare (policy heap)) list)+ (a', heap') = Heap.splitAt n' heap+ in+ (Heap.fromList b == heap') && equal heap a a'+ where+ equal _ [] [] = True+ equal _ _ [] = False+ equal _ [] _ = False+ equal h (x:xs) (y:ys) = EQ == heapCompare (policy h) x y && equal h xs ys headTailProperty :: [Int] -> Bool-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'))+headTailProperty [] = True+headTailProperty list = 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- (begin, end) = Heap.splitAt n heap- begin' = Heap.take n heap- end' = Heap.drop n heap- in- begin == begin' && end == end'+ n' = signum n * (n `mod` 100)+ (begin, end) = Heap.splitAt n heap+ begin' = Heap.take n heap+ end' = Heap.drop n heap+ in+ begin == begin' && end == end' takeWhileSpanBreakProperty :: Int -> Int -> Bool-takeWhileSpanBreakProperty length index = let- length' = abs length- index' = abs index- xs = [1..(max length' index')]- heap = Heap.fromAscList xs :: MinHeap Int- p1 x = x <= index'- p2 x = x > index'- (xs', heap') = Heap.span p1 heap- in- xs' == Heap.takeWhile p1 heap- && heap' == Heap.dropWhile p1 heap- && (xs', heap') == Heap.break p2 heap+takeWhileSpanBreakProperty len index = let+ length' = abs (len `mod` 100)+ index' = abs (index `mod` 100)+ xs = [1..(max length' index')]+ heap = Heap.fromAscList xs :: MinHeap Int+ p1 x = x <= index'+ p2 x = x > index'+ (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 readShowProperty heap = heap == read (show heap) -foldProperty :: (HeapPolicy p a, Num a) => Heap p a -> Bool-foldProperty heap = foldl (+) 0 heap == foldl (+) 0 (toList heap)- fromListProperty :: [Int] -> Bool fromListProperty xs = let- xs' = sort xs- in- (fromList xs' :: MinHeap Int) == (fromAscList xs' :: MinHeap Int)+ xs' = sort xs+ in+ (fromList xs' :: MinHeap Int) == (fromAscList xs' :: MinHeap Int) toListProperty :: (HeapPolicy p a, Eq a) => Heap p a -> Bool toListProperty heap = toList heap == elems heap partitionFilterProperty :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> Bool partitionFilterProperty p heap = let- (yes, no) = Heap.partition p heap- (yes', no') = List.partition p (toList heap)- in- yes == fromList yes'- && no == fromList no'- && (Heap.filter p heap) == fromList yes'+ (yes, no) = Heap.partition p heap+ (yes', no') = List.partition p (toList heap)+ in+ yes == fromList yes'+ && no == fromList no'+ && (Heap.filter p heap) == fromList yes' orderingProperty :: (Ord a) => MinHeap a -> MinHeap a -> Bool orderingProperty heap1 heap2 = let- list1 = toAscList heap1- list2 = toAscList heap2- in- compare heap1 heap2 == compare list1 list2+ list1 = toAscList heap1+ list2 = toAscList heap2+ in+ compare heap1 heap2 == compare list1 list2
heap.cabal view
@@ -1,6 +1,6 @@ Name: heap-Version: 0.4.0+Version: 0.5.0 Stability: beta Category: Data Structures