Functional Programming - Functors, monads, applicatives and traversables

Functors, monads, applicatives and traversables

Given the definition

newtype Map k v = MkMap [(k, v)]

What is the kind of Map? Please make Map k an instance of Functor.

-- Map has kind * -> * -> * (as a parameterized type with two type parameters)
instance Functor (Map k) where 
  fmap f (MkMap kvs) = MkMap (map (\(k,v) -> (k, f v)) kvs)

Show that the definition of the arithmetic evaluator using next in Lecture 10 is the same as the one using nested case clauses by expanding the definition of the former.

Define a function tuple :: Monad m => m a -> m b -> m (a, b) using explicit (>>=), do-notation and applicative operators.

What does the function do for the Maybe monad?

tuple           :: Monad m => m a -> m b -> m (a,b)
tuple actA actB = actA >>= \a ->
                    actB >>= \b -> return (a,b)


tuple           :: Monad m => m a -> m b -> m (a,b)
tuple actA actB = do a <- actA
                     b <- actB
                     return (a,b)

tuple           :: Monad m => m a -> m b -> m (a,b)
tuple actA actB = (,) <$> actA <*> actB

Define the following set of actions for State s a :
- A computation get of type State s s that obtains the current value of the state.
- A function modify of type (s -> s) -> State s () that updates the current state using the given function.
- A function put of type s -> State s () that overwrites the current state with the given value.
Using those primitive operations:
- Define modify using get and put.
- Define put using modify.
```
modify f = do x <- get
              put $ f x

put x = modify (const x)
```
Explain the behavior of sequence for the Maybe monad.

Define a monadic generalisation of foldl:

foldM :: Monad m => (a -> b -> m a) -> a -> [b] -> m a

foldM f v = foldl' g (return v)
  where
    g r x = r >>= \a -> f a x

Show that the Maybe monad satisfies the monad laws.

Given the type:

data Expr a = Var a | Val Int | Add (Expr a) (Expr a)

of expressions built from variables of type a, show that this type is monadic by completing the following declaration:

instance Monad Expr where
  -- return :: a -> Expr a
  return x = ...

  -- (>>=) :: Expr a -> (a -> Expr b) -> Expr b
  (Var a)   >>= f = ...
  (Val n)   >>= f = ...
  (Add x y) >>= f = ...

With the aid of an example, explain what the (>>=) operator for this type does.

To show how (>>=) :: Monad m => m a -> (a -> m b) -> m b generalizes function application and how do-notation generalizes let-bindings, consider the following definition of function application with the arguments swapped:

(&) :: a -> (a -> b) -> b 
(&) = flip ($)

Then, we can consider

let x = a in b

to be syntactic sugar for

a & \x -> b

similar to how

do
  x <- a
  b

is syntactic sugar for

a >>= \x -> b

Please desugar the following definition into code that explicitly uses (&):

compute x =
    let a = x + 5
        b = a * 3
        c = b / 2
        d = c - 7
        e = d * d
    in  e

compute x =
        x + 5 & \a ->
        a * 3 & \b ->
        b / 2 & \c ->
        c - 7 & \d ->
        d * d & \e ->
        e

Please desugar the following definition into code that explicitly uses (>>=):

main = do
    putStrLn "Enter the first number:"
    num1 <- readLn
    putStrLn "Enter the second number:"
    num2 <- readLn
    putStrLn $ "The sum of the numbers is: " ++ show (num1 + num2)

main =
    putStrLn "Enter the first number:" >>= \_ ->
    readLn >>= \num1 -> 
    putStrLn "Enter the second number:" >>= \_ ->
    readLn >>= \num2 ->
    putStrLn $ "The sum of the numbers is: " ++ show (num1 + num2)

Given the type:

data Error m a = Error m | OK a

Give a Functor instance for Error m. Please explain in words what this functor instance achieves.

instance Functor (Error m) where
fmap f (OK a)    = OK (f a)
fmap _ (Error m) = Error m

-- This instance applies a function f to an OK value and otherwise propagates the error message.

Give an Applicative instance for Error m that we can use to accumulate errors, meaning that we accumulate all error messages of all subcomputations that fail.

instance Monoid m => Applicative (Error m) where
  pure = OK
  (Error m1) <*> (Error m2) = Error (m1 <> m2)
  (Error m1) <*> (OK _) = Error m1
  (OK _) <*> (Error m2) = Error m2
  (OK f) <*> (OK a) = OK (f a)

Give a Monad instance for Error m. Please explain what this Monad instance can be used for. Please explain how the induced Applicative instance

instance Applicative (Error m) where 
  pure = return
  (<*>) mf ma = do 
      f <- mf 
      a <- ma 
      return (f a)

differs in behaviour from the error accumulation instance we defined previously.

instance Monad (Error m) where
  return = OK
  (OK a) >>= f = f a
  (Error m) >>= _ = Error m
-- This implements error propagation of the first error to be hit rather than error accumulation of all errors.

Given the types

newtype State s a = State {runState :: s -> (a, s)}
type StatePassing s a b = (a, s) -> (b, s)

Define functions

statePass :: (a -> State s b) -> StatePassing s a b 
unStatePass :: StatePassing s a b -> (a -> State s b)
statePass' :: State s b -> StatePassing s () b 
unStatePass' :: StatePassing s () b -> State s b

such that statePass . unStatePass = id, unStatePass . statePass = id, statePass' . unStatePass' = id and unStatePass' . statePass' = id.

statePass f (a, s) = let State g = f a in g s

unStatePass g a = State $ \s -> g (a, s)

statePass' = statePass . const

unStatePass' g = unStatePass g ()

Give a Monad instance for State s where you define return and >>= in terms of the four functions above.

instance Monad (State s) where 
  return = unStatePass id
  (>>=) f g = unStatePass' (statePass g . statePass' f)
  -- so (>=>) f g = unStatePass ((statePass g . statePass f))

Prove that these definitions of return and >>= are equivalent to the usual definitions

instance Monad (State s) where 
  return a = State (\s -> (a, s))
  (State f) >>= g = State (\s -> let (a, s') = f s in let State h = g a in h s')

return a 
= (def return)
unStatePass id a
= (def unStatePass)
State $ \s -> g (a, s)
= (def ($))
State (\s -> (a, s))

(>>=) (State f) g
= (def (>>=))
unStatePass' (statePass g . statePass' (State f))
= (def unStatePass')
unStatePass (statePass g . statePass' (State f)) ()
= (def unStatePass)
State $ \s -> (statePass g . statePass' (State f)) ((), s)
= (def (.))
State $ \s -> statePass g (statePass' (State f) ((), s))
= (def statePass')
State $ \s -> statePass g ((statePass . const) (State f) ((), s))
= (def (.))
State $ \s -> statePass g (statePass (const (State f)) ((), s))
= (def statePass)
State $ \s -> statePass g (let State f' = (const (State f)) () in f' s)
= (def const)
State $ \s -> statePass g (let State f' = State f in f' s)
= (referential transparency of let-bindings)
State $ \s -> statePass g (f s)
= (referential transparency of let-bindings)
State $ \s -> let (a, s') = f s in statePass g (a, s')
= (def statePass)
State $ \s -> let (a, s') = f s in let State h = g a in h s'
= (def ($))
State (\s -> let (a, s') = f s in let State h = g a in h s')

Using the four StatePassing helper functions we defined above, define

get :: State s s 
put :: s -> State s () 
modify :: (s -> s) -> State s ()

get = unStatePass' (\((), s) -> (s, s))

put = unStatePass (\(s, _) -> ((), s))

modify f = unStatePass' (\((), s)-> ((), f s))

We see that code written in the State s monad is equivalent to code in “state passing style”, i.e. code where in place of functions of type A -> B we instead work with functions of type (A, s) -> (B, s) that always thread through an extra argument and return value (the state) of type s.

(Challenging) Given the types

newtype Cont r a = Cont { runCont :: (a -> r) -> r}
type ContPassing r a b = (b -> r) -> (a -> r)

Define functions

contPass :: (a -> Cont r b) -> ContPassing r a b
unContPass :: ContPassing r a b  -> (a -> Cont r b)
contPass' :: Cont r b -> ContPassing r () b
unContPass' :: ContPassing r () b -> Cont r b

such that contPass . unContPass = id, unContPass . contPass = id, contPass' . unContPass' = id and unContPass' . contPass' = id.

contPass f k a = let Cont g = f a in g k

unContPass g a = Cont $ \k -> g k a

contPass' = contPass . const

unContPass' g = unContPass g ()

Give a Monad instance for Cont r. Hint: you may want to use the functions we defined previously.

instance Monad (Cont r) where 
    return = unContPass id
    (>>=) f g = unContPass' (contPass' f . contPass g)
    -- so (>=>) f g = unContPass ((contPass f . contPass g))

Define a function

callCC :: ((a -> Cont r b) -> Cont r a) -> Cont r a

Hint: you may want to define callCC in terms of a helper function

callCCHelp :: (ContPassing r a b -> ContPassing r () a) -> ContPassing r () a

that you define first.

callCC phi = unContPass' $ callCCHelp $ contPass' . phi . unContPass

callCCHelp psi k = psi (const k) k

We see that code written in the Cont r monad is equivalent to code in “continuation passing style”, i.e. code where in place of functions of type A -> B we instead write functions of type (B -> r) -> (A -> r) that operate in reverse on “continuations”.

Context: similarly to how State monads allow us to emulate computation with non-local data flow through mutable variables, Cont (inuation) monads can be used to emulate computation with non-local control flow where stack discipline is not respected in the call stack and we can instead perform arbitrary reads and writes of the current continuation. The example below demonstrates how this can work in practice.

fun :: Int -> String
fun n = (`runCont` id) $ do
    str <- callCC $ \exit1 -> do                            -- define "exit1"
        when (n < 10) (exit1 (show n))
        let ns = map digitToInt (show (n `div` 2))
        n' <- callCC $ \exit2 -> do                         -- define "exit2"
            when ((length ns) < 3) (exit2 (length ns))
            when ((length ns) < 5) (exit2 n)
            when ((length ns) < 7) $ do
                let ns' = map intToDigit (reverse ns)
                exit1 (dropWhile (=='0') ns')               --escape 2 levels
            return $ sum ns
        return $ "(ns = " ++ (show ns) ++ ") " ++ (show n')
    return $ "Answer: " ++ str

when      :: (Applicative f) => Bool -> f () -> f ()
when p s  = if p then s else pure ()