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

[Narita Takaoki]

成田です。

> sumim です。
> 
> まだ流れを追いきれていないので、Smalltalk的に書き直せていませんが、
> とりあえず成田さんのCLのコードをSmalltalkで動くよう直訳してみました。

おお、すばらしい・・・
ストレートに移すと、やっぱりブロックだらけになりますよね。

> ...流れ

じっくり見れば分かるでしょうから、解説もいらないとは思いますが、考え方の
解説をおこがましくも一応してみます。

大枠は、特定の条件を満たした繰り返し作用に対する「逐次平方」の適用で
す。フィボナッチ数列への適用は、フィボナッチと逐次平方でググると出てくる
かな？

;; SICP もキーワードにすると良いかも？

逐次平方を簡単にみるなら、フィボナッチ数列の場合では、二行行列でフィボ
ナッチ数列の第１項(= 1)、第０項(= 0)を要素とするものを f_1 として、二行二
列の行列 T を考え、その要素を

    t_1_1 := 1      t_1_2 := 1
    t_2_1 := 1      t_2_2 := 0

とします。そうするとフィボナッチ数列の定義は、

　f_n := T * f_n-1, n > 1

で与えられるので、

　f_n := (T^n) * f_1

に持ち込め、T^n の計算ができればよろしくなります。

冪の形になっているので、

　T^n = if  n is even then (T^{n/2})^2 else (T^{n-1}) * T.

を用いて、n が 1 になるまで分解して計算すると、T^n が求まり、計算量は
O(log(n)) になります。これをストレートに Common Lisp で書くと、

(defun sequential-square (f n x)
  (cond ((= n 1) x)
        ((evenp n) (let ((fn (sequential-square f (/ n 2) x))) (funcall f fn fn)))
        (t (funcall f x (sequential-square f (1- n) x)))))

(defun fibonacci (n)
  (car (sequential-square  ;; car は、f_1 と掛けて、f_n を取り出すのと一緒。
         (lambda (x y)  ;; このラムダ式は行列の掛け算もどきです。
           (let ((a (car x)) (b (cadr x)) (c (caddr x)) (d (cadddr x))
                 (m (car y)) (n (cadr y)) (l (caddr y)) (o (cadddr y)))
             (list (+ (* a m) (* b l)) (+ (* a n) (* b o)) (+ (* c m) (* d l))
                   (+ (* c n) (* d o)))))
         (1- n)
         '(1 1 1 0)))) ;; (t_1_1  t_1_2  t_2_1  t_2_2) で代用して２行２列行列を表現。

こんなところでしょうか。ここまでが、逐次平方の骨子です。

ちなみに、T * (T * T) も (T * T) * T も同じであるのですが、これが逐次平方を適用
するための「特定の条件」かな？

先に示した大げさな一般化を施した版は、行列の代わりにもうすこし一般性のある
線形関数による合成関数を想起して、合成関数演算を composition-op としてみ
たものです。composition-op は丁度 T に対する * の一般化でしょうか。fibo は、
T そのものにあたることになります。

となるとですね・・・sequentialSquare や compositionOp をメソッド化するとすると
Block クラスでしょうか・・・はてさて？

まあ、鷲見さんの書かれてたものに比べ、数学的発想（？）で対処しているので
Smalltalk の仕掛けで面白く・・という方向じゃないですねぇ・・・

;;; プログラミング発想だとメモ化とかストリーム化とかになるのでしょう・・・

> Squeak4.1とVisualWorks7.7で動作します。
> 
> 
> | sequentialSquare compositionOp fibo fibonacci |
> 
> sequentialSquare := nil.
> sequentialSquare := [:compOp :operator :n |
>    n < 1 ifTrue: [nil] ifFalse: [
>    n = 1 ifTrue: [operator] ifFalse: [
>    n > 1
>       ifTrue: [
>          n odd ifTrue: [
>             compOp
>                value: (sequentialSquare
>                   value: compOp value: operator value: n - 1)
>                value: operator]
>       ifFalse: [
>          | sqOp |
>          sqOp := sequentialSquare
>             value: compOp value: operator value: n / 2.
>          compOp value: sqOp value: sqOp]]]]].
> 
> compositionOp := [:func1 :func2 |
>    [:x | func1 value: (func2 value: x)]].
> 
> fibo := [:x | Array with: x first + (x at: 2) with: x first].
> 
> fibonacci := [:x |
>    x < 1 ifTrue: [nil] ifFalse: [
>    x = 1
>       ifTrue: [1]
>       ifFalse: [
>          ((sequentialSquare
>                value: compositionOp value: fibo value: x - 1)
>             value: #(1 0)) first]]].
> 
> fibonacci value: 1000
> 
> 
> 2010年12月14日17:11 Narita Takaoki <Narita.Takaoki ＠ exc.epson.co.jp>:
> > 成田です。
> >
> >> sumim こと鷲見です。
> >>
> >> 連想計算でもリフレクティブでもないので恐縮ですが、
> >> にぎやかしにと、２つほど考えてみました。
> >
> > 同様にぎやかしですが、それどころか Smalltalk にもなってません。
> >
> > これを Smalltalk 的に書くとしたら？で詰まってしまった・・・
> > Common Lisp で書いてしまいましたが：
> >
> > (defun sequential-square (comp-op operator n)
> >  (assert (integerp n) (n)) ;; 本質には関係しないので無視してください。
> >  (cond ((< n 1) nil)
> >        ((= n 1) operator)
> >        ((> n 1)
> >         (cond ((oddp n)
> >                (funcall comp-op
> >                 (sequential-square comp-op operator (1- n)) 
> operator))
> >               ('t
> >                (let
> >                 ((sq-op (sequential-square comp-op operator 
> (/ n 2))))
> >                 (funcall comp-op sq-op sq-op)))))))
> >
> > (defun composition-op (func1 func2)
> >  (lambda (x) (funcall func1 (funcall func2 x))))
> >
> > (defun fibo (x) (list (+ (car x) (cadr x)) (car x)))
> >
> > (defun fibonacci (x)
> >  (cond ((< x 1) nil)
> >        ((= x 1) 1) ;; かなりインチキ
> >        ('t
> >         (car
> >          (funcall
> >           (sequential-square #'composition-op #'fibo (1- x)) '(1 
> > 0))))))
>