Haskell insights

Question

I have found myself in a dire need of your insights.

Here's my object of interest:

class Mergable m where
    merge :: m -> m -> Maybe m
    mergeList :: [m] -> [m]

    mergeList [] = []
    mergeList [x] = [x]
    mergeList (x:y:t) = r1 ++ mergeList (r2 ++ t)
        where
            (r1,r2) = case (x `merge` y) of
                Just m  -> ([ ], [m])
                Nothing -> ([x], [y])

But I'll come back to it later. For now I prepared some examples:

data AffineTransform = Identity
                     | Translation Float Float
                     | Rotation Float
                     | Scaling Float Float
                     | Affine Matrix3x3

instance Monoid AffineTransform where
    mempty = Identity

    Identity `mappend` x = x
    x `mappend` Identity = x
    (Translation dx1 dy1) `mappend` (Translation dx2 dy2) = Translation (dx1+dx2) (dy1+dy2)
    (Rotation theta1) `mappend` (Rotation theta2) = Rotation (theta1+theta2)
    (Scaling sx1 sy1) `mappend` (Scaling sx2 sy2) = Scaling (sx1*sx2) (sy1*sy2)

    -- last resort: compose transforms from different subgroups 
    -- using an "expensive" matrix multiplication
    x `mappend` y = Affine (toMatrix x `mult3x3` toMatrix y) 

So now I can do:

toMatrix $ Rotation theta1 `mappend` Translation dx1 dy1 `mappend` Translation dx2 dy2 `mappend` Rotation theta2

or more briefly:

(toMatrix . mconcat) [Rotation theta1, Translation dx1 dy1, Translation dx2 dy2, Rotation theta2]

or more generally:

(toMatrix . (fold[r|r'|l|l'] mappend)) [Rotatio...], etc

In the above examples the first rotation and translation will be combined (expensively) to a matrix; then, that matrix combined with translation (also using multiplication) and then once again a multiplication will be used to produce the final result, even though (due to associativity) two translations in the middle could be combined cheaply for a total of two multiplications instead of three.

Anyhow, along comes my Mergable class to the rescue:

instance Mergable AffineTransform where
    x `merge` Identity = Just x
    Identity `merge` x = Just x
    x@(Translation _ _) `merge` y@(Translation _ _) = Just $ x `mappend` y
    x@(Rotation _) `merge` y@(Rotation _) = Just $ x `mappend` y
    x@(Scaling _ _) `merge` y@(Scaling _ _) = Just $ x `mappend` y
    _ `merge` _ = Nothing

so now (toMatrix . mconcat . mergeList) ~ (toMatrix . mconcat), as it should:

mergeList [Rotation theta1, Translation dx1 dy1, Translation dx2 dy2, Rotation theta2] == [Rotation theta1, Translation (dx1+dx2) (dy1+dy2), Rotation theta2]

Other examples I have in mind are more involved (code-wise) so I will just state the ideas.

Let's say I have some

data Message = ...

and a

dispatch :: [Message] -> IO a

where dispatch takes a message from the list, depending on it's type opens an appropriate channel (file, stream, etc), writes that message, closes the channel and continues with next message. So if opening and closing channels is an "expensive" operation, simply composing (dispatch . mergeList) can help improve performance with minimal effort.

Other times i have used it to handle events in gui applications like merging mousemoves, key presses, commands in an undo-redo system, etc.

The general pattern is that i take two items from the list, check if they are "mergeable" in some way and if so try to merge the result with the next item in the list or otherwise I leave the first item as it were and continue with the next pair (now that i think of it's a bit like generalized run length encoding)

My problem is that I can't shake the feeling that I'm reinventing the wheel and there has to be a similar structure in haskell that i could use. If that's not the case then:

1) How do I generalize it to other containers other than lists? 2) Can you spot any other structures Mergable is an instance of? (particularly Arrows if applicable, i have trouble wrapping my head around them) 3) Any insights on how strict/lazy should mergeList be and how to present it to user? 4) Optimization tips? Stackoverflow? Anything else?

Thanks!

Answer 1

I don't think there is anything like this already in a library. Hoogle and Hayoo don't turn up anything suitable.

Mergeable (I think it's spelt that way) looks like a generalisation of Monoid. Not an Arrow, sorry.

Sometimes you need to merge preserving order. Sometimes you don't need to preserve order when you merge.

I might do something like

newtype MergedInOrder a = MergedInOrder [a] -- without exporting the constructor

mergeInOrder :: Mergeable a => [a] -> MergedInOrder a
mergeInOrder = MergedInOrder . foldr f []
  where f x []            = [x]
        f x xs @ (y : ys) = case merge x y of
                                 Just z  -> z : ys
                                 Nothing -> x : xs

and similar newtypes for unordered lists, that take advantage of and do not require an Ord instance, respectively.

These newtypes have obvious Monoid instances.

I don't think we can write code to merge arbitrary containers of Mergeables, I think it would have to be done explicitly for each container.

Answer 2

Here was my first thought. Notice "deriving Ord". Otherwise this first section is almost exactly the same as some of the code you presented:

import Data.Monoid import Data.List

data AffineTransform = Identity
                     | Translation Float Float
                     | Rotation Float
                     | Scaling Float Float
                     | Affine Matrix3x3
                     deriving (Eq, Show, Ord)

-- some dummy definitions to satisfy the typechecker
data Matrix3x3 = Matrix3x3
               deriving (Eq, Show, Ord)

toMatrix :: AffineTransform -> Matrix3x3
toMatrix _ = Matrix3x3

mult3x3 :: Matrix3x3 -> Matrix3x3 -> Matrix3x3
mult3x3 _ _ = Matrix3x3

instance Monoid AffineTransform where
    mempty = Identity

    Identity `mappend` x = x
    x `mappend` Identity = x
    (Translation dx1 dy1) `mappend` (Translation dx2 dy2) =
      Translation (dx1+dx2) (dy1+dy2)
    (Rotation theta1) `mappend` (Rotation theta2) = Rotation (theta1+theta2)
    (Scaling sx1 sy1) `mappend` (Scaling sx2 sy2) = Scaling (sx1*sx2) (sy1*sy2)

    -- last resort: compose transforms from different subgroups 
    -- using an "expensive" matrix multiplication
    x `mappend` y = Affine (toMatrix x `mult3x3` toMatrix y)

And now, the kicker:

mergeList :: [AffineTransform] -> [AffineTransform]
mergeList = map mconcat . groupBy sameConstructor . sort
  where sameConstructor Identity Identity                   = True
        sameConstructor (Translation _ _) (Translation _ _) = True
        sameConstructor (Rotation _) (Rotation _)           = True
        sameConstructor (Scaling _ _) (Scaling _ _)         = True
        sameConstructor (Affine _) (Affine _)               = True
        sameConstructor _ _                                 = False

Assuming that translations, rotations, and scalings are orthagonal, why not reorder the list and group up all of those same operations together? (Is that a bad assumption?) That is the Haskell pattern that I saw: the good ol' group . sort trick. If you really want, you could pull sameConstructor out of mergeList:

mergeList :: (Monoid a, Ord a) => (a -> a -> Bool) -> [a] -> [a]
mergeList f = map mconcat . groupBy f . sort

P.S. if that was a bad assumption, then you could still do something like

mergeList = map mconcat . groupBy canMerge

But it seems to me that there is unusual overlap between merge and mappend the way you defined them.