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

### Implementing fmap​

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

fmap1 :: (a -> b) -> F1 a -> F1 bfmap1 f Nothing = Nothingfmap1 f (Just x) = Just (f x)fmap2 :: (a -> b) -> F2 a -> F2 bfmap2 f (Left x) = Left (f x)fmap2 f (Right s) = Right sfmap3 :: (a -> b) -> F3 a -> F3 bfmap3 f [] = []fmap3 f (x:xs) = (f x):(fmap3 f xs)fmap4 :: (a -> b) -> F4 a -> F4 bfmap4 f Leaf = Leaffmap4 f (Node l x r) = Node (fmap4 f l) (f x) (fmap4 f r)fmap5 :: (a -> b) -> F5 a -> F5 bfmap5 f r = \i -> f (r i)fmap6 :: (a -> b) -> F6 a -> F6 bfmap6 f m kb = m (\a -> kb (f a))fmap7 :: (a -> b) -> F7 a -> F7 bfmap7 f Lf = Lffmap7 f (Nd x brs) = Nd (f x) (fmap3 (fmap7 f) brs)fmap8 :: (a -> b) -> F8 a -> F8 bfmap8 f Lf3 = Lf3fmap8 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).

1. 上面所有的类型构造函数 F1F2F3F5F6 都是单体。试着为它们找到尽可能多的实现。

pure1 :: a -> F1 apure1 x = Just xbind1 :: F1 a -> (a -> F1 b) -> F1 bbind1 Nothing f = Nothingbind1 (Just x) f = f xpure2 :: a -> F2 apure2 x = Left xbind2 :: F2 a -> (a -> F2 b) -> F2 bbind2 (Left x) f = f xbind2 (Right s) f = Right spure3 :: a -> F3 apure3 x = [ x ]bind3 :: F3 a -> (a -> F3 b) -> F3 bbind3 [] f = []bind3 (x:xs) f = f x ++ bind3 xs fpure5 :: a -> F5 apure5 x = \i -> xbind5 :: F5 a -> (a -> F5 b) -> F5 bbind5 m f = \i -> f (m i) ipure6 :: a -> F6 apure6 x = \k -> k xbind6 :: F6 a -> (a -> F6 b) -> F6 bbind6 m f = \k -> m (\a -> f a k)
2. (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 Stringexample = Add (Add (Var "x") (Var "y")) (Val 7)substExample :: Expr StringsubstExample = do v <- example                   case v of                     "x" -> Add (Val 5) (Val 3)                     "y" -> Val 14

Running the example gives:

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

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 函数 wordsunwords。当用户输入空行时，该程序应退出。 haskellflipWords :: 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

qsort :: (Ord a, PickingMonad m) => [a] -> m [a]qsort = undefined
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)