Haskell/Solutions/Applicative functors
← Back to Applicative functors
Functor recap
[edit | edit source]| 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 | edit source]| 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 Lefts 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 | edit source]| 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 | edit source]| 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 do-block...
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 let-binding:
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 mind-numbing. 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 do-blocks are equivalent, look for a counter-example.
-- Assume we have some function g :: s -> s and a state s' :: s
-- In the do-blocks 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 point-free 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 counter-example:
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 left-to-right 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 left-to-right 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 | edit source]| 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.
alternatively, one can get away with using just Functor as follows
reproduce :: (a -> b) -> (a -> b) -> AT a -> AT b
reproduce f g t = B (f <$> t) (g <$> t)
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 ATs). By the way, sagittalMap would have the exact same implementation of reproduce, only using the other instance.
The monoidal presentation
[edit | edit source]| 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 -> (g x, f x)