Skip to main content

附录 A：精选习题解答（Selected solutions）

原文：Graham Hutton, Programming in Haskell, Second Edition, Appendix A。维护者已确认本书可翻译并发布用于学习研究。

本附录给出各章部分练习的参考解答。如果在 GHCi 中测试这些解答，请注意某些函数可能需要改名，以避免与标准 Prelude 中的内置函数冲突。例如，可以把 product 改名为 myproduct。

A.1 引言（Introduction）​

练习 1​

double (double 2)
= { 应用内部的 double }
double (2 + 2)
= { 应用 double }
(2 + 2) + (2 + 2)
= { 应用第一个 + }
4 + (2 + 2)
= { 应用第二个 + }
4 + 4
= { 应用 + }
8

或者：

double (double 2)
= { 应用外部的 double }
(double 2) + (double 2)
= { 应用第二个 double }
(double 2) + (2 + 2)
= { 应用第二个 + }
(double 2) + 4
= { 应用 double }
(2 + 2) + 4
= { 应用第一个 + }
4 + 4
= { 应用 + }
8

还有许多其他可能的答案。

练习 2​

sum [x]
= { 应用 sum }
x + sum []
= { 应用 sum }
x + 0
= { 应用 + }
x

练习 3​

product []     = 1
product (n:ns) = n * product ns

例如：

product [2,3,4]
= { 应用 product }
2 * (product [3,4])
= { 应用 product }
2 * (3 * product [4])
= { 应用 product }
2 * (3 * (4 * product []))
= { 应用 product }
2 * (3 * (4 * 1))
= { 应用 * }
24

A.2 初步实践（First steps）​

练习 2​

(2^3)*4
(2*3)+(4*5)
2+(3*(4^5))

练习 3​

n = a `div` length xs
    where
        a  = 10
        xs = [1,2,3,4,5]

练习 4​

last xs = head (reverse xs)

或者：

last xs = xs !! (length xs - 1)

A.3 类型与类（Types and classes）​

练习 1​

['a','b','c'] :: [Char]
('a','b','c') :: (Char,Char,Char)
[(False,'O'),(True,'1')] :: [(Bool,Char)]
([False,True],['0','1']) :: ([Bool],[Char])
[tail, init, reverse] :: [[a] -> [a]]

练习 2​

bools = [False,True]
nums = [[1,2],[3,4],[5,6]]
add x y z = x+y+z
copy x = (x,x)
apply f x = f x

对于 bools、nums 和 add，还有许多其他可能的答案。

A.4 定义函数（Defining functions）​

练习 1​

halve xs = (take n xs, drop n xs)
    where n = length xs `div` 2

或者：

halve xs = splitAt (length xs `div` 2) xs

练习 2​

third xs = head (tail (tail xs))
third xs = xs !! 2
third (_:_:x:_) = x

练习 3​

safetail xs = if null xs then [] else tail xs

safetail xs | null xs   = []
            | otherwise = tail xs

safetail []     = []
safetail (_:xs) = xs

练习 4​

False || False = False
False || True  = True
True  || False = True
True  || True  = True

False || False = False
_     || _     = True

False || b = b
True  || _ = True

b || c | b == c    = b
       | otherwise = True

A.5 列表推导式（List comprehensions）​

练习 1​

sum [x^2 | x <- [1..100]]

练习 2​

grid m n = [(x,y) | x <- [0..m], y <- [0..n]]

练习 3​

square n = [(x,y) | (x,y) <- grid n n, x /= y]

练习 4​

replicate n x = [x | _ <- [1..n]]

练习 5​

pyths n = [(x,y,z) | x <- [1..n],
                     y <- [1..n],
                     z <- [1..n],
                     x^2 + y^2 == z^2]

A.6 递归函数（Recursive functions）​

练习 1​

该函数不会终止，因为每次应用 fac 都会把参数减一，因此永远无法到达基本情形。

fac 0         = 1
fac n | n > 0 = n * fac (n-1)

练习 2​

sumdown 0 = 0
sumdown n = n + sumdown (n-1)

练习 3​

(^) :: Int -> Int -> Int
m ^ 0 = 1
m ^ n = m * (m ^ (n-1))

例如：

2 ^ 3
= { 应用 ^ }
2 * (2 ^ 2)
= { 应用 ^ }
2 * (2 * (2 ^ 1))
= { 应用 ^ }
2 * (2 * (2 * (2 ^ 0)))
= { 应用 ^ }
2 * (2 * (2 * 1))
= { 应用 * }
8

练习 4​

euclid x y | x == y = x
           | x < y  = euclid x (y-x)
           | y < x  = euclid (x-y) y

A.7 高阶函数（Higher-order functions）​

练习 1​

map f (filter p xs)

练习 2​

all p = and . map p
any p = or . map p

takeWhile _ [] = []
takeWhile p (x:xs) | p x       = x : takeWhile p xs
                   | otherwise = []

dropWhile _ [] = []
dropWhile p (x:xs) | p x       = dropWhile p xs
                   | otherwise = x:xs

练习 3​

map f = foldr (\x xs -> f x : xs) []

filter p = foldr (\x xs -> if p x then x:xs else xs) []

练习 4​

dec2int = foldl (\x y -> 10*x + y) 0

练习 5​

curry :: ((a,b) -> c) -> (a -> b -> c)
curry f = \x y -> f (x,y)

uncurry :: (a -> b -> c) -> ((a,b) -> c)
uncurry f = \(x,y) -> f x y

A.8 声明类型与类（Declaring types and classes）​

练习 1​

mult m Zero     = Zero
mult m (Succ n) = add m (mult m n)

练习 2​

occurs x (Leaf y) = x == y
occurs x (Node l y r) = case compare x y of
    LT -> occurs x l
    EQ -> True
    GT -> occurs x r

这个版本更高效，因为对每个节点只需要在 x 和 y 之间做一次比较，而前一个版本可能需要两次。

练习 3​

leaves (Leaf _)   = 1
leaves (Node l r) = leaves l + leaves r

balanced (Leaf _)   = True
balanced (Node l r) = abs (leaves l - leaves r) <= 1
                      && balanced l && balanced r

练习 4​

halve xs = splitAt (length xs `div` 2) xs

balance [x] = Leaf x
balance xs  = Node (balance ys) (balance zs)
    where (ys,zs) = halve xs

A.9 倒计时问题（The countdown problem）​

练习 1​

choices xs = [zs | ys <- subs xs, zs <- perms ys]

练习 2​

removeone x [] = []
removeone x (y:ys) | x == y    = ys
                   | otherwise = y : removeone x ys

isChoice []     _  = True
isChoice (x:xs) [] = False
isChoice (x:xs) ys = elem x ys && isChoice xs (removeone x ys)

练习 3​

这会导致不终止，因为对 exprs 的递归调用不再保证会减小列表长度。

A.10 交互式编程（Interactive programming）​

练习 1​

putStr xs = sequence_ [putChar x | x <- xs]

练习 2​

putBoard = putBoard' 1

putBoard' r []     = return ()
putBoard' r (n:ns) = do putRow r n
                        putBoard' (r+1) ns

练习 3​

putBoard b = sequence_ [putRow r n | (r,n) <- zip [1..] b]

A.11 不可战胜的井字棋（Unbeatable tic-tac-toe）​

练习 1​

使用定义：

nodes :: Tree a -> Int
nodes (Node _ ts) = 1 + sum (map nodes ts)

mydepth :: Tree a -> Int
mydepth (Node _ []) = 0
mydepth (Node _ ts) = 1 + maximum (map mydepth ts)

有：

> let tree = gametree empty O
> nodes tree
549946
> mydepth tree
9

练习 2​

import System.Random hiding (next)

bestmoves :: Grid -> Player -> [Grid]
bestmoves g p = [g' | Node (g',p') _ <- ts, p' == best]
    where
        tree = prune depth (gametree g p)
        Node (_,best) ts = minimax tree

play' :: Grid -> Player -> IO ()
play' g p
    | wins O g = putStrLn "Player O wins!\n"
    | wins X g = putStrLn "Player X wins!\n"
    | full g   = putStrLn "It's a draw!\n"
    | p == O   = do i <- getNat (prompt p)
                    case move g i p of
                        []   -> do putStrLn "ERROR: Invalid move"
                                   play' g p
                        [g'] -> play g' (next p)
    | p == X   = do putStr "Player X is thinking... "
                    let gs = bestmoves g p
                    n <- randomRIO (0,length gs - 1)
                    play (gs !! n) (next p)

注意，从导入库中隐藏函数 next，是为了避免与我们在玩家值上定义的 next 函数冲突。

A.12 单子及更多内容（Monads and more）​

练习 1​

instance Functor Tree where
    -- fmap :: (a -> b) -> Tree a -> Tree b
    fmap g Leaf         = Leaf
    fmap g (Node l x r) = Node (fmap g l) (g x) (fmap g r)

练习 2​

instance Functor ((->) a) where
    -- fmap :: (b -> c) -> (a -> b) -> (a -> c)
    fmap = (.)

练习 3​

instance Applicative ((->) a) where
    -- pure :: b -> (a -> b)
    pure = const

    -- (<*>) :: (a -> b -> c) -> (a -> b) -> (a -> c)
    g <*> h = \x -> g x (h x)

练习 4​

instance Functor ZipList where
    -- fmap :: (a -> b) -> ZipList a -> ZipList b
    fmap g (Z xs) = Z (fmap g xs)

instance Applicative ZipList where
    -- pure :: a -> ZipList a
    pure x = Z (repeat x)

    -- <*> :: ZipList (a -> b) -> ZipList a -> ZipList b
    (Z gs) <*> (Z xs) = Z [g x | (g,x) <- zip gs xs]

A.13 单子解析（Monadic parsing）​

练习 1​

comment = do string "--"
             many (sat (/= '\n'))
             return ()

练习 2​

表达式 2+3+4 使用第二版文法时有两种可能解析，对应于两种结合方式：

(2+3)+4
2+(3+4)

也就是说，一棵解析树先把左侧 2+3 构造成表达式，再与 4 相加；另一棵解析树先把右侧 3+4 构造成表达式，再与 2 相加。

练习 3​

使用第三版文法，解析树对应下面这些结构：

2+3       ==> 2 + 3
2*3*4     ==> 2 * (3 * 4)
(2+3)+4   ==> (2 + 3) + 4

换言之，乘法优先于加法，并且加法和乘法都按文法给定的方式向右结合；括号会显式改变分组。

练习 4​

如果不进行左因子化（left-factorising），所得解析器会发生大量回溯，并且在表达式大小上花费指数时间。例如，一个数字在被识别为表达式之前，会被解析四次。

A.14 Foldable 及相关抽象（Foldables and friends）​

练习 1​

instance (Monoid a, Monoid b) => Monoid (a,b) where
    -- mempty :: (a,b)
    mempty = (mempty, mempty)

    -- mappend :: (a,b) -> (a,b) -> (a,b)
    (x1,y1) `mappend` (x2,y2) =
        (x1 `mappend` x2, y1 `mappend` y2)

练习 2​

instance Monoid b => Monoid (a -> b) where
    -- mempty :: a -> b
    mempty = \_ -> mempty

    -- mappend :: (a -> b) -> (a -> b) -> (a -> b)
    f `mappend` g = \x -> f x `mappend` g x

A.15 惰性求值（Lazy evaluation）​

练习 1​

1+(2*3) 中唯一的 redex 是 2*3，它既是最内层也是最外层。

(1+2)*(2+3) 中的 redex 是 1+2 和 2+3，其中第一个是最内层。

fst (1+2,2+3) 中的 redex 是 1+2、2+3 和 fst (1+2,2+3)，其中第一个是最内层，最后一个是最外层。

(\x -> 1 + x) (2*3) 中的 redex 是 (\x -> 1 + x) (2*3) 和 2*3，其中第一个是最外层，第二个是最内层。

练习 2​

最外层求值：

fst (1+2, 2+3)
= { 应用 fst }
1+2
= { 应用 + }
3

最内层求值：

fst (1+2, 2+3)
= { 应用第一个 + }
fst (3, 2+3)
= { 应用 + }
fst (3, 5)
= { 应用 fst }
3

最外层求值更好，因为它避免了对第二个参数求值，因此少用一步化简。

练习 3​

mult 3 4
= { 应用 mult }
(\x -> (\y -> x * y)) 3 4
= { 应用外层 lambda }
(\y -> 3 * y) 4
= { 应用 lambda }
3 * 4
= { 应用 * }
12

A.16 程序推理（Reasoning about programs）​

练习 1​

基本情形：

add Zero (Succ m)
= { 应用 add }
Succ m
= { 反应用 add }
Succ (add Zero m)

归纳情形：

add (Succ n) (Succ m)
= { 应用 add }
Succ (add n (Succ m))
= { 归纳假设 }
Succ (Succ (add n m))
= { 反应用 add }
Succ (add (Succ n) m)

练习 2​

基本情形：

add Zero m
= { 应用 add }
m
= { add 的性质 }
add m Zero

归纳情形：

add (Succ n) m
= { 应用 add }
Succ (add n m)
= { 归纳假设 }
Succ (add m n)
= { add 的性质 }
add m (Succ n)

练习 3​

基本情形：

all (== x) (replicate 0 x)
= { 应用 replicate }
all (== x) []
= { 应用 all }
True

归纳情形：

all (== x) (replicate (n+1) x)
= { 应用 replicate }
all (== x) (x : replicate n x)
= { 应用 all }
x == x && all (== x) (replicate n x)
= { 应用 == }
True && all (== x) (replicate n x)
= { 应用 && }
all (== x) (replicate n x)
= { 归纳假设 }
True

练习 4​

基本情形：

[] ++ []
= { 应用 ++ }
[]

归纳情形：

(x : xs) ++ []
= { 应用 ++ }
x : (xs ++ [])
= { 归纳假设 }
x : xs

基本情形：

[] ++ (ys ++ zs)
= { 应用 ++ }
ys ++ zs
= { 反应用 ++ }
([] ++ ys) ++ zs

归纳情形：

(x : xs) ++ (ys ++ zs)
= { 应用 ++ }
x : (xs ++ (ys ++ zs))
= { 归纳假设 }
x : ((xs ++ ys) ++ zs)
= { 反应用 ++ }
(x : (xs ++ ys)) ++ zs
= { 反应用 ++ }
((x : xs) ++ ys) ++ zs

练习 5​

基本情形：

take 0 xs ++ drop 0 xs
= { 应用 take, drop }
[] ++ xs
= { 应用 ++ }
xs

基本情形：

take (n+1) [] ++ drop (n+1) []
= { 应用 take, drop }
[] ++ []
= { 应用 ++ }
[]

归纳情形：

take (n+1) (x:xs) ++ drop (n+1) (x:xs)
= { 应用 take, drop }
(x : take n xs) ++ (drop n xs)
= { 应用 ++ }
x : (take n xs ++ drop n xs)
= { 归纳假设 }
x : xs

A.17 推导编译器（Calculating compilers）​

练习 1​

解答见文献 [39]，本章也基于该文写成。