计算机程序的构造和解释(SICP) 第4章 习题解析 Part2

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

学习资料：

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

http://community.schemewiki.org/?SICP-Solutions

http://community.schemewiki.org/?sicp

https://liujiacai.net/blog/2016/02/22/recursion-without-name/

https://mvanier.livejournal.com/2897.html

4.11(p263)

代码：

(define (make-frame variables values)
    (define (make-frame-iter res vars vals)
        (if (equal? vars '())
            res
            (make-frame-iter 
                (append res (list (cons (car vars) (car vals))))
                (cdr vars) 
                (cdr vals))))
    (make-frame-iter '() variables values))

(define (frame-variables frame)
    (define (frame-variables-iter res frame)
        (if (equal? frame '())
            res
            (frame-variables-iter 
                (append res (list (caar frame))) (cdr frame))))
    (frame-variables-iter '() frame))

(define (frame-values frame)
    (define (frame-values-iter res frame)
        (if (equal? frame '())
            res
            (frame-values-iter 
                (append res (list (cdar frame))) (cdr frame))))
    (frame-values-iter '() frame))

(define (add-binding-to-frame! var val frame)
    (set-cdr! frame (append (cdr frame) (list (cons var val)))))

; test
(define variables (list 'a 'b 'c))
(define values (list 1 2 3))

(define frame (make-frame variables values))
(display frame)
(define var (frame-variables frame))
(display var)
(define val (frame-values frame))
(display val)
(add-binding-to-frame! 'd 4 frame)
(display frame)

测试结果：

1 ]=> (display frame)((a . 1) (b . 2) (c . 3))
;Unspecified return value

1 ]=> (define var (frame-variables frame))
;Value: var

1 ]=> (display var)(a b c)
;Unspecified return value

1 ]=> (define val (frame-values frame))
;Value: val

1 ]=> (display val)(1 2 3)
;Unspecified return value

1 ]=> (add-binding-to-frame! 'd 4 frame)
;Unspecified return value

1 ]=> (display frame)((a . 1) (b . 2) (c . 3) (d . 4))
;Unspecified return value

4.12(p263)

(define (lookup-variable-value var env)
    (let ((frame (first-frame env)))
         (define (env-loop env)
            (define (scan vars vals)
                (cond ((null? vars)
                       ; need change
                       (env-loop (enclosing-environment env)))
                      ((eq? var (car vars))
                       ; need change
                       (car vals))
                      (else (scan (cdr vars) (cdr vals)))))
            ; need change
            (if (eq? env the-empty-environment)
                (error "Unbound variable" var)
                (scan (frame-variables frame)
                      (frame-values frame))))
            (env-loop env)))

(define (set-variable-value! var env)
    (let ((frame (first-frame env)))
         (define (env-loop env)
            (define (scan vars vals)
                (cond ((null? vars)
                       ; need change
                       (env-loop (enclosing-environment env)))
                      ((eq? var (car vars))
                       ; need change
                       (set-car! vals val))
                      (else (scan (cdr vars) (cdr vals)))))
            ; need change
            (if (eq? env the-empty-environment)
                (error "Unbound variable -- SET!" var)
                (scan (frame-variables frame)
                      (frame-values frame))))
            (env-loop env)))

(define (define-variable! var val env)
    (let ((frame (first-frame env)))
         (define (env-loop env)
            (define (scan vars vals)
                (cond ((null? vars)
                       ; need change
                       (add-binding-to-frame! var val frame))
                      ((eq? var (car vars))
                       ; need change
                       (set-car! vals val))
                      (else (scan (cdr vars) (cdr vals)))))
            ; need change
            (scan (frame-variables frame)
                  (frame-values frame)))
        (env-loop env)))

; template
(define (variable-proc var val env flag)
    (lambda (var val env)
        (let ((frame (first-frame env)))
             (define (env-loop env)
                (define (scan vars vals)
                    (cond ((null? vars)
                           (cond ((= flag 3) (add-binding-to-frame! var val frame))
                                 (else (env-loop (enclosing-environment env)))))
                          ((eq? var (car vars))
                           (cond ((= flag 1) (car vals))
                                 (else (set-car! vals val))))
                         (else (scan (cdr vars) (cdr vals)))))
                (cond ((= flag 1) (if (eq? env the-empty-environment)
                                      (error "Unbound variable" var)
                                      (scan (frame-variables frame)
                                            (frame-values frame))))
                      ((= flag 2) (if (eq? env the-empty-environment)
                                      (error "Unbound variable -- SET!" var)
                                      (scan (frame-variables frame)
                                            (frame-values frame))))
                      (else (scan (frame-variables frame) (frame-values frame)))))
             (env-loop env))))

; define functioin
; lookup-variable-value, set-variable-value! flag = 1
; define-variable! flag = 0

(define (lookup-variable-value var env)
    (variable-proc var 0 env 1))

(define (set-variable-value! var env)
    (variable-proc var 0 env 2))

(define (define-variable! var val env)
    (variable-proc var val env 3))

4.13(p264)

参考资料：

http://community.schemewiki.org/?sicp-ex-4.13

思想是删除当前环境的var。

(define (make-unbound! var env)
    (let*  ((frame (first-frame env))
            (vars (frame-variables frame))
            (vals (frame-values frame)))
            ;curvars: 当前vars, curvals: 当前vals
            ;vars: 剩余vars, vals: 剩余vals
            (define (scan curvars vars curvals vals var)
                (if (not (null? curvars))
                    (if (equal? (car curvars) var)
                        (begin 
                            (set-cdr! curvars vars)
                            (set-cdr! curvals vals))
                        (scan vars (cdr vars) vals (cdr vals) var))))
            (if (not (null? vars))
                (scan vars (cdr vars) vals (cdr vals) var))))

4.14(p266)

参考资料：

https://github.com/jiacai2050/sicp/blob/master/exercises/04/4.14.md

https://blog.csdn.net/zzljlu/article/details/7617848

map的形式为

(map proc arr)

其中proc为函数。

在scheme解释器中，考虑函数

1 ]=> (lambda (x) x)

;Value 13: #[compound-procedure 13]

但是在我们的解释器中

;;; M-Eval input:
(lambda (x) x)

;;; M-Eval value:
(compound-procedure (x) (x) <procedure-env>)

所以如果调用原生的map，则会因为参数不匹配而报错。

4.15(p268)

考虑调用

(try try)

如果会终止，即

(halts? try try)

为true，那么会调用

(run-forever)

所以陷入死循环，这就产生了矛盾。

反之，如果不会终止，即

(halts? try try)

为false，那么会调用

'halted

这也产生了矛盾。

因此任何结果都会违背halts?的行为，所以不存在这样的halts?。

4.16(p270)

(a)(b)

(load "ch4-mceval.scm")
(load "4.6.scm")

; (a)
(define (lookup-variable-value var env)
  (define (env-loop env)
    (define (scan vars vals)
      (cond ((null? vars)
             (env-loop (enclosing-environment env)))
            ((eq? var (car vars))
             ; add
             (if (eq? (car vals) '*unassigned*)
                 (error "Unassigned value" var)
                 (car vals)))
            (else (scan (cdr vars) (cdr vals)))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable" var)
        (let ((frame (first-frame env)))
          (scan (frame-variables frame)
                (frame-values frame)))))
  (env-loop env))

; (b)
(define (scan-out-defines body)
    (define (definitions-to-let definitions)
        (map (lambda (x) (list (definition-variable x) '*unassigned*)) definitions))
    (define (definitions-to-set definitions)
        (map (lambda (x) (cons 'set (list (definition-variable x) (definition-value x)))) definitions))
    (define (def-to-let body definitions)
        (cond ((null? body) 
               (append (list 'let (definitions-to-let definitions)) (definitions-to-set definitions)))
              ((definition? (car body))
               (def-to-let (cdr body) (append definitions (list (car body)))))
              (else
              (append 
                (append (list 'let (definitions-to-let definitions)) (definitions-to-set definitions))
                (list (car body))))))
    (def-to-let body '()))

; test
(display
  (scan-out-defines '((define u <e1>)
      (define v <e2>)
      <e3>)))

结果如下：

1 ]=> ; test
(display
  (scan-out-defines '((define u <e1>)
      (define v <e2>)
      <e3>)))(let ((u *unassigned*) (v *unassigned*)) (set u <e1>) (set v <e2>) <e3>)

(c)

安装在make-procedure里，因为这样只会调用一次

(define (make-procedure parameters body env)
  (list 'procedure parameters body env))

4.17(p270)

参考资料：

http://community.schemewiki.org/?sicp-ex-4.17

let等价于lambda，所以会增加一个框架；如果要不增加框架，使用define即可：

(lambda <vars>
    (define u '*unassigned*)
    (define v '*unassigned*)
    (set! u <e1>)
    (set! v <e2>)
    <e3>)

4.18(p270)

代码如下：

(define (solve f y0 dt)
    (define y (integral (delay dy) y0 dt))
    (define dy (stream-map f y))
    y)

(lambda (f y0 dt)
    (let ((y '*unassigned*)
          (dy '*unassigned*))
        (let ((a (integral (delay dy) y0 dt))
              (b (stream-map f y)))
            (set! y a)
            (set! dy b))
        y))

(lambda (f y0 dt)
    (let ((y '*unassigned*)
          (dy '*unassigned*))
        (set! y (integral (delay dy) y0 dt))
        (set! dy (stream-map f y))
        y))

注意到如下定义会报错，因为dy, y均无定义：

let ((a (integral (delay dy) y0 dt))
     (b (stream-map f y)))

4.19(p271)

最合理的应该是Eva的想法。

给出一个实现的简单思路：

• 提取所有的变量，设没被赋值的变量数量$n$。
• 初始化$i=0,lasti= 0$。
• while $i< n$:
  • 给没被赋值的变量赋值。
  • 更新被赋值的元素数量$i$。
  • if $i=lasti$：
    • return 存在循环依赖。
  • $lasti = i$

4.20(p272)

(a)

(load "ch4-mceval.scm")
(load "4.6.scm")

(define (letrec? exp) (tagged-list? exp 'letrec))

(define (letrec-var-exp exp) (cadr exp))

(define (letrec-body exp) (cddr exp))

(define (get-var varexp)
    (car varexp))

(define (get-val varexp)
    (cadr varexp))

(define (varexp-to-let varexp)
    (map (lambda (x) (list (get-var x) '*unassigned*)) varexp))
(define (varexp-to-set varexp)
    (map (lambda (x) (cons 'set (list (get-var x) (get-val x)))) varexp))

(define (letrec->let exp)
    (cons 
        (append 
            (list 'let (varexp-to-let (letrec-var-exp exp))) 
            (varexp-to-set (letrec-var-exp exp)))
        (letrec-body exp)))

; test
(display (letrec->let '(letrec ((even?
            (lambda (n)
              (if (= n 0)
                  true
                  (odd? (- n 1)))))
           (odd?
            (lambda (n)
              (if (= n 0)
                  false
                  (even? (- n 1))))))
    )))

结果如下：

1 ]=> ; test
(display (letrec->let '(letrec ((even?
            (lambda (n)
              (if (= n 0)
                  true
                  (odd? (- n 1)))))
           (odd?
            (lambda (n)
              (if (= n 0)
                  false
                  (even? (- n 1))))))
    )))((let ((even? *unassigned*) (odd? *unassigned*)) (set even? (lambda (n) (if (= n 0) true (odd? (- n 1))))) (set odd? (lambda (n) (if (= n 0) false (even? (- n 1)))))))

(b)

略过

4.21(p272)

参考资料：

https://liujiacai.net/blog/2016/02/22/recursion-without-name/

https://mvanier.livejournal.com/2897.html

此题思路很巧妙，要多理解几遍。

完整思路：

; 原始函数
(define (factorial n)
    (if (= n 1)
        1
        (* n (factorial (- n 1)))))

; 为了消除递归, 将函数调用中的factorial用self替换
(define (part-factorial self n)
    (if (= n 1)
        1
        (* n (self (- n 1)))))

; 我们希望 (part-factorial part-factorial n) = n!
; 但是使用调用时, 内部会调用(part-factorial (- n 1)), 此时参数数量不匹配, 所以还要进行修改
(define (part-factorial self n)
    (if (= n 1)
        1
        (* n (self self (- n 1)))))

(part-factorial part-factorial 5)

; 做一层封装
(define (factorial n)
    (let ((fact (lambda (ft k)
                    (if (= k 1)
                        1
                        (* k (ft ft (- k 1)))))))
         (fact fact n)))

(factorial 5)

; 将let转换为lambda
; (let ((x <expr1>)) <expr2>)
;  ==> ((lambda (x) <expr2>) <expr1>)
(define (factorial n)
    ((lambda (fact)
      (fact fact n))
    (lambda (ft k)
      (if (= k 1)
          1
          (* k (ft ft (- k 1)))))))

(factorial 5)

结果如下：

1 ]=> ; 原始函数
(define (factorial n)
    (if (= n 1)
        1
        (* n (factorial (- n 1)))))
;Value: factorial

1 ]=> ; 为了消除递归, 将函数调用中的factorial用self替换
(define (part-factorial self n)
    (if (= n 1)
        1
        (* n (self (- n 1)))))
;Value: part-factorial

1 ]=> ; 我们希望 (part-factorial part-factorial n) = n!
; 但是使用调用时, 内部会调用(part-factorial (- n 1)), 此时参数数量不匹配, 所以还要进行修改
(define (part-factorial self n)
    (if (= n 1)
        1
        (* n (self self (- n 1)))))
;Value: part-factorial

1 ]=> (part-factorial part-factorial 5)
;Value: 120

1 ]=> ; 做一层封装
(define (factorial n)
    (let ((fact (lambda (ft k)
                    (if (= k 1)
                        1
                        (* k (ft ft (- k 1)))))))
         (fact fact n)))
;Value: factorial

1 ]=> (factorial 5)
;Value: 120

1 ]=> ; 将let转换为lambda
; (let ((x <expr1>)) <expr2>)
;  ==> ((lambda (x) <expr2>) <expr1>)
(define (factorial n)
    ((lambda (fact)
      (fact fact n))
    (lambda (ft k)
      (if (= k 1)
          1
          (* k (ft ft (- k 1)))))))
;Value: factorial

1 ]=> (factorial 5)
;Value: 120

1 ]=> ; (let ((fact (lambda (ft k)
;                 (if (= k 1)
;                     1
;                     (* k (ft ft (- k 1)))))))
;      (fact fact n))
End of input stream reached.

(a)

代码：

; (a)
((lambda (n)
   ((lambda (fact)
      (fact fact n))
    (lambda (ft k)
      (if (= k 1)
          1
          (* k (ft ft (- k 1)))))))
 10)

(define (fib n)
    ((lambda (fact)
      (fact fact n))
    (lambda (ft k)
      (if (<= k 2)
          1
          (+ (ft ft (- k 1)) (ft ft (- k 2)))))))

(fib 5)

((lambda (n)
   ((lambda (fact)
      (fact fact n))
    (lambda (ft k)
      (if (<= k 2)
          1
          (+ (ft ft (- k 1)) (ft ft (- k 2)))))))
 10)

(define (test n)
    (define (test-iter i)
        (if (<= i n)
            (begin (newline)
             (display (fib i))
             (test-iter (+ i 1)))))
    (test-iter 1))

(test 10)

结果如下：

1 ]=> (test 10)
1
1
2
3
5
8
13
21
34
55

(b)

; (b)
(define (f x)
  (define (even? n)
    (if (= n 0)
        true
        (odd? (- n 1))))
  (define (odd? n)
    (if (= n 0)
        false
        (even? (- n 1))))
  (even? x))

; 增加参数的递归定义
(define (f1 x)
  (define (ev? od? n)
    (if (= n 0)
        true
        (od? ev? (- n 1))))
  (define (od? ev? n)
    (if (= n 0)
        false
        (ev? od? (- n 1))))
  (ev? od? x))

(f1 5)
(f1 4)

; 无法在let中递归定义, 所以要增加参数
(define (f2 x)
    (let ((even? (lambda (od? n)
                    (if (= n 0) true (od? even? (- n 1)))))
          (odd? (lambda (ev? n)
                    (if (= n 0) false (ev? odd? (- n 1))))))
        (even? odd? x)))

; 报错
(f2 5)
(f2 4)

; 增加参数
(define (f3 x)
    (define (even? ev? od? n)
        ((lambda (ev? od? n)
            (if (= n 0)
                true
                (od? ev? od? (- n 1))))
        ev? od? n))
    (define (odd? ev? od? n)
        ((lambda (ev? od? n)
            (if (= n 0)
                false
                (ev? ev? od? (- n 1))))
        ev? od? n))
    (even? even? odd? x))

(f3 5)
(f3 4)

; 转换为let版本
(define (f4 x)
    (let ((even? (lambda (ev? od? n)
                    (if (= n 0) true (od? ev? od? (- n 1)))))
          (odd? (lambda (ev? od? n)
                    (if (= n 0) false (ev? ev? od? (- n 1))))))
        (even? even? odd? x)))

(f4 5)
(f4 4)

; 转换为lambda版本
(define (f5 x)
    ((lambda (even? odd?)
        (even? even? odd? x))
     (lambda (ev? od? n)
        (if (= n 0) true (od? ev? od? (- n 1))))
     (lambda (ev? od? n)
        (if (= n 0) false (ev? ev? od? (- n 1))))))

(f5 5)
(f5 4)

结果如下：

1 ]=> (f1 5)
;Value: #f

1 ]=> (f1 4)
;Value: #t

1 ]=> ; 无法在let中递归定义, 所以要增加参数
(define (f2 x)
    (let ((even? (lambda (od? n)
                    (if (= n 0) true (od? even? (- n 1)))))
          (odd? (lambda (ev? n)
                    (if (= n 0) false (ev? odd? (- n 1))))))
        (even? odd? x)))
;Value: f2

1 ]=> ; 报错
(f2 5)
;The procedure #[compiled-procedure 13 ("arith" #xa8) #x1a #x313232] has been called with 2 arguments; it requires exactly 1 argument.
;To continue, call RESTART with an option number:
; (RESTART 1) => Return to read-eval-print level 1.

2 error> (f2 4)
;The procedure #[compiled-procedure 13 ("arith" #xa8) #x1a #x313232] has been called with 2 arguments; it requires exactly 1 argument.
;To continue, call RESTART with an option number:
; (RESTART 2) => Return to read-eval-print level 2.
; (RESTART 1) => Return to read-eval-print level 1.

3 error> ; 增加参数
(define (f3 x)
    (define (even? ev? od? n)
        ((lambda (ev? od? n)
            (if (= n 0)
                true
                (od? ev? od? (- n 1))))
        ev? od? n))
    (define (odd? ev? od? n)
        ((lambda (ev? od? n)
            (if (= n 0)
                false
                (ev? ev? od? (- n 1))))
        ev? od? n))
    (even? even? odd? x))
;Value: f3

3 error> (f3 5)
;Value: #f

3 error> (f3 4)
;Value: #t

3 error> ; 转换为let版本
(define (f4 x)
    (let ((even? (lambda (ev? od? n)
                    (if (= n 0) true (od? ev? od? (- n 1)))))
          (odd? (lambda (ev? od? n)
                    (if (= n 0) false (ev? ev? od? (- n 1))))))
        (even? even? odd? x)))
;Value: f4

3 error> (f4 5)
;Value: #f

3 error> (f4 4)
;Value: #t

3 error> ; 转换为lambda版本
(define (f5 x)
    ((lambda (even? odd?)
        (even? even? odd? x))
     (lambda (ev? od? n)
        (if (= n 0) true (od? ev? od? (- n 1))))
     (lambda (ev? od? n)
        (if (= n 0) false (ev? ev? od? (- n 1))))))
;Value: f5

3 error> (f5 5)
;Value: #f

3 error> (f5 4)
;Value: #t