这次回顾第二章第四部分习题。

学习资料：

https://ocw.mit.edu/courses/electrical-engineering-and-computer-science/6-001-structure-and-interpretation-of-computer-programs-spring-2005/index.htm

https://github.com/DeathKing/Learning-SICP

https://mitpress.mit.edu/sites/default/files/sicp/index.html

https://www.bilibili.com/video/BV1Xx41117tr?from=search&seid=14983483066585274454

参考资料：

https://sicp.readthedocs.io/en/latest

2.44(p90)

形式：

up-splict n - 1 | up-splict n - 1
up-splict n

代码如下：

(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
        (below painter (beside smaller smaller)))))

备注：

below的第一个参数对应于下方的元素。

2.45(p91)

(define (split bigop smallop)
    (define (helper painter n)
        (if (= n 0)
            painter
            (let ((smaller (helper painter (- n 1))))
                (bigop painter (smallop smaller smaller)))))
    helper)

(define right-split (split beside below))
(define up-split (split below beside))

2.46(p92)

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

(define (xcor-vect vec)
    (car vec))

(define (ycor-vect vec)
    (cdr vec))

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

(define (sub-vect v1 v2)
    (add-vect v1 (scale-vect v2 -1)))

; test
(define v1 (make-vect 1 0))
(define v2 (make-vect 0 1))
(newline)
(display v1)
(newline)
(display v2)
(newline)
(display (add-vect v1 v2))
(newline)
(display (sub-vect v1 v2))
(newline)
(display (scale-vect v1 5))
(exit)

结果如下：

(1 . 0)
(0 . 1)
(1 . 1)
(1 . -1)
(5 . 0)

2.47(p93)

第一种实现：

(load "helper.scm")

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

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

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

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

; test
(define origin (make-vect 0 0))
(define edge1 (make-vect 1 0))
(define edge2 (make-vect 0 1))
(define frame (make-frame origin edge1 edge2))
(newline)
(display (origin-frame frame))
(newline)
(display (edge1-frame frame))
(newline)
(display (edge2-frame frame))
(exit)

结果如下：

(0 . 0)
(1 . 0)
(0 . 1)

第二种实现：

(load "helper.scm")

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

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

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

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

; test
(define origin (make-vect 0 0))
(define edge1 (make-vect 1 0))
(define edge2 (make-vect 0 1))
(define frame (make-frame origin edge1 edge2))
(newline)
(display (origin-frame frame))
(newline)
(display (edge1-frame frame))
(newline)
(display (edge2-frame frame))
(exit)

结果如下：

(0 . 0)
(1 . 0)
(0 . 1)

2.48(p93)

(load "helper.scm")

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

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

(define (end-segment segment)
    (cdr segment))

; test
(define v1 (make-vect 1 0))
(define v2 (make-vect 0 1))
(define segment (make-segment v1 v2))
(newline)
(display (start-segment segment))
(newline)
(display (end-segment segment))
(exit)

结果如下：

(1 . 0)
(0 . 1)

2.49(p93)

(load "helper.scm")

(define (segments->painter segment-list)
    (lambda (frame)
        (for-each
            (lambda (segment)
                (draw-line
                    ((frame-coord-map frame) (start-segment segment))
                    ((frame-coord-map frame) (end-segment segment))))
        segment-list)))

; a)
(define v1 (make-vect 0 0))
(define v2 (make-vect 1 0))
(define v3 (make-vect 1 1))
(define v4 (make-vect 0 1))
(define seg-list1 (list (make-segment v1 v2) (make-segment v2 v3)
                        (make-segment v3 v4) (make-segment v4 v1)))
(define p1 (segments->painter seg-list1))

; b)
(define seg-list2 (list (make-segment v1 v3) (make-segment v2 v4)))
(define p2 (segments->painter seg-list2))

; c)
(define v5 (make-vect 0.5 0))
(define v6 (make-vect 1 0.5))
(define v7 (make-vect 0.5 1))
(define v8 (make-vect 0 0.5))
(define seg-list3 (list (make-segment v5 v6) (make-segment v6 v7)
                        (make-segment v7 v8) (make-segment v8 v5)))
(define p3 (segments->painter seg-list2))

; d)
; 比较复杂, 略

(exit)

2.50(p95)

(load "helper.scm")

(define (flip-horiz painter)
    (transform-painter painter
                       (make-vect 1.0 0.0)
                       (make-vect 0.0 0.0)
                       (make-vect 0.0 1.0)))

(define (rotate180 painter)
    (transform-painter painter
                     (make-vect 1.0 1.0)
                     (make-vect 0.0 1.0)
                     (make-vect 1.0 0.0)))

(define (rotate270 painter)
    (transform-painter painter
                     (make-vect 0.0 1.0)
                     (make-vect 0.0 0.0)
                     (make-vect 1.0 1.0)))

2.51(p95)

方法1：

(load "helper.scm")
(load "2.50.scm")

(define (below1 painter1 painter2)
    (let ((split-point (make-vec 0.0 0.5)))
        (let ((painter-below
                (transform-painter painter1
                                   (make-vec 0.0 0.0)
                                   (make-vec 1.0 0.0)
                                   split-point))
              (painter-up
                (transform-painter painter2
                                   split-point
                                   (make-vec 1.0 0.5)
                                   (make-vec 0.0 1.0))))
        (lambda (frame)
            (painter-up frame)
            (painter-below frame)))))

方法2：

目标：

d2 c2
a2 b2
d1 c1 
a1 b1

过程：

第一步

d c				 a d
a b ->(rotate270) b c

第二步(beside)

a1 d1 a2 d2
b1 c1 b2 c2

第三步(rotate90)

d2 c2
a2 b2
d1 c1
a1 b1

代码如下：

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

2.52(p96)

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

; c)
(define (square-limit painter n)
  (let ((quarter (corner-split painter n)))
    (let ((half (beside quarter quarter)))
      (below half half))))

2.53(p98)

(load "helper.scm")

(newline)
(display (list 'a 'b 'c))
(newline)
(display (list (list 'george)))
(newline)
(display (cdr '((x1 x2) (y1 y2))))
(newline)
(display (cadr '((x1 x2) (y1 y2))))
(newline)
(display (pair? (car '(a short list))))
(newline)
(display (memq 'red '((red shoes) (blue socks))))
(newline)
(display (memq 'red '(red shoes blue socks)))
(exit)

结果如下：

(a b c)
((george))
((y1 y2))
(y1 y2)
#f
#f
(red shoes blue socks)

2.54(p98)

(define (equal? a b)
    (cond ((and (not (pair? a)) (not (pair? b))) (eq? a b))
           ((and (pair? a) (pair? b)) (and (eq? (car a) (car b)) (equal? (cdr a) (cdr b))))
           (else #f)))

; test
(newline)
(display (equal? '(this is a list) '(this is a list)))
(newline)
(display (equal? '(this is a list) '(this (is a) list)))
(exit)

结果如下：

#t
#f

2.55(p99)

‘有特殊含义，利用quoate表示’。

(newline)
(display (car ''abracadabra))
(newline)
(display (cdr ''abracadabra))
(newline)
(display '')
(exit)

结果如下：

quote
(abracadabra)
Exception in read: unexpected close parenthesis at line 6, char 12 of d:\MOOC\计算机程序的构造和解释\习题\第2 
章\2.55.scm

2.56(p102)

(load "helper.scm")

(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))))
        ((exponentiation? exp)
         (let ((b (base exp))
               (e (exponent exp)))
              (make-product
                (make-product e (make-exponentiation b (- e 1)))
                (deriv b var))))
        (else
         (error "unknown expression type -- DERIV" exp))))

(define (exponentiation? exp)
    (and (pair? exp) (eq? (car exp) '**)))

(define (base exp)
    (cadr exp))

(define (exponent exp)
    (caddr exp))

; b ** e
(define (make-exponentiation b e)
    (cond ((= e 0) 1)
          ((= e 1) b)
          (else (list '** b e))))

;test
(define a '(+ x 3))
(define b '(** x 5))
(define c (make-sum a b))
(define d '(** x 1))
(define e '(** x 0))
(newline)
(display (deriv a 'x))
(newline)
(display (deriv b 'x))
(newline)
(display (deriv c 'x))
(newline)
(display (deriv d 'x))
(newline)
(display (deriv e 'x))
(exit)

结果如下：

1
(* 5 (** x 4))
(+ 1 (* 5 (** x 4)))
1
0

2.57(p102)

(load "helper.scm")

(define (addend s) (cadr s))

(define (augend s) 
    ; 如果不是(+ a b), 则产生(+ b c)
    ; 否则直接返回b
    (if (not (null? (cdddr s)))
        (cons '+ (cddr s))
        (caddr s)))

(define (multiplier p) (cadr p))

(define (multiplicand p)
    (if (not (null? (cdddr p)))
        (cons '* (cddr p))
        (caddr p)))

; test
(newline)
(display (deriv '(+ x y 2) 'x))
(newline)
(display (deriv '(* x y (+ x 1 2)) 'x))
(exit)

结果如下：

1
(+ (* x y) (* y (+ x 1 2)))

2.58(p120)

(a)
(load "helper.scm")

(define (sum? x)
  (and (pair? x) (eq? (cadr x) '+)))

(define (addend s) (car s))

(define (augend s) (caddr s))

(define (product? x)
  (and (pair? x) (eq? (cadr x) '*)))

(define (multiplier p) (car p))

(define (multiplicand p) (caddr p))

;; With simplification
(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))))

; test
(define a '(x + 3))
(define b '(x * 5))
(define c (make-product a b))
(define d '(x + (3 * (x + (y + 2)))))
(newline)
(display (deriv a 'x))
(newline)
(display (deriv b 'x))
(newline)
(display (deriv c 'x))
(newline)
(display (deriv d 'x))
(exit)

结果如下：

1
5
(((x + 3) * 5) + (x * 5))
4
(b)
(load "helper.scm")

(define (sum? x)
  (and (pair? x) (eq? (cadr x) '+)))

(define (addend s) (car s))

(define (augend s)
    ; 如果是(a + b + c), 则返回(b + c)
    ; 如果是(a + b), 则返回b
    (cond ((null? (cdddr s)) (caddr s))
          ; 是pair
          (else (if (pair? (caddr s))
                    (caddr s)
                    (cddr s)))))

(define (product? x)
  (and (pair? x) (eq? (cadr x) '*)))

(define (multiplier p) (car p))

(define (multiplicand p)
    ; 如果是(a * b * c), 则返回(b * c)
    ; 如果是(a * b), 则返回b
    (cond ((null? (cdddr p)) (caddr p))
          ; 是pair
          (else (if (pair? (caddr p))
                    (caddr p)
                    (cddr p)))))

;; With simplification
(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))))

; test
(define a '(x + 3 * (x + y + 2)))
(define b '(x + (3 * (x + (y + 2)))))
(define c '(x * 1 * (x + 1 + 2)))
(newline)
(display (deriv a 'x))
(newline)
(display (deriv b 'x))
(newline)
(display (deriv c 'x))
(exit)

结果如下：

4
4
(x + (1 * (x + 1 + 2)))