Add fromDescList and fromDistinctDescList
[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.Maybe
6 import Data.Set
7 import Prelude hiding (lookup, null, map, filter, foldr, foldl)
8 import Test.Framework
9 import Test.Framework.Providers.HUnit
10 import Test.Framework.Providers.QuickCheck2
11 import Test.HUnit hiding (Test, Testable)
12 import Test.QuickCheck
13
14 main :: IO ()
15 main = defaultMain [ testCase "lookupLT" test_lookupLT
16 , testCase "lookupGT" test_lookupGT
17 , testCase "lookupLE" test_lookupLE
18 , testCase "lookupGE" test_lookupGE
19 , testCase "lookupIndex" test_lookupIndex
20 , testCase "findIndex" test_findIndex
21 , testCase "elemAt" test_elemAt
22 , testCase "deleteAt" test_deleteAt
23 , testProperty "prop_Valid" prop_Valid
24 , testProperty "prop_Single" prop_Single
25 , testProperty "prop_Member" prop_Member
26 , testProperty "prop_NotMember" prop_NotMember
27 , testProperty "prop_LookupLT" prop_LookupLT
28 , testProperty "prop_LookupGT" prop_LookupGT
29 , testProperty "prop_LookupLE" prop_LookupLE
30 , testProperty "prop_LookupGE" prop_LookupGE
31 , testProperty "prop_InsertValid" prop_InsertValid
32 , testProperty "prop_InsertDelete" prop_InsertDelete
33 , testProperty "prop_DeleteValid" prop_DeleteValid
34 , testProperty "prop_Link" prop_Link
35 , testProperty "prop_Merge" prop_Merge
36 , testProperty "prop_UnionValid" prop_UnionValid
37 , testProperty "prop_UnionInsert" prop_UnionInsert
38 , testProperty "prop_UnionAssoc" prop_UnionAssoc
39 , testProperty "prop_UnionComm" prop_UnionComm
40 , testProperty "prop_DiffValid" prop_DiffValid
41 , testProperty "prop_Diff" prop_Diff
42 , testProperty "prop_IntValid" prop_IntValid
43 , testProperty "prop_Int" prop_Int
44 , testProperty "prop_Ordered" prop_Ordered
45 , testProperty "prop_DescendingOrdered" prop_DescendingOrdered
46 , testProperty "prop_List" prop_List
47 , testProperty "prop_DescList" prop_DescList
48 , testProperty "prop_AscDescList" prop_AscDescList
49 , testProperty "prop_fromList" prop_fromList
50 , testProperty "prop_fromListDesc" prop_fromListDesc
51 , testProperty "prop_isProperSubsetOf" prop_isProperSubsetOf
52 , testProperty "prop_isProperSubsetOf2" prop_isProperSubsetOf2
53 , testProperty "prop_isSubsetOf" prop_isSubsetOf
54 , testProperty "prop_isSubsetOf2" prop_isSubsetOf2
55 , testProperty "prop_size" prop_size
56 , testProperty "prop_findMax" prop_findMax
57 , testProperty "prop_findMin" prop_findMin
58 , testProperty "prop_ord" prop_ord
59 , testProperty "prop_readShow" prop_readShow
60 , testProperty "prop_foldR" prop_foldR
61 , testProperty "prop_foldR'" prop_foldR'
62 , testProperty "prop_foldL" prop_foldL
63 , testProperty "prop_foldL'" prop_foldL'
64 , testProperty "prop_map" prop_map
65 , testProperty "prop_maxView" prop_maxView
66 , testProperty "prop_minView" prop_minView
67 , testProperty "prop_split" prop_split
68 , testProperty "prop_splitMember" prop_splitMember
69 , testProperty "prop_splitRoot" prop_splitRoot
70 , testProperty "prop_partition" prop_partition
71 , testProperty "prop_filter" prop_filter
72 ]
73
74 ----------------------------------------------------------------
75 -- Unit tests
76 ----------------------------------------------------------------
77
78 test_lookupLT :: Assertion
79 test_lookupLT = do
80 lookupLT 3 (fromList [3, 5]) @?= Nothing
81 lookupLT 5 (fromList [3, 5]) @?= Just 3
82
83 test_lookupGT :: Assertion
84 test_lookupGT = do
85 lookupGT 4 (fromList [3, 5]) @?= Just 5
86 lookupGT 5 (fromList [3, 5]) @?= Nothing
87
88 test_lookupLE :: Assertion
89 test_lookupLE = do
90 lookupLE 2 (fromList [3, 5]) @?= Nothing
91 lookupLE 4 (fromList [3, 5]) @?= Just 3
92 lookupLE 5 (fromList [3, 5]) @?= Just 5
93
94 test_lookupGE :: Assertion
95 test_lookupGE = do
96 lookupGE 3 (fromList [3, 5]) @?= Just 3
97 lookupGE 4 (fromList [3, 5]) @?= Just 5
98 lookupGE 6 (fromList [3, 5]) @?= Nothing
99
100 {--------------------------------------------------------------------
101 Indexed
102 --------------------------------------------------------------------}
103
104 test_lookupIndex :: Assertion
105 test_lookupIndex = do
106 isJust (lookupIndex 2 (fromList [5,3])) @?= False
107 fromJust (lookupIndex 3 (fromList [5,3])) @?= 0
108 fromJust (lookupIndex 5 (fromList [5,3])) @?= 1
109 isJust (lookupIndex 6 (fromList [5,3])) @?= False
110
111 test_findIndex :: Assertion
112 test_findIndex = do
113 findIndex 3 (fromList [5,3]) @?= 0
114 findIndex 5 (fromList [5,3]) @?= 1
115
116 test_elemAt :: Assertion
117 test_elemAt = do
118 elemAt 0 (fromList [5,3]) @?= 3
119 elemAt 1 (fromList [5,3]) @?= 5
120
121 test_deleteAt :: Assertion
122 test_deleteAt = do
123 deleteAt 0 (fromList [5,3]) @?= singleton 5
124 deleteAt 1 (fromList [5,3]) @?= singleton 3
125
126 {--------------------------------------------------------------------
127 Arbitrary, reasonably balanced trees
128 --------------------------------------------------------------------}
129 instance (Enum a) => Arbitrary (Set a) where
130 arbitrary = sized (arbtree 0 maxkey)
131 where maxkey = 10000
132
133 arbtree :: (Enum a) => Int -> Int -> Int -> Gen (Set a)
134 arbtree lo hi n = do t <- gentree lo hi n
135 if balanced t then return t else arbtree lo hi n
136 where gentree lo hi n
137 | n <= 0 = return Tip
138 | lo >= hi = return Tip
139 | otherwise = do i <- choose (lo,hi)
140 m <- choose (1,70)
141 let (ml,mr) | m==(1::Int) = (1,2)
142 | m==2 = (2,1)
143 | m==3 = (1,1)
144 | otherwise = (2,2)
145 l <- gentree lo (i-1) (n `div` ml)
146 r <- gentree (i+1) hi (n `div` mr)
147 return (bin (toEnum i) l r)
148
149 {--------------------------------------------------------------------
150 Valid tree's
151 --------------------------------------------------------------------}
152 forValid :: (Enum a,Show a,Testable b) => (Set a -> b) -> Property
153 forValid f = forAll arbitrary $ \t ->
154 -- classify (balanced t) "balanced" $
155 classify (size t == 0) "empty" $
156 classify (size t > 0 && size t <= 10) "small" $
157 classify (size t > 10 && size t <= 64) "medium" $
158 classify (size t > 64) "large" $
159 balanced t ==> f t
160
161 forValidUnitTree :: Testable a => (Set Int -> a) -> Property
162 forValidUnitTree f = forValid f
163
164 prop_Valid :: Property
165 prop_Valid = forValidUnitTree $ \t -> valid t
166
167 {--------------------------------------------------------------------
168 Single, Member, Insert, Delete
169 --------------------------------------------------------------------}
170 prop_Single :: Int -> Bool
171 prop_Single x = (insert x empty == singleton x)
172
173 prop_Member :: [Int] -> Int -> Bool
174 prop_Member xs n =
175 let m = fromList xs
176 in all (\k -> k `member` m == (k `elem` xs)) (n : xs)
177
178 prop_NotMember :: [Int] -> Int -> Bool
179 prop_NotMember xs n =
180 let m = fromList xs
181 in all (\k -> k `notMember` m == (k `notElem` xs)) (n : xs)
182
183 test_LookupSomething :: (Int -> Set Int -> Maybe Int) -> (Int -> Int -> Bool) -> [Int] -> Bool
184 test_LookupSomething lookup' cmp xs =
185 let odd_sorted_xs = filter_odd $ nub $ sort xs
186 t = fromList odd_sorted_xs
187 test x = case List.filter (`cmp` x) odd_sorted_xs of
188 [] -> lookup' x t == Nothing
189 cs | 0 `cmp` 1 -> lookup' x t == Just (last cs) -- we want largest such element
190 | otherwise -> lookup' x t == Just (head cs) -- we want smallest such element
191 in all test xs
192
193 where filter_odd [] = []
194 filter_odd [_] = []
195 filter_odd (_ : o : xs) = o : filter_odd xs
196
197 prop_LookupLT :: [Int] -> Bool
198 prop_LookupLT = test_LookupSomething lookupLT (<)
199
200 prop_LookupGT :: [Int] -> Bool
201 prop_LookupGT = test_LookupSomething lookupGT (>)
202
203 prop_LookupLE :: [Int] -> Bool
204 prop_LookupLE = test_LookupSomething lookupLE (<=)
205
206 prop_LookupGE :: [Int] -> Bool
207 prop_LookupGE = test_LookupSomething lookupGE (>=)
208
209 prop_InsertValid :: Int -> Property
210 prop_InsertValid k = forValidUnitTree $ \t -> valid (insert k t)
211
212 prop_InsertDelete :: Int -> Set Int -> Property
213 prop_InsertDelete k t = not (member k t) ==> delete k (insert k t) == t
214
215 prop_DeleteValid :: Int -> Property
216 prop_DeleteValid k = forValidUnitTree $ \t -> valid (delete k (insert k t))
217
218 {--------------------------------------------------------------------
219 Balance
220 --------------------------------------------------------------------}
221 prop_Link :: Int -> Property
222 prop_Link x = forValidUnitTree $ \t ->
223 let (l,r) = split x t
224 in valid (link x l r)
225
226 prop_Merge :: Int -> Property
227 prop_Merge x = forValidUnitTree $ \t ->
228 let (l,r) = split x t
229 in valid (merge l r)
230
231 {--------------------------------------------------------------------
232 Union
233 --------------------------------------------------------------------}
234 prop_UnionValid :: Property
235 prop_UnionValid
236 = forValidUnitTree $ \t1 ->
237 forValidUnitTree $ \t2 ->
238 valid (union t1 t2)
239
240 prop_UnionInsert :: Int -> Set Int -> Bool
241 prop_UnionInsert x t = union t (singleton x) == insert x t
242
243 prop_UnionAssoc :: Set Int -> Set Int -> Set Int -> Bool
244 prop_UnionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3
245
246 prop_UnionComm :: Set Int -> Set Int -> Bool
247 prop_UnionComm t1 t2 = (union t1 t2 == union t2 t1)
248
249 prop_DiffValid :: Property
250 prop_DiffValid = forValidUnitTree $ \t1 ->
251 forValidUnitTree $ \t2 ->
252 valid (difference t1 t2)
253
254 prop_Diff :: [Int] -> [Int] -> Bool
255 prop_Diff xs ys = toAscList (difference (fromList xs) (fromList ys))
256 == List.sort ((List.\\) (nub xs) (nub ys))
257
258 prop_IntValid :: Property
259 prop_IntValid = forValidUnitTree $ \t1 ->
260 forValidUnitTree $ \t2 ->
261 valid (intersection t1 t2)
262
263 prop_Int :: [Int] -> [Int] -> Bool
264 prop_Int xs ys = toAscList (intersection (fromList xs) (fromList ys))
265 == List.sort (nub ((List.intersect) (xs) (ys)))
266
267 {--------------------------------------------------------------------
268 Lists
269 --------------------------------------------------------------------}
270 prop_Ordered :: Property
271 prop_Ordered = forAll (choose (5,100)) $ \n ->
272 let xs = [0..n::Int]
273 in fromAscList xs === fromList xs
274
275 prop_DescendingOrdered :: Property
276 prop_DescendingOrdered = forAll (choose (5,100)) $ \n ->
277 let xs = [n,n-1..0::Int]
278 in fromDescList xs === fromList xs
279
280 prop_List :: [Int] -> Bool
281 prop_List xs = (sort (nub xs) == toList (fromList xs))
282
283 prop_DescList :: [Int] -> Bool
284 prop_DescList xs = (reverse (sort (nub xs)) == toDescList (fromList xs))
285
286 prop_AscDescList :: [Int] -> Bool
287 prop_AscDescList xs = toAscList s == reverse (toDescList s)
288 where s = fromList xs
289
290 prop_fromList :: [Int] -> Property
291 prop_fromList xs =
292 t === fromAscList sort_xs .&&.
293 t === fromDistinctAscList nub_sort_xs .&&.
294 t === List.foldr insert empty xs
295 where t = fromList xs
296 sort_xs = sort xs
297 nub_sort_xs = List.map List.head $ List.group sort_xs
298
299 prop_fromListDesc :: [Int] -> Property
300 prop_fromListDesc xs =
301 t === fromDescList sort_xs .&&.
302 t === fromDistinctDescList nub_sort_xs .&&.
303 t === List.foldr insert empty xs
304 where t = fromList xs
305 sort_xs = reverse (sort xs)
306 nub_sort_xs = List.map List.head $ List.group sort_xs
307
308 {--------------------------------------------------------------------
309 Set operations are like IntSet operations
310 --------------------------------------------------------------------}
311 toIntSet :: Set Int -> IntSet.IntSet
312 toIntSet = IntSet.fromList . toList
313
314 -- Check that Set Int.isProperSubsetOf is the same as Set.isProperSubsetOf.
315 prop_isProperSubsetOf :: Set Int -> Set Int -> Bool
316 prop_isProperSubsetOf a b = isProperSubsetOf a b == IntSet.isProperSubsetOf (toIntSet a) (toIntSet b)
317
318 -- In the above test, isProperSubsetOf almost always returns False (since a
319 -- random set is almost never a subset of another random set). So this second
320 -- test checks the True case.
321 prop_isProperSubsetOf2 :: Set Int -> Set Int -> Bool
322 prop_isProperSubsetOf2 a b = isProperSubsetOf a c == (a /= c) where
323 c = union a b
324
325 prop_isSubsetOf :: Set Int -> Set Int -> Bool
326 prop_isSubsetOf a b = isSubsetOf a b == IntSet.isSubsetOf (toIntSet a) (toIntSet b)
327
328 prop_isSubsetOf2 :: Set Int -> Set Int -> Bool
329 prop_isSubsetOf2 a b = isSubsetOf a (union a b)
330
331 prop_size :: Set Int -> Bool
332 prop_size s = size s == List.length (toList s)
333
334 prop_findMax :: Set Int -> Property
335 prop_findMax s = not (null s) ==> findMax s == maximum (toList s)
336
337 prop_findMin :: Set Int -> Property
338 prop_findMin s = not (null s) ==> findMin s == minimum (toList s)
339
340 prop_ord :: Set Int -> Set Int -> Bool
341 prop_ord s1 s2 = s1 `compare` s2 == toList s1 `compare` toList s2
342
343 prop_readShow :: Set Int -> Bool
344 prop_readShow s = s == read (show s)
345
346 prop_foldR :: Set Int -> Bool
347 prop_foldR s = foldr (:) [] s == toList s
348
349 prop_foldR' :: Set Int -> Bool
350 prop_foldR' s = foldr' (:) [] s == toList s
351
352 prop_foldL :: Set Int -> Bool
353 prop_foldL s = foldl (flip (:)) [] s == List.foldl (flip (:)) [] (toList s)
354
355 prop_foldL' :: Set Int -> Bool
356 prop_foldL' s = foldl' (flip (:)) [] s == List.foldl' (flip (:)) [] (toList s)
357
358 prop_map :: Set Int -> Bool
359 prop_map s = map id s == s
360
361 prop_maxView :: Set Int -> Bool
362 prop_maxView s = case maxView s of
363 Nothing -> null s
364 Just (m,s') -> m == maximum (toList s) && s == insert m s' && m `notMember` s'
365
366 prop_minView :: Set Int -> Bool
367 prop_minView s = case minView s of
368 Nothing -> null s
369 Just (m,s') -> m == minimum (toList s) && s == insert m s' && m `notMember` s'
370
371 prop_split :: Set Int -> Int -> Bool
372 prop_split s i = case split i s of
373 (s1,s2) -> all (<i) (toList s1) && all (>i) (toList s2) && i `delete` s == union s1 s2
374
375 prop_splitMember :: Set Int -> Int -> Bool
376 prop_splitMember s i = case splitMember i s of
377 (s1,t,s2) -> all (<i) (toList s1) && all (>i) (toList s2) && t == i `member` s && i `delete` s == union s1 s2
378
379 prop_splitRoot :: Set Int -> Bool
380 prop_splitRoot s = loop ls && (s == unions ls)
381 where
382 ls = splitRoot s
383 loop [] = True
384 loop (s1:rst) = List.null
385 [ (x,y) | x <- toList s1
386 , y <- toList (unions rst)
387 , x > y ]
388
389 prop_partition :: Set Int -> Int -> Bool
390 prop_partition s i = case partition odd s of
391 (s1,s2) -> all odd (toList s1) && all even (toList s2) && s == s1 `union` s2
392
393 prop_filter :: Set Int -> Int -> Bool
394 prop_filter s i = partition odd s == (filter odd s, filter even s)