sicp 笔记 (2)

第二章习题 2.1 - 2.32 的解答。

E-2.1:

(define (numer x) (car x))
(define (denom x) (cdr x))

(define (print-rat x)
  (display (numer x))
  (display "/")
  (display (denom x))
  (newline))

; -------------------------------------------

(define (make-rat n d)
  (if (or (and (> n 0) (< d 0))
          (and (< n 0) (< d 0)))
    (cons (- n) (- d))
    (cons n d)))

(print-rat (make-rat -3 -4))

E-2.2:

(define (make-point x y) (cons x y))
(define (x-point p) (car p))
(define (y-point p) (cdr p))

(define (make-segment start end) (cons start end))
(define (start-segment s) (car s))
(define (end-segment s) (cdr s))

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

; -------------------------------------------------

(define (average a b) (/ (+ a b) 2))

(define (midpoint-segment s)
  (make-point (average (x-point (start-segment s))
                       (x-point (end-segment s)))
              (average (y-point (start-segment s))
                       (y-point (end-segment s)))))

; -------------------------------------------------

(print-point (midpoint-segment (make-segment (make-point 1 1)
                                             (make-point 2 2))))

E-2.3:

(load "2.2.scm")

(define (make-rect top-left bottom-right)
  (cons top-left bottom-right))

(define (top-left-rect r) (car r))
(define (bottom-right-rect r) (cdr r))

(define (x-distance left-point right-point)
  (- (x-point right-point) (x-point left-point)))

(define (y-distance top-point bottom-point)
  (- (y-point bottom-point) (y-point top-point)))

(define (perimeter-rect r)
  (* (+ (x-distance (top-left-rect r) (bottom-right-rect r))
        (y-distance (top-left-rect r) (bottom-right-rect r)))
     2))

(define (area-rect r)
  (* (x-distance (top-left-rect r) (bottom-right-rect r))
     (y-distance (top-left-rect r) (bottom-right-rect r))))

; -------------------------------------------------

(perimeter-rect (make-rect (make-point 1 3)
                           (make-point 3 4)))

(area-rect (make-rect (make-point 1 2)
                      (make-point 3 4)))

还可以使用四个点,或者右上和左下两个对角点。

E-2.4:

(define (my-cons x y)
  (lambda (m) (m x y)))

(define (my-car z)
  (z (lambda (p q) p)))

; -----------------------------------------------

(define (my-cdr z)
  (z (lambda (p q) q)))

; -----------------------------------------------

(my-car (my-cons 32 45))

E-2.5: 刚开始傻里吧唧地复习了一遍对数运算,结果无论怎么算都是 0……其实应该是分别数能被 2 或 3 整除的次数。

(define (my-cons x y)
  (* (expt 2 x) (expt 3 y)))

(define (count z base)
  (if (= (remainder z base) 0)
    (+ 1 (count (/ z base) base))
    0))

(define (my-car z)
  (count z 2))

(define (my-cdr z)
  (count z 3))

; ------------------------------------

(my-car (my-cons 4 9))
(my-cdr (my-cons 4 9))

E-2.6: 真的理不清这个结构……

E-2.7: upper-bound 是 (car z),lower-bound 是 (cdr z)。

E-2.8: 相减的物理意义是两个区间的数之差的上下限。

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

E-2.9: 令 w1 = (max1 - min1) / 2,w2 = (max2 - min2) / 2,则 ws = w1 + w2。

E-2.10: 当 lower-bound 小于 0 时返回 0。

E-2.11:

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

(define (lower-bound x)
  (car x))

(define (upper-bound x)
  (cdr x))

(define (mul-interval x y)
  (let ((a1 (lower-bound x))
        (b1 (upper-bound x))
        (a2 (lower-bound y))
        (b2 (upper-bound y)))

    (cond ((and (> a1 0) (> b1 0) (> a2 0) (> b2 0))
           (make-interval (* a1 a2) (* b1 b2)))

          ((and (> a1 0) (> b1 0) (< a2 0) (> b2 0))
           (make-interval (* a2 b1) (* b1 b2)))

          ((and (> a1 0) (> b1 0) (< a2 0) (< a2 0))
           (make-interval (* b1 b2) (* a1 a2)))

          ((and (< a1 0) (> b1 0) (> a2 0) (> b2 0))
           (make-interval (* a1 b2) (* b1 b2)))

          ((and (< a1 0) (> b1 0) (< a2 0) (> b2 0))
           (make-interval (min (* a1 b2) (* b1 a2))
                          (max (* a1 a2) (* b1 b2))))

          ((and (< a1 0) (> b1 0) (< a2 0) (< b2 0))
           (make-interval (* b1 b2) (* a1 a2)))

          ((and (< a1 0) (< b1 0) (> a2 0) (> b2 0))
           (make-interval (* a1 b2) (* b1 a2)))

          ((and (< a1 0) (< b1 0) (< a2 0) (> b2 0))
           (make-interval (* a1 b2) (* a1 a2)))

          ((and (< a1 0) (< b1 0) (< a2 0) (< b2 0))
           (make-interval (* b1 b2) (* a1 a2))))))

E-2.12:

(load "../examples/2.1.4-interval-arithmetic.scm")

(define (center i)
  (/ (+ (lower-bound i) (upper-bound i)) 2))

(define (width i)
  (/ (- (upper-bound i) (lower-bound i)) 2))

(define (make-center-percent c p)
  (let ((w (* c p)))
    (make-interval (- c w) (+ c w))))

(define (percent i)
  (/ (width i) (center i)))

E-2.13: 没有读懂题目的意思,在网上找了答案才明白(参考资料 [3])。使用 (中心点,百分比) 的形式表示,设其中一个区间为 (c1, p1),另一个区间为 (c2, p2),范围分别为 (c1(1-p1), c2(1+p1)) 和 (c2(1-p2), c2(1+p2)),两者乘积的区间为 (c1c2(1-p1)(1-p2), c1c2(1+p1)(1+p2))。percentage tolerance 的定义是 tolerance/center,即 ((upper - lower)/2) / ((upper + lower)/2),结果为 (p1 + p2)/(1 + p1p2),当 p1 和 p2 都很小时约等于 p1+p2。

E-2.14: 两个等式的定义域并不一样,例如 par2 中 R1 和 R2 均不能为 0 但 par1 中可以,因此变形后再计算范围肯定不一样。

E-2.15: 我觉得 par1 较好,因为 par2 中 R1 和 R2 均不能为 0,而在 par1 中可以,例如导线的电阻就可以认为是 0。

E-2.16: 原因就是变形成立的条件必需在两者都有意义的定义域上,否则就会出现不同。参考资料 [4] 给出了一个实现。

E-2.17:

(define (last-pair l)
  (define (iter l)
    (if (null? (cdr l))
      (car l)
      (iter (cdr l))))

  (iter l))

; ----------------------------------------

(last-pair (list 1 2 3 4))

E-2.18:

(define (my-reverse l)
  (define (recur l)
    (if (null? l)
      (list)
      (append (recur (cdr l)) (list (car l)))))

  (recur l))

; ----------------------------------------

(my-reverse (list 1 4 9 16 25))

E-2.19: 很简单的题目,no-more? 对应 null?,except-first-denomination 对应 cdr,first-denomination 对应 car。

E-2.20:

(define (same-parity . l)
  (define (recur l remain)
    (if (null? l)
      (list)
      (if (= remain (remainder (car l) 2))
        (append (list (car l)) (recur (cdr l) remain))
        (recur (cdr l) remain))))

  (if (null? l)
     (list)
     (recur l (remainder (car l) 2))))

; ----------------------------------------------------

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

E-2.21:

(define (square-list items)
  (define (square x) (* x x))
  (if (null? items)
    (list)
    (cons (square (car items)) (square-list (cdr items)))))

(define (square-list items)
  (map (lambda (x) (* x x)) items))

E-2.22: 第一个问题是每次结果都从左边添加,answer 的变化过程为:nil -> (1 nil) -> (4 1 nil) ...。第二个问题刚好相反,整个链表顺序倒过来了,nil 变成了第一个元素。

E-2.23:

(define (my-for-each proc items)
  (map proc items))

; ----------------------------------------------------

(my-for-each (lambda (x) (display x) (newline))
             (list 57 321 88))

E-2.24: (1 (2 (3 4)))

E-2.25:

(define x (list 1 3 (list 5 7) 9))
(car (cdr (car (cdr (cdr x)))))

(define y (list (list 7)))
(car (car y))

(define z (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))
(car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr z))))))))))))

E-2.27: 做了好几天都没做出来,不是这里多了一层就是那里少了一层,最后终于忍不住到网上搜了答案(见参考资料 [1])。

(define (deep-reverse l)
  (cond ((null? l) (list))
        ((pair? (car l))
         (append (deep-reverse (cdr l))
                 (list (deep-reverse (car l)))))
        (else
          (append (deep-reverse (cdr l))
                  (list (car l))))))

; ------------------------------------------------------

(define x (list 7 8 9 (list 1 2) (list 3 4 (list 5 6))))

(display x)
(newline)
(deep-reverse x)

其实题目也算是给了提示,要模仿 E-2.18 的做法,只怪自己脑子不好使,嵌套层数一多就理不清了,后来写得越来越离谱……

E-2.28:

(define (fringe x)
  (cond ((null? x) (list))
        ((not (pair? x)) (list x))
        (else (append (fringe (car x)) (fringe (cdr x))))))

; -----------------------------------------------------------

(define x (list (list 1 2) (list 3 4)))

(fringe (list x x))

E-2.29: 分不清楚 mobile 和 branch 到底是不是同一个东西,在网上找了答案(参考资料 [2])也看不懂,最后感谢 #大侠 点拨,题目描述的其实是这么一个东东:一个物体(称为 mobile)上面插着两根棍子(称为 branch),每根棍子(branch)有两个属性,分别是 length 和 structure,而这个 structure 可能是一个权重(weight)或者是另一个物体(mobile)。

(define (make-mobile left right)
  (list left right))

(define (make-branch len structure)
  (list len structure))

; -----------------------------------------------------------

(define (left-branch x)
  (car x))

(define (right-branch x)
  (car (cdr x)))

(define (branch-length x)
  (car x))

(define (branch-structure x)
  (car (cdr x)))

; -----------------------------------------------------------

(define (total-weight x)

  (define (mobile? m)
    (pair? m))

  (define (branch-weight b)
    (let ((tmp (branch-structure b)))
      (if (mobile? tmp)
        (mobile-weight tmp)
        tmp)))

  (define (mobile-weight m)
    (+ (branch-weight (left-branch m))
       (branch-weight (right-branch m))))

  (mobile-weight x))

; -----------------------------------------------------------

(define a (make-mobile (make-branch 2 3) (make-branch 2 3)))
(define b (make-mobile (make-branch 2 3) (make-branch 4 5)))

(total-weight b)

E-2.30: 参考 E-2.27。

(define (square-tree t)
  (define (square x) (* x x))

  (cond ((null? t) (list))
        ((pair? (car t))
         (append (list (square-tree (car t)))
                 (square-tree (cdr t))))
        (else
          (append (list (square (car t))) (square-tree (cdr t))))))

; -----------------------------------------------------

(square-tree
  (list 1 (list 2 (list 3 4) 5) (list 6 7)))

E-2.31:

(define (tree-map proc t)
  (cond ((null? t) (list))
        ((pair? (car t))
         (append (list (tree-map proc (car t)))
                 (tree-map proc (cdr t))))
        (else
          (append (list (proc (car t))) (tree-map proc (cdr t))))))

; ------------------------------------------------------

(define (square x) (* x x))
(define (square-tree tree) (tree-map square tree))

(square-tree
  (list 1 (list 2 (list 3 4) 5) (list 6 7)))

E-2.32: 找出 除第一个元素外剩下的所有元素组成的集合 的所有子集,然后再把第一个元素分别添加到这些子集中。下面是 plt-scheme 的版本,nil 要表示成“(list)”。

(define (subsets s)
  (if (null? s)
    (list (list))
    (let ((rest (subsets (cdr s))))
      (append rest (map (lambda (x)
                          (append (list (car s)) x))
                        rest)))))

; ------------------------------------------

(subsets (list 1 2 3))

参考资料

[1] SICP 2.27: Reversing Nested Lists
[2] SICP 2.29: Binary Mobiles
[3] SICP 2.13 solution
[4] sicp 2.16

发表回复

您的电子邮箱地址不会被公开。 必填项已用*标注