heap 0.2.2 → 0.2.3
raw patch · 4 files changed
+195/−50 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Data/Heap.hs +45/−36
- Test/Heap.hs +123/−0
- Tests.lhs +12/−0
- heap.cabal +15/−14
Data/Heap.hs view
@@ -11,30 +11,31 @@ -- -- This module is best imported @qualified@ in order to prevent name clashes -- with other modules.-module Data.Heap (+module Data.Heap+ ( -- * Heap type- Heap, MinHeap, MaxHeap,- HeapPolicy(..), MinPolicy, MaxPolicy,+ Heap, MinHeap, MaxHeap+ , HeapPolicy(..), MinPolicy, MaxPolicy -- * Query- null, isEmpty, size, head,+ , null, isEmpty, size, head -- * Construction- empty, singleton, insert,- tail, extractHead,+ , empty, singleton, insert+ , tail, extractHead -- * Union- union, unions,+ , union, unions -- * Filter- filter, partition,+ , filter, partition -- * Subranges- take, drop, splitAt,- takeWhile, span, break,+ , take, drop, splitAt+ , takeWhile, span, break -- * Conversion -- ** Lists- fromList, toList, elems,+ , fromList, toList, elems -- ** Ordered lists- fromAscList, toAscList,+ , fromAscList, toAscList -- * Debugging- check-) where+ , check+ ) where import Data.Foldable (Foldable(foldMap)) import Data.List (foldl')@@ -64,12 +65,13 @@ 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+ 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 instance (HeapPolicy p a) => Monoid (Heap p a) where mempty = empty@@ -103,7 +105,7 @@ -- 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 used/.+ 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.@@ -179,9 +181,10 @@ -- | -- /O(log n)/. Find the minimum (depending on the 'HeapPolicy') and--- delete it from the 'Heap'.+-- delete it from the 'Heap'. This function is undefined for an+-- empty 'Heap'. extractHead :: (HeapPolicy p a) => Heap p a -> (a, Heap p a)-extractHead Empty = (error "Heap is empty", empty)+extractHead Empty = error "empty Heap" extractHead (Tree _ x l r) = (x, union l r) -- |@@ -238,13 +241,13 @@ else makeT y l2 (union r2 heap1) -- heap into the right branch, it's shorter -- |--- Combines a value @x@ and two 'Heaps' to one 'Heap'. Therefore, @x@ has to+-- 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+ ra = rank a+ rb = rank b in if ra > rb then Tree (rb + 1) x a b else Tree (ra + 1) x b a@@ -260,6 +263,10 @@ 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.@@ -269,8 +276,9 @@ 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+ where+ (l1, l2) = partition p l+ (r1, r2) = partition p r -- | -- Builds a 'Heap' from the given elements.@@ -305,11 +313,12 @@ 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'+ 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@@ -317,11 +326,11 @@ 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+ 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+ && r == 1 + rightRank -- rank == length of right spine && leftRank >= rightRank -- leftist property && check left && check right
+ Test/Heap.hs view
@@ -0,0 +1,123 @@+module Test.Heap (+ testHeap+) where++import Data.Foldable (foldl)+import Data.Heap as Heap+import Data.List as List hiding (foldl)+import Prelude hiding (foldl)+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)++instance (Arbitrary a, HeapPolicy p a) => Arbitrary (Heap p a) where+ arbitrary = do+ length <- choose (0, 100)+ list <- vector length+ return (Heap.fromList list)+ coarbitrary heap = variant (Heap.size heap)++leftistHeapProperty :: (HeapPolicy p a) => Heap p a -> Bool+leftistHeapProperty = Heap.check++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)++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++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'))++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'++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+ && (xs', heap') == Heap.break p2 heap+-- && ([1..(min length' index')], Heap.fromAscList [(min index' length')..(max length' index')]) == (xs', 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)++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'++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+
+ Tests.lhs view
@@ -0,0 +1,12 @@+#! /usr/bin/env runghc++>+> module Main where+>+> import Test.Heap+>+> main :: IO ()+> main = do+> testHeap+>+
heap.cabal view
@@ -1,19 +1,20 @@-Name: heap-Version: 0.2.2-Stability: beta-Category: Data-Synopsis: Heaps in Haskell-Description: A flexible Haskell heap implementation-License: BSD3-License-File: LICENSE-Copyright: (c) 2008, Stephan Friedrichs-Author: Stephan Friedrichs-Maintainer: stephan[dot]friedrichs[at]tu-bs[dot]de-Build-Type: Custom-Cabal-Version: >=1.2+Name: heap+Version: 0.2.3+Stability: beta+Category: Data, Data Structures+Synopsis: Heaps in Haskell+Description: A flexible Haskell heap implementation+License: BSD3+License-File: LICENSE+Copyright: (c) 2008, Stephan Friedrichs+Author: Stephan Friedrichs+Maintainer: stephan[dot]friedrichs[at]tu-bs[dot]de+Build-Type: Custom+Cabal-Version: >=1.2+Extra-Source-Files: Tests.lhs, Test/Heap.hs Library Build-Depends: base Exposed-Modules: Data.Heap- ghc-options: -O2 -Wall+ ghc-options: -Wall Extensions: CPP