Proposed addition to Data.FiniteMap
Graham Klyne
gk at ninebynine.org
Tue Nov 9 09:35:15 EST 2004
At 13:06 09/11/04 +0000, Simon Marlow wrote:
>On 09 November 2004 12:45, Graham Klyne wrote:
>
> > I'd like to propose an addition to the FiniteMap module in the form
> > of a monadic version of plusFM_C. The proposed implementation is
> > pretty much a copy of the existing implementation within a do block.
>
>Data.FiniteMap will shortly be deprecated in favour of DData.Map (which
>will be renamed to Data.Map when it is imported). Perhaps you'd like to
>reformulate the proposal using Data.Map instead?
OK, the proposed addition is below. I haven't fully tested the monad
threading order.
(Hmm.. using a state monad to collect a list of keys might be a way to do
that.)
Deprecation notwithstanding, given that FiniteMap is the current library
module, and that it would be nice if my code works out-of-the-box with the
next public release of the libraries, would there be any objection to also
adding my original proposal to the current FiniteMap module?
#g
--
Proposed addition:
[[
{--------------------------------------------------------------------
Monadic union
--------------------------------------------------------------------}
-- | Monadic version of union with a combining function.
--
-- The combiner function returns a monadic value, which is threaded though
-- the combined elements in key order, yielding a Map that is bound
-- to the same monadic type. The intended use for this is with a Maybe
-- monad, allowing result returned to be Nothing if any of the attempted
-- combinations of key values return Nothing. Could also be usefully used
-- with an error or state monad.
--
unionWithM :: (Ord k, Monad m) =>
(a -> a -> m a) -> Map k a -> Map k a -> m (Map k a)
unionWithM f m1 m2
= unionWithKeyM (\k x y -> f x y) m1 m2
-- | Monadic version of unionWithKey.
--
-- (See unionWithM)
--
unionWithKeyM :: (Ord k, Monad m) =>
(k -> a -> a -> m a) -> Map k a -> Map k a -> m (Map k a)
unionWithKeyM f Tip t2 = return t2
unionWithKeyM f t1 Tip = return t1
unionWithKeyM f t1 t2
-- hedge-union is more efficient on (bigset `union` smallset)
| size t1 >= size t2 = hedgeUnionWithKeyML f (const LT) (const GT) t1 t2
| otherwise = hedgeUnionWithKeyMR f (const LT) (const GT) t2 t1
-- Left version of monadic hedgeUnionWithKey
-- (Monad is threaded left-to-right in tree)
hedgeUnionWithKeyML :: (Ord k, Monad m) =>
(k -> a -> a -> m a) -> (k -> Ordering) -> (k -> Ordering) -> Map k a
-> Map k a
-> m (Map k a)
hedgeUnionWithKeyML f cmplo cmphi t1 Tip
= return t1
hedgeUnionWithKeyML f cmplo cmphi Tip (Bin _ kx x l r)
= return $ join kx x (filterGt cmplo l) (filterLt cmphi r)
hedgeUnionWithKeyML f cmplo cmphi (Bin _ kx x l r) t2
= do { newl <- hedgeUnionWithKeyML f cmplo cmpkx l lt
; newx <- case found of
Nothing -> return x
Just y -> f kx x y
; newr <- hedgeUnionWithKeyML f cmpkx cmphi r gt
; return $ join kx newx newl newr
}
where
cmpkx k = compare kx k
lt = trim cmplo cmpkx t2
(found,gt) = trimLookupLo kx cmphi t2
-- Right version of monadic hedgeUnionWithKey
-- (Monad is threaded Right-to-Left in tree)
hedgeUnionWithKeyMR :: (Ord k, Monad m) =>
(k -> a -> a -> m a) -> (k -> Ordering) -> (k -> Ordering) -> Map k a
-> Map k a
-> m (Map k a)
hedgeUnionWithKeyMR f cmplo cmphi t1 Tip
= return t1
hedgeUnionWithKeyMR f cmplo cmphi Tip (Bin _ kx x l r)
= return $ join kx x (filterGt cmplo l) (filterLt cmphi r)
hedgeUnionWithKeyMR f cmplo cmphi (Bin _ kx x l r) t2
= do { newr <- hedgeUnionWithKeyMR f cmpkx cmphi r gt
; newx <- case found of
Nothing -> return x
Just y -> f kx y x
; newl <- hedgeUnionWithKeyMR f cmplo cmpkx l lt
; return $ join kx newx newl newr
}
where
cmpkx k = compare kx k
lt = trim cmplo cmpkx t2
(found,gt) = trimLookupLo kx cmphi t2
-- And some test cases:
fm1 = fromList [(1,["a"]),(2,["b","c"]),(3,["d"])]
fm2 = fromList [(1,["b","c"]),(4,["e"])]
fm3 = fromList [(1,["d","e"]),(2,["c","d"]),(4,["f"])]
fm12 = Just $ fromList [(1,["a","b","c"]),(2,["b","c"]),(3,["d"]),(4,["e"])]
fm13 = Nothing
fm23 = Just $ fromList [(1,["b","c","d","e"]),(2,["c","d"]),(4,["e","f"])]
-- Test function returns Nothing if list values have a member in common:
comb ovs nvs | null (List.intersect ovs nvs) = Just (ovs++nvs)
| otherwise = Nothing
fmt1 = unionWithM comb fm1 fm2 == fm12
fmt2 = unionWithM comb fm1 fm3 == fm13
fmt3 = unionWithM comb fm2 fm3 == fm23
fmtall = and [fmt1,fmt2,fmt3]
]]
------------
Graham Klyne
For email:
http://www.ninebynine.org/#Contact
More information about the Libraries
mailing list