[SML 7870] 連想計算というリフレクティブな手法

[AOKI Atsushi]

青木＠京都上賀茂です。

フィボナッチ数を求めるプログラムは、通常、以下のようになりま
すが、40ぐらいのフィボナッチ数を求めるあたりから、ものすごい
手間がかかりだします。2のn乗のオーダーで計算量が増加です。

------------------------------------------------------------

Core.Integer methods for 'mathematical functions'

fibonacci
    "12 fibonacci."
    "40 fibonacci."

    self negative ifTrue: [^nil].
    self = 0 ifTrue: [^0].
    self = 1 ifTrue: [^1].
    ^(self - 1) fibonacci + (self - 2) fibonacci

------------------------------------------------------------

それを軽減するためには、連想計算というリフレクティブな手法を
用いるのが効果的であることが知られています。本日、学生とペア
プログラミングしながら作りましたので、それを紹介しておきます。

------------------------------------------------------------

Core.Integer methods for 'mathematical functions'

fibonacci
    "12 fibonacci."
    "100 fibonacci."

    | aValue aCode aString anIndex |
    self negative ifTrue: [^nil].
    self = 0 ifTrue: [^0].
    self = 1 ifTrue: [^1].
    aValue := (self - 1) fibonacci + (self - 2) fibonacci.
    [aCode := Integer sourceCodeAt: #fibonacci.
    aString := 'aValue :='.
    (anIndex := aCode findString: aString startingAt: 1) > 0
        ifTrue:
            [| aStream |
            aStream := (String new: aCode size + 1024) writeStream.
            [(1 to: anIndex - 1) do: [:index | aStream nextPut: (aCode at: index)].
            aStream
                nextPutAll: 'self = ';
                nextPutAll: self printString;
                nextPutAll: ' ifTrue: [^';
                nextPutAll: aValue printString;
                nextPutAll: '].';
                crtab.
            (anIndex to: aCode size) do: [:index | aStream nextPut: (aCode at: index)].
            aCode := aStream contents] ensure: [aStream close].
            Integer compile: aCode classified: #'mathematical functions']]
        on: Object errorSignal
        do: [:anException | anException return].
    ^aValue

------------------------------------------------------------

プログラムの実行中に、その実行中のプログラム自身を書き換えて
（コンパイルし直して）います。まさに動的な（フルな）リフレク
ションになりますでしょ。100ぐらいのフィボナッチ数も平気です。

もっといいやり方がありますので、皆さんで模索してくださいませ。
参考のため、じゅんのLisp版とProlog版も添えておきます。

------------------------------------------------------------

(defun fibonacci (n)
  (cond ((not (integerp n)) nil)
        ((< n 0) nil)
        ((= n 0) 0)
        ((= n 1) 1)
        (t (+ (fibonacci (- n 1))
              (fibonacci (- n 2))))))

------------------------------------------------------------

(defun fibonacci (n)
  (cond ((not (integerp n)) nil)
        ((< n 0) nil)
        ((= n 0) 0)
        ((= n 1) 1)
        (t (do (value assertion condition target clauses)
             (setq value (+ (fibonacci (- n 1))
                            (fibonacci (- n 2)))
                   assertion (list (list '= 'n n) value)
                   condition (nth 4 (getprop 'fibonacci 'expr))
                   target (last condition)
                   clauses (list (car target)))
             (rplaca target assertion)
             (rplacd target clauses)
             value))))

------------------------------------------------------------

fibonacci(0,0).
fibonacci(1,1).
fibonacci(N,F) :-
        integer(N),
        >(N,1),
        -(N,1,N1),
        -(N,2,N2),
        fibonacci(N1,A1),
        fibonacci(N2,A2),
        +(A1,A2,F).

------------------------------------------------------------

fibonacci(0,0).
fibonacci(1,1).
fibonacci(N,F) :-
        integer(N),
        >(N,1),
        -(N,1,N1),
        -(N,2,N2),
        fibonacci(N1,A1),
        fibonacci(N2,A2),
        +(A1,A2,F),
        asserta([fibonacci(N,F) :- !]).

------------------------------------------------------------
AOKI Atsushi          http://www.cc.kyoto-su.ac.jp/~atsushi/