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