Deconstructing foldr
edit
1.
-- We start from:
foldMap g = mconcat . fmap g
foldMap g = foldr mappend mempty . fmap g -- mconcat definition
-- Which can be simplified to:
foldMap f = foldr (mappend . f) mempty
-- Or, more pointfully:
foldMap f xs = foldr (\x z -> f x <> z) mempty xs
-- Alternatively (via the definition of foldr):
foldMap _ [] = mempty
foldMap g (x:xs) = g x <> foldMap g xs
The Foldable
class
edit
1.
A summary of the answers. Subtle issues are explained in the notes just below.
Fold | mempty
|
mappend
|
Preliminary function |
newtype fromData.Monoid |
Notes |
---|---|---|---|---|---|
product |
1 |
(*) |
Product |
||
concat |
[] |
(++) |
|||
concatMap f |
[] |
(++) |
f |
||
all p |
True |
(&&) |
p |
All |
|
elem x |
False |
(||) |
(== x) |
Any |
|
length |
0 |
(+) |
const 1 |
Sum |
|
traverse_ f |
pure () |
(*>) |
void . f |
See [i] | |
mapM_ f |
return () |
(>>) |
void . f |
See [i] | |
safeMaximum |
Nothing |
max' Nothing m = m max' m Nothing = m max' (Just x) (Just y) = Just (max x y) |
See [ii] | ||
find p |
Nothing |
leftmost Just |
\x -> if p x then Just x else Nothing |
First |
See [iii] |
composeL f |
id |
flip (.) |
flip f |
Dual . Endo |
See [iv] |
Notes:
[i]: The monoid here is of type Applicative f => f ()
. The function void
(defined as fmap (const ())
in Data.Functor) is needed to convert the inner values of the actions to ()
, thereby discarding the inner values. This conversion is not needed with an implementation in terms of foldr
(as the actual one is); however, for a foldMap
that isn't the generic one using Endo
, we would need to either discard the results using void
(as done above) or create a wrapper which forgets the result type. The latter trick (a rather advanced one, in fact) uses a feature called existential quantification, and might look like this:
{-# LANGUAGE ExistentialQuantification #-} -- First line of the source file.
-- forall a. causes the type to be forgotten.
data NoResults f = forall a. NoResults (f a)
runNoResults :: Applicative f => NoResults f -> f ()
runNoResults (NoResults u) = const () <$> u
instance Applicative f => Monoid (NoResults f) where
mempty = NoResults (pure ())
NoResults u `mappend` NoResults v = NoResults (u *> v)
While this is a stylish solution, it creates a host of complications − we can't use newtype
nor records, and we still need one fmap (const ())
for extracting the final action. So take this approach merely as a curio.
On a more reasonable note, mapM_
only differs from traverse_
in the type signature, as return = pure
and (>>) = (*>)
. That also mean the observations above apply to it as well.
[ii]: max :: Ord a => a -> a -> a
evaluates to the largest of its two arguments, and max' :: Ord a => Maybe a -> Maybe a -> Maybe a
is similar but involves Maybe
. The usage of Maybe
here is just a trick to add an extra value of Nothing
to the type a
so that max'
can become a legal mappend
. Nothing
, as mempty
, is the identity of max'
, and hence acts as a value that is less than or equal to all values in a
(e.g. something like negative infinity for the integers). This monoid may be implemented with the wrapper Max
as follows (and in fact something like this is used internally in the default implementation of maximum
from Data.Foldable).
newtype Max a = Max { unMax :: Maybe a }
instance Ord a => Monoid (Max a) where
mempty = Max Nothing
Max Nothing `mappend` x = x
x `mappend` Max Nothing = x
Max (Just x) `mappend` Max (Just y) = Max $ Just $ max x y
-- safeMaximum can then be written
safeMaximum = unMax . foldMap (Max . Just)
Note that liftA2 max
cannot be used as mappend
, since liftA2 max Nothing x = Nothing
, and therefore Nothing
is not the identity of liftA2 max
as required by the monoid laws.
[iii]: By "leftmost Just
", we mean:
Just x `mappendFirst` _ = Just x
_ `mappendFirst` Just y = Just y
_ `mappendFirst` _ = Nothing
The mirrored alternative would be:
_ `mappendLast` Just y = Just y
Just x `mappendLast` _ = Just x
_ `mappendLast` _ = Nothing
They are implemented through the First
and Last
newtype
wrappers from Data.Monoid respectively.
[iv]: That is a condensed version of the solution to the foldl
exercise in Higher-order functions. Dual
is a Data.Monoid
wrapper which flip
s the mappend
of a wrapped Monoid
.
List-like folding
edit1a.
instance Foldable Tree where
foldMap f t = case t of
Leaf x -> f x
Branch tl tr -> foldMap f tl <> foldMap f tr
1b.
-- Using the catamorphism
-- treeFold :: (b -> b -> b) -> (a -> b) -> Tree a -> b
treeDepth :: Tree a -> Int
treeDepth = treeFold (\dl dr -> 1 + max dl dr) (const 0)
It is impossible to implement treeDepth
using Foldable
. Folding a tree like a list destroys information about the structure of the branches. That can be clearly displayed by finding a pair of trees with different structures but which are converted to equal lists by toList
.
More facts about Foldable
edit
1a.
instance (Monoid a, Monoid b) => Monoid (a,b) where
mempty = (mempty, mempty)
(x1, y1) `mappend` (x2, y2) = (x1 `mappend` x2, y1 `mappend` y2)
1b.
-- For given a and b
-- f :: (Monoid a, Monoid b) => a -> b
-- If f is a monoid homomorphism, then
-- f mempty = mempty
-- f (x <> y) = f x <> f y
fst (mempty, mempty) = mempty -- Target
fst (mempty, mempty) -- LHS
mempty -- Q.E.D
fst ((x1, y1) <> (x2, y2)) = fst (x1, y1) <> fst (x2, y2)
fst (x1 <> x2, y1 <> y2) = x1 <> x2
x1 <> x2 = x1 <> x2 -- Q.E.D
1c.
foldMap f &&& foldMap g = foldMap (f &&& g) -- Target
-- f &&& g = \x -> (f x, g x)
(\x -> (foldMap f x, foldMap g x)) = foldMap (\x -> (f x, g x)) -- Target 2
-- Target 2 holds if the following hold:
fst . (\x -> (foldMap f x, foldMap g x)) = fst . foldMap (\x -> (f x, g x)) -- Target 3a
snd . (\x -> (foldMap f x, foldMap g x)) = snd . foldMap (\x -> (f x, g x)) -- Target 3b
-- From Target 3a, using the monoid homomorphism property:
fst . (\x -> (foldMap f x, foldMap g x)) = foldMap (fst . (\x -> (f x, g x)))
foldMap f = foldMap f -- OK
-- From Target 3b, using the monoid homomorphism property:
snd . (\x -> (foldMap f x, foldMap g x)) = foldMap (snd . (\x -> (f x, g x)))
foldMap g = foldMap g -- OK
-- Q.E.D (both Target 3a and Target 3b hold.)