练习 2.79

首先添加通用操作 equ? ：

;;; 79-equ.scm

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

(define (equ? x y)
    (apply-generic 'equ? x y))

然后分别在几个包中实现这个 equ? 函数的数据导向操作。

Scheme 数值包

在 Scheme 数值包(代码来自书本 129 页)中增加对 equ? 函数的数据导向操作，两个值的对比使用 = 函数完成：

;;; 79-install-scheme-number-package.scm

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

(define (install-scheme-number-package)

    ;; internal procedures
    (define (tag x)
        (attach-tag 'scheme-number x))

    ;; interface to rest of the system
    (put 'make 'scheme-number
        (lambda (x)
            (tag x)))

    ;; 新增
    (put 'equ? '(scheme-number scheme-number)
        (lambda (x y)
            (= x y)))

'done)

(define (make-scheme-number n)
    ((get 'make 'scheme-number) n))

测试：

1 ]=> (load "79-install-scheme-number-package.scm")

;Loading "79-install-scheme-number-package.scm"...
;  Loading "p123-put-and-get.scm"... done
;  Loading "p119-tag.scm"... done
;... done
;Value: make-scheme-number

1 ]=> (load "79-equ.scm")

;Loading "79-equ.scm"...
;  Loading "p125-apply-generic.scm"... done
;... done
;Value: equ?

1 ]=> (equ? (make-scheme-number 10)
            (make-scheme-number 10))

;Value: #t

1 ]=> (equ? (make-scheme-number 10)
            (make-scheme-number 1008611))

;Value: #f

有理数包

在有理数包(代码来自书本 129 页)中增加对 equ? 函数的数据导向操作，两个有理数相等，当且仅当它们的分子和分母分别相等：

;;; 79-install-rational-package.scm

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

(define (install-rational-package)
    
    ;; internal procedures
    (define (numer x)
        (car x))

    (define (denom x)
        (cdr x))

    (define (make-rat n d)
        (let ((g (gcd n d)))
            (cons (/ n g) (/ d g))))

    ;; interface to rest of the system
    (define (tag x)
        (attach-tag 'rational x))

    (put 'make 'rational
        (lambda (n d)
            (tag (make-rat n d))))

    ;; 新增
    (put 'equ? '(rational rational)
        (lambda (x y)
            (and (= (numer x) (numer y))
                 (= (denom x) (denom y)))))

'done)

(define (make-rational n d)
    ((get 'make 'rational) n d))

测试：

1 ]=> (load "79-install-rational-package.scm")

;Loading "79-install-rational-package.scm"...
;  Loading "p123-put-and-get.scm"... done
;  Loading "p119-tag.scm"... done
;... done
;Value: make-rational

1 ]=> (load "79-equ.scm")

;Loading "79-equ.scm"...
;  Loading "p125-apply-generic.scm"...
;    Loading "p119-tag.scm"... done
;  ... done
;... done
;Value: equ?

1 ]=> (install-rational-package)

;Value: done

1 ]=> (equ? (make-rational 1 2)
            (make-rational 1 2))

;Value: #t

1 ]=> (equ? (make-rational 1 2)
            (make-rational 10086 10086))

;Value: #f

复数包

在复数包(代码来自书本 131 页)增加对 equ? 函数的数据导向操作，其中复数的相等操作可以用两种方式来实现：

1. 对比两个复数的 real-part 和 imag-part
2. 对比两个复数的 magnitude 和 angle

源码中实现了以上两种方式，但是注释了其中一种。

另外因为要用到 real-part 等选择函数，源码中也补充了 练习 2.77 里提到的缺少选择函数实现的问题（否则这个复数包就不能正常运行）。

以下是修改后的复数包的定义：

;;; 79-install-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))

    ;; interface to rest of the system
    (define (tag z)
        (attach-tag 'complex z))

    (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))))
    
    ;; 补充完整缺少的选择函数（练习 2.77）
    (put 'real-part '(complex) real-part)

    (put 'imag-part '(complex) imag-part)

    (put 'magnitude '(complex) magnitude)

    (put 'angle '(complex) angle)

    ;; 新增
    (put 'equ? '(complex complex)
        (lambda (x y)
            (and (= (real-part x) (real-part y))
                 (= (imag-part x) (imag-part y)))))

    ;; equ? 的另一种实现，对比 magnitude 和 angle

    ; (put 'equ? '(complex complex)
    ;    (lambda (x y)
    ;        (and (= (magnitude x) (magnitude x))
    ;             (= (angle x) (angle 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))

因为复数包要载入的包数量众多，这里使用一个文件将所需的文件都载入进去，方便测试：

;;; 79-complex-driver.scm

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

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

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

测试：

1 ]=> (load "79-complex-driver.scm")

;Loading "79-complex-driver.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 "79-install-complex-package.scm"...
;    Loading "p123-put-and-get.scm"... done
;    Loading "p119-tag.scm"... done
;  ... done
;  Loading "p125-generic-selector.scm"...
;    Loading "p125-apply-generic.scm"...
;      Loading "p119-tag.scm"... done
;    ... done
;  ... done
;  Loading "79-equ.scm"...
;    Loading "p125-apply-generic.scm"...
;      Loading "p119-tag.scm"... done
;    ... done
;  ... done
;... done
;Value: done

1 ]=> (equ? (make-complex-from-real-imag 1 2)
            (make-complex-from-real-imag 1 2))

;Value: #t

1 ]=> (equ? (make-complex-from-real-imag 1 2)
            (make-complex-from-real-imag 10086 10086))

;Value: #f

1 ]=> (equ? (make-complex-from-mag-ang 1 2)
            (make-complex-from-mag-ang 1 2))

;Value: #t

1 ]=> (equ? (make-complex-from-mag-ang 1 2)
            (make-complex-from-mag-ang 10086 10086))

;Value: #f

讨论

blog comments powered by Disqus