Original author: David Banas capn.freako@gmail.com
Original date: February 7, 2016
Copyright (c) 2016 David Banas; all rights reserved World wide.
This jupyter notebook contains some thoughts and code, regarding the relationships between Applicative and Monoid, as well as between traverse and foldMap.
I'd like to thank both Conal Elliott and David Feuer for engaging with me on this topic, and for suggesting helpful exercises to help me clarify my understanding.
In [1]:
import Data.Time
putStrLn "Notebook last run:"
getCurrentTime
This all started, when I was attempting to answer a question posed by Brent Yorgey in Exercise 11.2.1 of his Typeclassopedia paper:
There are at least two natural ways to turn a tree of lists into a list of trees. What are they, and why?
I guessed (mistakenly I suspect, now) that Brent was really asking me to define two different Monoid instances for the data type, Tree, and then implement traverse, via foldMap, for each, making use of those instances. (I guessed this, because the exercises in the previous section of Brent's paper (Foldable) were all about creating the Monoid instances necessary to write elegant implementations of certain basic functions, via foldMap.)
In [2]:
data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
deriving (Show, Eq)
instance Functor Tree where
fmap g Empty = Empty
fmap g (Leaf x) = Leaf (g x)
fmap g (Node t1 x t2) = Node (fmap g t1) (g x) (fmap g t2)
-- instance Applicative Tree where
-- pure = Leaf
-- _ <*> Empty = Empty
-- Empty <*> _ = Empty
-- g <*> (Leaf x) = Empty
instance Foldable Tree where
foldMap f Empty = mempty
foldMap f (Leaf x) = f x
foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r
-- The "stock" Traversable instance for Tree, taken from the literature.
instance Traversable Tree where
sequenceA Empty = pure Empty
sequenceA (Leaf f) = Leaf <$> f
sequenceA (Node t1 f t2) = Node <$> (sequenceA t1) <*> f <*> (sequenceA t2)
In [3]:
import Data.Foldable ({-toList,-} fold)
-- import Control.Applicative (liftA)
import Data.Monoid (Sum (..))
newtype FTree f a = FTree {getTree :: Tree (f a)}
deriving (Show, Eq)
instance (Functor f) => Functor (FTree f) where
fmap g = FTree . (fmap . fmap) g . getTree
instance Foldable f => Foldable (FTree f) where
-- foldMap :: (Monoid m) => (a -> m) -> f a -> m
-- foldMap g fa = ?
-- g :: a -> m
-- fa :: FTree f a
-- getTree fa :: Tree (f a)
-- foldMap g :: f a -> m
-- foldMap (foldMap g) (getTree fa) :: m
-- foldMap g fa = foldMap (foldMap g) (getTree fa)
-- foldMap g = foldMap (foldMap g) . getTree
foldMap g = (foldMap . foldMap) g . getTree
-- instance Monoid (f a) => Applicative f where
-- pure _ = mempty
-- (<*>) = mappend
t = Node (Leaf [Sum 1, Sum 2, Sum 3]) [Sum 4, Sum 5] (Leaf [Sum 6])
ft = FTree t
fold ft
In [4]:
import Data.Functor.Identity (Identity (..))
import Data.Functor.Compose (Compose (..))
instance Traversable f => Traversable (FTree f) where
-- traverse :: Applicative g => (a -> g b) -> FTree f a -> g (FTree f b)
-- traverse h t = ?
-- h :: a -> g b
-- t :: FTree f a
-- getTree t :: Tree (f a)
-- traverse h :: Traversable t1 => t1 a -> g (t1 b)
-- traverse (traverse h) :: Traversable t2 => t2 (t1 a) -> g (t2 (t1 b))
-- traverse (traverse h) (getTree t) :: g (Tree (f b))
-- ..?
-- res = FTree <$> (u (v :: Tree (f b)) :: g (Tree (f b)))
--
-- Alternatively:
-- y = FTree (x :: Tree (f b)) :: FTree f b
-- res = pure y
-- but, I don't think so.
--
-- res :: g (FTree f b)
-- traverse h t = FTree <$> traverse (traverse h) (getTree t)
-- traverse h = fmap FTree . (traverse . traverse) h . getTree
-- traverse h = mapFTree $ (traverse . traverse) h
traverse = mapFTree . (traverse . traverse)
mapFTree g = fmap FTree . g . getTree
-- Test the laws:
t' = Node (Leaf [1]) [4] (Leaf [6])
ft' = FTree t'
traverse Identity ft' == Identity ft'
f = Identity
g = \x -> [x + 1]
traverse (Compose . fmap g . f) ft' == (Compose . fmap (traverse g) . traverse f $ ft')
In [5]:
{-# LANGUAGE Rank2Types FlexibleContexts UndecidableInstances AllowAmbiguousTypes #-}
-- An attempt at generically converting an Applicative to a Monoid.
newtype MonApp f a = MonApp {getApp :: (Applicative f, Monoid a) => f a}
instance Monoid (MonApp f a) where
mempty = MonApp $ pure mempty
mappend ma1 ma2 = MonApp $ mappend <$> (getApp ma1) <*> (getApp ma2)
instance (Monoid a) => Monoid (Tree a) where
mempty = Empty
mappend Empty t = t
mappend t Empty = t
mappend (Leaf x) (Leaf y) = Leaf (x `mappend` y)
mappend (Leaf x) (Node t1 y t2) = Node t1 (x `mappend` y) t2
mappend (Node t1 y t2) (Leaf x) = Node t1 (y `mappend` x) t2
mappend (Node t1 x t2) (Node t3 y t4) = Node (t1 `mappend` t3) (x `mappend` y) (t2 `mappend` t4)
-- This instance definition is only intended to work for those cases
-- in which the data type contained within the tree is a Monoid,
-- in which case 'Tree a' will also be a Monoid, via the instance, above.
-- I can't figure out how to express this to the compiler. Little help? :)
instance Monoid (Tree a) => Traversable Tree where
sequenceA = getApp . foldMap (MonApp . (fmap Leaf))
I couldn't figure out how to express to the compiler that I only wanted to instance those particular cases in which Tree f a was a Monoid.
In helping me navigate my confusion on this topic and understand the significance of Functor and Foldable being super-classes of Traversable, David Feuer proposed the following two exercises:
Hint: Consider traversing using the following applicative functors:
newtype Const a b = Const a
instance Monoid a => Applicative (Const a)
newtype Identity a = Identity a
instance Applicative Identity
The code, below, contains my response to his suggested exercises.
In [6]:
newtype Const a b = Const {getConst :: a}
deriving (Show, Eq)
:t Const
t = Node (Leaf [1, 2, 3]) [4, 5] (Leaf [6]) :: Tree [Int]
:t t
instance Functor (Const a) where
fmap f (Const x) = Const x
instance Monoid a => Applicative (Const a) where
pure x = Const mempty
(Const f) <*> (Const x) = Const (f `mappend` x)
:t traverse Const t
main :: IO ()
main = do
putStr "t = "
print t
putStrLn ""
-- Test the Functor laws.
putStrLn "Testing Functor laws:"
print $ fmap id (Const t) == id (Const t)
print $ fmap ((*2) . (+3)) (Const t) == (fmap (*2) . fmap (+3)) (Const t)
putStrLn ""
-- Test the Applicative laws.
-- (Can't use '(Const t)', because we haven't defined a
-- Monoid instance for (Tree [Int]).)
putStrLn "Testing Applicative laws:"
let l1 = [1, 2, 3] :: [Int]
let l2 = [4, 5, 6] :: [Int]
let l3 = [7, 8, 9] :: [Int]
print $ (pure (+1) <*> (Const l1)) == (fmap (+1) (Const l1))
print $ (pure id <*> (Const l2)) == (Const l2)
print $ (pure (.) <*> (Const l1) <*> (Const l2) <*> (Const l3)) == ((Const l1) <*> ((Const l2) <*> (Const l3)))
print $ (Const (Sum 1) <*> pure l3) == (pure ($ l3) <*> (Const (Sum 1)))
putStrLn ""
-- Do the traversal.
-- (We're expecting a single list, formed by concatenating all
-- the individual lists contained in 't', because the Monoid
-- instance for List defines 'mappend' as concatenation.)
putStrLn "Traversing 'Const . map (+1)' over 't':"
print $ getConst $ traverse (Const . map (+1)) t
putStrLn ""
-- As an interesting aside, do the traversal using 'id', instead of 'Const'.
-- (This is possible, because List has an Applicative instance.)
-- (We're expecting a list of trees, formed by taking all
-- possible combinations of the individual elements of the lists in 't',
-- because the Applicative instance for List defines (<*>) as
-- outer product, rather than concatenation.)
putStrLn "Traversing 'id' over 't':"
print $ traverse id t
putStrLn ""
-- Finally, show that 'traverse id' is just 'sequenceA'.
putStrLn "Applying 'sequenceA' to 't':"
print $ sequenceA t
main
So, traversing with Const is equivalent to folding.
The hardest part, above, was getting comfortable with the phantom type (i.e. - 'b') in the definition of Const, and realizing what it implied, with regard to the necessary Functor and Applicative instance definitions. In particular, it took me a while to realize that the correct thing to do was to ignore the 'x' in both the fmap and pure definitions.
In [7]:
newtype Identity a = Identity {getIdentity :: a}
deriving (Show, Eq)
:t Identity
t = Node (Leaf [1, 2, 3]) [4, 5] (Leaf [6]) :: Tree [Int]
:t t
instance Functor Identity where
fmap f (Identity x) = Identity (f x)
instance Applicative Identity where
pure = Identity
(Identity f) <*> (Identity x) = Identity (f x)
:t traverse Identity t
main :: IO ()
main = do
putStr "t = "
print t
putStrLn ""
-- Test the Functor laws.
putStrLn "Testing Functor laws:"
let l = [1, 2, 3] :: [Int]
print $ fmap id (Identity l) == id (Identity l)
print $ fmap ((map (*2)) . (map (+3))) (Identity l) == (fmap (map (*2)) . fmap (map (+3))) (Identity l)
putStrLn ""
-- Test the Applicative laws.
putStrLn "Testing Applicative laws:"
print $ (pure (map (+1)) <*> Identity l) == (fmap (map (+1)) (Identity l))
print $ (pure id <*> Identity l) == Identity l
print $ (pure (.) <*> Identity (map (+1)) <*> Identity (map (*2)) <*> (Identity l)) ==
(Identity (map (+1)) <*> (Identity (map (*2)) <*> (Identity l)))
print $ (Identity (map (+1)) <*> pure l) == (pure ($ l) <*> Identity (map (+1)))
putStrLn ""
-- Do the traversal.
-- (We're expecting the same tree, but with all its elements
-- incremented by one.)
putStrLn "Traversing 'Identity . map (+1)' over 't':"
print $ getIdentity $ traverse (Identity . map (+1)) t
putStrLn ""
putStrLn "fmap'ing 'map (+1)' over 't':"
print $ fmap (map (+1)) t
main
So, traversing with 'Identity . f' is equivalent to 'fmap f'.
And, in fact, we find two very similar functions defined in the Data.Traversable library:
-- | This function may be used as a value for `fmap` in a `Functor`
-- instance, provided that 'traverse' is defined. (Using
-- `fmapDefault` with a `Traversable` instance defined only by
-- 'sequenceA' will result in infinite recursion.)
fmapDefault :: Traversable t => (a -> b) -> t a -> t b
{-# INLINE fmapDefault #-}
fmapDefault f = getId . traverse (Id . f)
-- | This function may be used as a value for `Data.Foldable.foldMap`
-- in a `Foldable` instance.
foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m
foldMapDefault f = getConst . traverse (Const . f)