# Data.FiniteMap proposed addition, bug fix

Graham Klyne GK at ninebynine.org
Tue Nov 9 10:22:53 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?

red herring.  (I got it in my head that when reversing the parameters to
optimize the hedge union, I needed to reverse the monad ordering.  Duh!)

So the two sets of functions for hedgeUnionWithKeyM* were unnecessary,

#g
--

[[
{--------------------------------------------------------------------
--------------------------------------------------------------------}

-- | /O(n+m)/.  Monadic version of union with a combining function.
--   The implementation uses the efficient /hedge-union/ algorithm.
--
--   The combining 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

-- | /O(n+m)/.  Monadic version of @unionWithKey at .
--   The implementation uses the efficient /hedge-union/ algorithm.
--
--   See @unionWithM@ for further details.
--
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           = hedgeUnionWithKeyML flipf (const LT) (const GT)
t2 t1
where
flipf k x y   = f k y x

-- Left version of monadic hedgeUnionWithKey.
--
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

-- 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"])]
-- 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
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"])]
fmt1 = unionWithM comb fm1 fm2 == fm12
fmt2 = unionWithM comb fm1 fm3 == fm13
fmt3 = unionWithM comb fm2 fm3 == fm23
-- Test function uses state to accumulate combined keys
combk :: k -> [a] -> [a] -> State.State [k] [a]
combk k ov nv = State.State (\s -> (ov++nv,s++[k]))
fmk12 = ( fromList [(1,["a","b","c"]),(2,["b","c"]),(3,["d"]),(4,["e"])]
, [1] )
fmk13 = (fromList [(1,["a","d","e"]),(2,["b","c","c","d"]),(3,["d"]),(4,["f"])]
,[1,2] )
fmk23 = (fromList [(1,["b","c","d","e"]),(2,["c","d"]),(4,["e","f"])]
,[1,4])
fmt4  = State.runState (unionWithKeyM combk fm1 fm2) [] == fmk12
fmt5  = State.runState (unionWithKeyM combk fm1 fm3) [] == fmk13
fmt6  = State.runState (unionWithKeyM combk fm2 fm3) []  == fmk23
fmtall = and [fmt1,fmt2,fmt3,fmt4,fmt5,fmt6]
]]

------------
Graham Klyne
For email:
http://www.ninebynine.org/#Contact

_______________________________________________
Libraries mailing list