1e21574131020aa29aad79455885a4c6198c3b2c
[packages/containers.git] / Data / IntMap.hs
1 {-# OPTIONS_GHC -cpp -XNoBangPatterns #-}
2 -----------------------------------------------------------------------------
3 -- |
4 -- Module : Data.IntMap
5 -- Copyright : (c) Daan Leijen 2002
6 -- (c) Andriy Palamarchuk 2008
7 -- License : BSD-style
8 -- Maintainer : libraries@haskell.org
9 -- Stability : provisional
10 -- Portability : portable
11 --
12 -- An efficient implementation of maps from integer keys to values.
13 --
14 -- Since many function names (but not the type name) clash with
15 -- "Prelude" names, this module is usually imported @qualified@, e.g.
16 --
17 -- > import Data.IntMap (IntMap)
18 -- > import qualified Data.IntMap as IntMap
19 --
20 -- The implementation is based on /big-endian patricia trees/. This data
21 -- structure performs especially well on binary operations like 'union'
22 -- and 'intersection'. However, my benchmarks show that it is also
23 -- (much) faster on insertions and deletions when compared to a generic
24 -- size-balanced map implementation (see "Data.Map").
25 --
26 -- * Chris Okasaki and Andy Gill, \"/Fast Mergeable Integer Maps/\",
27 -- Workshop on ML, September 1998, pages 77-86,
28 -- <http://citeseer.ist.psu.edu/okasaki98fast.html>
29 --
30 -- * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve
31 -- Information Coded In Alphanumeric/\", Journal of the ACM, 15(4),
32 -- October 1968, pages 514-534.
33 --
34 -- Operation comments contain the operation time complexity in
35 -- the Big-O notation <http://en.wikipedia.org/wiki/Big_O_notation>.
36 -- Many operations have a worst-case complexity of /O(min(n,W))/.
37 -- This means that the operation can become linear in the number of
38 -- elements with a maximum of /W/ -- the number of bits in an 'Int'
39 -- (32 or 64).
40 -----------------------------------------------------------------------------
41
42 module Data.IntMap (
43 -- * Map type
44 IntMap, Key -- instance Eq,Show
45
46 -- * Operators
47 , (!), (\\)
48
49 -- * Query
50 , null
51 , size
52 , member
53 , notMember
54 , lookup
55 , findWithDefault
56
57 -- * Construction
58 , empty
59 , singleton
60
61 -- ** Insertion
62 , insert
63 , insertWith, insertWithKey, insertLookupWithKey
64
65 -- ** Delete\/Update
66 , delete
67 , adjust
68 , adjustWithKey
69 , update
70 , updateWithKey
71 , updateLookupWithKey
72 , alter
73
74 -- * Combine
75
76 -- ** Union
77 , union
78 , unionWith
79 , unionWithKey
80 , unions
81 , unionsWith
82
83 -- ** Difference
84 , difference
85 , differenceWith
86 , differenceWithKey
87
88 -- ** Intersection
89 , intersection
90 , intersectionWith
91 , intersectionWithKey
92
93 -- * Traversal
94 -- ** Map
95 , map
96 , mapWithKey
97 , mapAccum
98 , mapAccumWithKey
99 , mapAccumRWithKey
100
101 -- ** Fold
102 , fold
103 , foldWithKey
104
105 -- * Conversion
106 , elems
107 , keys
108 , keysSet
109 , assocs
110
111 -- ** Lists
112 , toList
113 , fromList
114 , fromListWith
115 , fromListWithKey
116
117 -- ** Ordered lists
118 , toAscList
119 , fromAscList
120 , fromAscListWith
121 , fromAscListWithKey
122 , fromDistinctAscList
123
124 -- * Filter
125 , filter
126 , filterWithKey
127 , partition
128 , partitionWithKey
129
130 , mapMaybe
131 , mapMaybeWithKey
132 , mapEither
133 , mapEitherWithKey
134
135 , split
136 , splitLookup
137
138 -- * Submap
139 , isSubmapOf, isSubmapOfBy
140 , isProperSubmapOf, isProperSubmapOfBy
141
142 -- * Min\/Max
143
144 , maxView
145 , minView
146 , findMin
147 , findMax
148 , deleteMin
149 , deleteMax
150 , deleteFindMin
151 , deleteFindMax
152 , updateMin
153 , updateMax
154 , updateMinWithKey
155 , updateMaxWithKey
156 , minViewWithKey
157 , maxViewWithKey
158
159 -- * Debugging
160 , showTree
161 , showTreeWith
162 ) where
163
164
165 import Prelude hiding (lookup,map,filter,foldr,foldl,null)
166 import Data.Bits
167 import qualified Data.IntSet as IntSet
168 import Data.Monoid (Monoid(..))
169 import Data.Maybe (fromMaybe)
170 import Data.Typeable
171 import Data.Foldable (Foldable(foldMap))
172 import Control.Monad ( liftM )
173 {-
174 -- just for testing
175 import qualified Prelude
176 import Debug.QuickCheck
177 import List (nub,sort)
178 import qualified List
179 -}
180
181 #if __GLASGOW_HASKELL__
182 import Text.Read
183 import Data.Data (Data(..), mkNoRepType)
184 #endif
185
186 #if __GLASGOW_HASKELL__ >= 503
187 import GHC.Exts ( Word(..), Int(..), shiftRL# )
188 #elif __GLASGOW_HASKELL__
189 import Word
190 import GlaExts ( Word(..), Int(..), shiftRL# )
191 #else
192 import Data.Word
193 #endif
194
195 infixl 9 \\{-This comment teaches CPP correct behaviour -}
196
197 -- A "Nat" is a natural machine word (an unsigned Int)
198 type Nat = Word
199
200 natFromInt :: Key -> Nat
201 natFromInt i = fromIntegral i
202
203 intFromNat :: Nat -> Key
204 intFromNat w = fromIntegral w
205
206 shiftRL :: Nat -> Key -> Nat
207 #if __GLASGOW_HASKELL__
208 {--------------------------------------------------------------------
209 GHC: use unboxing to get @shiftRL@ inlined.
210 --------------------------------------------------------------------}
211 shiftRL (W# x) (I# i)
212 = W# (shiftRL# x i)
213 #else
214 shiftRL x i = shiftR x i
215 #endif
216
217 {--------------------------------------------------------------------
218 Operators
219 --------------------------------------------------------------------}
220
221 -- | /O(min(n,W))/. Find the value at a key.
222 -- Calls 'error' when the element can not be found.
223 --
224 -- > fromList [(5,'a'), (3,'b')] ! 1 Error: element not in the map
225 -- > fromList [(5,'a'), (3,'b')] ! 5 == 'a'
226
227 (!) :: IntMap a -> Key -> a
228 m ! k = find' k m
229
230 -- | Same as 'difference'.
231 (\\) :: IntMap a -> IntMap b -> IntMap a
232 m1 \\ m2 = difference m1 m2
233
234 {--------------------------------------------------------------------
235 Types
236 --------------------------------------------------------------------}
237 -- | A map of integers to values @a@.
238 data IntMap a = Nil
239 | Tip {-# UNPACK #-} !Key a
240 | Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !(IntMap a) !(IntMap a)
241
242 type Prefix = Int
243 type Mask = Int
244 type Key = Int
245
246 instance Monoid (IntMap a) where
247 mempty = empty
248 mappend = union
249 mconcat = unions
250
251 instance Foldable IntMap where
252 foldMap _ Nil = mempty
253 foldMap f (Tip _k v) = f v
254 foldMap f (Bin _ _ l r) = foldMap f l `mappend` foldMap f r
255
256 #if __GLASGOW_HASKELL__
257
258 {--------------------------------------------------------------------
259 A Data instance
260 --------------------------------------------------------------------}
261
262 -- This instance preserves data abstraction at the cost of inefficiency.
263 -- We omit reflection services for the sake of data abstraction.
264
265 instance Data a => Data (IntMap a) where
266 gfoldl f z im = z fromList `f` (toList im)
267 toConstr _ = error "toConstr"
268 gunfold _ _ = error "gunfold"
269 dataTypeOf _ = mkNoRepType "Data.IntMap.IntMap"
270 dataCast1 f = gcast1 f
271
272 #endif
273
274 {--------------------------------------------------------------------
275 Query
276 --------------------------------------------------------------------}
277 -- | /O(1)/. Is the map empty?
278 --
279 -- > Data.IntMap.null (empty) == True
280 -- > Data.IntMap.null (singleton 1 'a') == False
281
282 null :: IntMap a -> Bool
283 null Nil = True
284 null _ = False
285
286 -- | /O(n)/. Number of elements in the map.
287 --
288 -- > size empty == 0
289 -- > size (singleton 1 'a') == 1
290 -- > size (fromList([(1,'a'), (2,'c'), (3,'b')])) == 3
291 size :: IntMap a -> Int
292 size t
293 = case t of
294 Bin _ _ l r -> size l + size r
295 Tip _ _ -> 1
296 Nil -> 0
297
298 -- | /O(min(n,W))/. Is the key a member of the map?
299 --
300 -- > member 5 (fromList [(5,'a'), (3,'b')]) == True
301 -- > member 1 (fromList [(5,'a'), (3,'b')]) == False
302
303 member :: Key -> IntMap a -> Bool
304 member k m
305 = case lookup k m of
306 Nothing -> False
307 Just _ -> True
308
309 -- | /O(log n)/. Is the key not a member of the map?
310 --
311 -- > notMember 5 (fromList [(5,'a'), (3,'b')]) == False
312 -- > notMember 1 (fromList [(5,'a'), (3,'b')]) == True
313
314 notMember :: Key -> IntMap a -> Bool
315 notMember k m = not $ member k m
316
317 -- | /O(min(n,W))/. Lookup the value at a key in the map. See also 'Data.Map.lookup'.
318 lookup :: Key -> IntMap a -> Maybe a
319 lookup k t
320 = let nk = natFromInt k in seq nk (lookupN nk t)
321
322 lookupN :: Nat -> IntMap a -> Maybe a
323 lookupN k t
324 = case t of
325 Bin _ m l r
326 | zeroN k (natFromInt m) -> lookupN k l
327 | otherwise -> lookupN k r
328 Tip kx x
329 | (k == natFromInt kx) -> Just x
330 | otherwise -> Nothing
331 Nil -> Nothing
332
333 find' :: Key -> IntMap a -> a
334 find' k m
335 = case lookup k m of
336 Nothing -> error ("IntMap.find: key " ++ show k ++ " is not an element of the map")
337 Just x -> x
338
339
340 -- | /O(min(n,W))/. The expression @('findWithDefault' def k map)@
341 -- returns the value at key @k@ or returns @def@ when the key is not an
342 -- element of the map.
343 --
344 -- > findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x'
345 -- > findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) == 'a'
346
347 findWithDefault :: a -> Key -> IntMap a -> a
348 findWithDefault def k m
349 = case lookup k m of
350 Nothing -> def
351 Just x -> x
352
353 {--------------------------------------------------------------------
354 Construction
355 --------------------------------------------------------------------}
356 -- | /O(1)/. The empty map.
357 --
358 -- > empty == fromList []
359 -- > size empty == 0
360
361 empty :: IntMap a
362 empty
363 = Nil
364
365 -- | /O(1)/. A map of one element.
366 --
367 -- > singleton 1 'a' == fromList [(1, 'a')]
368 -- > size (singleton 1 'a') == 1
369
370 singleton :: Key -> a -> IntMap a
371 singleton k x
372 = Tip k x
373
374 {--------------------------------------------------------------------
375 Insert
376 --------------------------------------------------------------------}
377 -- | /O(min(n,W))/. Insert a new key\/value pair in the map.
378 -- If the key is already present in the map, the associated value is
379 -- replaced with the supplied value, i.e. 'insert' is equivalent to
380 -- @'insertWith' 'const'@.
381 --
382 -- > insert 5 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'x')]
383 -- > insert 7 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'a'), (7, 'x')]
384 -- > insert 5 'x' empty == singleton 5 'x'
385
386 insert :: Key -> a -> IntMap a -> IntMap a
387 insert k x t
388 = case t of
389 Bin p m l r
390 | nomatch k p m -> join k (Tip k x) p t
391 | zero k m -> Bin p m (insert k x l) r
392 | otherwise -> Bin p m l (insert k x r)
393 Tip ky _
394 | k==ky -> Tip k x
395 | otherwise -> join k (Tip k x) ky t
396 Nil -> Tip k x
397
398 -- right-biased insertion, used by 'union'
399 -- | /O(min(n,W))/. Insert with a combining function.
400 -- @'insertWith' f key value mp@
401 -- will insert the pair (key, value) into @mp@ if key does
402 -- not exist in the map. If the key does exist, the function will
403 -- insert @f new_value old_value@.
404 --
405 -- > insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "xxxa")]
406 -- > insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
407 -- > insertWith (++) 5 "xxx" empty == singleton 5 "xxx"
408
409 insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
410 insertWith f k x t
411 = insertWithKey (\_ x' y' -> f x' y') k x t
412
413 -- | /O(min(n,W))/. Insert with a combining function.
414 -- @'insertWithKey' f key value mp@
415 -- will insert the pair (key, value) into @mp@ if key does
416 -- not exist in the map. If the key does exist, the function will
417 -- insert @f key new_value old_value@.
418 --
419 -- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
420 -- > insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:xxx|a")]
421 -- > insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
422 -- > insertWithKey f 5 "xxx" empty == singleton 5 "xxx"
423
424 insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
425 insertWithKey f k x t
426 = case t of
427 Bin p m l r
428 | nomatch k p m -> join k (Tip k x) p t
429 | zero k m -> Bin p m (insertWithKey f k x l) r
430 | otherwise -> Bin p m l (insertWithKey f k x r)
431 Tip ky y
432 | k==ky -> Tip k (f k x y)
433 | otherwise -> join k (Tip k x) ky t
434 Nil -> Tip k x
435
436
437 -- | /O(min(n,W))/. The expression (@'insertLookupWithKey' f k x map@)
438 -- is a pair where the first element is equal to (@'lookup' k map@)
439 -- and the second element equal to (@'insertWithKey' f k x map@).
440 --
441 -- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
442 -- > insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
443 -- > insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")])
444 -- > insertLookupWithKey f 5 "xxx" empty == (Nothing, singleton 5 "xxx")
445 --
446 -- This is how to define @insertLookup@ using @insertLookupWithKey@:
447 --
448 -- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t
449 -- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")])
450 -- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a"), (7, "x")])
451
452 insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a)
453 insertLookupWithKey f k x t
454 = case t of
455 Bin p m l r
456 | nomatch k p m -> (Nothing,join k (Tip k x) p t)
457 | zero k m -> let (found,l') = insertLookupWithKey f k x l in (found,Bin p m l' r)
458 | otherwise -> let (found,r') = insertLookupWithKey f k x r in (found,Bin p m l r')
459 Tip ky y
460 | k==ky -> (Just y,Tip k (f k x y))
461 | otherwise -> (Nothing,join k (Tip k x) ky t)
462 Nil -> (Nothing,Tip k x)
463
464
465 {--------------------------------------------------------------------
466 Deletion
467 [delete] is the inlined version of [deleteWith (\k x -> Nothing)]
468 --------------------------------------------------------------------}
469 -- | /O(min(n,W))/. Delete a key and its value from the map. When the key is not
470 -- a member of the map, the original map is returned.
471 --
472 -- > delete 5 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
473 -- > delete 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
474 -- > delete 5 empty == empty
475
476 delete :: Key -> IntMap a -> IntMap a
477 delete k t
478 = case t of
479 Bin p m l r
480 | nomatch k p m -> t
481 | zero k m -> bin p m (delete k l) r
482 | otherwise -> bin p m l (delete k r)
483 Tip ky _
484 | k==ky -> Nil
485 | otherwise -> t
486 Nil -> Nil
487
488 -- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
489 -- a member of the map, the original map is returned.
490 --
491 -- > adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]
492 -- > adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
493 -- > adjust ("new " ++) 7 empty == empty
494
495 adjust :: (a -> a) -> Key -> IntMap a -> IntMap a
496 adjust f k m
497 = adjustWithKey (\_ x -> f x) k m
498
499 -- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
500 -- a member of the map, the original map is returned.
501 --
502 -- > let f key x = (show key) ++ ":new " ++ x
503 -- > adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]
504 -- > adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
505 -- > adjustWithKey f 7 empty == empty
506
507 adjustWithKey :: (Key -> a -> a) -> Key -> IntMap a -> IntMap a
508 adjustWithKey f k m
509 = updateWithKey (\k' x -> Just (f k' x)) k m
510
511 -- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
512 -- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
513 -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.
514 --
515 -- > let f x = if x == "a" then Just "new a" else Nothing
516 -- > update f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]
517 -- > update f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
518 -- > update f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
519
520 update :: (a -> Maybe a) -> Key -> IntMap a -> IntMap a
521 update f k m
522 = updateWithKey (\_ x -> f x) k m
523
524 -- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
525 -- at @k@ (if it is in the map). If (@f k x@) is 'Nothing', the element is
526 -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.
527 --
528 -- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
529 -- > updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]
530 -- > updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
531 -- > updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
532
533 updateWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> IntMap a
534 updateWithKey f k t
535 = case t of
536 Bin p m l r
537 | nomatch k p m -> t
538 | zero k m -> bin p m (updateWithKey f k l) r
539 | otherwise -> bin p m l (updateWithKey f k r)
540 Tip ky y
541 | k==ky -> case (f k y) of
542 Just y' -> Tip ky y'
543 Nothing -> Nil
544 | otherwise -> t
545 Nil -> Nil
546
547 -- | /O(min(n,W))/. Lookup and update.
548 -- The function returns original value, if it is updated.
549 -- This is different behavior than 'Data.Map.updateLookupWithKey'.
550 -- Returns the original key value if the map entry is deleted.
551 --
552 -- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
553 -- > updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:new a")])
554 -- > updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) == (Nothing, fromList [(3, "b"), (5, "a")])
555 -- > updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) == (Just "b", singleton 5 "a")
556
557 updateLookupWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> (Maybe a,IntMap a)
558 updateLookupWithKey f k t
559 = case t of
560 Bin p m l r
561 | nomatch k p m -> (Nothing,t)
562 | zero k m -> let (found,l') = updateLookupWithKey f k l in (found,bin p m l' r)
563 | otherwise -> let (found,r') = updateLookupWithKey f k r in (found,bin p m l r')
564 Tip ky y
565 | k==ky -> case (f k y) of
566 Just y' -> (Just y,Tip ky y')
567 Nothing -> (Just y,Nil)
568 | otherwise -> (Nothing,t)
569 Nil -> (Nothing,Nil)
570
571
572
573 -- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
574 -- 'alter' can be used to insert, delete, or update a value in an 'IntMap'.
575 -- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.
576 alter :: (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
577 alter f k t
578 = case t of
579 Bin p m l r
580 | nomatch k p m -> case f Nothing of
581 Nothing -> t
582 Just x -> join k (Tip k x) p t
583 | zero k m -> bin p m (alter f k l) r
584 | otherwise -> bin p m l (alter f k r)
585 Tip ky y
586 | k==ky -> case f (Just y) of
587 Just x -> Tip ky x
588 Nothing -> Nil
589 | otherwise -> case f Nothing of
590 Just x -> join k (Tip k x) ky t
591 Nothing -> Tip ky y
592 Nil -> case f Nothing of
593 Just x -> Tip k x
594 Nothing -> Nil
595
596
597 {--------------------------------------------------------------------
598 Union
599 --------------------------------------------------------------------}
600 -- | The union of a list of maps.
601 --
602 -- > unions [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
603 -- > == fromList [(3, "b"), (5, "a"), (7, "C")]
604 -- > unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
605 -- > == fromList [(3, "B3"), (5, "A3"), (7, "C")]
606
607 unions :: [IntMap a] -> IntMap a
608 unions xs
609 = foldlStrict union empty xs
610
611 -- | The union of a list of maps, with a combining operation.
612 --
613 -- > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
614 -- > == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]
615
616 unionsWith :: (a->a->a) -> [IntMap a] -> IntMap a
617 unionsWith f ts
618 = foldlStrict (unionWith f) empty ts
619
620 -- | /O(n+m)/. The (left-biased) union of two maps.
621 -- It prefers the first map when duplicate keys are encountered,
622 -- i.e. (@'union' == 'unionWith' 'const'@).
623 --
624 -- > union (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "a"), (7, "C")]
625
626 union :: IntMap a -> IntMap a -> IntMap a
627 union t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
628 | shorter m1 m2 = union1
629 | shorter m2 m1 = union2
630 | p1 == p2 = Bin p1 m1 (union l1 l2) (union r1 r2)
631 | otherwise = join p1 t1 p2 t2
632 where
633 union1 | nomatch p2 p1 m1 = join p1 t1 p2 t2
634 | zero p2 m1 = Bin p1 m1 (union l1 t2) r1
635 | otherwise = Bin p1 m1 l1 (union r1 t2)
636
637 union2 | nomatch p1 p2 m2 = join p1 t1 p2 t2
638 | zero p1 m2 = Bin p2 m2 (union t1 l2) r2
639 | otherwise = Bin p2 m2 l2 (union t1 r2)
640
641 union (Tip k x) t = insert k x t
642 union t (Tip k x) = insertWith (\_ y -> y) k x t -- right bias
643 union Nil t = t
644 union t Nil = t
645
646 -- | /O(n+m)/. The union with a combining function.
647 --
648 -- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]
649
650 unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
651 unionWith f m1 m2
652 = unionWithKey (\_ x y -> f x y) m1 m2
653
654 -- | /O(n+m)/. The union with a combining function.
655 --
656 -- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
657 -- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]
658
659 unionWithKey :: (Key -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
660 unionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
661 | shorter m1 m2 = union1
662 | shorter m2 m1 = union2
663 | p1 == p2 = Bin p1 m1 (unionWithKey f l1 l2) (unionWithKey f r1 r2)
664 | otherwise = join p1 t1 p2 t2
665 where
666 union1 | nomatch p2 p1 m1 = join p1 t1 p2 t2
667 | zero p2 m1 = Bin p1 m1 (unionWithKey f l1 t2) r1
668 | otherwise = Bin p1 m1 l1 (unionWithKey f r1 t2)
669
670 union2 | nomatch p1 p2 m2 = join p1 t1 p2 t2
671 | zero p1 m2 = Bin p2 m2 (unionWithKey f t1 l2) r2
672 | otherwise = Bin p2 m2 l2 (unionWithKey f t1 r2)
673
674 unionWithKey f (Tip k x) t = insertWithKey f k x t
675 unionWithKey f t (Tip k x) = insertWithKey (\k' x' y' -> f k' y' x') k x t -- right bias
676 unionWithKey _ Nil t = t
677 unionWithKey _ t Nil = t
678
679 {--------------------------------------------------------------------
680 Difference
681 --------------------------------------------------------------------}
682 -- | /O(n+m)/. Difference between two maps (based on keys).
683 --
684 -- > difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 3 "b"
685
686 difference :: IntMap a -> IntMap b -> IntMap a
687 difference t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
688 | shorter m1 m2 = difference1
689 | shorter m2 m1 = difference2
690 | p1 == p2 = bin p1 m1 (difference l1 l2) (difference r1 r2)
691 | otherwise = t1
692 where
693 difference1 | nomatch p2 p1 m1 = t1
694 | zero p2 m1 = bin p1 m1 (difference l1 t2) r1
695 | otherwise = bin p1 m1 l1 (difference r1 t2)
696
697 difference2 | nomatch p1 p2 m2 = t1
698 | zero p1 m2 = difference t1 l2
699 | otherwise = difference t1 r2
700
701 difference t1@(Tip k _) t2
702 | member k t2 = Nil
703 | otherwise = t1
704
705 difference Nil _ = Nil
706 difference t (Tip k _) = delete k t
707 difference t Nil = t
708
709 -- | /O(n+m)/. Difference with a combining function.
710 --
711 -- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing
712 -- > differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])
713 -- > == singleton 3 "b:B"
714
715 differenceWith :: (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
716 differenceWith f m1 m2
717 = differenceWithKey (\_ x y -> f x y) m1 m2
718
719 -- | /O(n+m)/. Difference with a combining function. When two equal keys are
720 -- encountered, the combining function is applied to the key and both values.
721 -- If it returns 'Nothing', the element is discarded (proper set difference).
722 -- If it returns (@'Just' y@), the element is updated with a new value @y@.
723 --
724 -- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing
725 -- > differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])
726 -- > == singleton 3 "3:b|B"
727
728 differenceWithKey :: (Key -> a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
729 differenceWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
730 | shorter m1 m2 = difference1
731 | shorter m2 m1 = difference2
732 | p1 == p2 = bin p1 m1 (differenceWithKey f l1 l2) (differenceWithKey f r1 r2)
733 | otherwise = t1
734 where
735 difference1 | nomatch p2 p1 m1 = t1
736 | zero p2 m1 = bin p1 m1 (differenceWithKey f l1 t2) r1
737 | otherwise = bin p1 m1 l1 (differenceWithKey f r1 t2)
738
739 difference2 | nomatch p1 p2 m2 = t1
740 | zero p1 m2 = differenceWithKey f t1 l2
741 | otherwise = differenceWithKey f t1 r2
742
743 differenceWithKey f t1@(Tip k x) t2
744 = case lookup k t2 of
745 Just y -> case f k x y of
746 Just y' -> Tip k y'
747 Nothing -> Nil
748 Nothing -> t1
749
750 differenceWithKey _ Nil _ = Nil
751 differenceWithKey f t (Tip k y) = updateWithKey (\k' x -> f k' x y) k t
752 differenceWithKey _ t Nil = t
753
754
755 {--------------------------------------------------------------------
756 Intersection
757 --------------------------------------------------------------------}
758 -- | /O(n+m)/. The (left-biased) intersection of two maps (based on keys).
759 --
760 -- > intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "a"
761
762 intersection :: IntMap a -> IntMap b -> IntMap a
763 intersection t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
764 | shorter m1 m2 = intersection1
765 | shorter m2 m1 = intersection2
766 | p1 == p2 = bin p1 m1 (intersection l1 l2) (intersection r1 r2)
767 | otherwise = Nil
768 where
769 intersection1 | nomatch p2 p1 m1 = Nil
770 | zero p2 m1 = intersection l1 t2
771 | otherwise = intersection r1 t2
772
773 intersection2 | nomatch p1 p2 m2 = Nil
774 | zero p1 m2 = intersection t1 l2
775 | otherwise = intersection t1 r2
776
777 intersection t1@(Tip k _) t2
778 | member k t2 = t1
779 | otherwise = Nil
780 intersection t (Tip k _)
781 = case lookup k t of
782 Just y -> Tip k y
783 Nothing -> Nil
784 intersection Nil _ = Nil
785 intersection _ Nil = Nil
786
787 -- | /O(n+m)/. The intersection with a combining function.
788 --
789 -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA"
790
791 intersectionWith :: (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
792 intersectionWith f m1 m2
793 = intersectionWithKey (\_ x y -> f x y) m1 m2
794
795 -- | /O(n+m)/. The intersection with a combining function.
796 --
797 -- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar
798 -- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"
799
800 intersectionWithKey :: (Key -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
801 intersectionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
802 | shorter m1 m2 = intersection1
803 | shorter m2 m1 = intersection2
804 | p1 == p2 = bin p1 m1 (intersectionWithKey f l1 l2) (intersectionWithKey f r1 r2)
805 | otherwise = Nil
806 where
807 intersection1 | nomatch p2 p1 m1 = Nil
808 | zero p2 m1 = intersectionWithKey f l1 t2
809 | otherwise = intersectionWithKey f r1 t2
810
811 intersection2 | nomatch p1 p2 m2 = Nil
812 | zero p1 m2 = intersectionWithKey f t1 l2
813 | otherwise = intersectionWithKey f t1 r2
814
815 intersectionWithKey f (Tip k x) t2
816 = case lookup k t2 of
817 Just y -> Tip k (f k x y)
818 Nothing -> Nil
819 intersectionWithKey f t1 (Tip k y)
820 = case lookup k t1 of
821 Just x -> Tip k (f k x y)
822 Nothing -> Nil
823 intersectionWithKey _ Nil _ = Nil
824 intersectionWithKey _ _ Nil = Nil
825
826
827 {--------------------------------------------------------------------
828 Min\/Max
829 --------------------------------------------------------------------}
830
831 -- | /O(log n)/. Update the value at the minimal key.
832 --
833 -- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")]
834 -- > updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
835
836 updateMinWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
837 updateMinWithKey f t
838 = case t of
839 Bin p m l r | m < 0 -> let t' = updateMinWithKeyUnsigned f r in Bin p m l t'
840 Bin p m l r -> let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
841 Tip k y -> Tip k (f k y)
842 Nil -> error "maxView: empty map has no maximal element"
843
844 updateMinWithKeyUnsigned :: (Key -> a -> a) -> IntMap a -> IntMap a
845 updateMinWithKeyUnsigned f t
846 = case t of
847 Bin p m l r -> let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
848 Tip k y -> Tip k (f k y)
849 Nil -> error "updateMinWithKeyUnsigned Nil"
850
851 -- | /O(log n)/. Update the value at the maximal key.
852 --
853 -- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")]
854 -- > updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
855
856 updateMaxWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
857 updateMaxWithKey f t
858 = case t of
859 Bin p m l r | m < 0 -> let t' = updateMaxWithKeyUnsigned f l in Bin p m t' r
860 Bin p m l r -> let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
861 Tip k y -> Tip k (f k y)
862 Nil -> error "maxView: empty map has no maximal element"
863
864 updateMaxWithKeyUnsigned :: (Key -> a -> a) -> IntMap a -> IntMap a
865 updateMaxWithKeyUnsigned f t
866 = case t of
867 Bin p m l r -> let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
868 Tip k y -> Tip k (f k y)
869 Nil -> error "updateMaxWithKeyUnsigned Nil"
870
871
872 -- | /O(log n)/. Retrieves the maximal (key,value) pair of the map, and
873 -- the map stripped of that element, or 'Nothing' if passed an empty map.
874 --
875 -- > maxViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((5,"a"), singleton 3 "b")
876 -- > maxViewWithKey empty == Nothing
877
878 maxViewWithKey :: IntMap a -> Maybe ((Key, a), IntMap a)
879 maxViewWithKey t
880 = case t of
881 Bin p m l r | m < 0 -> let (result, t') = maxViewUnsigned l in Just (result, bin p m t' r)
882 Bin p m l r -> let (result, t') = maxViewUnsigned r in Just (result, bin p m l t')
883 Tip k y -> Just ((k,y), Nil)
884 Nil -> Nothing
885
886 maxViewUnsigned :: IntMap a -> ((Key, a), IntMap a)
887 maxViewUnsigned t
888 = case t of
889 Bin p m l r -> let (result,t') = maxViewUnsigned r in (result,bin p m l t')
890 Tip k y -> ((k,y), Nil)
891 Nil -> error "maxViewUnsigned Nil"
892
893 -- | /O(log n)/. Retrieves the minimal (key,value) pair of the map, and
894 -- the map stripped of that element, or 'Nothing' if passed an empty map.
895 --
896 -- > minViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((3,"b"), singleton 5 "a")
897 -- > minViewWithKey empty == Nothing
898
899 minViewWithKey :: IntMap a -> Maybe ((Key, a), IntMap a)
900 minViewWithKey t
901 = case t of
902 Bin p m l r | m < 0 -> let (result, t') = minViewUnsigned r in Just (result, bin p m l t')
903 Bin p m l r -> let (result, t') = minViewUnsigned l in Just (result, bin p m t' r)
904 Tip k y -> Just ((k,y),Nil)
905 Nil -> Nothing
906
907 minViewUnsigned :: IntMap a -> ((Key, a), IntMap a)
908 minViewUnsigned t
909 = case t of
910 Bin p m l r -> let (result,t') = minViewUnsigned l in (result,bin p m t' r)
911 Tip k y -> ((k,y),Nil)
912 Nil -> error "minViewUnsigned Nil"
913
914
915 -- | /O(log n)/. Update the value at the maximal key.
916 --
917 -- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")]
918 -- > updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
919
920 updateMax :: (a -> a) -> IntMap a -> IntMap a
921 updateMax f = updateMaxWithKey (const f)
922
923 -- | /O(log n)/. Update the value at the minimal key.
924 --
925 -- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")]
926 -- > updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
927
928 updateMin :: (a -> a) -> IntMap a -> IntMap a
929 updateMin f = updateMinWithKey (const f)
930
931 -- Similar to the Arrow instance.
932 first :: (a -> c) -> (a, b) -> (c, b)
933 first f (x,y) = (f x,y)
934
935 -- | /O(log n)/. Retrieves the maximal key of the map, and the map
936 -- stripped of that element, or 'Nothing' if passed an empty map.
937 maxView :: IntMap a -> Maybe (a, IntMap a)
938 maxView t = liftM (first snd) (maxViewWithKey t)
939
940 -- | /O(log n)/. Retrieves the minimal key of the map, and the map
941 -- stripped of that element, or 'Nothing' if passed an empty map.
942 minView :: IntMap a -> Maybe (a, IntMap a)
943 minView t = liftM (first snd) (minViewWithKey t)
944
945 -- | /O(log n)/. Delete and find the maximal element.
946 deleteFindMax :: IntMap a -> (a, IntMap a)
947 deleteFindMax = fromMaybe (error "deleteFindMax: empty map has no maximal element") . maxView
948
949 -- | /O(log n)/. Delete and find the minimal element.
950 deleteFindMin :: IntMap a -> (a, IntMap a)
951 deleteFindMin = fromMaybe (error "deleteFindMin: empty map has no minimal element") . minView
952
953 -- | /O(log n)/. The minimal key of the map.
954 findMin :: IntMap a -> a
955 findMin = maybe (error "findMin: empty map has no minimal element") fst . minView
956
957 -- | /O(log n)/. The maximal key of the map.
958 findMax :: IntMap a -> a
959 findMax = maybe (error "findMax: empty map has no maximal element") fst . maxView
960
961 -- | /O(log n)/. Delete the minimal key.
962 deleteMin :: IntMap a -> IntMap a
963 deleteMin = maybe (error "deleteMin: empty map has no minimal element") snd . minView
964
965 -- | /O(log n)/. Delete the maximal key.
966 deleteMax :: IntMap a -> IntMap a
967 deleteMax = maybe (error "deleteMax: empty map has no maximal element") snd . maxView
968
969
970 {--------------------------------------------------------------------
971 Submap
972 --------------------------------------------------------------------}
973 -- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
974 -- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).
975 isProperSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
976 isProperSubmapOf m1 m2
977 = isProperSubmapOfBy (==) m1 m2
978
979 {- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
980 The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when
981 @m1@ and @m2@ are not equal,
982 all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
983 applied to their respective values. For example, the following
984 expressions are all 'True':
985
986 > isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
987 > isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
988
989 But the following are all 'False':
990
991 > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
992 > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
993 > isProperSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
994 -}
995 isProperSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
996 isProperSubmapOfBy predicate t1 t2
997 = case submapCmp predicate t1 t2 of
998 LT -> True
999 _ -> False
1000
1001 submapCmp :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
1002 submapCmp predicate t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
1003 | shorter m1 m2 = GT
1004 | shorter m2 m1 = submapCmpLt
1005 | p1 == p2 = submapCmpEq
1006 | otherwise = GT -- disjoint
1007 where
1008 submapCmpLt | nomatch p1 p2 m2 = GT
1009 | zero p1 m2 = submapCmp predicate t1 l2
1010 | otherwise = submapCmp predicate t1 r2
1011 submapCmpEq = case (submapCmp predicate l1 l2, submapCmp predicate r1 r2) of
1012 (GT,_ ) -> GT
1013 (_ ,GT) -> GT
1014 (EQ,EQ) -> EQ
1015 _ -> LT
1016
1017 submapCmp _ (Bin _ _ _ _) _ = GT
1018 submapCmp predicate (Tip kx x) (Tip ky y)
1019 | (kx == ky) && predicate x y = EQ
1020 | otherwise = GT -- disjoint
1021 submapCmp predicate (Tip k x) t
1022 = case lookup k t of
1023 Just y | predicate x y -> LT
1024 _ -> GT -- disjoint
1025 submapCmp _ Nil Nil = EQ
1026 submapCmp _ Nil _ = LT
1027
1028 -- | /O(n+m)/. Is this a submap?
1029 -- Defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
1030 isSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
1031 isSubmapOf m1 m2
1032 = isSubmapOfBy (==) m1 m2
1033
1034 {- | /O(n+m)/.
1035 The expression (@'isSubmapOfBy' f m1 m2@) returns 'True' if
1036 all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
1037 applied to their respective values. For example, the following
1038 expressions are all 'True':
1039
1040 > isSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
1041 > isSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
1042 > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
1043
1044 But the following are all 'False':
1045
1046 > isSubmapOfBy (==) (fromList [(1,2)]) (fromList [(1,1),(2,2)])
1047 > isSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
1048 > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
1049 -}
1050 isSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
1051 isSubmapOfBy predicate t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
1052 | shorter m1 m2 = False
1053 | shorter m2 m1 = match p1 p2 m2 && (if zero p1 m2 then isSubmapOfBy predicate t1 l2
1054 else isSubmapOfBy predicate t1 r2)
1055 | otherwise = (p1==p2) && isSubmapOfBy predicate l1 l2 && isSubmapOfBy predicate r1 r2
1056 isSubmapOfBy _ (Bin _ _ _ _) _ = False
1057 isSubmapOfBy predicate (Tip k x) t = case lookup k t of
1058 Just y -> predicate x y
1059 Nothing -> False
1060 isSubmapOfBy _ Nil _ = True
1061
1062 {--------------------------------------------------------------------
1063 Mapping
1064 --------------------------------------------------------------------}
1065 -- | /O(n)/. Map a function over all values in the map.
1066 --
1067 -- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]
1068
1069 map :: (a -> b) -> IntMap a -> IntMap b
1070 map f m
1071 = mapWithKey (\_ x -> f x) m
1072
1073 -- | /O(n)/. Map a function over all values in the map.
1074 --
1075 -- > let f key x = (show key) ++ ":" ++ x
1076 -- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]
1077
1078 mapWithKey :: (Key -> a -> b) -> IntMap a -> IntMap b
1079 mapWithKey f t
1080 = case t of
1081 Bin p m l r -> Bin p m (mapWithKey f l) (mapWithKey f r)
1082 Tip k x -> Tip k (f k x)
1083 Nil -> Nil
1084
1085 -- | /O(n)/. The function @'mapAccum'@ threads an accumulating
1086 -- argument through the map in ascending order of keys.
1087 --
1088 -- > let f a b = (a ++ b, b ++ "X")
1089 -- > mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) == ("Everything: ba", fromList [(3, "bX"), (5, "aX")])
1090
1091 mapAccum :: (a -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
1092 mapAccum f a m
1093 = mapAccumWithKey (\a' _ x -> f a' x) a m
1094
1095 -- | /O(n)/. The function @'mapAccumWithKey'@ threads an accumulating
1096 -- argument through the map in ascending order of keys.
1097 --
1098 -- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
1099 -- > mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) == ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])
1100
1101 mapAccumWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
1102 mapAccumWithKey f a t
1103 = mapAccumL f a t
1104
1105 -- | /O(n)/. The function @'mapAccumL'@ threads an accumulating
1106 -- argument through the map in ascending order of keys.
1107 mapAccumL :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
1108 mapAccumL f a t
1109 = case t of
1110 Bin p m l r -> let (a1,l') = mapAccumL f a l
1111 (a2,r') = mapAccumL f a1 r
1112 in (a2,Bin p m l' r')
1113 Tip k x -> let (a',x') = f a k x in (a',Tip k x')
1114 Nil -> (a,Nil)
1115
1116 -- | /O(n)/. The function @'mapAccumR'@ threads an accumulating
1117 -- argument through the map in descending order of keys.
1118 mapAccumRWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
1119 mapAccumRWithKey f a t
1120 = case t of
1121 Bin p m l r -> let (a1,r') = mapAccumRWithKey f a r
1122 (a2,l') = mapAccumRWithKey f a1 l
1123 in (a2,Bin p m l' r')
1124 Tip k x -> let (a',x') = f a k x in (a',Tip k x')
1125 Nil -> (a,Nil)
1126
1127 {--------------------------------------------------------------------
1128 Filter
1129 --------------------------------------------------------------------}
1130 -- | /O(n)/. Filter all values that satisfy some predicate.
1131 --
1132 -- > filter (> "a") (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
1133 -- > filter (> "x") (fromList [(5,"a"), (3,"b")]) == empty
1134 -- > filter (< "a") (fromList [(5,"a"), (3,"b")]) == empty
1135
1136 filter :: (a -> Bool) -> IntMap a -> IntMap a
1137 filter p m
1138 = filterWithKey (\_ x -> p x) m
1139
1140 -- | /O(n)/. Filter all keys\/values that satisfy some predicate.
1141 --
1142 -- > filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
1143
1144 filterWithKey :: (Key -> a -> Bool) -> IntMap a -> IntMap a
1145 filterWithKey predicate t
1146 = case t of
1147 Bin p m l r
1148 -> bin p m (filterWithKey predicate l) (filterWithKey predicate r)
1149 Tip k x
1150 | predicate k x -> t
1151 | otherwise -> Nil
1152 Nil -> Nil
1153
1154 -- | /O(n)/. Partition the map according to some predicate. The first
1155 -- map contains all elements that satisfy the predicate, the second all
1156 -- elements that fail the predicate. See also 'split'.
1157 --
1158 -- > partition (> "a") (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")
1159 -- > partition (< "x") (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)
1160 -- > partition (> "x") (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])
1161
1162 partition :: (a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
1163 partition p m
1164 = partitionWithKey (\_ x -> p x) m
1165
1166 -- | /O(n)/. Partition the map according to some predicate. The first
1167 -- map contains all elements that satisfy the predicate, the second all
1168 -- elements that fail the predicate. See also 'split'.
1169 --
1170 -- > partitionWithKey (\ k _ -> k > 3) (fromList [(5,"a"), (3,"b")]) == (singleton 5 "a", singleton 3 "b")
1171 -- > partitionWithKey (\ k _ -> k < 7) (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)
1172 -- > partitionWithKey (\ k _ -> k > 7) (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])
1173
1174 partitionWithKey :: (Key -> a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
1175 partitionWithKey predicate t
1176 = case t of
1177 Bin p m l r
1178 -> let (l1,l2) = partitionWithKey predicate l
1179 (r1,r2) = partitionWithKey predicate r
1180 in (bin p m l1 r1, bin p m l2 r2)
1181 Tip k x
1182 | predicate k x -> (t,Nil)
1183 | otherwise -> (Nil,t)
1184 Nil -> (Nil,Nil)
1185
1186 -- | /O(n)/. Map values and collect the 'Just' results.
1187 --
1188 -- > let f x = if x == "a" then Just "new a" else Nothing
1189 -- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"
1190
1191 mapMaybe :: (a -> Maybe b) -> IntMap a -> IntMap b
1192 mapMaybe f m
1193 = mapMaybeWithKey (\_ x -> f x) m
1194
1195 -- | /O(n)/. Map keys\/values and collect the 'Just' results.
1196 --
1197 -- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
1198 -- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"
1199
1200 mapMaybeWithKey :: (Key -> a -> Maybe b) -> IntMap a -> IntMap b
1201 mapMaybeWithKey f (Bin p m l r)
1202 = bin p m (mapMaybeWithKey f l) (mapMaybeWithKey f r)
1203 mapMaybeWithKey f (Tip k x) = case f k x of
1204 Just y -> Tip k y
1205 Nothing -> Nil
1206 mapMaybeWithKey _ Nil = Nil
1207
1208 -- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
1209 --
1210 -- > let f a = if a < "c" then Left a else Right a
1211 -- > mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1212 -- > == (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])
1213 -- >
1214 -- > mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1215 -- > == (empty, fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1216
1217 mapEither :: (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
1218 mapEither f m
1219 = mapEitherWithKey (\_ x -> f x) m
1220
1221 -- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.
1222 --
1223 -- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a)
1224 -- > mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1225 -- > == (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])
1226 -- >
1227 -- > mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
1228 -- > == (empty, fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])
1229
1230 mapEitherWithKey :: (Key -> a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
1231 mapEitherWithKey f (Bin p m l r)
1232 = (bin p m l1 r1, bin p m l2 r2)
1233 where
1234 (l1,l2) = mapEitherWithKey f l
1235 (r1,r2) = mapEitherWithKey f r
1236 mapEitherWithKey f (Tip k x) = case f k x of
1237 Left y -> (Tip k y, Nil)
1238 Right z -> (Nil, Tip k z)
1239 mapEitherWithKey _ Nil = (Nil, Nil)
1240
1241 -- | /O(log n)/. The expression (@'split' k map@) is a pair @(map1,map2)@
1242 -- where all keys in @map1@ are lower than @k@ and all keys in
1243 -- @map2@ larger than @k@. Any key equal to @k@ is found in neither @map1@ nor @map2@.
1244 --
1245 -- > split 2 (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3,"b"), (5,"a")])
1246 -- > split 3 (fromList [(5,"a"), (3,"b")]) == (empty, singleton 5 "a")
1247 -- > split 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")
1248 -- > split 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", empty)
1249 -- > split 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], empty)
1250
1251 split :: Key -> IntMap a -> (IntMap a,IntMap a)
1252 split k t
1253 = case t of
1254 Bin _ m l r
1255 | m < 0 -> (if k >= 0 -- handle negative numbers.
1256 then let (lt,gt) = split' k l in (union r lt, gt)
1257 else let (lt,gt) = split' k r in (lt, union gt l))
1258 | otherwise -> split' k t
1259 Tip ky _
1260 | k>ky -> (t,Nil)
1261 | k<ky -> (Nil,t)
1262 | otherwise -> (Nil,Nil)
1263 Nil -> (Nil,Nil)
1264
1265 split' :: Key -> IntMap a -> (IntMap a,IntMap a)
1266 split' k t
1267 = case t of
1268 Bin p m l r
1269 | nomatch k p m -> if k>p then (t,Nil) else (Nil,t)
1270 | zero k m -> let (lt,gt) = split k l in (lt,union gt r)
1271 | otherwise -> let (lt,gt) = split k r in (union l lt,gt)
1272 Tip ky _
1273 | k>ky -> (t,Nil)
1274 | k<ky -> (Nil,t)
1275 | otherwise -> (Nil,Nil)
1276 Nil -> (Nil,Nil)
1277
1278 -- | /O(log n)/. Performs a 'split' but also returns whether the pivot
1279 -- key was found in the original map.
1280 --
1281 -- > splitLookup 2 (fromList [(5,"a"), (3,"b")]) == (empty, Nothing, fromList [(3,"b"), (5,"a")])
1282 -- > splitLookup 3 (fromList [(5,"a"), (3,"b")]) == (empty, Just "b", singleton 5 "a")
1283 -- > splitLookup 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Nothing, singleton 5 "a")
1284 -- > splitLookup 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Just "a", empty)
1285 -- > splitLookup 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], Nothing, empty)
1286
1287 splitLookup :: Key -> IntMap a -> (IntMap a,Maybe a,IntMap a)
1288 splitLookup k t
1289 = case t of
1290 Bin _ m l r
1291 | m < 0 -> (if k >= 0 -- handle negative numbers.
1292 then let (lt,found,gt) = splitLookup' k l in (union r lt,found, gt)
1293 else let (lt,found,gt) = splitLookup' k r in (lt,found, union gt l))
1294 | otherwise -> splitLookup' k t
1295 Tip ky y
1296 | k>ky -> (t,Nothing,Nil)
1297 | k<ky -> (Nil,Nothing,t)
1298 | otherwise -> (Nil,Just y,Nil)
1299 Nil -> (Nil,Nothing,Nil)
1300
1301 splitLookup' :: Key -> IntMap a -> (IntMap a,Maybe a,IntMap a)
1302 splitLookup' k t
1303 = case t of
1304 Bin p m l r
1305 | nomatch k p m -> if k>p then (t,Nothing,Nil) else (Nil,Nothing,t)
1306 | zero k m -> let (lt,found,gt) = splitLookup k l in (lt,found,union gt r)
1307 | otherwise -> let (lt,found,gt) = splitLookup k r in (union l lt,found,gt)
1308 Tip ky y
1309 | k>ky -> (t,Nothing,Nil)
1310 | k<ky -> (Nil,Nothing,t)
1311 | otherwise -> (Nil,Just y,Nil)
1312 Nil -> (Nil,Nothing,Nil)
1313
1314 {--------------------------------------------------------------------
1315 Fold
1316 --------------------------------------------------------------------}
1317 -- | /O(n)/. Fold the values in the map, such that
1318 -- @'fold' f z == 'Prelude.foldr' f z . 'elems'@.
1319 -- For example,
1320 --
1321 -- > elems map = fold (:) [] map
1322 --
1323 -- > let f a len = len + (length a)
1324 -- > fold f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
1325
1326 fold :: (a -> b -> b) -> b -> IntMap a -> b
1327 fold f z t
1328 = foldWithKey (\_ x y -> f x y) z t
1329
1330 -- | /O(n)/. Fold the keys and values in the map, such that
1331 -- @'foldWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
1332 -- For example,
1333 --
1334 -- > keys map = foldWithKey (\k x ks -> k:ks) [] map
1335 --
1336 -- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
1337 -- > foldWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"
1338
1339 foldWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b
1340 foldWithKey f z t
1341 = foldr f z t
1342
1343 foldr :: (Key -> a -> b -> b) -> b -> IntMap a -> b
1344 foldr f z t
1345 = case t of
1346 Bin 0 m l r | m < 0 -> foldr' f (foldr' f z l) r -- put negative numbers before.
1347 Bin _ _ _ _ -> foldr' f z t
1348 Tip k x -> f k x z
1349 Nil -> z
1350
1351 foldr' :: (Key -> a -> b -> b) -> b -> IntMap a -> b
1352 foldr' f z t
1353 = case t of
1354 Bin _ _ l r -> foldr' f (foldr' f z r) l
1355 Tip k x -> f k x z
1356 Nil -> z
1357
1358
1359
1360 {--------------------------------------------------------------------
1361 List variations
1362 --------------------------------------------------------------------}
1363 -- | /O(n)/.
1364 -- Return all elements of the map in the ascending order of their keys.
1365 --
1366 -- > elems (fromList [(5,"a"), (3,"b")]) == ["b","a"]
1367 -- > elems empty == []
1368
1369 elems :: IntMap a -> [a]
1370 elems m
1371 = foldWithKey (\_ x xs -> x:xs) [] m
1372
1373 -- | /O(n)/. Return all keys of the map in ascending order.
1374 --
1375 -- > keys (fromList [(5,"a"), (3,"b")]) == [3,5]
1376 -- > keys empty == []
1377
1378 keys :: IntMap a -> [Key]
1379 keys m
1380 = foldWithKey (\k _ ks -> k:ks) [] m
1381
1382 -- | /O(n*min(n,W))/. The set of all keys of the map.
1383 --
1384 -- > keysSet (fromList [(5,"a"), (3,"b")]) == Data.IntSet.fromList [3,5]
1385 -- > keysSet empty == Data.IntSet.empty
1386
1387 keysSet :: IntMap a -> IntSet.IntSet
1388 keysSet m = IntSet.fromDistinctAscList (keys m)
1389
1390
1391 -- | /O(n)/. Return all key\/value pairs in the map in ascending key order.
1392 --
1393 -- > assocs (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
1394 -- > assocs empty == []
1395
1396 assocs :: IntMap a -> [(Key,a)]
1397 assocs m
1398 = toList m
1399
1400
1401 {--------------------------------------------------------------------
1402 Lists
1403 --------------------------------------------------------------------}
1404 -- | /O(n)/. Convert the map to a list of key\/value pairs.
1405 --
1406 -- > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
1407 -- > toList empty == []
1408
1409 toList :: IntMap a -> [(Key,a)]
1410 toList t
1411 = foldWithKey (\k x xs -> (k,x):xs) [] t
1412
1413 -- | /O(n)/. Convert the map to a list of key\/value pairs where the
1414 -- keys are in ascending order.
1415 --
1416 -- > toAscList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
1417
1418 toAscList :: IntMap a -> [(Key,a)]
1419 toAscList t
1420 = -- NOTE: the following algorithm only works for big-endian trees
1421 let (pos,neg) = span (\(k,_) -> k >=0) (foldr (\k x xs -> (k,x):xs) [] t) in neg ++ pos
1422
1423 -- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs.
1424 --
1425 -- > fromList [] == empty
1426 -- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]
1427 -- > fromList [(5,"c"), (3,"b"), (5, "a")] == fromList [(5,"a"), (3,"b")]
1428
1429 fromList :: [(Key,a)] -> IntMap a
1430 fromList xs
1431 = foldlStrict ins empty xs
1432 where
1433 ins t (k,x) = insert k x t
1434
1435 -- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
1436 --
1437 -- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]
1438 -- > fromListWith (++) [] == empty
1439
1440 fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
1441 fromListWith f xs
1442 = fromListWithKey (\_ x y -> f x y) xs
1443
1444 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'.
1445 --
1446 -- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]
1447 -- > fromListWith (++) [] == empty
1448
1449 fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
1450 fromListWithKey f xs
1451 = foldlStrict ins empty xs
1452 where
1453 ins t (k,x) = insertWithKey f k x t
1454
1455 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
1456 -- the keys are in ascending order.
1457 --
1458 -- > fromAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
1459 -- > fromAscList [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "b")]
1460
1461 fromAscList :: [(Key,a)] -> IntMap a
1462 fromAscList xs
1463 = fromList xs
1464
1465 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
1466 -- the keys are in ascending order, with a combining function on equal keys.
1467 --
1468 -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]
1469
1470 fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
1471 fromAscListWith f xs
1472 = fromListWith f xs
1473
1474 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
1475 -- the keys are in ascending order, with a combining function on equal keys.
1476 --
1477 -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]
1478
1479 fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
1480 fromAscListWithKey f xs
1481 = fromListWithKey f xs
1482
1483 -- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
1484 -- the keys are in ascending order and all distinct.
1485 --
1486 -- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
1487
1488 fromDistinctAscList :: [(Key,a)] -> IntMap a
1489 fromDistinctAscList xs
1490 = fromList xs
1491
1492
1493 {--------------------------------------------------------------------
1494 Eq
1495 --------------------------------------------------------------------}
1496 instance Eq a => Eq (IntMap a) where
1497 t1 == t2 = equal t1 t2
1498 t1 /= t2 = nequal t1 t2
1499
1500 equal :: Eq a => IntMap a -> IntMap a -> Bool
1501 equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
1502 = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2)
1503 equal (Tip kx x) (Tip ky y)
1504 = (kx == ky) && (x==y)
1505 equal Nil Nil = True
1506 equal _ _ = False
1507
1508 nequal :: Eq a => IntMap a -> IntMap a -> Bool
1509 nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
1510 = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2)
1511 nequal (Tip kx x) (Tip ky y)
1512 = (kx /= ky) || (x/=y)
1513 nequal Nil Nil = False
1514 nequal _ _ = True
1515
1516 {--------------------------------------------------------------------
1517 Ord
1518 --------------------------------------------------------------------}
1519
1520 instance Ord a => Ord (IntMap a) where
1521 compare m1 m2 = compare (toList m1) (toList m2)
1522
1523 {--------------------------------------------------------------------
1524 Functor
1525 --------------------------------------------------------------------}
1526
1527 instance Functor IntMap where
1528 fmap = map
1529
1530 {--------------------------------------------------------------------
1531 Show
1532 --------------------------------------------------------------------}
1533
1534 instance Show a => Show (IntMap a) where
1535 showsPrec d m = showParen (d > 10) $
1536 showString "fromList " . shows (toList m)
1537
1538 {-
1539 XXX unused code
1540
1541 showMap :: (Show a) => [(Key,a)] -> ShowS
1542 showMap []
1543 = showString "{}"
1544 showMap (x:xs)
1545 = showChar '{' . showElem x . showTail xs
1546 where
1547 showTail [] = showChar '}'
1548 showTail (x':xs') = showChar ',' . showElem x' . showTail xs'
1549
1550 showElem (k,v) = shows k . showString ":=" . shows v
1551 -}
1552
1553 {--------------------------------------------------------------------
1554 Read
1555 --------------------------------------------------------------------}
1556 instance (Read e) => Read (IntMap e) where
1557 #ifdef __GLASGOW_HASKELL__
1558 readPrec = parens $ prec 10 $ do
1559 Ident "fromList" <- lexP
1560 xs <- readPrec
1561 return (fromList xs)
1562
1563 readListPrec = readListPrecDefault
1564 #else
1565 readsPrec p = readParen (p > 10) $ \ r -> do
1566 ("fromList",s) <- lex r
1567 (xs,t) <- reads s
1568 return (fromList xs,t)
1569 #endif
1570
1571 {--------------------------------------------------------------------
1572 Typeable
1573 --------------------------------------------------------------------}
1574
1575 #include "Typeable.h"
1576 INSTANCE_TYPEABLE1(IntMap,intMapTc,"IntMap")
1577
1578 {--------------------------------------------------------------------
1579 Debugging
1580 --------------------------------------------------------------------}
1581 -- | /O(n)/. Show the tree that implements the map. The tree is shown
1582 -- in a compressed, hanging format.
1583 showTree :: Show a => IntMap a -> String
1584 showTree s
1585 = showTreeWith True False s
1586
1587
1588 {- | /O(n)/. The expression (@'showTreeWith' hang wide map@) shows
1589 the tree that implements the map. If @hang@ is
1590 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If
1591 @wide@ is 'True', an extra wide version is shown.
1592 -}
1593 showTreeWith :: Show a => Bool -> Bool -> IntMap a -> String
1594 showTreeWith hang wide t
1595 | hang = (showsTreeHang wide [] t) ""
1596 | otherwise = (showsTree wide [] [] t) ""
1597
1598 showsTree :: Show a => Bool -> [String] -> [String] -> IntMap a -> ShowS
1599 showsTree wide lbars rbars t
1600 = case t of
1601 Bin p m l r
1602 -> showsTree wide (withBar rbars) (withEmpty rbars) r .
1603 showWide wide rbars .
1604 showsBars lbars . showString (showBin p m) . showString "\n" .
1605 showWide wide lbars .
1606 showsTree wide (withEmpty lbars) (withBar lbars) l
1607 Tip k x
1608 -> showsBars lbars . showString " " . shows k . showString ":=" . shows x . showString "\n"
1609 Nil -> showsBars lbars . showString "|\n"
1610
1611 showsTreeHang :: Show a => Bool -> [String] -> IntMap a -> ShowS
1612 showsTreeHang wide bars t
1613 = case t of
1614 Bin p m l r
1615 -> showsBars bars . showString (showBin p m) . showString "\n" .
1616 showWide wide bars .
1617 showsTreeHang wide (withBar bars) l .
1618 showWide wide bars .
1619 showsTreeHang wide (withEmpty bars) r
1620 Tip k x
1621 -> showsBars bars . showString " " . shows k . showString ":=" . shows x . showString "\n"
1622 Nil -> showsBars bars . showString "|\n"
1623
1624 showBin :: Prefix -> Mask -> String
1625 showBin _ _
1626 = "*" -- ++ show (p,m)
1627
1628 showWide :: Bool -> [String] -> String -> String
1629 showWide wide bars
1630 | wide = showString (concat (reverse bars)) . showString "|\n"
1631 | otherwise = id
1632
1633 showsBars :: [String] -> ShowS
1634 showsBars bars
1635 = case bars of
1636 [] -> id
1637 _ -> showString (concat (reverse (tail bars))) . showString node
1638
1639 node :: String
1640 node = "+--"
1641
1642 withBar, withEmpty :: [String] -> [String]
1643 withBar bars = "| ":bars
1644 withEmpty bars = " ":bars
1645
1646
1647 {--------------------------------------------------------------------
1648 Helpers
1649 --------------------------------------------------------------------}
1650 {--------------------------------------------------------------------
1651 Join
1652 --------------------------------------------------------------------}
1653 join :: Prefix -> IntMap a -> Prefix -> IntMap a -> IntMap a
1654 join p1 t1 p2 t2
1655 | zero p1 m = Bin p m t1 t2
1656 | otherwise = Bin p m t2 t1
1657 where
1658 m = branchMask p1 p2
1659 p = mask p1 m
1660
1661 {--------------------------------------------------------------------
1662 @bin@ assures that we never have empty trees within a tree.
1663 --------------------------------------------------------------------}
1664 bin :: Prefix -> Mask -> IntMap a -> IntMap a -> IntMap a
1665 bin _ _ l Nil = l
1666 bin _ _ Nil r = r
1667 bin p m l r = Bin p m l r
1668
1669
1670 {--------------------------------------------------------------------
1671 Endian independent bit twiddling
1672 --------------------------------------------------------------------}
1673 zero :: Key -> Mask -> Bool
1674 zero i m
1675 = (natFromInt i) .&. (natFromInt m) == 0
1676
1677 nomatch,match :: Key -> Prefix -> Mask -> Bool
1678 nomatch i p m
1679 = (mask i m) /= p
1680
1681 match i p m
1682 = (mask i m) == p
1683
1684 mask :: Key -> Mask -> Prefix
1685 mask i m
1686 = maskW (natFromInt i) (natFromInt m)
1687
1688
1689 zeroN :: Nat -> Nat -> Bool
1690 zeroN i m = (i .&. m) == 0
1691
1692 {--------------------------------------------------------------------
1693 Big endian operations
1694 --------------------------------------------------------------------}
1695 maskW :: Nat -> Nat -> Prefix
1696 maskW i m
1697 = intFromNat (i .&. (complement (m-1) `xor` m))
1698
1699 shorter :: Mask -> Mask -> Bool
1700 shorter m1 m2
1701 = (natFromInt m1) > (natFromInt m2)
1702
1703 branchMask :: Prefix -> Prefix -> Mask
1704 branchMask p1 p2
1705 = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))
1706
1707 {----------------------------------------------------------------------
1708 Finding the highest bit (mask) in a word [x] can be done efficiently in
1709 three ways:
1710 * convert to a floating point value and the mantissa tells us the
1711 [log2(x)] that corresponds with the highest bit position. The mantissa
1712 is retrieved either via the standard C function [frexp] or by some bit
1713 twiddling on IEEE compatible numbers (float). Note that one needs to
1714 use at least [double] precision for an accurate mantissa of 32 bit
1715 numbers.
1716 * use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit).
1717 * use processor specific assembler instruction (asm).
1718
1719 The most portable way would be [bit], but is it efficient enough?
1720 I have measured the cycle counts of the different methods on an AMD
1721 Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction:
1722
1723 highestBitMask: method cycles
1724 --------------
1725 frexp 200
1726 float 33
1727 bit 11
1728 asm 12
1729
1730 highestBit: method cycles
1731 --------------
1732 frexp 195
1733 float 33
1734 bit 11
1735 asm 11
1736
1737 Wow, the bit twiddling is on today's RISC like machines even faster
1738 than a single CISC instruction (BSR)!
1739 ----------------------------------------------------------------------}
1740
1741 {----------------------------------------------------------------------
1742 [highestBitMask] returns a word where only the highest bit is set.
1743 It is found by first setting all bits in lower positions than the
1744 highest bit and than taking an exclusive or with the original value.
1745 Allthough the function may look expensive, GHC compiles this into
1746 excellent C code that subsequently compiled into highly efficient
1747 machine code. The algorithm is derived from Jorg Arndt's FXT library.
1748 ----------------------------------------------------------------------}
1749 highestBitMask :: Nat -> Nat
1750 highestBitMask x0
1751 = case (x0 .|. shiftRL x0 1) of
1752 x1 -> case (x1 .|. shiftRL x1 2) of
1753 x2 -> case (x2 .|. shiftRL x2 4) of
1754 x3 -> case (x3 .|. shiftRL x3 8) of
1755 x4 -> case (x4 .|. shiftRL x4 16) of
1756 x5 -> case (x5 .|. shiftRL x5 32) of -- for 64 bit platforms
1757 x6 -> (x6 `xor` (shiftRL x6 1))
1758
1759
1760 {--------------------------------------------------------------------
1761 Utilities
1762 --------------------------------------------------------------------}
1763 foldlStrict :: (a -> b -> a) -> a -> [b] -> a
1764 foldlStrict f z xs
1765 = case xs of
1766 [] -> z
1767 (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx)
1768
1769 {-
1770 {--------------------------------------------------------------------
1771 Testing
1772 --------------------------------------------------------------------}
1773 testTree :: [Int] -> IntMap Int
1774 testTree xs = fromList [(x,x*x*30696 `mod` 65521) | x <- xs]
1775 test1 = testTree [1..20]
1776 test2 = testTree [30,29..10]
1777 test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3]
1778
1779 {--------------------------------------------------------------------
1780 QuickCheck
1781 --------------------------------------------------------------------}
1782 qcheck prop
1783 = check config prop
1784 where
1785 config = Config
1786 { configMaxTest = 500
1787 , configMaxFail = 5000
1788 , configSize = \n -> (div n 2 + 3)
1789 , configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ]
1790 }
1791
1792
1793 {--------------------------------------------------------------------
1794 Arbitrary, reasonably balanced trees
1795 --------------------------------------------------------------------}
1796 instance Arbitrary a => Arbitrary (IntMap a) where
1797 arbitrary = do{ ks <- arbitrary
1798 ; xs <- mapM (\k -> do{ x <- arbitrary; return (k,x)}) ks
1799 ; return (fromList xs)
1800 }
1801
1802
1803 {--------------------------------------------------------------------
1804 Single, Insert, Delete
1805 --------------------------------------------------------------------}
1806 prop_Single :: Key -> Int -> Bool
1807 prop_Single k x
1808 = (insert k x empty == singleton k x)
1809
1810 prop_InsertDelete :: Key -> Int -> IntMap Int -> Property
1811 prop_InsertDelete k x t
1812 = not (member k t) ==> delete k (insert k x t) == t
1813
1814 prop_UpdateDelete :: Key -> IntMap Int -> Bool
1815 prop_UpdateDelete k t
1816 = update (const Nothing) k t == delete k t
1817
1818
1819 {--------------------------------------------------------------------
1820 Union
1821 --------------------------------------------------------------------}
1822 prop_UnionInsert :: Key -> Int -> IntMap Int -> Bool
1823 prop_UnionInsert k x t
1824 = union (singleton k x) t == insert k x t
1825
1826 prop_UnionAssoc :: IntMap Int -> IntMap Int -> IntMap Int -> Bool
1827 prop_UnionAssoc t1 t2 t3
1828 = union t1 (union t2 t3) == union (union t1 t2) t3
1829
1830 prop_UnionComm :: IntMap Int -> IntMap Int -> Bool
1831 prop_UnionComm t1 t2
1832 = (union t1 t2 == unionWith (\x y -> y) t2 t1)
1833
1834
1835 prop_Diff :: [(Key,Int)] -> [(Key,Int)] -> Bool
1836 prop_Diff xs ys
1837 = List.sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys)))
1838 == List.sort ((List.\\) (nub (Prelude.map fst xs)) (nub (Prelude.map fst ys)))
1839
1840 prop_Int :: [(Key,Int)] -> [(Key,Int)] -> Bool
1841 prop_Int xs ys
1842 = List.sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
1843 == List.sort (nub ((List.intersect) (Prelude.map fst xs) (Prelude.map fst ys)))
1844
1845 {--------------------------------------------------------------------
1846 Lists
1847 --------------------------------------------------------------------}
1848 prop_Ordered
1849 = forAll (choose (5,100)) $ \n ->
1850 let xs = [(x,()) | x <- [0..n::Int]]
1851 in fromAscList xs == fromList xs
1852
1853 prop_List :: [Key] -> Bool
1854 prop_List xs
1855 = (sort (nub xs) == [x | (x,()) <- toAscList (fromList [(x,()) | x <- xs])])
1856
1857
1858 {--------------------------------------------------------------------
1859 updateMin / updateMax
1860 --------------------------------------------------------------------}
1861 prop_UpdateMinMax :: [Key] -> Bool
1862 prop_UpdateMinMax xs =
1863 let m = fromList [(x,0)|x<-xs]
1864 minKey = fst . head . Prelude.filter ((==1).snd) . assocs . updateMin succ $ m
1865 maxKey = fst . head . Prelude.filter ((==1).snd) . assocs . updateMax succ $ m
1866 in all (>=minKey) xs && all (<=maxKey) xs
1867
1868 -}