diff --git a/AUTHORS b/AUTHORS --- a/AUTHORS +++ b/AUTHORS @@ -1,1 +1,1 @@ -leon at melding-monads dot com +"Leon P Smith" diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -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. + + + + 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": + + + + +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 diff --git a/Data/List/Ordered.hs b/Data/List/Ordered.hs --- a/Data/List/Ordered.hs +++ b/Data/List/Ordered.hs @@ -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. +-- +-- +-- +-- 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) diff --git a/data-ordlist.cabal b/data-ordlist.cabal --- a/data-ordlist.cabal +++ b/data-ordlist.cabal @@ -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 @@ -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 diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -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