Haskell/Solutions/Applicative functors
← Back to Applicative functors
Contents
Functor
recap[edit]
Exercises 

Define instances of

1.
instance Functor Tree where
fmap f (Node x ts) = Node (f x) (fmap (fmap f) ts)
 Or, with a minor style change:
instance Functor Tree where
fmap f (Node x ts) = Node (f x) (fmap f <$> ts)
2.
instance Functor (Either e) where
fmap f (Right x) = Right (f x)
fmap _ l = l
3.
Functions have a Functor
instance, and it is a quite useful one. The "wrapped" value in this case is the result produced by the function.
instance Functor ((>) r) where
fmap g f = g . f
 Or simply:
instance Functor ((>) r) where
fmap = (.)
fmap
for functions is function composition.
The Applicative
class[edit]
Exercises 


1.
 Identity
pure id <*> v = v  Target
pure id <*> v
Just id <*> v
case v of
Nothing > Nothing
(Just x) > Just (id x)
case v of
Nothing > Nothing
(Just x) > Just x
v  Q.E.D
 Homomorphism
pure f <*> pure x = pure (f x)  Target
pure f <*> pure x
Just f <*> Just x
Just (f x)
pure (f x)  Q.E.D
 Interchange
u <*> pure y = pure ($ y) <*> u  Target
u <*> pure y
u <*> Just y
case u of
Nothing > Nothing
(Just f) > Just (f y)
case u of
Nothing > Nothing
(Just f) > Just (($ y) f)
pure ($ y) <*> u  Q.E.D
 Composition
pure (.) <*> u <*> v <*> w = u <*> (v <*> w)  Target
pure (.) <*> u <*> v <*> w
Just (.) <*> u <*> v <*> w
 The full mechanical derivation is too tedious,
 so we will present a streamlined solution instead.
 If any of u, v or w is Nothing, we get Nothing on both sides.
 Therefore, the only interesting case is:
Just (.) <*> Just g <*> Just f <*> Just x
Just ((.) g) <*> Just f <*> Just x  Homomorphism
Just ((.) g f) <*> Just x  Homomorphism
Just ((.) g f x)  Homomorphism
Just ((g . f) x)
Just (g (f x))
Just g <*> Just (f x)  Homomorphism
Just g <*> (Just f <*> Just x)  Homomorphism
u <*> v <*> w  Q.E.D.
2a.
instance Applicative (Either e) where
pure x = Right x
(Right f) <*> (Right x) = Right (f x)
(Right f) <*> l = l
l <*> _ = l
 Alternatively:
instance Applicative (Either e) where
pure = Right
(Right f) <*> v = fmap f v
l <*> _ = l
The choice for the first argument when there are two Left
s is arbitrary, but matches the Data.Either implementation.
2b.
instance Applicative ((>) r) where
pure x = \_ > x
u <*> f = \r > u r (f r)
 Alternatively:
instance Applicative ((>) r) where
pure = const
u <*> f = \r > u r (f r)
pure
and (<*>)
for functions are the K and S combinators of w:SKI combinator calculus respectively.
Déja vu[edit]
Exercises 


1.
 The definition of ap in the chapter, with explicit binds:
u <*> v = u >>= \f > v >>= \x > return (f x)
 v >>= \x > return (f x) = liftM f v = fmap f v
u <*> v = u >>= \f > fmap f v
 Or, with less points:
u <*> v = u >>= flip fmap v
2.
liftA5 :: Applicative f => (a > b > c > d > e > k)
> f a > f b > f c > f d > f e > f k
liftA5 f r s t u v = f <$> r <*> s <*> t <*> u <*> v
Sequencing of effects[edit]
Exercises 


1.
 Draft answer:
[] <*> _ = []
_ <*> [] = []
(f:fs) <*> xs = fmap f xs ++ (fs <*> xs)
 Avoiding explicit recursion:
fs <*> xs = concatMap (\f > fmap f xs) fs
 With less points:
fs <*> xs = concatMap (flip fmap xs) fs
[] <*> _ = []
_ <*> [] = []
fs <*> (x:xs) = fmap ($ x) fs ++ (fs <*> xs)
fs <*> xs = concatMap (\x > fmap ($ x) fs) xs
fs <*> xs = concatMap (flip fmap fs . flip ($)) xs
Note how the (<*>)
implementation matches exactly the general (<*>)
from(>>=)
implementation in the first exercise of the "Déja vu" section.
2.
Another pedantically slow derivation follows.
 The definition of ap in the chapter, with explicit binds:
u <*> v = u >>= \g > v >>= \y > return (g y)
f <$> u <*> v = f <$> u >>= \g > v >>= \y > return (g y)  See [*] note below
 For a monad, fmap f m = liftM f m = m >>= \x > return (f x)
f <$> u <*> v = (u >>= \x > return (f x)) >>= \g > v >>= \y > return (g y)
f <$> u <*> v = u >>= \x > (\z > return (f z)) x >>= \g > v >>= \y > return (g y)  Associativity monad law
f <$> u <*> v = u >>= \x > return (f x) >>= \g > v >>= \y > return (g y)
f <$> u <*> v = u >>= \x > (return (f x) >>= (\g > v >>= \y > return (g y)))
f <$> u <*> v = u >>= \x > (\g > v >>= \y > return (g y)) (f x)  Left unit monad law
f <$> u <*> v = u >>= \x > v >>= \y > return (f x y)
 For a monad, liftM2 f u v = liftA2 f u v = f <$> u <*> v
liftA2 f u v = do
x < u
y < v
return (f x y)
 Commutativity condition:
liftA2 f u v = liftA2 (flip f) v u
 Therefore, for a monad to be commutative this doblock...
do
x < u
y < v
return (f x y)
 ... must be equivalent to this one:
do
y < v
x < u
return (f x y)  flip f y x = f x y
 [*] Note: in this line...
f <$> u <*> v = f <$> u >>= \g > v >>= \y > return (g y)
 ... a reasonable shortcut would be eliminating the (<$>) using a letbinding:
f <$> u <*> v = u >>= \x > let g = f x in v >>= \y > return (g y)
 That leads directly to the answer:
f <$> u <*> v = u >>= \x > v >>= \y > return (f x y)  etc.
3a.
liftM2 f (ZipList xs) (ZipList ys) = liftM2 (flip f) (ZipList ys) (ZipList xs)
f <$> ZipList xs <*> ZipList ys = flip f <$> ZipList ys <*> ZipList xs  Target
f <$> ZipList xs <*> ZipList ys  LHS
ZipList (fmap f xs) <*> ZipList ys
ZipList (zipWith ($) (fmap f xs) ys)
ZipList (zipWith ($) (fmap (flip f) ys) xs)
ZipList (fmap (flip f) ys) <*> ZipList xs
flip f <$> ZipList ys <*> ZipList xs  Q.E.D; ZipList is commutative.
3b.
liftM2 k g f = liftM2 (flip k) f g
k <$> g <*> f = flip k <$> f <*> g  Target
k <$> g <*> f  LHS
k . g <*> f
\r > ((k . g) r) (f r)
\r > k (g r) (f r)
\r > flip k (f r) (g r)
\r > ((flip k . f) r) (g r)
flip k . f <*> g
flip k <$> f <*> g  Q.E.D; ((>) r) is commutative.
3c.
liftA2 f tx ty = liftA2 (flip f) ty tx
 Given that (State s) is a monad, we can use the result from exercise 2:
liftA2 f tx ty = do
x < tx
y < ty
return (f x y)
liftA2 (flip f) ty tx = do
y < ty
x < tx
return (f x y)
Two observations. Firstly, we might continue the solution by writing the binds explicitly, substituting the definitions of (>>=)
and return
and so forth. However, the plumbing in State
is quite convoluted, making the full derivation rather mindnumbing. For that reason, we will continue, at first, in a less formal way, so that the key insights are not obscured. Secondly, we have very good reasons to suspect State
is not commutative. After all, the whole point of State
is threading state updates with computations which depend on that state, and there is no particular reason why the order of the state transitions shouldn't matter. Following that lead, we will, instead of attempting to prove the doblocks are equivalent, look for a counterexample.
 Assume we have some function g :: s > s and a state s' :: s
 In the doblocks above, we will substitute:
tx = modify g >> get  Equivalent to State $ \s > (g s, g s)
ty = put s' >> get  Equivalent to State $ \s > (s', s')
 tx modifies the current state, while ty discards it.
We will now perform the substitutions, while keeping track of the (result, state) pairs in each step.
 Assume an initial state s :: s
liftA2 f tx ty = do  (_ , s )
x < modify g >> get  (g s , g s)
y < put s' >> get  (s' , s' )
return (f x y)  (f (g s) s', s' )
liftA2 (flip f) ty tx = do  (_ , s )
y < put s' >> get  (s' , s' )
x < modify g >> get  (g s' , g s')
return (f x y)  (f (g s') s', g s')
Neither the final states nor the final results match. That is enough to show State s
is not commutative.
For the sake of completeness, here is the full deduction through the Applicative
instance, done in mostly pointfree style. To protect our sanity, we will leave out the newtype
wrapping and unwrapping.
 Pretending the s > (_, s) from State s had an actual Monad instance:
fmap f t = first f . t  first f = \(x, y) > (f x, y)
t >>= k = app . first k . t  app = uncurry ($) = \(f, x) > f x
tg <*> tx = tg >>= flip fmap tx  ap
tg <*> tx = app . first (flip fmap tx) . tg
tg <*> tx = app . first (\g > first g . tx) . tg
liftA2 f tx ty = f <$> tx <*> ty
f <$> tx <*> ty  RHS
first f . tx <*> ty
app . first (\h > first h . ty) . first f . tx
app . first ((\h > first h . ty) . f) . tx
app . first ((\h > first h . ty) . \x > f x) . tx
app . first (\x > first (f x) . ty) . tx
\s > app . first (\x > first (f x) . ty) $ tx s
 Commutativity condition:
liftA2 f tx ty = liftA2 (flip f) ty tx
 Given some initial state s :: s, that becomes:
app . first (\x > first (f x) . ty) $ tx s
= app . first (\x > first (flip f x) . tx) $ ty s
 Proposed counterexample:
tx = \s > (g s, g s)
ty = \_ > (s', s')
 (These are the same state transitions we used above.)
app . first (\x > first (f x) . ty) $ tx s  LHS
app . first (\x > first (f x) . \_ > (s', s')) $ (g s, g s)
app . first (\x > \_ > first (f x) $ (s', s')) $ (g s, g s)
app . first (\x > \_ > (f x s', s')) $ (g s, g s)
app (\_ > (f (g s) s', s'), g s)
(f (g s) s', s')
app . first (\x > first (flip f x) . tx) $ ty s  RHS
app . first (\x > first (flip f x) . \z > (g z, g z)) $ (s', s')
app . first (\x > \z > first (flip f x) $ (g z, g z)) $ (s', s')
app . first (\x > \z > (f (g z) x, g z)) $ (s', s')
app . (\z > (f (g z) s', g z), s')
(f (g s') s', g s')  LHS /= RHS
 s > (_, s) is not commutative; therefore, State s isn't either.
4.
Prelude> [2,7,8] *> [3,9]
[3,9,3,9,3,9]
The skeleton of the second list is distributed into the skeleton of the first list; the values in the first list are discarded.
5.
v <**> u = flip ($) <$> v <*> u
 Alternatively,
v <**> u = liftA2 (flip ($)) v u
6.
Because (>>=)
imposes lefttoright sequencing. In m >>= k
, k
builds functorial context from the values in m
. The newly generated context is then combined with the preexisting context of m
, which is the matrix for creating the context of the result.
Incidentally, the fact (>>=)
performing lefttoright sequencing is the main reason for the convention that leads applicative operators to do the same. liftM2
and ap
are implemented using (>>=)
, and so they also sequence effects from left to right. That means Applicative
instances must follow suit if they are to be coherent with Monad
ones, and at that point it becomes sensible to extend the convention to all applicative functors (even those without Monad
instances) to minimise a source of confusion.
A sliding scale of power[edit]
Exercises 

The next few exercises concern the following tree data structure:

1.
A definition ready to be loaded in GHCi:
import Control.Monad
data AT a = L a  B (AT a) (AT a)
deriving (Show)
instance Functor AT where
fmap f t = case t of
L x > L (f x)
B tl tr > B (fmap f tl) (fmap f tr)
instance Applicative AT where
pure x = L x
L f <*> tx = fmap f tx
tf <*> L x = fmap ($ x) tf
B tfl tfr <*> tx = B (tfl <*> tx) (tfr <*> tx)
instance Monad AT where
return x = L x
t >>= k = case t of
L x > k x
B tl tr > B (tl >>= k) (tr >>= k)
Note how the laws of the various classes can guide you towards the correct instances. For example, the two first cases in the definition of (<*>)
follow immediately from the fmap and interchange laws of Applicative
.
2a.
fructify :: AT a > AT a
fructify t = fmap (flip ($)) t <*> B (L id) (L id)
 Alternate definition using <**>
fructify t = t <**> B (L id) (L id)
The context of fructify t
(i.e., the tree's shape) is fully determined by the context of t
, and the values have no influence over the resulting context. That calls for Applicative
. In the case of AT
, tf <*> tx
has the same shape as tf
, except with each leaf replaced by a tree with the shape of tx
. Hence, the desired shape for fructify t
can be obtained by applying a tree of shape B (L _) (L _)
to t
. In the above definition that uses (<*>)
, some processing is needed to get t
as the first argument to (<*>)
; the definition that uses (<**>)
is more natural. id
is used as each morphism function to produce the same value in each new leaf as that of the parent leaf.
2b.
prune :: a > (a > Bool) > AT a > AT a
prune z p t = case t of
L _ > t
B (L x) (L y) > if p x  p y then L z else t
B ll@(L x) tr > if p x then L z else B ll (prune z p tr)
B tl lr@(L y) > if p y then L z else B (prune z p tl) lr
B tl tr > B (prune z p tl) (prune z p tr)
For a second time we need to change the tree structure depending on its values, so Applicative
is not an option. Monad
is not enough as well. There are no values in the B
nodes for the second argument of (>>=)
to generate context from, and there is no way to access values elsewhere in the tree while performing the monadic bind. Thus we have resorted to a plain old explicitly recursive function.
(Note that if there were values in B
we might use an explicitly recursive function to tag the nodes, and then use the tags to prune the tree through the Monad
interface. It would be unnecessary trouble, of course, but it might make a nice extra exercise.)
2c.
reproduce :: (a > b) > (a > b) > AT a > AT b
reproduce f g t = B (L f) (L g) <*> t
reproduce
replaces the leaves of B (L f) (L g)
with fmap f t
and fmap g t
. This Applicative
instance is very similar to the standard "combinatorial" Applicative
of lists. As the structure of the result tree depends only of the structure of t
(and not of any values), Monad
is clearly unnecessary.
3.
The alternative instance is:
instance Applicative AT where
pure x = L x
L f <*> tx = fmap f tx
tf <*> L x = fmap ($ x) tf
B tfl tfr <*> B txl txr = B (tfl <*> txl) (tfr <*> txr)
It only combines subtrees with matching positions in the tree structures. The resulting behaviour is similar to that of ZipLists
, except that when the subtree shapes are different it inserts missing branches rather than removing extra ones (and it couldn't be otherwise, since there are no empty AT
s). By the way, sagittalMap
would have the exact same implementation of reproduce
, only using the other instance.
The monoidal presentation[edit]
Exercises 


1.
unit = pure ()
u *&* v = (,) <$> u <*> v
pure x = const x <$> unit
u <*> v = uncurry ($) <$> (u *&* v)  uncurry ($) = \(f, x) > f x
2.
liftA2 f u v = f <$> u <*> v
 Using the results of exercise 1:
liftA2 f u v = uncurry ($) <$> (f <$> u *&* v)
liftA2 f u v = uncurry ($) <$> ((f *** id) <$> (u *&* v))  Naturality Monoidal law
liftA2 f u v = uncurry ($) . (f *** id) <$> (u *&* v)  2nd functor law
liftA2 f u v = uncurry f <$> (u *&* v)  uncurry f = \(x, y) > f x y
 Commutativity condition
liftA2 f u v = liftA2 (flip f) v u
uncurry f <$> (u *&* v) = uncurry (flip f) <$> (v *&* u)
uncurry f <$> (u *&* v) = uncurry f . swap <$> (v *&* u)  swap (x, y) = (y, x)
uncurry f <$> (u *&* v) = uncurry f <$> (swap <$> (v *&* u))  2nd functor law
u *&* v = swap <$> (v *&* u)
That is a beautiful presentation of the commutativity condition. An applicative functor is commutative if the only difference between u *&* v
and v *&* u
is the elements of the pairs within them being swapped. All else  the values of the elements and the context around them  must be the same.
3a.
instance Monoidal ZipList where
unit = ZipList (repeat ())
(ZipList xs) *&* (ZipList ys) = ZipList (zipWith (,) xs ys)
 Or simply:
instance Monoidal ZipList where
unit = ZipList (repeat ())
(ZipList xs) *&* (ZipList ys) = ZipList (zip xs ys)
3b.
instance Monoidal ((>) r) where
unit = const ()
g *&* f = \x > (f x, g x)