[project @ 2005-01-20 14:39:09 by malcolm]
[packages/old-time.git] / Data / IntMap.hs
1 {-# OPTIONS -cpp -fglasgow-exts #-}
2 -----------------------------------------------------------------------------
3 -- Module : Data.IntMap
4 -- Copyright : (c) Daan Leijen 2002
5 -- License : BSD-style
6 -- Maintainer : libraries@haskell.org
7 -- Stability : provisional
8 -- Portability : portable
9 --
10 -- An efficient implementation of maps from integer keys to values.
11 --
12 -- This module is intended to be imported @qualified@, to avoid name
13 -- clashes with "Prelude" functions. eg.
14 --
15 -- > import Data.IntMap as Map
16 --
17 -- The implementation is based on /big-endian patricia trees/. This data
18 -- structure performs especially well on binary operations like 'union'
19 -- and 'intersection'. However, my benchmarks show that it is also
20 -- (much) faster on insertions and deletions when compared to a generic
21 -- size-balanced map implementation (see "Data.Map" and "Data.FiniteMap").
22 --
23 -- * Chris Okasaki and Andy Gill, \"/Fast Mergeable Integer Maps/\",
24 -- Workshop on ML, September 1998, pages 77-86,
25 -- <http://www.cse.ogi.edu/~andy/pub/finite.htm>
26 --
27 -- * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve
28 -- Information Coded In Alphanumeric/\", Journal of the ACM, 15(4),
29 -- October 1968, pages 514-534.
30 --
31 -- Many operations have a worst-case complexity of /O(min(n,W))/.
32 -- This means that the operation can become linear in the number of
33 -- elements with a maximum of /W/ -- the number of bits in an 'Int'
34 -- (32 or 64).
35 -----------------------------------------------------------------------------
36
37 module Data.IntMap (
38 -- * Map type
39 IntMap, Key -- instance Eq,Show
40
41 -- * Operators
42 , (!), (\\)
43
44 -- * Query
45 , null
46 , size
47 , member
48 , lookup
49 , findWithDefault
50
51 -- * Construction
52 , empty
53 , singleton
54
55 -- ** Insertion
56 , insert
57 , insertWith, insertWithKey, insertLookupWithKey
58
59 -- ** Delete\/Update
60 , delete
61 , adjust
62 , adjustWithKey
63 , update
64 , updateWithKey
65 , updateLookupWithKey
66
67 -- * Combine
68
69 -- ** Union
70 , union
71 , unionWith
72 , unionWithKey
73 , unions
74 , unionsWith
75
76 -- ** Difference
77 , difference
78 , differenceWith
79 , differenceWithKey
80
81 -- ** Intersection
82 , intersection
83 , intersectionWith
84 , intersectionWithKey
85
86 -- * Traversal
87 -- ** Map
88 , map
89 , mapWithKey
90 , mapAccum
91 , mapAccumWithKey
92
93 -- ** Fold
94 , fold
95 , foldWithKey
96
97 -- * Conversion
98 , elems
99 , keys
100 , keysSet
101 , assocs
102
103 -- ** Lists
104 , toList
105 , fromList
106 , fromListWith
107 , fromListWithKey
108
109 -- ** Ordered lists
110 , toAscList
111 , fromAscList
112 , fromAscListWith
113 , fromAscListWithKey
114 , fromDistinctAscList
115
116 -- * Filter
117 , filter
118 , filterWithKey
119 , partition
120 , partitionWithKey
121
122 , split
123 , splitLookup
124
125 -- * Submap
126 , isSubmapOf, isSubmapOfBy
127 , isProperSubmapOf, isProperSubmapOfBy
128
129 -- * Debugging
130 , showTree
131 , showTreeWith
132 ) where
133
134
135 import Prelude hiding (lookup,map,filter,foldr,foldl,null)
136 import Data.Bits
137 import Data.Int
138 import Data.Monoid
139 import qualified Data.IntSet as IntSet
140 import Data.Typeable
141
142 {-
143 -- just for testing
144 import qualified Prelude
145 import Debug.QuickCheck
146 import List (nub,sort)
147 import qualified List
148 -}
149
150 #if __GLASGOW_HASKELL__
151 import Data.Generics.Basics
152 import Data.Generics.Instances
153 #endif
154
155 #if __GLASGOW_HASKELL__ >= 503
156 import GHC.Word
157 import GHC.Exts ( Word(..), Int(..), shiftRL# )
158 #elif __GLASGOW_HASKELL__
159 import Word
160 import GlaExts ( Word(..), Int(..), shiftRL# )
161 #else
162 import Data.Word
163 #endif
164
165 infixl 9 \\{-This comment teaches CPP correct behaviour -}
166
167 -- A "Nat" is a natural machine word (an unsigned Int)
168 type Nat = Word
169
170 natFromInt :: Key -> Nat
171 natFromInt i = fromIntegral i
172
173 intFromNat :: Nat -> Key
174 intFromNat w = fromIntegral w
175
176 shiftRL :: Nat -> Key -> Nat
177 #if __GLASGOW_HASKELL__
178 {--------------------------------------------------------------------
179 GHC: use unboxing to get @shiftRL@ inlined.
180 --------------------------------------------------------------------}
181 shiftRL (W# x) (I# i)
182 = W# (shiftRL# x i)
183 #else
184 shiftRL x i = shiftR x i
185 #endif
186
187 {--------------------------------------------------------------------
188 Operators
189 --------------------------------------------------------------------}
190
191 -- | /O(min(n,W))/. Find the value of a key. Calls @error@ when the element can not be found.
192
193 (!) :: IntMap a -> Key -> a
194 m ! k = find' k m
195
196 -- | /O(n+m)/. See 'difference'.
197 (\\) :: IntMap a -> IntMap b -> IntMap a
198 m1 \\ m2 = difference m1 m2
199
200 {--------------------------------------------------------------------
201 Types
202 --------------------------------------------------------------------}
203 -- | A map of integers to values @a@.
204 data IntMap a = Nil
205 | Tip {-# UNPACK #-} !Key a
206 | Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !(IntMap a) !(IntMap a)
207
208 type Prefix = Int
209 type Mask = Int
210 type Key = Int
211
212 #if __GLASGOW_HASKELL__
213
214 {--------------------------------------------------------------------
215 A Data instance
216 --------------------------------------------------------------------}
217
218 -- This instance preserves data abstraction at the cost of inefficiency.
219 -- We omit reflection services for the sake of data abstraction.
220
221 instance Data a => Data (IntMap a) where
222 gfoldl f z im = z fromList `f` (toList im)
223 toConstr _ = error "toConstr"
224 gunfold _ _ = error "gunfold"
225 dataTypeOf _ = mkNorepType "Data.IntMap.IntMap"
226
227 #endif
228
229 {--------------------------------------------------------------------
230 Query
231 --------------------------------------------------------------------}
232 -- | /O(1)/. Is the map empty?
233 null :: IntMap a -> Bool
234 null Nil = True
235 null other = False
236
237 -- | /O(n)/. Number of elements in the map.
238 size :: IntMap a -> Int
239 size t
240 = case t of
241 Bin p m l r -> size l + size r
242 Tip k x -> 1
243 Nil -> 0
244
245 -- | /O(min(n,W))/. Is the key a member of the map?
246 member :: Key -> IntMap a -> Bool
247 member k m
248 = case lookup k m of
249 Nothing -> False
250 Just x -> True
251
252 -- | /O(min(n,W))/. Lookup the value of a key in the map.
253 lookup :: Key -> IntMap a -> Maybe a
254 lookup k t
255 = let nk = natFromInt k in seq nk (lookupN nk t)
256
257 lookupN :: Nat -> IntMap a -> Maybe a
258 lookupN k t
259 = case t of
260 Bin p m l r
261 | zeroN k (natFromInt m) -> lookupN k l
262 | otherwise -> lookupN k r
263 Tip kx x
264 | (k == natFromInt kx) -> Just x
265 | otherwise -> Nothing
266 Nil -> Nothing
267
268 find' :: Key -> IntMap a -> a
269 find' k m
270 = case lookup k m of
271 Nothing -> error ("IntMap.find: key " ++ show k ++ " is not an element of the map")
272 Just x -> x
273
274
275 -- | /O(min(n,W))/. The expression @(findWithDefault def k map)@ returns the value of key @k@ or returns @def@ when
276 -- the key is not an element of the map.
277 findWithDefault :: a -> Key -> IntMap a -> a
278 findWithDefault def k m
279 = case lookup k m of
280 Nothing -> def
281 Just x -> x
282
283 {--------------------------------------------------------------------
284 Construction
285 --------------------------------------------------------------------}
286 -- | /O(1)/. The empty map.
287 empty :: IntMap a
288 empty
289 = Nil
290
291 -- | /O(1)/. A map of one element.
292 singleton :: Key -> a -> IntMap a
293 singleton k x
294 = Tip k x
295
296 {--------------------------------------------------------------------
297 Insert
298 'insert' is the inlined version of 'insertWith (\k x y -> x)'
299 --------------------------------------------------------------------}
300 -- | /O(min(n,W))/. Insert a new key\/value pair in the map. When the key
301 -- is already an element of the set, its value is replaced by the new value,
302 -- ie. 'insert' is left-biased.
303 insert :: Key -> a -> IntMap a -> IntMap a
304 insert k x t
305 = case t of
306 Bin p m l r
307 | nomatch k p m -> join k (Tip k x) p t
308 | zero k m -> Bin p m (insert k x l) r
309 | otherwise -> Bin p m l (insert k x r)
310 Tip ky y
311 | k==ky -> Tip k x
312 | otherwise -> join k (Tip k x) ky t
313 Nil -> Tip k x
314
315 -- right-biased insertion, used by 'union'
316 -- | /O(min(n,W))/. Insert with a combining function.
317 insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
318 insertWith f k x t
319 = insertWithKey (\k x y -> f x y) k x t
320
321 -- | /O(min(n,W))/. Insert with a combining function.
322 insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
323 insertWithKey f k x t
324 = case t of
325 Bin p m l r
326 | nomatch k p m -> join k (Tip k x) p t
327 | zero k m -> Bin p m (insertWithKey f k x l) r
328 | otherwise -> Bin p m l (insertWithKey f k x r)
329 Tip ky y
330 | k==ky -> Tip k (f k x y)
331 | otherwise -> join k (Tip k x) ky t
332 Nil -> Tip k x
333
334
335 -- | /O(min(n,W))/. The expression (@insertLookupWithKey f k x map@) is a pair where
336 -- the first element is equal to (@lookup k map@) and the second element
337 -- equal to (@insertWithKey f k x map@).
338 insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a)
339 insertLookupWithKey f k x t
340 = case t of
341 Bin p m l r
342 | nomatch k p m -> (Nothing,join k (Tip k x) p t)
343 | zero k m -> let (found,l') = insertLookupWithKey f k x l in (found,Bin p m l' r)
344 | otherwise -> let (found,r') = insertLookupWithKey f k x r in (found,Bin p m l r')
345 Tip ky y
346 | k==ky -> (Just y,Tip k (f k x y))
347 | otherwise -> (Nothing,join k (Tip k x) ky t)
348 Nil -> (Nothing,Tip k x)
349
350
351 {--------------------------------------------------------------------
352 Deletion
353 [delete] is the inlined version of [deleteWith (\k x -> Nothing)]
354 --------------------------------------------------------------------}
355 -- | /O(min(n,W))/. Delete a key and its value from the map. When the key is not
356 -- a member of the map, the original map is returned.
357 delete :: Key -> IntMap a -> IntMap a
358 delete k t
359 = case t of
360 Bin p m l r
361 | nomatch k p m -> t
362 | zero k m -> bin p m (delete k l) r
363 | otherwise -> bin p m l (delete k r)
364 Tip ky y
365 | k==ky -> Nil
366 | otherwise -> t
367 Nil -> Nil
368
369 -- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
370 -- a member of the map, the original map is returned.
371 adjust :: (a -> a) -> Key -> IntMap a -> IntMap a
372 adjust f k m
373 = adjustWithKey (\k x -> f x) k m
374
375 -- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
376 -- a member of the map, the original map is returned.
377 adjustWithKey :: (Key -> a -> a) -> Key -> IntMap a -> IntMap a
378 adjustWithKey f k m
379 = updateWithKey (\k x -> Just (f k x)) k m
380
381 -- | /O(min(n,W))/. The expression (@update f k map@) updates the value @x@
382 -- at @k@ (if it is in the map). If (@f x@) is @Nothing@, the element is
383 -- deleted. If it is (@Just y@), the key @k@ is bound to the new value @y@.
384 update :: (a -> Maybe a) -> Key -> IntMap a -> IntMap a
385 update f k m
386 = updateWithKey (\k x -> f x) k m
387
388 -- | /O(min(n,W))/. The expression (@update f k map@) updates the value @x@
389 -- at @k@ (if it is in the map). If (@f k x@) is @Nothing@, the element is
390 -- deleted. If it is (@Just y@), the key @k@ is bound to the new value @y@.
391 updateWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> IntMap a
392 updateWithKey f k t
393 = case t of
394 Bin p m l r
395 | nomatch k p m -> t
396 | zero k m -> bin p m (updateWithKey f k l) r
397 | otherwise -> bin p m l (updateWithKey f k r)
398 Tip ky y
399 | k==ky -> case (f k y) of
400 Just y' -> Tip ky y'
401 Nothing -> Nil
402 | otherwise -> t
403 Nil -> Nil
404
405 -- | /O(min(n,W))/. Lookup and update.
406 updateLookupWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> (Maybe a,IntMap a)
407 updateLookupWithKey f k t
408 = case t of
409 Bin p m l r
410 | nomatch k p m -> (Nothing,t)
411 | zero k m -> let (found,l') = updateLookupWithKey f k l in (found,bin p m l' r)
412 | otherwise -> let (found,r') = updateLookupWithKey f k r in (found,bin p m l r')
413 Tip ky y
414 | k==ky -> case (f k y) of
415 Just y' -> (Just y,Tip ky y')
416 Nothing -> (Just y,Nil)
417 | otherwise -> (Nothing,t)
418 Nil -> (Nothing,Nil)
419
420
421 {--------------------------------------------------------------------
422 Union
423 --------------------------------------------------------------------}
424 -- | The union of a list of maps.
425 unions :: [IntMap a] -> IntMap a
426 unions xs
427 = foldlStrict union empty xs
428
429 -- | The union of a list of maps, with a combining operation
430 unionsWith :: (a->a->a) -> [IntMap a] -> IntMap a
431 unionsWith f ts
432 = foldlStrict (unionWith f) empty ts
433
434 -- | /O(n+m)/. The (left-biased) union of two sets.
435 union :: IntMap a -> IntMap a -> IntMap a
436 union t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
437 | shorter m1 m2 = union1
438 | shorter m2 m1 = union2
439 | p1 == p2 = Bin p1 m1 (union l1 l2) (union r1 r2)
440 | otherwise = join p1 t1 p2 t2
441 where
442 union1 | nomatch p2 p1 m1 = join p1 t1 p2 t2
443 | zero p2 m1 = Bin p1 m1 (union l1 t2) r1
444 | otherwise = Bin p1 m1 l1 (union r1 t2)
445
446 union2 | nomatch p1 p2 m2 = join p1 t1 p2 t2
447 | zero p1 m2 = Bin p2 m2 (union t1 l2) r2
448 | otherwise = Bin p2 m2 l2 (union t1 r2)
449
450 union (Tip k x) t = insert k x t
451 union t (Tip k x) = insertWith (\x y -> y) k x t -- right bias
452 union Nil t = t
453 union t Nil = t
454
455 -- | /O(n+m)/. The union with a combining function.
456 unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
457 unionWith f m1 m2
458 = unionWithKey (\k x y -> f x y) m1 m2
459
460 -- | /O(n+m)/. The union with a combining function.
461 unionWithKey :: (Key -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
462 unionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
463 | shorter m1 m2 = union1
464 | shorter m2 m1 = union2
465 | p1 == p2 = Bin p1 m1 (unionWithKey f l1 l2) (unionWithKey f r1 r2)
466 | otherwise = join p1 t1 p2 t2
467 where
468 union1 | nomatch p2 p1 m1 = join p1 t1 p2 t2
469 | zero p2 m1 = Bin p1 m1 (unionWithKey f l1 t2) r1
470 | otherwise = Bin p1 m1 l1 (unionWithKey f r1 t2)
471
472 union2 | nomatch p1 p2 m2 = join p1 t1 p2 t2
473 | zero p1 m2 = Bin p2 m2 (unionWithKey f t1 l2) r2
474 | otherwise = Bin p2 m2 l2 (unionWithKey f t1 r2)
475
476 unionWithKey f (Tip k x) t = insertWithKey f k x t
477 unionWithKey f t (Tip k x) = insertWithKey (\k x y -> f k y x) k x t -- right bias
478 unionWithKey f Nil t = t
479 unionWithKey f t Nil = t
480
481 {--------------------------------------------------------------------
482 Difference
483 --------------------------------------------------------------------}
484 -- | /O(n+m)/. Difference between two maps (based on keys).
485 difference :: IntMap a -> IntMap b -> IntMap a
486 difference t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
487 | shorter m1 m2 = difference1
488 | shorter m2 m1 = difference2
489 | p1 == p2 = bin p1 m1 (difference l1 l2) (difference r1 r2)
490 | otherwise = t1
491 where
492 difference1 | nomatch p2 p1 m1 = t1
493 | zero p2 m1 = bin p1 m1 (difference l1 t2) r1
494 | otherwise = bin p1 m1 l1 (difference r1 t2)
495
496 difference2 | nomatch p1 p2 m2 = t1
497 | zero p1 m2 = difference t1 l2
498 | otherwise = difference t1 r2
499
500 difference t1@(Tip k x) t2
501 | member k t2 = Nil
502 | otherwise = t1
503
504 difference Nil t = Nil
505 difference t (Tip k x) = delete k t
506 difference t Nil = t
507
508 -- | /O(n+m)/. Difference with a combining function.
509 differenceWith :: (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
510 differenceWith f m1 m2
511 = differenceWithKey (\k x y -> f x y) m1 m2
512
513 -- | /O(n+m)/. Difference with a combining function. When two equal keys are
514 -- encountered, the combining function is applied to the key and both values.
515 -- If it returns @Nothing@, the element is discarded (proper set difference). If
516 -- it returns (@Just y@), the element is updated with a new value @y@.
517 differenceWithKey :: (Key -> a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
518 differenceWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
519 | shorter m1 m2 = difference1
520 | shorter m2 m1 = difference2
521 | p1 == p2 = bin p1 m1 (differenceWithKey f l1 l2) (differenceWithKey f r1 r2)
522 | otherwise = t1
523 where
524 difference1 | nomatch p2 p1 m1 = t1
525 | zero p2 m1 = bin p1 m1 (differenceWithKey f l1 t2) r1
526 | otherwise = bin p1 m1 l1 (differenceWithKey f r1 t2)
527
528 difference2 | nomatch p1 p2 m2 = t1
529 | zero p1 m2 = differenceWithKey f t1 l2
530 | otherwise = differenceWithKey f t1 r2
531
532 differenceWithKey f t1@(Tip k x) t2
533 = case lookup k t2 of
534 Just y -> case f k x y of
535 Just y' -> Tip k y'
536 Nothing -> Nil
537 Nothing -> t1
538
539 differenceWithKey f Nil t = Nil
540 differenceWithKey f t (Tip k y) = updateWithKey (\k x -> f k x y) k t
541 differenceWithKey f t Nil = t
542
543
544 {--------------------------------------------------------------------
545 Intersection
546 --------------------------------------------------------------------}
547 -- | /O(n+m)/. The (left-biased) intersection of two maps (based on keys).
548 intersection :: IntMap a -> IntMap b -> IntMap a
549 intersection t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
550 | shorter m1 m2 = intersection1
551 | shorter m2 m1 = intersection2
552 | p1 == p2 = bin p1 m1 (intersection l1 l2) (intersection r1 r2)
553 | otherwise = Nil
554 where
555 intersection1 | nomatch p2 p1 m1 = Nil
556 | zero p2 m1 = intersection l1 t2
557 | otherwise = intersection r1 t2
558
559 intersection2 | nomatch p1 p2 m2 = Nil
560 | zero p1 m2 = intersection t1 l2
561 | otherwise = intersection t1 r2
562
563 intersection t1@(Tip k x) t2
564 | member k t2 = t1
565 | otherwise = Nil
566 intersection t (Tip k x)
567 = case lookup k t of
568 Just y -> Tip k y
569 Nothing -> Nil
570 intersection Nil t = Nil
571 intersection t Nil = Nil
572
573 -- | /O(n+m)/. The intersection with a combining function.
574 intersectionWith :: (a -> b -> a) -> IntMap a -> IntMap b -> IntMap a
575 intersectionWith f m1 m2
576 = intersectionWithKey (\k x y -> f x y) m1 m2
577
578 -- | /O(n+m)/. The intersection with a combining function.
579 intersectionWithKey :: (Key -> a -> b -> a) -> IntMap a -> IntMap b -> IntMap a
580 intersectionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
581 | shorter m1 m2 = intersection1
582 | shorter m2 m1 = intersection2
583 | p1 == p2 = bin p1 m1 (intersectionWithKey f l1 l2) (intersectionWithKey f r1 r2)
584 | otherwise = Nil
585 where
586 intersection1 | nomatch p2 p1 m1 = Nil
587 | zero p2 m1 = intersectionWithKey f l1 t2
588 | otherwise = intersectionWithKey f r1 t2
589
590 intersection2 | nomatch p1 p2 m2 = Nil
591 | zero p1 m2 = intersectionWithKey f t1 l2
592 | otherwise = intersectionWithKey f t1 r2
593
594 intersectionWithKey f t1@(Tip k x) t2
595 = case lookup k t2 of
596 Just y -> Tip k (f k x y)
597 Nothing -> Nil
598 intersectionWithKey f t1 (Tip k y)
599 = case lookup k t1 of
600 Just x -> Tip k (f k x y)
601 Nothing -> Nil
602 intersectionWithKey f Nil t = Nil
603 intersectionWithKey f t Nil = Nil
604
605
606 {--------------------------------------------------------------------
607 Submap
608 --------------------------------------------------------------------}
609 -- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
610 -- Defined as (@isProperSubmapOf = isProperSubmapOfBy (==)@).
611 isProperSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
612 isProperSubmapOf m1 m2
613 = isProperSubmapOfBy (==) m1 m2
614
615 {- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
616 The expression (@isProperSubmapOfBy f m1 m2@) returns @True@ when
617 @m1@ and @m2@ are not equal,
618 all keys in @m1@ are in @m2@, and when @f@ returns @True@ when
619 applied to their respective values. For example, the following
620 expressions are all @True@.
621
622 > isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
623 > isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
624
625 But the following are all @False@:
626
627 > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
628 > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
629 > isProperSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
630 -}
631 isProperSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
632 isProperSubmapOfBy pred t1 t2
633 = case submapCmp pred t1 t2 of
634 LT -> True
635 ge -> False
636
637 submapCmp pred t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
638 | shorter m1 m2 = GT
639 | shorter m2 m1 = submapCmpLt
640 | p1 == p2 = submapCmpEq
641 | otherwise = GT -- disjoint
642 where
643 submapCmpLt | nomatch p1 p2 m2 = GT
644 | zero p1 m2 = submapCmp pred t1 l2
645 | otherwise = submapCmp pred t1 r2
646 submapCmpEq = case (submapCmp pred l1 l2, submapCmp pred r1 r2) of
647 (GT,_ ) -> GT
648 (_ ,GT) -> GT
649 (EQ,EQ) -> EQ
650 other -> LT
651
652 submapCmp pred (Bin p m l r) t = GT
653 submapCmp pred (Tip kx x) (Tip ky y)
654 | (kx == ky) && pred x y = EQ
655 | otherwise = GT -- disjoint
656 submapCmp pred (Tip k x) t
657 = case lookup k t of
658 Just y | pred x y -> LT
659 other -> GT -- disjoint
660 submapCmp pred Nil Nil = EQ
661 submapCmp pred Nil t = LT
662
663 -- | /O(n+m)/. Is this a submap? Defined as (@isSubmapOf = isSubmapOfBy (==)@).
664 isSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
665 isSubmapOf m1 m2
666 = isSubmapOfBy (==) m1 m2
667
668 {- | /O(n+m)/.
669 The expression (@isSubmapOfBy f m1 m2@) returns @True@ if
670 all keys in @m1@ are in @m2@, and when @f@ returns @True@ when
671 applied to their respective values. For example, the following
672 expressions are all @True@.
673
674 > isSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
675 > isSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
676 > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
677
678 But the following are all @False@:
679
680 > isSubmapOfBy (==) (fromList [(1,2)]) (fromList [(1,1),(2,2)])
681 > isSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
682 > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
683 -}
684
685 isSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
686 isSubmapOfBy pred t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
687 | shorter m1 m2 = False
688 | shorter m2 m1 = match p1 p2 m2 && (if zero p1 m2 then isSubmapOfBy pred t1 l2
689 else isSubmapOfBy pred t1 r2)
690 | otherwise = (p1==p2) && isSubmapOfBy pred l1 l2 && isSubmapOfBy pred r1 r2
691 isSubmapOfBy pred (Bin p m l r) t = False
692 isSubmapOfBy pred (Tip k x) t = case lookup k t of
693 Just y -> pred x y
694 Nothing -> False
695 isSubmapOfBy pred Nil t = True
696
697 {--------------------------------------------------------------------
698 Mapping
699 --------------------------------------------------------------------}
700 -- | /O(n)/. Map a function over all values in the map.
701 map :: (a -> b) -> IntMap a -> IntMap b
702 map f m
703 = mapWithKey (\k x -> f x) m
704
705 -- | /O(n)/. Map a function over all values in the map.
706 mapWithKey :: (Key -> a -> b) -> IntMap a -> IntMap b
707 mapWithKey f t
708 = case t of
709 Bin p m l r -> Bin p m (mapWithKey f l) (mapWithKey f r)
710 Tip k x -> Tip k (f k x)
711 Nil -> Nil
712
713 -- | /O(n)/. The function @mapAccum@ threads an accumulating
714 -- argument through the map in an unspecified order.
715 mapAccum :: (a -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
716 mapAccum f a m
717 = mapAccumWithKey (\a k x -> f a x) a m
718
719 -- | /O(n)/. The function @mapAccumWithKey@ threads an accumulating
720 -- argument through the map in an unspecified order.
721 mapAccumWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
722 mapAccumWithKey f a t
723 = mapAccumL f a t
724
725 -- | /O(n)/. The function @mapAccumL@ threads an accumulating
726 -- argument through the map in pre-order.
727 mapAccumL :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
728 mapAccumL f a t
729 = case t of
730 Bin p m l r -> let (a1,l') = mapAccumL f a l
731 (a2,r') = mapAccumL f a1 r
732 in (a2,Bin p m l' r')
733 Tip k x -> let (a',x') = f a k x in (a',Tip k x')
734 Nil -> (a,Nil)
735
736
737 -- | /O(n)/. The function @mapAccumR@ threads an accumulating
738 -- argument throught the map in post-order.
739 mapAccumR :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
740 mapAccumR f a t
741 = case t of
742 Bin p m l r -> let (a1,r') = mapAccumR f a r
743 (a2,l') = mapAccumR f a1 l
744 in (a2,Bin p m l' r')
745 Tip k x -> let (a',x') = f a k x in (a',Tip k x')
746 Nil -> (a,Nil)
747
748 {--------------------------------------------------------------------
749 Filter
750 --------------------------------------------------------------------}
751 -- | /O(n)/. Filter all values that satisfy some predicate.
752 filter :: (a -> Bool) -> IntMap a -> IntMap a
753 filter p m
754 = filterWithKey (\k x -> p x) m
755
756 -- | /O(n)/. Filter all keys\/values that satisfy some predicate.
757 filterWithKey :: (Key -> a -> Bool) -> IntMap a -> IntMap a
758 filterWithKey pred t
759 = case t of
760 Bin p m l r
761 -> bin p m (filterWithKey pred l) (filterWithKey pred r)
762 Tip k x
763 | pred k x -> t
764 | otherwise -> Nil
765 Nil -> Nil
766
767 -- | /O(n)/. partition the map according to some predicate. The first
768 -- map contains all elements that satisfy the predicate, the second all
769 -- elements that fail the predicate. See also 'split'.
770 partition :: (a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
771 partition p m
772 = partitionWithKey (\k x -> p x) m
773
774 -- | /O(n)/. partition the map according to some predicate. The first
775 -- map contains all elements that satisfy the predicate, the second all
776 -- elements that fail the predicate. See also 'split'.
777 partitionWithKey :: (Key -> a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
778 partitionWithKey pred t
779 = case t of
780 Bin p m l r
781 -> let (l1,l2) = partitionWithKey pred l
782 (r1,r2) = partitionWithKey pred r
783 in (bin p m l1 r1, bin p m l2 r2)
784 Tip k x
785 | pred k x -> (t,Nil)
786 | otherwise -> (Nil,t)
787 Nil -> (Nil,Nil)
788
789
790 -- | /O(log n)/. The expression (@split k map@) is a pair @(map1,map2)@
791 -- where all keys in @map1@ are lower than @k@ and all keys in
792 -- @map2@ larger than @k@. Any key equal to @k@ is found in neither @map1@ nor @map2@.
793 split :: Key -> IntMap a -> (IntMap a,IntMap a)
794 split k t
795 = case t of
796 Bin p m l r
797 | zero k m -> let (lt,gt) = split k l in (lt,union gt r)
798 | otherwise -> let (lt,gt) = split k r in (union l lt,gt)
799 Tip ky y
800 | k>ky -> (t,Nil)
801 | k<ky -> (Nil,t)
802 | otherwise -> (Nil,Nil)
803 Nil -> (Nil,Nil)
804
805 -- | /O(log n)/. Performs a 'split' but also returns whether the pivot
806 -- key was found in the original map.
807 splitLookup :: Key -> IntMap a -> (Maybe a,IntMap a,IntMap a)
808 splitLookup k t
809 = case t of
810 Bin p m l r
811 | zero k m -> let (found,lt,gt) = splitLookup k l in (found,lt,union gt r)
812 | otherwise -> let (found,lt,gt) = splitLookup k r in (found,union l lt,gt)
813 Tip ky y
814 | k>ky -> (Nothing,t,Nil)
815 | k<ky -> (Nothing,Nil,t)
816 | otherwise -> (Just y,Nil,Nil)
817 Nil -> (Nothing,Nil,Nil)
818
819 {--------------------------------------------------------------------
820 Fold
821 --------------------------------------------------------------------}
822 -- | /O(n)/. Fold over the elements of a map in an unspecified order.
823 --
824 -- > sum map = fold (+) 0 map
825 -- > elems map = fold (:) [] map
826 fold :: (a -> b -> b) -> b -> IntMap a -> b
827 fold f z t
828 = foldWithKey (\k x y -> f x y) z t
829
830 -- | /O(n)/. Fold over the elements of a map in an unspecified order.
831 --
832 -- > keys map = foldWithKey (\k x ks -> k:ks) [] map
833 foldWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b
834 foldWithKey f z t
835 = foldr f z t
836
837 foldr :: (Key -> a -> b -> b) -> b -> IntMap a -> b
838 foldr f z t
839 = case t of
840 Bin p m l r -> foldr f (foldr f z r) l
841 Tip k x -> f k x z
842 Nil -> z
843
844 {--------------------------------------------------------------------
845 List variations
846 --------------------------------------------------------------------}
847 -- | /O(n)/. Return all elements of the map.
848 elems :: IntMap a -> [a]
849 elems m
850 = foldWithKey (\k x xs -> x:xs) [] m
851
852 -- | /O(n)/. Return all keys of the map.
853 keys :: IntMap a -> [Key]
854 keys m
855 = foldWithKey (\k x ks -> k:ks) [] m
856
857 -- | /O(n*min(n,W))/. The set of all keys of the map.
858 keysSet :: IntMap a -> IntSet.IntSet
859 keysSet m = IntSet.fromDistinctAscList (keys m)
860
861
862 -- | /O(n)/. Return all key\/value pairs in the map.
863 assocs :: IntMap a -> [(Key,a)]
864 assocs m
865 = toList m
866
867
868 {--------------------------------------------------------------------
869 Lists
870 --------------------------------------------------------------------}
871 -- | /O(n)/. Convert the map to a list of key\/value pairs.
872 toList :: IntMap a -> [(Key,a)]
873 toList t
874 = foldWithKey (\k x xs -> (k,x):xs) [] t
875
876 -- | /O(n)/. Convert the map to a list of key\/value pairs where the
877 -- keys are in ascending order.
878 toAscList :: IntMap a -> [(Key,a)]
879 toAscList t
880 = -- NOTE: the following algorithm only works for big-endian trees
881 let (pos,neg) = span (\(k,x) -> k >=0) (foldr (\k x xs -> (k,x):xs) [] t) in neg ++ pos
882
883 -- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs.
884 fromList :: [(Key,a)] -> IntMap a
885 fromList xs
886 = foldlStrict ins empty xs
887 where
888 ins t (k,x) = insert k x t
889
890 -- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
891 fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
892 fromListWith f xs
893 = fromListWithKey (\k x y -> f x y) xs
894
895 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'.
896 fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
897 fromListWithKey f xs
898 = foldlStrict ins empty xs
899 where
900 ins t (k,x) = insertWithKey f k x t
901
902 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
903 -- the keys are in ascending order.
904 fromAscList :: [(Key,a)] -> IntMap a
905 fromAscList xs
906 = fromList xs
907
908 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
909 -- the keys are in ascending order, with a combining function on equal keys.
910 fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
911 fromAscListWith f xs
912 = fromListWith f xs
913
914 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
915 -- the keys are in ascending order, with a combining function on equal keys.
916 fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
917 fromAscListWithKey f xs
918 = fromListWithKey f xs
919
920 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
921 -- the keys are in ascending order and all distinct.
922 fromDistinctAscList :: [(Key,a)] -> IntMap a
923 fromDistinctAscList xs
924 = fromList xs
925
926
927 {--------------------------------------------------------------------
928 Eq
929 --------------------------------------------------------------------}
930 instance Eq a => Eq (IntMap a) where
931 t1 == t2 = equal t1 t2
932 t1 /= t2 = nequal t1 t2
933
934 equal :: Eq a => IntMap a -> IntMap a -> Bool
935 equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
936 = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2)
937 equal (Tip kx x) (Tip ky y)
938 = (kx == ky) && (x==y)
939 equal Nil Nil = True
940 equal t1 t2 = False
941
942 nequal :: Eq a => IntMap a -> IntMap a -> Bool
943 nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
944 = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2)
945 nequal (Tip kx x) (Tip ky y)
946 = (kx /= ky) || (x/=y)
947 nequal Nil Nil = False
948 nequal t1 t2 = True
949
950 {--------------------------------------------------------------------
951 Ord
952 --------------------------------------------------------------------}
953
954 instance Ord a => Ord (IntMap a) where
955 compare m1 m2 = compare (toList m1) (toList m2)
956
957 {--------------------------------------------------------------------
958 Functor
959 --------------------------------------------------------------------}
960
961 instance Functor IntMap where
962 fmap = map
963
964 {--------------------------------------------------------------------
965 Monoid
966 --------------------------------------------------------------------}
967
968 instance Ord a => Monoid (IntMap a) where
969 mempty = empty
970 mappend = union
971 mconcat = unions
972
973 {--------------------------------------------------------------------
974 Show
975 --------------------------------------------------------------------}
976
977 instance Show a => Show (IntMap a) where
978 showsPrec d t = showMap (toList t)
979
980
981 showMap :: (Show a) => [(Key,a)] -> ShowS
982 showMap []
983 = showString "{}"
984 showMap (x:xs)
985 = showChar '{' . showElem x . showTail xs
986 where
987 showTail [] = showChar '}'
988 showTail (x:xs) = showChar ',' . showElem x . showTail xs
989
990 showElem (k,x) = shows k . showString ":=" . shows x
991
992 {--------------------------------------------------------------------
993 Typeable
994 --------------------------------------------------------------------}
995
996 #include "Typeable.h"
997 INSTANCE_TYPEABLE1(IntMap,intMapTc,"IntMap")
998
999 {--------------------------------------------------------------------
1000 Debugging
1001 --------------------------------------------------------------------}
1002 -- | /O(n)/. Show the tree that implements the map. The tree is shown
1003 -- in a compressed, hanging format.
1004 showTree :: Show a => IntMap a -> String
1005 showTree s
1006 = showTreeWith True False s
1007
1008
1009 {- | /O(n)/. The expression (@showTreeWith hang wide map@) shows
1010 the tree that implements the map. If @hang@ is
1011 @True@, a /hanging/ tree is shown otherwise a rotated tree is shown. If
1012 @wide@ is true, an extra wide version is shown.
1013 -}
1014 showTreeWith :: Show a => Bool -> Bool -> IntMap a -> String
1015 showTreeWith hang wide t
1016 | hang = (showsTreeHang wide [] t) ""
1017 | otherwise = (showsTree wide [] [] t) ""
1018
1019 showsTree :: Show a => Bool -> [String] -> [String] -> IntMap a -> ShowS
1020 showsTree wide lbars rbars t
1021 = case t of
1022 Bin p m l r
1023 -> showsTree wide (withBar rbars) (withEmpty rbars) r .
1024 showWide wide rbars .
1025 showsBars lbars . showString (showBin p m) . showString "\n" .
1026 showWide wide lbars .
1027 showsTree wide (withEmpty lbars) (withBar lbars) l
1028 Tip k x
1029 -> showsBars lbars . showString " " . shows k . showString ":=" . shows x . showString "\n"
1030 Nil -> showsBars lbars . showString "|\n"
1031
1032 showsTreeHang :: Show a => Bool -> [String] -> IntMap a -> ShowS
1033 showsTreeHang wide bars t
1034 = case t of
1035 Bin p m l r
1036 -> showsBars bars . showString (showBin p m) . showString "\n" .
1037 showWide wide bars .
1038 showsTreeHang wide (withBar bars) l .
1039 showWide wide bars .
1040 showsTreeHang wide (withEmpty bars) r
1041 Tip k x
1042 -> showsBars bars . showString " " . shows k . showString ":=" . shows x . showString "\n"
1043 Nil -> showsBars bars . showString "|\n"
1044
1045 showBin p m
1046 = "*" -- ++ show (p,m)
1047
1048 showWide wide bars
1049 | wide = showString (concat (reverse bars)) . showString "|\n"
1050 | otherwise = id
1051
1052 showsBars :: [String] -> ShowS
1053 showsBars bars
1054 = case bars of
1055 [] -> id
1056 _ -> showString (concat (reverse (tail bars))) . showString node
1057
1058 node = "+--"
1059 withBar bars = "| ":bars
1060 withEmpty bars = " ":bars
1061
1062
1063 {--------------------------------------------------------------------
1064 Helpers
1065 --------------------------------------------------------------------}
1066 {--------------------------------------------------------------------
1067 Join
1068 --------------------------------------------------------------------}
1069 join :: Prefix -> IntMap a -> Prefix -> IntMap a -> IntMap a
1070 join p1 t1 p2 t2
1071 | zero p1 m = Bin p m t1 t2
1072 | otherwise = Bin p m t2 t1
1073 where
1074 m = branchMask p1 p2
1075 p = mask p1 m
1076
1077 {--------------------------------------------------------------------
1078 @bin@ assures that we never have empty trees within a tree.
1079 --------------------------------------------------------------------}
1080 bin :: Prefix -> Mask -> IntMap a -> IntMap a -> IntMap a
1081 bin p m l Nil = l
1082 bin p m Nil r = r
1083 bin p m l r = Bin p m l r
1084
1085
1086 {--------------------------------------------------------------------
1087 Endian independent bit twiddling
1088 --------------------------------------------------------------------}
1089 zero :: Key -> Mask -> Bool
1090 zero i m
1091 = (natFromInt i) .&. (natFromInt m) == 0
1092
1093 nomatch,match :: Key -> Prefix -> Mask -> Bool
1094 nomatch i p m
1095 = (mask i m) /= p
1096
1097 match i p m
1098 = (mask i m) == p
1099
1100 mask :: Key -> Mask -> Prefix
1101 mask i m
1102 = maskW (natFromInt i) (natFromInt m)
1103
1104
1105 zeroN :: Nat -> Nat -> Bool
1106 zeroN i m = (i .&. m) == 0
1107
1108 {--------------------------------------------------------------------
1109 Big endian operations
1110 --------------------------------------------------------------------}
1111 maskW :: Nat -> Nat -> Prefix
1112 maskW i m
1113 = intFromNat (i .&. (complement (m-1) `xor` m))
1114
1115 shorter :: Mask -> Mask -> Bool
1116 shorter m1 m2
1117 = (natFromInt m1) > (natFromInt m2)
1118
1119 branchMask :: Prefix -> Prefix -> Mask
1120 branchMask p1 p2
1121 = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))
1122
1123 {----------------------------------------------------------------------
1124 Finding the highest bit (mask) in a word [x] can be done efficiently in
1125 three ways:
1126 * convert to a floating point value and the mantissa tells us the
1127 [log2(x)] that corresponds with the highest bit position. The mantissa
1128 is retrieved either via the standard C function [frexp] or by some bit
1129 twiddling on IEEE compatible numbers (float). Note that one needs to
1130 use at least [double] precision for an accurate mantissa of 32 bit
1131 numbers.
1132 * use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit).
1133 * use processor specific assembler instruction (asm).
1134
1135 The most portable way would be [bit], but is it efficient enough?
1136 I have measured the cycle counts of the different methods on an AMD
1137 Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction:
1138
1139 highestBitMask: method cycles
1140 --------------
1141 frexp 200
1142 float 33
1143 bit 11
1144 asm 12
1145
1146 highestBit: method cycles
1147 --------------
1148 frexp 195
1149 float 33
1150 bit 11
1151 asm 11
1152
1153 Wow, the bit twiddling is on today's RISC like machines even faster
1154 than a single CISC instruction (BSR)!
1155 ----------------------------------------------------------------------}
1156
1157 {----------------------------------------------------------------------
1158 [highestBitMask] returns a word where only the highest bit is set.
1159 It is found by first setting all bits in lower positions than the
1160 highest bit and than taking an exclusive or with the original value.
1161 Allthough the function may look expensive, GHC compiles this into
1162 excellent C code that subsequently compiled into highly efficient
1163 machine code. The algorithm is derived from Jorg Arndt's FXT library.
1164 ----------------------------------------------------------------------}
1165 highestBitMask :: Nat -> Nat
1166 highestBitMask x
1167 = case (x .|. shiftRL x 1) of
1168 x -> case (x .|. shiftRL x 2) of
1169 x -> case (x .|. shiftRL x 4) of
1170 x -> case (x .|. shiftRL x 8) of
1171 x -> case (x .|. shiftRL x 16) of
1172 x -> case (x .|. shiftRL x 32) of -- for 64 bit platforms
1173 x -> (x `xor` (shiftRL x 1))
1174
1175
1176 {--------------------------------------------------------------------
1177 Utilities
1178 --------------------------------------------------------------------}
1179 foldlStrict f z xs
1180 = case xs of
1181 [] -> z
1182 (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx)
1183
1184 {-
1185 {--------------------------------------------------------------------
1186 Testing
1187 --------------------------------------------------------------------}
1188 testTree :: [Int] -> IntMap Int
1189 testTree xs = fromList [(x,x*x*30696 `mod` 65521) | x <- xs]
1190 test1 = testTree [1..20]
1191 test2 = testTree [30,29..10]
1192 test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3]
1193
1194 {--------------------------------------------------------------------
1195 QuickCheck
1196 --------------------------------------------------------------------}
1197 qcheck prop
1198 = check config prop
1199 where
1200 config = Config
1201 { configMaxTest = 500
1202 , configMaxFail = 5000
1203 , configSize = \n -> (div n 2 + 3)
1204 , configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ]
1205 }
1206
1207
1208 {--------------------------------------------------------------------
1209 Arbitrary, reasonably balanced trees
1210 --------------------------------------------------------------------}
1211 instance Arbitrary a => Arbitrary (IntMap a) where
1212 arbitrary = do{ ks <- arbitrary
1213 ; xs <- mapM (\k -> do{ x <- arbitrary; return (k,x)}) ks
1214 ; return (fromList xs)
1215 }
1216
1217
1218 {--------------------------------------------------------------------
1219 Single, Insert, Delete
1220 --------------------------------------------------------------------}
1221 prop_Single :: Key -> Int -> Bool
1222 prop_Single k x
1223 = (insert k x empty == singleton k x)
1224
1225 prop_InsertDelete :: Key -> Int -> IntMap Int -> Property
1226 prop_InsertDelete k x t
1227 = not (member k t) ==> delete k (insert k x t) == t
1228
1229 prop_UpdateDelete :: Key -> IntMap Int -> Bool
1230 prop_UpdateDelete k t
1231 = update (const Nothing) k t == delete k t
1232
1233
1234 {--------------------------------------------------------------------
1235 Union
1236 --------------------------------------------------------------------}
1237 prop_UnionInsert :: Key -> Int -> IntMap Int -> Bool
1238 prop_UnionInsert k x t
1239 = union (singleton k x) t == insert k x t
1240
1241 prop_UnionAssoc :: IntMap Int -> IntMap Int -> IntMap Int -> Bool
1242 prop_UnionAssoc t1 t2 t3
1243 = union t1 (union t2 t3) == union (union t1 t2) t3
1244
1245 prop_UnionComm :: IntMap Int -> IntMap Int -> Bool
1246 prop_UnionComm t1 t2
1247 = (union t1 t2 == unionWith (\x y -> y) t2 t1)
1248
1249
1250 prop_Diff :: [(Key,Int)] -> [(Key,Int)] -> Bool
1251 prop_Diff xs ys
1252 = List.sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys)))
1253 == List.sort ((List.\\) (nub (Prelude.map fst xs)) (nub (Prelude.map fst ys)))
1254
1255 prop_Int :: [(Key,Int)] -> [(Key,Int)] -> Bool
1256 prop_Int xs ys
1257 = List.sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
1258 == List.sort (nub ((List.intersect) (Prelude.map fst xs) (Prelude.map fst ys)))
1259
1260 {--------------------------------------------------------------------
1261 Lists
1262 --------------------------------------------------------------------}
1263 prop_Ordered
1264 = forAll (choose (5,100)) $ \n ->
1265 let xs = [(x,()) | x <- [0..n::Int]]
1266 in fromAscList xs == fromList xs
1267
1268 prop_List :: [Key] -> Bool
1269 prop_List xs
1270 = (sort (nub xs) == [x | (x,()) <- toAscList (fromList [(x,()) | x <- xs])])
1271 -}