一般に、関数の返り値はひとつしかありません。複数の値を返す場合、昔の Lisp ではリストに格納して返すのが普通でした。この場合、返す側は必要なデータをリストに格納し、受け取る側はリストからデータを取り出す処理が必要になります。ところが、Scheme や Common Lisp の「多値 (multiple values)」という機能を使うと、複数の値を簡単にやり取りすることができます。
Scheme で複数の値を受け取るには関数 call-with-value を使います。
call-with-values producer consumer
call-with-values は producer を評価します。producer は引数のない関数で複数の値 (多値) を返します。call-with-value はそれをそのまま cousumer に渡して評価します。その結果が call-with-values の返り値となります。
複数の値を返すには関数 values を使います。
values args ...
values は複数個の引数を多値として返します。簡単な例を示しましょう。
gosh[r7rs.user]> (values 1 2 3) 1 2 3 gosh[r7rs.user]> (call-with-values (lambda () (values 1 2 3)) list) (1 2 3)
(values 1 2 3) は 3 つの値 1, 2, 3 を返します。call-with-values は受け取った多値を list に渡すので、(list 1 2 3) が評価されて (1 2 3) が返り値となります。
もう一つ簡単な例題として、Scheme のライブラリ SRFI-1 に用意されている関数 partition を作ってみましょう。
partition pred ls
partition はリスト ls を述語 pred で二分割し、pred を満たす要素のリストと、pred を満たさない要素のリストの 2 つを多値として返します。プログラムは次のようになります。
リスト : リストの分割 (1)
(define (partition pred ls)
(if (null? ls)
(values '() '())
(call-with-values
(lambda ()
(partition pred (cdr ls)))
(lambda (a b)
(if (pred (car ls))
(values (cons (car ls) a) b)
(values a (cons (car ls) b)))))))
引数 ls が空リストの場合は values で空リストを 2 つ返します。そうでなければ、call-with-values の最初のラムダ式で partition を再帰呼び出しし、2 番目のラムダ式の引数 a, b で多値を受け取ります。(pred (car ls)) が真の場合、(car ls) を a の先頭に追加し、そうでなければ b の先頭に追加します。あとは values で 2 つのリストを返すだけです。
簡単な実行例を示します。
gosh[r7rs.user]> (partition even? '(1 2 3 4 5 6)) (2 4 6) (1 3 5) gosh[r7rs.user]> (partition odd? '(1 2 3 4 5 6)) (1 3 5) (2 4 6)
このように、多値の操作は multiple-value-bind と values を使って行うことができます。このほかにも、便利な関数やマクロがあるので紹介しましょう。多値を変数に取り出す場合、R7RS-small で定義されているマクロ let-values, let*-values を使うと便利です。
(let-values ((variables mv-expr) ...) body ...) (let*-values ((variables mv-expr) ...) body ...)
variables はシンボルのリストで、mv-expr は多値を返す関数です。mv-expr が返す多値を variables のシンボルに束縛し、body 以降の S 式を評価します。多値の個数と変数の個数が合わないとエラーになります。let-values と let*-values は let と let* の関係と同じです。簡単な使用例を示します。
gosh[r7rs.user]> (let-values (((a b) (values 1 2)) ((c d) (values 3 4))) (list a b c d)) (1 2 3 4) gosh[r7rs.user]> (let*-values (((a b) (values 1 2)) ((c d) (values a b))) (list a b c d)) (1 2 1 2)
let-values を使うと、リストを分割する parititon は次のようになります。
リスト : リストの分割 (2)
(define (partition2 pred ls)
(if (null? ls)
(values '() '())
(let-values (((a b) (partition2 pred (cdr ls))))
(if (pred (car ls))
(values (cons (car ls) a) b)
(values a (cons (car ls) b))))))
gosh[r7rs.user]> (partition2 odd? '(1 2 3 4 5 6)) (1 3 5) (2 4 6) gosh[r7rs.user]> (partition2 even? '(1 2 3 4 5 6)) (2 4 6) (1 3 5)
partition2 を再帰呼び出しするとき、let-values で多値を受け取って変数 a, b にセットするだけです。call-with-values よりも使いやすいと思います。
define-values は多値の define バージョンです。
(define-values variables mv-expr)
varibales はシンボルのリストですが、ドットリストは受け付けないので注意してください。mv-expr は多値を返す関数です。簡単な使用例を示しましょう。
gosh[r7rs.user]> (define-values (a b) (values 1 2)) b gosh[r7rs.user]> a 1 gosh[r7rs.user]> b 2
最後に簡単な例題として「クイックソート (quick sort)」を取り上げます。ソートは昔から研究されている分野で、優秀なアルゴリズムが確立しています。その中でもクイックソートは高速なアルゴリズムとして有名です。
クイックソートはある値を基準にして、要素をそれより大きいものと小さいものの 2 つに分割していくことでソートを行います。基準になる値のことを「枢軸 (pivot)」といいます。枢軸は要素の中から適当な値を選んでいいのですが、リストの場合は任意の要素を簡単に選ぶことができません。この場合、いちばん簡単に求めることができる先頭の要素を枢軸とします。
リストを 2 つに分けたら、それらを同様にソートします。これは、再帰を使えば簡単に実現できます。その結果を枢軸を挟んで結合します。これを図に表すと次のようになります。
5 3 7 6 9 8 1 2 4
5 を枢軸に分割
(3 1 2 4) 5 (7 6 9 8)
3を枢軸に分割 7を枢軸に分割
(1 2) 3 (4) | 5 | (6) 7 (9 8)
・・・分割を繰り返していく・・・
図 : クイックソート
このようにリストを分割していくと、最後は空リストになります。ここが再帰の停止条件になります。あとは分割したリストを結合していけばいいわけです。プログラムは次のようになります。
リスト : クイックソート
(define (quick-sort f ls)
(if (null? ls)
'()
(let ((p (car ls)))
(let-values (((a b) (partition (lambda (x) (f x p)) (cdr ls))))
(append (quick-sort f a)
(cons p (quick-sort f b)))))))
最初に ls が空リストかチェックします。これが再帰呼び出しの停止条件になります。そうでなければ、リストを分割してソートを行います。リストの先頭要素を取り出して変数 p にセットします。これが枢軸となります。
リストの分割は関数 partition で行います。partition は x を基準にリストを 2 つに分割し、それらのリストを多値で返します。要素の大小関係は述語 pred で判定します。これを let-values で受け取り、変数 a, b にセットします。リスト a が枢軸よりも小さな要素を集めたもので、リスト b が枢軸以上の要素を集めたものです。そして、quick-sort を再帰呼び出しして、リスト a, b をソートします。あとは、その結果を枢軸 p を挟んで結合すればいいわけです。
それでは、簡単な実行例を示しましょう。
gosh[r7rs.user]> (quick-sort < '(5 6 4 7 3 8 2 9 1)) (1 2 3 4 5 6 7 8 9) gosh[r7rs.user]> (quick-sort > '(5 6 4 7 3 8 2 9 1)) (9 8 7 6 5 4 3 2 1)
正常に動作していますね。
クイックソートの実行時間は、データ数を N とすると平均して N * log2 N に比例します。ところが、枢軸の選び方によっては、最悪で N の 2 乗に比例するところまで劣化します。たとえば、リストの先頭要素を枢軸として選ぶ場合、リストの要素が昇順または降順に並んでいると最悪の結果になります。
このため、クイックソートをプログラムする場合、枢軸の選び方を工夫するのが一般的です。たとえば、データの中からいくつかの要素を選び、その中で中間の値を持つ要素を枢軸に選びます。たくさんの要素を選ぶとそれだけ最悪の枢軸を選ぶ危険性は減少しますが、中間の値を選ぶのに時間がかかってしまいます。実際には、3 つから 5 つの要素を選んで、その中で中間の値を枢軸とする場合が多いようです。
ただし、この改良方法はリストには不向きであることに注意してください。リストはデータ数が多くなるほど、後ろのデータを取り出すのに時間がかかるようになります。先頭から 3 つのデータを取り出して枢軸を選んだとしても、降順または昇順に並んだデータには効果が無いのは明らかです。このため、リストのソートはクイックソートよりも「マージソート (merge sort)」の方が適しているといわれています。
多値と同じような動作は「継続渡しスタイル (CPS)」でも実現することができます。CPS についての詳しいは説明は、拙作のページ 継続と継続渡しスタイル をお読みください。
今までは「継続」に渡す引数をひとつに限定していましたが、これを複数の引数を渡すように拡張します。たとえば、リストを分割する partition を CPS でプログラムすると次のようになります。
リスト : リストの分割 (CPS 版)
(define (partition/cps pred ls cont)
(if (null? ls)
(cont '() '())
(partition/cps
pred
(cdr ls)
(lambda (xs ys)
(if (pred (car ls))
(cont (cons (car ls) xs) ys)
(cont xs (cons (car ls) ys)))))))
partition/cps の引数 cont が継続を表します。cont は 2 つの引数を受け取ります。ls が空リストの場合は cont に 2 つの空リストを渡します。parition/cps は継続 (ラムダ式) の引数 xs, ys に 2 つのリストを渡します。この中で ls の先頭要素に述語 pred を適用して、真ならば xs の先頭に要素を追加し、そうでなければ ys の先頭に追加します。最後に、2 つのリストを cont に渡して呼び出すだけです。
簡単な実行例を示します。
gosh[r7rs.user]> (partition/cps even? '(1 2 3 4 5 6 7 8) (lambda (a b) (list a b))) ((2 4 6 8) (1 3 5 7))
partition/cps を使ったクイックソートは次のようになります。
リスト : クイックソート (CPS 版)
(define (quick-sort f ls)
(if (null? ls)
'()
(let ((p (car ls)))
(partition/cps
(lambda (x) (f x p))
(cdr ls)
(lambda (a b)
(append (quick-sort f a)
(cons p (quick-sort f b))))))))
partition/cps に渡す継続 (ラムダ式) で 2 つのリストを受け取り、この中で quick-sort を再帰呼び出しします。そして、その結果を枢軸 p を挟んで append で結合すればいいわけです。
簡単な実行例を示します。
gosh[r7rs.user]> (quick-sort < '(5 6 4 7 3 8 2 9 1 10)) (1 2 3 4 5 6 7 8 9 10)
Scheme の多値は R5RS から導入された比較的新しい機能です。多値は Scheme の「継続 (continuation)」を使って実装されています。通常、継続に渡す引数はひとつだけなのですが、call-with-values, let-values, let*-values, define-values のもとで生成された継続に限り、任意の数の引数を渡すことができます。R7RS-small では values を次のように定義しています。
リスト : values の定義 (R5RS, R7RS-small)
(define (values . things)
(call-with-current-continuation
(lambda (cont) (apply cont things))))
call/cc で取り出した継続 cont に複数の値を渡して呼び出しているだけです。この定義からもわかるように、(values) とすると 0 個の引数を継続に渡すことができます。簡単な例を示します。
gosh[r7rs.user]> (list) () gosh[r7rs.user]> (call-with-values (lambda () (values)) list) ()
ただし、引数をひとつ受け取る継続に 0 または 2 個以上の引数を渡した場合の動作は R7RS-small に規定されていません。処理系依存の動作になります。Gauche の場合、引数が 0 個のときは #<undef> が渡され、2 個以上のときは最初の要素が渡されます。
簡単な例を示しましょう。
gosh[r7rs.user]> (define a #f) a gosh[r7rs.user]> (display (call/cc (lambda (k) (set! a k) 1))) 1#<undef> gosh[r7rs.user]> (a 2) 2#<undef> gosh[r7rs.user]> (a 1 2 3) 1#<undef> gosh[r7rs.user]> (a) #<undef>#<undef>
display の引数を評価するときの継続を取り出して変数 a にセットします。これは引数をひとつ受け取る継続です。(a 2) を評価すると、2 が display に渡されて 2 が表示されます。(a 1 2 3) を評価すると、最初の引数 1 が display に渡されます。(a) を評価すると #<undef> が渡されます。ただし、処理系によって動作が異なる可能性があります。引数の個数が合わない場合、エラーを送出する処理系があるかもしれません。ご注意くださいませ。
今回は Scheme の「例外 (exception) 処理」について説明します。一般に、例外はエラー処理で使われる機能です。「例外＝エラー処理」と考えてもらってもかまいません。最近は例外処理を持っているプログラミング言語が多くなりました。Scheme の場合、昔の仕様書 (R5RS) には例外処理の規定がありませんでした。このため、例外処理は Scheme のライブラリ (SRFI-34 など) で実装されていたのですが、R6RS と R7RS-samll では例外処理が規定されています。今回は例外処理の基本的な使い方を簡単に説明します。
たとえば、1 から 100 までの 2 乗と 3 乗の値をファイルに書き込む処理を考えてみましょう。例外処理のないプログラミング言語、たとえばＣ言語でプログラムする場合、ファイルをオープンする処理、データを書き込む処理、ファイルをクローズする処理でエラーが発生していないかチェックする必要があります。ところが、Scheme でプログラムすると次のようになります。
リスト : データの出力
(import (scheme base) (scheme write) (scheme file))
(call-with-output-file "output.txt"
(lambda (oport)
(do ((n 1 (+ n 1)))
((> n 100))
(display n oport)
(display ", " oport)
(display (* n n) oport)
(display ", " oport)
(display (* n n n) oport)
(display "\n" oport))))
エラーをチェックする処理がありません。これは例外処理が働いて、エラーが発生したらプログラムの実行が中断されるからです。例外処理のおかげで、プログラムをすっきりと書くことができます。なお、エラーが発生したことを「例外が発生した」とか「例外が送出された」という場合もあります。本稿でもエラーのことを例外と記述することにします。
ところで、例外が発生するたびに実行を中断するのではなく、致命的な例外でなければプログラムの実行を継続したい場合もあるでしょう。このような場合にこそ、例外処理が役に立つのです。Scheme で発生した例外を捕まえる場合、guard を使うと簡単です。guard の構文を下図に示します。
(guard (variable clause1
clause2
...
clauseN)
body)
図 : guard の構文
guard は body の S 式を評価して、その結果を返します。Gauche の場合、body に複数の S 式を記述することができます。body を評価しているときにエラーが送出されると、エラーオブジェクト (エラーを表す値) を変数 vairable に束縛して、節 clause を順番にチェックします。clause は cond の節と同じ形式です。
guard は cond と同様に条件部 test が真を返す節を選択します。そして、その節の S 式を順番に評価して、最後の S 式の評価結果を返します。2 はまだ説明してませんが、通常の cond でも使用できる形式です。test が真の場合、その結果を関数 proc に渡して評価します。3 は cond と同じ形式です。
簡単な使用例を示します。
gosh[r7rs.user]> (guard (exc (else exc)) 1 2 3) 3 gosh[r7rs.user]> (guard (exc (else exc)) (/ 2 0)) #<error "attempt to calculate a divisio">
最初の例はエラーが送出されないので、最後に評価した 3 が返されます。次の例は 0 で除算したのでエラーが送出され、それを guard で捕捉しています。変数 exc にはエラーオブジェクトがセットされ、その節の S 式が評価されます。この場合は変数 exc にセットされたエラーオブジェクトを返しているだけです。
例外の送出は関数 error を使うと簡単です。
error message obj ...
error は引数のエラーメッセージ message と残りの引数 obj ... (イリタント) を格納したエラーオブジェクトを生成して例外を送出します。エラーオブジェクトは述語 error-object? で判定することができます。また、エラーメッセージとイリタントは以下の関数で取得することができます。
error-object? obj error-object-message err-obj error-object-irritants err-obj
簡単な使用例を示しましょう。
gosh[r7rs.user]> (guard (exc ((error-object? exc) exc)) (error "oops!" 1 2 3)) #<error "oops! 1 2 3"> gosh[r7rs.user]> (guard (exc ((error-object? exc) (error-object-message exc))) (error "oops!" 1 2 3)) "oops!" gosh[r7rs.user]> (guard (exc ((error-object? exc) (error-object-irritants exc))) (error "oops!" 1 2 3)) (1 2 3) gosh[r7rs.user]> (guard (exc ((error-object? exc) (error-object-irritants exc))) (error "oops!")) ()
関数 raise はエラーオブジェクトを生成しないで、引数の obj を使って例外を送出します。
raise obj
引数 obj は何でもかまいません。簡単な例を示します。
gosh[r7rs.user]> (guard (exc (else exc)) (raise 1)) 1 gosh[r7rs.user]> (guard (exc (else exc)) (raise 'foo)) foo gosh[r7rs.user]> (guard (exc (else exc)) (raise "oops")) "oops"
自分で特別な例外を表すレコード型を定義して、それを raise で送出することもできます。
gosh[r7rs.user]> (define-record-type Myerror (make-myerror message args) myerror? (message get-message) (args get-args)) get-args gosh[r7rs.user]> (guard (exc ((myerror? exc) exc)) (raise (make-myerror "oops" 123))) #<Myerror 0x7f10498c0e80> gosh[r7rs.user]> (guard (exc ((myerror? exc) (get-message exc))) (raise (make-myerror "oops" 123))) "oops" gosh[r7rs.user]> (guard (exc ((myerror? exc) (get-args exc))) (raise (make-myerror "oops" 123))) 123
file-error? obj read-error? obj
file-error? と read-error? はエラー型を判定する述語です。ファイルをオープンできないときやライブラリ (scheme file) の関数 delete-file でファイルを削除できないとき、捕捉したエラーオブジェクトに file-error? を適用すると #t を返します。関数 read でデータを読み込むときに例外が送出された場合、捕捉したエラーオブジェクトに read-error? を適用すると #t を返します。
簡単な使用例を示しましょう。
gosh[r7rs.user]> (open-input-file "test3.txt") *** SYSTEM-ERROR: couldn't open input file: "test3.txt": No such file or directory ・・・省略・・・ gosh[r7rs.user]> (guard (exc ((file-error? exc) exc)) (open-input-file "test3.txt")) #<system-error "couldn't open input file: "tes"> gosh[r7rs.user]> (define iport (open-input-string "(a b c")) iport gosh[r7rs.user]> (read iport) *** READ-ERROR: Read error at "(input string port)":line 1: EOF inside a list (starting from line 1) Stack Trace: ・・・省略・・・ gosh[r7rs.user]> (define iport (open-input-string "(a b c")) iport gosh[r7rs.user]> (guard (exc ((read-error? exc) exc)) (read iport)) #<read-error "Read error at "(input string p">
ファイル test3.txt が存在しない場合、open-input-file で例外が送出されますが、そのエラーオブジェクトは file-error? で判定することができます。文字列ポートから read でデータを読み込みますが、リストの右カッコがないため例外が送出されます。この場合は read-error? で判定することができます。
例外は guard だけではなく with-exception-handler でも捕捉することができます。
with-exception-handler handler thunk
引数 handler は引数を一つ受け取る関数で、thunk は引数を受け取らない関数です。with-execption-handler は thunk を評価して、その結果を返します。thunk を評価しているときに例外が送出されると handler に制御が移ります。このとき、handler にはエラーオブジェクトまたは raise の引数が渡されます。
例外を捕捉したとき、guard は節 clause の評価結果を返しますが、with-exception-handler は handler の評価が終了してもその結果を返しません。さらに上位の例外処理に制御が移るのです。次の例を見てください。
gosh[r7rs.user]> (with-exception-handler (lambda (x) (display x) (newline)) (lambda () (error "oops!"))) #<error "oops!"> *** ERROR: oops! Stack Trace: ・・・省略・・・
エラーオブジェクトを表示したあと、上位の例外処理がないので例外は捕捉されず、REPL でエラーが表示されます。この連鎖を止めるには、継続を使って with-exception-handler から脱出する必要があります。
gosh[r7rs.user]> (call/cc (lambda (cont) (with-exception-handler (lambda (x) (display x) (newline) (cont #t)) (lambda () (error "oops!"))))) #<error "oops!"> #t
上の例では、継続 cont で with-exception-handler から脱出しているので、REPL でエラーは表示されずに、継続 cont の返り値 #f が表示されます。
関数 raise-continuable を使うと、例外を送出したあと handler の返り値を使って実行を再開することができます。ただし、使い方が少々難しいようなので、ここでは簡単な例を示すだけにとどめます。詳細は R7RS-small や Gauche のマニュアルをお読みください。
gosh[r7rs.user]> (with-exception-handler (lambda (x) (if (string? x) (string->number x) (error "oops!"))) (lambda () (+ 10 (raise-continuable "123")))) 133 gosh[r7rs.user]> (with-exception-handler (lambda (x) (if (string? x) (string->number x) (error "oops!"))) (lambda () (+ 10 (raise-continuable 'foo)))) *** ERROR: oops! Stack Trace: ・・・省略・・・
今回は「たらいまわし関数」を例題にして、「メモ化」と「遅延評価」について簡単に説明します。
最初に「たらいまわし関数」について説明します。次のリストを見てください。
リスト : たらいまわし関数
(define (tarai x y z)
(if (<= x y)
y
(tarai (tarai (- x 1) y z) (tarai (- y 1) z x) (tarai (- z 1) x y))))
(define (tak x y z)
(if (<= x y)
z
(tak (tak (- x 1) y z) (tak (- y 1) z x) (tak (- z 1) x y))))
関数 tarai や tak は「たらいまわし関数」といって、再帰的に定義されています。これらの関数は、引数の与え方によっては実行に時間がかかるため、Lisp などのベンチマークに利用されることがあります。
関数 tarai は通称「竹内関数」と呼ばれていて、日本の代表的な Lisper である竹内郁雄先生によって考案されたそうです。そして、関数 tak は関数 tarai のバリエーションで、John Macarthy 先生によって作成されたそうです。たらいまわし関数が Lisp のベンチマークで使われていたことは知っていましたが、このような由緒ある関数だとは思ってもいませんでした。
それでは、さっそく実行してみましょう。実行環境は Ubunts 18.04 (Windows Subsystem for Linux), Intel Core i5-6200U 2.30GHz, Gauche (version 0.9.9) です。
tarai 14 7 0 : 26.8 [s] tak 22 11 0 : 26.4 [s]
このように、たらいまわし関数は引数の値が小さくても実行に時間がかかります。
たらいまわし関数が遅いのは、同じ値を何度も計算しているためです。この場合、「表 (table)」を使って処理を高速化することができます。同じ値を何度も計算することがないように、計算した値は表に格納しておいて、2 回目以降は表から計算結果を求めるようにします。このような手法を「表計算法」とか「メモ化 (memoization または memoisation)」といいます。
Scheme の場合、メモ化は「ハッシュ表 (hash table)」を使うと簡単です。Scheme の仕様書 (R7RS-samll) にハッシュ表は定義されていませんが、多くの Scheme 処理系でハッシュ表を使うことができます。もちろん、Gauche にもハッシュ表が用意されていますが、今回は拙作のページ ヒープとハッシュ法 で作成したハッシュ表 hash.scm を使うことにします。詳細は プログラムリスト２ をお読みください。
ハッシュ表を使うと、たらいまわし関数のメモ化は次のようになります。
リスト : たらいまわし関数のメモ化 (1)
;;; 畳み込み
(define (foldl fn a xs)
(if (null? xs)
a
(foldl fn (fn a (car xs)) (cdr xs))))
;;; ハッシュ関数
(define (hash-func xs)
(foldl (lambda (a x) (+ (* a 100) x)) 0 xs))
;;; メモ用のハッシュ表
(define *table* (make-hash-table 1999 hash-func equal?))
;;; たらいまわし関数
(define (tarai-memo x y z)
(let ((key (list x y z)))
(or (hash-find *table* key)
(let ((value (if (<= x y)
y
(tarai-memo (tarai-memo (- x 1) y z)
(tarai-memo (- y 1) z x)
(tarai-memo (- z 1) x y)))))
(hash-set! *table* key value)
value))))
関数 tarai-memo の値を格納するハッシュ表を大域変数 *table* に用意します。tarai-memo は引数 x, y, z を要素とするリストを作り、それをキーとしてハッシュ表 *table* を検索します。キーはリストなので等値の判定には述語 equal? を使います。*table* に key があればその値を返します。そうでなければ、値 value を計算して *table* にセットし、その値を返します。
ところで、ハッシュ表は局所変数に格納することもできます。次のリストを見てください。
リスト : たらいまわし関数のメモ化 (2)
(define tak-memo
(let ((table (make-hash-table 1999 hash-func equal?)))
(letrec ((tak (lambda (x y z)
(let* ((key (list x y z)))
(or (hash-find table key)
(let ((value (if (<= x y)
z
(tak (tak (- x 1) y z)
(tak (- y 1) z x)
(tak (- z 1) x y)))))
(hash-set! table key value)
value))))))
tak)))
let でハッシュ表 table を定義します。その中で、たらいまわし関数 tak を局所関数として定義します。局所関数 tak の処理内容は tarai-memo と同じですが、x <= y のときは z を返します。最後に tak を返します。この返り値を tak-memo にセットします。ハッシュ表 table が生成されるのは、tak-memo に関数をセットするときの一回だけです。これで、その関数専用のハッシュ表を局所変数に用意することができます。
このように関数をメモ化することは簡単にできますが、メモ化を行うたびに関数を修正するのは面倒です。このような場合、関数をメモ化する「メモ化関数」があると便利です。メモ化関数については 計算機プログラムの構造と解釈 第二版 3.3.3 表の表現 に詳しい説明があります。
プログラムは次のようになります。
リスト : メモ化関数
(define (memoize func size hfunc test?)
(let ((table (make-hash-table size hfunc test?)))
(lambda args
(or (hash-find table args)
(let ((value (apply func args)))
(hash-set! table args value)
value)))))
; メモ化
(set! tarai (memoize tarai 1999 hash-func equal?))
(set! tak (memoize tak 1999 hash-func equal?))
関数 memoize は関数 func を引数に受け取り、それをメモ化した関数を返します。memoize が返す関数はクロージャなので、memoize の引数 func や局所変数 table にアクセスすることができます。また、無名関数 lambda の引数 args は可変個の引数を受け取るように定義します。これで複数の引数を持つ関数にも対応することができます。
args の値は引数を格納したリストになるので、これをキーとして扱います。ハッシュ表 table に値がなければ、関数 func を呼び出して値を計算し、それを table にセットして値を返します。最後に、tak と tarai の値を set! で書き換えます。そうしないと、関数 tak, tarai の中で再帰呼び出しするとき、メモ化した関数を呼び出すことができません。ご注意ください。
それでは実際に実行してみましょう。
(tarai 192 96 0) : 0.29 [s] (tak 192 96 0) : 1.45 [s]
このように、引数の値を増やしても高速に実行することができます。メモ化の効果は十分に出ていると思います。また、同じ計算を再度実行すると、メモ化の働きにより値をすぐに求めることができます。
関数 tarai は「遅延評価 (delayed evaluation または lazy evaluation)」を行う処理系、たとえば関数型言語の Haskell では高速に実行することができます。また、Scheme でも delay と force を使って遅延評価を行うことができます。
tarai のプログラムを見てください。x <= y のときに y を返しますが、このとき引数 z の値は必要ありませんね。引数 z の値は x > y のときに計算するようにすれば、無駄な計算を省略することができます。なお、関数 tak は x <= y のときに z を返しているため、遅延評価で高速化することはできません。ご注意ください。
今回は Shiro さん の WiLiKi にある Scheme:たらいまわしべんち を参考に、プログラムを作ってみましょう。まず最初に delay と force を説明します。
delay はシンタックス形式で、引数 s-exp を評価しないでプロミス (promise) というデータを返します。s-exp はこのプロミスに保存されていて、(force promise) を実行すると、s-exp を評価してその値を返します。このとき、値がプロミスに保存されることに注意してください。再度 (force rpomise) を実行すると、保存された値が返されます。
簡単な使用例を示しましょう。
gosh[r7rs.user]> (define a (delay (+ 10 20))) a gosh[r7rs.user]> a #<promise 0x7f9483ba3360> gosh[r7rs.user]> (force a) 30
(delay (+ 10 20)) の返り値を変数 a にセットします。このとき、S 式 (+ 10 20) は評価されていません。(force a) を評価すると、S 式 (+ 10 20) を評価して値 30 を返します。また、(force a) を再度実行すると、同じ式を再評価することなく値を求めることができます。次の例を見てください。
gosh[r7rs.user]> (define b (delay (begin (display "oops!") (+ 10 20)))) b gosh[r7rs.user]> (force b) oops!30 gosh[r7rs.user]> (force b) 30
最初に (force b) を実行すると、S 式 (begin (display "oops!") (+ 10 20)) が評価されるので、画面に oops! が表示されます。次に、(force b) を実行すると、式を評価せずに保存した値を返すので oops! は表示されません。
delay と force を使うと、たらいまわし関数は次のようになります。
リスト : delay と force による遅延評価
(define (tarai1 x y z)
(if (<= x y)
y
(let ((zz (force z)))
(tarai1 (tarai1 (- x 1) y (delay zz))
(tarai1 (- y 1) zz (delay x))
(delay (tarai1 (- zz 1) x (delay y)))))))
遅延評価したい処理をプロミスにして引数 z に渡します。そして、x > y のときに引数 z のプロミスを force で評価します。すると、プロミス内の処理が評価されて z の値を求めることができます。たとえば、(delay 0) を z に渡す場合、(force z) とすると返り値は 0 になります。(delay x) を渡せば、x に格納されている値が返されます。(delay (tarai1 ...)) を渡せば tarai1 が実行されて、その値を求めることができます。
それでは、実際に実行してみましょう。
(tarai1 192 96 (delay 0)) closure : 0.024 [s]
tarai の場合、遅延評価の効果はとても大きいですね。
ところで、delay と force がなくても、クロージャを使って遅延評価を行うことができます。次のリストを見てください。
リスト : クロージャによる遅延評価
(define (tarai2 x y z)
(if (<= x y)
y
(let ((zz (z)))
(tarai2 (tarai2 (- x 1) y (lambda () zz))
(tarai2 (- y 1) zz (lambda () x))
(lambda () (tarai2 (- zz 1) x (lambda () y)))))))
遅延評価したい処理をクロージャに包んで引数 z に渡します。そして、x > y のときに引数 z の関数を呼び出します。すると、クロージャ内の処理が評価されて z の値を求めることができます。たとえば、(lambda () 0) を z に渡す場合、(z) とすると返り値は 0 になります。(lambda () x) を渡せば、x に格納されている値が返されます。(lambda () (tarai2 ...)) を渡せば、関数 tarai2 が実行されてその値が返されるわけです。
それでは、実際に実行してみましょう。
(tarai2 192 96 (lambda () 0)) closure : 0.008 [s]
クロージャの方が delay と force よりも速いですね。delay と force は処理が複雑になる分だけ、クロージャを使った遅延評価よりも実行速度は遅くなるようです。
ところで、クロージャを使わなくても、関数 tarai を高速化する方法があります。C++:language&libraries (cppll, リンク切れ) で Akira Higuchi さんが書かれたＣ言語の tarai 関数はとても高速です。Scheme でプログラムすると次のようになります。
リスト : tarai の遅延評価
(define (tarai3 x y z)
(if (<= x y)
y
(tarai-lazy (tarai3 (- x 1) y z) (tarai3 (- y 1) z x) (- z 1) x y)))
(define (tarai-lazy x y xx yy zz)
(if (<= x y)
y
(let ((z (tarai3 xx yy zz)))
(tarai-lazy (tarai3 (- x 1) y z) (tarai3 (- y 1) z x) (- z 1) x y))))
関数 tarai-lazy の引数 xx, yy, zz で z の値を表すところがポイントです。つまり、z の計算に必要な値を引数に保持し、z の値が必要になったときに (tarai xx yy zz) で計算するわけです。実際に実行してみると tarai 192 96 0 は 0.001 [s] になりました。Akira Higuchi さんに感謝いたします。
;;;
;;; tarai.scm : たらいまわし関数と遅延評価
;;;
;;; Copyright (C) 2009-2020 Makoto Hiroi
;;;
(import (scheme base) (scheme write) (scheme time)
(mylib hash))
(define (tarai x y z)
(if (<= x y)
y
(tarai (tarai (- x 1) y z) (tarai (- y 1) z x) (tarai (- z 1) x y))))
(define (tak x y z)
(if (<= x y)
z
(tak (tak (- x 1) y z) (tak (- y 1) z x) (tak (- z 1) x y))))
;;; 畳み込み
(define (foldl fn a xs)
(if (null? xs)
a
(foldl fn (fn a (car xs)) (cdr xs))))
;;; ハッシュ関数
(define (hash-func xs)
(foldl (lambda (a x) (+ (* a 100) x)) 0 xs))
;;; メモ用のハッシュ表
(define *table* (make-hash-table 1999 hash-func equal?))
; たらいまわし関数
(define (tarai-memo x y z)
(let ((key (list x y z)))
(or (hasa
h-find *table* key)
(let ((value (if (<= x y)
y
(tarai-memo (tarai-memo (- x 1) y z)
(tarai-memo (- y 1) z x)
(tarai-memo (- z 1) x y)))))
(hash-set! *table* key value)
value))))
(define tak-memo
(let ((table (make-hash-table 1999 hash-func equal?)))
(letrec ((tak (lambda (x y z)
(let* ((key (list x y z)))
(or (hash-find table key)
(let ((value (if (<= x y)
z
(tak (tak (- x 1) y z)
(tak (- y 1) z x)
(tak (- z 1) x y)))))
(hash-set! table key value)
value))))))
tak)))
;;; メモ化
(define (memoize func size hfunc test?)
(let ((table (make-hash-table size hfunc test?)))
(lambda args
(or (hash-find table args)
(let ((value (apply func args)))
(hash-set! table args value)
value)))))
(set! tarai (memoize tarai 1999 hash-func equal?))
(set! tak (memoize tak 1999 hash-func equal?))
;;; 遅延評価
(define (tarai1 x y z)
(if (<= x y)
y
(let ((zz (force z)))
(tarai1 (tarai1 (- x 1) y (delay zz))
(tarai1 (- y 1) zz (delay x))
(delay (tarai1 (- zz 1) x (delay y)))))))
;;; クロージャによる遅延評価
(define (tarai2 x y z)
(if (<= x y)
y
(let ((zz (z)))
(tarai2 (tarai2 (- x 1) y (lambda () zz))
(tarai2 (- y 1) zz (lambda () x))
(lambda () (tarai2 (- zz 1) x (lambda () y)))))))
;;; 関数だけの高速化
(define (tarai3 x y z)
(if (<= x y)
y
(tarai-lazy (tarai3 (- x 1) y z) (tarai3 (- y 1) z x) (- z 1) x y)))
(define (tarai-lazy x y xx yy zz)
(if (<= x y)
y
(let ((z (tarai3 xx yy zz)))
(tarai-lazy (tarai3 (- x 1) y z) (tarai3 (- y 1) z x) (- z 1) x y))))
;;; テスト
(define (test fn x y z)
(let ((s (current-jiffy)))
(display (fn x y z))
(newline)
(display (inexact (/ (- (current-jiffy) s) (jiffies-per-second))))
(newline)))
;;;
;;; hash.scm : ハッシュ表
;;;
;;; Copyright (C) 2008-2020 Makoto Hiroi
;;;
(define-library (mylib hash)
(import (scheme base) (scheme write))
(export make-hash-table hash? hash-find hash-set! hash-delete! hash-for-each)
(begin
;; ハッシュ表
(define-record-type Hash
(create-hash hash-table hash-func hash-test)
hash?
(hash-table hash-table)
(hash-func hash-func)
(hash-test hash-test))
;; ハッシュ表の生成
(define (make-hash-table size func test?)
(create-hash (make-vector size '()) (lambda (x) (modulo (func x) size)) test?))
;; ハッシュ表のアクセス
(define (hash-table-ref ht n) (vector-ref (hash-table ht) n))
(define (hash-table-set! ht n x) (vector-set! (hash-table ht) n x))
;; 探索
(define (hash-find ht key)
(let ((pair (assoc key
(hash-table-ref ht ((hash-func ht) key))
(hash-test ht))))
(and pair (cdr pair))))
;; 挿入
(define (hash-set! ht key value)
(let ((i ((hash-func ht) key)))
(hash-table-set! ht
i
(cons (cons key value)
(hash-table-ref ht i)))))
;; 削除
(define (alist-delete key xs pred)
(cond
((null? xs) '())
((pred key (caar xs))
(alist-delete key (cdr xs) pred))
(else
(cons (car xs)
(alist-delete key (cdr xs) pred)))))
(define (hash-delete! ht key)
(let ((i ((hash-func ht) key)))
(hash-table-set! ht i (alist-delete key (hash-table-ref ht i) (hash-test ht)))))
;; 巡回
(define (hash-for-each fn ht)
(vector-for-each
(lambda (xs)
(for-each (lambda (p) (fn (car p) (cdr p))) xs))
(hash-table ht)))
))