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@. -- 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@haskell.org http://www.haskell.org/mailman/listinfo/libraries ------------ Graham Klyne For email: http://www.ninebynine.org/#Contact