Ads by Google
新しい記事を書く事で広告が消せます。
私は知識に何ものかを付け加え,また他の人々がより多くのものを付け加える手助けをした --- G.H.ハーディ
///////////////////////////////////////////////////////////////////////////////
// 【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).
[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]
コメント