メモ化 （ET 版）

k.inaba さんが振ったネタが，いろいろなところで話題になっているみたいです．面白そうなので，私も参加．言語はもちろん ET です．

///////////////////////////////////////////////////////////////////////////////
// 【fib.etr】
//
// 再帰的に定義されたフィボナッチ数を求めるルールを，
// メモ化を用いて効率的に計算するプログラム
///////////////////////////////////////////////////////////////////////////////

///////////////////////////////////////////////////////////////////////////////
// ・処理結果のメモ化ルール (fib-maker *n (*n 番目のフィボナッチ数の答え))
// 通常の再帰計算が終わったあと，その結果を基にして
// (fib 40 *x) --> (= *x 165580141).
// のような，計算結果をいきなり返すルールを追加する．
// これにより，2 回目以降は劇的に再帰計算が減る
///////////////////////////////////////////////////////////////////////////////
(fib-maker *n *x)
-->
// 処理結果からルールを表す文字列の作成
(sprintf *str "(fib %d *x) --> (= *x %d)." (*n *x)),
// 文字列を S 式に変換
(srread *str *r),
// 現在のワールドの識別子を取得
(getWorldID *w),
// 現在のワールドにルールを追加
// 第三引数は，ルールの追加場所
// 再帰ルールよりも，メモしたルールの方を優先的に使って
// 欲しいので，先頭 (0 番目) に追加する
(addRule *w *r 0 ?),
// 追加したルールを反映
(rebuildRules).

// フィボナッチ数列の定義
(fib *n *x), {(<= *n 1)} --> (= *x 1), (fib-maker *n *x).
(fib *n *x), {(>= *n 2)}
--> (:= *n1 (- *n 1)), (fib *n1 *x1),
(:= *n2 (- *n 2)), (fib *n2 *x2),
(:= *x (+ *x1 *x2)), (fib-maker *n *x).

コメントを除けば，わずか 3 行のプログラムですね．

このような，途中経過を節やルールの形で追加し，プログラムを書き換えてゆくという自己書き換えプログラミングは，Prolog などの Logic Programming の世界では古くからよく使われてきた十八番テクニックです．

一回目の実行の前には，

[D]>dr
(fib-maker *A *B)-->(sprintf *C "(fib %d *x) --> (= *x %d)." (*A *B)), (srread *C *D), (getWorldID *E), (addRule *E *D 0 *F), (rebuildRules).
(fib *G *H),{(<= *G 1)}-->(= *H 1), (fib-maker *G *H).
(fib *I *J),{(>= *I 2)}-->(:= *K (- *I 1)), (fib *K *L), (:= *M (- *I 2)), (fib *M *N), (:= *J (+ *L *N)), (fib-maker *I *J).

これしかルールは存在しないので，一つ一つナイーブに計算してゆくしかありません．

しかし，一回目の処理の終了後には，

[D]>(fib 40 *x)
-------------------------D execution ---------------------
----------------------------------------------------------
succeeded.
(fib 40 165580141)
execution time: 38 [msec]

[D]>dr
(fib 40 *A)-->(= *A 165580141).
(fib 39 *B)-->(= *B 102334155).
(fib 38 *C)-->(= *C 63245986).
(fib 37 *D)-->(= *D 39088169).
(fib 36 *E)-->(= *E 24157817).
(fib 35 *F)-->(= *F 14930352).
(fib 34 *G)-->(= *G 9227465).
(fib 33 *H)-->(= *H 5702887).
(fib 32 *I)-->(= *I 3524578).
(fib 31 *J)-->(= *J 2178309).
(fib 30 *K)-->(= *K 1346269).
(fib 29 *L)-->(= *L 832040).
(fib 28 *M)-->(= *M 514229).
(fib 27 *N)-->(= *N 317811).
(fib 26 *O)-->(= *O 196418).
(fib 25 *P)-->(= *P 121393).
(fib 24 *Q)-->(= *Q 75025).
(fib 23 *R)-->(= *R 46368).
(fib 22 *S)-->(= *S 28657).
(fib 21 *T)-->(= *T 17711).
(fib 20 *U)-->(= *U 10946).
(fib 19 *V)-->(= *V 6765).
(fib 18 *W)-->(= *W 4181).
(fib 17 *X)-->(= *X 2584).
(fib 16 *Y)-->(= *Y 1597).
(fib 15 *A1)-->(= *A1 987).
(fib 14 *B1)-->(= *B1 610).
(fib 13 *C1)-->(= *C1 377).
(fib 12 *D1)-->(= *D1 233).
(fib 11 *E1)-->(= *E1 144).
(fib 10 *F1)-->(= *F1 89).
(fib 9 *G1)-->(= *G1 55).
(fib 8 *H1)-->(= *H1 34).
(fib 7 *I1)-->(= *I1 21).
(fib 6 *J1)-->(= *J1 13).
(fib 5 *K1)-->(= *K1 8).
(fib 4 *L1)-->(= *L1 5).
(fib 3 *M1)-->(= *M1 3).
(fib 2 *N1)-->(= *N1 2).
(fib 0 *O1)-->(= *O1 1).
(fib 1 *P1)-->(= *P1 1).
(fib-maker *Q1 *R1)-->(sprintf *S1 "(fib %d *x) --> (= *x %d)." (*Q1 *R1)), (srread *S1 *T1), (getWorldID *U1), (addRule *U1 *T1 0 *V1), (rebuildRules).
(fib *W1 *X1),{(<= *W1 1)}-->(= *X1 1), (fib-maker *W1 *X1).
(fib *Y1 *A2),{(>= *Y1 2)}-->(:= *B2 (- *Y1 1)), (fib *B2 *C2), (:= *D2 (- *Y1 2)), (fib *D2 *E2), (:= *A2 (+ *C2 *E2)), (fib-maker *Y1 *A2).

と，このように，大量のルールがキャッシングされているので，二回目の処理は一瞬．一回のルール適用で済みます (^-^)

[D:D]>(fib 40 *x)
-------------------------D execution ---------------------
---------------
(fib 40 *A) <-- (fib 40 *A)
---------------
(fib 40 *A) <-- (= *A 165580141)
SUCC
----------------------------------------------------------
succeeded.
(fib 40 165580141)
execution time: 10 [msec]