练习 2.77

这题所涉及的程序众多,完整的源码在后面给出。

首先重现 Louis 所遇到的问题:

1 ]=> (load "77-louis-complex.scm")

;Loading "77-louis-complex.scm"...
;  Loading "p123-install-rectangular-package.scm"...
;    Loading "p119-tag.scm"... done
;    Loading "p123-put-and-get.scm"... done
;  ... done
;  Loading "p124-install-polar-package.scm"...
;    Loading "p119-tag.scm"... done
;    Loading "p123-put-and-get.scm"... done
;  ... done
;  Loading "p130-install-complex-package.scm"...
;    Loading "p119-tag.scm"... done
;    Loading "p123-put-and-get.scm"... done
;  ... done
;  Loading "p125-generic-selector.scm"...
;    Loading "p125-apply-generic.scm"...
;      Loading "p119-tag.scm"... done
;    ... done
;  ... done
;... done
;Value: done

1 ]=> (magnitude (make-complex-from-real-imag 3 4))

;No method for these types -- APPLY-GENERIC (magnitude (complex))
;To continue, call RESTART with an option number:
; (RESTART 1) => Return to read-eval-print level 1.

2 error>

当 Louis 求值表达式 (magnitude z) 时,有以下执行过程:

(magnitude z)

(apply-generic 'magnitude z)

(map type-tag (list z))         ; => '(complex)

(get 'magnitude '(complex))     ; => #f

(error ...)

从执行过程可以看出, apply-generic 试图寻找 '(complex) 类型的 'magnitude 操作,但是该操作并不存在,所以它返回 #f ,并引发一个错误。

要让这个复数系统的 magnitude 函数以及其他通用选择符正常运作,我们需要像 Alyssa 说的那样,为 '(complex) 类型关联相应的操作函数才行。

以下是新的复数系统:

1 ]=> (load "77-alyssa-complex.scm")

;Loading "77-alyssa-complex.scm"...
;  Loading "p123-install-rectangular-package.scm"...
;    Loading "p119-tag.scm"... done
;    Loading "p123-put-and-get.scm"... done
;  ... done
;  Loading "p124-install-polar-package.scm"...
;    Loading "p119-tag.scm"... done
;    Loading "p123-put-and-get.scm"... done
;  ... done
;  Loading "p125-apply-generic.scm"...
;    Loading "p119-tag.scm"... done
;  ... done
;  Loading "p125-generic-selector.scm"...
;    Loading "p125-apply-generic.scm"...
;      Loading "p119-tag.scm"... done
;    ... done
;  ... done
;  Loading "77-install-alyssa-complex-package.scm"...
;    Loading "p123-put-and-get.scm"... done
;    Loading "p119-tag.scm"... done
;  ... done
;... done
;Value: done

1 ]=> (magnitude (make-complex-from-real-imag 3 4))

;Value: 5

在 Alyssa 的复数系统中求值表达式 (magnitude z) ,有以下执行过程:

(magnitude z)                                                   ; 这个 magnitude 是最外层的通用操作

(apply-generic 'magnitude z)

(map type-tag (list z))                                         ; => '(complex)

(get 'magnitude '(complex))                                     ; => magnitude  ; 这个 magnitude 是定义于 complex 包中的 magnitude

(apply magnitude (map contents (list z)))                       ; =>  (apply magnitude '((rectangular 3 . 4)))

(magnitude '(rectangular 3 . 4))

(apply-generic 'magnitude '(rectangular 3 . 4))

(map type-tag (list '(rectangular 3 . 4)))                      ; => '(rectangular)

(get 'magnitude '(rectangular))                                 ; => magnitude  ; 这个 magnitude 是定义于 rectangular 包中的 magnitude

(apply magnitude (map contents (list '(rectangular 3 . 4))))    ; => (apply magnitude '((3 . 4)))

(magnitude '(3 . 4))

(sqrt (+ (square (real-part '(3 . 4)))
         (square (imag-part '(3 . 4)))))

5

可以看出,复数系统共调用了三次 magnitude 函数,第一次调用的是外层的通用操作函数 magnitude ,第二次调用的是定义在 (install-complex-package) 包内的 magnitude 函数,第三次调用的是定义在 (install-rectangular-package) 包内的 magnitude 函数;从某种意义上来看,这三个 magnitude 组成了一个完整的通用操作 magnitude ,但从个体上看,这三个 magnitude 都不是同一个东西。

另外 apply-generic 调用了两次,第一次调用它剥去数据上的 complex 标示,并调用 (install-rectangular-package) 包中的 magnitude 函数;第二次调用它剥去数据上的 rectangular 标示,并调用 (install-rectangular-package) 包中的 magnitude 函数。

Louis 的复数系统的完整代码

主体程序:

;;; 77-louis-complex.scm

(load "p123-install-rectangular-package.scm")
(load "p124-install-polar-package.scm")
(load "p130-install-complex-package.scm")

(load "p125-generic-selector.scm")

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

rectangular 包:

;;; p123-install-rectangular-package.scm

(load "p119-tag.scm")
(load "p123-put-and-get.scm")

(define (install-rectangular-package)

  ;; internal procedures
  (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))))

  ;; interface to the rest of the system
  (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))

polar 包:

;;; p124-install-polar-package.scm

(load "p119-tag.scm")
(load "p123-put-and-get.scm")

(define (install-polar-package)

  ;; internal procedures
  (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)))

  ;; interface to the rest of the system
  (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 函数:

;;; p125-apply-generic.scm

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

magnitudeangle 等四个通用选择器:

;;; p125-generic-selector.scm

(load "p125-apply-generic.scm")

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

复数包:

;;; p130-install-complex-package.scm

(load "p119-tag.scm")
(load "p123-put-and-get.scm")

(define (install-complex-package)

    ;; imported procedures from rectangular and polar packages
    (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))

    ;; internal procedures
    (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))))

    ;; interface to rest of the system
    (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 函数:

;;; p123-put-and-get.scm

(load "p186-make-table.scm")

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

标识(tag)处理函数:

;;; p119-tag.scm

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

Alyssa 的复数系统的完整代码:

Alyssa 的复数系统除了主体程序和复数包和 Louis 的复数系统不同外,其他几个辅助程序都一样。

主体程序:

;;; 77-alyssa-complex.scm

(load "p123-install-rectangular-package.scm")
(load "p124-install-polar-package.scm")
(load "p125-apply-generic.scm")
(load "p125-generic-selector.scm")
(load "77-install-alyssa-complex-package.scm")  ; 更改

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

修改过的复数包:

;;; 77-install-alyssa-complex-package.scm

(load "p123-put-and-get.scm")
(load "p119-tag.scm")

(define (install-complex-package)

    ;;; imported procedures from rectangular and polar packages
    (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))

    ;;; interal procedures
    (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))))

    ;;; interface to rest of the system
    (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))

讨论

blog comments powered by Disqus