《SICP》习题第2章

本人做的SICP习题第2章，如有错误请指正，用的解释器是Racket

练习2.1

;; Exercise 2.1
;; 有理数
#lang racket

;; 有理数定义
(define (numer x) (car x))
(define (demon x) (cdr x))
;; 处理分子分母均为正的有理数
(define (make-positive-rat n d)
  (let ((g (gcd n d)))
    (cons (/ n g) (/ d g))))
;; 处理正负有理数
(define (make-rat n d)
  (define positive-rat (make-positive-rat (abs n) (abs d)))
  (if (< (* n d) 0)
      (cons (- (numer positive-rat)) (demon positive-rat))
      positive-rat))

练习2.2

point相关的代码

;; Exercise 2.2
;; point
#lang racket
(provide (all-defined-out))

;; selector
(define (x-point x) (car x))
(define (y-point x) (cdr x))

;; make
(define (make-point x y) (cons x y))

;; print
(define (print-point p)
  (newline)
  (display "(")
  (display (x-point p))
  (display ",")
  (display (y-point p))
  (display ")"))

segment相关

;; Exercise 2.2
;; segment
#lang racket
(require "point.rkt")
(provide (all-defined-out))

;; selector
(define (start-segment x) (car x))
(define (end-segment x) (cdr x))

;; make
(define (make-segment start end)
  (cons start end))

;; 平均数
(define (avg x y)
  (/ (+ x y) 2.0))

;; 求中点
(define (midpoint-segment s)
  (make-point (avg (x-point (start-segment s)) (x-point (end-segment s))) (avg (y-point(start-segment s)) (y-point (end-segment s)))))

练习2.3

看起来题目是想让我们用多种不同的底层方法实现矩形，然后计算周长和面积的函数不论底层实现怎么样都可以用

先写周长和面积函数

;; Exercise 2.3
;; 矩形的相关计算
#lang racket
(require "rectangle-by-segment.rkt")
(provide (all-defined-out))

;; 计算周长
(define (perimeter rectangle)
  (* 2 (+ (width rectangle) (height rectangle))))

;; 计算面积
(define (area rectangle)
  (* (width rectangle) (height rectangle)))

第一种实现方法，用两根线定义矩形，为了方便计算长宽，修改练习2.2中的segment，增加一个函数计算线段的长度

;; 求线段长度
(define (length s)
  (sqrt (+ (square (- (x-point (start-segment s)) (x-point (end-segment s))))
           (square (- (y-point (start-segment s)) (y-point (end-segment s)))))))

现在实现矩形

;; Exercise 2.3
;; 通过宽和高定义矩形
#lang racket
(provide (all-defined-out))
(require "segment.rkt")

;; make
(define (make-rectangle s1 s2) (cons s1 s2))

;; selector
(define (width r)
  (length (car r)))
(define (height r)
  (length (cdr r)))

第二种方法，用四个点实现矩形，其实三个点就可以定义一个矩形，为了方便还规定了四个点必须按顺时针顺序输入（不然还要判断哪两个点在对角线上，麻烦）

;; Exercise 2.3
;; 通过4个点定义矩形
#lang racket
(require "point.rkt")
(require "segment.rkt")
(provide (all-defined-out))

;; make
(define (make-rectangle p1 p2 p3 p4)
  (cons (cons p1 p2) (cons p3 p4)))

;; selector
(define (width r)
  (length (make-segment (car (car r)) (cdr (car r)))))
(define (height r)
  (length (make-segment (cdr (car r)) (cdr (cdr r)))))

最后来写一个测试方法，测试两种矩形实现方式

;; Exercise 2.3
;; 矩形测试
#lang racket
(require "point.rkt")
(require "segment.rkt")
(require "rectangle-calculate.rkt")
;; 可以替换矩形底层实现
(require "rectangle-by-point.rkt")
;; (require "rectangle-by-segment.rkt")

;; 定义四个点
(define p1 (make-point 3 4))
(define p2 (make-point 5 6))
(define p3 (make-point 7 4))
(define p4 (make-point 5 2))

;; 定义两条边
(define s1 (make-segment p1 p2))
(define s2 (make-segment p2 p3))

;; 定义矩形
(define r (make-rectangle p1 p2 p3 p4))
;; (define r (make-rectangle s1 s2))

;; 计算周长和面积
(perimeter r)
(area r)

练习2.4

;; Exercise 2.4
;; cons的另一种定义方法
#lang racket

;; cons
(define (cons x y)
  (lambda (m) (m x y)))

;; selector
(define (car z)
  (z (lambda (p q) p)))
(define (cdr z)
  (z (lambda (p q) q)))

这段代码，(car (cons x y))可以替换为((lambda (m) (m x y)) (lambda (p q) p))

进一步替换为((lambda (p q) p) x y)

所以(car (cons x y))可以返回x

其实cons就是返回一个匿名函数，这个匿名函数接收一个函数，并将x、y作为参数输入给这个函数

练习2.5

;; Exercise 2.5
;; 用2^a3^b这个整数，记录a、b
#lang racket

;; cons
(define (cons a b)
  (* (expt 2 a) (expt 3 b)))

;; 判断是否为偶数
(define (even? x)
  (=  (remainder x 2) 0))

;; 获取x中因子a的个数
(define (get-factor-num x a)
  (define (iter n r)
    (if (= (remainder r a) 0)
        (iter (+ n 1) (/ r a))
        n))
  (iter 0 x))
      
;; selector
(define (car c)
  (get-factor-num c 2))
(define (cdr c)
  (get-factor-num c 3))

练习2.6

这道题的题干初看有点懵逼的，我个人肤浅的理解写在了这里SICP习题2.6 题目理解

求1，1就是(add-1 zero)，2就是(add-1 one)，以此类推，答案在下面，展开就是了

;; Exercise 2.6
;; 丘奇数
#lang racket

;; 0
(define zero (lambda (f) (lambda (x) x)))

;; 加1
(define (add-1 n)
  (lambda (f) (lambda (x) (f ((n f) x)))))

;; 1
(define one
  (lambda (f) (lambda (x) (f x))))

;; 2
(define two
  (lambda (f) (lambda (x) (f (f x)))))

总结一下，丘奇数，就是f(f(f(...x)))中，调用f的次数来表示对应的数的

仔细看一下丘奇数的函数，(丘奇数 f)这个调用所返回的函数就是给输入套上多层f的外壳，丘奇数对应几就套几个f壳

所以加法就是一个套壳的操作，两个输入是m和n（注意是丘奇数不是阿拉伯数字），先套n个壳，再套m个壳，就是加法了

;; 加
(define (add m n)
  (lambda (f)
    (lambda (x)
      ((m f) ((n f) x)))))

练习2.7

超简单

;; Exercise 2.7
;; 区间计算
#lang racket

;; make
(define (make-interval a b) (cons a b))

;; selector
(define (lower-bound i)
  (car i))
(define (upper-bound i)
  (cdr i))

练习2.8

;; 减
(define (sub-interval x y)
  (make-interval (- (lower-bound x) (upper-bound y))
                 (- (upper-bound y) (lower-bound y))))

练习2.9

假设区间和

对于加法，

区间的宽度为 $\frac{x_2+y_2-x_1-y_1}{2} = \frac{x_2-x_1}{2}+\frac{y_2-y_1}{2}$ ，等于原区间宽度之和

对于减法，

区间的宽度为 $\frac{x_2-y_2-x_1+y_1}{2} = \frac{x_2-x_1}{2}-\frac{y_2-y_1}{2}$ ，等于原区间宽度之差

对于乘法，假设有区间和，相乘得到，宽度为5，原宽度是1和3，并不等于原区间宽度的积

对于除法，假设有区间和，相除得到，宽度为5.5，原宽度是1和3，并不等于原区间宽度的商

练习2.10

;; 除
(define (div-interval x y)
  (if (span-zero? y)
      (error "the interval spans zero")
      (mul-interval x 
                    (make-interval (/ 1.0 (upper-bound y))
                                   (/ 1.0 (lower-bound y))))))

;; 检测区间是否跨过0，包含端点在0的情况
(define (span-zero? i)
  (and (<= (lower-bound i) 0) (>= (upper-bound i) 0)))

;; 检测区间是否跨过0，包含端点在0的情况
(define (span-zero? i)
  (and (<= (lower-bound i) 0) (>= (upper-bound i) 0)))

练习2.11

一个区间有9种情况，在0的左侧，在0的右侧，横跨0

因此两个区间就有9种情况，列个表，假设区间和，区间在0左侧就用<0表示，在0右侧表示为>0

分布情况	乘法
x>0,y>0
x>0,y=0
x>0,y<0
x=0,y>0
x=0,y=0
x=0,y<0
x<0,y>0
x<0,y=0
x<0,y<0

代码如下

;; 判断区间是否在0右侧
(define (right-zero? i)
  (and (> (lower-bound i) 0) (> (upper-bound i) 0)))

;; 乘
(define (mul-interval x y)
  (let ((p1 (* (lower-bound x) (lower-bound y)))
        (p2 (* (lower-bound x) (upper-bound y)))
        (p3 (* (upper-bound x) (lower-bound y)))
        (p4 (* (upper-bound x) (upper-bound y))))
    (cond ((right-zero? x)
           (cond ((right-zero? y) (make-interval p1 p4))
                 ((span-zero? y)  (make-interval p3 p4))
                 (else (make-interval p3 p2))))
          ((span-zero? x)
           (cond ((right-zero? y) (make-interval p2 p4))
                 ((span-zero? y)  (make-interval (min p2 p3) (max p1 p4)))
                 (else (make-interval p3 p1))))
          (else
           (cond ((right-zero? y) (make-interval p2 p3))
                 ((span-zero? y)  (make-interval p2 p1))
                 (else (make-interval p4 p1)))))))

练习2.12

;; 百分比表示，make
(define (make-center-percent c p)
  (make-interval (- c (* c p)) (+ c (* c p))))

;; 百分比表示，selector
(define (center i)
  (/ (+ (lower-bound i) (upper-bound i)) 2))
(define (percent i)
  (/ (- (upper-bound i) (center i)) (center i)))

练习2.13

假设两个区间， $x_c\pm x_cx_p$ 和 $y_c\pm y_cy_p$ ，相乘得到的区间为

用百分比来表达，中心点为，误差百分比是是 $\frac{x_p+y_p}{1+x_py_p}$

练习2.14

现有的代码，A/A得不到[1,1]

练习2.15

par2可以得到正确的结果，par1是错误的

举个例子，两个电阻的阻值范围[2,3],[4,5]

par1计算的分子是[6,8]，分母是[8,15]

除出来是[0.6000000000000001,1.0]，是错误的，因为分子的最大值，8，是阻值取3和5的结果，而分母的最小值8，是阻值取2和4的结果

虽然电阻存在误差，但是一个电阻的阻值是不会变的，所以par1计算的是不可能存在的结果

学术一点来说，就是每个区间之间是独立的，但是出现在一个公式里的相同区间不是独立的，而我们程序考虑的都是每个输入区间完全独立的情况

如果每个区间只在计算中出现一次，就避免了这种情景，所以Eva Lu Ator说的是对的

练习2.16

思考了一下，区间运算，本质就是一个熟悉的数学问题，给出一个函数和多个自变量的范围，求函数的取值范围

如果自变量只有一个，很好做，初中都学过，如果自变量有多个呢，驻点、求偏导等一系列操作

首先，要写出正确的程序，我们必须时刻关注，出现一次以上的区间的相关性，需要把相同的区间区分开来

其次，要求偏导，求驻点，求偏导需要符号计算，求驻点需要解方程……

我感觉我这个水平做不到

练习2.17

;; Exercise 2.17
;; list
#lang racket

;; 返回list最后一个元素
(define (last-pair l)
  (if (null? (cdr l))
      (car l)
      (last-pair (cdr l))))

练习2.18

;; 反转list
(define (reverse l)
  (define (reverse-iter remain result)
    (if (null? remain)
        result
        (reverse-iter (cdr remain) (cons (car remain) result))))
  (reverse-iter l null))

练习2.19

;; Exercise 2.19
;; 使用list重写count-change
#lang racket

;; 硬币大小
(define us-coins (list 50 25 10 5 1))
(define uk-coins (list 100 50 20 10 5 2 1 0.5))

;; 计算找零方式
(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)))))

;; 判断是否没有其余硬币作为选择
(define (no-more? coin-values)
  (null? coin-values))

;; 放弃使用当前硬币
(define (except-first-denomination coin-values)
  (cdr coin-values))

;; 获取当前硬币价值
(define (first-denomination coin-values)
  (car coin-values))

练习2.20

构建一个新的list，把符合条件的元素加到list里，最后反转整个list得到

;; Exercise 2.20
;; 返回与第一个元素奇偶性一致的元素
#lang racket
(require "list.rkt")

;; 判断奇偶性一致
(define (same? x y)
  (= (remainder x 2) (remainder y 2)))

;; 过滤
(define (same-parity x . l)
  (define (same-parity-iter remain result)
    (if (null? remain)
        (cons x (reverse result))
        (if (same? x (car remain))
            (same-parity-iter (cdr remain) (cons (car remain) result))
            (same-parity-iter (cdr remain) result))))
  (same-parity-iter l null))

练习2.21

;; 对队列中的每个数取平方，递归版
(define (square-list-recursive items)
  (if (null? items)
      null
      (cons (* (car items) (car items)) (square-list-recursive (cdr items)))))

;; 对队列中的每个数取平方，map版
(define (square-list-map items)
  (map (lambda(x) (* x x)) items))

练习2.22

越先和result进行cons操作的元素，越排在列表的后面

迭代的时候是从头到尾迭代的，所以最后的结果是反的

第二段代码是错误的，假设一个list是(1,2,3,4,5)

第一次迭代时，调用了(iter (1,2,3,4,5) nil)，最后执行了(cons null 1)

第二次迭代时，调用了(iter (2,3,4,5) (cons null 1)，最后执行了(cons (cons null 1) 4))

所以这段代码调用的结果是(((((() . 1) . 4) . 9) . 16) . 25)，这个结构不是list，是list结构的颠倒，如果把car和cdr调换一下，本质上还是一个(25,16,9,4,1)

练习2.23

;; Exercise 2.23
;; for循环
#lang racket

;; 对l中的每个元素执行f
(define (for-each f l)
  (cond ((not (null? l))
         (f (car l))
         (for-each f (cdr l)))))

练习2.24

eval之后是(1 (2 (3 4)))

练习2.25

比较难的就是第三个，对l3执行一次cdr之后得到的是一个list，但不是直接(2,3,4,5,6,7)，而是一个((2,3,4,5,6,7), null)，所以要一个car取出list

;; Exercise 2.25
;; 获取list中的7
#lang racket

(define l1 (list 1 3 (list 5 7) 9))
(define l2 (list (list 7)))
(define l3 (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))

;; 获取7
(car (cdr (car (cdr (cdr l1)))))
(car (car l2))
(car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr l3))))))))))))

练习2.26

答案分别是：

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

这一章一直很疑惑，为什么(cons (list 1 2) (list 3 4))是((1 2) 3 4)

展开一下list，是(cons 1 (cons 2 nil))和(cons 3 (cons 4 nil))

所以展开(cons (list 1 2) (list 3 4))

(cons (cons 1 (cons 2 nil)) (cons 3 (cons 4 nil)))，打印出来是((1 2) 3 4)，从展开式可以看出来这是一个3元素的list，第1个元素是list，后两个元素是数字，因为缺少了一个nil

再展开一下(list (list 1 2) (list 3 4))

(cons (cons 1 (cons 2 nil)) (cons (cons 3 (cons 4 nil)) nil))，打印出来是((1 2) (3 4))，从展开式可以看出来这是一个2元素的list，每个元素都是一个list

练习2.27

;; Exercise 2.27
;; 深度翻转list
#lang racket

;; 深度翻转list
(define (deep-reverse l)
  (define (iter remain result)
    (if (null? remain)
        result
        (iter (cdr remain) (cons (deep-reverse (car remain)) result))))
  (if (pair? l)
      (iter l null)
      l))

练习2.28

;; Exercise 2.28
;; 从左到右，返回一棵树的所有叶节点
#lang racket

;; 返回叶节点
(define (fringe tree)
  (cond ((null? tree) null)
        ((pair? tree) (append (fringe (car tree)) (fringe (cdr tree))))
        (else (list tree))))

练习2.29

;; mobile selector
(define (left-branch m)
  (car m))
(define (right-branch m)
  (car (cdr m)))

;; branch selector
(define (branch-length m)
  (car m))
(define (branch-structure m)
  (car (cdr m)))

;; 判断branch是否包含mobile
(define (branch-contains-mobile b)
  (pair? (branch-structure b)))

;; 判断branch的总重
(define (total-weight-branch b)
  (cond ((null? b) 0)
        ((branch-contains-mobile b) (total-weight (branch-structure b)))
        (else (branch-structure b))))

;; mobile的总重
(define (total-weight m)
  (cond ((null? m) 0)
        ((pair? m) (+ (total-weight-branch (left-branch m))
                      (total-weight-branch (right-branch m))))
        (else m)))

;; 计算branch产生的力矩
(define (torque b)
  (* (branch-length b) (total-weight-branch b)))

;; 判断branch是否平衡
(define (balance-branch b)
  (if (branch-contains-mobile b)
      (balance (branch-structure b))
      true))

;; 判断mobile是否平衡
(define (balance m)
  (if (null? m)
      true
      (and (= (torque (left-branch m)) (torque (right-branch m)))
           (balance-branch (left-branch m))
           (balance-branch (right-branch m)))))

只需要修改selector即可

;; Exercise 2.29
;; 用cons构造mobile
#lang racket

;; make mobile
(define (make-mobile left right)
  (cons left right))

;; make branch
(define (make-branch length structure)
  (cons length structure))

;; mobile selector
(define (left-branch m)
  (car m))
(define (right-branch m)
  (cdr m))

练习2.30

;; Exercise 2.39
;; 对树里的所有元素取平方
#lang racket

;; 对树里所有元素取平方
(define (square-tree t)
  (cond ((null? t) null)
        ((pair? t) (cons (square-tree (car t)) (square-tree (cdr t))))
        (else (square t))))

;; 平方
(define (square x)
  (* x x))

练习2.31

;; Exercise 2.31
;; 对树里的所有元素采取某种操作
#lang racket

;; map
(define (tree-map proc t)
  (cond ((null? t) null)
        ((pair? t) (cons (tree-map proc (car t)) (tree-map proc (cdr t))))
        (else (proc t))))

(define t
  (list 1
       (list 2 (list 3 4) 5)
       (list 6 7)))

(tree-map (lambda (x) (* x x)) t)

练习2.32

把一个集合分成两部分，首元素和其余部分，那么这个集合的所有子集，也可以分为两个部分

一个部分是其余部分的子集，另一个部分是其余部分的子集再加上首元素

以(1 2 3)为例，分为1和(2 3)，其子集分为两个部分

(2 3)的子集() (3) (2) (2 3)

和(2 3)子集并入首元素1，(1) (1 3) (1 2) (1 2 3)

;; Exercise 2.32
;; 生成一个list的所有子list
#lang racket

;; 子list生成
(define (subsets s)
  (if (null? s)
      (list null)
      (let ((rest (subsets (cdr s))))
        (append rest (map (lambda (l) (cons (car s) l)) rest)))))

练习2.33

;; map-by-accumulate
(define (map-by-accumulate p sequence)
  (accumulate (lambda (x y) (cons (p x) y)) null sequence))

;; append-by-accumulate
(define (append-by-accumulate seq1 seq2)
  (accumulate cons seq2 seq1))

;; length-by-accumulate
(define (length-by-accumulate sequence)
  (accumulate (lambda(x y) (+ y 1)) 0 sequence))

练习2.34

;; polynomial-by-accumulate
(define (horner-eval x coefficient-sequence)
  (accumulate (lambda (this-coeff higher-terms) (+
                                                  (* higher-terms x)
                                                  this-coeff))
               0
               coefficient-sequence))

练习2.35

首先使用map函数处理tree，tree是一个嵌套的list，用map函数把每个嵌套的子树映射为子树叶节点数量

map函数里递归调用了count-leaves来处理子树

;; count-leaves-by-accumulate
(define (count-leaves t)
  (accumulate +
              0
              (map (lambda(x)
                     (cond ((null? x) 0)
                           ((pair? x) (count-leaves x))
                           (else 1)))
                   t)))

练习2.36

加入输入的list都是3元素的，就先把所有队列第一个元素提取出来，计算，然后和剩余的（剩下的2元素）做cons

这里有一个小问题，为什么一开始判断null用的是(car seqs)而不是seqs

因为到最后seqs是(() ())，这种list不是空的，所以要用(car seqs)判断

;; 若干个list的对应位累计
(define (accumulate-n op initial seqs)
  (if (null? (car seqs))
      null
      (cons (accumulate op initial (map (lambda(x)
                                          (car x))
                                        seqs))
            (accumulate-n op initial (map (lambda(x)
                                            (cdr x))
                                          seqs)))))

练习2.37

;; 矩阵向量乘
(define (matrix-*-vector m v)
  (map (lambda (x) (dot-product x v)) m))

;; 矩阵转置
(define (transpose mat)
  (accumulate-n cons null mat))

;; 矩阵乘矩阵
(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda(x) (matrix-*-vector cols x)) m)))

练习2.38

第一组，答案分别是3/2和1/6

fold-right，也就是accumulate，看一下展开的过程，是1/(2/(3/1))

fold-left，展开是1/1/2/3

第二组，答案分别是list (1 list (2 list (3 (nil))))和(list (list (list nil 1) 2) 3)

跟上面类似，不展开了

跟执行顺序无关的符号，满足结合律，即算子（参数）位置没有改变，运算顺序（用括号改变）不会对结果有影响

比如加法，就可以在fold-right和fold-left取得相同结果

练习2.39

fold-right，利用append

;; 翻转
(define (reverse sequence)
  (fold-right (lambda(x y)
                (append y (list x)))
              null
              sequence))

fold-left的很好写

;; 翻转
(define (reverse sequence)
  (fold-left (lambda(x y) (cons y x)) null sequence))

练习2.40

;; 生成整数对，并过滤和不为质数的部分
(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum? (unique-pairs n))))

;; 产生1<= j< i<= n的整数对
(define (unique-pairs n)
  (flatmap
   (lambda (i)
     (map (lambda(j) (list i j))
          (enumerate-interval 1 (- i 1))))
   (enumerate-interval 1 n)))

练习2.41

和上面的类似，照着写就行了

;; 产生1<=k<j<i<=n的整数组
(define (unique-triples n)
  (flatmap
   (lambda(i) (map
               (lambda(x)
                 (cons i x))
               (unique-pairs (- i 1))))
   (enumerate-interval 1 n)))

;; 判断整数组的和是否等于s
(define (sum-equal? s)
  (lambda(t) (= (accumulate + 0 t) s)))

;; 寻找n以内的和为s的整数组
(define (triple-sum s n)
  (filter (sum-equal? s) (unique-triples n)))

练习2.42

;; Exercise 2.42
;; N皇后
#lang racket
(require "prime-sum-pairs.rkt")
(require "sequence-operations.rkt")

;; N皇后
;; 当前棋盘的可能状态用一组list表示，每个list表示一种皇后放置方法，每个list对应下标存放的数值表示这一列皇后放在哪一行
(define (queens board-size)
  (define (queen-cols k)  
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens))
                 (enumerate-interval 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

;; 空棋盘
(define empty-board null)

;; 放入新的一列，new-row表示新放入的第k列皇后处于哪一行
(define (adjoin-position new-row k rest-of-queens)
  (cons new-row rest-of-queens))

;; 判断第k列的皇后位置是否合法
(define (safe? k positions)
  ;; 判断皇后所处行是否有重复，是否会在对角线碰撞
  (and (unique-first positions)
       ;; 判断皇后是否在对角线碰撞
       (not-crash? positions)))
       
;; 判断list中首元素是否是不重复
(define (unique-first l)
  (= (list-item-num l (car l)) 1))

;; 获取list中某个给定值出现了几次
(define (list-item-num l item)
  (length (filter (lambda(x) (= x item)) l)))

;; 判断新皇后是否会和其他皇后碰撞
(define (not-crash? l)
  ;; 沿着对角线逐步检查是否相撞
  ;; cur表示会与新皇后相撞的位置
  ;; direction为±1，表示两个对角线方向
  (define (check remain cur direction)
    (if (null? remain)
        #t
        (and (not (= (car remain) cur))
             (check (cdr remain) (+ cur direction) direction))))
  (and (check (cdr l) (+ (car l) 1) 1)
       (check (cdr l) (+ (car l) -1) -1)))

部分答案如下

练习2.43

原来的写法，每次做flatmap时，调用一次queen-cols，线形调用，耗费的时间是

现在这种写法，每次做flatmap时，调用board-size次queen-cols，变成了树形递归调用，根据前面的知识，树形递归调用耗费的时间是，随问题规模呈指数增长，常数与执行一次调用耗费时间有关，显然C大致为

所以更改后的代码，耗费时间大约为

练习2.4

;; 在画作上方画两幅更小的画作
(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
        (below painter (beside smaller smaller)))))

练习2.45

;; split，d1表示小画和大画的组合方式，d2表示两幅小画的组合方式
(define (split d1 d2)
  (lambda (painter n)
    (if (= n 0)
        painter
        (let ((smaller ((split d1 d2) painter (- n 1))))
          (d1 painter (d2 smaller smaller))))))

练习2.46

没什么难度

;; Exercise 2.46
;; 向量
#lang racket

;; make
(define (make-vect x y)
  (cons x y))

;; selector
(define (xcor-vect v)
  (car v))
(define (ycor-vect v)
  (cdr v))

;; 加
(define (add-vect v1 v2)
  (make-vect (+ (xcor-vect v1) (xcor-vect v2))
             (+ (ycor-vect v1) (ycor-vect v2))))

;; 减
(define (sub-vect v1 v2)
  (make-vect (- (xcor-vect v1) (xcor-vect v2))
             (- (ycor-vect v1) (ycor-vect v2))))

;; 乘系数
(define (scale-vect v s)
  (make-vect (* (xcor-vect v) s)
             (* (ycor-vect v) s)))

练习2.47

第一种

;; Exercise 2.47
;; frame
#lang racket

;; make
(define (make-frame origin edge1 edge2)
  (list origin edge1 edge2))

;; selector
(define (origin-frame f)
  (car f))
(define (edge1-frame f)
  (cadr f))
(define (edge2-frame f)
  (cadr (cdr f)))

第二种

;; Exercise 2.47
;; frame
#lang racket

;; make
(define (make-frame origin edge1 edge2)
  (cons origin (cons edge1 edge2)))

;; selector
(define (origin-frame f)
  (car f))
(define (edge1-frame f)
  (cadr f))
(define (edge2-frame f)
  (cdr (cdr f)))

练习2.48

;; Exercise 2.48
;; segment
#lang racket
(require "vector.rkt")
(provide (all-defined-out))

;; make
(define (make-segment v1 v2)
  (cons v1 v2))

;; selector
(define (start-segment s)
  (car s))
(define (end-segment s)
  (cdr s))

练习2.49

;; 画出外框
(define (draw-outline frame)
  ;; 四个端点
  (let ((v1 (make-vect 0 1))
        (v2 (make-vect 0 0))
        (v3 (make-vect 1 0))
        (v4 (make-vect 1 1)))
    (segments->painter (list (make-segment v1 v2)
                             (make-segment v2 v3)
                             (make-segment v3 v4)
                             (make-segment v4 v1)))))

;; 画X
(define (draw-x frame)
  ;; 四个端点
  (let ((v1 (make-vect 0 1))
        (v2 (make-vect 0 0))
        (v3 (make-vect 1 0))
        (v4 (make-vect 1 1)))
    (segments->painter (list (make-segment v1 v3)
                             (make-segment v2 v4)))))

;; 画菱形
(define (draw-diamond frame)
  ;; 四个中点
  (let ((v1 (make-vect 0.0 0.5))
        (v2 (make-vect 0.5 1.0))
        (v3 (make-vect 1.0 0.5))
        (v4 (make-vect 0.5 0.0)))
    (segments->painter (list (make-segment v1 v2)
                             (make-segment v2 v3)
                             (make-segment v3 v4)
                             (make-segment v4 v1)))))

我必须承认我是从网上抄的

;; 画挥手的小人
(define wave-painter-segments
  (segments->painter
   (list (make-segment (make-vect 0.2 0.0) (make-vect 0.4 0.4))
         (make-segment (make-vect 0.4 0.4) (make-vect 0.3 0.5))
         (make-segment (make-vect 0.3 0.5) (make-vect 0.1 0.3))
         (make-segment (make-vect 0.1 0.3) (make-vect 0.0 0.6))
         (make-segment (make-vect 0.0 0.8) (make-vect 0.1 0.5))
         (make-segment (make-vect 0.1 0.5) (make-vect 0.3 0.6))
         (make-segment (make-vect 0.3 0.6) (make-vect 0.4 0.6))
         (make-segment (make-vect 0.4 0.6) (make-vect 0.3 0.8))
         (make-segment (make-vect 0.3 0.8) (make-vect 0.4 1.0))
         (make-segment (make-vect 0.6 1.0) (make-vect 0.7 0.8))
         (make-segment (make-vect 0.7 0.8) (make-vect 0.6 0.6))
         (make-segment (make-vect 0.6 0.6) (make-vect 0.8 0.6))
         (make-segment (make-vect 0.8 0.6) (make-vect 1.0 0.4))
         (make-segment (make-vect 1.0 0.2) (make-vect 0.6 0.4))
         (make-segment (make-vect 0.6 0.4) (make-vect 0.8 0.0))
         (make-segment (make-vect 0.7 0.0) (make-vect 0.5 0.3))
         (make-segment (make-vect 0.5 0.3) (make-vect 0.3 0.0)))))

练习2.50

;; 水平翻转
(define (flip-horiz painter)
  ((transform-painter painter
                      (make-vect 1.0 0.0)
                      (make-vect 0.0 0.0)
                      (make-vect 1.0 1.0))
   painter))

;; 顺时针旋转180度
(define (rotate180 painter)
  ((transform-painter painter
                      (make-vect 1 1)
                      (make-vect 0 1)
                      (make-vect 1 0))
   painter))

;; 顺时针旋转270度
(define (rotate270 painter)
  ((transform-painter painter
                      (make-vect 0 1)
                      (make-vect 0 0)
                      (make-vect 1 1))
   painter))

练习2.51

仿照beside的写法

;; below
(define (below painter-bottom painter-top)
  (let ((paint-top
         (transform-painter painter-top
                            (make-vect 0.0 0.5)
                            (make-vect 1.0 0.5)
                            (make-vect 0.0 1.0)))
        (paint-below
         (transform-painter painter-bottom
                            (make-vect 0.0 0.0)
                            (make-vect 1.0 0.0)
                            (make-vect 0.0 0.5))))
    (lambda (frame)
      (paint-top frame)
      (paint-bottom frame))))

如果用beside加rotate实现below

;; beside实现below
(define (below-by-biside painter-bottom painter-top)
  (rotate270 (beside (rotate90 painter-bottom)
                      (rotate90 painter-up))))

练习2.52

给你画个对角线

;; 画挥手的小人
(define wave-painter-segments
  (segments->painter
   (list (make-segment (make-vect 0.0 0.0) (make-vect 1.0 1.0))
         (make-segment (make-vect 0.2 0.0) (make-vect 0.4 0.4))
         (make-segment (make-vect 0.4 0.4) (make-vect 0.3 0.5))
         (make-segment (make-vect 0.3 0.5) (make-vect 0.1 0.3))
         (make-segment (make-vect 0.1 0.3) (make-vect 0.0 0.6))
         (make-segment (make-vect 0.0 0.8) (make-vect 0.1 0.5))
         (make-segment (make-vect 0.1 0.5) (make-vect 0.3 0.6))
         (make-segment (make-vect 0.3 0.6) (make-vect 0.4 0.6))
         (make-segment (make-vect 0.4 0.6) (make-vect 0.3 0.8))
         (make-segment (make-vect 0.3 0.8) (make-vect 0.4 1.0))
         (make-segment (make-vect 0.6 1.0) (make-vect 0.7 0.8))
         (make-segment (make-vect 0.7 0.8) (make-vect 0.6 0.6))
         (make-segment (make-vect 0.6 0.6) (make-vect 0.8 0.6))
         (make-segment (make-vect 0.8 0.6) (make-vect 1.0 0.4))
         (make-segment (make-vect 1.0 0.2) (make-vect 0.6 0.4))
         (make-segment (make-vect 0.6 0.4) (make-vect 0.8 0.0))
         (make-segment (make-vect 0.7 0.0) (make-vect 0.5 0.3))
         (make-segment (make-vect 0.5 0.3) (make-vect 0.3 0.0)))))

;; corner split
(define (corner-split painter n)
  (if (= n 0)
      painter
      (let ((up (up-split painter (- n 1)))
            (right (right-split painter (- n 1)))
            (corner (corner-split painter (- n 1))))
        (beside (below painter up)
                (below right corner)))))

;; square limit
(define (square-limit painter n)
  (let ((combine4 (square-of-four identity flip-horiz
                                  flip-vert rotate180)))
    (combine4 (corner-split painter n))))

练习2.53

'(a b c)
'((george))
'((y1 y2)) 后面还有一个nil，所以是一个list，里面包含(y1,y2)和nil
'(y1 y2)
#f
#f 检查两个元素(red shoes)和(blue socks)，均不等于red
'(red shoes blue socks)

练习2.54

;; Exercise 2.54
;; 判断list是否相等
#lang racket

;; 判断两个list是否完全相等
(define (equal? l1 l2)
  (cond ((and (null? l1) (null? l2)) #t)
        ((or (null? l1) (null? l2) (not (eq? (car l1) (car l2)))) #f)
        (else (equal? (cdr l1) (cdr l2)))))

练习2.55

(car ''abracadabra)，展开就是(car '(quote abracadabra))

练习2.56

简单写了一个，仅支持指数为数字的形式

先写幂运算相关的make和selector

;; 判断是否是求幂
(define (exp? x)
  (and (pair? x)
       (eq? (car x) '**)))

;; 求幂
(define (make-exp base exponent)
  (if (or (=number? base 1) (=number? exponent 0))
      1
      (list '** base exponent)))

;; 获取幂的基数、指数
(define (base e) (cadr e))
(define (exponent e) (caddr e))

然后修改求导

;; 求导
(define (deriv exp var)
  (cond ((number? exp) 0)
        ((variable? exp)
         (if (same-variable? exp var) 1 0))
        ((sum? exp)
         (make-sum (deriv (addend exp) var)
                   (deriv (augend exp) var)))
        ((product? exp)
         (make-sum (make-product (multiplier exp)
                                 (deriv (multiplicand exp) var))
                   (make-product (deriv (multiplier exp) var)
                                 (multiplicand exp))))
        ((exp? exp)
         (make-product (make-product (exponent exp)
                                     (make-exp (base exp) (- (exponent exp) 1)))
                       (deriv (base exp) var)))
        (else
         (error "unknwon expression type -- DERIV" exp))))

练习2.57

只修改augend和multiplicand的定义，举个例子，addend还是保存第一项，augend保存之后的所有项的和

例如，(+ x y z)的addend是x，augend是(+ y z)

;; 获取加数
(define (augend s)
  (let ((rest (cddr s)))
    (if (null? (cdr rest))
        (car rest)
        (cons '+ rest))))

;; 获取乘数
(define (multiplicand p)
  (let ((rest (cddr p)))
    (if (null? (cdr rest))
        (car rest)
        (cons '* rest))))

练习2.58

;; 判断是否是求和式
(define (sum? x)
  (and (pair? x) (eq? (cadr x) '+)))

;; 判断是否是求积式
(define (product? x)
  (and (pair? x) (eq? (cadr x) '*)))

;; 获取加数
(define (addend s) (car s))
(define (augend s) (caddr s))

;; 获取乘数
(define (multiplier p) (car p))
(define (multiplicand p) (caddr p))

;; 求和
(define (make-sum a1 a2)
  (cond ((=number? a1 0) a2)
        ((=number? a2 0) a1)
        ((and (number? a1) (number? a2)) (+ a1 a2))
        (else (list a1 '+ a2))))

;; 求积
(define (make-product m1 m2)
  (cond ((or (=number? m1 0) (=number? m2 0)) 0)
        ((=number? m1 1) m2)
        ((=number? m2 1) m1)
        ((and (number? m1) (number? m2)) (* m1 m2))
        (else (list m1 '* m2))))

需要考虑的情况是，当加法前含有乘法运算时，如何准确地识别加法

例如，4 * x + x * x，需要判定为求和，并且拆分出4 * x和x * x，再对子项进行求导

那么只需要在判断表达式的死后，当表达式含有+，就判定为加法，先行进行处理

;; 判断是否是求和式
(define (sum? x)
  (contains? x '+))

;; 判断是否是求积式
(define (product? x)
  (and (not (contains? x '+)) (contains? x '*)))

;; 判断list中是否含有某元素
(define (contains? l item)
  (cond ((null? l) #f)
        ((eq? (car l) item) #t)
        (else (contains? (cdr l) item))))

乘法的selector修改成类似习题2.57中的样子（但需要修改，注意*号的位置，不是最前面而是中间），以支持多项计算，加法的selector需要在“+”处切分

;; 从list中获取指定item之前的部分
(define (get-before l item)
  (define (iter remain)
    (if (or (null? remain) (eq? (car remain) item))
        null
        (cons (car remain) (iter (cdr remain)))))
  (remove-brackets-if-only-one (iter l)))

;; 从list中获取指定item之后的部分
(define (get-after l item)
  (define (iter remain)
    (cond ((null? remain) null)
          ((eq? (car remain) item) (cdr remain))
          (else (iter (cdr remain)))))
  (remove-brackets-if-only-one (iter l)))

;; 若list中只含有一个元素，去除括号
(define (remove-brackets-if-only-one l)
  (if (null? (cdr l))
      (car l)
      l))

;; 获取加数
(define (addend s) (get-before s '+))
(define (augend s) (get-after s '+))

;; 获取乘数
(define (multiplier p) (car p))
(define (multiplicand p)
  (let ((rest (cddr p)))
    (if (null? (cdr rest))
        (car rest)
        rest)))

练习2.59

;; 取并集
(define (union-set set1 set2)
  (cond ((or (null? set1) (null? set2)) set2)
        ((element-of-set? (car set1) set2)
         (union-set (cdr set1) set2))
        (else (cons (car set1) (union-set (cdr set1) set2)))))

练习2.60

由可重复列表构成的集合，代码如下

;; Exercise 2.60
;; 允许重复的列表构成的集合
#lang racket

;; 判断集合是否包含某个元素
(define (element-of-set? x set)
  (cond ((null? set) false)
        ((equal? x (car set)) true)
        (else (element-of-set? x (cdr set)))))

;; 在集合中加入元素
(define (adjoin-set x set)
  (cons x set))

;; 取交集 
(define (union-set set1 set2)
  (cond ((null? set1) set2)
        ((null? set2) set1)
        (else (union-set (cdr set1) (cons (car set1) set2)))))

;; 取并集
(define (intersection-set set1 set2)
  (cond ((or (null? set1) (null? set2)) null)
        ((element-of-set? (car set1) set2)
         (cons (car set1)
               (intersection-set (cdr set1) set2)))
        (else (intersection-set (cdr set1) set2))))

和由不可重复列表构成集合的各项操作复杂度对比

分类	element-of-set?	adjoin-set	union-set	intersection-set
重复列表	$\Theta (n)$	$\Theta (1)$	$\Theta (n)$	$\Theta (n^2)$
不可重复列表	$\Theta (n)$	$\Theta (n)$	$\Theta (n^2)$	$\Theta (n^2)$

虽然有部分操作复杂度降低了，但是带来的是更大的存储开销，在数据重复度很高的情况下，重复列表的长度会比不重复列表大很多，操作也会变慢，因此需要根据应用来选择合适的底层实现方式

练习2.61

;; Exercise 2.61
;; 有序列表构成的集合
#lang racket

;; 向集合增加元素
(define (adjoin-set x set1)
  (cond ((null? set1) (cons x null))
        ((= (car set1) x) set1)
        ((> (car set1) x) (cons x set1))
        (else (cons (car set1) (adjoin-set x (cdr set1))))))

练习2.62

;; 取交集
(define (union-set set1 set2)
  (cond ((null? set1) set2)
        ((null? set2) set1)
        (else
         (let ((x1 (car set1))
               (x2 (car set2)))
           (cond ((= x1 x2) (cons x1 (union-set (cdr set1) (cdr set2))))
                 ((< x1 x2) (cons x1 (union-set (cdr set1) set2)))
                 (else (cons x2 (union-set set1 (cdr set2)))))))))

练习2.63

两种写法都一样，是前序遍历

对于图2.16，结果都是1 3 5 7 9 11

两种写法的递归调用次数都是差不多的，那么就比较每一次的操作

第一种写法使用了append操作，比第二种写法的cons操作，显然复杂度更高

练习2.64

非常多的let嵌套简直惊悚，建议从下往上看，清晰很多

首先partial-tree有两个输入，一个是元素列表，一个是元素列表长度

partial-tree的返回是一个pair，从最后一行可以猜出，pair是已经组合好的树和未处理的元素

再读一读let嵌套就可以知道，partial-tree先把左子树的所有元素处理成树，返回未处理的元素（包含entry和右子树的所有元素），然后依次处理entry和右子树

处理的结果是(5 (1 () (3 () ())) (9 (7 () ()) (11 () ())))

对每个元素都处理依次，因此复杂度为 $\Theta (n)$

首先把二叉树转换成list，再按照需求进行交或并的归并，再把处理好的list转换成二叉树

三种操作的复杂度都是 $\Theta (n)$

;; 取交集
(define (union-set set1 set2)
  (let ((list1 (tree->list-1 set1))
        (list2 (tree->list-1 set2)))
    ;; 取两个有序列表交集
    (define (merge list1 list2)
      (cond ((null? list1) list2)
            ((null? list2) list1)
            (else
             (let ((x1 (car list1))
                   (x2 (car list2)))
               (cond ((= x1 x2) (cons x1 (merge (cdr list1) (cdr list2))))
                     ((< x1 x2) (cons x1 (merge (cdr list1) list2)))
                     (else (cons x2 (merge list1 (cdr list2)))))))))
    (let ((union-list (merge list1 list2)))
      (list->tree union-list))))

;; 取交集
(define (intersection-set set1 set2)
  (let ((list1 (tree->list-1 set1))
        (list2 (tree->list-2 set2)))
    ;; 取两个有序列表并集
    (define (merge list1 list2)
      (if (or (null? list1) (null? list2))
          null
          (let ((x1 (car list1))
                (x2 (car list2)))
            (cond ((= x1 x2) (cons x1 (merge (cdr list1) (cdr list2))))
                  ((< x1 x2) (merge (cdr list1) list2))
                  (else (merge list1 (cdr list2)))))))
    (let ((intersection-list (merge list1 list2)))
      (list->tree intersection-list))))

练习2.66

;; 查找
(define (lookup set1 key)
  (if (null? set1)
      false
      (let ((x (entry set1)))
        (cond ((= x key) true)
              ((< x key) (lookup (right-branch set1) key))
              (else (lookup (left-branch set1) key))))))

练习2.67

A D A B B C A

练习2.68

;; 编码
(define (encode message tree)
  (if (null? message)
      '()
      (append (encode-symbol (car message) tree)
              (encode (cdr message) tree))))

;; 编码一个symbol
(define (encode-symbol symbol tree)
  ;; 判断有序集合中是否含有某元素
  (define (contains? set1 s)
    (cond ((null? set1) false)
          ((equal? (car set1) s) true)
          (else (contains? (cdr set1) s))))
  ;; 判断子树是否包含symbol
  (define (tree-contains? s t)
    (contains? (symbols t) s))
  (cond ((leaf? tree) null)
        ((tree-contains? symbol (left-branch tree))
         (cons 0 (encode-symbol symbol (left-branch tree))))
        ((tree-contains? symbol (right-branch tree))
         (cons 1 (encode-symbol symbol (right-branch tree))))
        (else (error ("待加密信息输入错误")))))
         
;; 测试编码      
(define sample-characters '(A D A B B C A))
(encode sample-characters sample-tree)

练习2.69

;; 将最小的元素合并为一个节点
(define (successive-merge ordered-pairs)
  (if (= (length ordered-pairs) 1)
      (car ordered-pairs)
      (let ((leaf1 (car ordered-pairs))
            (leaf2 (cadr ordered-pairs))
            (remains (cddr ordered-pairs)))
        (successive-merge (adjoin-set (make-code-tree leaf1 leaf2) remains)))))

练习2.70

利用霍夫曼编码，只要84位bit，定长3-bit编码需要108位

练习2.71

对于这种频率，在合并树节点的时候，两个最小的节点合并后仍然是最小的节点，n=5的时候霍夫曼树如下

因此这种情况，频率最高的节点，霍夫曼编码是1位，频率最低的节点，霍夫曼编码是n-1位

练习2.72

对一个长度为n的message，假设单词为m个，调用n次encode函数，每个encode函数调用一次encode-symbol

一次encode-symbol，每次都要在节点的set中搜寻symbol是否存在，然后沿着节点一次向下搜寻沿着节点，所以复杂度和霍夫曼树是否平衡有关。在不知道霍夫曼树结构的情况下，计算复杂度是很困难的

以练习2.71中的霍夫曼树为例

对于最频繁出现的symbol，在第一个节点set中搜寻即可找到，第一个节点set长度为n，所以复杂度是 $\Theta (n)$

对于最不频繁出现的symbol，要在(n-1)个节点的set中搜寻，每个set的长度与n成正比，所以复杂度是 $\Theta (n^2)$

练习2.73

数据导向的求导程序

因为数字和符号已经有了内置的number?、variable?这种函数，如果对数字、变量也打数据标签，要多很多操作

先把给数据打标签的代码写好

;; 带标签数据
#lang racket
(provide (all-defined-out))

;; 给数据打标签
(define (attach-tag type-tag contents)
  (cons type-tag contents))

;; 获取数据标签
(define (type-tag datum)
  (if (pair? datum)
      (car datum)
      (error "Bad tagged datum -- TYPE-TAG" datum)))

;; 获取数据内容
(define (contents datum)
  (if (pair? datum)
      (cdr datum)
      (error "Bad tagged datum -- CONTENTS" datum)))

sum和product的install代码

;; sum数据类型
(define (install-sum-package)
  ;; 内部函数
  ;; 构造函数
  (define (make-sum x y)
    (cond ((=number? x 0) y)
          ((=number? y 0) x)
          ((and (number? x) (number? y)) (+ x y))
          (else (attach-tag '+ x y))))
  ;; 获取第一个加数
  (define (addend s)
    (car s))
  ;; 获取第二个加数
  (define (augend s)
    (cadr s))
  ;; 求导
  (define (diff-sum operands var)
    (make-sum (deriv (addend operands) var)
              (deriv (augend operands) var)))
  ;; 注册函数
  (put 'deriv '+ diff-sum))
  (put 'make  '+ make-sum))

;; product数据类型
(define (install-product-package)
  ;; 内部函数
  ;; 构造函数
  (define (make-product x y)
    (cond ((=number? x 1) y)
          ((=number? y 1) x)
          ((or (=number? x 0) (=number? y 0)) 0)
          ((and (number? x) (number? y)) (+ x y))
          (else (attach-tag '* x y))))
  ;; 获取第一个乘数
  (define (multiplier s)
    (car s))
  ;; 获取第二个乘数
  (define (multiplicand s)
    (cadr s))
  ;; 求导
  (define (diff-product operands var)
    (make-sum (make-product
               (multiplier operands)
               (deriv (multiplicand operands) var))
              (make-product
               (deriv (multiplier operands) var)
               (multiplicand operands))))
  ;; 接口
  (put 'deriv '* diff-product)
  (put 'make  '* make-product))

(define make-sum (get 'make '+))
(define make-product (get 'make '*))

;; 指数数据类型
(define (install-exp-package)
  ;; 内部函数
  ;; 构造函数
  (define (make-exp x y)
    (cond ((=number? y 0) 1)
          ((=number? y 1) x)
          ((and (number? x) (number? y)) (** x y))
          (else (attach-tag '** x y))))
  ;; 获取基数
  (define (base s)
    (car s))
  ;; 获取指数
  (define (exponent s)
    (cadr s))
  ;; 求导
  (define (diff-exp operands var)
    (let ((b (base operands))
          (e (exponent operands)))
      (make-product e
                    (make-product (deriv e var)
                                  (make-exp b (make-sum e -1)))))
  ;; 接口
  (put 'deriv '** diff-exp)
  (put 'make  '** make-exp))

把所有put操作的前两个参数调换位置就可以了

2.74

由题意，每个独立文件以不同的数据结构存放员工信息，以员工姓名为主键

每个文件的数据都分配一个tag，都公开以下接口：

通过员工姓名查询员工信息记录的get函数
各种select函数，包括薪水、入职日期等

get_record函数通过员工姓名在文件中查询员工信息，在不同文件中查询时，只要根据不同的数据tag选择对应的get函数就可以了

通过每条员工信息的数据tag，选择对应的select函数，查询薪水

在不同文件中搜索，直到搜索到该姓名为止

分配给新公司一个tag，并在它原来的员工数据基础上，增加对应的get和select函数

2.75

这个message写起来比tag简单多了

伟大的面向对象思想

;; 极座标
(define (make-from-mag-ang m a)
  (define (dispatch op)
    (cond ((eq? op 'magnitude) m)
          ((eq? op 'angle) a)
          ((eq? op 'real-part) (* m (cos a)))
          ((eq? op 'imag-part) (* m (sin a)))
          (else
           (error "Unknown op -- MAKE-FROM-MAG-ANG" op))))
  dispatch)

2.76

显式分派：非常麻烦，每个类型的每个方法名字要注意区分，大型系统中简直是噩梦的存在

tag：增加类型，要分配一个新tag，并更新全局函数表；增加方法要更新全局函数表；之前的代码无需修改

message：增加类型几乎不需要额外的开销；增加方法，其实和tag相比要加入的代码量是类似的，但是tag法的方法代码可以不和同类代码放在一起，message的方法必须和类写在一个dispatch函数里，所以tag法增加方法更加地方便一些（写起来方便，写的量我觉得差不多）

综上，经常增加类，使用message法，经常增加方法，使用tag法

练习2.77

magnitude只在install函数内部定义了，其他函数无法直接调用install函数内部定义的函数

练习2.78

加个判断分支就好，number和symbol不打tag，获取标签的时候，判断为number?或symbol?的直接返回对应tag

;; Exercise 2.78
;; 带标签数据，可处理系统自带number和symbol
#lang racket

;; 给数据打标签
(define (attach-tag type-tag contents)
  (if (or (number? contents) (symbol? contents))
      contents
      (cons type-tag contents)))

;; 获取数据标签
(define (type-tag datum)
  (cond ((number? datum) 'number)
        ((symbol? datum) 'symbol)
        ((pair? datum) (car datum))
        (else (error "Bad tagged datum -- TYPE-TAG" datum))))

;; 获取数据内容
(define (contents datum)
  (cond ((or (number? datum) (symbol? datum)) datum)
        ((pair? datum) (cdr datum))
        (else (error "Bad tagged datum -- CONTENTS" datum))))

练习2.79

以下代码需要放在各install包里

;; Exercise 2.80
;; 泛型数字操作
#lang racket

;; 判断有理数是否相等
(define (rational-eq? r1 r2)
  (= (* (numer r1) (denom r2))
     (* (denom r1) (numer r2))))
(put 'equ? 'rational rational-eq?)

;; 判断复数是否相等
(define (complex-eq? c1 c2)
  (and (= (real-part c1) (real-part c2))
       (= (imag-part c1) (imag-part c2))))
(put 'equ? 'complex complex-eq?)

;; 判断数字是否相等
(define (number-eq? n1 n2)
  (= n1 n2))
(put 'equ? 'number number-eq?)

练习2.80

类似操作

;; Exercise 2.80
;; 泛型数字操作
#lang racket

;; 判断有理数是否为零
(define (rational-zero? r)
  (= (numer r) 0))
(put 'zero? 'rational rational-zero?)

;; 判断复数是否为零
(define (complex-zero? c)
  (and (= (real-part c) 0) (= (imag-part c) 0)))
(put 'zero? 'complex complex-zero?)

;; 判断数字是否为0
(define (number-zero? n)
  (= n 0))
(put 'zero? 'number number-zero?)

练习2.81

apply-generic函数有两个分支：一个分支是找到当前输入类型对应的操作函数，调用函数，完成操作；或者尝试输入数据的类型转换，再用新输入类型调用apply-generic

如果加上scheme-number自身的转换，(apply-generic scheme-number scheme-number)会重复a1->a2类型转换，然后调用(apply-generic scheme-number scheme-number)，程序陷入死循环

从上一小题分析可以看出来，apply-generic首先查找是否有对应输入类型的操作函数，查找不到就会尝试进行类型转换；如果加入同类型转换的函数，转换前后没有任何改变，找不到操作函数还是找不到，必然会引起死循环调用

;; Exercise 2.81
;; 泛型函数
#lang racket

;; 泛型操作
(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc
          (apply proc (map contents args))
          (if (= (length args) 2)
              (let ((type1 (car type-tags))
                    (type2 (cadr type-tags))
                    (a1 (car args))
                    (a2 (cadr args)))
                ;; 如果两个输入数据类型相同，报错
                (if (equal? type1 type2)
                    (error "No method for these types")
                    (let ((t1->t2 (get-coercion type1 type2))
                          (t2->t1 (get-coercion type2 type1)))
                      (cond (t1->t2
                             (apply-generic op (t1->t2 a1) a2))
                            (t2->t1
                             (apply-generic op a1 (t2->t1 a2)))
                            (else
                             (error "No method for these types"
                                    (list op type-tags)))))))
              (error "No method for these types")
                     (list op type-tags))))))

练习2.82

这种实现方式，如果存在输入类型不同的通用函数，比如(exp scheme-number complex)，是不能找到这个通用函数的，只能找到所有输入类型都是一样的通用函数

;; 多输入泛型操作
(define (apply-generic op . args)
  ;; 尝试转换arg为type类型
  (define (change-type type arg)
    (let ((change-proc (get-coercion (type-tags arg) type)))
      (if change-proc
          (apply change-proc arg)
          arg)))
  ;; origin-types表示最初输入参数的类型list
  (define (iter origin-types changed-args)
    ;; 查找对应输入类型的函数
    (let ((type-tags (map type-tag changed-args)))
      (let ((proc (get op type-tags)))
        (if proc
            ;; 如果找到对应输入类型的函数
            (apply proc (map contents changed-args))
            ;; 如果没有找到，转换为origin-types中的首元素类型
            (if (null? origin-types)
                ;; 已经尝试了所有类型，仍未找到，报错
                (error "No method for these types")
                ;; 转换参数类型，递归调用
                (iter (cdr origin-types) (map change-type args)))))))
  ;; 调用
  (iter (map type-tag args) args))

《SICP》习题第2章

Centos6.10下Open-falcon的分佈式安裝（虛擬機僞分佈式）和前端界面安裝

Elasticsearch學習（零）——安裝與基本操作

Centos6下Redis學習（一）——Java客戶端Lettuce的使用、Springboot整合

LeetCode困難刷題記錄——Median of Two Sorted Arrays 尋找兩個有序數組的中位數

Centos6.10下Open-falcon學習記錄（三）——log監控插件falcon-log-agent

Mac下配置sublime實現LaTeX

https://yachay.unat.edu.pe/blog/index.php?comment_area=format_blog&comment_component=blog&comment_co

linux以太網驅動總結