Map library
Jan-Willem Maessen
jmaessen at alum.mit.edu
Fri Jun 3 11:27:14 EDT 2005
On Jun 2, 2005, at 10:29 AM, Mario Blazevic wrote:
> ...
> 3. The Data.Map looks much better than the FiniteMap library, and its
> export list is very complete. There are, however, two (or four) more
> functions that would be really nice to have in there, as they are
> impossible to write efficiently with the functions currently provided:
>
>
> mapFilter :: (a -> Maybe b) -> Map k a -> Map k b
> mapFilter f = map Maybe.fromJust . filter Maybe.isJust . map f
>
> mapPartition :: (a -> Either b c) -> Map k a -> (Map k b, Map k c)
> mapPartition f = removeTags . partition isLeft . map f
> where isLeft (Either.Left _) = True
> isLeft (Either.Right _) = False
> removeTags (leftMap, rightMap) = (map (\ (Left x) ->
> x) leftMap,
> map (\ (Right x) ->
> x) rightMap)
Having worked on implementing, eg. IntSet in terms of FiniteMap-type
code + UInt32 bitmaps at the nodes, I eventually hit on a basic set of
functions which seem to let you do everything. Here in a descriptive
(but possibly buggy) notation:
data Found a = Keep | Modify a | Delete
data Missing a = Omit | Insert a
lookupLike :: (Ord k) =>
(r, Missing a) -> -- What to do to map when the
key is not found
(a -> (r, Found a)) -> -- What to do to map when the
key is found
k -> Map k a -> (r, Map k a)
lookupLike can be used to do arbitrarily nasty update, insertion, and
deletion actions. The "Keep" and "Omit" actions allow fast return
without re-allocation if nothing changes.
It can also be used to perform pure lookup of all kinds, though it'll
generally be unacceptably clunky.
We really should add a "k" argument to both the found and not found
actions to be completely general---but this only matters if equality
throws away information that is actually important, for example if
we're being perverse and stashing our value in the key.
type MapOrFilter k a b = k -> a -> Maybe b
mapFilterLike :: (Ord k) =>
MapOrFilter k a b ->
Map k a -> Map k b
This is basically the mapFilter from above, with the key argument
thrown in. From this we can get arbitrary generalizations of map and
filter.
mapPartition from above, again with an additional key argument, should
be the only splitter you ever need.
data UpdateAction k a b where
Discard :: UpdateAction k a b
NoUpdate :: UpdateAction k a a
UpdateWith :: MapOrFilter k a b -> UpdateAction k a b
joinLike :: (Ord k) =>
UpdateAction k a c -> -- What to do with elements only
in first map
UpdateAction k b c -> -- What to do with elements only
in second map
(k -> a -> b -> Maybe c) -> -- How to combine elements in
both maps
Map k a -> Map k b -> Map k c
This can be used to implement union, intersection, difference, union
with combine, and so forth. Alas, the complexity of an UpdateAction is
required, since NoUpdate and Discard can change the asymptotic
complexity of the join relative to doing everything using MapOrFilter.
Technically, of course, we can replace the type UpdateAction k a b with
an equivalent function Map k a -> Map k b, but that doesn't clearly
convey the intention.
So, anyone bold enough to put these "most general possible" functions
into a Map implementation? I'm guessing there won't be general
agreement on the names / types of the actions, but the general idea is
tested and sound.
-Jan-Willem Maessen
More information about the Glasgow-haskell-users
mailing list