Solutions to the Problem Sheet for LI Functional Programming - Week 7 & 8

Implementing fmap

• 为上述所有的类型构造器实现 fmap 函数。可以在这里找到一个基本的模板。

  fmap1 :: (a -> b) -> F1 a -> F1 b
  fmap1 f Nothing = Nothing
  fmap1 f (Just x) = Just (f x)
  
  fmap2 :: (a -> b) -> F2 a -> F2 b
  fmap2 f (Left x) = Left (f x)
  fmap2 f (Right s) = Right s
  
  fmap3 :: (a -> b) -> F3 a -> F3 b
  fmap3 f [] = []
  fmap3 f (x:xs) = (f x):(fmap3 f xs)
  
  fmap4 :: (a -> b) -> F4 a -> F4 b
  fmap4 f Leaf = Leaf
  fmap4 f (Node l x r) = Node (fmap4 f l) (f x) (fmap4 f r)
  
  fmap5 :: (a -> b) -> F5 a -> F5 b
  fmap5 f r = \i -> f (r i)
  
  fmap6 :: (a -> b) -> F6 a -> F6 b
  fmap6 f m kb = m (\a -> kb (f a))
  
  fmap7 :: (a -> b) -> F7 a -> F7 b
  fmap7 f Lf = Lf
  fmap7 f (Nd x brs) = Nd (f x) (fmap3 (fmap7 f) brs)
  
  fmap8 :: (a -> b) -> F8 a -> F8 b
  fmap8 f Lf3 = Lf3
  fmap8 f (Nd3 x brs) = Nd3 (f x) (fmap7 (fmap8 f) brs)

• 你可能会从这个列表中得到这样的印象：每一个类型构造器都是一个函数。当你试图为上面的 F5 的对偶实现 fmap 时会发生什么？就是说，对于类型构造函数 hs type NotAFunctor a = a -> Int 来说，会发生什么？

  This type constructor is not a functor, as a map `a -> b` induces a map `(b -> Int) -> (a -> Int)`, i.e.
  one which goes in the wrong direction.  (We say that it is a **contravariant** functor).

Implementing Monads

2. 上面所有的类型构造函数 F1、F2、F3、F5 和 F6 都是单体。试着为它们找到尽可能多的实现。

   pure1 :: a -> F1 a
   pure1 x = Just x
   
   bind1 :: F1 a -> (a -> F1 b) -> F1 b
   bind1 Nothing f = Nothing
   bind1 (Just x) f = f x
   
   pure2 :: a -> F2 a
   pure2 x = Left x
   
   bind2 :: F2 a -> (a -> F2 b) -> F2 b
   bind2 (Left x) f = f x
   bind2 (Right s) f = Right s
   
   pure3 :: a -> F3 a
   pure3 x = [ x ]
   
   bind3 :: F3 a -> (a -> F3 b) -> F3 b
   bind3 [] f = []
   bind3 (x:xs) f = f x ++ bind3 xs f
   
   pure5 :: a -> F5 a
   pure5 x = \i -> x
   
   bind5 :: F5 a -> (a -> F5 b) -> F5 b
   bind5 m f = \i -> f (m i) i
   
   pure6 :: a -> F6 a
   pure6 x = \k -> k x
   
   bind6 :: F6 a -> (a -> F6 b) -> F6 b
   bind6 m f = \k -> m (\a -> f a k)

3. (Adapted from Programming in Haskell) Consider the following simple expression type:

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

   证明它是一个单体。在这种情况下，>>= 函数到底做什么？

   instance Functor Expr where
     fmap f (Var x) = Var (f x)
     fmap f (Val i) = Val i
     fmap f (Add l r) = Add (fmap f l) (fmap f r)
   
   instance Applicative Expr where
     pure x = Var x
     (<*>) mf ma = mf >>= (\f ->
                   ma >>= (\a -> Var (f a)))
   
   instance Monad Expr where
     return x = Var x
     (>>=) (Var x) f = f x
     (>>=) (Val i) f = Val i
     (>>=) (Add l r) f = Add (l >>= f) (r >>= f)

   下面的例子表明，>>= 的作用类似于 "替换"，用一个新的子表达式替换出现在表达式叶子上的变量。

   example :: Expr String
   example = Add (Add (Var "x") (Var "y")) (Val 7)
   
   substExample :: Expr String
   substExample = do v <- example
                      case v of
                        "x" -> Add (Val 5) (Val 3)
                        "y" -> Val 14
   

   Running the example gives:

   > substExample
   Add (Add (Add (Val 5) (Val 3)) (Val 14)) (Val 7)

Using Monads

1. 使用 State 单体来实现一个函数

   labelRose :: Rose a -> Rose (Int,a)

   它用一个 fresh 索引来装饰树中的每个节点。

   labelRoseS :: Rose a -> State Int (Rose (Int,a))
   labelRoseS (Br (x,brs)) = do i <- get
                                modify ((+)1)
                                brs' <- sequence (map labelRoseS brs)
                                pure (Br ((i,x),brs'))
   
   labelRose :: Rose a -> Rose (Int,a)
   labelRose r = fst (runState (labelRoseS r) 0)

2. 使用 IO 单体从用户那里读取一行输入并打印一个响应。

   readAndRespond :: IO ()
   readAndRespond = do putStrLn "Tell me something!"
                   s <- getLine
                   putStrLn $ "You said: " ++ s

3. 创建一个简单的 REPL，读取一行文本并打印同一行的文字，并将其反转。你可能想查一下 haskell 的 prelude 函数 words 和 unwords。当用户输入空行时，该程序应退出。

   ```haskell
   flipWords :: IO ()
   flipWords = do putStrLn "Type some words (or press return to quit)."
                  str <- getLine
                  if (null str)
                    then return ()
                    else do putStrLn "Here are your words, backwards!"
                            putStrLn (unwords $ reverse $ words str)
                            flipWords
   ```

A Picking Monad

Problem: Implement a new version of Quicksort

qsort :: (Ord a, PickingMonad m) => [a] -> m [a]
qsort = undefined

它对 pick 进行了适当的调用，以选择支点。

qsort :: (Ord a, PickingMonad m) => [a] -> m [a]
qsort [] = pure []
qsort xs =
  do
    i <- pick 0 (length xs - 1)
    let x = xs !! i
    l <- qsort [ y | y <- xs , y < x ]
    r <- qsort [ y | y <- xs , y > x ]
    pure (l ++ [x] ++ r)