data-ordlist 0.4.3 → 0.4.4
raw patch · 5 files changed
+330/−325 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGES +8/−1
- Data/List/Ordered.hs +112/−115
- data-ordlist.cabal +2/−2
- test/Main.hs +0/−207
- test/data-list-ordered-tests.hs +208/−0
CHANGES view
@@ -1,3 +1,8 @@+Version 0.4.4: (2010-12-24)++ * Simplified the implementation of `mergeAll` and `unionAll` based on+ comments from Will Ness.+ Version 0.4.3: (2010-03-02) * Improved the implementation of `nubSort`, mirroring the improvements made@@ -18,7 +23,9 @@ Version 0.4.1: (2010-02-17) * Simplified the implementation of `mergeAll` and `unionAll` thanks- to some pointers by Heinrich Apfelmus.+ to some pointers by Heinrich Apfelmus. This introduced an infinite+ non-productive loop into `unionAll`, which was later fixed without+ giving up the simplifications. * Minor documentation fixes
Data/List/Ordered.hs view
@@ -37,8 +37,8 @@ , minus, minusBy , xunion, xunionBy , merge, mergeBy- , mergeAll, mergeAllBy- , unionAll, unionAllBy+ , mergeAll , mergeAllBy+ , unionAll , unionAllBy -- * Lists to Ordered Lists , nub, nubBy@@ -52,7 +52,7 @@ import Data.List(sort,sortBy) -- | 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 :: Ord a => [a] -> Bool isSorted = isSortedBy (<=) -- | The 'isSortedBy' function returns 'True' iff the predicate returns true@@ -66,7 +66,7 @@ -- | The 'member' function returns 'True' if the element appears in the -- ordered list.-member :: (Ord a) => a -> [a] -> Bool+member :: Ord a => a -> [a] -> Bool member = memberBy compare -- | The 'memberBy' function is the non-overloaded version of 'member'.@@ -82,7 +82,7 @@ -- | 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 :: Ord a => [a] -> a -> Bool has xs y = memberBy compare y xs -- | The 'hasBy' function is the non-overloaded version of 'has'.@@ -91,7 +91,7 @@ -- | 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 :: Ord a => a -> [a] -> [a] insertBag = insertBagBy compare -- | The 'insertBagBy' function is the non-overloaded version of 'insertBag'.@@ -107,7 +107,7 @@ -- | 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 :: Ord a => a -> [a] -> [a] insertSet = insertSetBy compare -- | The 'insertSetBy' function is the non-overloaded version of 'insertSet'.@@ -122,17 +122,17 @@ {- -- 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)+-- "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,+-- and xunion. Due to interactions with GHC's optimizer, coded separately, -- 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+-- inliner and constant propagation; 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@@ -145,28 +145,45 @@ -> [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+ 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++-- Here's another variation that was suggested to me. It is more general+-- than genSectBy, as it can implement a merge; but it cannot implement+-- a left-biased merge++foldrMergeBy :: (a -> b -> Ordering)+ -> (a -> c -> c) -> (b -> c -> c) -> (a -> b -> c -> c) -> c+ -> [a] -> [b] -> c+foldrMergeBy cmp addA addB unify z = loop+ where+ loop xs [] = foldr addA z xs+ loop [] ys = foldr addB z ys+ loop (x:xs) (y:ys)+ = case cmp x y of+ LT -> x `addA` loop xs (y:ys)+ EQ -> unify x y (loop xs ys)+ GT -> y `addB` 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+-- occurrences in either input. If either input is a set, then the output -- is a set. -- -- > 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 :: Ord a => [a] -> [a] -> [a] isect = isectBy compare -- | The 'isectBy' function is the non-overloaded version of 'isect'.@@ -183,12 +200,12 @@ -- | 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+-- of occurrences in either input. If both inputs are sets, then the -- output is a set. -- -- > 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 :: Ord a => [a] -> [a] -> [a] union = unionBy compare -- | The 'unionBy' function is the non-overloaded version of 'union'.@@ -210,7 +227,7 @@ -- -- > 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 :: Ord a => [a] -> [a] -> [a] minus = minusBy compare -- | The 'minusBy' function is the non-overloaded version of 'minus'.@@ -232,7 +249,7 @@ -- -- > 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 :: Ord a => [a] -> [a] -> [a] xunion = xunionBy compare -- | The 'xunionBy' function is the non-overloaded version of 'xunion'.@@ -249,11 +266,11 @@ -- | 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.+-- occurrences in the lists. -- -- > 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 :: Ord a => [a] -> [a] -> [a] merge = mergeBy compare -- | The 'mergeBy' function is the non-overloaded version of 'merge'.@@ -269,7 +286,7 @@ -- | The 'subset' function returns true if the first list is a sub-list -- of the second.-subset :: (Ord a) => [a] -> [a] -> Bool+subset :: Ord a => [a] -> [a] -> Bool subset = subsetBy compare -- | The 'subsetBy' function is the non-overloaded version of 'subset'.@@ -285,7 +302,7 @@ GT -> loop (x:xs) ys {---- This is Ian Lynagh's mergesort implementation, which appears as+-- This is Ian Lynagh's mergesort implementation, which appeared as -- Data.List.sort, with the static argument transformation applied. -- It's not clear whether this modification is truly worthwhile or not. @@ -293,7 +310,7 @@ sort = sortBy compare sortBy :: (a -> a -> Ordering) -> [a] -> [a]-sortBy cmp = foldTree merge . map (\x -> [x])+sortBy cmp = foldTree (mergeBy cmp) [] . map (\x -> [x]) -} -- | The 'sortOn' function provides the decorate-sort-undecorate idiom,@@ -317,12 +334,12 @@ -- | The 'nubSortBy' function is the non-overloaded version of 'nubSort'. nubSortBy :: (a -> a -> Ordering) -> [a] -> [a]-nubSortBy cmp = foldTree (unionBy cmp) . runs+nubSortBy cmp = foldTree' (unionBy cmp) [] . runs where -- 'runs' partitions the input into sublists that are monotonic,- -- contiguous, and non-overlapping. Descending runs are- -- reversed and adjacent duplicates are eliminated, so- -- every run returned is strictly ascending.+ -- contiguous, and non-overlapping. Descending runs are reversed+ -- and adjacent duplicates are eliminated, so every run returned is+ -- strictly ascending. runs (a:b:xs) = case cmp a b of@@ -361,7 +378,7 @@ -- > nub [2,0,1,3,3] == [2,3] -- > nub = nubBy (<) -nub :: (Ord a) => [a] -> [a]+nub :: Ord a => [a] -> [a] nub = nubBy (<) -- | The 'nubBy' function is the greedy algorithm that returns a@@ -381,112 +398,92 @@ | p x y = y : loop y ys | otherwise = loop x ys --- Helper function used in nubSortBy+-- | The function @'foldTree'' plus zero@ computes the sum of a list+-- using a balanced tree of operations. 'foldTree'' necessarily diverges+-- on infinite lists, hence it is a stricter variant of 'foldTree'.+-- 'foldTree'' is used in the implementation of 'sort' and 'nubSort'. -foldTree _ [] = undefined-foldTree f xs = loop xs+foldTree' :: (a -> a -> a) -> a -> [a] -> a+foldTree' plus zero xs+ = case xs of+ [] -> zero+ (_:_) -> loop xs where loop [x] = x loop xs = loop (pairs xs) - pairs (x:y:zs) = f x y : pairs zs- pairs zs = zs---- Helper functions used in 'mergeAll' and 'unionAll'+ pairs (x:y:zs) = plus x y : pairs zs+ pairs zs = zs -data People a = VIP a (People a) | Crowd [a]+-- | The function @'foldTree' plus zero@ computes the sum of a list using+-- a sequence of balanced trees of operations. Given an appropriate @plus@+-- operator, this function can be productive on an infinite list, hence it+-- is lazier than 'foldTree''. 'foldTree' is used in the implementation of+-- 'mergeAll' and 'unionAll'. -lazyFoldTree _ [] = Crowd []-lazyFoldTree f xs = loop xs+foldTree :: (a -> a -> a) -> a -> [a] -> a+foldTree plus zero xs+ = case xs of+ [] -> zero+ (_:_) -> loop xs where loop [x] = x- loop (x:xs) = x `f` loop (pairs xs)-- pairs (x:y:ys) = f x y : pairs ys- pairs xs = xs--serve (VIP x xs) = x:serve xs-serve (Crowd xs) = xs+ loop (x:xs) = x `plus` loop (pairs xs) -vips xss = [ VIP x (Crowd xs) | (x:xs) <- xss ]+ pairs (x:y:zs) = plus x y : pairs zs+ pairs zs = zs --- | 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:+-- | The 'mergeAll' function merges a (potentially) infinite number of+-- ordered lists, under the assumption that the heads of the inner lists+-- are sorted. An element is duplicated in the result as many times as+-- the total number of occurrences in all inner lists. ----- > mergeAll' = foldr merge' []--- > where merge' [] ys = ys--- > merge' (x:xs) ys = x : merge xs ys+-- The 'mergeAll' function is closely related to @'foldr' 'merge' []@.+-- The former does not assume that the outer list is finite, whereas+-- the latter makes no assumption about the heads of the inner lists.+-- When both sets of assumptions are met, these two functions are+-- equivalent. ----- This simplification uses a linear chain of comparisons. The--- implementation provided uses a tree of comparisons, which is faster on a--- wide range of inputs.-mergeAll :: (Ord a) => [[a]] -> [a]+-- This implementation of 'mergeAll' uses a tree of comparisons, and is+-- based on input from Dave Bayer, Heinrich Apfelmus, Omar Antolin Camarena,+-- and Will Ness.+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 = serve . lazyFoldTree merge' . vips+mergeAllBy cmp = foldTree merge' [] where- 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)+ merge' [] ys = ys+ merge' (x:xs) ys = x : mergeBy cmp xs 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+-- | The 'unionAll' computes the union of a (potentially) infinite number+-- of lists, under the assumption that the heads of the inner lists+-- are sorted. The result will duplicate an element as many times as+-- the maximum number of occurrences in any single list. Thus, the result+-- is a set if and only if every inner list is a set. ----- > unionAll [[1,2],[1,2]] == foldr union [] [[1,2],[1,2]] == [1,2]+-- Analogous to 'mergeAll', 'unionAll' is closely related to+-- @'foldr' 'union' []@; The outer does not assume that the outer list+-- is finite, whereas the right fold does not assume anything about the+-- heads of the inner lists. When both sets of assumptions are met, the+-- functions are equivalent. ----- 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]+-- This implementation is also based on implicit heaps, providing+-- a tree of comparisons.+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 = serve . lazyFoldTree union' . vips+unionAllBy cmp = foldTree union' [] where msg = "Data.List.Ordered.unionAllBy: the heads of the lists are not sorted"- union' (VIP x xs) ys- = VIP x $ case ys of- Crowd _ -> union' xs ys- VIP y yt -> case cmp x y of- LT -> union' xs ys- EQ -> union' xs yt- GT -> error msg- 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)++ union' [] ys = ys+ union' (x:xs) ys = x : case ys of+ [] -> xs+ (y:yt) -> case cmp x y of+ LT -> unionBy cmp xs ys+ EQ -> unionBy cmp xs yt+ GT -> error msg
data-ordlist.cabal view
@@ -1,5 +1,5 @@ Name: data-ordlist-Version: 0.4.3+Version: 0.4.4 Description: This module provides set and multiset operations on ordered lists. License: BSD3@@ -22,4 +22,4 @@ source-repository this type: darcs location: http://patch-tag.com/r/lpsmith/data-ordlist/pullrepo- tag: 0.4.3+ tag: 0.4.4
− test/Main.hs
@@ -1,207 +0,0 @@-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---approxEq xs ys = take n xs == take n ys- where n = 1000--prop_mergeAll_productive = mergeAll [ [n..] | n <- [1..] ] `approxEq` triangle 1- where- triangle n = replicate n n ++ triangle (n+1)--prop_unionAll :: HeadOrderedLists Int -> Bool-prop_unionAll (HeadOrdered xss)- = foldr union [] xss == unionAll xss--prop_unionAll_productive = unionAll [ [n..] | n <- [1..] ] `approxEq` [1..]--quickCheckOnce = quickCheckWith (stdArgs {maxSuccess = 1})--main = do- putStr "\nprop_member\n"- quickCheck prop_member-- putStr "\nprop_insertBag_sort\n"- quickCheck prop_insertBag_sort-- putStr "\nprop_insertSet_nubSort\n"- quickCheck prop_insertSet_nubSort-- putStr "\nprop_nub\n"- quickCheck prop_nub-- putStr "\nprop_nub_isSorted\n"- quickCheck prop_nub_isSorted-- putStr "\nprop_nubSort_isSorted\n"- quickCheck prop_nubSort_isSorted-- putStr "\nprop_isect_subset\n"- quickCheck prop_isect_subset-- putStr "\nprop_isect_examples\n"- quickCheckOnce prop_isect_examples-- putStr "\nprop_union_subset\n"- quickCheck prop_union_subset-- putStr "\nprop_isect_subset_union\n"- quickCheck prop_isect_subset_union-- putStr "\nprop_union_examples\n"- quickCheckOnce prop_union_examples-- putStr "\nprop_minus_subset\n"- quickCheck prop_minus_subset-- putStr "\nprop_minus_examples\n"- quickCheckOnce prop_minus_examples-- putStr "\nprop_xunion_subset_union\n"- quickCheck prop_xunion_subset_union-- putStr "\nprop_merge_xunion_isect_union\n"- quickCheck prop_merge_xunion_isect_union-- putStr "\nprop_merge_union_isect_merge\n"- quickCheck prop_merge_union_isect_merge-- putStr "\nprop_minus_merge_isect_union\n"- quickCheck prop_minus_merge_isect_union-- putStr "\nprop_minus_union_isect_xunion\n"- quickCheck prop_minus_union_isect_xunion-- putStr "\nprop_xunion_examples\n"- quickCheckOnce prop_xunion_examples-- putStr "\nprop_merge_subset\n"- quickCheck prop_merge_subset-- putStr "\nprop_merge_examples\n"- quickCheckOnce prop_merge_examples-- putStr "\nprop_nub_examples\n"- quickCheckOnce prop_nub_examples-- putStr "\nprop_mergeAll\n"- quickCheck prop_mergeAll-- putStr "\nprop_mergeAll_productive\n"- quickCheckOnce prop_mergeAll_productive-- putStr "\nprop_unionAll\n"- quickCheck prop_unionAll-- putStr "\nprop_unionAll_productive\n"- quickCheckOnce prop_unionAll_productive
+ test/data-list-ordered-tests.hs view
@@ -0,0 +1,208 @@+module Main where++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++approxEq xs ys = take n xs == take n ys+ where n = 1000++triangle n = replicate n n ++ triangle (n+1)++prop_mergeAll_productive = mergeAll [ [n..] | n <- [1..] ] `approxEq` triangle 1++prop_unionAll :: HeadOrderedLists Int -> Bool+prop_unionAll (HeadOrdered xss)+ = foldr union [] xss == unionAll xss++prop_unionAll_productive = unionAll [ [n..] | n <- [1..] ] `approxEq` [1..]++quickCheckOnce = quickCheckWith (stdArgs {maxSuccess = 1})++main = do+ putStr "\nprop_member\n"+ quickCheck prop_member++ putStr "\nprop_insertBag_sort\n"+ quickCheck prop_insertBag_sort++ putStr "\nprop_insertSet_nubSort\n"+ quickCheck prop_insertSet_nubSort++ putStr "\nprop_nub\n"+ quickCheck prop_nub++ putStr "\nprop_nub_isSorted\n"+ quickCheck prop_nub_isSorted++ putStr "\nprop_nubSort_isSorted\n"+ quickCheck prop_nubSort_isSorted++ putStr "\nprop_isect_subset\n"+ quickCheck prop_isect_subset++ putStr "\nprop_isect_examples\n"+ quickCheckOnce prop_isect_examples++ putStr "\nprop_union_subset\n"+ quickCheck prop_union_subset++ putStr "\nprop_isect_subset_union\n"+ quickCheck prop_isect_subset_union++ putStr "\nprop_union_examples\n"+ quickCheckOnce prop_union_examples++ putStr "\nprop_minus_subset\n"+ quickCheck prop_minus_subset++ putStr "\nprop_minus_examples\n"+ quickCheckOnce prop_minus_examples++ putStr "\nprop_xunion_subset_union\n"+ quickCheck prop_xunion_subset_union++ putStr "\nprop_merge_xunion_isect_union\n"+ quickCheck prop_merge_xunion_isect_union++ putStr "\nprop_merge_union_isect_merge\n"+ quickCheck prop_merge_union_isect_merge++ putStr "\nprop_minus_merge_isect_union\n"+ quickCheck prop_minus_merge_isect_union++ putStr "\nprop_minus_union_isect_xunion\n"+ quickCheck prop_minus_union_isect_xunion++ putStr "\nprop_xunion_examples\n"+ quickCheckOnce prop_xunion_examples++ putStr "\nprop_merge_subset\n"+ quickCheck prop_merge_subset++ putStr "\nprop_merge_examples\n"+ quickCheckOnce prop_merge_examples++ putStr "\nprop_nub_examples\n"+ quickCheckOnce prop_nub_examples++ putStr "\nprop_mergeAll\n"+ quickCheck prop_mergeAll++ putStr "\nprop_mergeAll_productive\n"+ quickCheckOnce prop_mergeAll_productive++ putStr "\nprop_unionAll\n"+ quickCheck prop_unionAll++ putStr "\nprop_unionAll_productive\n"+ quickCheckOnce prop_unionAll_productive