日々の流転

λ. "top-downのmemoization" と histomorphism

"top-downのmemoization" の一引数の場合というのは、V. Vene. Categorical programming with inductive and coinductive types.(2004-06-29の日記参照) の histomorphism に非常に近いなぁと思った。

まず、yts氏による定義は以下のようなものだった。

fib :: Int -> Int
fib = memo1 (
 xs -> case n of
        0 -> 0
        1 -> 1
        _ -> xs !! 1 + xs !! 2)
 
memo1 :: (Int -> [a] -> a) -> Int -> a
memo1 f n = head $ memos1 f n
 
memos1 :: (Int -> [a] -> a) -> Int -> [a]
memos1 f n = rs
  where 
    rs = m n rs
    m n ~xxs@(x:xs) = (f n xxs):m (n - 1) xs

これは少し複雑なので単純化する。 memos1 の f n xxs に注目すると、

• xxsの先頭要素は f n xxs 自身になっているが、この先頭要素は普通使われないので、xxs の代わりに xs を渡すことにしよう。
• 負の定義域を考慮しているためか、xsは無限リストになっている。定義域を自然数に限定してxsを有限のリストにしてしまおう。
• そうすると、xsの長さからnの情報が復元できるので、nもパラメータとして渡す必要はない。

そうして単純化して少し書き換えると、以下の様な定義が得られる。

fib :: Int -> Int
fib = histo phi
    where phi []      = 0
          phi [_]     = 1
          phi (a:b:_) = a+b
 
histo :: ([a] -> a) -> (Int -> a)
histo phi = head . f
    where f 0     = phi [] : []
          f (n+1) = phi xs : xs
              where xs = f n

正確な定義は省くが、このfibのように定義されている関数はhistomorphismと呼ばれる。これは(Intで表現された)自然数に関するhistomorphismだけど、histomorphismの概念はリストや木といった帰納的なデータ型一般に適用することが出来る。前述の V. Vene. Categorical programming with inductive and coinductive types. ではpolytypicなhistoを使ってfibを以下のように定義していた。これも詳細は省くけど、対応しているのが分かると思う。

fib :: Nat -> Int
fib = histo phi
    where phi Z = 0
          phi (S x) = case tlCV x of
                      Z   -> 1
                      S y -> hdCV x + hdCV y

(2005-09-04 追記) ちなみに、Category extras パッケージ を用いると以下のようになる。やっていることは同じなのだけど、histoの型が「Fixpoint f t => (f (Strf f a) -> a) -> t -> a」になっていて、また「instance Fixpoint Maybe Int」と定義されているので、引数の型がNatではなくIntになっている。

import Control.Recursion
import Data.BranchingStream
 
fib :: Int -> Int
fib = histo phi
    where phi Nothing  = 0
          phi (Just x) = case tlf x of
                         Nothing -> 1
                         Just y  -> hdf x + hdf y