Data.FiniteMap proposed addition, bug fix

[Graham Klyne]

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