这次回顾第二章第七部分习题,习题真的越来越难,确实有点力不从心,本章剩余的习题会慢慢更新,后续会先学习第三章。

学习资料:

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

2.81(p136)

参考资料:

https://sicp.readthedocs.io/en/latest/chp2/81.html

(a)

会产生无限循环。

(b)

并没有,因为如果类型相同,那么t1->t2存在,从而会执行如下操作:

(apply-generic op (t1->t2 a1) a2)

递归调用的语句依然为:

(apply-generic op (t1->t2 a1) a2)
(c)

增加一个if判断产生报错即可:

(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)))
                (let ((t1->t2 (get-coercion type1 type2))
                      (t2->t1 (get-coercion type2 type1)))
                  ; 进入该步说明没有type1, type2对应的函数, 此时如果类型相同则报错
                  (if (equal? type1 type2)
                      (error "No method for these types" (list op type-tags))
                      (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(p137)

事实上,只要是塔型结构,即使参数只有两个,该函数也会出现问题。

考虑图2.26,假设多边形有一个op,假设现在要对三角形和四边形调用该op,那么必然要将两者转换为多边形,但是该过程无法做到这点。

2.83(p137)

参考资料:

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

整体结构:

  • 2.83helper
    • arithmetic.scm
    • complex_ari.scm
    • integer_ari.scm(新增)
    • rational_ari.scm
    • real_ari.scm
    • raise.scm(新增)
  • 2.83.scm

raise.scm代码如下:

(define (install-raise-package)
    (put 'raise '(integer)
       (lambda (x) (make-rational x 1)))
    (put 'raise '(rational)
       (lambda (x) (make-real (/ (numer x) (denom x)))))
    (put 'raise '(real)
       (lambda (x) (make-complex-from-real-imag x 0)))
)

主代码如下:

(load "2.83helper/arithmetic.scm")

(define (add x y) (apply-generic 'add x y))
(define (sub x y) (apply-generic 'sub x y))
(define (mul x y) (apply-generic 'mul x y))
(define (div x y) (apply-generic 'div x y))
(define (magnitude z) (apply-generic 'magnitude z))
(define (raise x) (apply-generic 'raise x))

(define d1 (make-integer 1))
(define d2 (raise d1))
(define d3 (raise d2))
(define d4 (raise d3))

(newline)
(display d1)
(newline)
(display d2)
(newline)
(display d3)
(newline)
(display d4)
(newline)
(exit)

结果如下:

(integer . 1)
(rational 1 . 1)
(real . 1)
(complex rectangular 1 . 0)

2.84(p137)

参考资料:

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

这里假设类型的关系为塔型,所以或者类型$a$可以转换为类型$b$,或者类型$b$可以转换为类型$a$。

整体结构:

  • 2.84helper
    • apply.scm(修改)
    • arithmetic.scm
    • height.scm(新增)
    • raise.scm(修改)
  • 2.84.scm

raise.scm增加一个raise k次的函数:

(define (install-raise-package)
    (put 'raise 'integer
        (lambda (x) (make-rational x 1)))
    (put 'raise 'rational
        (lambda (x) (make-real (/ (numer x) (denom x)))))
    (put 'raise 'real
        (lambda (x) (make-complex-from-real-imag x 0)))
)

(define (raise-k-times x k)
    (define raise-x (get 'raise (type-tag x)))
    (if (= k 0)
        x
        (raise-k-times (raise-x (contents x)) (- k 1))))

height.scm定义层级关系:

(define complex-height
    0)
(define real-height
    (+ 1 complex-height))
(define rational-height
    (+ 1 real-height))
(define integer-height
    (+ 1 rational-height))

(define (height type)
    (cond ((eq? type 'complex) complex-height)
          ((eq? type 'real) real-height)
          ((eq? type 'rational) rational-height)
          ((eq? type 'integer) integer-height)))

修改后的apply.scm:

(load "2.84helper/height.scm")
(load "2.84helper/raise.scm")

(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)))
                (let ((h1 (height type1))
                      (h2 (height type2)))
                     (define h (abs (- h1 h2)))
                  ; 调整
                  (cond ((< h1 h2)
                         (apply-generic op a1 (raise-k-times a2 h)))
                        ((> h1 h2)
                         (apply-generic op (raise-k-times a1 h) a2))
                        (else
                         (apply-generic op a1 a2)))))
              (error "No method for these types"
                     (list op type-tags)))))))

主函数:

(load "2.84helper/arithmetic.scm")

(define (add x y) (apply-generic 'add x y))
(define (sub x y) (apply-generic 'sub x y))
(define (mul x y) (apply-generic 'mul x y))
(define (div x y) (apply-generic 'div x y))
(define (magnitude z) (apply-generic 'magnitude z))

(define d1 (make-integer 1))
(define d2 (raise-k-times d1 1))
(define d3 (raise-k-times d1 2))
(define d4 (raise-k-times d1 3))
(define d5 (add d1 d2))
(define d6 (add d3 d4))
(define d7 (make-integer 1))

(newline)
(display d1)
(newline)
(display d2)
(newline)
(display d3)
(newline)
(display d4)
(newline)
(display d5)
(newline)
(display d6)
(newline)
(display (eq? d1 d7))

(exit)

测试结果:

(integer . 1)
(rational 1 . 1)
(real . 1)
(complex rectangular 1 . 0)
(rational 2 . 1)
(complex rectangular 2 . 0)
#f

2.85(p137)

由于计算机中实数使用浮点数表示,所以编程无法判断实数是否为有理数,因此这里的只考虑

  • 整数
  • 实数
  • 复数

整体结构:

  • 2.85helper
    • apply.scm(修改)
    • arithmetic.scm
    • drop.scm(新增)
    • height.scm(删除有理数部分)
    • raise.scm(删除有理数部分)
  • 2.85.scm

drop.scm:

  • 思路是比较简单的,如果(raise(project(x))) = x,那么则可以project;否则返回x。
(load "2.85helper/raise.scm")

(define (install-project-package)
    (put 'project 'complex
        (lambda (x) (make-real (real-part x))))
    (put 'project 'real
        (lambda (x) (make-integer (round x))))
)

(define (drop x)
    (let ((type-x (type-tag x))
          (project-x (get 'project (type-tag x))))
        (if project-x
            (let ((x-project (project-x (contents x))))
                (let ((raise-x (get 'raise (type-tag x-project))))
                    (let ((x-raise (raise-x (contents x-project)))
                          (eq (get 'equ? (list type-x type-x))))
                        (if (eq (contents x) (contents x-raise))
                            (drop x-project)
                            x))))
            x)))

apply.scm:

(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc
          ; 新增
          (drop (apply proc (map contents args)))
          (if (= (length args) 2)
              (let ((type1 (car type-tags))
                    (type2 (cadr type-tags))
                    (a1 (car args))
                    (a2 (cadr args)))
                (let ((h1 (height type1))
                      (h2 (height type2)))
                     (define h (abs (- h1 h2)))
                  ; 修改
                  (cond ((< h1 h2)
                         (drop (apply-generic op a1 (raise-k-times a2 h))))
                        ((> h1 h2)
                         (drop (apply-generic op (raise-k-times a1 h) a2)))
                        (else
                         (drop (apply-generic op a1 a2))))))
              (error "No method for these types"
                     (list op type-tags)))))))

主程序:

(load "2.85helper/arithmetic.scm")

(define (add x y) (apply-generic 'add x y))
(define (sub x y) (apply-generic 'sub x y))
(define (mul x y) (apply-generic 'mul x y))
(define (div x y) (apply-generic 'div x y))
(define (magnitude z) (apply-generic 'magnitude z))

; test
(define d1 (make-integer 1))
(define d2 (make-real 1.0))
(define d3 (make-real -1.5))
(define d4 (make-real 2.5))
(define d5 (make-complex-from-real-imag 1.5 2))
(define d6 (make-complex-from-real-imag 1.5 -2))
(newline)
(display (add d1 d2))
(newline)
(display (add d3 d4))
(newline)
(display (add d5 d6))

(exit)

结果如下:

(integer . 2.0)
(integer . 1.0)
(integer . 3.0)

2.86(p137)

参考资料:

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

这部分如果要完全实现还是比较复杂的,这部分留在完整的运算系统中实现,这里只补充核心部分。

  • 将加减乘除替换为add, sub, mul, div
  • 定义通用的sin, cos, square, sqrt, atan

op.scm:

(define (add x y) (apply-generic 'add x y))
(define (sub x y) (apply-generic 'sub x y))
(define (mul x y) (apply-generic 'mul x y))
(define (div x y) (apply-generic 'div x y))
(define (magnitude z) (apply-generic 'magnitude z))
(define (raise x) (apply-generic 'raise x))
(define (value x) (apply-generic 'value x))

(define (sine x)
    (sin (value x)))

(define (cosine x)
    (cosine (value x)))

(define (square x)
    (* (value x) (value x)))

(define (sqrt x)
    (sqrt (value x)))

(define (atan x)
    (atan (value x)))