SICP 解题集 —— 2.2 层次性数据和闭包性质
1 练习 2.17 | last-pair :表中的最后一个序对
2 练习 2.18 | reverse :反转一个表
3 练习 2.19 | 让兑换零钱的程序更灵活
4 练习 2.20 | 用带点尾部记法接收任意多个参数,以及 same-parity
5 练习 2.21 | 定义 square-list 的两种方式
6 练习 2.22 | 尝试使用迭代计算过程产生表时遇到的问题
7 练习 2.23 | for-each :对表中每个项应用一个过程
8 练习 2.24 | 熟悉层次性结构
9 练习 2.25 | 从嵌套列表中取元素
10 练习 2.26 | appendconslist 的不同
11 练习 2.27 | deep-reverse :深反转
12 练习 2.28 | fringe :取出树的全部叶子
13 练习 2.29 | 二叉活动体
13.1 小题 2.29 (a)
13.2 小题 2.29 (b)
13.3 小题 2.29 (c)
13.4 小题 2.29 (d)
14 练习 2.30 | square-tree :对树的平方映射
15 练习 2.31 | tree-map :对树的一般映射
16 练习 2.32 | subsets :求集合的全部子集
16.1 subsets 的代码
16.2 证明
16.3 一个求全部组合的算法
16.4 一个只求组合数的算法:对组合数递推公式的证明
16.5 一个只求子集个数的算法:对子集个数公式的证明
16.6 为什么生成的结果顺序很“自然”
17 练习 2.33 | 基本的表操作也可以用 accumulate 表达
18 练习 2.34 | horner-eval :线性步数求多项式值
19 练习 2.35 | 用 accumulate 重新定义 count-leaves
20 练习 2.36 | accumulate-n :差不多是个可变参数版本 accumulate
20.1 accumulate-n 的代码
20.2 为什么并非真正的变参 accumulate
20.3 variadic-accumulate :真正的变参 accumulate
20.4 随手写个变参 map
21 练习 2.37 | 矩阵与向量操作
8.16

SICP 解题集 —— 2.2 层次性数据和闭包性质🔗

返回主页面

1 练习 2.17 | last-pair :表中的最后一个序对🔗

一个表只有一个元素,当且仅当它是一个序对,且其 cdrnil 。此时 car 就是这个元素。仿照书上的做法,我们写出如下递归步骤:

代码如下:

> (define (last-pair ls)
    (define (iter ls)
      (let ([rest (cdr ls)])
        (if (null? rest)
            ls
            (iter rest))))
    (if (null? ls)
        (error "Argument is empty list -- LAST-PAIR")
        (iter ls)))
> (last-pair (list 23 72 149 34))

'(34)

> (last-pair (list 34))

'(34)

> (last-pair nil)

Argument is empty list -- LAST-PAIR

(原书 3.3.1 节也使用了这个 last-pair 过程。)

2 练习 2.18 | reverse :反转一个表🔗

> (define (reverse ls)
    (define (iter source dest)
      (if (null? source)
          dest
          (iter (cdr source)
                (cons (car source) dest))))
    (iter ls nil))
> (reverse (list 1 4 9 16 25))

'(25 16 9 4 1)

> (reverse (list 25))

'(25)

> (reverse nil)

'()

不变量是: (append (reverse dest) source) 总是和原列表 ls 内容相同。

直观上, iter 的每一步,都 source 的首个元素取出,置于 dest 的开头。以 ls 内容为 (1 4 9 16 25) 为例,每次调用 iter 时, sourcedest 的内容分别是:

最后返回了 dest ,完成计算。

3 练习 2.19 | 让兑换零钱的程序更灵活🔗

书上的新版 cc 过程如下:

> (define (cc amount coin-values)
    (cond ((= amount 0) 1)
          ((or (< amount 0) (no-more? coin-values)) 0)
          (else
           (+ (cc amount
                  (except-first-denomination coin-values))
              (cc (- amount
                     (first-denomination coin-values))
                  coin-values)))))

可以看到, no-more? 其实就是判断货币类型表是否为空, first-denomination 其实就是“选取表的第一项”,而 except-first-denomination 就是“选取表中除去第一项之后剩下的所有项形成的子表”,三个操作分别对应 null?carcdr

> (define (no-more? coin-values)
    (null? coin-values))
> (define (first-denomination coin-values)
    (car coin-values))
> (define (except-first-denomination coin-values)
    (cdr coin-values))

测试一下:

> (cc 100 (list 50 25 10 5 1))

292

对比一下 1.2.2 节时写的 cc 过程。当时没有表这种数据结构,就只能将五种货币面值硬编码在 first-denomination 过程里的 cond 中,用一个整数变量 kinds-of-coins 来表示考虑的硬币类型数,还要自己数出种类数的初始值 5 ,还要硬编码在 count-change 过程的实现中。有了表,这个程序实现起来更自然、更优美了,代码可读性增强了,灵活性也大大增强了。

4 练习 2.20 | 用带点尾部记法接收任意多个参数,以及 same-parity🔗

> (define (boolean-equal? a b)
    (or (and a b)
        (and (not a) (not b))))
> (define (filter take? ls)
    (define (filtered sublist)
      (cond [(null? sublist) nil]
            [(take? (car sublist))
             (cons (car sublist) (filtered (cdr sublist)))]
            [else (filtered (cdr sublist))]))
    (filtered ls))
> (define (same-parity . ls)
    (let ([head-odd (odd? (car ls))])
      (filter (lambda (x)
                (boolean-equal? head-odd (odd? x)))
              ls)))
> (same-parity 1 2 3 4 5 6 7)

'(1 3 5 7)

> (same-parity 2 3 4 5 6 7)

'(2 4 6)

这里定义了 boolean-equal? 过程判断两个布尔值是否相等,它利用了如下事实:两个布尔值相等,当且仅当两者都是真或者两者都是假。原书后面的章节会介绍足够通用的 equal? 过程,它对于布尔值也能正确工作。Racket 还自带 boolean=? 谓词,专门用于布尔值。

这里还定义了 filter 过程,它取一个谓词 take? 和一个表 ls ,返回一个表,包含的是 ls 中所有满足谓词 take? 的项。不难感觉到,这个过程比较通用。它在原书正文中的稍后章节就会遇到,之后还会多次用到。

5 练习 2.21 | 定义 square-list 的两种方式🔗

> (define (square-list items)
    (if (null? items)
        nil
        (cons (square (car items))
              (square-list (cdr items)))))
> (square-list (list 1 2 3 4 5))

'(1 4 9 16 25)

> (define (square-list items)
    (map square items))
> (square-list (list 1 2 3 4 5))

'(1 4 9 16 25)

正如正文中所说,使用 map ,可以“将实现表变换的过程的实现,与如何提取表的元素以及组合结果的细节隔离开”。而在第一种实现中,“程序的递归结构将人的注意力吸引到对于表中逐个元素的处理上。”

6 练习 2.22 | 尝试使用迭代计算过程产生表时遇到的问题🔗

如果要使用只需要常数额外空间的迭代计算过程,那么就一直只能去处理表的开头部分。

想象一下,在桌面上,面前有几百张纸叠放起来,形成纸堆。你需要将它们全都签上名,但是一次只准搬运一张纸(所以总是只能处理纸堆上最上面的部分),那么只能这样做:

可以想到,原本位置靠上的纸,先被签上名,先被放在旁边,结果就位置靠下了。这就是为什么结果反转了。想要让结果重新正起来也很简单,那就是再完整搬运一次。这其实就对应了 练习 2.18 | reverse :反转一个表 中产生迭代计算过程的 reverse

与之类似,在 items 内容为 (1 2 3 4 5) 的情况下, iter 的各次调用中, thingsanswer 分别是:

我们知道,表 (25 16 9 4 1) 是通过 (cons 25 (cons 16 (cons 9 (cons 4 (cons 1 nil))))) 构造出来的。只把调用 cons 时的两个参数交换位置,我们只能得到一个 (cons (cons (cons (cons (cons nil 1) 4) 9) 16) 25) 。这甚至不是一个表。而且 25 其实也是仍然在最外层。

解决起来其实也不难,刚才就已经说到了:用 reverse 过程将结果表反转一下即可。 reverse 的迭代计算过程版本在 练习 2.18 | reverse :反转一个表 实现了。由于“处理”和“反转”都是迭代计算过程版本,所需步数都是 \Theta (n) (其中 n 是表中项的个数),只需要常数额外空间,所以组合起来之后所需步数和额外空间还是这样的。

7 练习 2.23 | for-each :对表中每个项应用一个过程🔗

实际上可以偷懒,用 map 逃课,如下:

> (define (for-each proc ls)
    (map proc ls)
    true)
> (for-each (lambda (x) (newline) (display x))
            (list 57 321 88))

57

321

88

#t

map 把过程应用于所有项,然后把整个结果表丢弃掉。

但我们还是自己写一个使用(尾)递归的版本吧:

> (define (for-each proc ls)
    (cond [(null? ls) true]
          [else
           (proc (car ls))
           (for-each proc (cdr ls))]))
> (for-each (lambda (x) (newline) (display x))
            (list 57 321 88))

57

321

88

#t

这个版本还能产生迭代计算过程,而书中的 map 实现并没有。

8 练习 2.24 | 熟悉层次性结构🔗

> (list 1 (list 2 (list 3 4)))

'(1 (2 (3 4)))

始终记住:解释器打印一个表的方式是先打印一个左括号,再将各个元素逐个打印出来,再打印右括号。

盒子指针和树的图先欠着。

9 练习 2.25 | 从嵌套列表中取元素🔗

以题中第一个表 (1 3 (5 7) 9) 为例:

  1. 应用 cdr ,得到 (3 (5 7) 9)

  2. 应用 cdr ,得到 ((5 7) 9)

  3. 应用 car ,得到 (5 7)

  4. 应用 cdr ,得到 (7)

  5. 应用 car ,得到 7

以下是对三个表的解答:

> (define ls1 (list 1 3 (list 5 7) 9))
> (define ls2 (list (list 7)))
> (define ls3 (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))
> (cadr (caddr ls1))

7

> (car (car ls2))

7

> (cadr (cadr (cadr (cadr (cadr (cadr ls3))))))

7

注意,对 (1 (2 3))cdr 之后只能得到 ((2 3)) ,还需要再取一次 car 才能得到 (2 3)

10 练习 2.26 | appendconslist 的不同🔗

逐个分析。

用解释器来验证一下:

> (define x (list 1 2 3))
> (define y (list 4 5 6))
> (append x y)

'(1 2 3 4 5 6)

> (cons x y)

'((1 2 3) 4 5 6)

> (list x y)

'((1 2 3) (4 5 6))

11 练习 2.27 | deep-reverse :深反转🔗

reverse 的不同之处是,在处理表中元素时,要看一眼元素本身是不是表(是不是序对)。如果是的话,要递归调用 deep-reverse 变换一下。

> (define (deep-reverse ls)
    (define (iter source dest)
      (if (null? source)
          dest
          (let ([head (car source)]
                [tail (cdr source)])
            (let ([new-head
                   (if (pair? head)
                       (deep-reverse head)
                       head)])
              (iter tail (cons new-head dest))))))
    (iter ls nil))
> (define x (list (list 1 2) (list 3 4)))
> x

'((1 2) (3 4))

> (reverse x)

'((3 4) (1 2))

> (deep-reverse x)

'((4 3) (2 1))

也可以在 deep-reverse 的入口处检查参数是否为表,不是的话直接返回。这样,在迭代过程中我们就能随意对每一个表项都调用 deep-reverse 了。

> (define (deep-reverse x)
    (define (iter source dest)
      (if (null? source)
          dest
          (let ([head (car source)]
                [tail (cdr source)])
            (iter tail (cons (deep-reverse head) dest)))))
    (if (pair? x)
        (iter x nil)
        x))
> (deep-reverse x)

'((4 3) (2 1))

但这样会使类似于 (deep-reverse 1) 这样的调用也能不声不响地返回一个值 1 ,而我们没有把这样的参数拦下的机会。至于这是不是想要的行为,这就不好说了。

12 练习 2.28 | fringe :取出树的全部叶子🔗

> (define (fold-right f default ls)
    (if (null? ls)
        default
        (f (car ls)
           (fold-right f default (cdr ls)))))
> (define (fringe x)
    (cond [(null? x) nil]
          [(pair? x)
           (let ([fringes-of-subtrees (map fringe x)])
             (fold-right append nil fringes-of-subtrees))]
          [else (list x)]))
> (define x (list (list 1 2) (list 3 nil (list 4 5 6))))
> x

'((1 2) (3 () (4 5 6)))

> (fringe x)

'(1 2 3 4 5 6)

fringe 的设计思路如下:

那么,如何拼接呢?

这里定义了一个过程 fold-right 。以 (fold-right f x (list a b c)) 为例,它的结果等同于 (f a (f b (f c x))) 的结果。它也是相当通用的函数,随后在练习 2.38 附近也会出现。

有了 fold-right 函数,我们用一个 (fold-right append nil fringes-of-subtrees) ,就可以把多个 fringe 的结果拼接起来了。

13 练习 2.29 | 二叉活动体🔗

分为 (a) (b) (c) (d) 四小题。

这里先将书上的 make-mobilemake-branch 定义出来。

> (define (make-mobile left right)
    (list left right))
> (define (make-branch length structure)
    (list length structure))

13.1 小题 2.29 (a)🔗

从一个表中取出首项需要 car ,第二项则是 cadr 。注意这与用 cons 时的不同。

> (define (left-branch m) (car m))
> (define (right-branch m) (cadr m))
> (define (branch-length b) (car b))
> (define (branch-structure b) (cadr b))

13.2 小题 2.29 (b)🔗

我们设计函数,它们能分别求出活动体、分支和结构的总重量。

> (define (simple-weight? x)
    (not (pair? x)))
> (define (total-weight-mobile m)
    (+ (total-weight-branch (left-branch m))
       (total-weight-branch (right-branch m))))
> (define (total-weight-branch b)
    (total-weight-structure (branch-structure b)))
> (define (total-weight-structure s)
    (if (simple-weight? s)
        s
        (total-weight-mobile s)))

这并不会造成无限递归,因为我们目前并不会造出循环的数据结构。总会碰到基底情况:结构是一个简单重量。

题上要求求活动体重量的函数要叫 total-weight ,我们就照做一下:

> (define (total-weight m)
    (total-weight-mobile m))

测试一下:

> (define m1 (make-mobile (make-branch 4 6)
                          (make-branch 3 8)))
> (define m2 (make-mobile (make-branch 7 4)
                          (make-branch 2 m1)))
> (define m3 (make-mobile (make-branch 7 5)
                          (make-branch 2 m1)))
> (total-weight m1)

14

> (total-weight m2)

18

> (total-weight m3)

19

13.3 小题 2.29 (c)🔗

一种直接的做法是按部就班地定义好各个函数:

> (define (torque-branch b)
    (* (total-weight-branch b)
       (branch-length b)))
> (define (balanced-mobile? m)
    (and (balanced-branch? (left-branch m))
         (balanced-branch? (right-branch m))
         (= (torque-branch (left-branch m))
            (torque-branch (right-branch m)))))
> (define (balanced-branch? b)
    (balanced-structure? (branch-structure b)))
> (define (balanced-structure? s)
    (if (simple-weight? s)
        true
        (balanced-mobile? s)))
> (map balanced-mobile? (list m1 m2 m3))

'(#t #t #f)

但这样其实导致了一些重复计算。在 balanced-mobile? 过程中,我们先判断了两个分支上的结构是否平衡,而这作出的计算其实已经足以得到两个结构的总重量了(只差两个加法操作)。但我们没能使用这些计算结果,而是又调用了一遍 torque-branch ,这需要重新对两个分支上的结构计算总重量。

要定量地分析这会怎样拖慢速度的话,我们考虑一个“满二叉活动体”(类比“满二叉树”) ,深度为 d ,有 n 个简单重量,则有 n \approx 2^d 。设上述的算法处理深度为 \Theta(d) 的满二叉活动体时所需时间为 T(d) ,则有递归式 T(d) = 4T(d-1) + \Theta(1) ,解得 T(d) = \Theta(4^d) = \Theta((2^d)^2) = \Theta(n^2) 。而如果能够使用中间计算结果,则有 T’(d) = 2T(d-1) + \Theta(1) ,解得 T’(d) = \Theta(n)

也就是说,如果有 n 个简单重量,那么优化前所需步数是 \Theta(n^2) ,优化后只需 \Theta(n) 步数。

我们来做一下这个优化:

> (define (torque-branch-with-weight b weight)
    (* weight
       (branch-length b)))
> (define (make-stat weight balance)
    (list weight balance))
> (define (weight-stat stat)
    (car stat))
> (define (balance-stat stat)
    (cadr stat))
> (define (stat-mobile m)
    (let ([lbranch (left-branch m)]
          [rbranch (right-branch m)])
      (let ([lstat (stat-branch lbranch)]
            [rstat (stat-branch rbranch)])
        (let ([lweight (weight-stat lstat)]
              [rweight (weight-stat rstat)]
              [lbalance (balance-stat lstat)]
              [rbalance (balance-stat rstat)])
          (make-stat (+ lweight rweight)
                     (and lbalance
                          rbalance
                          (= (torque-branch-with-weight lbranch lweight)
                             (torque-branch-with-weight rbranch rweight))))))))
> (define (stat-branch b)
    (stat-structure (branch-structure b)))
> (define (stat-structure s)
    (if (simple-weight? s)
        (make-stat s true)
        (stat-mobile s)))
> (define (fast-balanced-mobile? m)
    (balance-stat (stat-mobile m)))
> (map fast-balanced-mobile? (list m1 m2 m3))

'(#t #t #f)

我们将先前对活动体、分支和结构计算总重量的函数 total-weight-mobiletotal-weight-branchtotal-weight-structure 作出改造,使它们不止返回总重量,还返回“这个东西是否平衡”。这两个信息打包在一起,称为“状态”对象,在代码中称为 stat 。它有构造函数 make-stat ,以及选择函数 weight-statbalance-stat 。改造出来的函数称为 stat-mobilestat-branchstat-structure 。有了 stat-mobile ,我们对结果做一个 balance-stat ,就能轻松解决问题了。

13.4 小题 2.29 (d)🔗

得益于抽象屏障,有关活动体和分支如何的实现细节可以和程序中其他程序完全隔离开来,正如原书 2.1.2 节所说的那样。我们只需要更改它们的选择函数即可。获取活动体左分支和分支长度的选择函数刚好一个字都不用改;获取活动体右分支和分支上结构的选择函数则刚好只需要改一个字。将后者实现里的 cadr 改成 cdr 即可。

14 练习 2.30 | square-tree :对树的平方映射🔗

依葫芦画瓢,模仿正文里的 scale-tree 即可。

> (define tree-for-test (list 1
                              (list 2 (list 3 4) 5)
                              (list 6 7)))
> (define (square-tree tree)
    (cond [(null? tree) nil]
          [(not (pair? tree)) (square tree)]
          [else (cons (square-tree (car tree))
                      (square-tree (cdr tree)))]))
> (square-tree tree-for-test)

'(1 (4 (9 16) 25) (36 49))

> (define (square-tree tree)
    (map (lambda (sub-tree)
           (if (pair? sub-tree)
               (square-tree sub-tree)
               (square sub-tree)))
         tree))
> (square-tree tree-for-test)

'(1 (4 (9 16) 25) (36 49))

15 练习 2.31 | tree-map :对树的一般映射🔗

甚至只是将 练习 2.30 | square-tree :对树的平方映射 代码中的 square 改成一般的 proc 就可以了。

> (define (tree-map proc tree)
    (define (mapped tree)
      (map (lambda (sub-tree)
             (if (pair? sub-tree)
                 (mapped sub-tree)
                 (proc sub-tree)))
           tree))
    (mapped tree))
> (define (square-tree tree) (tree-map square tree))
> (square-tree tree-for-test)

'(1 (4 (9 16) 25) (36 49))

16 练习 2.32 | subsets :求集合的全部子集🔗

分为多个小节。

16.1 subsets 的代码🔗

> (define (subsets s)
    (if (null? s)
        (list nil)
        (let ((rest (subsets (cdr s))))
          (append rest (map (lambda (subset) (cons (car s) subset))
                            rest)))))
> (subsets (list 1 2 3))

'(() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))

s(1 2 3) 时为例,上述算法会先求出其 cdr ,即 (2 3) ,的全部子集,即 (() (3) (2) (2 3)) 。然后用 map 给这 4 个表都添上 1(它是刚才被遗弃的 (car s) ),又得到了 4 个表 ((1) (1 3) (1 2) (1 2 3)) 。用 append 把前面那 4 个表和现在这个 4 表放在一个表里,就得到了 (() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))

16.2 证明🔗

为了证明这个算法为什么正确,我们要先明白这个算法求的到底是什么。我们引入数学概念“幂集”(power set)。集合 S 的幂集就是它的所有子集所组成的集合,记为 \mathcal{P}(S) 。更正式的定义就是 \mathcal{P}(S) = \{ T \, | \, T \subseteq S \} 。例如当 S = \{ 1, 2, 3 \} 时,其幂集 \mathcal{P}(S) = \{ \{\}, \{3\}, \{2\}, \{2, 3\}, \{1\}, \{1, 3\}, \{1, 2\}, \{1, 2, 3\} \} 。所以刚才这个算法就是一个求集合幂集的算法。

刚才构造性地求集合 S 的幂集 \mathcal{P}(S) 的算法,是做了分情况讨论:

两个 \cup 左右不重叠是比较显然的,我们只证明一下为什么这个断言中的等式:

\mathcal{P}(S) = \mathcal{P}(S’) \cup \{ T’ \cup \{ e \} \, | \, T’ \in \mathcal{P}(S’) \}

是对的。我们将等式左侧称为 \text{LHS} ,右边称为 \text{RHS} 。我们要通过证明 \text{LHS} \subseteq \text{RHS}\text{LHS} \supseteq \text{RHS} 来证明 \text{LHS} = \text{RHS}

据此,我们证明了,对于非空集合,这个分治构造的定义确实和幂集的定义等价,这个等式是成立的。

16.3 一个求全部组合的算法🔗

给定一个整数 k ,和一个集合 S ,它有 n 个元素。从 S 中取出 k 个元素形成一个集合(所以这 k 个元素的顺序是不重要的),我们在这里将其称为一个组合。例如,当 S = \{ 1, 2, 3, 4, 5 \} k = 3 时, \{ 1, 3, 4 \} 就是一个组合。选出组合的总方法数称为组合数,记为 C_n^k ,也记为 \dbinom{n}{k}

我们可以实现一个 combinations 函数,将 \dbinom{n}{k} 个组合全部列出。代码如下:

> (define (combinations s k)
    (cond [(= k 0) (list nil)]
          [(= k (length s)) (list s)]
          [else
           (append (map (lambda (l)
                          (cons (car s) l))
                        (combinations (cdr s) (- k 1)))
                   (combinations (cdr s) k))]))
> (combinations (list 1 2 3 4 5) 3)

'((1 2 3)

  (1 2 4)

  (1 2 5)

  (1 3 4)

  (1 3 5)

  (1 4 5)

  (2 3 4)

  (2 3 5)

  (2 4 5)

  (3 4 5))

这里的思想仍然是递归和分治。我们想要得到 S 的所有 \dbinom{n}{k} 种组合,只需分三种情况:

直观上,我们如果关注着集合 S 中的一个元素 e ,现在又要从这个集合中取 k 个元素作为一个组合,那么这个 e 要么在组合里,要么不在组合里。如果在的话,我们就只用考虑在剩下的 n-1 的元素里怎么选出 k-1 个,最后只需把这个 e 加回来即可;如果不在的话,我们就只用考虑在剩下的 n-1 个元素里怎么选出 k 个,最后甚至也不用添回来。

16.4 一个只求组合数的算法:对组合数递推公式的证明🔗

如果我们不关注具体的方法,而只关注方法数,那么代码可以简化。我们可以得到 combination-count 过程,它只给出在有 n 个元素的集合中取出 k 个元素形成组合的方法总数,也就是 \dbinom{n}{k}

> (define (combination-count n k)
    (cond [(= k 0) 1]
          [(= k n) 1]
          [else
           (+ (combination-count (- n 1) (- k 1))
              (combination-count (- n 1) k))]))
> (combination-count 5 3)

10

我们无需再将 s 的具体内容传进去,只需要传入元素个数 n ;在 k 等于 0 或者 n 时,原本的“列出这一个方法”改成了“给出 1 ”;原本的 (cdr s) 变成了 (- n 1) ;原本对具体方法的列表的 append 变成了对方法数量的 +

可以发现,代码里其实出现了组合数著名的递推公式:

\dbinom{n}{k} = \dbinom{n-1}{k-1} + \dbinom{n-1}{k}

而事实上,刚才的思路确实构成对这个公式的证明。

16.5 一个只求子集个数的算法:对子集个数公式的证明🔗

如果将类似的想法套在求幂集的算法上,我们能得到什么呢?

> (define (subset-count n)
    (if (= n 0)
        1
        (* 2 (subset-count (- n 1)))))
> (subset-count 5)

32

空集只有 1 个子集。而有 n 个元素的集合,它的子集个数,是有 n-1 个元素的集合的子集个数的 2 倍。从上述的前提出发,用数学归纳法,就能轻松证明: n 个元素的集合,其子集个数为 2^n

16.6 为什么生成的结果顺序很“自然”🔗

我们观察 (subsets (list 1 2 3)) 的结果,它是一个表,8 个元素分别是:

(     )

(    3)

(  2  )

(  2 3)

(1    )

(1   3)

(1 2  )

(1 2 3)

可以发现,这和 3 位二进制数计数时的样子是一样的:

0 0 0

0 0 1

0 1 0

0 1 1

1 0 0

1 0 1

1 1 0

1 1 1

这是因为,对于首个元素 (car s) ,我们先让它不出现在各个结果的开头,再让它出现在各个结果的开头,前者比后者先在最终的答案里出现。这是代码中的逻辑。所以,如果对于有 n-1 个元素的列表, subsets 生成的结果是有着二进制计数的样子的,那么对于有 n 个元素的列表, subsets 生成的结果也将是有着二进制计数的样子的。而对于 1 个元素的列表,结果显然也是如此。(0 个元素时的情况也符合。)由数学归纳法,我们就知道, subsets 生成的结果,确实一定有着二进制计数的样子。

而对于 combinations 函数,我们看到它的结果:

> (combinations (list 1 2 3 4 5) 3)

'((1 2 3)

  (1 2 4)

  (1 2 5)

  (1 3 4)

  (1 3 5)

  (1 4 5)

  (2 3 4)

  (2 3 5)

  (2 4 5)

  (3 4 5))

刚好是按照字典序排列的,只要原本的列表已经有序了。证明方法和刚才差不多,对于首个元素 (car s) ,我们先让它出现在某些结果的开头,再让它不出现在其他一些结果中,前者比后者先在最终的答案里出现。

combinations 函数并不基于比较,而是基于位置。即使传入的列表不是有序的,结果列表中的结果在映射到它们在原列表中的位置之后,结果列表也构成从小到大的字典序。

17 练习 2.33 | 基本的表操作也可以用 accumulate 表达🔗

我们需要更清晰地了解一下这个 accumulate 。比如 (accumulate f init (list 1 2 3 4)) 计算的是 (f 1 (f 2 (f 3 (f 4 init)))) ,以此类推。所以,当 fconsinitnil 时,它就会返回表,而且内容仍是 (1 2 3 4)

对于 map ,我们让 cons 仍然能生成序对,但是会把第一操作数修改一下,用 p 修改,这样结果的表的每一项就都是用 p 映射过的了。

> (define (map p sequence)
    (accumulate (lambda (x y) (cons (p x) y)) nil sequence))
> (map square (list 1 2 3 4 5))

'(1 4 9 16 25)

对于 append ,我们把 nil 换成 seq2 ,这样就把 seq2 接到 seq1 的后面了。

> (define (append seq1 seq2)
    (accumulate cons seq2 seq1))
> (append (list 1 2 3 4 5) (list 6 7 8 9 10))

'(1 2 3 4 5 6 7 8 9 10)

对于 length ,我们只需利用一个如下事实: p 被调用的次数刚好和列表长度相等。我们也并不需要读取列表中各项的内容。

> (define (length sequence)
    (accumulate (lambda (x y) (+ 1 y)) 0 sequence))
> (length (list 6 7 8 9 10))

5

18 练习 2.34 | horner-eval :线性步数求多项式值🔗

> (define (horner-eval x coefficient-sequence)
    (accumulate (lambda (this-coeff higher-terms) (+ this-coeff (* x higher-terms)))
                0
                coefficient-sequence))
> (horner-eval 2 (list 1 3 0 5 0 1))

79

其实不用 accumulate 而是手写递归也比较有意思:

> (define (horner-eval x coefficient-sequence)
    (if (null? coefficient-sequence)
        0
        (+ (car coefficient-sequence)
           (* x (horner-eval x (cdr coefficient-sequence))))))
> (horner-eval 2 (list 1 3 0 5 0 1))

79

意思是:

\begin{align*} a_0 + a_1 x + a_2 x^2 + \cdots + a_n x^n &= a_0 + x (a_1 + a_2 x + \cdots + a_n x^{n-1}) \\ &= a_0 + x (b_0 + b_1 x + \cdots + b_{n-1} x^{n-1}) \end{align*}

上边的都产生递归计算过程,下面写一个迭代计算过程的:

> (define (horner-eval x coefficient-sequence)
    (define (iter result rest-coefficient)
      (if (null? rest-coefficient)
          result
          (iter (+ (* x result) (car rest-coefficient))
                (cdr rest-coefficient))))
    (iter 0 (reverse coefficient-sequence)))
> (horner-eval 2 (list 1 3 0 5 0 1))

79

不变量是:每次调用 (iter result ls) 时,都满足

之和不变,而且等于最终要计算出的值。这样一来,原本的系数列表中, n 次项系数刚好会与 x 相乘 n 次。

上边的版本使用了 reversereverse 可以实现成产生迭代过程的版本,所以上述算法只需常数额外空间。

再写一个不需要 reverse 的版本:

> (define (horner-eval x coefficient-sequence)
    (define (iter result i x-power rest-coefficient)
      (if (null? rest-coefficient)
          result
          (iter (+ result (* x-power (car rest-coefficient)))
                (+ i 1)
                (* x x-power)
                (cdr rest-coefficient))))
    (iter 0 0 1 coefficient-sequence))
> (horner-eval 2 (list 1 3 0 5 0 1))

79

不变量是:每次调用 (iter result x-power ls) 时,都满足 x-power 等于 x^i ,以及

之和不变,而且等于最终要计算出的值。

这里显式地将 i 作为参数,只是为了方便描述不变量。这个参数其实是多余的,可以去掉。

上述算法也只需常数额外空间。

书中也提到:“这一规则是 W. G. Horner 在 19 世纪早期提出的,但这一方法在 100 多年前就已经被牛顿实际使用了。”但这个算法的历史远不止于此。它还有一个名字叫秦九韶算法。

中文维基百科上的 秦九韶算法#历史 列出了一些比 Horner 更早的发现者:

(其中最后一条所引用的参考资料可能不可靠。)

(复制时间:2026-04-23)

19 练习 2.35 | 用 accumulate 重新定义 count-leaves🔗

练习 2.28 | fringe :取出树的全部叶子 相似。其实在那里,我们定义的 fold-rightaccumulate 就是同一个东西。练习 2.38 也有提到。

与之不同的是,我们将使用 +0 而非 consnil ,因为在这里我们不需要用表把叶子们的实际内容记下来,而是只需要记长度。

> (define (count-leaves x)
    (cond [(null? x) 0]
          [(pair? x)
           (let ([leaf-counts-of-subtrees (map count-leaves x)])
             (accumulate + 0 leaf-counts-of-subtrees))]
          [else 1]))
> (define x (list (list 1 2) (list 3 nil (list 4 5 6))))
> x

'((1 2) (3 () (4 5 6)))

> (count-leaves x)

6

20 练习 2.36 | accumulate-n :差不多是个可变参数版本 accumulate🔗

分为多个小节。

20.1 accumulate-n 的代码🔗

> (define (accumulate-n op init seqs)
    (if (null? (car seqs))
        nil
        (cons (accumulate op init (map car seqs))
              (accumulate-n op init (map cdr seqs)))))
> (define data (list (list 1 2 3) (list 4 5 6) (list 7 8 9) (list 10 11 12)))
> (accumulate-n + 0 data)

'(22 26 30)

> (accumulate-n cons nil data)

'((1 4 7 10) (2 5 8 11) (3 6 9 12))

注意到 (accumulate-n cons nil data) 会让 data 的行变成列、列变成行,就像矩阵转置一样。紧接着的 练习 2.37 | 矩阵与向量操作 就要我们实现矩阵转置操作 transpose ,方法其实就是这样。在那里也有更详细的讲解。

20.2 为什么并非真正的变参 accumulate🔗

需要注意的是,例如生成 22accumulate-n 并不是通过计算 (+ 1 4 7 10) 生成的,而是做了相当于 (accumulate + 0 (list 1 4 7 10)) ,也就是 (+ 1 (+ 4 (+ 7 (+ 10 0)))) 的计算。要想拿着 (list 1 4 7 10) 计算 (+ 1 4 7 10) ,需要使用后面章节所使用的 apply 函数(见 2.4.3 节中的脚注):

> (apply + (list 1 4 7 10))

22

因此,即使使用 练习 2.20 | 用带点尾部记法接收任意多个参数,以及 same-parity 这道练习题所提到的带点尾部记法让传入的多个序列能够直接写出而不需要手动包装进一个 list 里,我们仍然不能说 accumulate-n 就是 accumulate 的一种变参版本,至少不能说它相对于 accumulate 就像 Scheme 标准中的通用 map 相对于书中使用的一元 map 那样(见原书 2.2.1 节的脚注)。

20.3 variadic-accumulate :真正的变参 accumulate🔗

如果可以使用 apply ,我们就能定义出真正的变参版本 accumulate 了。

Racket 自带的 apply 函数做了一些扩展,例如 (apply + 1 2 (list 3 4))(apply + (list 1 2 3 4)) 效果相同。这样一来, (apply f (append (list a b c) ls)) 就可以简写成 (apply f a b c ls) 了。这里的代码没有使用这种简写。

> (define (variadic-accumulate f init . seqs)
    (if (null? (car seqs))
        init
        (apply f (append (map car seqs)
                         (list (apply variadic-accumulate
                                      (append (list f init)
                                              (map cdr seqs))))))))
> (variadic-accumulate
   (lambda (a b result)
     (* result (- a b)))
   1
   (list 1 2 3)
   (list 4 5 6))

-27

事实上,这个 variadic-accumulate 的用法,就和 Racket 自带的 foldr 一样了。

20.4 随手写个变参 map🔗

变参 map 使用了一个 map1 ,后者就是书中使用的一元 map 。当然,它在变参 map 的实现中并不是必要的。

> (define (map1 f ls)
    (if (null? ls)
        nil
        (cons (f (car ls))
              (map1 f (cdr ls)))))
> (define (map f . seqs)
    (if (null? (car seqs))
        nil
        (cons (apply f (map1 car seqs))
              (apply map (cons f (map1 cdr seqs))))))
> (map + (list 1 2 3) (list 40 50 60) (list 700 800 900))

'(741 852 963)

此外,这也方便了下一题 练习 2.37 | 矩阵与向量操作dot-product 的实现。

21 练习 2.37 | 矩阵与向量操作🔗

先定义一些测试数据:

> (define v (list 1 2 3))
> (define w (list 4 5 6))
> (define A
    (list (list 1 2 3 4)
          (list 5 6 7 8)))
> (define B
    (list (list 1 2 3)
          (list 4 5 6)
          (list 7 8 9)
          (list 10 11 12)))

n 维向量 vn 维向量 w 做点积,会得到一个数。计算方法其实就是:将两个向量中位置相同的数相乘,再将得到的 n 个积相加。也就是说,

\begin{bmatrix} v_1 \\ v_2 \\ \vdots \\ v_n \end{bmatrix} \cdot \begin{bmatrix} w_1 \\ w_2 \\ \vdots \\ w_n \end{bmatrix} = v_1 w_1 + v_2 w_2 + \cdots + v_n w_n

下文中的向量点乘可能会接收到行向量,此时将其转置变成列向量即可。

因此可以用变参版本 mapaccumulate 实现点积操作:

> (define (dot-product v w)
    (accumulate + 0 (map * v w)))
> v

'(1 2 3)

> w

'(4 5 6)

> (dot-product v w)

32

m \times n 矩阵 A 与一个 n 维列向量 v 相乘,会得到一个 m 维向量。计算方法其实就是:将矩阵的 m 个行都作为向量看待,并让它们各自和 v 做点积,得到的 m 个数组成 m 维向量,这就是结果。也就是说,

\begin{bmatrix} A_{1*} \\ A_{2*} \\ \vdots \\ A_{m*} \end{bmatrix} \cdot v = \begin{bmatrix} A_{1*} \cdot v \\ A_{2*} \cdot v \\ \vdots \\ A_{m*} \cdot v \end{bmatrix}

在这里, A 的第 i 行记为 A_{i*}

因此可以用 map 配合 dot-product 实现矩阵与向量的乘法:

> (define (matrix-*-vector m v)
    (map (lambda (row) (dot-product row v)) m))
> B

'((1 2 3) (4 5 6) (7 8 9) (10 11 12))

> v

'(1 2 3)

> (matrix-*-vector B v)

'(14 32 50 68)

矩阵转置将矩阵的行变成列,列变成行。 accumulate-n 会先对各个行的首个元素做 accumulate ,再对各个行的第二个元素做 accumulate ……最后将结果做成一个表返回。如果将“各个行的首个元素”组合成表,这个表的内容就是原矩阵的第一列了,以此类推。因此可以用 accumulate-n ,传入 consnil ,实现矩阵转置操作。

> (define (transpose mat)
    (accumulate-n cons nil mat))
> B

'((1 2 3) (4 5 6) (7 8 9) (10 11 12))

> (transpose B)

'((1 4 7 10) (2 5 8 11) (3 6 9 12))

m \times n 矩阵 A 与一个 n \times k 矩阵 B 相乘,会得到一个 m \times k 矩阵。计算方法其实就是:将 Am 个行与 Bk 个列分别做点积,第 i 个行与第 j 个列的点积就是结果矩阵中第 i 行第 j 列的数。也就是说,

\begin{bmatrix} A_{1*} \\ A_{2*} \\ \vdots \\ A_{m*} \end{bmatrix} \cdot \begin{bmatrix} B_{*1} & B_{*2} & \cdots & B_{*k} \end{bmatrix} = \begin{bmatrix} A_{1*} \cdot B_{*1} & A_{1*} \cdot B_{*2} & \cdots & A_{1*} \cdot B_{*k} \\ A_{2*} \cdot B_{*1} & A_{2*} \cdot B_{*2} & \cdots & A_{2*} \cdot B_{*k} \\ \vdots & \vdots & \ddots & \vdots \\ A_{m*} \cdot B_{*1} & A_{m*} \cdot B_{*2} & \cdots & A_{m*} \cdot B_{*k} \end{bmatrix}

我们发现,结果矩阵的第 i 行其实可以表示成 B 的转置 B^{\mathrm{T}}A 的第 i 行做点积:

B^{\mathrm{T}} \cdot A_{i*} = \begin{bmatrix} {B_{*1}}^{\mathrm{T}} \\ {B_{*2}}^{\mathrm{T}} \\ \vdots \\ {B_{*k}}^{\mathrm{T}} \end{bmatrix} \cdot A_{i*} = \begin{bmatrix} A_{i*} \cdot B_{*1} & A_{i*} \cdot B_{*2} & \cdots & A_{i*} \cdot B_{*k} \end{bmatrix}

所以矩阵乘法的结果可以重写一下:

\begin{bmatrix} A_{1*} \cdot B_{*1} & A_{1*} \cdot B_{*2} & \cdots & A_{1*} \cdot B_{*k} \\ A_{2*} \cdot B_{*1} & A_{2*} \cdot B_{*2} & \cdots & A_{2*} \cdot B_{*k} \\ \vdots & \vdots & \ddots & \vdots \\ A_{m*} \cdot B_{*1} & A_{m*} \cdot B_{*2} & \cdots & A_{m*} \cdot B_{*k} \end{bmatrix} = \begin{bmatrix} B^{\mathrm{T}} \cdot A_{1*} \\ B^{\mathrm{T}} \cdot A_{2*} \\ \vdots \\ B^{\mathrm{T}} \cdot A_{k*} \\ \end{bmatrix}

因此可以用 transposemapmatrix-*-vector 实现矩阵相乘操作:

> (define (matrix-*-matrix m n)
    (let ((cols (transpose n)))
      (map (lambda (row) (matrix-*-vector cols row)) m)))
> A

'((1 2 3 4) (5 6 7 8))

> B

'((1 2 3) (4 5 6) (7 8 9) (10 11 12))

> (matrix-*-matrix A B)

'((70 80 90) (158 184 210))