メモ〜化したりスマス。 Memoization and Tail Recursive Function
のぶひささん(id:Nobuhisa)が、魔法的メモ化関数を書いてくださいました。
めもりんこ - (hatena (diary ’Nobuhisa))
非常にふつくしいので、ぜひご覧になってください。
このエントリは「F# Advent Calendar jp 2010」第16回のものです。
F# Advent Calendar jp 2010とは
のぶひささん(id:Nobuhisa)発案のF#を盛り上げるイベントです。
2010年のクリスマス(もしくは2010年いっぱい？)までに、
参加者が１日１つずつ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」を使うなんてもことも考えられますが、何か美しくないんですよねこれ。どっちがよいのかな。)
ちなみに、この関数の型はこんな感じになっています。
あれれ、これでは引数を１つ取る任意の関数についてしかメモ化することができませんね。
引数を２つ、あるいは３つ取る任意の関数もメモ化したいのに。
２つあるいは３つの引数を取る任意の関数をメモ化する関数をつくる
作りました。
[<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)]
「１つの引数を取る任意の関数をメモ化する関数」と似ていますね。
ところで、「createDic」とはなんでしょう。これです。
let createDic (key:'a) (value:'b) = Dictionary<'a, 'b> ()
引数で与えられたkeyとvalueの型を適用したDictionaryを作ります。
この関数を利用することで、Unchecked.defaultof<'T>を用いて、
任意のジェネリックなDictionaryをクリエイトしているというわけです。
ここでは('TArg1, 'TArg2)のタプルをkeyとして、'TResultをvalueとするDictionaryが作られています。
他は、１つの引数を取るバージョンと一緒ですね。
これを刺身タンポポの要領でコピペしていけば、３引数バージョン、４引数バージョン・・・と容易に量産することができます*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)]
まぁ、必要となるのはせいぜい３引数バージョンまででしょう。
「引数多すぎは百害あって一利なし」って、ことわざにもあるくらいです。
関数型言語だからこそDRY原則*2を意識して
ここまでのメモ化関数の中に、似たような実装が複数あらわれましたね。（コピペ駆動開発の賜物）
これは不吉な臭いを感じますね？そんなときはリファクタリングだね？
やってみましょう。
まず、せっかくなので１引数バージョンについても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]
なんだか少しかっこよくなりましたね。気のせいですね。
２引数バージョンをリファクタったー。
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とみなすことができるので、そいつをうまく利用したわけです。
２つの引数をまとめたimuutableなValueObjectをキーとしてDictionaryに登録することで
１引数バージョンのmemoize1関数の実装を、２引数バージョンで再利用することができました。
同じ要領で３引数バージョンもつくっちゃいましょう。
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}
ふつくしい…。
おまけ１：引数なし関数のメモ化
一応、引数なし関数というか、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に保存しておく考え方は変わりません。
調子に乗って、２引数、３引数のもつくっておきます。
[<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)
末尾再帰対応版のメモ化関数のリファクタリングは、あなたにお任せします。
なかなか面白いとおもいますので、トライしてみてください。
おまけ２：再帰と言えば、そう。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
とりあえず書いてみた。という以外のなにものでもありません。
というかこれ、ダメですね。まったく最適化されていません。残念！
タイムアップですので、またの機会に考えます。
おまけ３：「あのー、タプルを引数に取る関数もメモ化したいんですが…。」
君はcurry、uncurryを知っているか！？
// カリー化します let curry f a b = f (a, b) // アンカリー化します let uncurry f (a, b) = f a b
難しく考えなくていいんですよね。
まず、タプルな引数を取る関数を一端カリー化してしまって、それをメモ化する。
次に、その関数をアンカリー化して戻しちゃえばいんじゃないかな！いいんじゃないかな！
「そんなテクニックが！？」 「いや、テクニックちゅうほどでもないよ。」 「するってーと、タプルな引数を取る関数をメモ化してしまう関数もお茶の子さいさい…ということですね！（まじか！）」 「だねー。そういうこと。おｋ？」 「はーー…。関数型言語って魔法みたい。」 「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
※この記事内に「メモｲﾋ（めもいひ）」がいくつか隠れています。探してみてね！何個あるかな？（どうでもいいね！）
