[Back]

2.5 带有通用型操作的系统

2.77

因为在复数层面没有定义magnitude,所以解释器在表通用算术包的负数列里找不到magnitude,先进入magnitude,然后apply-generic进入了`magnitude的apply过程,然后再次进入`magnitude的分派,这次的标志类型会变成rectangle或者polar中的一种,再次apply的时候就能求值了。

2.78

(define (attach-tag type-tag contents)
    (cond (number? (car contents) contents)
          (else (cons type-tag contents))))
(define (type-tag datum)
    (cond ((pair? datum)
            (if (number? (car datum))
                `scheme-number
                (car datum)))
          (else (if (number? datum)
                `scheme-number
                (display "Bad tagged datum --TYPE-TAG" datum)))))
(define (contents datum)
    (cond ((pair? datum)
            (if (number? (car datum))
                datum
                (cdr datum)))
          (else (if (number? datum)
                datum
                (display "Bad tagged datum -- CONTENTS" datum)))))

2.79

(define (install-equ-package)
    (define (equ-number x y)
        (= x y))
    (define (equ-rat x y)
        (and (= (number x) (number y))
             (= (denom x) (denom y))))
    (define (equ-complex x y)
        (and (= (real-part x) (real-part y))
             (= (imag-part x) (imag-part y))))
    (put `equal `(scheme-number scheme-number) equ-number)
    (put `equal `(rational rational) equ-rat)
    (put `equal `(complex complex) equ-complex)
    `done)
(define (equal a b)
    (apply-generic `equal a b))

2.80

(define (install-equzero-package)
    (define (equ-zero-number x)
        (= x 0))
    (define (equ-zero-rat x)
        (and (= (number x) 0)
            (not (= (denom x) 0))))
    (define (equ-zero-complex x)
        (= (magnitude x) 0))
    (put `=zero? `scheme-number equ-zero-number)
    (put `=zero? `rational equ-zero-rat)
    (put `=zero? `complex equ-zero-complex)
    `done)
(define (=zero? a)
    (apply-generic `=zero? a))

2.81

A) 显然Louis的程序会使得过程进入无限的递归,每次都尝试将复数转化为复数而又找不到相应的过程。

B) 并不可以,所有没能正确找到过程的两个相同类型的参数做运算时,都会无限循环而不抛出错误。

C)

(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 (car (cdr type-tags))))
                    (if (eq? type1 type2)
                        (display "No method for this type" type1)
                        (let ((a1 (car args)
                              (a2 (car (cdr args)))))
                            (let ((t1->t2 (get-coercion type1 type2))
                                  (t2->t1 (get-coercion type2 type1)))
                                (cond (t1->t2 (apply-generic op (t1->t2 a1) a2))
                                      (t2->t1 (apply-generic op a1 (t2->t1 a2)))
                                      (else (display "No method for these types" (list op type-tags))))))))
                (display "No method for these types" (list op type-tags)))))))

2.82

一个显然的情况是将所有的情况都推广到未出现在参数中的数据类型才能进行计算,同时,如果对于一部分的数,我们定义了到一个类型的转换,而另一部分却是到其他类型的转换,这样变为两种数据类型后一样可以操作,但是这也是这种策略没有考虑到的。这其实是一个排列组合问题。

2.83

(define (raise arg)
    (let ((tags (car arg)))
        (if tags
            (apply `raise tags arg)
            (display "Bad Data Format"))))
(define (install-raise-package)
    (define (raise-number n)
        (make-rat n 1))
    (define (raise-rational r)
        (/ (number r) (denom r)))
    (define (raise-real r)
        (make-complex-real-imag r 0))
    (put `raise `scheme-number raise-number)
    (put `raise `rational raise-rational)
    (put `raise `real-number raise-real)
    `done)

2.84

(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 (car (cdr type-tags))))
                        (if (eq? type1 type2)
                            (display "No method for this type" type1)
                            (let ((pos1 (check-from-tower type1 tower))
                                  (pos2 (check-from-tower type2 tower))
                                  (a1 (car args))
                                  (a2 (car (cdr args))))
                                (if (< pos1 pos2)
                                    (apply-generic op (raise a1) a2)
                                    (apply-generic op a1 (raise a2))))))
                    (display "No method for these types" (list op type-tags)))))))
(define tower `())
(define (check-from-tower tower type)
    (define (check iter type tower)
        (cond ((null? tower) (display "No mathcing types"))
            ((eq? (car tower) type) iter)
            (else (check (+ iter 1) type (cdr tower)))))
    (check 1 type tower))

2.85

(define (drop x)
    (if (equ? x (project x))
        (drop (project x))
        x))
(define (project x)
    (apply-generic `project x))
(define (install-project-package)
    (define (project-complex x)
        (real x))
    (define (project-real r)
        (make-rat (round r) 1))
    (define (project-rat r)
        (number r))
    (put `project `complex project-complex)
    (put `project `real-number project-real)
    (put `project `rational project-rat)
    `done)

只需在apply以后drop即可

2.86

实际上不需要做任何修改,因为数据层面的屏蔽,我们只要保证采用的一定是通用过程,组合数据的是何种数据也就无关紧要了。

sin和cos码量太大,搁置。

2.87

(define (=zero-poly? p)
    (cond ((null? p) #t)
          (else (if (=zero? (coeff (car p)))
                    (=zero-poly? (cdr p))
                    #f))))
(put `=zero? `polynomial =zero-poly?)

2.88

只需对多项式的每一项都取负即可,建立一个通用的取负过程也十分简单,搁置

2.89

(define (get-coeff order term-list)
    (define highest (length term-list))
    (define (iter cnt term-list)
        (if (= cnt (- highest order))
            (car term-list)
            (iter (+ cnt 1) (cdr term-list))))
    (iter 0 term-list))

2.90

如题目意思,这道题码量巨大,且十分容易思考,搁置

2.91

(div-terms (minus-poly L1 (multi-poly L2 (make-poly (variable L1) (cons (make-term new-o new-c))))) L2)
(list (cons ((multi-poly L2 (make-poly (variable L1) (cons (make-term new-o new-c))))) (car rest-of-result)) (cdr rest-of-result))

2.92

码量过大,搁置