data-ordlist 0.2 → 0.4
raw patch · 5 files changed
+441/−81 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.List.Ordered: mergeAll :: (Ord a) => [[a]] -> [a]
+ Data.List.Ordered: mergeAllBy :: (a -> a -> Ordering) -> [[a]] -> [a]
+ Data.List.Ordered: unionAll :: (Ord a) => [[a]] -> [a]
+ Data.List.Ordered: unionAllBy :: (a -> a -> Ordering) -> [[a]] -> [a]
Files
- AUTHORS +1/−1
- CHANGES +60/−0
- Data/List/Ordered.hs +224/−77
- data-ordlist.cabal +4/−3
- test/Main.hs +152/−0
AUTHORS view
@@ -1,1 +1,1 @@-leon at melding-monads dot com+"Leon P Smith" <leon@melding-monads.com>
+ CHANGES view
@@ -0,0 +1,60 @@+Version 0.4: (2010-02-15)++ * The "CHANGES" file was added to document the changes between releases.++ * Documentation Improvements++ * A rough first pass at a test suite++ * The functions `mergeAll` and `unionAll` were added. They operate+ on a possibly infinite list of possibly infinite ordered lists; assuming+ the heads of the lists are ordered.++ Thanks goes to Omar Antolín Camarena, Heinrich Apfelmus, and Dave Bayer.++ Omar Antolín Camarena suggested the addition, located the article+ used as the basis for the implementation, and was quite helpful with+ testing and debugging.++ Heinrich Apfelmus wrote his "Implicit Heaps" article, where he+ simplified an algorithm by Dave Bayer. It is this article that forms+ the basis of our implementation.++ <http://apfelmus.nfshost.com/articles/implicit-heaps.html>++ Dave Bayer posted his 'venturi' implementation to the haskell-cafe+ mailing list on 2007 Jul 22. It also appears as "BayerPrimes.hs"+ inside of Melissa O'Neill's "haskell-primes.zip":++ <http://www.mail-archive.com/haskell-cafe@haskell.org/msg27612.html>+ <http://www.cs.hmc.edu/~oneill/code/haskell-primes.zip>++Version 0.2: (2010-02-07)++ * The module name was changed from `Data.OrdList` to `Data.List.Ordered`++ * Fixed bugs in `insertSetBy`, `insertBagBy`, and `nub`. The insertion+ functions assumed reversed lists, while `nub` failed to remove duplicates.++ Thanks to Topi Karvonen for reporting the first issue!++ * Changed semantics of `insertSetBy` slightly: the new version replaces an+ element if it is already there. If the old semantics turns out to be+ important, a new function can be added at a later date.++ * Changed semantics of `nubBy`: the new version negates the binary relation,+ so that `new_nubBy f == old_nubBy (not . f)`. It is now in better keeping+ with the spirit of the rest of the library, and mades the bug in `nub`+ more obvious.++ * Better documentation, I hope. At the very least, the process of+ documenting `nubBy` revealed the bug in `nub`.+++Version 0.0.1: (2009-07-10)++ * The initial release, sadly, did not contain the source file++Version 0.0: (2009-07-10)++ * Initial Release
Data/List/Ordered.hs view
@@ -37,6 +37,8 @@ , minus, minusBy , xunion, xunionBy , merge, mergeBy+ , mergeAll, mergeAllBy+ , unionAll, unionAllBy -- * Lists to Ordered Lists , nub, nubBy@@ -49,11 +51,12 @@ import Data.List(sort,sortBy) --- | 'isSorted' returns 'True' if the elements of a list occur in non-descending order, equivalent to 'isSortedBy' ('<=')+-- | The 'isSorted' predicate returns 'True' if the elements of a list occur in non-descending order, equivalent to 'isSortedBy' ('<='). isSorted :: (Ord a) => [a] -> Bool isSorted = isSortedBy (<=) --- | 'isSortedBy' returns 'True' if the predicate returns true for all adjacent pairs of elements in the list+-- | The 'isSortedBy' function returns 'True' iff the predicate returns true+-- for all adjacent pairs of elements in the list. isSortedBy :: (a -> a -> Bool) -> [a] -> Bool isSortedBy lte = loop where@@ -61,11 +64,12 @@ loop [_] = True loop (x:y:zs) = (x `lte` y) && loop (y:zs) --- | 'member' returns 'True' if the element appears in the ordered list+-- | The 'member' function returns 'True' if the element appears in the+-- ordered list. member :: (Ord a) => a -> [a] -> Bool member = memberBy compare --- | 'memberBy' is the non-overloaded version of 'member'+-- | The 'memberBy' function is the non-overloaded version of 'member'. memberBy :: (a -> a -> Ordering) -> a -> [a] -> Bool memberBy cmp x = loop where@@ -75,19 +79,22 @@ EQ -> True GT -> loop ys --- | 'has' returns 'True' if the element appears in the list; it is a function from an ordered list to its characteristic function.+-- | The 'has' function returns 'True' if the element appears in the list;+-- it is equivalent to 'member' except the order of the arguments is reversed,+-- making it a function from an ordered list to its characteristic function. has :: (Ord a) => [a] -> a -> Bool has xs y = memberBy compare y xs --- | 'hasBy' is the non-overloaded version of 'has'+-- | The 'hasBy' function is the non-overloaded version of 'has'. hasBy :: (a -> a -> Ordering) -> [a] -> a -> Bool hasBy cmp xs y = memberBy cmp y xs --- | 'insertBag' inserts an element into a list, allowing for duplicate elements+-- | The 'insertBag' function inserts an element into a list. If the element+-- is already there, then another copy of the element is inserted. insertBag :: (Ord a) => a -> [a] -> [a] insertBag = insertBagBy compare --- | 'insertBagBy' is the non-overloaded version of 'insertBag'+-- | The 'insertBagBy' function is the non-overloaded version of 'insertBag'. insertBagBy :: (a -> a -> Ordering) -> a -> [a] -> [a] insertBagBy cmp = loop where@@ -97,11 +104,13 @@ GT -> y:loop x ys _ -> x:y:ys --- | 'insertSet' inserts an element into an ordered list, or replaces the first occurrence if it is already there.+-- | The 'insertSet' function inserts an element into an ordered list.+-- If the element is already there, then the element replaces the existing+-- element. insertSet :: (Ord a) => a -> [a] -> [a] insertSet = insertSetBy compare --- | 'insertSetBy' is the non-overloaded version of 'insertSet'+-- | The 'insertSetBy' function is the non-overloaded version of 'insertSet'. insertSetBy :: (a -> a -> Ordering) -> a -> [a] -> [a] insertSetBy cmp = loop where@@ -111,16 +120,56 @@ EQ -> x:ys GT -> y:loop x ys --- | 'isect' computes the intersection of two ordered lists.--- The result contains those elements contained in both arguments+{-+-- This function is moderately interesting, as it encompasses all the+-- "venn diagram" functions on two sets. (though not merge; which isn't+-- a set function)++-- However, it doesn't seem that useful, considering that of the 8 possible+-- functions, there are only 4 interesting variations: isect, union, minus,+-- and xunion. Due to interactions with GHC's optimizer, coded seperately,+-- these have a smaller combined object code size than the object code size+-- for genSectBy. (Or, turn off certain optimizations and lose speed.)++-- Each individual object code can be recovered from genSectBy via GHC's+-- inliner and constant propogation; but this doesn't save much in terms+-- of source code size and reduces portability.++-- Note that the Static Argument Transformation is necessary for this to work+-- correctly; inlining genSectBy allows for cmp and p to be inlined as well,+-- or at least eliminate some indirect jumps. All of the *By functions in+-- this module follow this idiom for this reason.++genSectBy :: (a -> a -> Ordering)+ -> (a -> a -> Bool)+ -> [a] -> [a] -> [a]+genSectBy cmp p = loop+ where+ loop [] ys | p False True = ys+ | otherwise = []+ loop xs [] | p True False = xs+ | otherwise = []+ loop (x:xs) (y:ys)+ = case cmp x y of+ LT | p True False -> x : loop xs (y:ys)+ | otherwise -> loop xs (y:ys)+ EQ | p True True -> x : loop xs ys+ | otherwise -> loop xs ys+ GT | p False True -> y : loop (x:xs) ys+ | otherwise -> loop (x:xs) ys+-}++-- | The 'isect' function computes the intersection of two ordered lists.+-- An element occurs in the output as many times as the minimum number of+-- occurences in either input. If either input is a set, then the output+-- is a set. ----- > isect [1,3,5] [2,4,6] == []--- > isect [2,4,6,8] [3,6,9] == [6]--- > isect [1,2,2,2] [1,1,1,2,2] == [1,2,2]+-- > isect [ 1,2, 3,4 ] [ 3,4, 5,6 ] == [ 3,4 ]+-- > isect [ 1, 2,2,2 ] [ 1,1,1, 2,2 ] == [ 1, 2,2 ] isect :: (Ord a) => [a] -> [a] -> [a] isect = isectBy compare --- | 'isectBy' is the non-overloaded version of 'isect'+-- | The 'isectBy' function is the non-overloaded version of 'isect'. isectBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] isectBy cmp = loop where@@ -132,17 +181,17 @@ EQ -> x : loop xs ys GT -> loop (x:xs) ys --- | 'union' computes the union of two ordered lists.--- The result contains those elements contained in either argument;--- elements that appear in both lists are appear in the result only once.+-- | The 'union' function computes the union of two ordered lists.+-- An element occurs in the output as many times as the maximum number+-- of occurences in either input. If both inputs are sets, then the+-- output is a set. ----- > union [1,3,5] [2,4,6] == [1..6]--- > union [2,4,6,8] [3,6,9] == [2,3,4,6,8,9]--- > union [1,2,2,2] [1,1,1,2,2] == [1,1,1,2,2,2]+-- > union [ 1,2, 3,4 ] [ 3,4, 5,6 ] == [ 1,2, 3,4, 5,6 ]+-- > union [ 1, 2,2,2 ] [ 1,1,1, 2,2 ] == [ 1,1,1, 2,2,2 ] union :: (Ord a) => [a] -> [a] -> [a] union = unionBy compare --- | 'unionBy' is the non-overloaded version of 'union'+-- | The 'unionBy' function is the non-overloaded version of 'union'. unionBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] unionBy cmp = loop where@@ -154,18 +203,17 @@ EQ -> x : loop xs ys GT -> y : loop (x:xs) ys ----- | 'minus' computes the multiset difference of two ordered lists.--- Each occurence of an element in the second argument is removed from the first list, if it is there.+-- | The 'minus' function computes the difference of two ordered lists.+-- An element occurs in the output as many times as it occurs in+-- the first input, minus the number of occurrences in the second input.+-- If the first input is a set, then the output is a set. ----- > minus [1,3,5] [2,4,6] == [1,3,5]--- > minus [2,4,6,8] [3,6,9] == [2,4,8]--- > minus [1,2,2,2] [1,1,1,2,2] == [2]+-- > minus [ 1,2, 3,4 ] [ 3,4, 5,6 ] == [ 1,2 ]+-- > minus [ 1, 2,2,2 ] [ 1,1,1, 2,2 ] == [ 2 ] minus :: (Ord a) => [a] -> [a] -> [a] minus = minusBy compare --- | 'minusBy' is the non-overloaded version of 'minus'+-- | The 'minusBy' function is the non-overloaded version of 'minus'. minusBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] minusBy cmp = loop where@@ -177,16 +225,17 @@ EQ -> loop xs ys GT -> loop (x:xs) ys --- | 'xunion' computes the multiset exclusive union of two ordered lists.--- The result contains those elements that appear in either list, but not both.+-- | The 'xunion' function computes the exclusive union of two ordered lists.+-- An element occurs in the output as many times as the absolute difference+-- between the number of occurrences in the inputs. If both inputs+-- are sets, then the output is a set. ----- > xunion [1,3,5] [2,4,6] == [1..6]--- > xunion [2,4,6,8] [3,6,9] == [2,3,4,8]--- > xunion [1,2,2,2] [1,1,1,2,2] == [1,1,2]+-- > xunion [ 1,2, 3,4 ] [ 3,4, 5,6 ] == [ 1,2, 5,6 ]+-- > xunion [ 1, 2,2,2 ] [ 1,1,1, 2,2 ] == [ 1,1, 2 ] xunion :: (Ord a) => [a] -> [a] -> [a] xunion = xunionBy compare --- | 'xunionBy' is the non-overloaded version of 'xunion'+-- | The 'xunionBy' function is the non-overloaded version of 'xunion'. xunionBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] xunionBy cmp = loop where@@ -198,32 +247,16 @@ EQ -> loop xs ys GT -> y : loop (x:xs) ys -{--genSectBy cmp p = loop- where- loop [] ys | p False True = ys- | otherwise = []- loop xs [] | p True False = xs- | otherwise = []- loop (x:xs) (y:ys)- = case cmp x y of- LT | p True False -> x : loop xs (y:ys)- | otherwise -> loop xs (y:ys)- EQ | p True True -> x : loop xs ys- | otherwise -> loop xs ys- GT | p False True -> y : loop (x:xs) ys- | otherwise -> loop (x:xs) ys--}---- | 'merge' combines all elements of two ordered lists. The result contains those elements that appear in either list; elements that appear in both lists appear in the result multiple times.+-- | The 'merge' function combines all elements of two ordered lists.+-- An element occurs in the output as many times as the sum of the+-- occurences in the lists. ----- > merge [1,3,5] [2,4,6] == [1,2,3,4,5,6]--- > merge [2,4,6,8] [3,6,9] == [2,3,4,6,6,8,9]--- > merge [1,2,2,2] [1,1,1,2,2] == [1,1,1,1,2,2,2,2,2]+-- > merge [ 1,2, 3,4 ] [ 3,4, 5,6 ] == [ 1,2, 3,3,4,4, 5,6 ]+-- > merge [ 1, 2,2,2 ] [ 1,1,1, 2,2 ] == [ 1,1,1,1, 2,2,2,2,2 ] merge :: (Ord a) => [a] -> [a] -> [a] merge = mergeBy compare --- | 'mergeBy' is the non-overloaded version of 'merge'+-- | The 'mergeBy' function is the non-overloaded version of 'merge'. mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] mergeBy cmp = loop where@@ -234,11 +267,12 @@ GT -> y : loop (x:xs) ys _ -> x : loop xs (y:ys) --- | 'subset' returns true if the first list is a sub-list of the second.+-- | The 'subset' function returns true if the first list is a sub-list+-- of the second. subset :: (Ord a) => [a] -> [a] -> Bool subset = subsetBy compare --- | 'subsetBy' is the non-overloaded version of 'subset'+-- | The 'subsetBy' function is the non-overloaded version of 'subset'. subsetBy :: (a -> a -> Ordering) -> [a] -> [a] -> Bool subsetBy cmp = loop where@@ -251,12 +285,13 @@ GT -> loop (x:xs) ys {-+-- This is Ian Lynagh's mergesort implementation, which appears as+-- Data.List.sort, with the static argument transformation applied.+-- It's not clear whether this modification is truly worthwhile or not.+ sort :: Ord a => [a] -> [a] sort = sortBy compare --- This is Ian Lynaugh's mergesort implementation provided in Data.List.sort with the--- static argument transformation applied. It's not clear if this is really worthwhile or not.- sortBy :: (a -> a -> Ordering) -> [a] -> [a] sortBy cmp = loop . map (\x -> [x]) where@@ -269,23 +304,27 @@ merge_pairs (xs:ys:xss) = mergeBy cmp xs ys : merge_pairs xss -} --- | 'sortOn' provides the decorate-sort-undecorate idiom, aka the \"Schwartzian transform\"+-- | The 'sortOn' function provides the decorate-sort-undecorate idiom,+-- also known as the \"Schwartzian transform\". sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f = map snd . sortOn' fst . map (\x -> (f x, x)) --- | This variant of 'sortOn' recomputes the function to sort on every comparison. This can is better--- for functions that are cheap to compute, including projections.-+-- | This variant of 'sortOn' recomputes the sorting key every comparison.+-- This can be better for functions that are cheap to compute.+-- This is definitely better for projections, as the decorate-sort-undecorate+-- saves nothing and adds two traversals of the list and extra memory+-- allocation. sortOn' :: Ord b => (a -> b) -> [a] -> [a] sortOn' f = sortBy (\x y -> compare (f x) (f y)) --- | 'nubSort' is equivalent to 'nub' '.' 'sort', except somewhat more efficient as duplicates--- are removed as it sorts. It is essentially Data.List.sort, a mergesort by Ian Lynagh, with--- 'merge' replaced by 'union'.+-- | The 'nubSort' function is equivalent to 'nub' '.' 'sort', except+-- somewhat more efficient as duplicates are removed as it sorts. It is+-- essentially Data.List.sort, a mergesort by Ian Lynagh, with 'merge'+-- replaced by 'union'. nubSort :: Ord a => [a] -> [a] nubSort = nubSortBy compare --- | 'nubSortBy' is the non-overloaded version of 'nubSort'+-- | The 'nubSortBy' function is the non-overloaded version of 'nubSort'. nubSortBy :: (a -> a -> Ordering) -> [a] -> [a] nubSortBy cmp = loop . map (\x -> [x]) where@@ -297,11 +336,11 @@ union_pairs [xs] = [xs] union_pairs (xs:ys:xss) = unionBy cmp xs ys : union_pairs xss --- | 'nubSortOn' provides decorate-sort-undecorate for 'nubSort'+-- | The 'nubSortOn' function provides decorate-sort-undecorate for 'nubSort'. nubSortOn :: Ord b => (a -> b) -> [a] -> [a] nubSortOn f = map snd . nubSortOn' fst . map (\x -> (f x, x)) --- | This variant of 'nubSortOn' recomputes the function for each comparison.+-- | This variant of 'nubSortOn' recomputes the for each comparison. nubSortOn' :: Ord b => (a -> b) -> [a] -> [a] nubSortOn' f = nubSortBy (\x y -> compare (f x) (f y)) @@ -316,11 +355,14 @@ nub :: (Ord a) => [a] -> [a] nub = nubBy (<) --- | 'nubBy' is the greedy algorithm that returns a sublist of its--- input such that 'isSortedBy' is true.+-- | The 'nubBy' function is the greedy algorithm that returns a+-- sublist of its input such that: -- -- > isSortedBy pred (nubBy pred xs) == True-+--+-- This is true for all lists, not just ordered lists, and all binary+-- predicates, not just total orders. On infinite lists, this statement+-- is true in a certain mathematical sense, but not a computational one. nubBy :: (a -> a -> Bool) -> [a] -> [a] nubBy p [] = [] nubBy p (x:xs) = x : loop x xs@@ -329,3 +371,108 @@ loop x (y:ys) | p x y = y : loop y ys | otherwise = loop x ys++data People a = VIP a (People a) | Crowd [a]++-- | The 'mergeAll' function generalizes \"'foldr' 'merge' []\" to a+-- (possibly infinite) list of (possibly infinite) ordered lists. To make+-- this possible, it adds the assumption that the heads of the non-empty+-- lists themselves form a sorted list.+--+-- The implementation is based on the article \"Implicit Heaps\" by+-- Heinrich Apfelmus, which simplifies an algorithm by Dave Bayer.+--+-- <http://apfelmus.nfshost.com/articles/implicit-heaps.html>+--+-- The following definition is a simple and reasonably efficient implementation+-- that is faster for inputs whose smallest elements are highly biased+-- towards the first few lists:+--+-- > mergeAll' = foldr merge' []+-- > where merge' [] ys = ys+-- > merge' (x:xs) ys = x : merge xs ys+--+-- This definition uses a linear chain of comparisons whereas the provided+-- implementation uses a tree of comparisons, which is faster on a wide range+-- of inputs.+mergeAll :: (Ord a) => [[a]] -> [a]+mergeAll = mergeAllBy compare++-- | The 'mergeAllBy' function is the non-overloaded variant of the 'mergeAll' function.+mergeAllBy :: (a -> a -> Ordering) -> [[a]] -> [a]+mergeAllBy cmp xss = loop [ (VIP x (Crowd xs)) | (x:xs) <- xss ]+ where+ loop [] = []+ loop ((VIP x xs):xss) = x : loop (xs:xss)+ loop [Crowd xs] = xs+ loop xss = loop (mergePairs xss)++ mergePairs [] = []+ mergePairs [x] = [x]+ mergePairs (x:y:zs) = merge' x y : mergePairs zs++ merge' (VIP x xs) ys = VIP x (merge' xs ys)+ merge' (Crowd []) ys = ys+ merge' (Crowd xs) (Crowd ys) = Crowd (mergeBy cmp xs ys)+ merge' xs@(Crowd (x:xt)) ys@(VIP y yt)+ = case cmp x y of+ GT -> VIP y (merge' xs yt)+ _ -> VIP x (merge' (Crowd xt) ys)++-- | The 'unionAll' function generalizes \"'foldr' 'union' []\" to a+-- (possibly infinite) list of (possibly infinite) ordered lists.+-- To make this possible, it adds the assumption that the heads of the+-- non-empty lists themselves form a sorted list.+--+-- The library implementation is based on some of the same techniques+-- as used in 'mergeAll'. However, the analogous simple definition+-- is not entirely satisfactory, because+--+-- > unionAll' = foldr union' []+-- > where union' [] ys = ys+-- > union' (x:xs) ys = x : union xs ys+-- >+-- > unionAll' [[1,2],[1,2]] == [1,1,2]+--+-- whereas we really want the result+--+-- > unionAll [[1,2],[1,2]] == foldr union [] [[1,2],[1,2]] == [1,2]+--+-- The first equality is only true when both sets of assumptions are met:+-- \"foldr union []\" assumes the outer list is finite, and 'unionAll'+-- assumes that the heads of the inner lists are sorted.+unionAll :: (Ord a) => [[a]] -> [a]+unionAll = unionAllBy compare++-- | The 'unionAllBy' function is the non-overloaded variant of the 'unionAll' function.+unionAllBy :: (a -> a -> Ordering) -> [[a]] -> [a]+unionAllBy cmp xss = loop [ (VIP x (Crowd xs)) | (x:xs) <- xss ]+ where+ loop [] = []+ loop ( VIP x xs : VIP y ys : xss )+ = case cmp x y of+ LT -> x : loop ( xs : VIP y ys : xss )+ EQ -> loop ( VIP x (union' xs ys) : unionPairs xss )+ GT -> error "Data.List.Ordered.unionAllBy: the heads of the lists are not sorted"+ loop ( VIP x xs : xss )+ = x : loop (xs:xss)+ loop [Crowd xs] = xs+ loop (xs:xss) = loop (unionPairs (xs:xss))++ unionPairs [] = []+ unionPairs [x] = [x]+ unionPairs (x:y:zs) = union' x y : unionPairs zs++ union' (VIP x xs) (VIP y ys)+ = case cmp x y of+ LT -> VIP x (union' xs (VIP y ys))+ EQ -> VIP x (union' xs ys)+ GT -> error "Data.List.Ordered.unionAllBy: the heads of the lists are not sorted"+ union' (VIP x xs) (Crowd ys) = VIP x (union' xs (Crowd ys))+ union' (Crowd []) ys = ys+ union' (Crowd xs) (Crowd ys) = Crowd (unionBy cmp xs ys)+ union' xs@(Crowd (x:xt)) ys@(VIP y yt)+ = case cmp x y of+ LT -> VIP x (union' (Crowd xt) ys)+ EQ -> VIP x (union' (Crowd xt) yt)+ GT -> VIP y (union' xs yt)
data-ordlist.cabal view
@@ -1,6 +1,7 @@ Name: data-ordlist-Version: 0.2-Description: Ordered Lists+Version: 0.4+Description:+ This module provides set and multiset operations on ordered lists. License: BSD3 License-file: LICENSE Author: Leon P Smith <leon@melding-monads.com>@@ -21,4 +22,4 @@ source-repository this type: darcs location: http://patch-tag.com/r/lpsmith/data-ordlist/pullrepo- tag: 0.2+ tag: 0.4
+ test/Main.hs view
@@ -0,0 +1,152 @@+import qualified Data.List as List+import Data.List.Ordered+import Test.QuickCheck+import Test.QuickCheck.Arbitrary++prop_member :: NonNegative Int -> Positive Int -> Bool+prop_member (NonNegative n) (Positive d)+ = member n [0,d..] == (n `mod` d == 0)++prop_insertBag_sort :: [Int] -> Bool+prop_insertBag_sort xs = foldr insertBag [] xs == sort xs++prop_insertSet_nubSort :: [Int] -> Bool+prop_insertSet_nubSort xs = foldr insertSet [] xs == nubSort xs++prop_nub :: OrderedList Int -> Bool+prop_nub (Ordered xs) = List.nub xs == nub xs++prop_nub_isSorted :: [Int] -> Bool+prop_nub_isSorted xs = isSortedBy (<) (nub xs)++prop_nubSort_isSorted :: [Int] -> Bool+prop_nubSort_isSorted xs = isSortedBy (<) (nubSort xs)++prop_isect_subset :: OrderedList Int -> OrderedList Int -> Bool+prop_isect_subset (Ordered xs) (Ordered ys)+ = let zs = isect xs ys+ in zs `subset` xs && zs `subset` ys++prop_isect_examples+ = isect [1,2,3,4] [3,4,5,6] == [3,4]+ && isect [1,3,5] [2,4,6] == []+ && isect [2,4,6,8] [3,6,9] == [6]+ && isect [1,2,2,2] [1,1,1,2,2] == [1,2,2]++prop_union_subset :: OrderedList Int -> OrderedList Int -> Bool+prop_union_subset (Ordered xs) (Ordered ys)+ = let zs = union xs ys+ in xs `subset` zs && ys `subset` zs++prop_isect_subset_union :: OrderedList Int -> OrderedList Int -> Bool+prop_isect_subset_union (Ordered xs) (Ordered ys)+ = isect xs ys `subset` union xs ys++prop_union_examples+ = union [1,2,3,4] [3,4,5,6] == [1..6]+ && union [1,3,5] [2,4,6] == [1..6]+ && union [2,4,6,8] [3,6,9] == [2,3,4,6,8,9]+ && union [1,2,2,2] [1,1,1,2,2] == [1,1,1,2,2,2]++prop_minus_subset :: OrderedList Int -> OrderedList Int -> Bool+prop_minus_subset (Ordered xs) (Ordered ys)+ = minus xs ys `subset` xs++prop_minus_examples+ = minus [1,2,3,4] [3,4,5,6] == [1,2]+ && minus [1,3,5] [2,4,6] == [1,3,5]+ && minus [2,4,6,8] [3,6,9] == [2,4,8]+ && minus [1,2,2,2] [1,1,1,2,2] == [2]++prop_xunion_subset_union :: OrderedList Int -> OrderedList Int -> Bool+prop_xunion_subset_union (Ordered xs) (Ordered ys)+ = xunion xs ys `subset` union xs ys++prop_merge_xunion_isect_union :: OrderedList Int -> OrderedList Int -> Bool+prop_merge_xunion_isect_union (Ordered xs) (Ordered ys)+ = merge (xunion xs ys) (isect xs ys) == union xs ys++prop_merge_union_isect_merge :: OrderedList Int -> OrderedList Int -> Bool+prop_merge_union_isect_merge (Ordered xs) (Ordered ys)+ = merge (union xs ys) (isect xs ys) == merge xs ys++prop_minus_merge_isect_union :: OrderedList Int -> OrderedList Int -> Bool+prop_minus_merge_isect_union (Ordered xs) (Ordered ys)+ = minus (merge xs ys) (isect xs ys) == union xs ys++prop_minus_union_isect_xunion :: OrderedList Int -> OrderedList Int -> Bool+prop_minus_union_isect_xunion (Ordered xs) (Ordered ys)+ = minus (union xs ys) (isect xs ys) == xunion xs ys++prop_xunion_examples+ = xunion [1,2,3,4] [3,4,5,6] == [1,2,5,6]+ && xunion [1,3,5] [2,4,6] == [1..6]+ && xunion [2,4,6,8] [3,6,9] == [2,3,4,8,9]+ && xunion [1,2,2,2] [1,1,1,2,2] == [1,1,2]++prop_merge_subset :: OrderedList Int -> OrderedList Int -> Bool+prop_merge_subset (Ordered xs) (Ordered ys)+ = union xs ys `subset` merge xs ys++prop_merge_examples+ = merge [1,2,3,4] [3,4,5,6] == [1,2,3,3,4,4,5,6]+ && merge [1,3,5] [2,4,6] == [1,2,3,4,5,6]+ && merge [2,4,6,8] [3,6,9] == [2,3,4,6,6,8,9]+ && merge [1,2,2,2] [1,1,1,2,2] == [1,1,1,1,2,2,2,2,2]++prop_nub_examples+ = nub [1,1,1,2,2] == [1,2]+ && nub [2,0,1,3,3] == [2,3]++safeHead [] = Nothing+safeHead (a:_) = Just a++newtype HeadOrderedLists x = HeadOrdered [[x]] deriving (Eq, Ord, Show, Read)++instance (Ord a, Arbitrary a) => Arbitrary (HeadOrderedLists a) where+ arbitrary = (HeadOrdered . sortOn' safeHead . map sort) `fmap` arbitrary+ shrink _ = []++prop_mergeAll :: HeadOrderedLists Int -> Bool+prop_mergeAll (HeadOrdered xss)+ = foldr merge [] xss == mergeAll xss++prop_unionAll :: HeadOrderedLists Int -> Bool+prop_unionAll (HeadOrdered xss)+ = foldr union [] xss == unionAll xss++broken_unionAll :: HeadOrderedLists Int -> Bool+broken_unionAll (HeadOrdered xss)+ = foldr union [] xss == foldr union' [] xss+ where+ union' [] ys = ys+ union' (x:xs) ys = x : union xs ys++prop_broken_unionAll = expectFailure broken_unionAll++main = do+ putStr "prop_member: " >> quickCheck prop_member+ putStr "prop_insertBag_sort: " >> quickCheck prop_insertBag_sort+ putStr "prop_insertSet_nubSort: " >> quickCheck prop_insertSet_nubSort+ putStr "prop_nub: " >> quickCheck prop_nub+ putStr "prop_nub_isSorted: " >> quickCheck prop_nub_isSorted+ putStr "prop_nubSort_isSorted: " >> quickCheck prop_nubSort_isSorted+ putStr "prop_isect_subset: " >> quickCheck prop_isect_subset+ putStr "prop_isect_examples: " >> quickCheck prop_isect_examples+ putStr "prop_union_subset: " >> quickCheck prop_union_subset+ putStr "prop_isect_subset_union: " >> quickCheck prop_isect_subset_union+ putStr "prop_union_examples: " >> quickCheck prop_union_examples+ putStr "prop_minus_subset: " >> quickCheck prop_minus_subset+ putStr "prop_minus_examples: " >> quickCheck prop_minus_examples+ putStr "prop_xunion_subset_union: " >> quickCheck prop_xunion_subset_union+ putStr "prop_merge_xunion_isect_union: " >> quickCheck prop_merge_xunion_isect_union+ putStr "prop_merge_union_isect_merge: " >> quickCheck prop_merge_union_isect_merge+ putStr "prop_minus_merge_isect_union: " >> quickCheck prop_minus_merge_isect_union+ putStr "prop_minus_union_isect_xunion: " >> quickCheck prop_minus_union_isect_xunion+ putStr "prop_xunion_examples: " >> quickCheck prop_xunion_examples+ putStr "prop_merge_subset: " >> quickCheck prop_merge_subset+ putStr "prop_merge_examples: " >> quickCheck prop_merge_examples+ putStr "prop_nub_examples: " >> quickCheck prop_nub_examples+ putStr "prop_mergeAll: " >> quickCheck prop_mergeAll+ putStr "prop_unionAll: " >> quickCheck prop_unionAll+ putStr "prop_broken_unionAll: " >> quickCheck prop_broken_unionAll