sicp 笔记 (3)

第二章习题 2.33 - 2.51 的解答。

E-2.33:

(define (accumulate op initial sequence)
  (if (null? sequence)
    initial
    (op (car sequence)
        (accumulate op initial (cdr sequence)))))

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

(define (my-map p sequence)
  (accumulate (lambda (x y) (append (list x) y)) (list) sequence))

(define (my-append seq1 seq2)
  (accumulate cons seq2 seq1))

(define (my-length sequence)
  (accumulate (lambda (x y) (if (null? sequence)
                              0
                              (+ 1 y))) 0 sequence))

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

(my-map + (list 1 2 3 4 5))
(my-append (list 1 2 3) (list 5 6 7))
(my-length (list 1 3 4))

E-2.34:

(load "2.33.scm")

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

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

(horner-eval 2 (list 1 3 0 5 0 1))
</pre>

E-2.35:

<pre lang='scheme' line='1' src='2.35.scm'>
(load "2.33.scm") ; accumulate

(define (count-leaves t)
  (accumulate + 0 (map (lambda (x)
                         (if (pair? x)
                           (count-leaves x)
                           1))
                       t)))

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

(define x (list (list 1 2) (list 3 4)))
(count-leaves x)

E-2.36:

(load "2.33.scm")

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
    (list)
    (cons (accumulate op init (map car seqs))
          (accumulate-n op init (map cdr seqs)))))

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

(define s (list (list 1 2 3) (list 4 5 6) (list 7 8 9) (list 10 11 12)))

(accumulate-n + 0 s)

E-2.37: 这题真是个复用的好例子。

(load "2.33.scm")
(load "2.36.scm")

(define (matrix-*-vector m v)
  (map (lambda (x) (accumulate + 0 (map * x v))) m))

(define (transpose m)
  (accumulate-n (lambda (x y) (append (list x) y))
                (list) m))

(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (x) (matrix-*-vector cols x))
         m)))

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

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

(matrix-*-vector m v)
(transpose m)
(matrix-*-matrix m m)

E-2.38: op 要满足交换律。

(load "2.33.scm")

(define (my-fold-right op initial sequence)
  (accumulate op initial sequence))

(define (my-fold-left op initial sequence)
  (define (iter result rest)
    (if (null? rest)
      result
      (iter (op result (car rest))
            (cdr rest))))

  (iter initial sequence))

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

(my-fold-right / 1 (list 1 2 3))
(my-fold-left / 1 (list 1 2 3))
(my-fold-right list (list) (list 1 2 3))
(my-fold-left list (list) (list 1 2 3))

E-2.39:

(load "2.38.scm")

(define (my-reverse sequence)
  (my-fold-right (lambda (x y) (append y (list x))) (list) sequence))

(define (my-reverse-2 sequence)
  (my-fold-left (lambda (x y) (append (list y) x)) (list) sequence))

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

(my-reverse-2 (list 1 2 3 4 5))

E-2.40:

(define (filter predicate sequence)
  (if (null? sequence)
    (list)
    (if (predicate (car sequence))
      (append (list (car sequence)) (filter predicate (cdr sequence)))
      (filter predicate (cdr sequence)))))

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

(load "1.22.scm") ; prime?
(load "2.33.scm") ; accumulate

(define (enumerate-interval a b)
  (if (> a b)
    (list)
    (append (list a) (enumerate-interval (+ a 1) b))))

(define (unique-pairs n)
  (accumulate append
              (list)
              (map (lambda (i)
                     (map (lambda (j) (list i j))
                          (enumerate-interval 1 (- i 1))))
                   (enumerate-interval 1 n))))

(define (make-pair-sum pair)
  (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))

(define (prime-sum? pair)
  (prime? (+ (car pair) (cadr pair))))

(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum? (unique-pairs n))))

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

(unique-pairs 5)
(prime-sum-pairs 5)

E-2.41: 生成 3 元组的时候比生成 2 元组麻烦点,不能直接连写 3 个 map,而是在第二个循环的时候先 flatmap 一下去掉一层,相当生成 2 元组时最外层的 accumulate。

(load "2.40.scm")

(define (flatmap proc seq)
  (accumulate append (list) (map proc seq)))

(define (unique-triples n)
  (flatmap (lambda (i)
             (flatmap (lambda (j)
                        (map (lambda (k) (list i j k))
                             (enumerate-interval 1 (- j 1))))
                      (enumerate-interval 1 (- i 1))))
           (enumerate-interval 1 n)))

(define (s-triples s)
  (filter (lambda (x)
            (= (accumulate + 0 x) s))
          (unique-triples s)))

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

(s-triples 11)

E-2.42: 刚开始想不到 safe? 只有一个列参数怎样能判断和其它皇后的位置关系,网上搜了答案(参考资料 [1])后发现可以通过 adjoin-position 传递要判断的当前行数,并且在 adjoin-position 中不必保留列信息。具体的实现没仔细看,经过这一点提示后自己实现了一个。程序是按列来添加皇后的,与习惯的按行添加不同,这也带来了不少麻烦。

(load "2.41.scm")

(define empty-board (list))

(define (safe? col1 positions)

  (define (safe-pos? row1 row2 col2)
    (cond ((= row1 row2) #f)
          ((= col1 col2) #f)
          ((= (abs (- row1 row2)) (abs (- col1 col2))) #f)
          (else #t)))

  (define (recur row1 row col2)
    (if (null? row)
      #t
      (if (not (safe-pos? row1 (car row) col2))
        #f
        (recur row1 (cdr row) (- col2 1)))))

  (if (null? positions)
    #t
    (recur (car positions) (cdr positions) (length (cdr positions)))))

(define (adjoin-position new-row k rest-of-queens)
  ;(map display (list "join result -> " (append (list new-row) rest-of-queens) "\n"))
  (append (list new-row) rest-of-queens))

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

(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))

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

(queens 4)

adjoin-position 的作用是添加新行位置,其中并没有保留列信息(题目中的参数 k 没有使用,因为在 safe? 中已经有了 k)。返回的 list(假设名字为 row,长度为 size,从 1 开始计数)表示的意思是:row[i] 表示皇后位于第 row[i] 行第 (size - i + 1) 列(其中 1<=i<=size)。例如 row 为 (3 1 4 2),从左往右分别表示皇后的位置为:第 3 行第 4 列,第 1 行第 3 列,第 4 行第 2 列,第 2 行第 1 列。adjoin-position 只负责添加新的行位置(具体行为看注释打印的内容),至于是否合法是由 queen-cols 中的 filter 来判断的,即 safe?。

safe? 函数判断新增加列的所有位置中,哪个位置(即处于新增加列中的哪一行)是合法的。其中的 recur 函数为递归判断新增加的位置与之前的位置是否有冲突;safe-pos? 判断某个位置 (row1, col1) 是否和已经存在的位置 (row2, col2) 有冲突(是否在同一行,是否在同一列,是否在对角线上)。

E-2.43: 内层循环中的 queen-cols 重复计算了,本来已经确定了的位置在每次 flatmap 时都要重新算一遍。

E-2.44: 将 right-split 中 beside 和 below 的位置交换。

E-2.45:

(define (split op1 op2)
  (define (helper painter n)
    (if (= n 0)
      painter
      (let ((smaller (helper painter (- n 1))))
        (op1 painter (op2 smaller smaller)))))

  helper)

E-2.46:

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

(define (xcor-vect v)
  (car v))

(define (ycor-vect v)
  (cdr v))

(define (add-vect a b)
  (make-vect (+ (xcor-vect a) (xcor-vect b))
             (+ (ycor-vect a) (ycor-vect b))))

(define (sub-vect a b)
  (make-vect (- (xcor-vect a) (xcor-vect b))
             (- (ycor-vect a) (ycor-vect b))))

(define (scale-vect v s)
  (make-vect (* s (xcor-vect v))
             (* s (ycor-vect v))))

E-2.47:

(define (origin-frame f)
  (car f))

(define (edge1-frame f)
  (cadr f))

(define (edge2-frame f)
  (caddr f))

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

(define (edge2-frame f)
  (cddr f))

E-2.48: 因为之前实现的 for-each 使用了 list,因此这里也使用 list 而不是 cons。

(define (make-segment a b)
  (list a b))

(define (start-segment s)
  (car s))

(define (end-segment s)
  (cadr s))

E-2.49:

(define origin (make-vect 0 0))
(define top-left (make-vect 0 1))
(define top-right (make-vect 1 1))
(define bottom-right (make-vect 1 0))

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

(define outlint-segment-list (list (make-segment origin top-left)
                                   (make-segment top-left top-right)
                                   (make-segment top-right bottom-right)
                                   (make-segment bottom-right origin)))

(define (outline frame)
  ((segment->painter outlint-segment-list) frame))

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

(define opposite-segment-list (list (make-segment origin top-right)
                                    (make-segment top-left bottom-right)))

(define (opposite frame)
  ((segment->painter opposite-segment-list) frame))

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

(define diamond-segment-list (list (make-segment origin (make-vect 0 0.5))
                                   (make-segment top-left (make-vect 0.5 1))
                                   (make-segment (make-vect 1 0.5) bottom-right)
                                   (make-segment (make-vect 0.5 0) origin)))

(define (diamond frame)
  ((segment->painter diamond-segment-list) frame))

E-2.50:

(define (flip-horiz painter)
  (transform-painter painter
                     (make-vect 1 0)
                     (make-vect 0 0)
                     (make-vect 1 1)))

(define (rotate180 painter)
  (transform-painter painter
                     (make-vect 1 1)
                     (make-vect 0 1)
                     (make-vect 1 0)))

(define (rotate270 painter)
  (transform-painter painter
                     (make-vect 0 1)
                     (make-vect 0 0)
                     (make-vect 1 1)))

E-2.51:

(define (below painter1 painter2)
  (let ((split-point (make-vect 0 0.5)))
    (let ((paint-bottom (transform-painter painter1
                                           (make-vect 0 0)
                                           split-point
                                           (make-vect 1 0)))
          (paint-top (transform-painter painter2
                                        split-point
                                        (make-vect 0 1)
                                        (make-vect 1 0.5))))

      (lambda (frame)
        (paint-top frame)
        (paint-bottom frame)))))

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

(define (below2 painter1 painter2)
  (rotate90 (beside (rotate270 painter1) (rotate270 painter2))))

参考资料

[1] SICP exercise 2.42

发表回复

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