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?
I added tests for the monad threading order, and realized it was a complete
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,
unless it really is desired to have right-to-left monad threading
#g
--
Proposed addition:
[[
{--------------------------------------------------------------------
Monadic union
--------------------------------------------------------------------}
-- | /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.
-- (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
-- 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
Libraries at haskell.org
http://www.haskell.org/mailman/listinfo/libraries
------------
Graham Klyne
For email:
http://www.ninebynine.org/#Contact
More information about the Libraries
mailing list