リスト操作と高階関数の続きです。今回はちょっと便利な関数を紹介します。
最初は数列を生成する関数 iota と tabulate を作りましょう。iota は n から始まり step ずつ増加して m 以下で終わる数列を生成します。プログラムは次のようになります。
リスト 1 : 数列の生成
(defun iota (m &optional (n 1) (step 1))
(if (> n m)
nil
(cons n (iota m (+ n step) step))))
引数 n と step はオプショナル引数としましたが、キーワード引数にしてもよいでしょう。簡単な実行例を示します。
> (iota 10) (1 2 3 4 5 6 7 8 9 10) > (iota 5 0) (0 1 2 3 4 5) > (iota 5 0 0.5) (0 0.5 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.5 5.0)
iota を末尾再帰と繰り返しに変換すると次のようになります。
リスト 2 : 数列の生成 (2)
(defun iota1 (m &optional (n 1) (step 1))
(labels ((iter (n a)
(if (> n m)
(nreverse a)
(iter (+ n step) (cons n a)))))
(iter n nil)))
(defun iota2 (m &optional (n 1) (step 1))
(do ((i n (+ i step))
(a nil))
((> i m) (nreverse a))
(push i a)))
どちらの関数も累積変数 a に数値を格納し、nreverse でリストを反転して返します。とくに難しいところはないでしょう。
関数 tabulate は iota で生成した数列に関数 fn を適用した結果をリストに格納して返します。(mapcar fn (iota x)) と同じですが、この方法では iota で新しいリストを生成し、なおかつ mapcar で新しいリストを生成することになります。tabulate は数列を生成しながら関数 fn を適用するので、無駄なリストを生成することがありません。プログラムは次のようになります。
リスト 3 : 数列の生成 (3)
(defun tabulate (fn m &optional (n 1) (step 1))
(if (> n m)
nil
(cons (funcall fn n) (tabulate fn m (+ n step) step))))
tabulate は生成した数値 n に関数 fn を適用した結果をリストに格納するだけです。簡単な実行例を示します。
> (tabulate #'(lambda (x) (* x x)) 10) (1 4 9 16 25 36 49 64 81 100)
tabulate を末尾再帰と繰り返しに変換すると次のようになります。
リスト 4 : 数列の生成 (4)
(defun tabulate1 (fn m &optional (n 1) (step 1))
(labels ((iter (n a)
(if (> n m)
(nreverse a)
(iter (+ n step) (cons (funcall fn n) a)))))
(iter n nil)))
(defun tabulate2 (fn m &optional (n 1) (step 1))
(do ((i n (+ i step))
(a nil))
((> i m) (nreverse a))
(push (funcall fn i) a)))
今までと同じで、累積変数 a を使って結果をリストに格納し、それを nreverse で反転しています。とくに難しいところはないと思います。
ところで、iota や tabulate のようなリストを生成する関数は、次のように一般化することができます。
リスト 5 : 解きほぐし
(defun unfold (p f g seed &optional (tail-gen #'(lambda (x) nil)))
(if (funcall p seed)
(funcall tail-gen seed)
(cons (funcall f seed)
(unfold p f g (funcall g seed) tail-gen))))
(defun unfold-right (p f g seed &optional (tail nil))
(labels ((iter (seed acc)
(if (funcall p seed)
acc
(iter (funcall g seed) (cons (funcall f seed) acc)))))
(iter seed tail)))
関数 unfold と unfold-right は畳み込みを行う fold-right とfold-left の逆変換に相当する処理で、「解きほぐし」とか「逆畳み込み」と呼ばれています。unfold と unfold-right の仕様は Scheme のライブラリ SRFI-1 を参考にしました。
unfold は値 seed に関数 f を適用し、その要素をリストに格納して返します。引数 p は終了条件を表す関数で、p が真を返すときリストの終端を関数 tail-gen で生成して返します。一般に、tail-gen は nil を返すのが普通です。関数 g は seed の値を更新するために使用します。したがって、生成されるリストの要素は次のようになります。
( (f (g seed)) ; g を 1 回適用 (f (g (g seed))) ; g を 2 回適用 (f (g (g (g seed)))) ; g を 3 回適用 ... (f (g (g ... (g seed) ...))) ) ; g を n 回適用
リストの長さが n の場合、最後の要素は g を n 回適用し、その結果に f を適用することになります。unfold-right は生成されるリストの要素が unfold の逆になります。また、引数 tail は関数値ではなくリストの終端を表す値になります。
簡単な例を示しましょう。
> (unfold #'(lambda (x) (> x 10)) #'identity #'1+ 1) (1 2 3 4 5 6 7 8 9 10) > (unfold-right #'(lambda (x) (> x 10)) #'identity #'1+ 1) (10 9 8 7 6 5 4 3 2 1)
このように、unfold を使って iota を実現することができます。また、関数 identity のかわりに他の関数を渡すことで、関数 tabulate と同じ動作を実現できます。
もう一つ簡単な例を示しましょう。start から始まって増分値が step で合計値が sum 以上になる数列で、要素が最小個数となるものを求めます。次のリストを見てください。
リスト 6 : 合計値が sum 以上になる数列を求める
(defun unfold-sum (sum start &optional (step 1))
(unfold #'(lambda (x) (<= sum (car x)))
#'cdr
#'(lambda (x) (cons (+ (car x) (cdr x)) (+ (cdr x) step)))
(cons 0 start)))
関数名は unfold-sum としました。プログラムは簡単で、リストの要素を start から始めて step ずつ値を増やしていき、合計値が sum 以上になったらリストの生成を終了します。
リストの生成中には、要素の値とそれまでの合計値が必要になります。そこで、これらの値をコンスセルにまとめて unfold の seed に渡すことにします。CAR 部が合計値で、CDR 部が要素の値です。したがって、終了条件は引数の CAR 部が sum 以上になったときで、seed の更新は "CAR 部 + CDR 部" と "CDR 部 + step" の値を cons でまとめたものになります。
簡単な実行例を示します。
> (fold-left #'+ 0 '(1 2 3 4 5)) 15 > (unfold-sum 15 1) (1 2 3 4 5) > (unfold-sum 16 1) (1 2 3 4 5 6) > (fold-left #'+ 0 '(1 3 5 7 9)) 25 > (unfold-sum 25 1 2) (1 3 5 7 9) > (unfold-sum 26 1 2) (1 3 5 7 9 11)
要素の合計値がちょうど sum にならない場合もありますが、合計値は sum 以上で要素の個数は最小になっています。なお、合計値が sum 以下で、できるだけ sum に近い数列を生成することもできます。興味のある方はプログラムを作ってみてください。
ところで、unfold と unfold-right の seed は、数値だけではなくリストを渡すこともできます。たとえば、畳み込みを行う fold-right に cons を渡すと copy-list を実現できますが、解きほぐしを行う unfold で car と cdr を渡しても copy-list を実現することができます。
> (fold-right #'cons nil '(1 2 3 4 5)) (1 2 3 4 5) > (unfold #'null #'car #'cdr '(1 2 3 4 5)) (1 2 3 4 5)
また、unfold を使って関数 maplist を実現することもできます。次の例を見てください。
> (maplist #'identity '(1 2 3 4 5)) ((1 2 3 4 5) (2 3 4 5) (3 4 5) (4 5) (5)) > (unfold #'null #'identity #'cdr '(1 2 3 4 5)) ((1 2 3 4 5) (2 3 4 5) (3 4 5) (4 5) (5))
unfold で identity のかわりに他の関数を渡すと、maplist と同じ動作になります。
ちなみに、unfold と unfold-right を繰り返しに変換すると、次のようになります。なお、プログラムを簡単にするため、リストの終端は nil に固定しています。ご注意くださいませ。
リスト 7 : 解きほぐし (2)
(defun unfold (p f g seed)
(do ((x seed (funcall g x))
(acc nil))
((funcall p x) (nreverse acc))
(push (funcall f x) acc)))
(defun unfold-right (p f g seed)
(do ((x seed (funcall g x))
(acc nil))
((funcall p x) acc)
(push (funcall f x) acc)))
次は一つのリストを長さ n の部分リストに分ける関数 group を作ってみましょう。この処理はリストの先頭から n 個の要素を取り出す関数 take を作ると簡単です。次のリストを見てください。
リスト 8 : リストの分割 (1)
(defun take (n ls)
(if (or (zerop n) (null ls))
nil
(cons (car ls) (take (1- n) (cdr ls)))))
(defun group (n ls)
(if (null ls)
nil
(cons (take n ls) (group n (nthcdr n ls)))))
take はリスト ls の先頭から n 個の要素を取り出してリストに格納して返します。リストの長さが n 未満の場合は、リストをコピーして返すことになります。関数 group は take の返り値と group を再帰呼び出しした返り値を cons で連結するだけです。group を再帰呼び出しするときは、nthcdr で先頭から n 個の要素を取り除くことに注意してください。
それでは実行例を示します。
> (take 3 '(a b c d e f g h i)) (A B C) > (group 3 '(a b c d e f g h i)) ((A B C) (D E F) (G H I)) > (group 4 '(a b c d e f g h i)) ((A B C D) (E F G H) (I))
take と group を末尾再帰に変換すると次のようになります。
リスト 9 : リストの分割 (2)
(defun take1 (n ls)
(labels ((iter (n ls a)
(if (or (zerop n) (null ls))
(values (nreverse a) ls)
(iter (1- n) (cdr ls) (cons (car ls) a)))))
(iter n ls nil)))
(defun group1 (n ls)
(labels ((iter (ls a)
(if (null ls)
(nreverse a)
(multiple-value-bind
(xs ys)
(take1 n ls)
(iter ys (cons xs a))))))
(iter ls nil)))
どちらの関数も累積変数 a に要素を格納し、最後にそれを nreverse で反転します。関数 take1 は values を使って 2 つの値を返します。一つは取り出した要素を格納したリストで、もう一つが残りのリストです。これにより、関数 group1 で nthcdr を呼び出す必要がなくなります。group1 では multiple-value-bind で 2 つの値を xs, ys で受け取り、xs を累積変数 a の先頭に追加し、iter を再帰呼び出しするときは ys を渡します。
実行例は take と group と同じなので省略します。
次はリストを「木」として扱う関数を紹介します。ここでは、コンスセルが木の「節
node) 」でアトムが「葉 (leaf) 」と考えることにします。木を操作する関数も高階関数として簡単にプログラムすることができます。たとえば、葉に関数 fn を適用するマップ関数 maptree は次のようになります。
リスト 10 : 木のマップ関数
(defun maptree (fn ls)
(cond ((null ls) nil)
((atom ls) (funcall fn ls))
(t (cons (maptree fn (car ls))
(maptree fn (cdr ls))))))
引数 fn が葉に適用する関数、引数 ls が木を表すリストです。木を順番にたどっていき、ls が空リストならば nil を返します。アトムならば葉に到達したので、ls に fn を適用します。そうでなければ、ls を car と cdr で分解して maptree を再帰呼び出しして、その返り値を cons で結合します。
簡単な実行例を示します。
> (maptree #'identity '(a b (c d (e . f) g) h)) (A B (C D (E . F) G) H) > (maptree #'(lambda (x) (* x x)) '(1 2 (3 4 (5 . 6) 7) 8)) (1 4 (9 16 (25 . 36) 49) 64)
maptree に関数 identity を渡すと木をコピーすることができます。これは関数 copy-tree と同じ動作です。数値を 2 乗する関数を渡せば、葉の値を 2 乗した木を求めることができます。
リストと同様に、木を操作する関数も一般化することができます。次のリストを見てください。
リスト 11 : 汎用的な木の操作関数
(defun for-each-tree (fn comb term tree)
(cond ((null tree) term)
((atom tree) (funcall fn tree))
(t (funcall comb
(for-each-tree fn comb term (car tree))
(for-each-tree fn comb term (cdr tree))))))
引数 comb は節を結合する関数、term はリストの終端で返す値です。プログラムは簡単で、引数のリスト ls が空リストならば term を返します。ls がアトムであれば、ls に関数 fn を適用します。それ以外の場合は、リスト ls を car と cdr で分解して for-each-tree を再帰呼び出しし、その返り値を comb で結合します。
for-each-tree を使うと、木を操作する関数を簡単に作ることができます。簡単な例を示しましょう。
リスト 12 : for-each-tree の使用例
; マップ
(defun maptree (fn ls)
(for-each-tree fn #'cons nil ls))
; フィルター
(defun filter-tree (fn ls)
(for-each-tree #'(lambda (x) (if (funcall fn x) x))
#'(lambda (x y) (if (null x) y (cons x y)))
nil
ls))
; 平坦化
(defun flatten (ls)
(for-each-tree #'list #'append nil ls))
; 葉を数える
(defun count-leaf (ls)
(for-each-tree #'(lambda (x) 1) #'+ 0 ls))
; 合計値を求める
(defun sum-tree (ls)
(for-each-tree #'identity #'+ 0 ls))
maptree は for-each-tree の comb に cons を渡し、term に nil を渡すことで実現できます。filter-tree は葉に適用する関数で fn を呼び出し、返り値が真の場合はその要素を返します。そうでなければ nil を返します。そして、comb に渡す関数で、引数 x が nil の場合は引数 y をそのまま返し、そうでなければ (cons x y) を返します。これで真を返す要素を取り出すことができます。
平坦化を行う flatten も簡単です。葉に list を適用して、それを append で連結するだけです。葉を数える count-leaf は、葉に到達したら 1 を返す関数を渡して、それを + で加算するだけです。葉の合計値を求める sum-tree も簡単ですね。identity で葉の数値をそのまま返して + で加算するだけです。
それでは実行例を示します。
> (maptree #'(lambda (x) (* x x)) '(1 2 (3 4 (5 6 7 . 8) 9) 10)) (1 4 (9 16 (25 36 49 . 64) 81) 100) > (filter-tree #'evenp '(1 2 (3 4 (5 6 7 . 8) 9) 10)) (2 (4 (6 . 8)) 10) > (flatten '(1 2 (3 4 (5 6 7 . 8) 9) 10)) (1 2 3 4 5 6 7 8 9 10) > (count-leaf '(1 2 (3 4 (5 6 7 . 8) 9) 10)) 10 > (sum-tree '(1 2 (3 4 (5 6 7 . 8) 9) 10)) 55
正常に動作していますね。最後に、for-each-tree を CPS 化したプログラムを示します。
リスト 13 : for-each-tree の CPS 化
(defun for-each-tree-cps (fn comb term tree)
(labels ((iter (tree cont)
(cond ((null tree) (funcall cont term))
((atom tree) (funcall cont (funcall fn tree)))
(t (iter (car tree)
#'(lambda (x)
(iter (cdr tree)
#'(lambda (y)
(funcall cont (funcall comb x y))))))))))
(iter tree #'identity)))
ご参考までに。
今回は「たらいまわし関数」を例題にして、「メモ化」と「遅延評価」について説明します。なお、このドキュメントは拙作のページ Algorithms with Python 再帰定義 (たらいまわし関数) のプログラムを Common Lisp で書き直したものです。内容は重複していますが、ご了承くださいませ。
最初に「たらいまわし関数」について説明します。次のリストを見てください。
リスト 14 : たらいまわし関数
(defun tarai (x y z)
(if (<= x y)
y
(tarai (tarai (1- x) y z) (tarai (1- y) z x) (tarai (1- z) x y))))
(defun tak (x y z)
(if (<= x y)
z
(tak (tak (1- x) y z) (tak (1- y) z x) (tak (1- z) x y))))
関数 tarai や tak は「たらいまわし関数」といって、再帰的に定義されています。これらの関数は、引数の与え方によっては実行に時間がかかるため、Lisp などのベンチマークに利用されることがあります。
関数 tarai は通称「竹内関数」と呼ばれていて、日本の代表的な Lisper である竹内郁雄先生によって考案されたそうです。そして、関数 tak は関数 tarai のバリエーションで、John Macarthy によって作成されたそうです。たらいまわし関数が Lisp のベンチマークで使われていたことは知っていましたが、このような由緒ある関数だとは思ってもいませんでした。
それでは、さっそく実行してみましょう。実行環境は Windows XP, celeron 1.40 GHz, CLISP (version 2.44) です。
tarai 12 6 0 : 2.32 [s] tak 18 9 0 : 2.57 [s]
このように、たらいまわし関数は引数の値が小さくても実行に時間がかかります。
たらいまわし関数が遅いのは、同じ値を何度も計算しているためです。この場合、表 (table) を使って処理を高速化することができます。同じ値を何度も計算することがないように、計算した値は表に格納しておいて、2 回目以降は表から計算結果を求めるようにします。このような手法を「表計算法」とか「メモ化 (memoization または memoisation) 」といいます。
Common Lisp の場合、メモ化は Common Lisp 入門：ハッシュ表 を使うと簡単です。次のリストを見てください。
リスト 15 : たらいまわし関数のメモ化 (1)
; メモ用のハッシュ表
(defvar *table* (make-hash-table :test #'equal))
(defun tarai-memo (x y z)
(let* ((key (list x z y))
(value (gethash key *table* nil)))
(unless value
(if (<= x y)
(setf value y)
(setf value (tarai-memo (tarai-memo (1- x) y z)
(tarai-memo (1- y) z x)
(tarai-memo (1- z) x y))))
(setf (gethash key *table*) value))
value))
関数 tarai-memo の値を格納するハッシュ表をグローバル変数 *table* に用意します。関数 tarai-memo では、引数 x, y, z を要素とするリストを作り、それをキーとしてハッシュ表 *table* を検索します。*table* に key があれば、その値 value を返します。そうでなければ、値 value を計算して *table* にセットして、その値を返します。
ところで、ハッシュ表はローカル変数に格納することもできます。次のリストを見てください。
リスト 16 : たらいまわし関数のメモ化 (2)
(setf (symbol-function 'tak-memo)
(let ((table (make-hash-table :test #'equal)))
(labels ((tak (x y z)
(let* ((key (list x y z))
(value (gethash key table nil)))
(unless value
(if (<= x y)
(setf value z)
(setf value (tak (tak (1- x) y z)
(tak (1- y) z x)
(tak (1- z) x y))))
(setf (gethash key table) value))
value)))
#'tak)))
let でハッシュ表 table を定義します。その中で labels を使ってたらいまわし関数 tak を局所関数として定義します。局所関数 tak の処理内容は tarai-memo と同じですが、x <= y のときは z を返します。最後に #'tak を返します。この返り値をシンボル tak-memo にセットします。
拙作のページ Common Lisp 入門：属性リスト で簡単に説明しましたが、Common Lisp のシンボルは自分自身の名前、関数値、変数値、属性リストを格納することができます。関数 symbol-function はシンボルから関数値を取り出すことができます。そして、setf と symbol-function を組み合わせると、シンボルに関数値をセットすることができます。
簡単な例を示しましょう。
> (setf (symbol-function 'square) #'(lambda (x) (* x x))) #<FUNCTION :LAMBDA (X) (* X X)> > (square 5) 25
シンボル square の関数値にラムダ式 #'(lambda (x) (* x x)) をセットします。すると、defun で関数を定義するのと同じように square を呼び出すことができます。ラムダ式は変数ではなくシンボルの関数値にセットされているので、funcall で呼び出す必要はありません。
なお、ハッシュ表 table が生成されるのは、tak-memo に関数をセットするときの一回だけです。これで、その関数専用のハッシュ表を局所変数に用意することができます。
このように関数をメモ化することは簡単にできますが、メモ化を行うたびに関数を修正するのは面倒です。このような場合、関数をメモ化する「メモ化関数」があると便利です。メモ化関数については Structure and Interpretation of Computer Programs (SICP) 3.3.3 Representing Tables に詳しい説明があります。
プログラムは次のようになります。
リスト 17 : メモ化関数
(defun memoize (func)
(let ((table (make-hash-table :test #'equal)))
#'(lambda (&rest args)
(let ((value (gethash args table nil)))
(unless value
(setf value (apply func args))
(setf (gethash args table) value))
value))))
; たらいまわし関数
(defun tak (x y z)
(if (<= x y)
z
(tak (tak (- x 1) y z) (tak (- y 1) z x) (tak (- z 1) x y))))
(defun tarai (x y z)
(if (<= x y)
y
(tarai (tarai (- x 1) y z) (tarai (- y 1) z x) (tarai (- z 1) x y))))
; 関数値を書き換える
(setf (symbol-function 'tak) (memoize #'tak))
(setf (symbol-function 'tarai) (memoize #'tarai))
関数 memoize は関数 func を引数に受け取り、それをメモ化した関数を返します。memoize が返す関数はクロージャなので、memoize の引数 func や局所変数 table にアクセスすることができます。また、無名関数 lambda の引数 args は可変個の引数を受け取るように定義します。これで、複数の引数を持つ関数にも対応することができます。
args の値は引数を格納したリストになるので、これをキーとして扱います。ハッシュ表 table に値がなければ、関数 func を呼び出して値を計算し、それを table にセットします。そしで、最後に値を返します。
なお、シンボル tak と tarai の関数値を書き換えないと、関数 tak, tarai の中で再帰呼び出しするとき、メモ化した関数を呼び出すことができません。また、関数 tak, tarai をコンパイルするとき、関数値を書き換えてから行ってください。書き換える前にコンパイルすると、コンパイラの最適化機能 (末尾再帰最適化など) によりメモ化が機能しない場合があります。ご注意ください。
それでは実際に実行してみましょう。実行環境は Windows XP, celeron 1.40 GHz, CLISP (version 2.44) です。
tarai (192, 96, 0) : 0.75 [s] tak (192, 96, 0) : 2.50 [s]
このように、引数の値を増やしても高速に実行することができます。メモ化の効果は十分に出ていると思います。また、同じ計算を再度実行すると、メモ化の働きにより値をすぐに求めることができます。
関数 tarai は「遅延評価 (delayed evaluation または lazy evaluation) 」を行う処理系、たとえば関数型言語の Haskell では高速に実行することができます。また、Scheme でも delay と force を使って遅延評価を行うことができます。tarai のプログラムを見てください。x <= y のときに y を返しますが、このとき引数 z の値は必要ありませんね。引数 z の値は x > y のときに計算するようにすれば、無駄な計算を省略することができます。
なお、関数 tak は x <= y のときに z を返しているため、遅延評価で高速化することはできません。ご注意ください。
Common Lisp の場合、遅延評価は仕様 (CLtL2) にはありませんが、クロージャを使って遅延評価を行うことは簡単です。今回は Shiro さん の WiLiKi にある Scheme:たらいまわしべんち を参考に、プログラムを作ってみましょう。次のリストを見てください。
リスト 18 : クロージャによる遅延評価
(defun tarai-lazy (x y z)
(if (<= x y)
y
(let ((zz (funcall z)))
(tarai-lazy (tarai-lazy (1- x) y #'(lambda () zz))
(tarai-lazy (1- y) zz #'(lambda () x))
#'(lambda () (tarai-lazy (1- zz) x #'(lambda () y)))))))
遅延評価したい処理をクロージャに包んで引数 z に渡します。そして、x > y のときに引数 z の関数を呼び出します。すると、クロージャ内の処理が評価されて z の値を求めることができます。たとえば、#'(lambda () 0) を z に渡す場合、(funcall z) とすると返り値は 0 になります。#'(lambda () x) を渡せば、x に格納されている値が返されます。#'(lambda () (tarai-lazy ...)) を渡せば、関数 tarai-lazy が実行されてその値が返されるわけです。
それでは、実際に実行してみましょう。実行環境は Windows XP, celeron 1.40 GHz, CLISP (version 2.44) です。
tarai 192 96 0 closure : 0.083 [s]
実行時間が速いので、今回は tarai 192 96 0 を 10 回実行した時間から 1 回の実行時間を求めました。tarai の場合、遅延評価の効果はとても大きいですね。
ところで、クロージャを使わなくても、関数 tarai を高速化する方法があります。C++:language&libraries (cppll) で Akira Higuchi さん が書かれたＣ言語の tarai 関数はとても高速です。Common Lisp でプログラムすると次のようになります。
リスト 19 : tarai の遅延評価
(defun tarai (x y z)
(if (<= x y)
y
(tarai-lazy (tarai (1- x) y z) (tarai (1- y) z x) (1- z) x y)))
(defun tarai-lazy (x y xx yy zz)
(if (<= x y)
y
(let ((z (tarai xx yy zz)))
(tarai-lazy (tarai (1- x) y z) (tarai (1- y) z x) (1- z) x y))))
関数 tarai-lazy の引数 xx, yy, zz で z の値を表すところがポイントです。つまり、z の計算に必要な値を引数に保持し、z の値が必要になったときに (tarai xx yy zz) で計算するわけです。実際に実行してみると tarai 192 96 0 は 0.005 [s] になりました。Akira Higuchi さんに感謝いたします。
ところで、Scheme の delay と force は Common Lisp でもマクロを使って簡単に実装することができます。次のリストを見てください。
リスト 20 : delay と force
(defmacro delay (expr)
`(make-promise #'(lambda () ,expr)))
(defun make-promise (f)
(let ((flag nil) (result nil))
#'(lambda ()
(unless flag
(let ((x (funcall f)))
(unless flag
(setf flag t
result x))))
result)))
(defun force (promise)
(funcall promise))
リスト 20 は 参考文献 [1] に掲載されているプログラムを Common Lisp で書き直したものです。delay の引数 expr をクロージャに格納して関数 make-promis に渡します。make-promise はクロージャを生成して返します。このデータを Scheme では「プロミス」といいます。本稿では遅延オブジェクトと呼ぶことにします。force は簡単で、引数 promise を funcall で評価するだけです。
make-promise はクロージャを生成し、その中にクロージャ f の評価結果を格納します。flag が nil の場合は f を評価していないので、funcall で f を評価して、その返り値を result にセットし、flag の値を t に書き換えます。flag が t ならば f は評価済みなので result を返します。
簡単な使用例を示しましょう。
> (setq a (delay (+ 10 20))) #<COMPILED-FUNCTION MAKE-PROMISE-1> > (force a) 30
(delay (+ 10 20)) の返り値を変数 a にセットします。このとき、S 式 (+ 10 20) は評価されていません。遅延オブジェクトの値を実際に求める関数が force です。(force a) を評価すると、S 式 (+ 10 20) を評価して値 30 を返します。
また、遅延オブジェクトは式の評価結果をキャッシュします。したがって、(force a) を再度実行すると、同じ式を再評価することなく値を求めることができます。次の例を見てください。
> (setq b (delay (progn (princ "oops!") (+ 10 20)))) #<COMPILED-FUNCTION MAKE-PROMISE-1> > (force b) oops! 30 > (force b) 30
最初に (force b) を実行すると、S 式 (progn (princ "oops!") (+ 10 20)) が評価されるので、画面に oops! が表示されます。次に、(force b) を実行すると、式を評価せずにキャッシュした値を返すので oops! は表示されません。
delay と force を使うと、tarai は次のようになります。
リスト 21 : delay と force による遅延評価
(defun tarai (x y z)
(if (<= x y)
y
(let ((zz (force z)))
(tarai (tarai (1- x) y (delay zz))
(tarai (1- y) zz (delay x))
(delay (tarai (1- zz) x (delay y)))))))
関数 tarai の引数 z にデータを渡すとき、delay で遅延オブジェクトを生成します。そして、その値を取り出すときは (force z) とします。これで遅延評価を行うことができます。
それでは、実際に実行してみましょう。実行環境は Windows XP, celeron 1.40 GHz, CLISP (version 2.44) です。
tarai 192 96 0 closure : 0.22 [s]
delay と force は処理が複雑になる分だけ、クロージャを使った遅延評価よりも実行速度は遅くなるようです。それでも遅延評価の効果は十分に出ていると思います。