読者です 読者をやめる 読者になる 読者になる
ようこそ。睡眠不足なプログラマのチラ裏です。

メモ〜化したりスマス。 Memoization and Tail Recursive Function

F#2.0 F# F# Advent Calendar jp 2010 メモ化 末尾再帰


のぶひささん(id:Nobuhisa)が、魔法的メモ化関数を書いてくださいました。
めもりんこ - (hatena (diary ’Nobuhisa))


非常にふつくしいので、ぜひご覧になってください。




このエントリは「F# Advent Calendar jp 2010」第16回のものです。

F# Advent Calendar jp 2010とは

のぶひささん(id:Nobuhisa)発案のF#を盛り上げるイベントです。
2010年のクリスマス(もしくは2010年いっぱい?)までに、
参加者が1日1つずつF#にまつわる記事をブログに書いていき、
年末年始はみんなでF#を楽しもう!というとってもナイスなイベントです。
F#に関係してる記事であれば、その内容に特にしばりはないということなので、どなたでも気軽に参加できます。
ふるってご参加ください。また、この機会にF#にぜひ触れてみてください。


F#でメモ化について考えてみる
メリークリスマス!ということで、「メモ〜化したりスマス」とか。冬ですね。
寒いですが、F#でメモ化について考えてみたいと思います。


メモ化とはプログラムを高速化するための最適化技法のひとつで、
関数呼び出しの引数をキーとして、関数の結果をキャッシュに保持しておき、
1度呼び出された関数が再度呼び出されたときに再計算をせずに、保持しておいた結果を再利用する手法です。
具体的には、キーと値のペアを保持しておくためのコレクション(あるいはテーブル)を用意し、
クロージャ内で、関数の結果が静的スコープ内で解決されるように実装するようなもののことをそう呼びます。


メモ化関数はとってもエコです。なかでもメモ化された再帰関数は、
自身を何度も呼び出すという再帰というその特徴から、大きなエコ効果を発揮します。
「計算機プログラムの構造と解釈」(SICP : Structure and Interpretation of Computer Programs)の
23ページの下の方に少しと、159ページの下の方あたりからメモイヒについて解説があります。
お手元にある方は、パラパラっとめくってチラリと確認してみるのもいいかもしれません。


任意の関数をメモ化する関数をつくる

F#による任意の関数をメモ化する関数の実装例です。

[<CompiledName("Memoize")>]
let memoize1 f = 
  let dic = Dictionary<'TArg1, 'TResult> ()  
  fun x -> match dic.TryGetValue(x) with 
           | true, r -> r
           | _       -> dic.[x] <- f x
                        dic.[x]


ご覧いただくとわかるように、Dictionary内のキーに引数が存在した場合はDictionaryから取得した値を返し、
存在しなかった場合は、関数に引数を適用した結果を辞書に登録してから、結果を返しています。
これがF#におけるメモ化の基本的な実装例です。
(F#であれば「ref Map.empty」を使うなんてもことも考えられますが、何か美しくないんですよねこれ。どっちがよいのかな。)



ちなみに、この関数の型はこんな感じになっています。


あれれ、これでは引数を1つ取る任意の関数についてしかメモ化することができませんね。
引数を2つ、あるいは3つ取る任意の関数もメモ化したいのに。


2つあるいは3つの引数を取る任意の関数をメモ化する関数をつくる

作りました。

[<CompiledName("Memoize")>]
let memoize2 f = 
  let dic = createDic (defaultof<'TArg1> 
                     , defaultof<'TArg2>) defaultof<'TResult>
  fun x y -> match dic.TryGetValue((x,y)) with 
             |true, r -> r
             | _      -> dic.[(x,y)] <- f x y
                         dic.[(x,y)]


「1つの引数を取る任意の関数をメモ化する関数」と似ていますね。
ところで、「createDic」とはなんでしょう。これです。

let createDic (key:'a) (value:'b) = Dictionary<'a, 'b> ()


引数で与えられたkeyとvalueの型を適用したDictionaryを作ります。
この関数を利用することで、Unchecked.defaultof<'T>を用いて、
任意のジェネリックなDictionaryをクリエイトしているというわけです。
ここでは('TArg1, 'TArg2)のタプルをkeyとして、'TResultをvalueとするDictionaryが作られています。
他は、1つの引数を取るバージョンと一緒ですね。
これを刺身タンポポの要領でコピペしていけば、3引数バージョン、4引数バージョン・・・と容易に量産することができます*1


[<CompiledName("Memoize")>]
let memoize3 f = 
  let dic = createDic (defaultof<'TArg1> 
                     , defaultof<'TArg2>
                     , defaultof<'TArg3>) defaultof<'TResult>
  fun x y z -> match dic.TryGetValue((x,y,z)) with 
               |true, r -> r
               | _      -> dic.[(x,y,z)] <- f x y z
                           dic.[(x,y,z)]

まぁ、必要となるのはせいぜい3引数バージョンまででしょう。
「引数多すぎは百害あって一利なし」って、ことわざにもあるくらいです。



関数型言語だからこそDRY原則*2を意識して

ここまでのメモ化関数の中に、似たような実装が複数あらわれましたね。(コピペ駆動開発の賜物)
これは不吉な臭いを感じますね?そんなときはリファクタリングだね?


やってみましょう。
まず、せっかくなので1引数バージョンについてもcreateDicを使うようにしてみましょう。

[<CompiledName("Memoize")>]
let memoize1 f = 
  let dic = createDic  defaultof<'TArg1> defaultof<'TResult>
  fun x -> match dic.TryGetValue(x) with 
           | true, r -> r
           | _       -> dic.[x] <- f x
                        dic.[x]

なんだか少しかっこよくなりましたね。気のせいですね。



2引数バージョンをリファクタったー。

type args<'TArg1,'TArg2> = {item1:'TArg1; item2:'TArg2}
[<CompiledName("Memoize")>]
let memoize2 (f : 'TArg1 -> 'TArg2 -> 'TResult) = 
  let f' = collateArg { item1 = defaultof<'TArg1>
                        item2 = defaultof<'TArg2> } (fun a -> f a.item1 a.item2) |> memoize1
  fun a b -> f' { item1 = a 
                  item2 = b}


なんだか、ずいぶんと様変わりしましたね。少しずつ見ていきましょう。
まずはcollateArg関数です。名前むつかしいです。なんとなく雰囲気で付けました。

let collateArg (arg: 'TArg) (f : 'TArg -> 'TResult) = fun a -> f a


引数をまとめるみたいな感じですね。型はこんな感じになっています。


次に、type args<'TArg1,'TArg2>ですが、これはレコード型です。
F#では、C#でいうところの匿名型にあたるものの代用としてレコード型を用いることがあります。
レコード型はimmutableなValueObjectとみなすことができるので、そいつをうまく利用したわけです。
2つの引数をまとめたimuutableなValueObjectをキーとしてDictionaryに登録することで
1引数バージョンのmemoize1関数の実装を、2引数バージョンで再利用することができました。


同じ要領で3引数バージョンもつくっちゃいましょう。

type args<'TArg1,'TArg2,'TArg3> ={item1:'TArg1; item2:'TArg2; item3:'TArg3}
[<CompiledName("Memoize")>]
let memoize3 (f : 'TArg1 -> 'TArg2 -> 'TArg3 -> 'TResult) = 
  let f' = collateArg { item1 = defaultof<'TArg1>
                        item2 = defaultof<'TArg2>
                        item3 = defaultof<'TArg3> } (fun a -> f a.item1 a.item2 a.item3) |> memoize1
  fun a b c -> f' { item1 = a 
                    item2 = b
                    item3 = c}


ふつくしい…。


おまけ1:引数なし関数のメモ化

一応、引数なし関数というか、unitを引数として取る関数のメモイヒについても考えておきましょう。
あんまりうれしい関数ではないけれど。

[<CompiledName("Memoize")>]
let memoize0 f = 
  let value = ref defaultof<'TResult>
  let hasValue = ref false
  fun () -> if not !hasValue then  hasValue := true
                                   value := f ()
            !value

Dictionaryを利用していないという点で異なるだけであって、基本はなにも変わっていません。
メモ化の考え方を理解していれば、容易に理解できる内容ですね。



まだもう少し続きます。お付き合いください。




末尾再帰な関数のメモ化を考える


タイトルに「Memoization and Tail Recursive Function」とありましたが、
末尾再帰な関数だってメモ化したくなるシナリオがないとも限りません。あるの?あることにしておいてください。
任意の末尾再帰な関数をメモイヒする関数もつくってみました。以下、実装例です。

[<CompiledName("MemoizeTailRecursion")>]
let memoizeTailRecursion f =
  let dic = createDic  defaultof<'TArg1> defaultof<'TResult>
  let rec f' x c = 
    match dic.TryGetValue(x) with
    | true, r -> c r
    | _ ->  f x (fun r -> dic.[x] <- r
                          c r) f'
  (fun x -> f' x id)

末尾再帰対応をしているだけで、基本的には通常のメモ化関数となんら変わりませんね。
結果をキャッシュとしてDictionaryに保存しておく考え方は変わりません。


調子に乗って、2引数、3引数のもつくっておきます。

[<CompiledName("MemoizeTailRecursion")>]
let memoizeTailRecursion2 f =
  let dic = createDic (defaultof<'TArg1> 
                     , defaultof<'TArg2>) defaultof<'TResult>
  let rec f' x y c = 
    match dic.TryGetValue((x,y)) with
    | true, r -> c r
    | _ ->  f x (fun r -> dic.[(x,y)] <- r
                          c r) f'
  (fun x y -> f' x y id)


[<CompiledName("MemoizeTailRecursion")>]
let memoizeTailRecursion3 f =
  let dic = createDic (defaultof<'TArg1> 
                     , defaultof<'TArg2>
                     , defaultof<'TArg3>) defaultof<'TResult>
  let rec f' x y z c = 
    match dic.TryGetValue((x,y,z)) with
    | true, r -> c r
    | _ ->  f x (fun r -> dic.[(x,y,z)] <- r
                          c r) f'
  (fun x y z -> f' x y z id)


末尾再帰対応版のメモ化関数のリファクタリングは、あなたにお任せします。
なかなか面白いとおもいますので、トライしてみてください。



おまけ2:再帰と言えば、そう。Y Combinatorを思い出す…。

関数型言語で再帰と言えば、Y Combinatorを思い出します。
「Y Combinatorも再帰的な表現なのだから、これもメモ化したら幸せななんじゃね?」「そうなんじゃね?」(独り言)
だったら、メモ化されたY Combinatorつくってみましょう。そうしましょう。
ということで、Memoized Y Combinatorについても考えみました。


まずは、通常のY Combinatorを。

type Y<'T> = Rec of (Y<'T> -> 'T)

// Y Combinator 
let y mk =
  let f' (Rec f as g) = mk (fun y -> f g y)
  f' (Rec f')

で、メモ化したY Combinatorを試しに書いてみた。

// Memoized Y Combinator?
let yMem mk = 
  let dic = createDic defaultof<'a> defaultof<'b>
  let f' (Rec f as g) = mk (fun y -> f g y)
  let f'' = f' (Rec f')
  fun x -> if dic.ContainsKey(x) then
             dic.[x]
           else
             let answer = f'' x
             dic.[x] <- answer
             answer


とりあえず書いてみた。という以外のなにものでもありません。
というかこれ、ダメですね。まったく最適化されていません。残念! 
タイムアップですので、またの機会に考えます。



おまけ3:「あのー、タプルを引数に取る関数もメモ化したいんですが…。」

君はcurry、uncurryを知っているか!?

// カリー化します
let curry f a b = f (a, b)

// アンカリー化します
let uncurry f (a, b) = f a b


難しく考えなくていいんですよね。


まず、タプルな引数を取る関数を一端カリー化してしまって、それをメモ化する。
次に、その関数をアンカリー化して戻しちゃえばいんじゃないかな!いいんじゃないかな!

     「そんなテクニックが!?」

          「いや、テクニックちゅうほどでもないよ。」

     「するってーと、タプルな引数を取る関数をメモ化してしまう関数もお茶の子さいさい…ということですね!(まじか!)」

          「だねー。そういうこと。おk?」

     「はーー…。関数型言語って魔法みたい。」

          「F#おもしろいだろう? 」

          「君はもう気付いているようだが、F#はもちろん魔法だぜ。」

     「ファンタジー…ファンタスティック!!」


なんだかとってもアレでぐだぐだになっちゃいましたが、華麗にスルーしてください(^-^)/~



最後に

メモ化的なスニペットがまだなかったようなので、今回書いたコードをF# Snipetに投稿してみました。
F# Snipetは、id:tomerunさんが第12回「F#学習用リソースいろいろ」で紹介してくださっていましたね。
関数の型をツールチップで確認できますし、これはかなりの便利サイトですね。ぐっじょぶすぎ。


投稿した内容はこちら → http://fssnip.net/1q

open System
open System.Threading 
open System.Collections.Generic 
open Microsoft.FSharp.Core.Operators.Unchecked 

// [snippet:Memoize Sample]
let createDic (key:'a) (value:'b) = Dictionary<'a, 'b> ()
let collateArg (arg: 'TArg) (f : 'TArg -> 'TResult) = fun a -> f a

[<CompiledName("Memoize")>]
let memoize0 f = 
  let value = ref defaultof<'TResult>
  let hasValue = ref false
  fun () -> if not !hasValue then  hasValue := true
                                   value := f ()
            !value

[<CompiledName("Memoize")>]
let memoize1 f = 
  let dic = createDic  defaultof<'TArg1> defaultof<'TResult>
  fun x -> match dic.TryGetValue(x) with 
           | true, r -> r
           | _       -> dic.[x] <- f x
                        dic.[x]

type args<'TArg1,'TArg2> = {item1:'TArg1; item2:'TArg2}
[<CompiledName("Memoize")>]
let memoize2 (f : 'TArg1 -> 'TArg2 -> 'TResult) = 
  let f' = collateArg { item1 = defaultof<'TArg1>
                        item2 = defaultof<'TArg2> } (fun a -> f a.item1 a.item2) |> memoize1
  fun a b -> f' { item1 = a 
                  item2 = b}


type args<'TArg1,'TArg2,'TArg3> ={item1:'TArg1; item2:'TArg2; item3:'TArg3}
[<CompiledName("Memoize")>]
let memoize3 (f : 'TArg1 -> 'TArg2 -> 'TArg3 -> 'TResult) = 
  let f' = collateArg { item1 = defaultof<'TArg1>
                        item2 = defaultof<'TArg2>
                        item3 = defaultof<'TArg3> } (fun a -> f a.item1 a.item2 a.item3) |> memoize1
  fun a b c -> f' { item1 = a 
                    item2 = b
                    item3 = c}
// [/snippet]

// [snippet:Memoize Tail Recursion Sample]
[<CompiledName("MemoizeTailRecursion")>]
let memoizeTailRecursion f =
  let dic = createDic  defaultof<'TArg1> defaultof<'TResult>
  let rec f' a k = 
    match dic.TryGetValue(a) with
    | true, r -> k r
    | _ ->  f a (fun r -> dic.[a] <- r
                          k r) f'
  (fun a -> f' a id)

[<CompiledName("MemoizeTailRecursion")>]
let memoizeTailRecursion2 f =
  let dic = createDic (defaultof<'TArg1> 
                     , defaultof<'TArg2>) defaultof<'TResult>
  let rec f' a b k = 
    match dic.TryGetValue((a,b)) with
    | true, r -> k r
    | _ ->  f a (fun r -> dic.[(a,b)] <- r
                          k r) f'
  (fun a b -> f' a b id)

[<CompiledName("MemoizeTailRecursion")>]
let memoizeTailRecursion3 f =
  let dic = createDic (defaultof<'TArg1> 
                     , defaultof<'TArg2>
                     , defaultof<'TArg3>) defaultof<'TResult>
  let rec f' a b c k = 
    match dic.TryGetValue((a,b,c)) with
    | true, r -> k r
    | _ ->  f a (fun r -> dic.[(a,b,c)] <- r
                          k r) f'
  (fun a b c -> f' a b c id)
// [/snippet]

// [snippet:Main]
let fibtrc n k m =
    if n = 0 then k 1
    else m (n - 1) (fun r1 -> let r = r1 * n in k r) 

let Heviy0 () =
  Thread.Sleep 3000
  1

let Heviy i = 
  Thread.Sleep 1000
  i + 1

let Heviy2 i j = 
  Thread.Sleep 1000
  i + j + 1

let Heviy3 i j k = 
  Thread.Sleep 1000
  i + j + k + 1
 
let Main =
  printfn "%s" "memoize0"
  let memofunc0 = memoize0 (fun () -> Heviy0 ())
  for i=0 to 4 do Console.WriteLine(memofunc0 ())
  for i=0 to 4 do Console.WriteLine(memofunc0 ())
  printfn "%s" "memoize1"
  let memofunc1 = memoize1 (fun x -> Heviy x)
  for i=0 to 4 do Console.WriteLine(memofunc1 i)
  for i=0 to 4 do Console.WriteLine(memofunc1 i)
  printfn "%s" "memoize2"
  let memofunc2 = memoize2 (fun a b -> Heviy2 a b)
  for i=0 to 4 do Console.WriteLine(memofunc2 i i)
  for i=0 to 4 do Console.WriteLine(memofunc2 i i)
  printfn "%s" "memoize3"
  let memofunc3 = memoize3 (fun a b c -> Heviy3 a b c)
  for i=0 to 4 do Console.WriteLine(memofunc3 i i i)
  for i=0 to 4 do Console.WriteLine(memofunc3 i i i)

let fibtrcmem = memoizeTailRecursion fibtrc
fibtrcmem 5 |> printfn "%d" 

Console.WriteLine ()
  |> fun _ -> Console.ReadLine () |> ignore
// [/snippet]


type Y<'T> = Rec of (Y<'T> -> 'T)
// Y Combinator
let y mk =
  let f' (Rec f as g) = mk (fun y -> f g y)
  f' (Rec f')
  
// Memoized Y Combinator... No.
let yMem mk = 
  let dic = createDic defaultof<'a> defaultof<'b>
  let f' (Rec f as g) = mk (fun y -> f g y)
  let f'' = f' (Rec f')
  fun x -> if dic.ContainsKey(x) then
             dic.[x]
           else
             let answer = f'' x
             dic.[x] <- answer
             answer


※この記事内に「メモイヒ(めもいひ)」がいくつか隠れています。探してみてね!何個あるかな?(どうでもいいね!)

*1:かの有名な、コピペ駆動開発。

*2:"Don't Repeat Yourself." 繰り返しの禁止