問題2-78〜80

昨日の続きです。まずは問題2-78。汎用演算のサンプルコードのままだと、単純な整数の数値を一つ作るためには、(make-scheme-number 3)みたいなことをやってscheme-numberのタグをつけなければなりません。この面倒臭さを解消するための問題です。タグつけの部分を以下のように変えてやることで、整数をそのままadd手続きに渡してやっても、正しく計算されるようになります。

(define (attach-tag type-tag contents)
  (if (eq? 'scheme-number type-tag)
      contents
      (cons type-tag contents)))

(define (type-tag datum)
  (cond ((number? datum) 'scheme-number)
        ((pair? datum) (car datum))
        (else (error "Bad tagged datum" datum))))

(define (contents datum)
  (cond ((number? datum) datum)
        ((pair? datum) (cdr datum))
        (else (error "Bad tagged datum" datum))))

(attach-tag 'scheme-number 3)  ;=>3
(type-tag 3)  ;=>scheme-number
(contents 3)  ;=>3

(add 3 4)  ;=>7
(sub 7 3)  ;=>4

次の問題2-79は、渡された二つの値が等しいかどうかをしらべる汎用演算を追加するための問題です。また、問題2-80では、渡された任意の値がゼロと等しいかを調べる汎用演算を追加します。まずは、インターフェイスを定義します。

;(define (equ? x y) (apply-generic 'equ? x y))
;(define (=zero? x) (apply-generic '=zero? x))

;修正:2008/05/17

(define (equ? x y) ((get 'equ? (list (type-tag x) (type-tag y)))
                    (contents x) (contents y)))
(define (=zero? x) ((get '=zero? (type-tag x)) x))

それぞれの型のパッケージに、これらの演算の具体的な処理を記述します。(有理数については試していませんが、make-ratしている時点で約分やれているので、numer/denom経由で同値/ゼロ判定すればいいと思われます。)

(define (install-scheme-number-package)
  ;;...other
  (put 'equ? '(scheme-number scheme-number)
       (lambda (x y) (= x y)))
  (put '=zero? 'scheme-number
       (lambda (x) (= 0 (contents x))))
  ;;...other
  'done)

(equ? 3 4)  ;=>#f
(equ? 3 3)  ;=>#t

(=zero? 0)  ;=>#t
(=zero? 4)  ;=>f

(define (install-complex-package)
  ;;...other
  (define (equ?-complex z1 z2)
    (and (= (real-part z1) (real-part z2))
         (= (imag-part z1) (imag-part z2))))
  (define (=zero?-complex z1)
    (and (= 0 (real-part z1))
         (= 0 (imag-part z1))))
  ;;...other
  (put 'equ? '(complex complex)
       (lambda (z1 z2) (equ?-complex z1 z2)))
  (put '=zero? 'complex
       (lambda (z1) (=zero?-complex z1)))
  ;;...other
  'done)

(define c1 (make-complex-from-real-imag 3 1))
(define c2 (make-complex-from-real-imag 3 1))
(define c3 (make-complex-from-real-imag 0 0))

(define c4 (make-complex-from-mag-ang 4 1))
(define c5 (make-complex-from-mag-ang 4 1))
(define c6 (make-complex-from-mag-ang 0 0.5))

(equ? c1 c2)  ;=>#t
(equ? c1 c3)  ;=>#f

(equ? c4 c5)  ;=>#t
(equ? c4 c6)  ;=>#f

(=zero? c1)  ;=>#f
(=zero? c3)  ;=>#t

(=zero? c4)  ;=>#f
(=zero? c6)  ;=>#t

最後のゼロ判定がゼロになるのは、magnitudeがゼロならば、angleがどんな数であっても、複素数としての値はゼロだということで納得しました。どうやら上手く動いているようです。