【SICP练习】101 练习2.77-2.78

练习2.77

我们首先来看看题目中描述的问题，当Louis Reasoner试着求值(magnitude z)时，程序中不断的寻找。一开始是通过apply-generic、而后是map，最后是get。这三个函数在书中都有很好的解释，我自知才疏学浅就不介绍了。最后一步的get中，最后由于找不到匹配的参数而返回了#f。而在Alyssa的程序中则不然。具体请看代码。

(define (install-rectangular-package)
  (define (real-part z) (car z))
  (define (imag-part z) (cdr z))
  (define (make-from-real-imag x y) (cons x y))
  (define (magnitude z)
    (sqrt (+ (square (real-part z))
             (square (imag-part z)))))
  (define (angle z)
    (atan (imag-part z) (real-part z)))
  (define (make-from-mag-ang r a) 
    (cons (* r (cos a)) (* r (sin a))))
  (define (tag x) (attach-tag 'rectangular x))
  (put 'real-part '(rectangular) real-part)
  (put 'imag-part '(rectangular) imag-part)
  (put 'magnitude '(rectangular) magnitude)
  (put 'angle '(rectangular) angle)
  (put 'make-from-real-imag 'rectangular 
       (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang 'rectangular 
       (lambda (r a) (tag (make-from-mag-ang r a))))
'done)

(define (make-from-real-imag x y)
    ((get 'make-from-real-imag 'rectangular) x y))


(define (install-polar-package)
  (define (magnitude z) (car z))
  (define (angle z) (cdr z))
  (define (make-from-mag-ang r a) (cons r a))
  (define (real-part z)
    (* (magnitude z) (cos (angle z))))
  (define (imag-part z)
    (* (magnitude z) (sin (angle z))))
  (define (make-from-real-imag x y) 
    (cons (sqrt (+ (square x) (square y)))
          (atan y x)))
  (define (tag x) (attach-tag 'polar x))
  (put 'real-part '(polar) real-part)
  (put 'imag-part '(polar) imag-part)
  (put 'magnitude '(polar) magnitude)
  (put 'angle '(polar) angle)
  (put 'make-from-real-imag 'polar
       (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang 'polar 
       (lambda (r a) (tag (make-from-mag-ang r a))))
'done)

(define (make-from-mag-ang r a)
((get 'make-from-mag-ang 'polar) r a))

apply-generic 函数：

(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))
                (error 
                    "No method for these types -- APPLY-GENERIC"
                    (list op type-tags))))))

magnitude 、 angle 等四个通用选择器：

(define (real-part z) (apply-generic 'real-part z))
(define (imag-part z) (apply-generic 'imag-part z))
(define (magnitude z) (apply-generic 'magnitude z))
(define (angle z) (apply-generic 'angle z))

复数包：

(define (install-complex-package)
    (define (make-from-real-imag x y)
        ((get 'make-from-real-imag 'rectangular) x y))
    (define (make-from-mag-ang r a)
        ((get 'make-from-mag-ang 'polar) r a))
    (define (add-complex z1 z2)
        (make-from-real-imag (+ (real-part z1) (real-part z2))
                             (+ (imag-part z1) (imag-part z2))))
    (define (sub-complex z1 z2)
        (make-from-real-imag (- (real-part z1) (real-part z2))
                             (- (imag-part z1) (imag-part z2))))
    (define (mul-complex z1 z2)
        (make-from-mag-ang (* (magnitude z1) (magnitude z2))
                           (+ (angle z1) (angle z2))))
    (define (div-complex z1 z2)
        (make-from-mag-ang (/ (magnitude z1) (magnitude z2))
                           (- (angle z1) (angle z2))))
    (define (tag z)
        (attach-tag 'complex z))
    (put 'add '(complex complex)
        (lambda (z1 z2)
            (tag (add-complex z1 z2))))
    (put 'sub '(complex complex)
        (lambda (z1 z2)
            (tag (sub-complex z1 z2))))
    (put 'mul '(complex complex)
        (lambda (z1 z2)
            (tag (mul-complex z1 z2))))
    (put 'div '(complex complex)
        (lambda (z1 z2)
            (tag (div-complex z1 z2))))
    (put 'make-from-real-imag 'complex
        (lambda (x y)
            (tag (make-from-real-imag x y))))

    (put 'make-from-mag-ang 'complex
        (lambda (x y)
            (tag (make-from-mag-ang x y))))
'done)

(define (make-complex-from-real-imag x y)
    ((get 'make-from-real-imag 'complex) x y))
(define (make-complex-from-mag-ang r a)
((get 'make-from-mag-ang 'complex) r a))

put 函数和 get 函数：

(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))

标识（tag）处理函数：

(define (attach-tag type-tag contents)
    (cons type-tag contents))

(define (type-tag datum)
    (if (pair? datum)
        (car datum)
        (error "Bad tagged datum -- TYPE-TAG" datum)))

(define (contents datum)
    (if (pair? datum)
        (cdr datum)
        (error "Bad tagged datum -- CONTENTS" datum)))

(install-rectangular-package)
(install-polar-package)
(install-complex-package)

修改过的复数包：

(define (install-complex-package)
    (define (make-from-real-imag x y)
        ((get 'make-from-real-imag 'rectangular) x y))
    (define (make-from-mag-ang r a)
        ((get 'make-from-mag-ang 'polar) r a))
    (define (add-complex z1 z2)
        (make-from-real-imag (+ (real-part z1) (real-part z2))
                             (+ (imag-part z1) (imag-part z2))))
    (define (sub-complex z1 z2)
        (make-from-real-imag (- (real-part z1) (real-part z2))
                             (- (imag-part z1) (imag-part z2))))
    (define (mul-complex z1 z2)
        (make-from-mag-ang (* (magnitude z1) (magnitude z2))
                           (+ (angle z1) (angle z2))))
    (define (div-complex z1 z2)
        (make-from-mag-ang (/ (magnitude z1) (magnitude z2))
                           (- (angle z1) (angle z2))))
    (define (tag z)
        (attach-tag 'complex z))
    (put 'add '(complex complex)
        (lambda (z1 z2)
            (tag (add-complex z1 z2))))
    (put 'sub '(complex complex)
        (lambda (z1 z2)
            (tag (sub-complex z1 z2))))
    (put 'mul '(complex complex)
        (lambda (z1 z2)
            (tag (mul-complex z1 z2))))
    (put 'div '(complex complex)
        (lambda (z1 z2)
            (tag (div-complex z1 z2))))
    (put 'make-from-real-imag 'complex
        (lambda (x y)
            (tag (make-from-real-imag x y))))
    (put 'make-from-mag-ang 'complex
        (lambda (r a)
            (tag (make-from-mag-ang r a))))
    (put 'real-part '(complex) real-part)
    (put 'imag-part '(complex) imag-part)
    (put 'magnitude '(complex) magnitude)
    (put 'angle '(complex) angle)
'done)
(define (make-complex-from-real-imag x y)
    ((get 'make-from-real-imag 'complex) x y))
(define (make-complex-from-mag-ang r a)
    ((get 'make-from-mag-ang 'complex) r a))

练习2.78

这道题要求我们修改type-tag、contents和attach-tag的定义使我们的通用算术系统可以利用Scheme的内部类型系统。也就是说将一个数字传递给make-scheme-number后返回的是scheme-number . 1(此处传入的是1)。更改之后的则不需要scheme-number这一部分了。

(define (attach-tag type-tag contents)
    (if (number? contents)
       contents
       (cons type-tag contents)))
(define (type-tag datum)
    (cond ((number? datum)
            ‘scheme-number)
           ((pair? datum)
            (car datum))
           (else 
            (error “Bad tagged datum – TYPE-TAG” datum))))
(define (contents datum)
    (cond ((number? datum)
           datum)
           ((pair? datum)
             (cdr datum))
            (else
             (error “Bad tagged datum – CONTENT” datum)))

install-scheme-number-package相关代码在书中第129页代码，这里load一下即可。

(install-scheme-number-package)
;Value: done
(define ten (make-scheme-number 10))
;Value: ten
ten
;Value: 10
(contents ten)
;Value: 10
(type-tag ten)
;Value: scheme-number
(add ten ten) 
;Value: 20

---

---

感谢访问，希望对您有所帮助。 欢迎关注或收藏、评论或点赞。

---

为使本文得到斧正和提问，转载请注明出处：
http://blog.csdn.net/nomasp

---

版权声明：本文为 NoMasp柯于旺 原创文章，如需转载请联系本人。