ルート探索を用いた型変換
Scheme のような、強い型付けがされた言語でプログラミングしていると、型変換の作業が面倒になることがあると思います。あるいは、複数の型のデータが流れ込んできて、それらを統一的に扱いたいというケースもあるかも知れません。
ということで、型変換の関数を自分で作ることにしたんですが、できるだけ面倒の無いように、変換の方法をプログラムが勝手に調べてくれれば楽だなぁと思いました。
そこで、次のような方法を考えてみました。
まず、隣接する型同士の変換関数を洗いざらいリストアップしておきます。型変換のリクエストがあると、2つの型を繋ぐルートを調べます。そのルート上にある関数を順に合成することで、離れた型同士の変換関数が自動的に生成される、という要領です。
以下、定義です。
(fun (hany f h)
(reset0
(hash-for-each h
(fn (k v)
(awhen (f k v)
(shift0 _ it))))
#f))ハッシュ表を活用するので、ハッシュ検索の関数を作ってみました。脱出のために部分継続を使ってあります。
(define-values (install-type type-of)
(let ((h (make-hasheq)))
(values (fn (a a?) (hash-set! h a a?))
(fn (x)
(hany (fn (a a?)
(and (a? x) a))
h)))))型名を登録する関数と、型名を調べる関数です。何となくハッシュ表をグローバルに置きたくなかったのでちょっと妙な定義方法になっています。ローカル変数を複数の関数で共有したい場合の Scheme 流のやり方です。
(define-values (relate-types make-search)
(let ((h (make-hasheq)))
(values (let ((a-hash
[hash-ref! h _ (fn () (make-hasheq))]))
(fn (a b a->b)
(hash-set! (a-hash a) b a->b)))
(fn (a path)
(aand (hash-ref h a #f)
(fn (b)
(or (hash-ref it b #f)
(hany (fn (a~ a->a~)
(aand (not (memq a~ path))
(relation a~ b path)
(compose it a->a~)))
it))))))))型同士の関係 (変換関数) を登録する関数と、それをルート探索で調べる関数です。
探索のアルゴリズムは深さ優先と幅優先をミックスしたような感じになっています。が、常に最短経路が見つかるわけではないので、ちょっと回りくどい変換関数が作られてしまうことがあるかも知れません。
引数の path は、例えば vector と list の間をぐるぐるループしたりしないように、これまでの経路を覚えておくためのものです。
(fun (relation from to path)
(cond ((eq? from to) values)
((make-search from (cons from path)) => [_ to])
(else #f)))
(fun (coerce type x)
(or (aand (type-of x) (relation it type '()) (it x))
(error 'coerce "coercion method not known for ~s to ~a" x type)))relation は2つの型の関係を返す関数です。これはメモ化した方が良いでしょうね。
coerce が型変換のインターフェースとなります。type-of でデータの型名を得て、relation でそれと対象の型との関係を調べます。あとはそれをデータに適用すれば良いだけです (aand 超便利！)。
ちなみに、CL や Arc の coerce とは引数の順番が逆になっていますが、自動カリー化が行われる言語ではこういう順番にするのが一般的です。
関数の定義は以上です。
型と型変換の定義はこのように分けて行います。
(for-each [apply install-type _]
`((char ,char?)
(bytes ,bytes?)
(number ,number?)
(string ,string?)
(symbol ,symbol?)
(vector ,vector?)
(list ,list?)))
(for-each [apply relate-types _]
`((char string ,string)
(char number ,char->integer)
(bytes list ,bytes->list)
(bytes string ,bytes->string/utf-8)
(number string ,number->string)
(string bytes ,string->bytes/utf-8)
(string number ,string->number)
(string symbol ,string->symbol)
(string list ,string->list)
(symbol string ,symbol->string)
(vector list ,vector->list)
(list string ,list->string)
(list vector ,list->vector)))内容的にはまだまだ不十分ですが、まぁテスト段階なのでこんなものです。本当なら数値型をもっとちゃんと定義したいところです。
また、バイト列から文字列への変換を、文字コードを自動検知して変換するようにすれば、例えばポートから文字列まで、文字コードのことを考えることなく変換できるようになるなぁとか、いろいろ想像と期待が膨らみます。
もちろんユーザー定義の型も登録可能です。が、注意すべきなのは
;; wrong (install-type 'atom (negate pair?))
のような一般的な型を登録してしまうと、型の検知 (type-of) がうまく機能しなくなるということです。したがって、常に他のデータ型と重ならない、ユニークな型を登録する必要があります。
ただし、hany の代わりに hmany のような複数の型候補を返す関数を作って、それぞれについて平行して対象との relation を調べるようなシステムに変更すれば、この問題は解決されるんじゃないかと思います。
あと、リストから文字列への変換は以下のように定義した方が良いかもしれません。
(relate-types 'list
'string
[list->string (map (coerce 'char) _)])
実行例:
> (map (coerce 'symbol)
(coerce 'list #"abc"))
(a b c)バイト列からリストへの変換は一発なんですが、その要素 (整数) からシンボルまでは探索しなければ辿り着けませんね。
> (coerce 'symbol (coerce 'list #"abc")) abc
これは数値のリストから文字列、さらにシンボルへと変換されています (たぶん)。リストから文字列への変換が list->string のままだとエラーが生じているはずです。
追記 (探索方式の見直し)
上で、この型システムにはオーバーラップする型を含められない制限があると言ったんですが、それだと一般の数値から整数への変換なども出来ないことに気付きました。ということで、atom の例えの所で思い付いた hmany 関数というのを作って、複数の型の候補から経路を探索できるようにしてみます。
(fun (hmany f h)
(reset0
(hash-for-each h
(fn (k v)
(awhen (f k v)
(shift0 cont
(cons it (cont))))))
'()))(fun (one-or-many l)
(cond ((null? l) #f)
((null? (cdr l)) (car l))
(else l)))
(define-values (install-type type-of)
(let ((h (make-hasheq)))
(values (fn (a a?) (hash-set! h a a?))
(fn (x)
(aand (one-or-many
(hmany (fn (a a?)
(and (a? x) a))
h))
(if (pair? it)
(sort-types it)
it))))))type-of は、このバージョンでは #f か型 (シンボル) か、型のリストを返すようになります。
(define-values (order<types sort-types)
(let ((h (make-hasheq)))
(values (fn (lo hi)
(hash-set! h hi (adjoin lo (hash-ref h hi '()))))
(fn (l)
(sort l
(afn (x y)
(aand (hash-ref h y #f)
(or (memq x it)
(ormap (self x) it)))))))))型のリストを返す場合は、型階層の低い順から並ぶようにします (e.g. (integer number))。経路を全探索した時に、その結果から辺の数が最少のものを正しい経路として採用するんですが、たまに等しい距離の経路が並んでしまうことがあるので、その場合に備えて優先順位を付けるんです。
型階層は
(define-values (raise-type reduce-type)
(values (fn (lo hi raise)
(order<types lo hi) (relate-types lo hi raise))
(fn (hi lo reduce)
(order<types lo hi) (relate-types hi lo reduce))))
(reduce-type 'number 'integer (compose inexact->exact round))のようにして定義します。型システム全体は階層の無いネットワークなんですが、その中に numerical tower のような階層構造を部分グラフとして組み込むというイメージです。
次に型システムの実装です。
(fun (make-graph)
(let* ((h (make-hasheq))
(a-hash [hash-ref! h _ (fn () (make-hasheq))]))
(case-lambda
((a) (hash-ref h a #f))
((a b) (aand (hash-ref h a #f) (hash-ref it b #f)))
((a b a->b) (hash-set! (a-hash a) b a->b) a->b))))初めのバージョンを作った時に、型の集合と型同士の変換の集合がグラフ構造を成すことに気付いたので、このような関数を作ってみました。型システムの定義と、経路探索のメモ化に使用します。
(define-values (relate-types search-paths)
(let ((g (make-graph)))
(values (fn (a b a->b) (g a b a->b))
(afn (a b path)
(if (eq? a b)
'(())
(aand (g a)
(apply append
(hmany (fn (a~ a->a~)
(aand (not (memq a~ path))
(self a~ b (cons a path))
(map [append _ `(,a->a~)]
it)))
it))))))))search-paths は少々ややこしいですが、型 a から b への経路のリストを返す関数です。self で再帰呼び出しすることで深さ優先、hmany を使うことで全探索となっています。
(fun (sorted-car < l)
(and (pair? l) (car (sort l <))))
(define least-cdr
(sorted-car (fn ((cons _ x) (cons _ y)) (< x y))))
(fun (map-types from to)
(aand (least-cdr
(map [cons _ (length _)]
(search-paths from to '())))
(cons (apply compose (car it))
(cdr it))))
map-types は2つの型の間の全ての経路のうち最短のものを選ぶ関数です。
この経路というのは隣接する型同士の変換関数のリストなので、compose を適用するとそのまま from から to への変換関数になってくれます。
返り値はその変換関数と経路の長さのペアとなっています。
メモ化バージョン。
(define-values (map-types remap-types)
(let ((g (make-graph)))
(values (fn (from to)
(or (g from to)
(aand (least-cdr
(map [cons _ (length _)]
(search-paths from to '())))
(g from to
(cons (apply compose (car it))
(cdr it))))))
(fn (from to)
(set! g (make-graph))
(map-types from to)))))型システムは実行時に自由に変更可能なため、いちおうルートの再計算ができるようにしておきます。
(fun (relation from to)
(aand (if (and (symbol? from) (symbol? to))
(map-types from to)
(least-cdr
(cond ((symbol? from)
(filter-map (map-types from) to))
((symbol? to)
(filter-map [map-types _ to] from))
(else
(append-map [filter-map (map-types _) to]
from)))))
(car it)))
(fun (coerce type x)
(or (aand (type-of x) (relation it type) (it x)) x))relation は map-types の car を取り出す関数となります。
探索の始点と終点が1対1の場合もあれば、下の例みたいに coerce の第1引数に type-of を使うと多対多となることもあるので、場合分けが必要です。
1対1以外の場合は、変換関数と辺の数のペアのリストが得られるので、その中から least-cdr で最少辺のものを選んでいます。
(fun (inc n x)
(coerce (type-of x)
(+ (coerce 'integer x) (or n 1))))
ライブラリ:
mlfun.ss arcfun.ss anaphora.ss
