Add `disjoint` for Data.Set
[packages/containers.git] / tests / set-properties.hs
1 {-# LANGUAGE CPP #-}
2 import qualified Data.IntSet as IntSet
3 import Data.List (nub,sort)
4 import qualified Data.List as List
5 import Data.Monoid (mempty)
6 import Data.Maybe
7 import Data.Set
8 import Prelude hiding (lookup, null, map, filter, foldr, foldl, all, take, drop, splitAt)
9 import Test.Framework
10 import Test.Framework.Providers.HUnit
11 import Test.Framework.Providers.QuickCheck2
12 import Test.HUnit hiding (Test, Testable)
13 import Test.QuickCheck
14 import Test.QuickCheck.Function
15 import Test.QuickCheck.Poly
16 import Control.Monad.Trans.State.Strict
17 import Control.Monad.Trans.Class
18 import Control.Monad (liftM, liftM3)
19 import Data.Functor.Identity
20 import Data.Foldable (all)
21 #if !MIN_VERSION_base(4,8,0)
22 import Control.Applicative (Applicative (..), (<$>))
23 #endif
24 import Control.Applicative (liftA2)
25
26 main :: IO ()
27 main = defaultMain [ testCase "lookupLT" test_lookupLT
28 , testCase "lookupGT" test_lookupGT
29 , testCase "lookupLE" test_lookupLE
30 , testCase "lookupGE" test_lookupGE
31 , testCase "lookupIndex" test_lookupIndex
32 , testCase "findIndex" test_findIndex
33 , testCase "elemAt" test_elemAt
34 , testCase "deleteAt" test_deleteAt
35 , testProperty "prop_Valid" prop_Valid
36 , testProperty "prop_Single" prop_Single
37 , testProperty "prop_Member" prop_Member
38 , testProperty "prop_NotMember" prop_NotMember
39 , testProperty "prop_LookupLT" prop_LookupLT
40 , testProperty "prop_LookupGT" prop_LookupGT
41 , testProperty "prop_LookupLE" prop_LookupLE
42 , testProperty "prop_LookupGE" prop_LookupGE
43 , testProperty "prop_InsertValid" prop_InsertValid
44 , testProperty "prop_InsertDelete" prop_InsertDelete
45 , testProperty "prop_InsertBiased" prop_InsertBiased
46 , testProperty "prop_DeleteValid" prop_DeleteValid
47 , testProperty "prop_Link" prop_Link
48 , testProperty "prop_Merge" prop_Merge
49 , testProperty "prop_UnionValid" prop_UnionValid
50 , testProperty "prop_UnionInsert" prop_UnionInsert
51 , testProperty "prop_UnionAssoc" prop_UnionAssoc
52 , testProperty "prop_UnionComm" prop_UnionComm
53 , testProperty "prop_UnionBiased" prop_UnionBiased
54 , testProperty "prop_DiffValid" prop_DiffValid
55 , testProperty "prop_Diff" prop_Diff
56 , testProperty "prop_IntValid" prop_IntValid
57 , testProperty "prop_Int" prop_Int
58 , testProperty "prop_IntBiased" prop_IntBiased
59 , testProperty "prop_Ordered" prop_Ordered
60 , testProperty "prop_DescendingOrdered" prop_DescendingOrdered
61 , testProperty "prop_List" prop_List
62 , testProperty "prop_DescList" prop_DescList
63 , testProperty "prop_AscDescList" prop_AscDescList
64 , testProperty "prop_fromList" prop_fromList
65 , testProperty "prop_fromListDesc" prop_fromListDesc
66 , testProperty "prop_isProperSubsetOf" prop_isProperSubsetOf
67 , testProperty "prop_isProperSubsetOf2" prop_isProperSubsetOf2
68 , testProperty "prop_isSubsetOf" prop_isSubsetOf
69 , testProperty "prop_isSubsetOf2" prop_isSubsetOf2
70 , testProperty "prop_disjoint" prop_disjoint
71 , testProperty "prop_size" prop_size
72 , testProperty "prop_lookupMax" prop_lookupMax
73 , testProperty "prop_lookupMin" prop_lookupMin
74 , testProperty "prop_findMax" prop_findMax
75 , testProperty "prop_findMin" prop_findMin
76 , testProperty "prop_ord" prop_ord
77 , testProperty "prop_readShow" prop_readShow
78 , testProperty "prop_foldR" prop_foldR
79 , testProperty "prop_foldR'" prop_foldR'
80 , testProperty "prop_foldL" prop_foldL
81 , testProperty "prop_foldL'" prop_foldL'
82 , testProperty "prop_map" prop_map
83 , testProperty "prop_map2" prop_map2
84 , testProperty "prop_mapMonotonic" prop_mapMonotonic
85 , testProperty "prop_maxView" prop_maxView
86 , testProperty "prop_minView" prop_minView
87 , testProperty "prop_split" prop_split
88 , testProperty "prop_splitMember" prop_splitMember
89 , testProperty "prop_splitRoot" prop_splitRoot
90 , testProperty "prop_partition" prop_partition
91 , testProperty "prop_filter" prop_filter
92 , testProperty "takeWhileAntitone" prop_takeWhileAntitone
93 , testProperty "dropWhileAntitone" prop_dropWhileAntitone
94 , testProperty "spanAntitone" prop_spanAntitone
95 , testProperty "take" prop_take
96 , testProperty "drop" prop_drop
97 , testProperty "splitAt" prop_splitAt
98 , testProperty "powerSet" prop_powerSet
99 , testProperty "cartesianProduct" prop_cartesianProduct
100 , testProperty "disjointUnion" prop_disjointUnion
101 ]
102
103 -- A type with a peculiar Eq instance designed to make sure keys
104 -- come from where they're supposed to.
105 data OddEq a = OddEq a Bool deriving (Show)
106
107 getOddEq :: OddEq a -> (a, Bool)
108 getOddEq (OddEq b a) = (b, a)
109 instance Arbitrary a => Arbitrary (OddEq a) where
110 arbitrary = OddEq <$> arbitrary <*> arbitrary
111 instance Eq a => Eq (OddEq a) where
112 OddEq x _ == OddEq y _ = x == y
113 instance Ord a => Ord (OddEq a) where
114 OddEq x _ `compare` OddEq y _ = x `compare` y
115
116 ----------------------------------------------------------------
117 -- Unit tests
118 ----------------------------------------------------------------
119
120 test_lookupLT :: Assertion
121 test_lookupLT = do
122 lookupLT 3 (fromList [3, 5]) @?= Nothing
123 lookupLT 5 (fromList [3, 5]) @?= Just 3
124
125 test_lookupGT :: Assertion
126 test_lookupGT = do
127 lookupGT 4 (fromList [3, 5]) @?= Just 5
128 lookupGT 5 (fromList [3, 5]) @?= Nothing
129
130 test_lookupLE :: Assertion
131 test_lookupLE = do
132 lookupLE 2 (fromList [3, 5]) @?= Nothing
133 lookupLE 4 (fromList [3, 5]) @?= Just 3
134 lookupLE 5 (fromList [3, 5]) @?= Just 5
135
136 test_lookupGE :: Assertion
137 test_lookupGE = do
138 lookupGE 3 (fromList [3, 5]) @?= Just 3
139 lookupGE 4 (fromList [3, 5]) @?= Just 5
140 lookupGE 6 (fromList [3, 5]) @?= Nothing
141
142 {--------------------------------------------------------------------
143 Indexed
144 --------------------------------------------------------------------}
145
146 test_lookupIndex :: Assertion
147 test_lookupIndex = do
148 isJust (lookupIndex 2 (fromList [5,3])) @?= False
149 fromJust (lookupIndex 3 (fromList [5,3])) @?= 0
150 fromJust (lookupIndex 5 (fromList [5,3])) @?= 1
151 isJust (lookupIndex 6 (fromList [5,3])) @?= False
152
153 test_findIndex :: Assertion
154 test_findIndex = do
155 findIndex 3 (fromList [5,3]) @?= 0
156 findIndex 5 (fromList [5,3]) @?= 1
157
158 test_elemAt :: Assertion
159 test_elemAt = do
160 elemAt 0 (fromList [5,3]) @?= 3
161 elemAt 1 (fromList [5,3]) @?= 5
162
163 test_deleteAt :: Assertion
164 test_deleteAt = do
165 deleteAt 0 (fromList [5,3]) @?= singleton 5
166 deleteAt 1 (fromList [5,3]) @?= singleton 3
167
168 {--------------------------------------------------------------------
169 Arbitrary, reasonably balanced trees
170 --------------------------------------------------------------------}
171
172 -- | The IsInt class lets us constrain a type variable to be Int in an entirely
173 -- standard way. The constraint @ IsInt a @ is essentially equivalent to the
174 -- GHC-only constraint @ a ~ Int @, but @ IsInt @ requires manual intervention
175 -- to use. If ~ is ever standardized, we should certainly use it instead.
176 -- Earlier versions used an Enum constraint, but this is confusing because
177 -- not all Enum instances will work properly for the Arbitrary instance here.
178 class (Show a, Read a, Integral a, Arbitrary a) => IsInt a where
179 fromIntF :: f Int -> f a
180
181 instance IsInt Int where
182 fromIntF = id
183
184 -- | Convert an Int to any instance of IsInt
185 fromInt :: IsInt a => Int -> a
186 fromInt = runIdentity . fromIntF . Identity
187
188 {- We don't actually need this, but we can add it if we ever do
189 toIntF :: IsInt a => g a -> g Int
190 toIntF = unf . fromIntF . F $ id
191
192 newtype F g a b = F {unf :: g b -> a}
193
194 toInt :: IsInt a => a -> Int
195 toInt = runIdentity . toIntF . Identity -}
196
197
198 -- How much the minimum value of an arbitrary set should vary
199 positionFactor :: Int
200 positionFactor = 1
201
202 -- How much the gap between consecutive elements in an arbitrary
203 -- set should vary
204 gapRange :: Int
205 gapRange = 5
206
207 instance IsInt a => Arbitrary (Set a) where
208 arbitrary = sized (\sz0 -> do
209 sz <- choose (0, sz0)
210 middle <- choose (-positionFactor * (sz + 1), positionFactor * (sz + 1))
211 let shift = (sz * (gapRange) + 1) `quot` 2
212 start = middle - shift
213 t <- evalStateT (mkArb step sz) start
214 if valid t then pure t else error "Test generated invalid tree!")
215 where
216 step = do
217 i <- get
218 diff <- lift $ choose (1, gapRange)
219 let i' = i + diff
220 put i'
221 pure (fromInt i')
222
223 class Monad m => MonadGen m where
224 liftGen :: Gen a -> m a
225 instance MonadGen Gen where
226 liftGen = id
227 instance MonadGen m => MonadGen (StateT s m) where
228 liftGen = lift . liftGen
229
230 -- | Given an action that produces successively larger elements and
231 -- a size, produce a set of arbitrary shape with exactly that size.
232 mkArb :: MonadGen m => m a -> Int -> m (Set a)
233 mkArb step n
234 | n <= 0 = return Tip
235 | n == 1 = singleton `liftM` step
236 | n == 2 = do
237 dir <- liftGen arbitrary
238 p <- step
239 q <- step
240 if dir
241 then return (Bin 2 q (singleton p) Tip)
242 else return (Bin 2 p Tip (singleton q))
243 | otherwise = do
244 -- This assumes a balance factor of delta = 3
245 let upper = (3*(n - 1)) `quot` 4
246 let lower = (n + 2) `quot` 4
247 ln <- liftGen $ choose (lower, upper)
248 let rn = n - ln - 1
249 liftM3 (\lt x rt -> Bin n x lt rt) (mkArb step ln) step (mkArb step rn)
250
251 -- | Given a strictly increasing list of elements, produce an arbitrarily
252 -- shaped set with exactly those elements.
253 setFromList :: [a] -> Gen (Set a)
254 setFromList xs = flip evalStateT xs $ mkArb step (length xs)
255 where
256 step = do
257 x : xs <- get
258 put xs
259 pure x
260
261 data TwoSets = TwoSets (Set Int) (Set Int) deriving (Show)
262
263 data TwoLists a = TwoLists [a] [a]
264
265 data Options2 = One2 | Two2 | Both2 deriving (Bounded, Enum)
266 instance Arbitrary Options2 where
267 arbitrary = arbitraryBoundedEnum
268
269 -- We produce two lists from a simple "universe". This instance
270 -- is intended to give good results when the two lists are then
271 -- combined with each other; if other elements are used with them,
272 -- they may or may not behave particularly well.
273 instance IsInt a => Arbitrary (TwoLists a) where
274 arbitrary = sized $ \sz0 -> do
275 sz <- choose (0, sz0)
276 let universe = [0,3..3*(fromInt sz - 1)]
277 divide2Gen universe
278
279 instance Arbitrary TwoSets where
280 arbitrary = do
281 TwoLists l r <- arbitrary
282 TwoSets <$> setFromList l <*> setFromList r
283
284 divide2Gen :: [a] -> Gen (TwoLists a)
285 divide2Gen [] = pure (TwoLists [] [])
286 divide2Gen (x : xs) = do
287 way <- arbitrary
288 TwoLists ls rs <- divide2Gen xs
289 case way of
290 One2 -> pure (TwoLists (x : ls) rs)
291 Two2 -> pure (TwoLists ls (x : rs))
292 Both2 -> pure (TwoLists (x : ls) (x : rs))
293
294 {--------------------------------------------------------------------
295 Valid trees
296 --------------------------------------------------------------------}
297 forValid :: (IsInt a,Testable b) => (Set a -> b) -> Property
298 forValid f = forAll arbitrary $ \t ->
299 classify (size t == 0) "empty" $
300 classify (size t > 0 && size t <= 10) "small" $
301 classify (size t > 10 && size t <= 64) "medium" $
302 classify (size t > 64) "large" $ f t
303
304 forValidUnitTree :: Testable a => (Set Int -> a) -> Property
305 forValidUnitTree f = forValid f
306
307 prop_Valid :: Property
308 prop_Valid = forValidUnitTree $ \t -> valid t
309
310 {--------------------------------------------------------------------
311 Single, Member, Insert, Delete
312 --------------------------------------------------------------------}
313 prop_Single :: Int -> Bool
314 prop_Single x = (insert x empty == singleton x)
315
316 prop_Member :: [Int] -> Int -> Bool
317 prop_Member xs n =
318 let m = fromList xs
319 in all (\k -> k `member` m == (k `elem` xs)) (n : xs)
320
321 prop_NotMember :: [Int] -> Int -> Bool
322 prop_NotMember xs n =
323 let m = fromList xs
324 in all (\k -> k `notMember` m == (k `notElem` xs)) (n : xs)
325
326 test_LookupSomething :: (Int -> Set Int -> Maybe Int) -> (Int -> Int -> Bool) -> [Int] -> Bool
327 test_LookupSomething lookup' cmp xs =
328 let odd_sorted_xs = filter_odd $ nub $ sort xs
329 t = fromList odd_sorted_xs
330 test x = case List.filter (`cmp` x) odd_sorted_xs of
331 [] -> lookup' x t == Nothing
332 cs | 0 `cmp` 1 -> lookup' x t == Just (last cs) -- we want largest such element
333 | otherwise -> lookup' x t == Just (head cs) -- we want smallest such element
334 in all test xs
335
336 where filter_odd [] = []
337 filter_odd [_] = []
338 filter_odd (_ : o : xs) = o : filter_odd xs
339
340 prop_LookupLT :: [Int] -> Bool
341 prop_LookupLT = test_LookupSomething lookupLT (<)
342
343 prop_LookupGT :: [Int] -> Bool
344 prop_LookupGT = test_LookupSomething lookupGT (>)
345
346 prop_LookupLE :: [Int] -> Bool
347 prop_LookupLE = test_LookupSomething lookupLE (<=)
348
349 prop_LookupGE :: [Int] -> Bool
350 prop_LookupGE = test_LookupSomething lookupGE (>=)
351
352 prop_InsertValid :: Int -> Property
353 prop_InsertValid k = forValidUnitTree $ \t -> valid (insert k t)
354
355 prop_InsertDelete :: Int -> Set Int -> Property
356 prop_InsertDelete k t = not (member k t) ==> delete k (insert k t) == t
357
358 prop_InsertBiased :: Int -> Set Int -> Bool
359 prop_InsertBiased k t = (k, True) `member` kt
360 where
361 t' = mapMonotonic (`OddEq` False) t
362 kt' = insert (OddEq k True) t'
363 kt = mapMonotonic getOddEq kt'
364
365 prop_DeleteValid :: Int -> Property
366 prop_DeleteValid k = forValidUnitTree $ \t -> valid (delete k (insert k t))
367
368 {--------------------------------------------------------------------
369 Balance
370 --------------------------------------------------------------------}
371 prop_Link :: Int -> Property
372 prop_Link x = forValidUnitTree $ \t ->
373 let (l,r) = split x t
374 in valid (link x l r)
375
376 prop_Merge :: Int -> Property
377 prop_Merge x = forValidUnitTree $ \t ->
378 let (l,r) = split x t
379 in valid (merge l r)
380
381 {--------------------------------------------------------------------
382 Union
383 --------------------------------------------------------------------}
384 prop_UnionValid :: Property
385 prop_UnionValid
386 = forValidUnitTree $ \t1 ->
387 forValidUnitTree $ \t2 ->
388 valid (union t1 t2)
389
390 prop_UnionInsert :: Int -> Set Int -> Bool
391 prop_UnionInsert x t = union t (singleton x) == insert x t
392
393 prop_UnionAssoc :: Set Int -> Set Int -> Set Int -> Bool
394 prop_UnionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3
395
396 prop_UnionComm :: TwoSets -> Bool
397 prop_UnionComm (TwoSets t1 t2) = (union t1 t2 == union t2 t1)
398
399 prop_UnionBiased :: TwoSets -> Property
400 prop_UnionBiased (TwoSets l r) = union l' r' === union l' (difference r' l')
401 where
402 l' = mapMonotonic (`OddEq` False) l
403 r' = mapMonotonic (`OddEq` True) r
404
405 prop_IntBiased :: TwoSets -> Bool
406 prop_IntBiased (TwoSets l r) = all (\(OddEq _ b) -> not b) l'r'
407 where
408 l' = mapMonotonic (`OddEq` False) l
409 r' = mapMonotonic (`OddEq` True) r
410 l'r' = intersection l' r'
411
412 prop_DiffValid :: Property
413 prop_DiffValid = forValidUnitTree $ \t1 ->
414 forValidUnitTree $ \t2 ->
415 valid (difference t1 t2)
416
417 prop_Diff :: [Int] -> [Int] -> Bool
418 prop_Diff xs ys = toAscList (difference (fromList xs) (fromList ys))
419 == List.sort ((List.\\) (nub xs) (nub ys))
420
421 prop_IntValid :: Property
422 prop_IntValid = forValidUnitTree $ \t1 ->
423 forValidUnitTree $ \t2 ->
424 valid (intersection t1 t2)
425
426 prop_Int :: [Int] -> [Int] -> Bool
427 prop_Int xs ys = toAscList (intersection (fromList xs) (fromList ys))
428 == List.sort (nub ((List.intersect) (xs) (ys)))
429
430 prop_disjoint :: Set Int -> Set Int -> Bool
431 prop_disjoint a b = a `disjoint` b == null (a `intersection` b)
432
433 {--------------------------------------------------------------------
434 Lists
435 --------------------------------------------------------------------}
436 prop_Ordered :: Property
437 prop_Ordered = forAll (choose (5,100)) $ \n ->
438 let xs = [0..n::Int]
439 in fromAscList xs === fromList xs
440
441 prop_DescendingOrdered :: Property
442 prop_DescendingOrdered = forAll (choose (5,100)) $ \n ->
443 let xs = [n,n-1..0::Int]
444 in fromDescList xs === fromList xs
445
446 prop_List :: [Int] -> Bool
447 prop_List xs = (sort (nub xs) == toList (fromList xs))
448
449 prop_DescList :: [Int] -> Bool
450 prop_DescList xs = (reverse (sort (nub xs)) == toDescList (fromList xs))
451
452 prop_AscDescList :: [Int] -> Bool
453 prop_AscDescList xs = toAscList s == reverse (toDescList s)
454 where s = fromList xs
455
456 prop_fromList :: [Int] -> Property
457 prop_fromList xs =
458 t === fromAscList sort_xs .&&.
459 t === fromDistinctAscList nub_sort_xs .&&.
460 t === List.foldr insert empty xs
461 where t = fromList xs
462 sort_xs = sort xs
463 nub_sort_xs = List.map List.head $ List.group sort_xs
464
465 prop_fromListDesc :: [Int] -> Property
466 prop_fromListDesc xs =
467 t === fromDescList sort_xs .&&.
468 t === fromDistinctDescList nub_sort_xs .&&.
469 t === List.foldr insert empty xs
470 where t = fromList xs
471 sort_xs = reverse (sort xs)
472 nub_sort_xs = List.map List.head $ List.group sort_xs
473
474 {--------------------------------------------------------------------
475 Set operations are like IntSet operations
476 --------------------------------------------------------------------}
477 toIntSet :: Set Int -> IntSet.IntSet
478 toIntSet = IntSet.fromList . toList
479
480 -- Check that Set Int.isProperSubsetOf is the same as Set.isProperSubsetOf.
481 prop_isProperSubsetOf :: TwoSets -> Bool
482 prop_isProperSubsetOf (TwoSets a b) = isProperSubsetOf a b == IntSet.isProperSubsetOf (toIntSet a) (toIntSet b)
483
484 -- In the above test, isProperSubsetOf almost always returns False (since a
485 -- random set is almost never a subset of another random set). So this second
486 -- test checks the True case.
487 prop_isProperSubsetOf2 :: TwoSets -> Bool
488 prop_isProperSubsetOf2 (TwoSets a b) = isProperSubsetOf a c == (a /= c) where
489 c = union a b
490
491 prop_isSubsetOf :: TwoSets -> Bool
492 prop_isSubsetOf (TwoSets a b) = isSubsetOf a b == IntSet.isSubsetOf (toIntSet a) (toIntSet b)
493
494 prop_isSubsetOf2 :: TwoSets -> Bool
495 prop_isSubsetOf2 (TwoSets a b) = isSubsetOf a (union a b)
496
497 prop_size :: Set Int -> Bool
498 prop_size s = size s == List.length (toList s)
499
500 prop_findMax :: Set Int -> Property
501 prop_findMax s = not (null s) ==> findMax s == maximum (toList s)
502
503 prop_findMin :: Set Int -> Property
504 prop_findMin s = not (null s) ==> findMin s == minimum (toList s)
505
506 prop_lookupMin :: Set Int -> Property
507 prop_lookupMin m = lookupMin m === (fst <$> minView m)
508
509 prop_lookupMax :: Set Int -> Property
510 prop_lookupMax m = lookupMax m === (fst <$> maxView m)
511
512 prop_ord :: TwoSets -> Bool
513 prop_ord (TwoSets s1 s2) = s1 `compare` s2 == toList s1 `compare` toList s2
514
515 prop_readShow :: Set Int -> Bool
516 prop_readShow s = s == read (show s)
517
518 prop_foldR :: Set Int -> Bool
519 prop_foldR s = foldr (:) [] s == toList s
520
521 prop_foldR' :: Set Int -> Bool
522 prop_foldR' s = foldr' (:) [] s == toList s
523
524 prop_foldL :: Set Int -> Bool
525 prop_foldL s = foldl (flip (:)) [] s == List.foldl (flip (:)) [] (toList s)
526
527 prop_foldL' :: Set Int -> Bool
528 prop_foldL' s = foldl' (flip (:)) [] s == List.foldl' (flip (:)) [] (toList s)
529
530 prop_map :: Set Int -> Bool
531 prop_map s = map id s == s
532
533 prop_map2 :: Fun Int Int -> Fun Int Int -> Set Int -> Property
534 prop_map2 f g s = map (apply f) (map (apply g) s) === map (apply f . apply g) s
535
536 prop_mapMonotonic :: Set Int -> Property
537 prop_mapMonotonic s = mapMonotonic id s === s
538
539 prop_maxView :: Set Int -> Bool
540 prop_maxView s = case maxView s of
541 Nothing -> null s
542 Just (m,s') -> m == maximum (toList s) && s == insert m s' && m `notMember` s'
543
544 prop_minView :: Set Int -> Bool
545 prop_minView s = case minView s of
546 Nothing -> null s
547 Just (m,s') -> m == minimum (toList s) && s == insert m s' && m `notMember` s'
548
549 prop_split :: Set Int -> Int -> Bool
550 prop_split s i = case split i s of
551 (s1,s2) -> all (<i) (toList s1) && all (>i) (toList s2) && i `delete` s == union s1 s2
552
553 prop_splitMember :: Set Int -> Int -> Bool
554 prop_splitMember s i = case splitMember i s of
555 (s1,t,s2) -> all (<i) (toList s1) && all (>i) (toList s2) && t == i `member` s && i `delete` s == union s1 s2
556
557 prop_splitRoot :: Set Int -> Bool
558 prop_splitRoot s = loop ls && (s == unions ls)
559 where
560 ls = splitRoot s
561 loop [] = True
562 loop (s1:rst) = List.null
563 [ (x,y) | x <- toList s1
564 , y <- toList (unions rst)
565 , x > y ]
566
567 prop_partition :: Set Int -> Int -> Bool
568 prop_partition s i = case partition odd s of
569 (s1,s2) -> all odd (toList s1) && all even (toList s2) && s == s1 `union` s2
570
571 prop_filter :: Set Int -> Int -> Bool
572 prop_filter s i = partition odd s == (filter odd s, filter even s)
573
574 prop_take :: Int -> Set Int -> Property
575 prop_take n xs = valid taken .&&.
576 taken === fromDistinctAscList (List.take n (toList xs))
577 where
578 taken = take n xs
579
580 prop_drop :: Int -> Set Int -> Property
581 prop_drop n xs = valid dropped .&&.
582 dropped === fromDistinctAscList (List.drop n (toList xs))
583 where
584 dropped = drop n xs
585
586 prop_splitAt :: Int -> Set Int -> Property
587 prop_splitAt n xs = valid taken .&&.
588 valid dropped .&&.
589 taken === take n xs .&&.
590 dropped === drop n xs
591 where
592 (taken, dropped) = splitAt n xs
593
594 prop_takeWhileAntitone :: [Either Int Int] -> Property
595 prop_takeWhileAntitone xs' = valid tw .&&. tw === filter isLeft xs
596 where
597 xs = fromList xs'
598 tw = takeWhileAntitone isLeft xs
599
600 prop_dropWhileAntitone :: [Either Int Int] -> Property
601 prop_dropWhileAntitone xs' = valid tw .&&. tw === filter (not . isLeft) xs
602 where
603 xs = fromList xs'
604 tw = dropWhileAntitone isLeft xs
605
606 prop_spanAntitone :: [Either Int Int] -> Property
607 prop_spanAntitone xs' = valid tw .&&. valid dw
608 .&&. tw === takeWhileAntitone isLeft xs
609 .&&. dw === dropWhileAntitone isLeft xs
610 where
611 xs = fromList xs'
612 (tw, dw) = spanAntitone isLeft xs
613
614 prop_powerSet :: Set Int -> Property
615 prop_powerSet xs = valid ps .&&. ps === ps'
616 where
617 xs' = take 10 xs
618
619 ps = powerSet xs'
620 ps' = fromList . fmap fromList $ lps (toList xs')
621
622 lps [] = [[]]
623 lps (y : ys) = fmap (y:) (lps ys) ++ lps ys
624
625 prop_cartesianProduct :: Set Int -> Set Int -> Property
626 prop_cartesianProduct xs ys =
627 valid cp .&&. toList cp === liftA2 (,) (toList xs) (toList ys)
628 where cp = cartesianProduct xs ys
629
630 prop_disjointUnion :: Set Int -> Set Int -> Property
631 prop_disjointUnion xs ys =
632 valid du .&&. du === union (mapMonotonic Left xs) (mapMonotonic Right ys)
633 where du = disjointUnion xs ys
634
635 isLeft :: Either a b -> Bool
636 isLeft (Left _) = True
637 isLeft _ = False