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