SICP 2.5 Systems with Generic Operations - プログラミング再入門

ノート

Now we will see how to use this same idea not only to define operations that are generic over different representations but also to define operations that are generic over different kinds of arguments.

単にそれぞれのデータ型用の手続きを呼び出すだけではなく、複数のデータ型が混ざった操作（operation）にも応用する。
手続きのディスパッチをオブジェクトに行わせるmessage passingではちょっと難しそう。型変換が入ってしまい他の型の情報を知らなければならなくなるので。

2.5.1 Generic Arithmetic Operations

総称算術演算。ここではまだ異なる型同士の演算は考えない。単項演算か同じ型同士の演算のみ。
前節に出て来た表とput、getを使って各データ用のコンストラクタと算術演算を登録。

scheme-number-package
tagはattach-tag（単にconsと同じ）でシンボルscheme-numberをタグ付けする。
前節ではdefineで内部関数として定義してからputしていたが、その名前は必要ないのでここではlambdaで無名関数を登録している。無名関数の引数はcontentsによってタグは剥がされているのでそのまま演算出来る。
makeも定義しているが内部的にはtagを直接呼んでいる。
前節に引き続き、表とput、getはは第３章から拝借。attach-tag、type-tag、contentsを2.4.2および2.4.3から拝借して、scheme number packageを動かしてみる。今回もDrRacketのモードは

#lang scheme
(require r5rs)

の状態。

> (add (make-scheme-number 123) (make-scheme-number 456))
{scheme-number . 579}
> (sub (make-scheme-number 456) (make-scheme-number 123))
{scheme-number . 333}
> (mul (make-scheme-number 123) (make-scheme-number 456))
{scheme-number . 56088}
> (div (make-scheme-number 10) (make-scheme-number 3))
{scheme-number . 3 1/3}
>

rational-number-package
今回はアクセサnumber、denomが必要。make-ratを定義して計算結果を格納するのに呼び出している。またadd-rat等を定義して無名関数から呼び出す形に定義している。tagはローカルな関数としてrational用のを定義。動作確認。

> (add (make-rational 1 2) (make-rational 1 3))
{rational 5 . 6}
> (sub (make-rational 1 2) (make-rational 1 3))
{rational 1 . 6}
> (mul (make-rational 1 2) (make-rational 1 3))
{rational 1 . 6}
> (div (make-rational 1 2) (make-rational 1 3))
{rational 3 . 2}
>

complex-package
install-complex-packageは色々足りない、と思ったら、2.4.3節のrectangular packageとpollar packageが既にインストールされている事が前提の模様。2.4.3節のreal-part等はR5RSの定義と衝突を起こすので、ここでも名前を変える必要がある。

> (add (make-complex-from-real-imag 1 2) (make-complex-from-real-imag 3 4))
{complex rectangular 4 . 6}
> (mul (make-complex-from-mag-ang 1 (/ pi 4)) (make-complex-from-mag-ang 1 (/ pi 4)))
{complex polar 1 . 1.5707963267948966}
>

Exercise 2.77

実際に実行してみる。

> (define z (make-complex-from-real-imag 3 4))
> (my-magnitude z)
. . No method for these types -- APPLY-GENERIC {magnitude {complex}}
>

確かにエラー。Alyssaの提案通り関数を追加したとして、処理を頭の中で追ってみる。

(my-magnitude z)
(apply-generic 'magnitude z)
1. type-args = (complex)
2. (get 'magnitude '(complex))
3. proc = magnitude

問題はこのmagnitudeは何なのか。
最終的にはinstall-rectangular-packageで登録した(put 'magnitude '(rectangular) magnitude)に辿り着いて、このpackageのmagnitudeが呼ばれて欲しい。
apply-generalの続きを考えると、

(apply magnitude (contents z))
(apply magnitude '(rectangular 3 4))

と言う事はこのmagnitudeは(apply-general 'magnitude '(rectangular 3 4))を呼んで欲しいので、それはmy-magnitudeと言う事。なのでAlyssaの提案を少し変更して登録する。

  (put 'real-part '(complex) my-real-part)
  (put 'imag-part '(complex) my-imag-part)
  (put 'magnitude '(complex) my-magnitude)
  (put 'angle '(complex) my-angle)

これで実行してみる。

> (define z (make-complex-from-real-imag 3 4))
> (my-magnitude z)
5
>

期待通り。

Exercise 2.78

普通の数字はタグを付けずに扱えないか。

> (add 1 2)
. . Bad tagged datum -- TYPE-TAG 1
>

これが動く様にする。要はタグがついていなくてもtype-tagを適用するとscheme-numberが返れば良い。

attach-tagはデータが普通の数字の場合は何もしない。
type-tagはデータが普通の数字の場合はscheme-numberを返す。
contentsはデータが普通の数字の場合はそのままその数字を返す。

と言う事。

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

実行してみる。

> (add 1 2)
3
> (sub 10 7)
3
> (mul 2 3)
6
> (div 9 3)
3
>

Exercise 2.79

apply-genericを呼ぶ入り口手続きを用意して、後は各データ型用のequ?手続きを用意するだけ。殆どはequal?で行けそう。

(define (equ? x y) (apply-generic 'equ? x y))
;
(define (install-scheme-number-package)
…中略
  (put 'equ? '(scheme-number scheme-number)
       (lambda (x y) (= x y)))
  'done)

;
(define (install-rational-package)
…中略
  (put 'equ? '(rational rational)
       (lambda (x y) (equal? x y)))
  'done)
;
(define (install-rectangular-package)
…中略
  (put 'equ? '(rectangular rectangular)
       (lambda (x y) (equal? x y)))
  'done)
;
(define (install-polar-package)
…中略
  (put 'equ? '(polar polar)
       (lambda (x y) (equal? x y)))
  'done)
;
(define (install-complex-package)
…中略
  (put 'equ? '(complex complex)
       (lambda (x y) (equ? x y)))
  'done)

動作確認

> (equ? 1 1)
#t
> (equ? 1 2)
#f
> (equ? (make-scheme-number 1) (make-scheme-number 1))
#t
> (equ? (make-scheme-number 1) (make-scheme-number 2))
#f
> (equ? (make-rational 1 2) (make-rational 1 2))
#t
> (equ? (make-rational 1 2) (make-rational 1 3))
#f
> (equ? (make-complex-from-real-imag 1 2) (make-complex-from-real-imag 1 2))
#t
> (equ? (make-complex-from-real-imag 1 2) (make-complex-from-real-imag 1 2))
#t
> (equ? (make-complex-from-mag-ang 1 2) (make-complex-from-mag-ang 1 2))
#t
> (equ? (make-complex-from-mag-ang 1 2) (make-complex-from-mag-ang 1 3))
#f
>

Exercise 2.80

scheme-numberは自明として、rationalはnumeratorのみが0であれば良い。

complexの=zero?に関して、最初

(=zero? (make-complex-from-real-imag 0 0))
(put '=zero? '(complex) (lambda (x) (=zero? x))) ;これのlambaの部分
(put '=zero? '(rectangular) (lambda (x) (equ? x (make-from-real-imag 0 0)))) ;これのlambaの部分

と考えて、equ?に飛ばしたかったのだが、'=zero? '(rectangular)のlambdaに渡される引数は既にrectangularも剥がされていてもうタグが無いのでequ?で検索するべき手続きが無い。
かと言って'=zero? '(complex)のlambdaの中で0相当のオブジェクトを作ろうにもmake-from-real-imagを呼ぶべきかmake-from-mag-angを呼ぶべきかxのタグを見なければ判断出来ない。

equ?が使えないのが何だか残念だがequal?を使う事で解決する。

(define (=zero? x) (apply-generic '=zero? x))
;
(define (install-scheme-number-package)
…中略
  (put '=zero? '(scheme-number)
       (lambda (x) (= x 0)))
  'done)
;
(define (install-rational-package)
…中略
  (put '=zero? '(rational)
       (lambda (x) (= (numer x) 0)))
  'done)
;
(define (install-rectangular-package)
…中略
  (put '=zero? '(rectangular)
       (lambda (x) (equal? x (make-from-real-imag 0 0))))
  'done)
;
(define (install-polar-package)
…中略
  (put '=zero? '(polar)
       (lambda (x) (equal? x (make-from-mag-ang 0 0))))
  'done)
;
(define (install-complex-package)
…中略
  (put '=zero? '(complex)
       (lambda (x) (=zero? x)))
  'done)

動作確認

> (=zero? 0)
#t
> (=zero? 1)
#f
> (=zero? (make-scheme-number 0))
#t
> (=zero? (make-scheme-number 1))
#f
> (=zero? (make-rational 0 2))
#t
> (=zero? (make-rational 1 2))
#f
> (=zero? (make-complex-from-real-imag 0 0))
#t
> (=zero? (make-complex-from-real-imag 0 1))
#f
> (=zero? (make-complex-from-mag-ang 0 0))
#t
> (=zero? (make-complex-from-mag-ang 0 1))
#f
>