[Haskell-cafe] Could someone teach me why we use Data.Monoid?

Daniel Schüssler anotheraddress at gmx.de
Sun Nov 15 01:51:35 EST 2009


Hi,

>  - Product (a,b) and co-product (Either) of monoids

the coproduct of monoids is actually a bit tricky. It could be implemented 
like this:

-- | 
-- Invariant 1: There are never two adjacent Lefts or two adjacent Rights
-- Invariant 2: No elements (Left mempty) or (Right mempty) allowed
newtype Coprod m1 m2 = C [Either m1 m2]
 
instance (Eq m1, Eq m2, Monoid m1, Monoid m2) => Monoid (Coprod m1 m2) where
	mempty = C []
	mappend (C x1) (C x2) = C (normalize (x1 ++ x2))

normalize [] = []
normalize (Left a0 : as)  | a0 == mempty = normalize as
normalize (Right a0 : as) | a0 == mempty = normalize as
normalize [a] = [a]
normalize (Left a0 : Left a1 : as) = Left (mappend a0 a1) : normalize as
normalize (Right a0 : Right a1 : as) = Right (mappend a0 a1) : normalize as
normalize (a0:as) = a0 : normalize as

inl x = normalize [Left x]
inr x = normalize [Right x]

fold :: (Monoid m1, Monoid m2, Monoid n) =>
		 (m1 -> n) -> (m2 -> n) -> Coprod m1 m2 -> n
fold k1 k2 = foldMap (either k1 k2)

------------------
Alternative version, possibly more efficient? Represent directly as fold:
------------------
newtype Coprod m1 m2 = C (forall n. Monoid n => (m1 -> n) -> (m2 -> n) -> n)

instance Monoid (Coprod m1 m2) where
  mempty = C (\_ _ -> mempty)
  mappend (C x) (C x') = 
	C (\k1 k2 -> mappend (x k1 k2) (x' k1 k2))

inl x = C (\k1 _ -> k1 x)
inr x = C (\_ k2 -> k2 x) 

------------------

Question: in the mappend of the second version, we have a choice: We could 
also, when possible, multiply on the *inside*, that is *before* applying 
k1/k2:
-------------------
mappend (C x) (C x') =
 C (\k1 k2 ->
	 x (\m1 -> x' (\m1' -> k1 (mappend m1 m1')
				    (\m2' -> mappend (k1 m1) (k2 m2'))
      (\m2 -> x' (\m1' -> mappend (k2 m2) (k1 m1'))
                 (\m2' -> k2 (mappend m2 m2')))
-------------------

Now I don't know what the efficiency implications of the two different 
versions are :) Apparently it depends on the relative costs of mappend in 
m1/m2 vs. n, and the cost of computing k1/k2?

Greetings,
Daniel


More information about the Haskell-Cafe mailing list