Correct Data.Set Arbitrary instance never to return unbalanced trees.
[packages/containers.git] / tests / set-properties.hs
1 {-# LANGUAGE CPP, ScopedTypeVariables #-}
2
3 -- QuickCheck properties for Data.Set
4 -- > ghc -DTESTING -fforce-recomp -O2 --make -fhpc -i.. set-properties.hs
5
6 import Data.List (nub,sort)
7 import qualified Data.List as List
8 import Data.Set
9 import Prelude hiding (lookup, null, map ,filter)
10 import Test.QuickCheck
11
12 main :: IO ()
13 main = do
14 q $ label "prop_Valid" prop_Valid
15 q $ label "prop_Single" prop_Single
16 q $ label "prop_Single" prop_Single
17 q $ label "prop_InsertValid" prop_InsertValid
18 q $ label "prop_InsertValid" prop_InsertValid
19 q $ label "prop_InsertDelete" prop_InsertDelete
20 q $ label "prop_InsertDelete" prop_InsertDelete
21 q $ label "prop_DeleteValid" prop_DeleteValid
22 q $ label "prop_DeleteValid" prop_DeleteValid
23 q $ label "prop_Join" prop_Join
24 q $ label "prop_Join" prop_Join
25 q $ label "prop_Merge" prop_Merge
26 q $ label "prop_Merge" prop_Merge
27 q $ label "prop_UnionValid" prop_UnionValid
28 q $ label "prop_UnionValid" prop_UnionValid
29 q $ label "prop_UnionInsert" prop_UnionInsert
30 q $ label "prop_UnionInsert" prop_UnionInsert
31 q $ label "prop_UnionAssoc" prop_UnionAssoc
32 q $ label "prop_UnionAssoc" prop_UnionAssoc
33 q $ label "prop_UnionComm" prop_UnionComm
34 q $ label "prop_UnionComm" prop_UnionComm
35 q $ label "prop_DiffValid" prop_DiffValid
36 q $ label "prop_Diff" prop_Diff
37 q $ label "prop_Diff" prop_Diff
38 q $ label "prop_IntValid" prop_IntValid
39 q $ label "prop_Int" prop_Int
40 q $ label "prop_Int" prop_Int
41 q $ label "prop_Ordered" prop_Ordered
42 q $ label "prop_List" prop_List
43 q $ label "prop_List" prop_List
44 where
45 q :: Testable prop => prop -> IO ()
46 q = quickCheckWith args
47
48 {--------------------------------------------------------------------
49 QuickCheck
50 --------------------------------------------------------------------}
51
52 args :: Args
53 args = stdArgs { maxSuccess = 500
54 , maxDiscard = 500
55 }
56
57 {--------------------------------------------------------------------
58 Arbitrary, reasonably balanced trees
59 --------------------------------------------------------------------}
60 instance (Enum a) => Arbitrary (Set a) where
61 arbitrary = sized (arbtree 0 maxkey)
62 where maxkey = 10000
63
64 arbtree :: (Enum a) => Int -> Int -> Int -> Gen (Set a)
65 arbtree lo hi n = do t <- gentree lo hi n
66 if balanced t then return t else arbtree lo hi n
67 where gentree lo hi n
68 | n <= 0 = return Tip
69 | lo >= hi = return Tip
70 | otherwise = do i <- choose (lo,hi)
71 m <- choose (1,70)
72 let (ml,mr) | m==(1::Int) = (1,2)
73 | m==2 = (2,1)
74 | m==3 = (1,1)
75 | otherwise = (2,2)
76 l <- gentree lo (i-1) (n `div` ml)
77 r <- gentree (i+1) hi (n `div` mr)
78 return (bin (toEnum i) l r)
79
80 {--------------------------------------------------------------------
81 Valid tree's
82 --------------------------------------------------------------------}
83 forValid :: (Enum a,Show a,Testable b) => (Set a -> b) -> Property
84 forValid f = forAll arbitrary $ \t ->
85 -- classify (balanced t) "balanced" $
86 classify (size t == 0) "empty" $
87 classify (size t > 0 && size t <= 10) "small" $
88 classify (size t > 10 && size t <= 64) "medium" $
89 classify (size t > 64) "large" $
90 balanced t ==> f t
91
92 forValidUnitTree :: Testable a => (Set Int -> a) -> Property
93 forValidUnitTree f = forValid f
94
95 prop_Valid :: Property
96 prop_Valid = forValidUnitTree $ \t -> valid t
97
98 {--------------------------------------------------------------------
99 Single, Insert, Delete
100 --------------------------------------------------------------------}
101 prop_Single :: Int -> Bool
102 prop_Single x = (insert x empty == singleton x)
103
104 prop_InsertValid :: Int -> Property
105 prop_InsertValid k = forValidUnitTree $ \t -> valid (insert k t)
106
107 prop_InsertDelete :: Int -> Set Int -> Property
108 prop_InsertDelete k t = not (member k t) ==> delete k (insert k t) == t
109
110 prop_DeleteValid :: Int -> Property
111 prop_DeleteValid k = forValidUnitTree $ \t -> valid (delete k (insert k t))
112
113 {--------------------------------------------------------------------
114 Balance
115 --------------------------------------------------------------------}
116 prop_Join :: Int -> Property
117 prop_Join x = forValidUnitTree $ \t ->
118 let (l,r) = split x t
119 in valid (join x l r)
120
121 prop_Merge :: Int -> Property
122 prop_Merge x = forValidUnitTree $ \t ->
123 let (l,r) = split x t
124 in valid (merge l r)
125
126 {--------------------------------------------------------------------
127 Union
128 --------------------------------------------------------------------}
129 prop_UnionValid :: Property
130 prop_UnionValid
131 = forValidUnitTree $ \t1 ->
132 forValidUnitTree $ \t2 ->
133 valid (union t1 t2)
134
135 prop_UnionInsert :: Int -> Set Int -> Bool
136 prop_UnionInsert x t = union t (singleton x) == insert x t
137
138 prop_UnionAssoc :: Set Int -> Set Int -> Set Int -> Bool
139 prop_UnionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3
140
141 prop_UnionComm :: Set Int -> Set Int -> Bool
142 prop_UnionComm t1 t2 = (union t1 t2 == union t2 t1)
143
144 prop_DiffValid :: Property
145 prop_DiffValid = forValidUnitTree $ \t1 ->
146 forValidUnitTree $ \t2 ->
147 valid (difference t1 t2)
148
149 prop_Diff :: [Int] -> [Int] -> Bool
150 prop_Diff xs ys = toAscList (difference (fromList xs) (fromList ys))
151 == List.sort ((List.\\) (nub xs) (nub ys))
152
153 prop_IntValid :: Property
154 prop_IntValid = forValidUnitTree $ \t1 ->
155 forValidUnitTree $ \t2 ->
156 valid (intersection t1 t2)
157
158 prop_Int :: [Int] -> [Int] -> Bool
159 prop_Int xs ys = toAscList (intersection (fromList xs) (fromList ys))
160 == List.sort (nub ((List.intersect) (xs) (ys)))
161
162 {--------------------------------------------------------------------
163 Lists
164 --------------------------------------------------------------------}
165 prop_Ordered :: Property
166 prop_Ordered = forAll (choose (5,100)) $ \n ->
167 let xs = [0..n::Int]
168 in fromAscList xs == fromList xs
169
170 prop_List :: [Int] -> Bool
171 prop_List xs = (sort (nub xs) == toList (fromList xs))