今回は「たらいまわし関数」を例題にして、「メモ化」と「遅延評価」について簡単に説明します。
最初に「たらいまわし関数」について説明します。次のリストを見てください。
リスト : たらいまわし関数
(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)))
))