Improve query functions of Map and Set.
[packages/containers.git] / tests / set-properties.hs
1 import qualified Data.IntSet as IntSet
2 import Data.List (nub,sort)
3 import qualified Data.List as List
4 import Data.Monoid (mempty)
5 import Data.Set
6 import Prelude hiding (lookup, null, map, filter, foldr, foldl)
7 import Test.QuickCheck
8 import Test.Framework
9 import Test.Framework.Providers.QuickCheck2
10
11 main :: IO ()
12 main = defaultMainWithOpts [ testProperty "prop_Valid" prop_Valid
13 , testProperty "prop_Single" prop_Single
14 , testProperty "prop_Member" prop_Member
15 , testProperty "prop_NotMember" prop_NotMember
16 , testProperty "prop_InsertValid" prop_InsertValid
17 , testProperty "prop_InsertDelete" prop_InsertDelete
18 , testProperty "prop_DeleteValid" prop_DeleteValid
19 , testProperty "prop_Join" prop_Join
20 , testProperty "prop_Merge" prop_Merge
21 , testProperty "prop_UnionValid" prop_UnionValid
22 , testProperty "prop_UnionInsert" prop_UnionInsert
23 , testProperty "prop_UnionAssoc" prop_UnionAssoc
24 , testProperty "prop_UnionComm" prop_UnionComm
25 , testProperty "prop_DiffValid" prop_DiffValid
26 , testProperty "prop_Diff" prop_Diff
27 , testProperty "prop_IntValid" prop_IntValid
28 , testProperty "prop_Int" prop_Int
29 , testProperty "prop_Ordered" prop_Ordered
30 , testProperty "prop_List" prop_List
31 , testProperty "prop_DescList" prop_DescList
32 , testProperty "prop_AscDescList" prop_AscDescList
33 , testProperty "prop_fromList" prop_fromList
34 , testProperty "prop_isProperSubsetOf" prop_isProperSubsetOf
35 , testProperty "prop_isProperSubsetOf2" prop_isProperSubsetOf2
36 , testProperty "prop_isSubsetOf" prop_isSubsetOf
37 , testProperty "prop_isSubsetOf2" prop_isSubsetOf2
38 , testProperty "prop_size" prop_size
39 , testProperty "prop_findMax" prop_findMax
40 , testProperty "prop_findMin" prop_findMin
41 , testProperty "prop_ord" prop_ord
42 , testProperty "prop_readShow" prop_readShow
43 , testProperty "prop_foldR" prop_foldR
44 , testProperty "prop_foldR'" prop_foldR'
45 , testProperty "prop_foldL" prop_foldL
46 , testProperty "prop_foldL'" prop_foldL'
47 , testProperty "prop_map" prop_map
48 , testProperty "prop_maxView" prop_maxView
49 , testProperty "prop_minView" prop_minView
50 , testProperty "prop_split" prop_split
51 , testProperty "prop_splitMember" prop_splitMember
52 , testProperty "prop_partition" prop_partition
53 , testProperty "prop_filter" prop_filter
54 ] opts
55 where
56 opts = mempty { ropt_test_options = Just $ mempty { topt_maximum_generated_tests = Just 500
57 , topt_maximum_unsuitable_generated_tests = Just 500
58 }
59 }
60
61 {--------------------------------------------------------------------
62 Arbitrary, reasonably balanced trees
63 --------------------------------------------------------------------}
64 instance (Enum a) => Arbitrary (Set a) where
65 arbitrary = sized (arbtree 0 maxkey)
66 where maxkey = 10000
67
68 arbtree :: (Enum a) => Int -> Int -> Int -> Gen (Set a)
69 arbtree lo hi n = do t <- gentree lo hi n
70 if balanced t then return t else arbtree lo hi n
71 where gentree lo hi n
72 | n <= 0 = return Tip
73 | lo >= hi = return Tip
74 | otherwise = do i <- choose (lo,hi)
75 m <- choose (1,70)
76 let (ml,mr) | m==(1::Int) = (1,2)
77 | m==2 = (2,1)
78 | m==3 = (1,1)
79 | otherwise = (2,2)
80 l <- gentree lo (i-1) (n `div` ml)
81 r <- gentree (i+1) hi (n `div` mr)
82 return (bin (toEnum i) l r)
83
84 {--------------------------------------------------------------------
85 Valid tree's
86 --------------------------------------------------------------------}
87 forValid :: (Enum a,Show a,Testable b) => (Set a -> b) -> Property
88 forValid f = forAll arbitrary $ \t ->
89 -- classify (balanced t) "balanced" $
90 classify (size t == 0) "empty" $
91 classify (size t > 0 && size t <= 10) "small" $
92 classify (size t > 10 && size t <= 64) "medium" $
93 classify (size t > 64) "large" $
94 balanced t ==> f t
95
96 forValidUnitTree :: Testable a => (Set Int -> a) -> Property
97 forValidUnitTree f = forValid f
98
99 prop_Valid :: Property
100 prop_Valid = forValidUnitTree $ \t -> valid t
101
102 {--------------------------------------------------------------------
103 Single, Member, Insert, Delete
104 --------------------------------------------------------------------}
105 prop_Single :: Int -> Bool
106 prop_Single x = (insert x empty == singleton x)
107
108 prop_Member :: [Int] -> Int -> Bool
109 prop_Member xs n =
110 let m = fromList xs
111 in all (\k -> k `member` m == (k `elem` xs)) (n : xs)
112
113 prop_NotMember :: [Int] -> Int -> Bool
114 prop_NotMember xs n =
115 let m = fromList xs
116 in all (\k -> k `notMember` m == (k `notElem` xs)) (n : xs)
117
118 prop_InsertValid :: Int -> Property
119 prop_InsertValid k = forValidUnitTree $ \t -> valid (insert k t)
120
121 prop_InsertDelete :: Int -> Set Int -> Property
122 prop_InsertDelete k t = not (member k t) ==> delete k (insert k t) == t
123
124 prop_DeleteValid :: Int -> Property
125 prop_DeleteValid k = forValidUnitTree $ \t -> valid (delete k (insert k t))
126
127 {--------------------------------------------------------------------
128 Balance
129 --------------------------------------------------------------------}
130 prop_Join :: Int -> Property
131 prop_Join x = forValidUnitTree $ \t ->
132 let (l,r) = split x t
133 in valid (join x l r)
134
135 prop_Merge :: Int -> Property
136 prop_Merge x = forValidUnitTree $ \t ->
137 let (l,r) = split x t
138 in valid (merge l r)
139
140 {--------------------------------------------------------------------
141 Union
142 --------------------------------------------------------------------}
143 prop_UnionValid :: Property
144 prop_UnionValid
145 = forValidUnitTree $ \t1 ->
146 forValidUnitTree $ \t2 ->
147 valid (union t1 t2)
148
149 prop_UnionInsert :: Int -> Set Int -> Bool
150 prop_UnionInsert x t = union t (singleton x) == insert x t
151
152 prop_UnionAssoc :: Set Int -> Set Int -> Set Int -> Bool
153 prop_UnionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3
154
155 prop_UnionComm :: Set Int -> Set Int -> Bool
156 prop_UnionComm t1 t2 = (union t1 t2 == union t2 t1)
157
158 prop_DiffValid :: Property
159 prop_DiffValid = forValidUnitTree $ \t1 ->
160 forValidUnitTree $ \t2 ->
161 valid (difference t1 t2)
162
163 prop_Diff :: [Int] -> [Int] -> Bool
164 prop_Diff xs ys = toAscList (difference (fromList xs) (fromList ys))
165 == List.sort ((List.\\) (nub xs) (nub ys))
166
167 prop_IntValid :: Property
168 prop_IntValid = forValidUnitTree $ \t1 ->
169 forValidUnitTree $ \t2 ->
170 valid (intersection t1 t2)
171
172 prop_Int :: [Int] -> [Int] -> Bool
173 prop_Int xs ys = toAscList (intersection (fromList xs) (fromList ys))
174 == List.sort (nub ((List.intersect) (xs) (ys)))
175
176 {--------------------------------------------------------------------
177 Lists
178 --------------------------------------------------------------------}
179 prop_Ordered :: Property
180 prop_Ordered = forAll (choose (5,100)) $ \n ->
181 let xs = [0..n::Int]
182 in fromAscList xs == fromList xs
183
184 prop_List :: [Int] -> Bool
185 prop_List xs = (sort (nub xs) == toList (fromList xs))
186
187 prop_DescList :: [Int] -> Bool
188 prop_DescList xs = (reverse (sort (nub xs)) == toDescList (fromList xs))
189
190 prop_AscDescList :: [Int] -> Bool
191 prop_AscDescList xs = toAscList s == reverse (toDescList s)
192 where s = fromList xs
193
194 prop_fromList :: [Int] -> Bool
195 prop_fromList xs
196 = case fromList xs of
197 t -> t == fromAscList sort_xs &&
198 t == fromDistinctAscList nub_sort_xs &&
199 t == List.foldr insert empty xs
200 where sort_xs = sort xs
201 nub_sort_xs = List.map List.head $ List.group sort_xs
202
203 {--------------------------------------------------------------------
204 Set operations are like IntSet operations
205 --------------------------------------------------------------------}
206 toIntSet :: Set Int -> IntSet.IntSet
207 toIntSet = IntSet.fromList . toList
208
209 -- Check that Set Int.isProperSubsetOf is the same as Set.isProperSubsetOf.
210 prop_isProperSubsetOf :: Set Int -> Set Int -> Bool
211 prop_isProperSubsetOf a b = isProperSubsetOf a b == IntSet.isProperSubsetOf (toIntSet a) (toIntSet b)
212
213 -- In the above test, isProperSubsetOf almost always returns False (since a
214 -- random set is almost never a subset of another random set). So this second
215 -- test checks the True case.
216 prop_isProperSubsetOf2 :: Set Int -> Set Int -> Bool
217 prop_isProperSubsetOf2 a b = isProperSubsetOf a c == (a /= c) where
218 c = union a b
219
220 prop_isSubsetOf :: Set Int -> Set Int -> Bool
221 prop_isSubsetOf a b = isSubsetOf a b == IntSet.isSubsetOf (toIntSet a) (toIntSet b)
222
223 prop_isSubsetOf2 :: Set Int -> Set Int -> Bool
224 prop_isSubsetOf2 a b = isSubsetOf a (union a b)
225
226 prop_size :: Set Int -> Bool
227 prop_size s = size s == List.length (toList s)
228
229 prop_findMax :: Set Int -> Property
230 prop_findMax s = not (null s) ==> findMax s == maximum (toList s)
231
232 prop_findMin :: Set Int -> Property
233 prop_findMin s = not (null s) ==> findMin s == minimum (toList s)
234
235 prop_ord :: Set Int -> Set Int -> Bool
236 prop_ord s1 s2 = s1 `compare` s2 == toList s1 `compare` toList s2
237
238 prop_readShow :: Set Int -> Bool
239 prop_readShow s = s == read (show s)
240
241 prop_foldR :: Set Int -> Bool
242 prop_foldR s = foldr (:) [] s == toList s
243
244 prop_foldR' :: Set Int -> Bool
245 prop_foldR' s = foldr' (:) [] s == toList s
246
247 prop_foldL :: Set Int -> Bool
248 prop_foldL s = foldl (flip (:)) [] s == List.foldl (flip (:)) [] (toList s)
249
250 prop_foldL' :: Set Int -> Bool
251 prop_foldL' s = foldl' (flip (:)) [] s == List.foldl' (flip (:)) [] (toList s)
252
253 prop_map :: Set Int -> Bool
254 prop_map s = map id s == s
255
256 prop_maxView :: Set Int -> Bool
257 prop_maxView s = case maxView s of
258 Nothing -> null s
259 Just (m,s') -> m == maximum (toList s) && s == insert m s' && m `notMember` s'
260
261 prop_minView :: Set Int -> Bool
262 prop_minView s = case minView s of
263 Nothing -> null s
264 Just (m,s') -> m == minimum (toList s) && s == insert m s' && m `notMember` s'
265
266 prop_split :: Set Int -> Int -> Bool
267 prop_split s i = case split i s of
268 (s1,s2) -> all (<i) (toList s1) && all (>i) (toList s2) && i `delete` s == union s1 s2
269
270 prop_splitMember :: Set Int -> Int -> Bool
271 prop_splitMember s i = case splitMember i s of
272 (s1,t,s2) -> all (<i) (toList s1) && all (>i) (toList s2) && t == i `member` s && i `delete` s == union s1 s2
273
274 prop_partition :: Set Int -> Int -> Bool
275 prop_partition s i = case partition odd s of
276 (s1,s2) -> all odd (toList s1) && all even (toList s2) && s == s1 `union` s2
277
278 prop_filter :: Set Int -> Int -> Bool
279 prop_filter s i = partition odd s == (filter odd s, filter even s)