SICP 読み (64) 2.5.2 異る型のデータの統合
練習問題の数が多い上に難しい。今回は問題 2.81 です。
問題 2.81
Louis さんが言われている「引数が既に同じ型を持っていても、互いの型への強制変換を試みるべき」という根拠は何なのだろうか。
ま、それは良いとして a についてはループするように見えるな。ってか、apply-generic の実装を見るに強制変換な手続きを書いてあるのは良いのですが、同じ型同士の演算する時もこれらの強制変換な手続きは使われないように読める。
大体が additive にやりましょう、という中でスデに同じ型同士の演算が用意されているにも関わらずさらに、というのがよく分からない。頭悪くてスミマセン。
apply-generic も修正するのかなぁ。p.115 の apply-generic だと scheme-number->scheme-number とか complex->complex なんてのが coercion 表に登録されていたとしても上記の通り、スルーだし。
でもどこかで
(apply proc (map contents args))
しないとこれはこれで無限ループだな。
b の解としては、同一型の強制型変換な手続きは用意されていても呼び出されないし、a のように呼び出されるケースになったら無限の再帰ループになる。ただ、手続きが表に登録されていない場合を除けば正しくは動作する、となるのかなぁ。
手続きを元にした根拠も書いておく。
- 同一型で表に登録された手続きが呼び出された場合は get 手続きにより proc に手続きが格納される。
- 同一型で表に登録されていない手続きが呼び出された場合は、get-coercion により変換されたものを渡して apply-generic が呼び出される。
- 二つの引数がどちらも変換不可能であった場合、error となる。
という事は、同一型変換な手続きが定義されていた場合、表が登録されていない場合の異常処理が永遠に適用されない、という事になる、と言って良いの??
そうした不具合を除去するための c であれば、実装としては get にて変換できず、引数は 2 つ指定されていて、type-tags の car と cadr が eq? だったら強制型変換しない、とすれば良いのかな??
これを前提に試験を検討してみる。まず問題にて定義されている手続きから。
問題発生。まず以下のような試験をでっち上げた。
("scheme-number->scheme-number test"
(setup (lambda ()
(install-scheme-number-package)
(put-coercion 'scheme-number
'scheme-number
scheme-number->scheme-number)))
("convert succeed"
(assert-equal 5 ((get-coercion 'scheme-number 'scheme-number) 5))
)
)
("complex->complex test"
(setup (lambda ()
(install-complex-package)
(install-rectangular-package)
(install-polar-package)
(put-coercion 'complex
'complex
complex->complex)))
("convert succeed"
(assert-equal (make-complex-from-real-imag 1 2)
((get-coercion 'complex 'complex)
(make-complex-from-real-imag 1 2)))
)
)そしたら前回追加した coercion な試験で NG が出る。(一部のみ以下に)
-- (test case) coercion test: .F expected:<#f> but was:<#<closure complex->complex>> in no _'complex 'complex_ member in local-table (coercion) F expected:<#f> but was:<#<closure scheme-number->scheme-number>> in no _'scheme-number 'scheme-number_ member in local-table (coercion) ..
coercion test は以下。
("coercion test"
(setup (lambda ()
(install-scheme-number-package)
(install-complex-package)
(install-rectangular-package)))
("return of put-coercion is 'ok"
(assert-equal 'ok
(put-coercion 'scheme-number 'complex scheme-number->complex))
)
("no _'complex 'complex_ member in local-table (coercion)"
(let ((dummy (put-coercion 'scheme-number 'complex scheme-number->complex)))
(assert-false (get-coercion 'complex 'complex)))
)
("no _'scheme-number 'scheme-number_ member in local-table (coercion)"
(let ((dummy (put-coercion 'scheme-number 'complex scheme-number->complex)))
(assert-false (get-coercion 'scheme-number 'scheme-number)))
)
("_'scheme-number 'complex_ member exists in local-table (coercion)"
(let ((dummy (put-coercion 'scheme-number 'complex scheme-number->complex)))
(assert-equal scheme-number->complex
(get-coercion 'scheme-number 'complex)))
)
("coercion success"
(let ((dummy (put-coercion 'scheme-number 'complex scheme-number->complex)))
(assert-equal (make-complex-from-real-imag 1 0)
((get-coercion 'scheme-number 'complex) 1)))
)
)teardown か何かで coercion な表をクリアしないと駄目だな。どうすれば良い??
一番 easy なソレは setup で coercion 定義か。これは微妙スギ。トップレベルで定義されたクロージャをリセット (delete?) する術は無いんだとすると、汎用算術演算的な手法を使うしかなさげ。でも、各々の試験で install-*-package ってしてますが、それは試験に閉じた環境になるのかなぁ。とほほほ。
仕方が無いので setup ではなくて let 使うコトに決定。
って駄目だ。勘違いしてました。各試験の setup とか let 使っても局所表自体がリセットされてる訳ではないんですね。クロージャって凄いな、と思いつつリセットは (以下略
しかし困った。とりあえず既存の試験はコメントアウトで。(こら
で、何すりゃ良いんだっけ。apply-generic の試験か。確認したいのは
- 同一型で表に登録されていない手続きの呼び出しは error になるか
- 同一型で表に登録済みな手続きの呼び出しは正常に実行されているか
- 異る型 (scheme-number と complex で良いか) で表にされていない手続きの呼び出しは error になるか。
- 異る型 (scheme-number と complex で良いか) で表に登録済みな手続きの呼び出しは正常に実行されているか
上記を鑑みると異る型でも表に未登録で変換可能だったらループしそう。上記によれば試験は以下のようになりますか。
("test of 2.81"
(setup (lambda()
(install-scheme-number-package)
(install-complex-package)
(install-rational-package)
(install-rectangular-package)
(put-coercion 'scheme-number 'complex scheme-number->complex)
(put-coercion 'scheme-number
'scheme-number
scheme-number->scheme-number)
(put-coercion 'complex 'complex complex->complex)
))
("registered procedure in same type"
(assert-equal 5
(apply-generic 'add
(make-scheme-number 2)
(make-scheme-number 3)))
)
("unregistered procedure in same type"
(assert-error (apply-generic 'expt
(make-scheme-number 2)
(make-scheme-number 3)))
)
("registered procedure in different type"
(assert-equal (make-complex-from-real-imag 5 0)
(apply-generic 'add
(make-scheme-number 2)
(make-complex-from-real-imag 3 0)))
)
("unregistered procedure in different type"
(assert-error (apply-generic 'expt
(make-scheme-number 2)
(make-complex-from-real-imag 3 0)))
)
)なんかグダグダだなぁ。実装は以下ですか。すごいキタナい。
(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)
(if (not (eq? (car type-tags) (cadr type-tags)))
(let ((type1 (car type-tags))
(type2 (cadr type-tags))
(a1 (car args))
(a2 (cadr 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
(error "No method for these types"
(list op type-args))))))
(error "No method for these types" (list op type-tags)))
(error
"No method for these types" (list op type-tags)))))))で、試験したら NG と怒られる。assert-error の書き方が違うし。以下のように試験を修正し、リトライ。
("test of 2.81"
(setup (lambda()
(install-scheme-number-package)
(install-complex-package)
(install-rational-package)
(install-rectangular-package)
(put-coercion 'scheme-number 'complex scheme-number->complex)
(put-coercion 'scheme-number
'scheme-number
scheme-number->scheme-number)
(put-coercion 'complex 'complex complex->complex)
))
("registered procedure in same type"
(assert-equal 5
(apply-generic 'add
(make-scheme-number 2)
(make-scheme-number 3)))
)
("unregistered procedure in same type"
(assert-error (lambda ()
(apply-generic 'expt
(make-scheme-number 2)
(make-scheme-number 3))))
)
("registered procedure in different type"
(assert-equal (make-complex-from-real-imag 5 0)
(apply-generic 'add
(make-scheme-number 2)
(make-complex-from-real-imag 3 0)))
)
("unregistered procedure in different type"
(assert-error (lambda ()
(apply-generic 'expt
(make-scheme-number 2)
(make-complex-from-real-imag 3 0))))
)
)一応通った。次の問題も意味が分かってないんだよなぁ。(とほほほ
「試みられない何か適当な混合型の演算」って何だよ。
追記
げ。よく見たら凄いコトしてるし。以下、上記の解から一部のみ。
(if (not (eq? (car type-tags) (cadr type-tags))) (let ((type1 (car type-tags)) (type2 (cadr type-tags)) (a1 (car args)) (a2 (cadr args))) (let ((t1->t2 (get-coercion type1 type2)) (t2->t1 (get-coercion type2 type1)))
これは酷い。ヤッツけてるのがモロに分かるな。(とほほほ
