メモライズ

Haskell

漸くたまっていたものを吐き出せる時が来た。
そういうわけで、まずは軽い話題から。


今回はHaskellでメモライズを行う方法。
Haskellは遅延評価でグラフ簡約なのでメモライズとの親和性は
良いように思うのだが、実際にやろうとすると自力では方法を見出せなかった。
極めて直接的な方法はCなどでやるように配列にデータを突っ込む方法であるが、
あえてHaskellで配列を使用してそれに書き込んだりしてそういうことを
行うのは非常にばかげているようなことのように感じる。


そういうわけで、どないしようかと思っていると
Cleanのマニュアル(だったかどうかは忘れたが)にやり方が載っていた。
それがまた極めて簡潔、極めて技巧的なもんで驚いてしまった。
まぁ、知ってしまうと難しくもなんとも無いのだが…。


やり方はおおよそあの有名なHaskellでのフィボナッチ数列のコードと類似している。
実際のところそれの一般化のようになっている。

fib = 1:1:zipWith (+) fib (tail fib)

これはfibのn要素目がそれの1個下と2個下の和であるという定義である。
尤も、もっと直接的な定義は次のようである。

fib 0 = 1
fib 1 = 1
fib n = fib (n-1) + fib (n-2)

この定義はfibが1引数、nは最初に渡した数を超えることは無いので、
DPを持ち出すまでもなくメモライズでメモリ空間O(n)、時間O(n)の消費で計算できることになる。
にもかかわらず、式の簡約結果はどこかに保持されるわけではないので
これをこのまま評価するとメモライズは行われず計算時間はO(n^2)かかることになる。


ではどうすればよいのか。
計算が失われてしまうなら全部明示的に保持してしまえばよい。

fibTbl = [ fib n | n <- [1..] ] where
  fib 0 = 1
  fib 1 = 1
  fib n = fibTbl !! (n-1) + fibTbl !! (n-2)

このように書くとfibTblへの任意の参照が計算のトリガーとなり、
必要最小限の計算が行われる。
fibTblの値は一度しか計算されなので、メモライズできる。


この方法のCなど普通に配列を用いて行うメモライズに対する
アドバンテージは明らかである。すなわち、テーブルのサイズをあらかじめ指定する必要が無い。
これにより、インデックスのレンジを正確に推定する必要が無くなる。


次にこれを一般化することを考えてみる。
行いたい計算各々についてメモライズをすれば良いといえば良いのだが、
一般化できるともう少し嬉しい。


まず、簡単なレベルから。任意のInt->Intな関数をメモライズしてみよう。
想定する関数は

memolize :: (Int -> Int) -> (Int -> Int)

である。
これはそんなに難しくなくて

memolize f = \x -> tbl !! x where
  tbl = map f [0..]

…では良くない。
fがtblを使っていないからである。
少し変更して

memolize :: ( (Int -> Int) -> (Int -> Int)) -> (Int -> Int)
memolize f = (tbl!!) where
  tbl = map (f (tbl!!)) [0..]

このようにすればよいだろうか。
渡す関数はfix(不動点演算子)を用いた再帰的定義と同じような感じで。

fib = memolize $ \f n ->
  case n of
    0 -> 0
    1 -> 1
    n -> f (n-1) + f (n-2)

これでfibの呼び出しがメモライズできる。


一般化をもう少し進めてみる。
インデックスがIntなのがかなりの制約であるので、
これをIxクラスのインスタンスを取れるようにしてみる。

memolizeI :: Ix i => (i,i) -> ( (i -> a) -> (i -> a)) -> (i -> a)
memolizeI r f i = tbl !! index r i where
  tbl = map (f (\i -> tbl !! index r i)) $ range r

これを用いるとアッカーマン関数は

ack = memolizeI ( (0,0),(100,100)) $ \a (m,n) ->
  case (m,n) of
    (0,n) -> n+1
    (m,0) -> a (m-1,1)
    _     -> a (m-1,a (m,n-1))

このように書ける。
最初にmemolizeIに渡している( (0,0),(100,100))はあらかじめ用意する
リストのレンジである。
一般化したつもりが大きな制約が一つ増えてしまった。
これは一般のIxクラスについてEnumerateが定義できないからであるので
仕方が無いといえば仕方が無い。
これを嫌うならむりやり任意のインデックスのIntへのエンコード/デコードを
用意して最初のmemolizeを使わないといけないだろう。
しかし、その場合も、うまくやらないと引数の片側に範囲が決まってしまうことになるのだが。
ちなみに上のアッカーマン関数であるが、大きな数に対しては
無論レンジが全然足りないのでほとんど小さな数に対してしか計算できない。
さらにもう一つこの実装の欠点としてはリストが長くなったときの
配列の参照時間である。これのせいで計算のオーダーが一個上がってしまっているかもしれない。
しかしそれは遅延配列でも使えば何とかなるかもしれない。


というわけで、このようなものを書くだけ書いても仕方が無いので、
なにか簡単なDP問題でも解いてみることにする。
いつものacm.uva.esより10590番、
http://acm.uva.es/p/v105/10590.html
任意の自然数を自然数で表す方法の数を求めよという問題。
例えば、4なら
1+1+1+1
1+1+2
1+3
2+2
4
の5通りが存在する。


解法であるが、
n以下の数を用いてmを作る場合の数。
を考えれば自ずと分かる。
つまり、この関数をf n m とすると

f n m | n == 1 = 1
      | otherwise = sum [f (n-1) (m-i) | i <- [0,n..m] ]

と表せる。
n,mともに減る一方。0以上であるので。
これらの組み合わせは高々5000^2なのでDPできる。
(ただし、これ、答えがむちゃくちゃ大きくなるので長整数が扱える必要あり。
Haskellだと何も問題無いけどね〜)


というわけで、式が出来たので先のmemolizeを用いて実装してみる。

main = getContents >>= mapM_ (print.solve.read) . words

solve :: Int -> Integer
solve x = inner (x,x) where
  inner = memolizeI ( (0,0),(5000,5000)) $ \f (n,m) ->
    case (n,m) of
      (1,_) -> 1
      (n,m) -> sum [f (n-1,m-i) | i <- [0,n..m] ]

これでOKである。
…が、パフォーマンスがよろしくない。
大き目の数を入れると帰ってこなくなる。
memolizeをリストでなく配列で実装すると

memolizeIA :: Ix i => (i,i) -> ( (i -> a) -> (i -> a)) -> (i -> a)
memolizeIA r f i = arr ! i where
  arr = listArray r $ map (f (arr !)) $ range r

このようなものが出来たが、
今度はものすごい勢いでメモリが消費されてしまう。
確かに25万要素の遅延計算を保持するとそれなりにメモリが
たくさんいるかもしれない。


そういうわけで、パフォーマンスについては
もう少し考えないといけないようである。
(メモライズなのでパフォーマンスが出ないと意味が無いような気も…)