Y箱

 
これまでもPEを解いていて、memoize関数によるメモ化が効いていないなぁと思うことが何度かあったのだけれど、そのままにしてあった。
でも、Problem 57 を解いているときにこれを解決しないと問題が解けないことが判明。
ちょっと調べてみたら、memoizeが思ったようなmemoizeをしていないことがわかって、僕の思うようなmemoizeをしてくれる関数を作る新しいマクロを作って解決。

なので、そのことについて。


たとえば、フィボナッチ数を求める関数。(実験のためにプリント文を仕込んである。)

;;
(defn fib [n]
  (do
     (println "-->" n)
     (if (<= n 1)
        n
        (+ (fib (dec n)) (fib (- n 2))))))
;;

メモ化する前に実行するとこんな感じ

user> (fib 4)
--> 4
--> 3
--> 2
--> 1
--> 0
--> 1
--> 2
--> 1
--> 0
3

行き着くところまでネストしていく様子が見えます。 さて、これを、memoize関数でメモ化します。

(def fib (memoize fib))

で、実行してみます。

user> (fib 4)
--> 4
--> 3
--> 2  ※
--> 1
--> 0
--> 1
--> 2  ★
--> 1
--> 0
3

続けて (fib 4) を実行すると、

user> (fib 4)
3

ちゃんとメモ化してるじゃん....じゃない!

ってことで、長くなるので
続きました。


最初のときの出力を見てほしい。★のところは、(fib 2) が呼ばれているんだけど、これは※のところですでに一度呼ばれているからメモ化が効くべきで、この先には行って欲しくない。ほかの (fib 1) (fib 0)も同様。

さらに(fib 5)をやってみるともっとがっかり。

user> (fib 5)
--> 5
--> 4
--> 3
--> 2
--> 1
…略…

おいおい。(fib 4) も (fib 3)もわかってるんだから、ぱっと出せよ…。

計算を始めちゃうと、それまでにメモされている情報にアクセスできていないってことですね。
これじゃあメモ化っていってもねぇ。だめじゃん。

ということで、この実装では、フィボナッチ数列のような漸化式型のテータの生成には使えないってことがわかりました。

素数判定みたいに、前の結果が関係ないものについてなら有効でしょうけど。

これじゃあ問題が解けないんで、ソースを見て考えた。 原因は、メモ化のためのメモ領域が関数の外にあることだと推測した。

memoizeのソースは下のもので、メモ化したい関数を引数「f」で与えるとメモ化された関数が返る。

(defn memoize [f]
  (let [mem (atom {})]
    (fn [& args]                           ;; あ
      (if-let [e (find @mem args)]
        (val e)
        (let [ret (apply f args)]          ;; い
          (swap! mem assoc args ret)  
          ret)))))

memoizeは「あ」のところで新しい関数をつくって、メモ領域の処理と「f」をラップして返している。
さて、再帰は「い」の「f」の中で行なわれているわけだけど、その中で呼びだされるのはあくまで「f」であって、memoizeで作成された関数ではないわけ。「f」からこいつを呼べればいいのだけれど、そんなことは不可能。

解決するには、メモ化したい関数とメモ領域を同じクロージャに入れればよい。

ということで、どっかを探せば誰かが作ってるとは思うけど、メモ化した関数を定義するマクロを作ってみた。実験のために、メモを消去する関数とメモの中身を表示する関数も一緒につくるようにした。

;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; create memoised func

(defmacro defn-memo 
  "Creates memoised function, and accessor of the memo which named -data,
   memo deletion function named -clear"
  [name arg-list & body]
  `(let [mem# (atom {})]

     (defn ~(symbol (str (str name) "-data")) []
       @mem#)

     (defn ~(symbol (str (str name) "-clear")) []
       (reset! mem# {}))

     (defn ~name ~arg-list
       (if-let [e# (find @mem# ~arg-list)]
          (val e#)
          (let [ret# ~@body]
              (swap! mem# assoc ~arg-list ret#)
              ret#))))))
;;

最後のやつが関数の実体。
このように、関数が呼び出されたあとにメモの中を見るようにしておけば、再帰的に呼ばれたときにも、過去の情報にアクセスできる。

使いかたは普通のdefnと同じ。単にdefnをdefn-memoに書き替える。

;;
(defn-memo mem-fib [n]
  (do
     (println "-->" n)
     (if (<= n 1)
        n
        (+ (mem-fib (dec n)) (mem-fib (- n 2))))))

使ってみる

user> (mem-fib 4)
--> 4
--> 3
--> 2
--> 1
--> 0
3

変っていないようだけど、メモ化してないバージョンと比べると、
 

user> (fib 4)
--> 4
--> 3
--> 2
--> 1
--> 0
--> 1 ★
--> 2
--> 1
--> 0
3

mem-fibは★以降の計算で前の値にヒットしているからその先を計算していないことがわかる。 さらに(fib 5) とかやってみると、 差は歴然。

user> (mem-fib 5)
--> 5
5

user> (fib 5)
--> 5
--> 4
--> 3
--> 2
--> 1
--> 0
--> 1
--> 2
--> 1
--> 0
--> 3
--> 2
--> 1
--> 0
--> 1
5

めでたしめでたし。


メモの中身は、mem-fib-data でアクセスできます。 atomなので、その気になれば変更できます。

user> (mem-fib-data)
{[5] 5, [4] 3, [3] 2, [2] 1, [0] 0, [1] 1}

消すこともできます。

user> (mem-fib-clear)
{}
user> (mem-fib-data)
{}

消しちゃうと、

user> (mem-fib 5)
--> 5
--> 4
--> 3
--> 2
--> 1
--> 0
5

計算しなおす。

ただ、メモ化したとはいえ、未計算のところは計算しなくちゃならなくて、定義が末尾再帰になってないから、このまま大きな数を求めようとするとスタックを食いつぶしてエラーになったりします。

(mem-fib 10000) ;; やっちゃだめ

こういう場合は、

(last (map mem-fib (range 10001)))

みたいにやる。(printlnを取っておかないと...)

user> (time (last (map mem-fib (range 10001))))
"Elapsed time: 60.550712 msecs"
33644764876431783266 … 7366875

たぶん、memoizeしたfibで同じことをやっても思ったようにはうごかない。

(last (map fib (range 10001)))

データはatomだから、pmapでも大丈夫。

user> (time (last (pmap mem-fib (range 10001))))
"Elapsed time: 227.005108 msecs"
33644764876431783266 …

でも、早くない。前に書いたように、1つずつ別プロセスでやってしまうとオーバーヘッドが増えちゃってだめ。