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