SICP 2.5.2 Combining Data of Different Types
と言う訳で、ここまで避けて通って来た異なる型同士の演算について。
基本的には総称関数の話だが、オブジェクト指向のメソッド検索にも通ずる話。
ノート
complexにscheme-numberを足す例。
(define (install-complex-package) …中略 (define (add-complex-to-schemenum z x) (make-from-real-imag (+ (my-real-part z) x) (my-imag-part z))) …中略 (put 'add '(complex scheme-number) (lambda (z x) (tag (add-complex-to-schemenum z x))))
前節同様real-part、imag-partは本物と衝突してしまうのでmy-real-part、my-imag-partに変更。動かすと。
> (add (make-complex-from-real-imag 1 2) 2) {complex rectangular 3 . 2} >
全ての組み合わせを用意していたのでは破綻するのは明白。
Coercion
強要、強制。コンピュータの世界では強制的に型を合わせる事を意味しているらしい。
型変換テーブルを用いて、そこに変換ルーチンが見つかったらそれで変換して演算する。apply-genericで手続きが見つからなかったら、まず第１引数を第２引数の型に換えられるかチェック。見つかれば変換した型で演算、見つからなければ第２引数を第１引数の型に換えられるかチェック。見つかれば変換した型で演算、見つからなければエラー。
型変換テーブルを定義して実行してみる。
(define coercion-table (make-table)) (define get-coercion (coercion-table 'lookup-proc)) (define put-coercion (coercion-table 'insert-proc!))
後は教科書のまま。実行してみる。
> (add (make-complex-from-real-imag 1 2) 2) {complex rectangular 3 . 2} > (add 2 (make-complex-from-real-imag 1 2)) {complex rectangular 3 . 2} >
型変換ルーチンはひとつ書くだけでどちらのケースにも対応出来ている。
但し、１回変換するだけで型が揃うケースにしか対応出来ていない。複数回変換する必要があったり、双方を変換する事で第３の型で揃えるケースには対応出来ない。
Hierarchies of types
型の階層。
integers are a subtype of rational numbers (i.e., any operation that can be applied to a rational number can automatically be applied to an integer).
これはリスコフの置換原則と同じ事。
型の階層が一直線（タワー）であれば、引数の型が合うまで低い方の型を上側（汎用側）に上げる（raise）。演算もある型で見つからなければ一つ上の型で探す。ここまでは普通のオブジェクト指向でも同じ。また結果等は可能な限り下の型で表現出来る様にする。これは普通は無い。
Exercise 2.81
Louis Reasoner has noticed that apply-generic may try to coerce the arguments to each other's type even if they already have the same type.
mayの解釈が難しいが「同じ型の引数でも型変換しようとしても良いかも知れない。」と言う事か。ただ何故そう考えたのかは全く不明。現状二つの引数の型が同じであれば(apply proc (map contents args))が呼ばれて普通に計算は終わる。
a.
expはezとしての標準関数と衝突するので
(define (myexp x y) (apply-generic 'exp x y))
として、
> (myexp 2 3) 8 > (myexp 2 (make-complex-from-real-imag 3 0)) . . user break > (myexp (make-complex-from-real-imag 2 0) (make-complex-from-real-imag 3 0)) . . user break >
scheme-numberの時は良いがcomplexが入ると無限ループに陥る。
(complex complex)に対応する演算は定義されていないので、型変換を試みる事になるが両方ともcomplexで何も変化が起きないので、また同じ型変換を試みる事になり無限ループに陥る。
余計な事をしなければ対応する演算がないとしてすぐに止まる。
> (myexp 2 3) 8 > (myexp (make-complex-from-real-imag 2 0) (make-complex-from-real-imag 3 0)) . . No method for these types {exp {complex complex}} >
b.
そもそも何も変化させない型変換に意味がある筈がない。
c.
Louisの意味のない方変換関数を登録しなければ、scheme-number->scheme-numberとかcomplex->complexは見つからず、condのブロックのelseに入るので、apply-genericは特に変更する必要はない。
仮に事故で同じ型への変換関数が登録されてしまってもその変換を行わない様にするには
(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 (cadr type-tags)) (a1 (car args)) (a2 (cadr args))) (if (eq? type1 type2) (error "No method for these types" (list op type-tags)) (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-tags))))))) (error "No method for these types" (list op type-tags)))))))
実行してみる。
> (myexp 2 3) 8 > (myexp (make-complex-from-real-imag 2 0) (make-complex-from-real-imag 3 0)) . . No method for these types {exp {complex complex}} >
もう少しエラー処理を纏められないものかとも思うが。。。
Exercise 2.82
二つ以上の引数に対応出来る様にapply-genericを一般化する。つまり以下の様な演算をサポートする。
> (+ 1 2 3 4 5) 15 > (* 1 2 3 4) 24 > (/ 1 2 3 4) 1/24 > (- 1 2 3 4) -8 >
apply-genericは可変長引数を取る事は出来るが、operation-tableに登録する引数の型のリストは可変長と言う訳には行かない。と言う事は畳み込みの様に実装する必要がある。この場合は必ずしも問題文にある様に全ての引数の型を合わせてから演算する必要はない。
最初の二つを計算して、その結果とその次の要素と言う要領で順に計算して行く。3項以上引数がある場合にのみ計算を分割する様にする。全体の構成は以下の様な感じに出来れば良さそう。
(define (test op . args) (display args)(newline) (if (< 2 (length args)) (apply test op (test op (car args) (cadr args)) (cddr args)) (apply + args)))
実行するとこんな感じ。
> (test 'add 1 2 3 4) (1 2 3 4) (1 2) (3 3 4) (3 3) (6 4) 10 >
まずは入り口の総称関数を可変引数対応にする。
(define (add x . ys) (apply apply-generic 'add x ys)) (define (sub x . ys) (apply apply-generic 'sub x ys)) (define (mul x . ys) (apply apply-generic 'mul x ys)) (define (div x . ys) (apply apply-generic 'div x ys))
ysがリストになっているので、リストの内容を引数として展開する為にapplyを使用する。
(define (apply-generic op . args) (if (< 2 (length args)) (apply apply-generic op (apply-generic op (car args) (cadr args)) (cddr args)) (let ((type-tags (map type-tag args))) …以降は元のapply-genericと同じ。
動作確認
> (add 1 2 3 4 5) 15 > (sub 10 9 8 7) -14 > (mul 2 3 4 5 6) 720 > (div 1 2 3 4) 1/24 > (define z (make-complex-from-real-imag 1 0)) > (add z 1 3 z 4) {complex rectangular 10 . 0} > (define r (make-complex-from-mag-ang 1 (/ pi 6))) > (mul r r r r r r) {complex polar 1 . 3.1415926535897927} >
一応動いていそう。
値の型は二つずつの演算の引数の組み合わせで決まり、必要な時にだけ変換する。
One strategy is to attempt to coerce all the arguments to the type of the first argument, then to the type of the second argument, and so on. Give an example of a situation where this strategy (and likewise the two-argument version given above) is not sufficiently general.
型を事前に全て揃える事は確かに可能。だけどoperation-tableに引数の個数別の関数を用意しなければならない。と言う事は演算をする事まで考えるとこの方法では一般化は出来ていない事になる。例を示せと言われても困るけど、引数の数が千個、一万個のそれぞれの関数を用意出来ますか？と言う事かな。
Hint: Consider the case where there are some suitable mixed-type operations present in the table that will not be tried.
その前に書いてある様に事前に全ての型を合わせてしまうと、異なる型の演算が登録されていても、それは決して使われない事になる。
Exercise 2.83
ここまでで出て来た型変換はscheme-number->complexのみ。またscheme-numberはintegerもrealも含んでいた事になる。なのでscheme-numberは廃止して、integerとrealを導入する。
;; Integer (define (install-integer-package) (define (tag x) (attach-tag 'integer x)) (put 'add '(integer integer) (lambda (x y) (tag (+ x y)))) (put 'sub '(integer integer) (lambda (x y) (tag (- x y)))) (put 'mul '(integer integer) (lambda (x y) (tag (* x y)))) (put 'div '(integer integer) (lambda (x y) (tag (/ x y)))) (put 'make 'integer (lambda (x) (tag x))) (put 'equ? '(integer integer) (lambda (x y) (= x y))) (put '=zero? '(integer) (lambda (x) (= x 0))) (put 'exp '(integer integer) (lambda (x y) (tag (expt x y)))) ; using primitive expt 'done) (define (make-integer n) ((get 'make 'integer) n)) ;; Real (define (install-real-package) (define (tag x) (attach-tag 'real x)) (put 'add '(real real) (lambda (x y) (tag (+ x y)))) (put 'sub '(real real) (lambda (x y) (tag (- x y)))) (put 'mul '(real real) (lambda (x y) (tag (* x y)))) (put 'div '(real real) (lambda (x y) (tag (/ x y)))) (put 'make 'real (lambda (x) (tag x))) (put 'equ? '(real real) (lambda (x y) (= x y))) (put '=zero? '(real) (lambda (x) (= x 0))) (put 'exp '(real real) (lambda (x y) (tag (expt x y)))) ; using primitive expt 'done) (define (make-real n) ((get 'make 'real) n)) … (install-integer-package) (install-real-package)
これに伴ってtype-tagもscheme-numberではなくintegerとrealを返す事にする。
(define (type-tag datum) (cond ((pair? datum) (car datum)) ((integer? datum) 'integer) ((real? datum) 'real) (else (error "Bad tagged datum -- TYPE-TAG" datum))))
ここまでの動作確認。
> (type-tag 1) integer > (type-tag 1.2) real > (add 1.2 3.4 5.6) 10.2 > (mul 1.2 3.4) 4.08 >
rationalからrealへの変換を書く為にはnumerとdenomにアクセスする必要があるが、これらはrational packageの内部関数。
ただintegerからcomplexまで型の階層構造は形成しているものの、それぞれの型の実装には依存関係は無いので型変換は型の実装とは独立させておきたい。なので、まずはnumerとdenomをインターフェースとして露出させる事にする。
(define (install-rational-package) ;; internal procedures (define (numer x) (car x)) (define (denom x) (cdr x)) …中略 (put 'numer '(rational) (lambda (x) (make-integer (numer x)))) (put 'denom '(rational) (lambda (x) (make-integer (denom x)))) …中略 'done) (define (numer r) (apply-generic 'numer r)) (define (denom r) (apply-generic 'denom r))
動作確認。
> (numer (make-rational 2 3)) 2 > (denom (make-rational 2 3)) 3 >
そこで
(define (install-coercion) (put 'raise '(integer) (lambda (x) (make-rational x 1))) (put 'raise '(rational) (lambda (x) (make-real (/ (numer x) (denom x))))) (put 'raise '(real) (lambda (x) (make-complex-from-real-imag x 0))) 'done) (install-coercion) (define (raise x) (apply-generic 'raise x))
とすれば上手くいきそうだが、rationalからのraiseは上手くいかない。
> (raise (make-rational 2 3)) . . No method for these types {numer {2}} >
(numer x)を呼び出そうとしてもxは既にタグが剥がされていて剥き身のペアなのでメソッドが見つからない*1。raiseはrationalのパッケージに実装してrealへの依存は致し方無しとする方法も考えられるが、ここは少し強引に一般化して、
- raiseの入り口は各パッケージに実装する
- 実際に変換するルーチンは各パッケージとは別に定義してoperation-tableに登録
- 入り口のraiseからoperation-tableに登録されている実際の変換ルーチンを呼び出す
方法を考える。これなら各型のパッケージは他の型への明示的な依存は無くなる。実際型パッケージのコードからはどの型に変換されるのか分からない。
(define (install-integer-package) …中略 (put 'raise '(integer) (lambda (x) ((get 'raise 'integer) x))) 'done) (define (install-real-package) …中略 (put 'raise '(real) (lambda (x) ((get 'raise 'real) x))) 'done) (define (install-rational-package) …中略 (put 'raise '(rational) (lambda (x) ((get 'raise 'rational) (numer x) (denom x)))) 'done) (define (install-coercion) (put 'raise 'integer (lambda (x) (make-rational x 1))) (put 'raise 'rational (lambda (n d) (make-real (/ n d)))) (put 'raise 'real (lambda (x) (make-complex-from-real-imag x 0))) 'done) (install-coercion)
実はこれでnumerとdenomは元通り内部関数に戻せる。
operation-tableのキーがraise (integer)とraise integerの二つあるのがちょっと紛らわしいが、まぁこれは二番目の方の名前を何かに変えれば済む事なのであまり気にしない。
実行してみる。
> (raise (make-integer 2)) {rational 2 . 1} > (raise (make-rational 2 3)) 2/3 > (raise (make-real 2.3)) {complex rectangular 2.3 . 0} >
Exercise 2.84
and will not lead to problems in adding new levels to the tower.
どのレベルをproblemとするか次第だが。現状は各型パッケージはそれぞれ完全に独立しているので、新しい型を追加してもこれらへの影響は皆無。逆にcoercionパッケージは全ての型同士の関係を管理する事になるので、新しい型を追加した時にはこのパッケージの変更は避けられない。変換ルーチンは追加やオーバーライドは簡単なので、型のタワーをリストで表現するとして、これを動的に変更出来ない事を問題とするかと言う所か。ここでは単純化してリストは固定で持つ事とする。
まずは
You will need to devise a way to test which of two types is higher in the tower.
に応えて
(define (compare-types a b) (define (comp-aux a b l) (cond ((null? l) #f) ((eq? a b) '=) ((eq? a (car l)) '<) ((eq? b (car l)) '>) (else (comp-aux a b (cdr l))))) (comp-aux a b '(complex real rational integer)))
本当はa bが両方ともリストに存在しているか確認が必要だが、それは省略するとして。実行すると
> (compare-types 'integer 'real) > > (compare-types 'integer 'rational) > > (compare-types 'complex 'integer) < > (compare-types 'complex 'complex) = >
これを使ってapply-genericを変更する。構造としては特に変化はない。compare-typesを使って各型のraiseを使う様に変形しただけ。
(define (apply-generic op . args) (if (< 2 (length args)) (apply apply-generic op (apply-generic op (car args) (cadr args)) (cddr 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 (cadr type-tags)) (a1 (car args)) (a2 (cadr args))) (let ((types-are (compare-types type1 type2))) (cond ((eq? types-are '=) (error "No method for these types" (list op type-tags))) ((eq? types-are '>) (apply-generic op (raise a1) a2)) ((eq? types-are '<) (apply-generic op a1 (raise a2))) (else (error "Unknown type included" (list op type-tags)))))) (error "No method for these types" (list op type-tags))))))))
実行してみる
> (add 1 (make-rational 2 3)) {rational 5 . 3} > (add 2 (make-real 1.2)) . . user break >
integerからrealへのraiseが無限ループになってしまう。タグを省略すると、integerから型変換してrational、realに来た時に実質integerに戻ってしまうので必ずタグを付ける様に戻す。
(define (attach-tag type-tag contents) (cons type-tag contents))
実行してみると
> (add 1 (make-rational 2 3)) {rational 5 . 3} > (add 2 (make-real 1.2)) {real . 3.2} > (add (make-real 1.2) 2) {real . 3.2} > (add 3 (make-complex-from-real-imag 1 4)) {complex rectangular 4 . 4} > (add (make-complex-from-real-imag 1 4) (make-rational 2 3)) {complex rectangular 1 2/3 . 4} >
1 2/3の部分はDrRacket上では帯分数表示。
Exercise 2.85
drop以外での使い道があるのか分からないが、dropとは関係無しにprojectを実装する。dropの場合は可能な場合にのみ変換だが、projectは無理矢理変換する。complexにraiseを実装しなかったのと同様integerにprojectは実装出来ない。raionalからintegerは実は一旦realに直してroundすれば良い。realからrationalは実はなかなか難しい問題なのだが、どうもschemeのgcdのお陰で実は簡単そう。
> (make-rational 1.2 3.4) {rational 5404319552844595.0 . 15312238733059686.0} > (/ 1.2 3.4) 0.35294117647058826 > (/ 5404319552844595.0 15312238733059686.0) 0.35294117647058826 > (gcd 1.2 3.4) 2.220446049250313e-16 > (/ 1.2 (gcd 1.2 3.4)) 5404319552844595.0 > (make-rational 1.23456 1) {rational 694995494495815.0 . 562949953421312.0} >
と言う訳でnumerとしてrealをそのまま、denomに1を指定すると整数ではないgcdを計算してくれて、お陰でnumberとdenomはほぼ整数になる。
complexからrealへの変換はベクトルの絶対値を取る考え方もあるが、そのままreal-partを取り出す事とする。またpolarのcomplexからrealを作るには、ちょっと無駄足だが一旦magとangに分解された値からもう一度complexを作り直してそれからreal-partを取り出す必要がある。絶対値を使う場合には同じ事がrectangularの方で起きる事になる。
> (my-real-part (make-complex-from-mag-ang 10 pi)) -10.0 >
Exercise 2.84の結果を使って
(define (project x) (apply-generic 'project x)) (define (install-real-package) …中略 (put 'project '(real) (lambda (x) ((get 'project 'real) x))) 'done) (define (install-rational-package) …中略 (put 'project '(rational) (lambda (x) ((get 'project 'rational) (numer x) (denom x)))) 'done) (define (install-rectangular-package) …中略 (put 'project '(rectangular) (lambda (x) ((get 'project 'rectangular) (real-part x) (imag-part x)))) 'done) (define (install-polar-package) …中略 (put 'project '(polar) (lambda (x) ((get 'project 'polar) (magnitude x) (angle x)))) 'done) (define (install-complex-package) …中略 (put 'project '(complex) (lambda (x) (project x))) 'done) (define (install-coercion) …中略 (put 'project 'rational (lambda (n d) (make-integer (round (/ n d))))) (put 'project 'real (lambda (r) (make-rational r 1))) (put 'project 'rectangular (lambda (r i) (make-real r))) (put 'project 'polar (lambda (m a) (make-real (my-real-part (make-complex-from-mag-ang m a))))) 'done)
実行してみる
> (project (make-complex-from-real-imag 12.3 4.5)) {real . 12.3} > (project (make-complex-from-mag-ang 12 (/ pi 2))) {real . 7.347880794884119e-16} > (project (make-real 12.3)) {rational 3462142213541069.0 . 281474976710656.0} > (/ 3462142213541069.0 281474976710656.0) 12.3 > (project (make-rational 16 3)) {integer . 5} >
projectしてraiseして同じになるかを確かめるとの事。
> (raise (project (make-complex-from-real-imag 12.3 0))) {complex rectangular 12.3 . 0} > (raise (project (make-complex-from-mag-ang 12.3 0))) {complex rectangular 12.3 . 0} > (raise (project (make-real 12.3))) {real . 12.3} > (raise (project (make-rational 12 1))) {rational 12 . 1} >
問題のひとつはrealをrationalにしてまたrealに戻した時に誤差を生じないのか。
> (define r1 (make-real 1.23456)) > (equ? r1 (raise (project r1))) #t >
かならず#tが返って来るか一抹の不安がある。もうひとつの問題はpolarをrealにしてraiseした時に必ずrectangularになってしまう事。取り敢えずcomplexの比較は強制的にrectangularで行う様に変更。
(define (install-complex-package) …中略 (put 'equ? '(complex complex) (lambda (a b) (equ? ((get 'make-from-real-imag 'rectangular) (apply-generic 'real-part a) (apply-generic 'imag-part a)) ((get 'make-from-real-imag 'rectangular) (apply-generic 'real-part b) (apply-generic 'imag-part b))))) …中略 'done)
実行してみる。
> (equ? (make-complex-from-real-imag 1.0 0.0) (make-complex-from-mag-ang 1.0 0.0)) #t > (equ? (make-complex-from-real-imag -1.0 0.0) (make-complex-from-mag-ang 1.0 pi)) #f > ((lambda (z) ((get 'make-from-real-imag 'rectangular) (apply-generic 'real-part z) (apply-generic 'imag-part z))) (make-complex-from-mag-ang 1.0 pi)) {rectangular -1.0 . 1.2246467991473532e-16} >
本当は誤差範囲を設けないと役には立たないが、取り敢えずdropの役には立ちそう。
またequal?では0と0.0は等値とはならない様で、以下の様に等式が成り立たないケースがある。
> (equ? (make-complex-from-real-imag 1.2 0) (raise (project (make-complex-from-real-imag 1.2 0.0)))) #t > (equ? (make-complex-from-real-imag 1.2 0.0) (raise (project (make-complex-from-real-imag 1.2 0)))) #f >
なのでコンストラクタでrealに統一する。
(define (install-rectangular-package) …中略 (define (make-from-real-imag x y) (cons (+ x 0.0) (+ y 0.0))) …以下省略
こうしないと以下の二つは#fとなってしまう。
> (equ? (make-complex-from-real-imag 1.2 0) (raise (project (make-complex-from-real-imag 1.2 0.0)))) #t > (equ? (make-complex-from-real-imag 1.2 0.0) (raise (project (make-complex-from-real-imag 1.2 0)))) #t >
dropを実装する。
(define (drop x) (let ((proj (get 'project (list (type-tag x))))) (if proj (let ((projected (project x))) (let ((restored (raise projected))) (if (equ? x restored) (drop projected) x))) x)))
project出来るかどうかを調べるのにgetを使っていて、projも使えるのに使っていない所が何とも冗長な感じがあるが、projを使うとまたcontentsとか呼ばなければならず、それはそれで煩雑で悩ましい。
動作確認
> (drop (make-complex-from-real-imag 1.2 0)) {rational 5404319552844595.0 . 4503599627370496.0} > (drop (make-complex-from-real-imag 2 0)) {integer . 2.0} > (drop (make-real 3.0)) {integer . 3.0} > (drop (make-rational 5 1)) {integer . 5} >
roundがrealの値を返してしまうので、integerなのに小数点を含んでしまう所も何とも歯痒い感じ。
次にapply-genericを変更するがここで次の問題。apply-genericはraiseに対しても使っている。なので単純に結果をdropしようとするとraiseとdropが押し問答状態に陥ってしまう。他にも単に計算結果ではなくアクセッサとして使っている演算もあり、これらの結果をdropしてしまってもおかしなことが起きてしまう。
apply-genericの内容を新しいapply-operationと言う関数に移して、apply-genericはapply-operationを呼び出した結果をdropする、raise等の演算ははapply-genericではないくapply-operationを呼び出す事にする。
(define (apply-generic op . args) (drop (apply apply-operation op args))) (define (apply-operation op . args) …中身は元のapply-generic (define (equ? x y) (apply-operation 'equ? x y)) ; booleanを返すのでdropできない (define (=zero? x) (apply-operation '=zero? x)) ; booleanを返すのでdropできない (define (raise x) (apply-operation 'raise x)) (define (project x) (apply-operation 'project x)) (define (my-real-part z) (apply-operation 'real-part z)) (define (my-imag-part z) (apply-operation 'imag-part z)) (define (my-magnitude z) (apply-operation 'magnitude z)) (define (my-angle z) (apply-operation 'angle z)) (define (install-complex-package) …中略 (put 'equ? '(complex complex) (lambda (a b) (equ? ((get 'make-from-real-imag 'rectangular) (apply-operation 'real-part a) (apply-operation 'imag-part a)) ((get 'make-from-real-imag 'rectangular) (apply-operation 'real-part b) (apply-operation 'imag-part b)))))
実行してみる。
> (add (make-rational 4 5) (make-complex-from-real-imag 1.2 0.0)) {integer . 2.0} > (add (make-complex-from-real-imag 1.2 -1.3) (make-complex-from-real-imag 2.8 1.3)) {integer . 4.0} >
Exercise 2.86
complexの作り方はこんな感じにすると考える。
(make-complex-from-real-imag (make-real 1.2) (make-real 3.4))
これを動かすにはmake-from-real-imagでreal型に強制する為に0.0を足していた部分を一旦戻す。
(define (install-rectangular-package) … (define (make-from-real-imag x y) (cons x y)) … (define (install-polar-package) … (define (make-from-mag-ang r a) (cons r a)) …
実行すると
> (make-complex-from-real-imag (make-real 1.2) (make-real 3.4)) {complex rectangular {real . 1.2} real . 3.4} > (make-complex-from-mag-ang (make-real 1.2) (make-real pi)) {complex polar {real . 1.2} real . 3.141592653589793} > (make-complex-from-real-imag (make-rational 2 3) (make-rational 3 4)) {complex rectangular {rational 2 . 3} rational 3 . 4} > (make-complex-from-real-imag (make-integer 2) (make-integer 3)) {complex rectangular {integer . 2} integer . 3} > (make-complex-from-real-imag (make-real 1.2) (make-integer 2)) {complex rectangular {real . 1.2} integer . 2} >
見慣れない表示になるが、最後のセルは例えば{real . 1.2}と{real . 3.4}へのポインタになっていると思われる。
次に演算をサポートする。タグ付きの値が渡ってしまうので+をaddにと言う様に変更。
(define (install-complex-package) … (define (add-complex z1 z2) (make-from-real-imag (add (my-real-part z1) (my-real-part z2)) (add (my-imag-part z1) (my-imag-part z2)))) (define (sub-complex z1 z2) (make-from-real-imag (sub (my-real-part z1) (my-real-part z2)) (sub (my-imag-part z1) (my-imag-part z2)))) (define (mul-complex z1 z2) (make-from-mag-ang (mul (my-magnitude z1) (my-magnitude z2)) (add (my-angle z1) (my-angle z2)))) (define (div-complex z1 z2) (make-from-mag-ang (div (my-magnitude z1) (my-magnitude z2)) (sub (my-angle z1) (my-angle z2))))
実行してみる。
> (add (make-complex-from-real-imag (make-real 1.2) (make-real -1.3)) (make-complex-from-real-imag (make-real 2.8) (make-real 1.3))) {complex rectangular {integer . 4.0} integer . 0.0} >
real同士の演算結果はdropされているが、最後のcomplexがdropされていない。
> (make-complex-from-real-imag (make-integer 4.0) (make-integer 0.0)) {complex rectangular {integer . 4.0} integer . 0.0} > (project (make-complex-from-real-imag (make-integer 4.0) (make-integer 0.0))) {real integer . 4.0} > (raise (project (make-complex-from-real-imag (make-integer 4.0) (make-integer 0.0)))) {complex rectangular {integer . 4.0} . 0} > (equ? (make-complex-from-real-imag (make-integer 4.0) (make-integer 0.0)) (raise (project (make-complex-from-real-imag (make-integer 4.0) (make-integer 0.0))))) #f >
まずprojectした時にタグ付きデータを含んだ実数が出来てしまうので、タグがひとつだけ付く様にする必要があるcomplex（ここではrectangular）からprojectする時のコード：
(put 'project 'rectangular (lambda (r i) (make-real r)))
ここの引数rにタグ付きのデータが渡って来るが、何が渡って来るのかは分からない。integerかrealの場合はタグを剥がしてしまえば良いが、rationalの場合そうは行かないし、ここにrの型に依存したコードを書くのは望ましくない。元々rectangularからprojectしたらrealになる事を想定していたが、考えてみたらdropの中でraiseした後にちゃんと比較さえ出来ればprojectの結果は何の型になっても良い筈。なので単純に
(put 'project 'rectangular (lambda (r i) r))
とする。実行してみる。
> (add (make-complex-from-real-imag (make-real 1.2) (make-real -1.3)) (make-complex-from-real-imag (make-real 2.8) (make-real 1.3))) {complex rectangular {integer . 4.0} integer . 0.0} > (project (make-complex-from-real-imag (make-integer 4.0) (make-integer 0.0))) {integer . 4.0} > (raise (raise (raise (project (make-complex-from-real-imag (make-integer 4.0) (make-integer 0.0)))))) {complex rectangular 4.0 . 0} > (equ? (make-complex-from-real-imag (make-integer 4.0) (make-integer 0.0)) (raise (raise (raise (project (make-complex-from-real-imag (make-integer 4.0) (make-integer 0.0))))))) #f >
まだdropされない。raiseでタグ付きには戻っていないが比較でエラーになっている訳ではないので、ちゃんと比較はされている。調べてみるとちゃんとrectangularのequ?に来ているが、ここで#fを返している。
> (equ? (make-complex-from-real-imag 1 2) (make-complex-from-real-imag (make-integer 1) (make-integer 2))) #f >
これが#tを返す様にしたい。
(put 'equ? '(rectangular rectangular) (lambda (x y) (equal? x y)))
このequal?はタグ付きデータを解釈せずに単純にリスト同士の比較してしまうのが原因。ここをタグ付きデータの比較をする様に変更。
(put 'equ? '(rectangular rectangular) (lambda (x y) (and (equ? (real-part x) (real-part y)) (equ? (imag-part x) (imag-part y)))))
実行してみる。
> (add (make-complex-from-real-imag (make-real 1.2) (make-real -1.3)) (make-complex-from-real-imag (make-real 2.8) (make-real 1.3))) {integer . 4.0} > (add (make-complex-from-real-imag 1.2 (make-real -1.3)) (make-complex-from-real-imag (make-real 2.8) 1.3)) {integer . 4.0} >
drop出来た。生の数値もtype-tagとcontentsがあたかもタグが付いていたかの様に振る舞ってくれるお陰でデータは混ぜこぜでも大丈夫。更に比較する時に型変換されて比較出来るのであればdropの中でraiseしてから比較する必要はない。
(define (drop x) (let ((proj (get 'project (list (type-tag x))))) (if proj (let ((projected (project x))) (if (equ? x projected) (drop projected) x)) x)))
最後に、rectangularとpolar間の演算の為の三角関数と平方、平方根を定義する。平方はmulに変更すればタグ付きデータでも対応可能。
(define (square x) (mul x x))
それ以外の関数は結果は常にrealとなる（実際には有限桁数なのでrationalにdropされてしまうが）のでreal型にのみ定義し、apply-operationに引数がひとつの場合は単純にraiseして関数が定義されていないか探す事にする。ただし、arctanだけは引数が二つあり、例えばinteger, integerの組み合わせではエラーとなってしまうので、取り敢えずその場合は両方の引数をraiseする事とする。（本当はどこかでちゃんとエラー処理が必要）
(define (apply-operation op . args) (if (< 2 (length args)) (apply apply-operation op (apply-operation op (car args) (cadr args)) (cddr args)) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (cond ((= (length args) 2) (let ((type1 (car type-tags)) (type2 (cadr type-tags)) (a1 (car args)) (a2 (cadr args))) (let ((types-are (compare-types type1 type2))) (cond ((eq? types-are '=) (apply-operation op (raise a1) (raise a2))) ((eq? types-are '>) (apply-operation op (raise a1) a2)) ((eq? types-are '<) (apply-operation op a1 (raise a2))) (else (error "Unknown type included" (list op type-tags))))))) ((= (length args) 1) (apply-operation op (raise (car args)))) (else (error "No method for these types" (list op type-tags)))))))))
（この関数は大きくなり過ぎているので分解したいが。。。）
(define (sine x) (apply-generic 'sin x)) (define (cosine x) (apply-generic 'cos x)) (define (arctan x y) (apply-generic 'atan x y)) (define (square-root x) (apply-generic 'sqrt x)) (define (install-real-package) … (put 'sin '(real) (lambda (x) (tag (sin x)))) (put 'cos '(real) (lambda (x) (tag (cos x)))) (put 'atan '(real real) (lambda (x y) (tag (atan x y)))) (put 'sqrt '(real) (lambda (x) (tag (sqrt x)))) 'done) (define (install-rectangular-package) … (define (magnitude z) (square-root (add (square (real-part z)) (square (imag-part z))))) (define (angle z) (arctan (imag-part z) (real-part z))) (define (make-from-mag-ang r a) (cons (mul r (cosine a)) (mul r (sine a)))) (define (install-polar-package) … (define (real-part z) (mul (magnitude z) (cosine (angle z)))) (define (imag-part z) (mul (magnitude z) (sine (angle z)))) (define (make-from-real-imag x y) (cons (square-root (add (square x) (square y))) (arctan y x)))
raiseを利用する事で（効率は悪いかも知れないが）、三角関数等をrational型に定義した時のrealへの変換のコードが省ける。
実行してみる。
> (my-magnitude (make-complex-from-real-imag (make-integer 4) (make-real 3.0))) {integer . 5.0} > (my-angle (make-complex-from-real-imag (make-integer 4) (make-real 3.0))) {rational 5796142707547873.0 . 9007199254740992.0} > (my-real-part (make-complex-from-mag-ang (make-integer 1) (make-real (/ pi 3)))) {rational 4503599627370497.0 . 9007199254740992.0} > (my-imag-part (make-complex-from-mag-ang (make-real 1.0) (/ pi 2))) {integer . 1.0} > (my-angle (make-complex-from-real-imag (make-integer 4) (make-integer 3))) {rational 5796142707547873.0 . 9007199254740992.0} > (mul (make-complex-from-real-imag (make-integer 1) (make-integer -1)) (make-complex-from-real-imag (make-real 2) (make-real 3))) {complex polar {rational 5740985595342839.0 . 1125899906842624.0} rational 1777981139569027.0 . 9007199254740992.0} >
*1:エラー出力の{2}はタイプタグとして引数のcarを取った結果。
