Improve query functions of Map and Set.
[packages/containers.git] / tests / map-properties.hs
1 {-# LANGUAGE CPP #-}
2
3 #ifdef STRICT
4 import Data.Map.Strict as Data.Map
5 #else
6 import Data.Map.Lazy as Data.Map
7 #endif
8
9 import Data.Monoid
10 import Data.Maybe hiding (mapMaybe)
11 import Data.Ord
12 import Data.Function
13 import Prelude hiding (lookup, null, map, filter, foldr, foldl)
14 import qualified Prelude (map)
15
16 import Data.List (nub,sort)
17 import qualified Data.List as List
18 import qualified Data.Set
19 import Test.Framework
20 import Test.Framework.Providers.HUnit
21 import Test.Framework.Providers.QuickCheck2
22 import Test.HUnit hiding (Test, Testable)
23 import Test.QuickCheck
24 import Text.Show.Functions ()
25
26 default (Int)
27
28 main :: IO ()
29 main = defaultMainWithOpts
30 [ testCase "ticket4242" test_ticket4242
31 , testCase "index" test_index
32 , testCase "size" test_size
33 , testCase "size2" test_size2
34 , testCase "member" test_member
35 , testCase "notMember" test_notMember
36 , testCase "lookup" test_lookup
37 , testCase "findWithDefault" test_findWithDefault
38 , testCase "empty" test_empty
39 , testCase "mempty" test_mempty
40 , testCase "singleton" test_singleton
41 , testCase "insert" test_insert
42 , testCase "insertWith" test_insertWith
43 , testCase "insertWithKey" test_insertWithKey
44 , testCase "insertLookupWithKey" test_insertLookupWithKey
45 , testCase "delete" test_delete
46 , testCase "adjust" test_adjust
47 , testCase "adjustWithKey" test_adjustWithKey
48 , testCase "update" test_update
49 , testCase "updateWithKey" test_updateWithKey
50 , testCase "updateLookupWithKey" test_updateLookupWithKey
51 , testCase "alter" test_alter
52 , testCase "union" test_union
53 , testCase "mappend" test_mappend
54 , testCase "unionWith" test_unionWith
55 , testCase "unionWithKey" test_unionWithKey
56 , testCase "unions" test_unions
57 , testCase "mconcat" test_mconcat
58 , testCase "unionsWith" test_unionsWith
59 , testCase "difference" test_difference
60 , testCase "differenceWith" test_differenceWith
61 , testCase "differenceWithKey" test_differenceWithKey
62 , testCase "intersection" test_intersection
63 , testCase "intersectionWith" test_intersectionWith
64 , testCase "intersectionWithKey" test_intersectionWithKey
65 , testCase "map" test_map
66 , testCase "mapWithKey" test_mapWithKey
67 , testCase "mapAccum" test_mapAccum
68 , testCase "mapAccumWithKey" test_mapAccumWithKey
69 , testCase "mapAccumRWithKey" test_mapAccumRWithKey
70 , testCase "mapKeys" test_mapKeys
71 , testCase "mapKeysWith" test_mapKeysWith
72 , testCase "mapKeysMonotonic" test_mapKeysMonotonic
73 , testCase "elems" test_elems
74 , testCase "keys" test_keys
75 , testCase "keysSet" test_keysSet
76 , testCase "associative" test_assocs
77 , testCase "toList" test_toList
78 , testCase "fromList" test_fromList
79 , testCase "fromListWith" test_fromListWith
80 , testCase "fromListWithKey" test_fromListWithKey
81 , testCase "toAscList" test_toAscList
82 , testCase "toDescList" test_toDescList
83 , testCase "showTree" test_showTree
84 , testCase "showTree'" test_showTree'
85 , testCase "fromAscList" test_fromAscList
86 , testCase "fromAscListWith" test_fromAscListWith
87 , testCase "fromAscListWithKey" test_fromAscListWithKey
88 , testCase "fromDistinctAscList" test_fromDistinctAscList
89 , testCase "filter" test_filter
90 , testCase "filterWithKey" test_filteWithKey
91 , testCase "partition" test_partition
92 , testCase "partitionWithKey" test_partitionWithKey
93 , testCase "mapMaybe" test_mapMaybe
94 , testCase "mapMaybeWithKey" test_mapMaybeWithKey
95 , testCase "mapEither" test_mapEither
96 , testCase "mapEitherWithKey" test_mapEitherWithKey
97 , testCase "split" test_split
98 , testCase "splitLookup" test_splitLookup
99 , testCase "isSubmapOfBy" test_isSubmapOfBy
100 , testCase "isSubmapOf" test_isSubmapOf
101 , testCase "isProperSubmapOfBy" test_isProperSubmapOfBy
102 , testCase "isProperSubmapOf" test_isProperSubmapOf
103 , testCase "lookupIndex" test_lookupIndex
104 , testCase "findIndex" test_findIndex
105 , testCase "elemAt" test_elemAt
106 , testCase "updateAt" test_updateAt
107 , testCase "deleteAt" test_deleteAt
108 , testCase "findMin" test_findMin
109 , testCase "findMax" test_findMax
110 , testCase "deleteMin" test_deleteMin
111 , testCase "deleteMax" test_deleteMax
112 , testCase "deleteFindMin" test_deleteFindMin
113 , testCase "deleteFindMax" test_deleteFindMax
114 , testCase "updateMin" test_updateMin
115 , testCase "updateMax" test_updateMax
116 , testCase "updateMinWithKey" test_updateMinWithKey
117 , testCase "updateMaxWithKey" test_updateMaxWithKey
118 , testCase "minView" test_minView
119 , testCase "maxView" test_maxView
120 , testCase "minViewWithKey" test_minViewWithKey
121 , testCase "maxViewWithKey" test_maxViewWithKey
122 , testCase "valid" test_valid
123 , testProperty "fromList" prop_fromList
124 , testProperty "insert to singleton" prop_singleton
125 , testProperty "insert" prop_insert
126 , testProperty "insert then lookup" prop_insertLookup
127 , testProperty "insert then delete" prop_insertDelete
128 , testProperty "insert then delete2" prop_insertDelete2
129 , testProperty "delete non member" prop_deleteNonMember
130 , testProperty "deleteMin" prop_deleteMin
131 , testProperty "deleteMax" prop_deleteMax
132 , testProperty "split" prop_split
133 , testProperty "split then join" prop_join
134 , testProperty "split then merge" prop_merge
135 , testProperty "union" prop_union
136 , testProperty "union model" prop_unionModel
137 , testProperty "union singleton" prop_unionSingleton
138 , testProperty "union associative" prop_unionAssoc
139 , testProperty "union+unionWith" prop_unionWith
140 , testProperty "unionWith" prop_unionWith2
141 , testProperty "union sum" prop_unionSum
142 , testProperty "difference" prop_difference
143 , testProperty "difference model" prop_differenceModel
144 , testProperty "intersection" prop_intersection
145 , testProperty "intersection model" prop_intersectionModel
146 , testProperty "intersectionWith" prop_intersectionWith
147 , testProperty "intersectionWithModel" prop_intersectionWithModel
148 , testProperty "intersectionWithKey" prop_intersectionWithKey
149 , testProperty "intersectionWithKeyModel" prop_intersectionWithKeyModel
150 , testProperty "fromAscList" prop_ordered
151 , testProperty "fromList then toList" prop_list
152 , testProperty "toDescList" prop_descList
153 , testProperty "toAscList+toDescList" prop_ascDescList
154 , testProperty "alter" prop_alter
155 , testProperty "index" prop_index
156 , testProperty "null" prop_null
157 , testProperty "member" prop_member
158 , testProperty "notmember" prop_notmember
159 , testProperty "lookup" prop_lookup
160 , testProperty "find" prop_find
161 , testProperty "findWithDefault" prop_findWithDefault
162 , testProperty "findIndex" prop_findIndex
163 , testProperty "lookupIndex" prop_lookupIndex
164 , testProperty "findMin" prop_findMin
165 , testProperty "findMax" prop_findMax
166 , testProperty "deleteMin" prop_deleteMinModel
167 , testProperty "deleteMax" prop_deleteMaxModel
168 , testProperty "filter" prop_filter
169 , testProperty "partition" prop_partition
170 , testProperty "map" prop_map
171 , testProperty "fmap" prop_fmap
172 , testProperty "mapkeys" prop_mapkeys
173 , testProperty "split" prop_splitModel
174 , testProperty "foldr" prop_foldr
175 , testProperty "foldr'" prop_foldr'
176 , testProperty "foldl" prop_foldl
177 , testProperty "foldl'" prop_foldl'
178 ] opts
179
180 where
181 opts = mempty { ropt_test_options = Just $ mempty { topt_maximum_generated_tests = Just 500
182 , topt_maximum_unsuitable_generated_tests = Just 500
183 }
184 }
185
186 {--------------------------------------------------------------------
187 Arbitrary, reasonably balanced trees
188 --------------------------------------------------------------------}
189 instance (Enum k,Arbitrary a) => Arbitrary (Map k a) where
190 arbitrary = sized (arbtree 0 maxkey)
191 where maxkey = 10^5
192
193 arbtree :: (Enum k, Arbitrary a) => Int -> Int -> Int -> Gen (Map k a)
194 arbtree lo hi n = do t <- gentree lo hi n
195 if balanced t then return t else arbtree lo hi n
196 where gentree lo hi n
197 | n <= 0 = return Tip
198 | lo >= hi = return Tip
199 | otherwise = do{ x <- arbitrary
200 ; i <- choose (lo,hi)
201 ; m <- choose (1,70)
202 ; let (ml,mr) | m==(1::Int)= (1,2)
203 | m==2 = (2,1)
204 | m==3 = (1,1)
205 | otherwise = (2,2)
206 ; l <- gentree lo (i-1) (n `div` ml)
207 ; r <- gentree (i+1) hi (n `div` mr)
208 ; return (bin (toEnum i) x l r)
209 }
210
211 ------------------------------------------------------------------------
212
213 type UMap = Map Int ()
214 type IMap = Map Int Int
215 type SMap = Map Int String
216
217 ----------------------------------------------------------------
218 -- Unit tests
219 ----------------------------------------------------------------
220
221 test_ticket4242 :: Assertion
222 test_ticket4242 = (valid $ deleteMin $ deleteMin $ fromList [ (i, ()) | i <- [0,2,5,1,6,4,8,9,7,11,10,3] :: [Int] ]) @?= True
223
224 ----------------------------------------------------------------
225 -- Operators
226
227 test_index :: Assertion
228 test_index = fromList [(5,'a'), (3,'b')] ! 5 @?= 'a'
229
230 ----------------------------------------------------------------
231 -- Query
232
233 test_size :: Assertion
234 test_size = do
235 null (empty) @?= True
236 null (singleton 1 'a') @?= False
237
238 test_size2 :: Assertion
239 test_size2 = do
240 size empty @?= 0
241 size (singleton 1 'a') @?= 1
242 size (fromList([(1,'a'), (2,'c'), (3,'b')])) @?= 3
243
244 test_member :: Assertion
245 test_member = do
246 member 5 (fromList [(5,'a'), (3,'b')]) @?= True
247 member 1 (fromList [(5,'a'), (3,'b')]) @?= False
248
249 test_notMember :: Assertion
250 test_notMember = do
251 notMember 5 (fromList [(5,'a'), (3,'b')]) @?= False
252 notMember 1 (fromList [(5,'a'), (3,'b')]) @?= True
253
254 test_lookup :: Assertion
255 test_lookup = do
256 employeeCurrency "John" @?= Just "Euro"
257 employeeCurrency "Pete" @?= Nothing
258 where
259 employeeDept = fromList([("John","Sales"), ("Bob","IT")])
260 deptCountry = fromList([("IT","USA"), ("Sales","France")])
261 countryCurrency = fromList([("USA", "Dollar"), ("France", "Euro")])
262 employeeCurrency :: String -> Maybe String
263 employeeCurrency name = do
264 dept <- lookup name employeeDept
265 country <- lookup dept deptCountry
266 lookup country countryCurrency
267
268 test_findWithDefault :: Assertion
269 test_findWithDefault = do
270 findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) @?= 'x'
271 findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) @?= 'a'
272
273 ----------------------------------------------------------------
274 -- Construction
275
276 test_empty :: Assertion
277 test_empty = do
278 (empty :: UMap) @?= fromList []
279 size empty @?= 0
280
281 test_mempty :: Assertion
282 test_mempty = do
283 (mempty :: UMap) @?= fromList []
284 size (mempty :: UMap) @?= 0
285
286 test_singleton :: Assertion
287 test_singleton = do
288 singleton 1 'a' @?= fromList [(1, 'a')]
289 size (singleton 1 'a') @?= 1
290
291 test_insert :: Assertion
292 test_insert = do
293 insert 5 'x' (fromList [(5,'a'), (3,'b')]) @?= fromList [(3, 'b'), (5, 'x')]
294 insert 7 'x' (fromList [(5,'a'), (3,'b')]) @?= fromList [(3, 'b'), (5, 'a'), (7, 'x')]
295 insert 5 'x' empty @?= singleton 5 'x'
296
297 test_insertWith :: Assertion
298 test_insertWith = do
299 insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "xxxa")]
300 insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
301 insertWith (++) 5 "xxx" empty @?= singleton 5 "xxx"
302
303 test_insertWithKey :: Assertion
304 test_insertWithKey = do
305 insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:xxx|a")]
306 insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
307 insertWithKey f 5 "xxx" empty @?= singleton 5 "xxx"
308 where
309 f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
310
311 test_insertLookupWithKey :: Assertion
312 test_insertLookupWithKey = do
313 insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
314 insertLookupWithKey f 2 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing,fromList [(2,"xxx"),(3,"b"),(5,"a")])
315 insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")])
316 insertLookupWithKey f 5 "xxx" empty @?= (Nothing, singleton 5 "xxx")
317 where
318 f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
319
320 ----------------------------------------------------------------
321 -- Delete/Update
322
323 test_delete :: Assertion
324 test_delete = do
325 delete 5 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
326 delete 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
327 delete 5 empty @?= (empty :: IMap)
328
329 test_adjust :: Assertion
330 test_adjust = do
331 adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "new a")]
332 adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
333 adjust ("new " ++) 7 empty @?= empty
334
335 test_adjustWithKey :: Assertion
336 test_adjustWithKey = do
337 adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:new a")]
338 adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
339 adjustWithKey f 7 empty @?= empty
340 where
341 f key x = (show key) ++ ":new " ++ x
342
343 test_update :: Assertion
344 test_update = do
345 update f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "new a")]
346 update f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
347 update f 3 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
348 where
349 f x = if x == "a" then Just "new a" else Nothing
350
351 test_updateWithKey :: Assertion
352 test_updateWithKey = do
353 updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:new a")]
354 updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
355 updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
356 where
357 f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
358
359 test_updateLookupWithKey :: Assertion
360 test_updateLookupWithKey = do
361 updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= (Just "5:new a", fromList [(3, "b"), (5, "5:new a")])
362 updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a")])
363 updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) @?= (Just "b", singleton 5 "a")
364 where
365 f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
366
367 test_alter :: Assertion
368 test_alter = do
369 alter f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
370 alter f 5 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
371 alter g 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "c")]
372 alter g 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "c")]
373 where
374 f _ = Nothing
375 g _ = Just "c"
376
377 ----------------------------------------------------------------
378 -- Combine
379
380 test_union :: Assertion
381 test_union = union (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "a"), (7, "C")]
382
383 test_mappend :: Assertion
384 test_mappend = mappend (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "a"), (7, "C")]
385
386 test_unionWith :: Assertion
387 test_unionWith = unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "aA"), (7, "C")]
388
389 test_unionWithKey :: Assertion
390 test_unionWithKey = unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "5:a|A"), (7, "C")]
391 where
392 f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value
393
394 test_unions :: Assertion
395 test_unions = do
396 unions [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
397 @?= fromList [(3, "b"), (5, "a"), (7, "C")]
398 unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
399 @?= fromList [(3, "B3"), (5, "A3"), (7, "C")]
400
401 test_mconcat :: Assertion
402 test_mconcat = do
403 mconcat [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
404 @?= fromList [(3, "b"), (5, "a"), (7, "C")]
405 mconcat [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
406 @?= fromList [(3, "B3"), (5, "A3"), (7, "C")]
407
408 test_unionsWith :: Assertion
409 test_unionsWith = unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
410 @?= fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]
411
412 test_difference :: Assertion
413 test_difference = difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 3 "b"
414
415 test_differenceWith :: Assertion
416 test_differenceWith = differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])
417 @?= singleton 3 "b:B"
418 where
419 f al ar = if al== "b" then Just (al ++ ":" ++ ar) else Nothing
420
421 test_differenceWithKey :: Assertion
422 test_differenceWithKey = differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])
423 @?= singleton 3 "3:b|B"
424 where
425 f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing
426
427 test_intersection :: Assertion
428 test_intersection = intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "a"
429
430
431 test_intersectionWith :: Assertion
432 test_intersectionWith = intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "aA"
433
434 test_intersectionWithKey :: Assertion
435 test_intersectionWithKey = intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "5:a|A"
436 where
437 f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar
438
439 ----------------------------------------------------------------
440 -- Traversal
441
442 test_map :: Assertion
443 test_map = map (++ "x") (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "bx"), (5, "ax")]
444
445 test_mapWithKey :: Assertion
446 test_mapWithKey = mapWithKey f (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "3:b"), (5, "5:a")]
447 where
448 f key x = (show key) ++ ":" ++ x
449
450 test_mapAccum :: Assertion
451 test_mapAccum = mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) @?= ("Everything: ba", fromList [(3, "bX"), (5, "aX")])
452 where
453 f a b = (a ++ b, b ++ "X")
454
455 test_mapAccumWithKey :: Assertion
456 test_mapAccumWithKey = mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) @?= ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])
457 where
458 f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
459
460 test_mapAccumRWithKey :: Assertion
461 test_mapAccumRWithKey = mapAccumRWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) @?= ("Everything: 5-a 3-b", fromList [(3, "bX"), (5, "aX")])
462 where
463 f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
464
465 test_mapKeys :: Assertion
466 test_mapKeys = do
467 mapKeys (+ 1) (fromList [(5,"a"), (3,"b")]) @?= fromList [(4, "b"), (6, "a")]
468 mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "c"
469 mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "c"
470
471 test_mapKeysWith :: Assertion
472 test_mapKeysWith = do
473 mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "cdab"
474 mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "cdab"
475
476 test_mapKeysMonotonic :: Assertion
477 test_mapKeysMonotonic = do
478 mapKeysMonotonic (+ 1) (fromList [(5,"a"), (3,"b")]) @?= fromList [(4, "b"), (6, "a")]
479 mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) @?= fromList [(6, "b"), (10, "a")]
480 valid (mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")])) @?= True
481 valid (mapKeysMonotonic (\ _ -> 1) (fromList [(5,"a"), (3,"b")])) @?= False
482
483 ----------------------------------------------------------------
484 -- Conversion
485
486 test_elems :: Assertion
487 test_elems = do
488 elems (fromList [(5,"a"), (3,"b")]) @?= ["b","a"]
489 elems (empty :: UMap) @?= []
490
491 test_keys :: Assertion
492 test_keys = do
493 keys (fromList [(5,"a"), (3,"b")]) @?= [3,5]
494 keys (empty :: UMap) @?= []
495
496 test_keysSet :: Assertion
497 test_keysSet = do
498 keysSet (fromList [(5,"a"), (3,"b")]) @?= Data.Set.fromList [3,5]
499 keysSet (empty :: UMap) @?= Data.Set.empty
500
501 test_assocs :: Assertion
502 test_assocs = do
503 assocs (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
504 assocs (empty :: UMap) @?= []
505
506 ----------------------------------------------------------------
507 -- Lists
508
509 test_toList :: Assertion
510 test_toList = do
511 toList (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
512 toList (empty :: SMap) @?= []
513
514 test_fromList :: Assertion
515 test_fromList = do
516 fromList [] @?= (empty :: SMap)
517 fromList [(5,"a"), (3,"b"), (5, "c")] @?= fromList [(5,"c"), (3,"b")]
518 fromList [(5,"c"), (3,"b"), (5, "a")] @?= fromList [(5,"a"), (3,"b")]
519
520 test_fromListWith :: Assertion
521 test_fromListWith = do
522 fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] @?= fromList [(3, "ab"), (5, "aba")]
523 fromListWith (++) [] @?= (empty :: SMap)
524
525 test_fromListWithKey :: Assertion
526 test_fromListWithKey = do
527 fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] @?= fromList [(3, "3ab"), (5, "5a5ba")]
528 fromListWithKey f [] @?= (empty :: SMap)
529 where
530 f k a1 a2 = (show k) ++ a1 ++ a2
531
532 ----------------------------------------------------------------
533 -- Ordered lists
534
535 test_toAscList :: Assertion
536 test_toAscList = toAscList (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
537
538 test_toDescList :: Assertion
539 test_toDescList = toDescList (fromList [(5,"a"), (3,"b")]) @?= [(5,"a"), (3,"b")]
540
541 test_showTree :: Assertion
542 test_showTree =
543 (let t = fromDistinctAscList [(x,()) | x <- [1..5]]
544 in showTree t) @?= "4:=()\n+--2:=()\n| +--1:=()\n| +--3:=()\n+--5:=()\n"
545
546 test_showTree' :: Assertion
547 test_showTree' =
548 (let t = fromDistinctAscList [(x,()) | x <- [1..5]]
549 in s t ) @?= "+--5:=()\n|\n4:=()\n|\n| +--3:=()\n| |\n+--2:=()\n |\n +--1:=()\n"
550 where
551 showElem k x = show k ++ ":=" ++ show x
552
553 s = showTreeWith showElem False True
554
555
556 test_fromAscList :: Assertion
557 test_fromAscList = do
558 fromAscList [(3,"b"), (5,"a")] @?= fromList [(3, "b"), (5, "a")]
559 fromAscList [(3,"b"), (5,"a"), (5,"b")] @?= fromList [(3, "b"), (5, "b")]
560 valid (fromAscList [(3,"b"), (5,"a"), (5,"b")]) @?= True
561 valid (fromAscList [(5,"a"), (3,"b"), (5,"b")]) @?= False
562
563 test_fromAscListWith :: Assertion
564 test_fromAscListWith = do
565 fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] @?= fromList [(3, "b"), (5, "ba")]
566 valid (fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")]) @?= True
567 valid (fromAscListWith (++) [(5,"a"), (3,"b"), (5,"b")]) @?= False
568
569 test_fromAscListWithKey :: Assertion
570 test_fromAscListWithKey = do
571 fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")] @?= fromList [(3, "b"), (5, "5:b5:ba")]
572 valid (fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")]) @?= True
573 valid (fromAscListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) @?= False
574 where
575 f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2
576
577 test_fromDistinctAscList :: Assertion
578 test_fromDistinctAscList = do
579 fromDistinctAscList [(3,"b"), (5,"a")] @?= fromList [(3, "b"), (5, "a")]
580 valid (fromDistinctAscList [(3,"b"), (5,"a")]) @?= True
581 valid (fromDistinctAscList [(3,"b"), (5,"a"), (5,"b")]) @?= False
582
583 ----------------------------------------------------------------
584 -- Filter
585
586 test_filter :: Assertion
587 test_filter = do
588 filter (> "a") (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
589 filter (> "x") (fromList [(5,"a"), (3,"b")]) @?= empty
590 filter (< "a") (fromList [(5,"a"), (3,"b")]) @?= empty
591
592 test_filteWithKey :: Assertion
593 test_filteWithKey = filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
594
595 test_partition :: Assertion
596 test_partition = do
597 partition (> "a") (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", singleton 5 "a")
598 partition (< "x") (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3, "b"), (5, "a")], empty)
599 partition (> "x") (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3, "b"), (5, "a")])
600
601 test_partitionWithKey :: Assertion
602 test_partitionWithKey = do
603 partitionWithKey (\ k _ -> k > 3) (fromList [(5,"a"), (3,"b")]) @?= (singleton 5 "a", singleton 3 "b")
604 partitionWithKey (\ k _ -> k < 7) (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3, "b"), (5, "a")], empty)
605 partitionWithKey (\ k _ -> k > 7) (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3, "b"), (5, "a")])
606
607 test_mapMaybe :: Assertion
608 test_mapMaybe = mapMaybe f (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "new a"
609 where
610 f x = if x == "a" then Just "new a" else Nothing
611
612 test_mapMaybeWithKey :: Assertion
613 test_mapMaybeWithKey = mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "key : 3"
614 where
615 f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
616
617 test_mapEither :: Assertion
618 test_mapEither = do
619 mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
620 @?= (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])
621 mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
622 @?= ((empty :: SMap), fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
623 where
624 f a = if a < "c" then Left a else Right a
625
626 test_mapEitherWithKey :: Assertion
627 test_mapEitherWithKey = do
628 mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
629 @?= (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])
630 mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
631 @?= ((empty :: SMap), fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])
632 where
633 f k a = if k < 5 then Left (k * 2) else Right (a ++ a)
634
635 test_split :: Assertion
636 test_split = do
637 split 2 (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3,"b"), (5,"a")])
638 split 3 (fromList [(5,"a"), (3,"b")]) @?= (empty, singleton 5 "a")
639 split 4 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", singleton 5 "a")
640 split 5 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", empty)
641 split 6 (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3,"b"), (5,"a")], empty)
642
643 test_splitLookup :: Assertion
644 test_splitLookup = do
645 splitLookup 2 (fromList [(5,"a"), (3,"b")]) @?= (empty, Nothing, fromList [(3,"b"), (5,"a")])
646 splitLookup 3 (fromList [(5,"a"), (3,"b")]) @?= (empty, Just "b", singleton 5 "a")
647 splitLookup 4 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", Nothing, singleton 5 "a")
648 splitLookup 5 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", Just "a", empty)
649 splitLookup 6 (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3,"b"), (5,"a")], Nothing, empty)
650
651 ----------------------------------------------------------------
652 -- Submap
653
654 test_isSubmapOfBy :: Assertion
655 test_isSubmapOfBy = do
656 isSubmapOfBy (==) (fromList [('a',1)]) (fromList [('a',1),('b',2)]) @?= True
657 isSubmapOfBy (<=) (fromList [('a',1)]) (fromList [('a',1),('b',2)]) @?= True
658 isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1),('b',2)]) @?= True
659 isSubmapOfBy (==) (fromList [('a',2)]) (fromList [('a',1),('b',2)]) @?= False
660 isSubmapOfBy (<) (fromList [('a',1)]) (fromList [('a',1),('b',2)]) @?= False
661 isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1)]) @?= False
662
663 test_isSubmapOf :: Assertion
664 test_isSubmapOf = do
665 isSubmapOf (fromList [('a',1)]) (fromList [('a',1),('b',2)]) @?= True
666 isSubmapOf (fromList [('a',1),('b',2)]) (fromList [('a',1),('b',2)]) @?= True
667 isSubmapOf (fromList [('a',2)]) (fromList [('a',1),('b',2)]) @?= False
668 isSubmapOf (fromList [('a',1),('b',2)]) (fromList [('a',1)]) @?= False
669
670 test_isProperSubmapOfBy :: Assertion
671 test_isProperSubmapOfBy = do
672 isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
673 isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
674 isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) @?= False
675 isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)]) @?= False
676 isProperSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= False
677
678 test_isProperSubmapOf :: Assertion
679 test_isProperSubmapOf = do
680 isProperSubmapOf (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
681 isProperSubmapOf (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) @?= False
682 isProperSubmapOf (fromList [(1,1),(2,2)]) (fromList [(1,1)]) @?= False
683
684 ----------------------------------------------------------------
685 -- Indexed
686
687 test_lookupIndex :: Assertion
688 test_lookupIndex = do
689 isJust (lookupIndex 2 (fromList [(5,"a"), (3,"b")])) @?= False
690 fromJust (lookupIndex 3 (fromList [(5,"a"), (3,"b")])) @?= 0
691 fromJust (lookupIndex 5 (fromList [(5,"a"), (3,"b")])) @?= 1
692 isJust (lookupIndex 6 (fromList [(5,"a"), (3,"b")])) @?= False
693
694 test_findIndex :: Assertion
695 test_findIndex = do
696 findIndex 3 (fromList [(5,"a"), (3,"b")]) @?= 0
697 findIndex 5 (fromList [(5,"a"), (3,"b")]) @?= 1
698
699 test_elemAt :: Assertion
700 test_elemAt = do
701 elemAt 0 (fromList [(5,"a"), (3,"b")]) @?= (3,"b")
702 elemAt 1 (fromList [(5,"a"), (3,"b")]) @?= (5, "a")
703
704 test_updateAt :: Assertion
705 test_updateAt = do
706 updateAt (\ _ _ -> Just "x") 0 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "x"), (5, "a")]
707 updateAt (\ _ _ -> Just "x") 1 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "x")]
708 updateAt (\_ _ -> Nothing) 0 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
709 updateAt (\_ _ -> Nothing) 1 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
710 -- updateAt (\_ _ -> Nothing) 7 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
711
712 test_deleteAt :: Assertion
713 test_deleteAt = do
714 deleteAt 0 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
715 deleteAt 1 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
716
717 ----------------------------------------------------------------
718 -- Min/Max
719
720 test_findMin :: Assertion
721 test_findMin = findMin (fromList [(5,"a"), (3,"b")]) @?= (3,"b")
722
723 test_findMax :: Assertion
724 test_findMax = findMax (fromList [(5,"a"), (3,"b")]) @?= (5,"a")
725
726 test_deleteMin :: Assertion
727 test_deleteMin = do
728 deleteMin (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(5,"a"), (7,"c")]
729 deleteMin (empty :: SMap) @?= empty
730
731 test_deleteMax :: Assertion
732 test_deleteMax = do
733 deleteMax (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(3,"b"), (5,"a")]
734 deleteMax (empty :: SMap) @?= empty
735
736 test_deleteFindMin :: Assertion
737 test_deleteFindMin = deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((3,"b"), fromList[(5,"a"), (10,"c")])
738
739 test_deleteFindMax :: Assertion
740 test_deleteFindMax = deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((10,"c"), fromList [(3,"b"), (5,"a")])
741
742 test_updateMin :: Assertion
743 test_updateMin = do
744 updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "Xb"), (5, "a")]
745 updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
746
747 test_updateMax :: Assertion
748 test_updateMax = do
749 updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "Xa")]
750 updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
751
752 test_updateMinWithKey :: Assertion
753 test_updateMinWithKey = do
754 updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"3:b"), (5,"a")]
755 updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
756
757 test_updateMaxWithKey :: Assertion
758 test_updateMaxWithKey = do
759 updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"b"), (5,"5:a")]
760 updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
761
762 test_minView :: Assertion
763 test_minView = do
764 minView (fromList [(5,"a"), (3,"b")]) @?= Just ("b", singleton 5 "a")
765 minView (empty :: SMap) @?= Nothing
766
767 test_maxView :: Assertion
768 test_maxView = do
769 maxView (fromList [(5,"a"), (3,"b")]) @?= Just ("a", singleton 3 "b")
770 maxView (empty :: SMap) @?= Nothing
771
772 test_minViewWithKey :: Assertion
773 test_minViewWithKey = do
774 minViewWithKey (fromList [(5,"a"), (3,"b")]) @?= Just ((3,"b"), singleton 5 "a")
775 minViewWithKey (empty :: SMap) @?= Nothing
776
777 test_maxViewWithKey :: Assertion
778 test_maxViewWithKey = do
779 maxViewWithKey (fromList [(5,"a"), (3,"b")]) @?= Just ((5,"a"), singleton 3 "b")
780 maxViewWithKey (empty :: SMap) @?= Nothing
781
782 ----------------------------------------------------------------
783 -- Debug
784
785 test_valid :: Assertion
786 test_valid = do
787 valid (fromAscList [(3,"b"), (5,"a")]) @?= True
788 valid (fromAscList [(5,"a"), (3,"b")]) @?= False
789
790 ----------------------------------------------------------------
791 -- QuickCheck
792 ----------------------------------------------------------------
793
794 prop_fromList :: UMap -> Bool
795 prop_fromList t = valid t
796
797 prop_singleton :: Int -> Int -> Bool
798 prop_singleton k x = insert k x empty == singleton k x
799
800 prop_insert :: Int -> UMap -> Bool
801 prop_insert k t = valid $ insert k () t
802
803 prop_insertLookup :: Int -> UMap -> Bool
804 prop_insertLookup k t = lookup k (insert k () t) /= Nothing
805
806 prop_insertDelete :: Int -> UMap -> Bool
807 prop_insertDelete k t = valid $ delete k (insert k () t)
808
809 prop_insertDelete2 :: Int -> UMap -> Property
810 prop_insertDelete2 k t = (lookup k t == Nothing) ==> (delete k (insert k () t) == t)
811
812 prop_deleteNonMember :: Int -> UMap -> Property
813 prop_deleteNonMember k t = (lookup k t == Nothing) ==> (delete k t == t)
814
815 prop_deleteMin :: UMap -> Bool
816 prop_deleteMin t = valid $ deleteMin $ deleteMin t
817
818 prop_deleteMax :: UMap -> Bool
819 prop_deleteMax t = valid $ deleteMax $ deleteMax t
820
821 ----------------------------------------------------------------
822
823 prop_split :: Int -> UMap -> Bool
824 prop_split k t = let (r,l) = split k t
825 in (valid r, valid l) == (True, True)
826
827 prop_join :: Int -> UMap -> Bool
828 prop_join k t = let (l,r) = split k t
829 in valid (join k () l r)
830
831 prop_merge :: Int -> UMap -> Bool
832 prop_merge k t = let (l,r) = split k t
833 in valid (merge l r)
834
835 ----------------------------------------------------------------
836
837 prop_union :: UMap -> UMap -> Bool
838 prop_union t1 t2 = valid (union t1 t2)
839
840 prop_unionModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
841 prop_unionModel xs ys
842 = sort (keys (union (fromList xs) (fromList ys)))
843 == sort (nub (Prelude.map fst xs ++ Prelude.map fst ys))
844
845 prop_unionSingleton :: IMap -> Int -> Int -> Bool
846 prop_unionSingleton t k x = union (singleton k x) t == insert k x t
847
848 prop_unionAssoc :: IMap -> IMap -> IMap -> Bool
849 prop_unionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3
850
851 prop_unionWith :: IMap -> IMap -> Bool
852 prop_unionWith t1 t2 = (union t1 t2 == unionWith (\_ y -> y) t2 t1)
853
854 prop_unionWith2 :: IMap -> IMap -> Bool
855 prop_unionWith2 t1 t2 = valid (unionWithKey (\_ x y -> x+y) t1 t2)
856
857 prop_unionSum :: [(Int,Int)] -> [(Int,Int)] -> Bool
858 prop_unionSum xs ys
859 = sum (elems (unionWith (+) (fromListWith (+) xs) (fromListWith (+) ys)))
860 == (sum (Prelude.map snd xs) + sum (Prelude.map snd ys))
861
862 prop_difference :: IMap -> IMap -> Bool
863 prop_difference t1 t2 = valid (difference t1 t2)
864
865 prop_differenceModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
866 prop_differenceModel xs ys
867 = sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys)))
868 == sort ((List.\\) (nub (Prelude.map fst xs)) (nub (Prelude.map fst ys)))
869
870 prop_intersection :: IMap -> IMap -> Bool
871 prop_intersection t1 t2 = valid (intersection t1 t2)
872
873 prop_intersectionModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
874 prop_intersectionModel xs ys
875 = sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
876 == sort (nub ((List.intersect) (Prelude.map fst xs) (Prelude.map fst ys)))
877
878 prop_intersectionWith :: (Int -> Int -> Maybe Int) -> IMap -> IMap -> Bool
879 prop_intersectionWith f t1 t2 = valid (intersectionWith f t1 t2)
880
881 prop_intersectionWithModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
882 prop_intersectionWithModel xs ys
883 = toList (intersectionWith f (fromList xs') (fromList ys'))
884 == [(kx, f vx vy) | (kx, vx) <- List.sort xs', (ky, vy) <- ys', kx == ky]
885 where xs' = List.nubBy ((==) `on` fst) xs
886 ys' = List.nubBy ((==) `on` fst) ys
887 f l r = l + 2 * r
888
889 prop_intersectionWithKey :: (Int -> Int -> Int -> Maybe Int) -> IMap -> IMap -> Bool
890 prop_intersectionWithKey f t1 t2 = valid (intersectionWithKey f t1 t2)
891
892 prop_intersectionWithKeyModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
893 prop_intersectionWithKeyModel xs ys
894 = toList (intersectionWithKey f (fromList xs') (fromList ys'))
895 == [(kx, f kx vx vy) | (kx, vx) <- List.sort xs', (ky, vy) <- ys', kx == ky]
896 where xs' = List.nubBy ((==) `on` fst) xs
897 ys' = List.nubBy ((==) `on` fst) ys
898 f k l r = k + 2 * l + 3 * r
899
900 ----------------------------------------------------------------
901
902 prop_ordered :: Property
903 prop_ordered
904 = forAll (choose (5,100)) $ \n ->
905 let xs = [(x,()) | x <- [0..n::Int]]
906 in fromAscList xs == fromList xs
907
908 prop_list :: [Int] -> Bool
909 prop_list xs = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
910
911 prop_descList :: [Int] -> Bool
912 prop_descList xs = (reverse (sort (nub xs)) == [x | (x,()) <- toDescList (fromList [(x,()) | x <- xs])])
913
914 prop_ascDescList :: [Int] -> Bool
915 prop_ascDescList xs = toAscList m == reverse (toDescList m)
916 where m = fromList $ zip xs $ repeat ()
917
918 ----------------------------------------------------------------
919
920 prop_alter :: UMap -> Int -> Bool
921 prop_alter t k = balanced t' && case lookup k t of
922 Just _ -> (size t - 1) == size t' && lookup k t' == Nothing
923 Nothing -> (size t + 1) == size t' && lookup k t' /= Nothing
924 where
925 t' = alter f k t
926 f Nothing = Just ()
927 f (Just ()) = Nothing
928
929 ------------------------------------------------------------------------
930 -- Compare against the list model (after nub on keys)
931
932 prop_index :: [Int] -> Property
933 prop_index xs = length xs > 0 ==>
934 let m = fromList (zip xs xs)
935 in xs == [ m ! i | i <- xs ]
936
937 prop_null :: IMap -> Bool
938 prop_null m = null m == (size m == 0)
939
940 prop_member :: [Int] -> Int -> Bool
941 prop_member xs n =
942 let m = fromList (zip xs xs)
943 in all (\k -> k `member` m == (k `elem` xs)) (n : xs)
944
945 prop_notmember :: [Int] -> Int -> Bool
946 prop_notmember xs n =
947 let m = fromList (zip xs xs)
948 in all (\k -> k `notMember` m == (k `notElem` xs)) (n : xs)
949
950 prop_lookup :: [(Int, Int)] -> Int -> Bool
951 prop_lookup xs n =
952 let xs' = List.nubBy ((==) `on` fst) xs
953 m = fromList xs'
954 in all (\k -> lookup k m == List.lookup k xs') (n : List.map fst xs')
955
956 prop_find :: [(Int, Int)] -> Bool
957 prop_find xs =
958 let xs' = List.nubBy ((==) `on` fst) xs
959 m = fromList xs'
960 in all (\(k, v) -> m ! k == v) xs'
961
962 prop_findWithDefault :: [(Int, Int)] -> Int -> Int -> Bool
963 prop_findWithDefault xs n x =
964 let xs' = List.nubBy ((==) `on` fst) xs
965 m = fromList xs'
966 in all (\k -> findWithDefault x k m == maybe x id (List.lookup k xs')) (n : List.map fst xs')
967
968 prop_findIndex :: [(Int, Int)] -> Property
969 prop_findIndex ys = length ys > 0 ==>
970 let m = fromList ys
971 in findIndex (fst (head ys)) m `seq` True
972
973 prop_lookupIndex :: [(Int, Int)] -> Property
974 prop_lookupIndex ys = length ys > 0 ==>
975 let m = fromList ys
976 in isJust (lookupIndex (fst (head ys)) m)
977
978 prop_findMin :: [(Int, Int)] -> Property
979 prop_findMin ys = length ys > 0 ==>
980 let xs = List.nubBy ((==) `on` fst) ys
981 m = fromList xs
982 in findMin m == List.minimumBy (comparing fst) xs
983
984 prop_findMax :: [(Int, Int)] -> Property
985 prop_findMax ys = length ys > 0 ==>
986 let xs = List.nubBy ((==) `on` fst) ys
987 m = fromList xs
988 in findMax m == List.maximumBy (comparing fst) xs
989
990 prop_deleteMinModel :: [(Int, Int)] -> Property
991 prop_deleteMinModel ys = length ys > 0 ==>
992 let xs = List.nubBy ((==) `on` fst) ys
993 m = fromList xs
994 in toAscList (deleteMin m) == tail (sort xs)
995
996 prop_deleteMaxModel :: [(Int, Int)] -> Property
997 prop_deleteMaxModel ys = length ys > 0 ==>
998 let xs = List.nubBy ((==) `on` fst) ys
999 m = fromList xs
1000 in toAscList (deleteMax m) == init (sort xs)
1001
1002 prop_filter :: (Int -> Bool) -> [(Int, Int)] -> Property
1003 prop_filter p ys = length ys > 0 ==>
1004 let xs = List.nubBy ((==) `on` fst) ys
1005 m = fromList xs
1006 in filter p m == fromList (List.filter (p . snd) xs)
1007
1008 prop_partition :: (Int -> Bool) -> [(Int, Int)] -> Property
1009 prop_partition p ys = length ys > 0 ==>
1010 let xs = List.nubBy ((==) `on` fst) ys
1011 m = fromList xs
1012 in partition p m == let (a,b) = (List.partition (p . snd) xs) in (fromList a, fromList b)
1013
1014 prop_map :: (Int -> Int) -> [(Int, Int)] -> Property
1015 prop_map f ys = length ys > 0 ==>
1016 let xs = List.nubBy ((==) `on` fst) ys
1017 m = fromList xs
1018 in map f m == fromList [ (a, f b) | (a,b) <- xs ]
1019
1020 prop_fmap :: (Int -> Int) -> [(Int, Int)] -> Property
1021 prop_fmap f ys = length ys > 0 ==>
1022 let xs = List.nubBy ((==) `on` fst) ys
1023 m = fromList xs
1024 in fmap f m == fromList [ (a, f b) | (a,b) <- xs ]
1025
1026 prop_mapkeys :: (Int -> Int) -> [(Int, Int)] -> Property
1027 prop_mapkeys f ys = length ys > 0 ==>
1028 let xs = List.nubBy ((==) `on` fst) ys
1029 m = fromList xs
1030 in mapKeys f m == (fromList $ List.nubBy ((==) `on` fst) $ reverse [ (f a, b) | (a,b) <- sort xs])
1031
1032 prop_splitModel :: Int -> [(Int, Int)] -> Property
1033 prop_splitModel n ys = length ys > 0 ==>
1034 let xs = List.nubBy ((==) `on` fst) ys
1035 (l, r) = split n $ fromList xs
1036 in toAscList l == sort [(k, v) | (k,v) <- xs, k < n] &&
1037 toAscList r == sort [(k, v) | (k,v) <- xs, k > n]
1038
1039 prop_foldr :: Int -> [(Int, Int)] -> Property
1040 prop_foldr n ys = length ys > 0 ==>
1041 let xs = List.nubBy ((==) `on` fst) ys
1042 m = fromList xs
1043 in foldr (+) n m == List.foldr (+) n (List.map snd xs) &&
1044 foldr (:) [] m == List.map snd (List.sort xs) &&
1045 foldrWithKey (\_ a b -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
1046 foldrWithKey (\k _ b -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
1047 foldrWithKey (\k x xs -> (k,x):xs) [] m == List.sort xs
1048
1049
1050 prop_foldr' :: Int -> [(Int, Int)] -> Property
1051 prop_foldr' n ys = length ys > 0 ==>
1052 let xs = List.nubBy ((==) `on` fst) ys
1053 m = fromList xs
1054 in foldr' (+) n m == List.foldr (+) n (List.map snd xs) &&
1055 foldr' (:) [] m == List.map snd (List.sort xs) &&
1056 foldrWithKey' (\_ a b -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
1057 foldrWithKey' (\k _ b -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
1058 foldrWithKey' (\k x xs -> (k,x):xs) [] m == List.sort xs
1059
1060 prop_foldl :: Int -> [(Int, Int)] -> Property
1061 prop_foldl n ys = length ys > 0 ==>
1062 let xs = List.nubBy ((==) `on` fst) ys
1063 m = fromList xs
1064 in foldl (+) n m == List.foldr (+) n (List.map snd xs) &&
1065 foldl (flip (:)) [] m == reverse (List.map snd (List.sort xs)) &&
1066 foldlWithKey (\b _ a -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
1067 foldlWithKey (\b k _ -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
1068 foldlWithKey (\xs k x -> (k,x):xs) [] m == reverse (List.sort xs)
1069
1070 prop_foldl' :: Int -> [(Int, Int)] -> Property
1071 prop_foldl' n ys = length ys > 0 ==>
1072 let xs = List.nubBy ((==) `on` fst) ys
1073 m = fromList xs
1074 in foldl' (+) n m == List.foldr (+) n (List.map snd xs) &&
1075 foldl' (flip (:)) [] m == reverse (List.map snd (List.sort xs)) &&
1076 foldlWithKey' (\b _ a -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
1077 foldlWithKey' (\b k _ -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
1078 foldlWithKey' (\xs k x -> (k,x):xs) [] m == reverse (List.sort xs)