练习 2.80

这道题和 练习 2.79 类似，都是为各个包添加通用操作。

首先将 =zero? 函数的通用函数写下来：

;;; 80-zero.scm

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

(define (=zero? x)
    (apply-generic '=zero? x))

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

Scheme 数值包

一个值 value 对于 =zero? 为真当且仅当这个值等于 0 ：

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

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

(define (install-scheme-number-package)

    (define (tag x)
        (attach-tag 'scheme-number x))

    (put 'make 'scheme-number
        (lambda (x)
            (tag x)))
    ;; 新增
    (put '=zero? '(scheme-number)
        (lambda (value)
            (= value 0)))

'done)

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

测试：

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

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

1 ]=> (load "80-zero.scm")

;Loading "80-zero.scm"...
;  Loading "p125-apply-generic.scm"...
;    Loading "p119-tag.scm"... done
;  ... done
;... done
;Value: =zero?

1 ]=> (install-scheme-number-package)

;Value: done

1 ]=> (=zero? (make-scheme-number 0))

;Value: #t

1 ]=> (=zero? (make-scheme-number 10086))

;Value: #f

有理数包

有理数包程序可以在书本 129 页的 (install-rational-package) 源码的基础上进行修改，一个有理数为零当且仅当它的分子为 0 ：

;;; 80-install-rational-package.scm

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

(define (install-rational-package)
    (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 '=zero? '(rational)
        (lambda (r)
            (= 0 (numer r))))

'done)

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

测试：

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

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

1 ]=> (load "80-zero.scm")

;Loading "80-zero.scm"...
;  Loading "p125-apply-generic.scm"...
;    Loading "p119-tag.scm"... done
;  ... done
;... done
;Value: =zero?

1 ]=> (install-rational-package)

;Value: done

1 ]=> (=zero? (make-rational 0 1))

;Value: #t

1 ]=> (=zero? (make-rational 10086 10086))

;Value: #f

复数包

一个复数为 0 当且仅当它的 real-part 和 imag-part 都为 0 。

为了方便起见，直接在 练习 2.79 的程序的基础上进行修改：

;;; 80-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 '=zero? '(complex)
        (lambda (c)
            (and (= 0 (real-part c))
                 (= 0 (imag-part c)))))

'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.79 的复数包载入驱动：

;;; 80-complex-driver.scm

(load "p123-install-rectangular-package.scm")
(load "p124-install-polar-package.scm")
(load "p125-generic-selector.scm")
(load "80-install-complex-package.scm") ; 修改
(load "80-zero.scm")

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

测试：

1 ]=> (load "80-install-complex-package.scm")

;Loading "80-install-complex-package.scm"...
;  Loading "p123-put-and-get.scm"... done
;  Loading "p119-tag.scm"... done
;... done
;Value: make-complex-from-mag-ang

1 ]=> (load "80-zero.scm")

;Loading "80-zero.scm"...
;  Loading "p125-apply-generic.scm"...
;    Loading "p119-tag.scm"... done
;  ... done
;... done
;Value: =zero?

1 ]=> (=zero? (make-complex-from-real-imag 0 0))

;Value: #t

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

;Value: #f

1 ]=> (=zero? (make-complex-from-mag-ang 0 0))

;Value: #t

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

;Value: #f

讨论

blog comments powered by Disqus