+{-# OPTIONS_GHC -fno-bang-patterns #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : Data.Map
--
-- An efficient implementation of maps from keys to values (dictionaries).
--
--- This module is intended to be imported @qualified@, to avoid name
--- clashes with Prelude functions. eg.
+-- Since many function names (but not the type name) clash with
+-- "Prelude" names, this module is usually imported @qualified@, e.g.
--
--- > import Data.Map as Map
+-- > import Data.Map (Map)
+-- > import qualified Data.Map as Map
--
-- The implementation of 'Map' is based on /size balanced/ binary trees (or
-- trees of /bounded balance/) as described by:
-- * J. Nievergelt and E.M. Reingold,
-- \"/Binary search trees of bounded balance/\",
-- SIAM journal of computing 2(1), March 1973.
+--
+-- Note that the implementation is /left-biased/ -- the elements of a
+-- first argument are always preferred to the second, for example in
+-- 'union' or 'insert'.
-----------------------------------------------------------------------------
module Data.Map (
-- * Map type
- Map -- instance Eq,Show
+ Map -- instance Eq,Show,Read
-- * Operators
, (!), (\\)
, null
, size
, member
+ , notMember
, lookup
, findWithDefault
-- ** Insertion
, insert
, insertWith, insertWithKey, insertLookupWithKey
+ , insertWith', insertWithKey'
-- ** Delete\/Update
, delete
, update
, updateWithKey
, updateLookupWithKey
+ , alter
-- * Combine
, partition
, partitionWithKey
+ , mapMaybe
+ , mapMaybeWithKey
+ , mapEither
+ , mapEitherWithKey
+
, split
, splitLookup
, updateMax
, updateMinWithKey
, updateMaxWithKey
+ , minView
+ , maxView
+ , minViewWithKey
+ , maxViewWithKey
-- * Debugging
, showTree
) where
import Prelude hiding (lookup,map,filter,foldr,foldl,null)
-import Data.Monoid
import qualified Data.Set as Set
import qualified Data.List as List
+import Data.Monoid (Monoid(..))
+import Data.Typeable
+import Control.Applicative (Applicative(..), (<$>))
+import Data.Traversable (Traversable(traverse))
+import Data.Foldable (Foldable(foldMap))
{-
-- for quick check
import List(nub,sort)
-}
+#if __GLASGOW_HASKELL__
+import Text.Read
+import Data.Generics.Basics
+import Data.Generics.Instances
+#endif
+
{--------------------------------------------------------------------
Operators
--------------------------------------------------------------------}
infixl 9 !,\\ --
--- | /O(log n)/. Find the value of a key. Calls @error@ when the element can not be found.
+-- | /O(log n)/. Find the value at a key.
+-- Calls 'error' when the element can not be found.
(!) :: Ord k => Map k a -> k -> a
m ! k = find k m
type Size = Int
+instance (Ord k) => Monoid (Map k v) where
+ mempty = empty
+ mappend = union
+ mconcat = unions
+
+#if __GLASGOW_HASKELL__
+
+{--------------------------------------------------------------------
+ A Data instance
+--------------------------------------------------------------------}
+
+-- This instance preserves data abstraction at the cost of inefficiency.
+-- We omit reflection services for the sake of data abstraction.
+
+instance (Data k, Data a, Ord k) => Data (Map k a) where
+ gfoldl f z map = z fromList `f` (toList map)
+ toConstr _ = error "toConstr"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNorepType "Data.Map.Map"
+ dataCast2 f = gcast2 f
+
+#endif
+
{--------------------------------------------------------------------
Query
--------------------------------------------------------------------}
Bin sz k x l r -> sz
--- | /O(log n)/. Lookup the value of key in the map.
-lookup :: Ord k => k -> Map k a -> Maybe a
-lookup k t
+-- | /O(log n)/. Lookup the value at a key in the map.
+--
+-- The function will
+-- @return@ the result in the monad or @fail@ in it the key isn't in the
+-- map. Often, the monad to use is 'Maybe', so you get either
+-- @('Just' result)@ or @'Nothing'@.
+lookup :: (Monad m,Ord k) => k -> Map k a -> m a
+lookup k t = case lookup' k t of
+ Just x -> return x
+ Nothing -> fail "Data.Map.lookup: Key not found"
+lookup' :: Ord k => k -> Map k a -> Maybe a
+lookup' k t
= case t of
Tip -> Nothing
Bin sz kx x l r
-> case compare k kx of
- LT -> lookup k l
- GT -> lookup k r
+ LT -> lookup' k l
+ GT -> lookup' k r
EQ -> Just x
+lookupAssoc :: Ord k => k -> Map k a -> Maybe (k,a)
+lookupAssoc k t
+ = case t of
+ Tip -> Nothing
+ Bin sz kx x l r
+ -> case compare k kx of
+ LT -> lookupAssoc k l
+ GT -> lookupAssoc k r
+ EQ -> Just (kx,x)
+
-- | /O(log n)/. Is the key a member of the map?
member :: Ord k => k -> Map k a -> Bool
member k m
Nothing -> False
Just x -> True
--- | /O(log n)/. Find the value of a key. Calls @error@ when the element can not be found.
+-- | /O(log n)/. Is the key not a member of the map?
+notMember :: Ord k => k -> Map k a -> Bool
+notMember k m = not $ member k m
+
+-- | /O(log n)/. Find the value at a key.
+-- Calls 'error' when the element can not be found.
find :: Ord k => k -> Map k a -> a
find k m
= case lookup k m of
Nothing -> error "Map.find: element not in the map"
Just x -> x
--- | /O(log n)/. The expression @(findWithDefault def k map)@ returns the value of key @k@ or returns @def@ when
--- the key is not in the map.
+-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns
+-- the value at key @k@ or returns @def@ when the key is not in the map.
findWithDefault :: Ord k => a -> k -> Map k a -> a
findWithDefault def k m
= case lookup k m of
empty
= Tip
--- | /O(1)/. Create a map with a single element.
+-- | /O(1)/. A map with a single element.
singleton :: k -> a -> Map k a
singleton k x
= Bin 1 k x Tip Tip
{--------------------------------------------------------------------
Insertion
- [insert] is the inlined version of [insertWith (\k x y -> x)]
--------------------------------------------------------------------}
-- | /O(log n)/. Insert a new key and value in the map.
+-- If the key is already present in the map, the associated value is
+-- replaced with the supplied value, i.e. 'insert' is equivalent to
+-- @'insertWith' 'const'@.
insert :: Ord k => k -> a -> Map k a -> Map k a
insert kx x t
= case t of
EQ -> Bin sz kx x l r
-- | /O(log n)/. Insert with a combining function.
+-- @'insertWith' f key value mp@
+-- will insert the pair (key, value) into @mp@ if key does
+-- not exist in the map. If the key does exist, the function will
+-- insert the pair @(key, f new_value old_value)@.
insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith f k x m
= insertWithKey (\k x y -> f x y) k x m
+-- | Same as 'insertWith', but the combining function is applied strictly.
+insertWith' :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
+insertWith' f k x m
+ = insertWithKey' (\k x y -> f x y) k x m
+
+
-- | /O(log n)/. Insert with a combining function.
+-- @'insertWithKey' f key value mp@
+-- will insert the pair (key, value) into @mp@ if key does
+-- not exist in the map. If the key does exist, the function will
+-- insert the pair @(key,f key new_value old_value)@.
+-- Note that the key passed to f is the same key passed to 'insertWithKey'.
insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKey f kx x t
= case t of
-> case compare kx ky of
LT -> balance ky y (insertWithKey f kx x l) r
GT -> balance ky y l (insertWithKey f kx x r)
- EQ -> Bin sy ky (f ky x y) l r
+ EQ -> Bin sy kx (f kx x y) l r
--- | /O(log n)/. The expression (@insertLookupWithKey f k x map@) is a pair where
--- the first element is equal to (@lookup k map@) and the second element
--- equal to (@insertWithKey f k x map@).
+-- | Same as 'insertWithKey', but the combining function is applied strictly.
+insertWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
+insertWithKey' f kx x t
+ = case t of
+ Tip -> singleton kx x
+ Bin sy ky y l r
+ -> case compare kx ky of
+ LT -> balance ky y (insertWithKey' f kx x l) r
+ GT -> balance ky y l (insertWithKey' f kx x r)
+ EQ -> let x' = f kx x y in seq x' (Bin sy kx x' l r)
+
+
+-- | /O(log n)/. The expression (@'insertLookupWithKey' f k x map@)
+-- is a pair where the first element is equal to (@'lookup' k map@)
+-- and the second element equal to (@'insertWithKey' f k x map@).
insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a,Map k a)
insertLookupWithKey f kx x t
= case t of
-> case compare kx ky of
LT -> let (found,l') = insertLookupWithKey f kx x l in (found,balance ky y l' r)
GT -> let (found,r') = insertLookupWithKey f kx x r in (found,balance ky y l r')
- EQ -> (Just y, Bin sy ky (f ky x y) l r)
+ EQ -> (Just y, Bin sy kx (f kx x y) l r)
{--------------------------------------------------------------------
Deletion
adjustWithKey f k m
= updateWithKey (\k x -> Just (f k x)) k m
--- | /O(log n)/. The expression (@update f k map@) updates the value @x@
--- at @k@ (if it is in the map). If (@f x@) is @Nothing@, the element is
--- deleted. If it is (@Just y@), the key @k@ is bound to the new value @y@.
+-- | /O(log n)/. The expression (@'update' f k map@) updates the value @x@
+-- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
+-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.
update :: Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
update f k m
= updateWithKey (\k x -> f x) k m
--- | /O(log n)/. The expression (@update f k map@) updates the value @x@
--- at @k@ (if it is in the map). If (@f k x@) is @Nothing@, the element is
--- deleted. If it is (@Just y@), the key @k@ is bound to the new value @y@.
+-- | /O(log n)/. The expression (@'updateWithKey' f k map@) updates the
+-- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing',
+-- the element is deleted. If it is (@'Just' y@), the key @k@ is bound
+-- to the new value @y@.
updateWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
updateWithKey f k t
= case t of
Just x' -> (Just x',Bin sx kx x' l r)
Nothing -> (Just x,glue l r)
+-- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
+-- 'alter' can be used to insert, delete, or update a value in a 'Map'.
+-- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@
+alter :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
+alter f k t
+ = case t of
+ Tip -> case f Nothing of
+ Nothing -> Tip
+ Just x -> singleton k x
+ Bin sx kx x l r
+ -> case compare k kx of
+ LT -> balance kx x (alter f k l) r
+ GT -> balance kx x l (alter f k r)
+ EQ -> case f (Just x) of
+ Just x' -> Bin sx kx x' l r
+ Nothing -> glue l r
+
{--------------------------------------------------------------------
Indexing
--------------------------------------------------------------------}
-- | /O(log n)/. Lookup the /index/ of a key. The index is a number from
-- /0/ up to, but not including, the 'size' of the map.
-lookupIndex :: Ord k => k -> Map k a -> Maybe Int
-lookupIndex k t
- = lookup 0 t
+lookupIndex :: (Monad m,Ord k) => k -> Map k a -> m Int
+lookupIndex k t = case lookup 0 t of
+ Nothing -> fail "Data.Map.lookupIndex: Key not found."
+ Just x -> return x
where
lookup idx Tip = Nothing
lookup idx (Bin _ kx x l r)
where
sizeL = size l
--- | /O(log n)/. Delete the element at /index/. Defined as (@deleteAt i map = updateAt (\k x -> Nothing) i map@).
+-- | /O(log n)/. Delete the element at /index/.
+-- Defined as (@'deleteAt' i map = 'updateAt' (\k x -> 'Nothing') i map@).
deleteAt :: Int -> Map k a -> Map k a
deleteAt i map
= updateAt (\k x -> Nothing) i map
findMin :: Map k a -> (k,a)
findMin (Bin _ kx x Tip r) = (kx,x)
findMin (Bin _ kx x l r) = findMin l
-findMin Tip = error "Map.findMin: empty tree has no minimal element"
+findMin Tip = error "Map.findMin: empty map has no minimal element"
-- | /O(log n)/. The maximal key of the map.
findMax :: Map k a -> (k,a)
findMax (Bin _ kx x l Tip) = (kx,x)
findMax (Bin _ kx x l r) = findMax r
-findMax Tip = error "Map.findMax: empty tree has no maximal element"
+findMax Tip = error "Map.findMax: empty map has no maximal element"
-- | /O(log n)/. Delete the minimal key.
deleteMin :: Map k a -> Map k a
deleteMax (Bin _ kx x l r) = balance kx x l (deleteMax r)
deleteMax Tip = Tip
--- | /O(log n)/. Update the minimal key.
+-- | /O(log n)/. Update the value at the minimal key.
updateMin :: (a -> Maybe a) -> Map k a -> Map k a
updateMin f m
= updateMinWithKey (\k x -> f x) m
--- | /O(log n)/. Update the maximal key.
+-- | /O(log n)/. Update the value at the maximal key.
updateMax :: (a -> Maybe a) -> Map k a -> Map k a
updateMax f m
= updateMaxWithKey (\k x -> f x) m
--- | /O(log n)/. Update the minimal key.
+-- | /O(log n)/. Update the value at the minimal key.
updateMinWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
updateMinWithKey f t
= case t of
Bin sx kx x l r -> balance kx x (updateMinWithKey f l) r
Tip -> Tip
--- | /O(log n)/. Update the maximal key.
+-- | /O(log n)/. Update the value at the maximal key.
updateMaxWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
updateMaxWithKey f t
= case t of
Bin sx kx x l r -> balance kx x l (updateMaxWithKey f r)
Tip -> Tip
+-- | /O(log n)/. Retrieves the minimal (key,value) pair of the map, and the map stripped from that element
+-- @fail@s (in the monad) when passed an empty map.
+minViewWithKey :: Monad m => Map k a -> m ((k,a), Map k a)
+minViewWithKey Tip = fail "Map.minView: empty map"
+minViewWithKey x = return (deleteFindMin x)
+
+-- | /O(log n)/. Retrieves the maximal (key,value) pair of the map, and the map stripped from that element
+-- @fail@s (in the monad) when passed an empty map.
+maxViewWithKey :: Monad m => Map k a -> m ((k,a), Map k a)
+maxViewWithKey Tip = fail "Map.maxView: empty map"
+maxViewWithKey x = return (deleteFindMax x)
+
+-- | /O(log n)/. Retrieves the minimal key\'s value of the map, and the map stripped from that element
+-- @fail@s (in the monad) when passed an empty map.
+minView :: Monad m => Map k a -> m (a, Map k a)
+minView Tip = fail "Map.minView: empty map"
+minView x = return (first snd $ deleteFindMin x)
+
+-- | /O(log n)/. Retrieves the maximal key\'s value of the map, and the map stripped from that element
+-- @fail@s (in the monad) when passed an empty map.
+maxView :: Monad m => Map k a -> m (a, Map k a)
+maxView Tip = fail "Map.maxView: empty map"
+maxView x = return (first snd $ deleteFindMax x)
+
+-- Update the 1st component of a tuple (special case of Control.Arrow.first)
+first :: (a -> b) -> (a,c) -> (b,c)
+first f (x,y) = (f x, y)
{--------------------------------------------------------------------
Union.
--------------------------------------------------------------------}
--- | The union of a list of maps: (@unions == foldl union empty@).
+-- | The union of a list of maps:
+-- (@'unions' == 'Prelude.foldl' 'union' 'empty'@).
unions :: Ord k => [Map k a] -> Map k a
unions ts
= foldlStrict union empty ts
-- | The union of a list of maps, with a combining operation:
--- (@unionsWith f == foldl (unionWith f) empty@).
+-- (@'unionsWith' f == 'Prelude.foldl' ('unionWith' f) 'empty'@).
unionsWith :: Ord k => (a->a->a) -> [Map k a] -> Map k a
unionsWith f ts
= foldlStrict (unionWith f) empty ts
-- | /O(n+m)/.
-- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@.
--- It prefers @t1@ when duplicate keys are encountered, ie. (@union == unionWith const@).
+-- It prefers @t1@ when duplicate keys are encountered,
+-- i.e. (@'union' == 'unionWith' 'const'@).
-- The implementation uses the efficient /hedge-union/ algorithm.
--- Hedge-union is more efficient on (bigset `union` smallset)?
+-- Hedge-union is more efficient on (bigset `union` smallset)
union :: Ord k => Map k a -> Map k a -> Map k a
union Tip t2 = t2
union t1 Tip = t1
-union t1 t2
- | size t1 >= size t2 = hedgeUnionL (const LT) (const GT) t1 t2
- | otherwise = hedgeUnionR (const LT) (const GT) t2 t1
+union t1 t2 = hedgeUnionL (const LT) (const GT) t1 t2
-- left-biased hedge union
hedgeUnionL cmplo cmphi t1 Tip
(found,gt) = trimLookupLo kx cmphi t2
newx = case found of
Nothing -> x
- Just y -> y
+ Just (_,y) -> y
{--------------------------------------------------------------------
Union with a combining function
unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWithKey f Tip t2 = t2
unionWithKey f t1 Tip = t1
-unionWithKey f t1 t2
- | size t1 >= size t2 = hedgeUnionWithKey f (const LT) (const GT) t1 t2
- | otherwise = hedgeUnionWithKey flipf (const LT) (const GT) t2 t1
- where
- flipf k x y = f k y x
+unionWithKey f t1 t2 = hedgeUnionWithKey f (const LT) (const GT) t1 t2
hedgeUnionWithKey f cmplo cmphi t1 Tip
= t1
(found,gt) = trimLookupLo kx cmphi t2
newx = case found of
Nothing -> x
- Just y -> f kx x y
+ Just (_,y) -> f kx x y
{--------------------------------------------------------------------
Difference
-- | /O(n+m)/. Difference with a combining function. When two equal keys are
-- encountered, the combining function is applied to the key and both values.
--- If it returns @Nothing@, the element is discarded (proper set difference). If
--- it returns (@Just y@), the element is updated with a new value @y@.
+-- If it returns 'Nothing', the element is discarded (proper set difference). If
+-- it returns (@'Just' y@), the element is updated with a new value @y@.
-- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/.
differenceWithKey :: Ord k => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
differenceWithKey f Tip t2 = Tip
hedgeDiffWithKey f cmplo cmphi t (Bin _ kx x l r)
= case found of
Nothing -> merge tl tr
- Just y -> case f kx y x of
- Nothing -> merge tl tr
- Just z -> join kx z tl tr
+ Just (ky,y) ->
+ case f ky y x of
+ Nothing -> merge tl tr
+ Just z -> join ky z tl tr
where
cmpkx k = compare kx k
lt = trim cmplo cmpkx t
Intersection
--------------------------------------------------------------------}
-- | /O(n+m)/. Intersection of two maps. The values in the first
--- map are returned, i.e. (@intersection m1 m2 == intersectionWith const m1 m2@).
+-- map are returned, i.e. (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@).
intersection :: Ord k => Map k a -> Map k b -> Map k a
intersection m1 m2
= intersectionWithKey (\k x y -> x) m1 m2
-- | /O(n+m)/. Intersection with a combining function.
-intersectionWith :: Ord k => (a -> b -> a) -> Map k a -> Map k b -> Map k a
+intersectionWith :: Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWith f m1 m2
= intersectionWithKey (\k x y -> f x y) m1 m2
-- | /O(n+m)/. Intersection with a combining function.
-- Intersection is more efficient on (bigset `intersection` smallset)
-intersectionWithKey :: Ord k => (k -> a -> b -> a) -> Map k a -> Map k b -> Map k a
+--intersectionWithKey :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
+--intersectionWithKey f Tip t = Tip
+--intersectionWithKey f t Tip = Tip
+--intersectionWithKey f t1 t2 = intersectWithKey f t1 t2
+--
+--intersectWithKey f Tip t = Tip
+--intersectWithKey f t Tip = Tip
+--intersectWithKey f t (Bin _ kx x l r)
+-- = case found of
+-- Nothing -> merge tl tr
+-- Just y -> join kx (f kx y x) tl tr
+-- where
+-- (lt,found,gt) = splitLookup kx t
+-- tl = intersectWithKey f lt l
+-- tr = intersectWithKey f gt r
+
+
+intersectionWithKey :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWithKey f Tip t = Tip
intersectionWithKey f t Tip = Tip
-intersectionWithKey f t1 t2
- | size t1 >= size t2 = intersectWithKey f t1 t2
- | otherwise = intersectWithKey flipf t2 t1
- where
- flipf k x y = f k y x
-
-intersectWithKey f Tip t = Tip
-intersectWithKey f t Tip = Tip
-intersectWithKey f t (Bin _ kx x l r)
- = case found of
+intersectionWithKey f t1@(Bin s1 k1 x1 l1 r1) t2@(Bin s2 k2 x2 l2 r2) =
+ if s1 >= s2 then
+ let (lt,found,gt) = splitLookupWithKey k2 t1
+ tl = intersectionWithKey f lt l2
+ tr = intersectionWithKey f gt r2
+ in case found of
+ Just (k,x) -> join k (f k x x2) tl tr
+ Nothing -> merge tl tr
+ else let (lt,found,gt) = splitLookup k1 t2
+ tl = intersectionWithKey f l1 lt
+ tr = intersectionWithKey f r1 gt
+ in case found of
+ Just x -> join k1 (f k1 x1 x) tl tr
Nothing -> merge tl tr
- Just y -> join kx (f kx y x) tl tr
- where
- (found,lt,gt) = splitLookup kx t
- tl = intersectWithKey f lt l
- tr = intersectWithKey f gt r
Submap
--------------------------------------------------------------------}
-- | /O(n+m)/.
--- This function is defined as (@submap = submapBy (==)@).
+-- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
isSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool
isSubmapOf m1 m2
= isSubmapOfBy (==) m1 m2
{- | /O(n+m)/.
- The expression (@isSubmapOfBy f t1 t2@) returns @True@ if
- all keys in @t1@ are in tree @t2@, and when @f@ returns @True@ when
+ The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if
+ all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when
applied to their respective values. For example, the following
- expressions are all @True@.
+ expressions are all 'True':
> isSubmapOfBy (==) (fromList [('a',1)]) (fromList [('a',1),('b',2)])
> isSubmapOfBy (<=) (fromList [('a',1)]) (fromList [('a',1),('b',2)])
> isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1),('b',2)])
- But the following are all @False@:
+ But the following are all 'False':
> isSubmapOfBy (==) (fromList [('a',2)]) (fromList [('a',1),('b',2)])
> isSubmapOfBy (<) (fromList [('a',1)]) (fromList [('a',1),('b',2)])
Nothing -> False
Just y -> f x y && submap' f l lt && submap' f r gt
where
- (found,lt,gt) = splitLookup kx t
+ (lt,found,gt) = splitLookup kx t
-- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
--- Defined as (@isProperSubmapOf = isProperSubmapOfBy (==)@).
+-- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).
isProperSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool
isProperSubmapOf m1 m2
= isProperSubmapOfBy (==) m1 m2
{- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
- The expression (@isProperSubmapOfBy f m1 m2@) returns @True@ when
+ The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when
@m1@ and @m2@ are not equal,
- all keys in @m1@ are in @m2@, and when @f@ returns @True@ when
+ all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
applied to their respective values. For example, the following
- expressions are all @True@.
+ expressions are all 'True':
> isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
> isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
- But the following are all @False@:
+ But the following are all 'False':
> isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
> isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
(l1,l2) = partitionWithKey p l
(r1,r2) = partitionWithKey p r
+-- | /O(n)/. Map values and collect the 'Just' results.
+mapMaybe :: Ord k => (a -> Maybe b) -> Map k a -> Map k b
+mapMaybe f m
+ = mapMaybeWithKey (\k x -> f x) m
+
+-- | /O(n)/. Map keys\/values and collect the 'Just' results.
+mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> Map k a -> Map k b
+mapMaybeWithKey f Tip = Tip
+mapMaybeWithKey f (Bin _ kx x l r) = case f kx x of
+ Just y -> join kx y (mapMaybeWithKey f l) (mapMaybeWithKey f r)
+ Nothing -> merge (mapMaybeWithKey f l) (mapMaybeWithKey f r)
+
+-- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
+mapEither :: Ord k => (a -> Either b c) -> Map k a -> (Map k b, Map k c)
+mapEither f m
+ = mapEitherWithKey (\k x -> f x) m
+
+-- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.
+mapEitherWithKey :: Ord k =>
+ (k -> a -> Either b c) -> Map k a -> (Map k b, Map k c)
+mapEitherWithKey f Tip = (Tip, Tip)
+mapEitherWithKey f (Bin _ kx x l r) = case f kx x of
+ Left y -> (join kx y l1 r1, merge l2 r2)
+ Right z -> (merge l1 r1, join kx z l2 r2)
+ where
+ (l1,l2) = mapEitherWithKey f l
+ (r1,r2) = mapEitherWithKey f r
{--------------------------------------------------------------------
Mapping
mapWithKey f (Bin sx kx x l r)
= Bin sx kx (f kx x) (mapWithKey f l) (mapWithKey f r)
--- | /O(n)/. The function @mapAccum@ threads an accumulating
--- argument through the map in an unspecified order.
+-- | /O(n)/. The function 'mapAccum' threads an accumulating
+-- argument through the map in ascending order of keys.
mapAccum :: (a -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
mapAccum f a m
= mapAccumWithKey (\a k x -> f a x) a m
--- | /O(n)/. The function @mapAccumWithKey@ threads an accumulating
--- argument through the map in unspecified order. (= ascending pre-order)
+-- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating
+-- argument through the map in ascending order of keys.
mapAccumWithKey :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
mapAccumWithKey f a t
= mapAccumL f a t
--- | /O(n)/. The function @mapAccumL@ threads an accumulating
--- argument throught the map in (ascending) pre-order.
+-- | /O(n)/. The function 'mapAccumL' threads an accumulating
+-- argument throught the map in ascending order of keys.
mapAccumL :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
mapAccumL f a t
= case t of
(a3,r') = mapAccumL f a2 r
in (a3,Bin sx kx x' l' r')
--- | /O(n)/. The function @mapAccumR@ threads an accumulating
--- argument throught the map in (descending) post-order.
+-- | /O(n)/. The function 'mapAccumR' threads an accumulating
+-- argument throught the map in descending order of keys.
mapAccumR :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
mapAccumR f a t
= case t of
in (a3,Bin sx kx x' l' r')
-- | /O(n*log n)/.
--- @mapKeys f s@ is the map obtained by applying @f@ to each key of @s@.
+-- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
--
--- It's worth noting that the size of the result may be smaller if,
--- for some @(x,y)@, @x \/= y && f x == f y@
+-- The size of the result may be smaller if @f@ maps two or more distinct
+-- keys to the same new key. In this case the value at the smallest of
+-- these keys is retained.
mapKeys :: Ord k2 => (k1->k2) -> Map k1 a -> Map k2 a
mapKeys = mapKeysWith (\x y->x)
-- | /O(n*log n)/.
--- @mapKeysWith c f s@ is the map obtained by applying @f@ to each key of @s@.
+-- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.
--
--- It's worth noting that the size of the result may be smaller if,
--- for some @(x,y)@, @x \/= y && f x == f y@
--- In such a case, the values will be combined using @c@
+-- The size of the result may be smaller if @f@ maps two or more distinct
+-- keys to the same new key. In this case the associated values will be
+-- combined using @c@.
mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1->k2) -> Map k1 a -> Map k2 a
mapKeysWith c f = fromListWith c . List.map fFirst . toList
where fFirst (x,y) = (f x, y)
--- | /O(n)/. The
---
--- @mapMonotonic f s == 'map' f s@, but works only when @f@ is monotonic.
+-- | /O(n)/.
+-- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@
+-- is strictly monotonic.
-- /The precondition is not checked./
-- Semi-formally, we have:
--
-- > and [x < y ==> f x < f y | x <- ls, y <- ls]
--- > ==> mapMonotonic f s == map f s
+-- > ==> mapKeysMonotonic f s == mapKeys f s
-- > where ls = keys s
mapKeysMonotonic :: (k1->k2) -> Map k1 a -> Map k2 a
{--------------------------------------------------------------------
Folds
--------------------------------------------------------------------}
--- | /O(n)/. Fold the map in an unspecified order. (= descending post-order).
+
+-- | /O(n)/. Fold the values in the map, such that
+-- @'fold' f z == 'Prelude.foldr' f z . 'elems'@.
+-- For example,
+--
+-- > elems map = fold (:) [] map
+--
fold :: (a -> b -> b) -> b -> Map k a -> b
fold f z m
= foldWithKey (\k x z -> f x z) z m
--- | /O(n)/. Fold the map in an unspecified order. (= descending post-order).
+-- | /O(n)/. Fold the keys and values in the map, such that
+-- @'foldWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
+-- For example,
+--
+-- > keys map = foldWithKey (\k x ks -> k:ks) [] map
+--
foldWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b
foldWithKey f z t
= foldr f z t
{--------------------------------------------------------------------
List variations
--------------------------------------------------------------------}
--- | /O(n)/. Return all elements of the map.
+-- | /O(n)/.
+-- Return all elements of the map in the ascending order of their keys.
elems :: Map k a -> [a]
elems m
= [x | (k,x) <- assocs m]
--- | /O(n)/. Return all keys of the map.
+-- | /O(n)/. Return all keys of the map in ascending order.
keys :: Map k a -> [k]
keys m
= [k | (k,x) <- assocs m]
keysSet :: Map k a -> Set.Set k
keysSet m = Set.fromDistinctAscList (keys m)
--- | /O(n)/. Return all key\/value pairs in the map.
+-- | /O(n)/. Return all key\/value pairs in the map in ascending key order.
assocs :: Map k a -> [(k,a)]
assocs m
= toList m
fromAscListWith f xs
= fromAscListWithKey (\k x y -> f x y) xs
--- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys
+-- | /O(n)/. Build a map from an ascending list in linear time with a
+-- combining function for equal keys.
-- /The precondition (input list is ascending) is not checked./
fromAscListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a
fromAscListWithKey f xs
-- | /O(n)/. Build a map from an ascending list of distinct elements in linear time.
---
-- /The precondition is not checked./
fromDistinctAscList :: [(k,a)] -> Map k a
fromDistinctAscList xs
le -> trim cmplo cmphi l
ge -> trim cmplo cmphi r
-trimLookupLo :: Ord k => k -> (k -> Ordering) -> Map k a -> (Maybe a, Map k a)
+trimLookupLo :: Ord k => k -> (k -> Ordering) -> Map k a -> (Maybe (k,a), Map k a)
trimLookupLo lo cmphi Tip = (Nothing,Tip)
trimLookupLo lo cmphi t@(Bin sx kx x l r)
= case compare lo kx of
LT -> case cmphi kx of
- GT -> (lookup lo t, t)
+ GT -> (lookupAssoc lo t, t)
le -> trimLookupLo lo cmphi l
GT -> trimLookupLo lo cmphi r
- EQ -> (Just x,trim (compare lo) cmphi r)
+ EQ -> (Just (kx,x),trim (compare lo) cmphi r)
{--------------------------------------------------------------------
{--------------------------------------------------------------------
Split
--------------------------------------------------------------------}
--- | /O(log n)/. The expression (@split k map@) is a pair @(map1,map2)@ where
+-- | /O(log n)/. The expression (@'split' k map@) is a pair @(map1,map2)@ where
-- the keys in @map1@ are smaller than @k@ and the keys in @map2@ larger than @k@. Any key equal to @k@ is found in neither @map1@ nor @map2@.
split :: Ord k => k -> Map k a -> (Map k a,Map k a)
split k Tip = (Tip,Tip)
GT -> let (lt,gt) = split k r in (join kx x l lt,gt)
EQ -> (l,r)
--- | /O(log n)/. The expression (@splitLookup k map@) splits a map just
--- like 'split' but also returns @lookup k map@.
-splitLookup :: Ord k => k -> Map k a -> (Maybe a,Map k a,Map k a)
-splitLookup k Tip = (Nothing,Tip,Tip)
+-- | /O(log n)/. The expression (@'splitLookup' k map@) splits a map just
+-- like 'split' but also returns @'lookup' k map@.
+splitLookup :: Ord k => k -> Map k a -> (Map k a,Maybe a,Map k a)
+splitLookup k Tip = (Tip,Nothing,Tip)
splitLookup k (Bin sx kx x l r)
= case compare k kx of
- LT -> let (z,lt,gt) = splitLookup k l in (z,lt,join kx x gt r)
- GT -> let (z,lt,gt) = splitLookup k r in (z,join kx x l lt,gt)
- EQ -> (Just x,l,r)
+ LT -> let (lt,z,gt) = splitLookup k l in (lt,z,join kx x gt r)
+ GT -> let (lt,z,gt) = splitLookup k r in (join kx x l lt,z,gt)
+ EQ -> (l,Just x,r)
+
+-- | /O(log n)/.
+splitLookupWithKey :: Ord k => k -> Map k a -> (Map k a,Maybe (k,a),Map k a)
+splitLookupWithKey k Tip = (Tip,Nothing,Tip)
+splitLookupWithKey k (Bin sx kx x l r)
+ = case compare k kx of
+ LT -> let (lt,z,gt) = splitLookupWithKey k l in (lt,z,join kx x gt r)
+ GT -> let (lt,z,gt) = splitLookupWithKey k r in (join kx x l lt,z,gt)
+ EQ -> (l,Just (kx, x),r)
+
+-- | /O(log n)/. Performs a 'split' but also returns whether the pivot
+-- element was found in the original set.
+splitMember :: Ord k => k -> Map k a -> (Map k a,Bool,Map k a)
+splitMember x t = let (l,m,r) = splitLookup x t in
+ (l,maybe False (const True) m,r)
+
{--------------------------------------------------------------------
Utility functions that maintain the balance properties of the tree.
- A lower [delta] leads to a more 'perfectly' balanced tree.
- A higher [delta] performs less rebalancing.
- - Balancing is automaic for random data and a balancing
+ - Balancing is automatic for random data and a balancing
scheme is only necessary to avoid pathological worst cases.
Almost any choice will do, and in practice, a rather large
[delta] may perform better than smaller one.
--------------------------------------------------------------------}
instance (Ord k, Ord v) => Ord (Map k v) where
- compare m1 m2 = compare (toList m1) (toList m2)
+ compare m1 m2 = compare (toAscList m1) (toAscList m2)
{--------------------------------------------------------------------
- Monoid
+ Functor
--------------------------------------------------------------------}
+instance Functor (Map k) where
+ fmap f m = map f m
-instance (Ord k) => Monoid (Map k v) where
- mempty = empty
- mappend = union
- mconcat = unions
+instance Traversable (Map k) where
+ traverse f Tip = pure Tip
+ traverse f (Bin s k v l r)
+ = flip (Bin s k) <$> traverse f l <*> f v <*> traverse f r
+
+instance Foldable (Map k) where
+ foldMap _f Tip = mempty
+ foldMap f (Bin _s _k v l r)
+ = foldMap f l `mappend` f v `mappend` foldMap f r
{--------------------------------------------------------------------
- Functor
+ Read
--------------------------------------------------------------------}
-instance Functor (Map k) where
- fmap f m = map f m
+instance (Ord k, Read k, Read e) => Read (Map k e) where
+#ifdef __GLASGOW_HASKELL__
+ readPrec = parens $ prec 10 $ do
+ Ident "fromList" <- lexP
+ xs <- readPrec
+ return (fromList xs)
+
+ readListPrec = readListPrecDefault
+#else
+ readsPrec p = readParen (p > 10) $ \ r -> do
+ ("fromList",s) <- lex r
+ (xs,t) <- reads s
+ return (fromList xs,t)
+#endif
+
+-- parses a pair of things with the syntax a:=b
+readPair :: (Read a, Read b) => ReadS (a,b)
+readPair s = do (a, ct1) <- reads s
+ (":=", ct2) <- lex ct1
+ (b, ct3) <- reads ct2
+ return ((a,b), ct3)
{--------------------------------------------------------------------
Show
--------------------------------------------------------------------}
instance (Show k, Show a) => Show (Map k a) where
- showsPrec d m = showMap (toAscList m)
+ showsPrec d m = showParen (d > 10) $
+ showString "fromList " . shows (toList m)
showMap :: (Show k,Show a) => [(k,a)] -> ShowS
showMap []
= showChar '{' . showElem x . showTail xs
where
showTail [] = showChar '}'
- showTail (x:xs) = showChar ',' . showElem x . showTail xs
+ showTail (x:xs) = showString ", " . showElem x . showTail xs
- showElem (k,x) = shows k . showString ":=" . shows x
+ showElem (k,x) = shows k . showString " := " . shows x
-- | /O(n)/. Show the tree that implements the map. The tree is shown
showElem k x = show k ++ ":=" ++ show x
-{- | /O(n)/. The expression (@showTreeWith showelem hang wide map@) shows
+{- | /O(n)/. The expression (@'showTreeWith' showelem hang wide map@) shows
the tree that implements the map. Elements are shown using the @showElem@ function. If @hang@ is
- @True@, a /hanging/ tree is shown otherwise a rotated tree is shown. If
- @wide@ is true, an extra wide version is shown.
+ 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If
+ @wide@ is 'True', an extra wide version is shown.
> Map> let t = fromDistinctAscList [(x,()) | x <- [1..5]]
> Map> putStrLn $ showTreeWith (\k x -> show (k,x)) True False t
withBar bars = "| ":bars
withEmpty bars = " ":bars
+{--------------------------------------------------------------------
+ Typeable
+--------------------------------------------------------------------}
+
+#include "Typeable.h"
+INSTANCE_TYPEABLE2(Map,mapTc,"Map")
{--------------------------------------------------------------------
Assertions
projects / haskell-directory.git / blobdiff