ようこそ。睡眠不足なプログラマのチラ裏です。
トップ > モナド

FizzBuzz問題から学ぶモナド

プログラミング Haskell F#2.0 F# モナド 息抜き

前回のエントリでモナドについて熱く語りました。今回はゆるいモナドの雑記です。
モナドを利用してFizzBuzz問題を書いてみることで、「モナドってなんなん？なにしてくれちゃってるん？」ということが、
もしかしたら分かるかもしれないよ、という息抜き的なお話です。


FizzBuzz問題から学ぶモナド

FizzBuzzをモナドで - トウフ日記
http://d.hatena.ne.jp/nskj77/20070512/1178952068


よりコードを引用します。

data FB a = FB (a, String)

instance Monad FB where
  return x = FB (x, "") 
  m >>= f  = bind m f 
    where bind (FB (x, y)) f = let FB (m, n) = f x in FB (m, y ++ n)

instance (Show a) => Show (FB a) where
  show (FB (x, "")) = show x
  show (FB (_, y))  = y 

fizzbuzz = mapM_ (\x -> print (fizz x >>= buzz))
  where fizz x | x `mod` 3 == 0 = FB (x, "Fizz")
               | otherwise      = return x
        buzz x | x `mod` 5 == 0 = FB (x, "Buzz")
               | otherwise      = return x


はい。FizzBuzz問題をモナドで実装してみようというHaskellのコードです。
これは非常に面白いですね。さっそくF#へ移植してみましょう。

type FB<'T> = FB of 'T * string

let inline (>>=) (FB (x, y)) f = f x |> function | FB(m,n) -> FB(m, y + n)
let bindFB m f = m >>= f
let fbreturn x = FB x

type FizzBuzzBuilder () =
  member this.Return (x) = fbreturn x
  member this.Bind (m,f) = m >>= f

let fb = FizzBuzzBuilder ()

let fizz = function
| x when x % 3 = 0 -> fb { return x,"Fizz" }
| x -> fb { return x,"" }

let buzz = function
| x when x % 5 = 0 -> fb { return x,"Buzz" }
| x -> fb { return x,"" }

let printFB  = function 
  | FB(x,"") -> printfn "%A" x
  | FB(_,y)  -> printfn "%s" y

let fizzbuzz = Seq.iter (fun x -> (fizz x >>= buzz) |> printFB)

[1..100] |> fizzbuzz |> ignore
System.Console.ReadLine () |> ignore


とくになんの捻りもなく、ベタに移植。とりあえずFizzBuzzできました。
Bind(>>=)で、とある型'Tとstringなタプルを伝番させて、出力内容を構築する仕組みになっていますね。


で、気付いたんですが、これはモナド則を満たしていませんね。
当然、元ネタのHaskellのコードについても同じことが言えます。
元ネタは、確かに型クラスとしてのMonadを利用してFizzBuzzを実装してはいますが、
MonadのインスタンスであるFBがモナド則を満たしていないので、厳密にはモナドによるFizzBuzzの実装にはなっていないんですね。
具体的には、モナド則１について満たされていないので、残念な感じなっています。




モナド則1

return x >>= f  ==  f x


ベタ移植できていませんでした。正しくはこうです。

type FB<'T> = FB of 'T * string

let inline (>>=) (FB (x, y)) f = f x |> function | FB(m,n) -> FB(m, y + n)
let bindFB m f = m >>= f
let fbreturn (x:int) = FB (x,"")

type FizzBuzzBuilder () =
  member this.Return (x) = fbreturn x
  member this.Bind (m,f) = m >>= f

let fb = FizzBuzzBuilder ()

let fizz = function
| x when x % 3 = 0 -> FB (x,"Fizz")
| x -> fb { return x }

let buzz = function
| x when x % 5 = 0 -> FB (x,"Buzz")
| x -> fb { return x }

let printFB  = function 
  | FB(x,"") -> printfn "%d" x
  | FB(_,y)  -> printfn "%s" y

let fizzbuzz = Seq.iter (fun x -> fizz x >>= buzz |> printFB)

[1..100] |> fizzbuzz |> ignore
System.Console.ReadLine () |> ignore

そして、元ネタのHaskellのコード同様に、これはモナド則を満たします。




では、モナド則1を満たすように書き直してみます。
モナド則を満たしつつ、単に関数適用するようなかたちに書き換えてみます。

type FB<'T> = FB of 'T * string 

let inline (>>=) (FB (x, y)) f : FB<'b> = f (x,y) 
let fbreturn x = FB x

type FizzBuzzBuilder () =
  member this.Return (x) = fbreturn x
  member this.Bind (m,f) = m >>= f

let fb = FizzBuzzBuilder ()

let fizz = function
| x when x % 3 = 0 -> fb { return x,"Fizz" }
| x -> fb { return x,"" }

let buzz = function
| x,s when x % 5 = 0 -> fb { return x, s + "Buzz" }
| x,s -> fb { return x,s }

let printFB  = function 
  | FB(x,"") -> printfn "%A" x
  | FB(_,y)  -> printfn "%s" y

let fizzbuzz = Seq.iter (fun x -> (fizz x >>= buzz) |> printFB)

[1..100] |> fizzbuzz
System.Console.ReadLine () |> ignore


モナドでFizzBuzzを書くならこう書くのが自然ですね。
この例では、fizz関数で生成されたFBモナドにbuzz関数をBind(>>=)で適用することで、モナドが合成されていることがわかります。


どこが変わったのかと言えば、コンピューテーション式のBindの実装です。
修正前の実装では、Bind(>>=)で　f　を　x　に適用したあとに、ごにょごにょ（文字列を結合する操作を)していました。
これにより、モナド則１(左単位元)が満たされなくなっていたということです。
前回のエントリでも書きましたが、モナドは「ジェネリックな関数適用」と見なすことができました。
逆に言うと、Bind(>>=)で関数適用以上のことをしてしまうと、モナドとしての整合性がとれなくなってしまうということです。
このことから、Bind(>>=)時に関数適用の操作の範囲を超えてしまうような余計な操作はしてはいけないことがわかります。
「関数適用の操作の範囲を超えるような処理は、Bind(>>=)対象となるモナド側で構築する」のが作法ということになります。
この例では、fizz関数とbuzz関数内でやっていることがそれにあたります。


世界のナベアツ問題もモナドで


FizzBuzz問題に類似する世界のナベアツ問題（もはや死語）についても、
同じ戦略を利用することができるので、同様に関数適用の操作をするだけのFizzBuzzモナドを使って書いてみましょう。

let aho = function
| x when x % 3 = 0 || (string x).Contains("3") -> fb { return x, string x + "あほ" }
| x -> fb { return x, string x + "" }

let ahan = function
| x,s when x % 8 = 0 -> fb { return x, s + "あはん" }
| x,s -> fb { return x,s }

let printNabeatsu  = function 
  | M(x,"") -> printfn "%A" x
  | M(_,y)  -> printfn "%s" y

let nabeatsu = Seq.iter (fun x -> (aho x >>= ahan) |> printNabeatsu)

[1..40] |> nabeatsu
System.Console.ReadLine () |> ignore


FizzBuzzモナドがやっていること自体が、単なる関数適用にすぎないため、そのまま流用することができました。



「がぶさんのかんがえたさいきょうのBLげんご、F#」をモナドで

ぼくのかんがえたさいきょうのBLげんご、F# - Gab_kmのブログ
http://blog.livedoor.jp/gab_km/archives/1355595.html


サンプルとしてもう一つ、こちらも実装してみましょう。


ガブさん曰く、

今回できなかったこととして、他の人に「なんてものを見てしまったんだろうな感」を与えないようにしたいところ。
このキャッキャウフフを何かにくるんで、(精神的に)安全に扱う仕掛けが必要だ。
そう、それはまさにモナドの得意とするところ。
BLモナドの実装が次なるチャレンジになるだろう。


ということで、BLに特化したBLモナドの実装？と行きたくなるのかもしれませんが、
この場合も、戦略としてFizzBuzzモナドが利用できます。FizzBuzzモナドで実装してみましょう。

type SemeUke = Seme | Uke
let createBoy name seme uke a = 
  let say s nm line = 
    let s = if s <> "" then s + "\n" else s
    s + nm + "「" + line + "」"
  a |> function
  | (Seme,s)-> fb { return Uke, say s name seme }
  | (Uke,s) -> fb { return Seme, say s name uke }

let gab = createBoy <| "ガブ" 
                    <| "んー。やっぱりもっとクールに。ほら、こうできる。ねっ？（手を握りながら" 
                    <| "んっ。。。こうですか？/// もっと教えてほしいです。。。///"

let kyon = createBoy <| "きょん"
                     <| "このうさみみに触れたければ、軽やかにスレーブを使いこなして。ほら、もっと素直になって？"
                     <| "っっっ/// うさみみがぴょんぴょんしちゃうよ///"

let printBL  = function 
  | M(x,"") -> printfn "%A" "「・・・。」"
  | M(_,y)  -> printfn "%s" y

printfn "%s" "きょん×ガブ"
(Seme,"") |> kyon >>= gab |> printBL

printfn "%s" "\nガブ×きょん"
(Seme,"") |> gab >>= kyon |> printBL

System.Console.ReadLine () |> ignore


難なくモナドで実装することができました。FuzzBuzzモナドがとても抽象的な操作をしていることがわかります。
モナドは非常に柔軟で拡張性も高いので、もう一人BL対象を増やすことも容易です。

type SemeUke = Seme | Uke | Another
let createBoy name seme uke another a = 
  let say s nm line = 
    let s = if s <> "" then s + "\n" else s
    s + nm + "「" + line + "」"
  a |> function
  | (Seme,s)-> fb { return Uke, say s name seme }
  | (Uke,s) -> fb { return Another, say s name uke }
  | (Another,s) -> fb { return Seme, say s name another }

let gab = createBoy <| "ガブ" 
                    <| "んー。やっぱりもっとクールに。ほら、こうできる。ねっ？（手を握りながら" 
                    <| "んっ。。。こうですか？/// もっと教えてほしいです。。。///"
                    <| "きゃっきゃ"

let kyon = createBoy <| "きょん"
                     <| "このうさみみに触れたければ、軽やかにスレーブを使いこなして。ほら、もっと素直になって？"
                     <| "っっっ/// うさみみがぴょんぴょんしちゃうよ///"
                     <| "ウフフ"

let kusomiso = createBoy <| "くそみそ"
                         <| "ウホッ！いい男。やらないか"
                         <| "ん゛ん゛ん゛ん゛ん"
                         <| "マッスル！マッスル！"

let printBL  = function 
  | M(x,"") -> printfn "%A" "「・・・。」"
  | M(_,y)  -> printfn "%s" y

printfn "%s" "きょん×ガブ"
(Seme,"") |> kyon >>= gab |> printBL

printfn "%s" "\nガブ×きょん"
(Seme,"") |> gab >>= kyon |> printBL

printfn "%s" "\nガブ×きょん×くそみそ"
(Seme,"") |> gab >>= kyon >>= kusomiso |> printBL

printfn "%s" "\nくそみそ×きょん×ガブ"
(Seme,"") |> kusomiso >>= kyon >>= gab |> printBL

System.Console.ReadLine () |> ignore

で、何度もしつこく言っていますが、このFizzBuzzモナドでは単に関数適用をしているにすぎません。
このBL的な何かの処理を、モナドで実装すること自体に意味はありません。あくまでFizzBuzzモナドがやっていることに着目してください。



で、FizzBuzzモナドって結局何なの

ということを踏まえたところで、FizzBuzzモナドに注目してもっと抽象的に考えていきましょう。
判別供用体の FB<'T> ですが、 'Tはそもそもジェネリックな型なので、FB of 'T * stringである必要はないですね。
表現としては、 FB of 'T で十分に表現できます。


以下のように書き直せます。

type FB<'T> = FB of 'T 

let inline (>>=) (FB (x, y)) f : FB<'b> = f (x,y) 
let fbreturn x = FB x

type FizzBuzzBuilder () =
  member this.Return (x) = fbreturn x
  member this.Bind (m,f) = m >>= f

また、同様の理由でBind(>>=)についても同じことが言えるので、
FBの'T型について、タプルであることを明示する必要はありません。


以下のように書き直せます。

type FB<'T> = FB of 'T 

let inline (>>=) (FB x) f : FB<'b> = f x 
let fbreturn x = FB x

type FizzBuzzBuilder () =
  member this.Return (x) = fbreturn x
  member this.Bind (m,f) = m >>= f

これって、そもそもFBって名前である意味がないよね。


以下のように書き直せます。

type M<'T> = M of 'T 

let inline (>>=) (M x) f : M<'U> = f x
let mreturn x : M<'T> = M x

type MonadBuilder () =
  member this.Return (x) = mreturn x
  member this.Bind (m,f) = m >>= f


おやおや。なにかとても見覚えのある形になりましたね。
もうお気付きですね。「これって、モナドの基本形そのままやん！*1」　はいそのとおりです。
先ほどまでFizzBuzzモナドと呼んでいたものの正体は、実はモナドの基本形そのものだったんだよ！





※オチです




当然のことながら、そのままFizzBuzz(世界のナベアツ、BL的な何か)が動きます。

type M<'T> = M of 'T 

let inline (>>=) (M x) f : M<'U> = f x
let mreturn x : M<'T> = M x

type MonadBuilder () =
  member this.Return (x) = mreturn x
  member this.Bind (m,f) = m >>= f

let m = MonadBuilder ()

let fizz = function
| x when x % 3 = 0 -> m { return x,"Fizz" }
| x -> m { return x,"" }

let buzz = function
| x,s when x % 5 = 0 -> m { return x, s + "Buzz" }
| x,s -> m { return x,s }

let printFB  = function 
  | M(x,"") -> printfn "%A" x
  | M(_,y)  -> printfn "%s" y

let fizzbuzz = Seq.iter (fun x -> (fizz x >>= buzz) |> printFB)

[1..100] |> fizzbuzz
System.Console.ReadLine () |> ignore


ということで、FizzBuzz問題をモナドで書いてみることで、
「モナドが何をやっているのか」、あるいは「モナドはジェネリックな関数適用だよね」
ということを、さも説明してしまったかのような雰囲気をかもし出してみました。何かの参考になれば幸いです。

*1:いわゆるIdentityモナド

快刀乱麻を断つモナド - F#とIOモナドとコンピューテーション式の奥義と

プログラミング F#2.0 F# Haskell コンピューテーション式 言語指向プログラミング モナド IOモナド 

　　　　　　　　 ,. -‐'''''""¨¨¨ヽ 
　　　　 　 　 (.＿＿_,,,... -ｧァﾌ|　　　　　　　　　　あ…ありのまま　今　起こった事を話すぜ！ 
　 　 　 　 　 |i i|　 　 }!　}} /／| 
　　　　 　 　 |l､{　 　j}　/,,ｨ//｜　　　　　　　『F#でIOモナドっぽい何かを作ろうとしていたら、 
　　　　　　　 i|:!ヾ､_ﾉ／ u {:}//ﾍ　　　　　　　　いつのまにか、全然別モノのLazyモナドをつくっていた。』 
　　　　　　　 |ﾘ u' }　 ,ﾉ　_,!V,ﾊ | 
　　 　 　 ／´fト､_{ﾙ{,ィ'ｅﾗ　, ﾀ人　　　　　　　　な…　何を言ってるのか　わからねーと思うが 
　　　　 /' 　 ヾ|宀| {´,)⌒`/ |<ヽﾄiゝ　　　　　　　　おれも　何をされたのか　わからなかった… 
　　　　,ﾞ　 ／ )ヽ iLﾚ 　u' |　| ヾｌﾄﾊ〉 
　　 　 |／_／　 ﾊ !ニ⊇　'／:} 　V:::::ヽ　　　　　　　　頭がどうにかなりそうだった… 
　　　 /／ 二二二7'T'' ／u'　__ /:::::::/｀ヽ 
　　　/'´r　-―一ｧ‐ﾞＴ´　'"´ ／::::／-‐ 　＼　　　素の「Lazy<'T>」の入れ子だとか 「unit -> 'T」の連鎖だとか 
　　 / // 　 广¨´ 　/'　　 ／:::::／´￣｀ヽ ⌒ヽ　　　　そんなチャチな遅延合成じゃあ　断じてねえ 
　　ﾉ ' /　 ノ:::::`ー-､___／:::::／/ 　 　 　 ヽ　　} 
_／｀丶　/::::::::::::::::::::::::::￣`ー-{:::...　　　 　　　ｲ　 もっと恐ろしい言語指向プログラミングの　片鱗を味わったぜ…


に至るまでの前置き(能書き)が無駄に長いです。
F#でIOモナドの話についてのみ書くつもりが、モナド全般の話になってしまいました。
それにしてもこれは一体誰向けの記事なのか、書いた本人もよくわからないんだぜ…（ごくり）。






プログラミングの世界のモナドとは、計算を組み合わせてより複雑な計算を構築するための、戦略の抽象のことを言います。モナドと言えばHaskellが有名ですが、モナドという抽象概念は言語依存のものではありません。



「モナドは関数プログラミングにおける戦略の抽象である。」と言いました。戦略には計算に応じてさまざまな種類があり、それぞれに名前、問題、適用可能性、特徴、結果などがあります。たとえば、Maybeモナドという名前の戦略がある。これは「失敗する可能性のある計算の合成」という問題に対する解決策を持っている。複数の失敗するかもしれない計算を合成し、ひとまとめの失敗するかもしれない計算として扱いたいような場合に適用することができる。「失敗したらその後の処理はしない」という特徴を持っている。結果として、入れ子が深くなりがちな失敗可能性のある計算の連鎖について、複雑な計算をよりシンプルに表現することができる。感のよい人はもう気づいているかもしれないが、「これって、もしかしてデザインパターン？」そう、「○○モナド」をそれぞれの問題領域を解決するためのパターンとして捉えることができます。そしてそのパターン全体に係る「モナド」は、それぞれの○○モナドに対して同じ枠組みを提供している“より高い抽象”と言うことができます。モナドは同じ枠組み（同じ概念）の下で、実にさまざまな問題領域に対して解決策を提示してくれます。つまり、関数プログラミンにおける「メタデザインパターン」あるいは「メタ戦略」、「メタ理論」がモナドであると捉えることもできます。この高次な概念は、もともと数学の一分野である圏論から来ています。なぜ圏論のモナドなんていうプログラミングと何の関連もない数学的構造が、プログラミングのあらゆる問題の解決策を示していたり、多くのプログラミングパターンを説明することができるのかはわかりません。そこには深イイ理由があるのかもしれないし、ただの偶然なのかもしれない。ただこれだけは言える。「数学SUGEEEEEEEEEEE」と。



Haskellの「Monad」は、モナドの抽象概念を適用した単なる型クラスのひとつです。モナドはメタ戦略なので、他の言語でもモナドを表現することはできます。しかし、型クラスと同程度の表現力を持っていない限り、Haskellほど美しくモナドとその周辺事情を表現することはできません。HaskellのMonadは型クラスによって非常に洗練された表現をされているので、モナドを勉強する上でとても参考になります。なにかを学ぶ場合、抽象的な話だけではわかりにくいので、具体的な例で考えてみると理解の助けとなります。Haskellの知識が少し必要ですが、id:kazu-yamamotoさんの「QAで学ぶMonad - あどけない話」の説明がすばらしくわかりやすいです。




「モナドは難しい」、「モナドは象だ」、「モナドかわいいよモナド」、「このモナドの説明を書いた人はこんなモナドの説明を読んでいます」、「モナドはメタファーではない」、「モナにゃんぺろぺろ」、「圏論モナドこそ至高」など、実にさまざまな声を聞きます。Real World Haskell（オライリー）には、「モナドを使っていると苛々します」という皮肉めいた記述が現れたりもします。




憧れの(闇の)カンスウガタゲンガー達が語る「モナドの本当の意味」を理解しようとすると、やはり圏論の概念やら定理やらの正確な理解が必要なのかもしれず。でも、その域に達するには、おそらく私を含めた一般的なプログラマには険しくも困難な道。出口の見えない試練に身を投じることになります。
しかし、多くのカンスウガタゲンガーは、圏論の本質的な意味やその定理に強いわけではなく。それにもかかわらず、彼らはモナドを使ったプログラムを書きます。小難しい概念を正確に理解することはできなくても、モナドを利用してメリットを享受することはできるんです。そしてモナドはとても便利なんです。実際のところ「モナド則*1」さえわかっていればほとんどの場合は困りません。使っているうちにモナドの性質が徐々にわかってきて、いずれ立派なモナグラマ−になれるかもしれない。もしかすると、みんなに愛でられるような可愛いオレオレモナドを発明できるようになるかもしれない。

C++をモナドに置き換えて音読してみましょう。そんな感じです。






単に関数プログラミングにおけるモナドの実用性あるいは利便性という意味だけで言うと、モナド則（モナドが守るべき３つのルール）を満たす基本演算の定義をすれば、あらゆる操作を同じ枠組みのもとでジェネリックに連鎖できる仕組みを利用することができる、ということに他ならない。モナドがプログラミング上で表現している抽象は、ジェネリックな関数合成と言いかえることもできる。関数合成とモナドの合成の違いを考えると、モナドはジェネリックな合成であり、異なる型の値を持つことができる点で異なる。これはそれぞれのシグネチャを比較するとわかりやすい。


Haskell:関数合成の演算子

(.) :: (b -> c) -> (a -> b) -> (a -> c)


Haskell:Bind演算子

(>>=) :: Monad m => m a -> (a -> m b) -> m b


(>>=)ではm aやm bと表されているように、合成時に異なる型の値が関わることがわかる。


Bind演算子(>>=)は、ある関数で値になんらかの処理をして、その値を次の関数に値を受け渡たしていく。ここでのある関数というのは、もちろん(a -> m b)のことであり、a は前の関数が返したモナドから値を取り出したものである。どのようにモナドから値を取り出して次の関数の引数にするのかを決定するのがBind演算子(>>=)というわけ。より関数型っぽく言いかえると、どのように(a -> m b)をm aに適用するのかを決めるための定義がBind演算子(>>=)。



では最初の、先頭にあたるモナドは一体どこからやってくるのか？ということになる。そこで、モナドが定義しなければならないもうひとつの定義、returnが導出される。returnは、なんらかの値を新たなモナド型の値にする関数で、しばしばモナドに包むなんて表現されたりもする。


Haskell

return :: Monad m => a -> m a


シグネチャも御覧の通りで、何も難しいことはしていません。Haskellでは、return や Bind演算子(>>=)はただの関数ではなくて、Monadクラス(型クラス)のメソッドになっていて、これによってアドホック多相が使える。なので、モナドがどのように合成されるのかという実装の詳細を意識しなくてもよいようになっている。つまり、文法上は同じように(>>=)でモナドが合成されていたとしても、そのモナドの種類によって実際の合成の挙動は異なる。つまるところこれはオーバーロード (多重定義)のことを言っていて、F#ではコンピューテーション式を用いることで、似たようなことができる。


モナドがやっていることは、実は強力な関数合成の一種であって、実は複雑なことはなにもしていない。にもかかわらず、モナドが難しいと言われる理由は、モナドが関数合成とジェネリックとアドホック多相が絡み合う複合体として表現される抽象であるからかもしれない。加えて、Haskellにあらわれる「クラス」や「インスタンス」という用語が、一般的なオブジェクト指向のそれの意味とまるで異なることも一因かもしれない。こういった事情があるので、日頃から抽象的な設計手法やメタプログラミングにあまり馴染みのないプログラマが突然モナドに触れると火傷してしまうというのは致し方ないことだ。プログラミングの基礎的素養は必要だが、順を追って丁寧に学習していけば「モナドがなにをやってくれているのかを理解する」こと自体はそれほど難しいことではない。





憧れの(闇の)カンスウガタゲンガー達は、暇さえあればモナドの話をしています。彼らは三度の飯よりモナドを好みます。なぜ彼らはモナドに夢中になるのか。モナドはそんなにも魅力的な存在なのでしょうか。そしてモナドは一体なんの役立つのでしょう。モナドはジェネリックな関数合成だと説明しました。しかし、実際に何の役に立つかはあまりピンとこないかもしれません。



モナドはメタ戦略だといいました。プログラミングにおいて戦略は重要なファクターです。関数プログラミングを構造化するための戦略を定義するのに極めて重要なツール、それがモナドです。モナドなくして関数プログラミングは語れません。モナドには、そう言い切れるそれを特に決定付けるいくつかの特徴があります。



（１）複雑な計算の可読性向上が期待できる。モナドは美しい！
計算を繋ぐBind演算子(>>=)によって、関数プログラミングを命令型的に表現することができる。モナド合成時の実装の詳細を意識しなくてもよいようになっているので、コードを劇的に単純化することができ、可読性の向上が見込めます。
　

HaskellのBind演算子(>>=)は、F#のコンピューテーション式(ビルダー)では

と表現されて、　シグネチャは、

です。



Bindの働きは、平たく言えばただの関数の結合ですが、通常の関数の合成を拡張した働きを持たせるのが一般的で、たとえば、Maybeモナドでは、成功と失敗を表す２種類のデータを次の関数へ伝達することができるようになっている。F#でoption型を利用することを考えた場合、Maybeモナドは欠かせないものとなります。→　F#プログラマのためのMaybeモナド入門 - みずぴー日記

ただし、モナドを利用することでコードの美しさが保てるかどうかは、実装言語によって大きく変わってくきます。たとえばHaskellには型クラスがあるのでとてもエレガントに表現されている。コードも非常に美しいです。F#ならコンピューテーション式できれいに表現できる。Scalaではfor式できれいに表現できる。他の言語だとまた状況は変わってきます。



（２）カプセル化とモジュール性を確保。頑丈なプログラミングを促進する！
モナドのBindによる合成においては、合成時の値がモナドの外に漏れ出ることがないのでモジュール性が保証されます。この特徴によって、プログラマはモナド内でプログラムしたものが他の領域に干渉することを懸念する必要がないので、とても幸せです。これはモナドプログラミングの純粋さを示すものであり、計算そのものとその合成戦略を分離していることを意味しています。つまりモナドは安全で動的に組み合わせ可能な計算として機能します。

　
まったくの別物なので、誤解を招いてしまいそうで例えることを躊躇しそうになるが、オブジェクト指向プログラマであれば、動的に機能拡張が可能という意味では、GoFデザインパターンにおける Decoratorパターン をイメージすると、モナドの拡張可能なモジュール性というものを想像しやすいかもしれない（あくまでイメージで）。オブジェクト指向パラダイムのDecoratorパターンでは、オブジェクトとオブジェクトを組み合わせることで、新たに複雑なオブジェクトを生成していました。　関数プログラミングのパラダイムでは、より高い抽象であるモナドでそれを高い次元で実現する。状況に応じてさまざまな用途のモナドを使い分けたり、必要に応じて複数のモナドを合成したりします。



（３）モナドによる柔軟性の高い関数型プログラミングは、アジャイル性を与える！
モナドは汎用なインターフェイスを持ち、関数の純粋さを保つ性質がある。これによりコードのリファクタリングが容易になり、また多くの場合は反復開発が容易になる(アジャイル性の向上)。モナドを用いない関数型プログラミングより、モナドを利用したプログラムはより柔軟性が高くなりやすい。これはモナドによる計算が、一連のプログラムとデータをカプセル化し、モジュール性があることからも説明できます。アジャイルというとオブジェクト指向とセットで語られることが多いが、真にアジャイル性を追及するならば、関数プログラミングを選択することがベターであることは確定的明らかである。








前ふりが長くなりましたが、やっとこの記事を書くきっかけとなったIOモナドの話をします。IOモナドは副作用をモナドの中に封じ込めて、純粋関数を表現するための仕組みを提供するパターンであり、非常に巧妙な仕組みです。少し言い換えると、副作用のある部分と副作用のない部分を明確に分離するための仕組みを提供する戦略を持っています。



この夏、「ATEND - 第0回 スタートHaskell」というイベントがあるそうです。定員150人にもかかわらず、すでに定員オーバーしています（すごい）。最近モテ言語と言われているだけあって、Haskell恐ろしい人気です。そちらのキャッチフレーズ（？）より以下を引用させていただきます。

スタートHaskell :: [初心者] → IO [経験者] -- この夏、Haskellを始めよう！

これが意味するところがそういう意味なのかはわかりませんが、IOモナドはHaskellにおいて、脱Haskell初心者の鬼門のひとつとされているモナドのひとつで、とりわけ特殊な存在として捉えられています。しかし、「IOモナドはモナドじゃないよ」「IOモナドなんて勉強しなくてもモナドは使えるよ」などと言う声もあります。それでいて魔術的な一面も持っていたり、IOモナドはモナドの中でも他とは毛色の違う不思議な存在です。これは、HaskellのIOモナドの定義がプラットフォーム依存(評価器, 実行器依存)であることに起因します。Haskellの「純粋さ（参照透明性）」に密接な関わりをもっています。さらにHaskellは遅延評価を採用している言語であることも関係してきます。このような特徴を持つIOモナドは特別な存在です。したがって、設計思想の異なる他の言語でHaskellのIOモナドを真似ることは難しいでしょう。





IOモナドについて語るには、まずは副作用とは何なのかを知る必要がありました。


副作用とは、関数やメソッドなどのある処理(計算)単位が、外部の環境になにかしら影響を及ぼすことを言います。つまり、処理の中で論理的な状態を変化させて、それ以降で得られる結果になんらかの影響を与えることです。代表的な例としては、コンソールを使った入出力や変数への値の破壊的代入、UIへの描画などがあげられます。





副作用がなく一貫性のある処理単位を純粋関数と呼ぶ。


「純粋」という修飾は、つまりそれがコンポーザブルであることを意味していて、大きく２つの特徴を持っている。まず、「自己完結」しているという特徴がある。そのため、純粋関数は他との結び付きや相互依存を一切気にすることなく、関数を自由に合成することができる。そして、純粋関数は「状態を持たない」。純粋関数の値（計算結果, 返り値）は、常にその引数の値によって決定される。同じ引数を伴う関数の計算が、いついかなる場合も同じ値となる（いわゆる参照透明性）ときそれは純粋関数だ。外部の環境に対して副作用を伴うような関数を部品として扱うと、必ず危険を伴う（バグりやすい）。環境に依存していて、事あるごとに結果が異なるような関数を使うなんて正気の沙汰じゃない！という意見はもっともです。それに対して、「自己完結」していて「状態がない」という環境に依存しない特徴を持っている純粋関数は、コンポーサブルな安全な部品として扱える。


関数型言語でこそ、より意味のある純粋関数
関数を純粋にすると、外部環境を意識せずに済むので可読性が高くなります。状態を持たないので、コードのリファクタリングが容易にもなります。また、多くの場合は設計の変更に強く、反復開発が容易になりやすいでしょう(アジャイル性の向上)。他との依存性もないので単独でのテストも容易で、テストコードは関数を呼び出すことに集中できて、デバッグも容易になるなど良いことずくめ。この純粋関数の特徴をより高く抽象的に昇華されたのがモナドで、合成可能なメタ純粋関数として捉えることもできる。


純粋関数は、もちろんHaskellだけのものでもなければ、ScalaやF#などを含めた関数型言語だけのものでもない。Java, C#, VB.NETというような、一般的なオブジェクト指向言語での実装においても、副作用をともなわない純粋関数を書くことは常に意識されてきた。ただ、オブジェクト指向言語では、関数をファーストクラス(第一級の値, first-class)*2として扱えないため、関数を部品として扱えず、純粋関数が持つ特徴である「自己完結」していて「状態を持たない」ので構成可能で安全な部品として扱えるという最大のメリットを享受することができない。それに対して、関数型言語はコンポーサブルな純粋関数を自由に組み合わせることで、より大きな純粋関数を作り出して効果的に再利用することができる。モナドについても同様のことが言え、純粋関数よりもさらに強力さを持つ。これは「なぜ関数型で書くのか」の理由のひとつと言える。




初めて読んだHaskellの本「ふつうのHaskellプログラミング」にはこんなことが書いてありました。
IOモナドにはふたつの目的があって、まずひとつは「副作用を伴う処理(アクション)の評価順序を確実に指定する」こと。もつひとつは、「参照透明性を保ったまま副作用を実現する」ということでした。
あるいは、「IOモナドは、まだ入出力を実行していない世界をアクションの中に包み込んでいて、アクションが評価されると、入出力の結果と、入出力を実行した後の世界が生成されます。」というようなことも書いてありました。３年くらい前に読んで、なんとなくわかったような気になっていましたが実は何もわかっていませんでした。そのときはまだ他の関数型言語も学んだことがなく、Haskellにも触れたばかりだったので。とここに言い訳をしておく。今思えば、IOモナドからモナドを入門するのは、ちょっと難しいのではないかと思います。



IOモナドの目的ですが、まず、ひとつめの目的は、Haskellが遅延評価*3を特徴としている言語であるということが深く関係しています。なので、主にHaskellというプログラミング言語におけるIOモナドの立ち位置としての目的と言えるかもしれません。ふたつめの目的は、副作用のある計算を純粋関数で表現すること。ひいては、副作用のカプセル化とモジュール性の確保が目的であると言えます。Haskellでは、副作用を持ち込みながら参照透明性を保つ手段として、モナドの持つ特徴をうまく利用していて、IOモナドを一方向モナドとして扱い、実行器まで巻き込むことで副作用をうまく封じ込めることに成功している。実行器まで巻き込むということがあまり説明されていないことが多いので、初心者は路頭に迷ってしまうのだと思う。

一方向モナドの素晴しい機能は、プログラムのモナドではない部分の関数型の性質を破壊することなく、そのモナド演算子中で副作用をサポートすることができるというものです。

「モナドのすべて」のモナド則-出口はないを参照されたい。



Haskellでは、すべての計算はトップレベルのIOモナドの中で起こります。実行器まで巻き込むというのはつまりそういう意味です。副作用は全てIOモナドにリフトされます。開発者が関数の外部環境に勝手にアクセスすることはできないようになっています。なので純粋です。「副作用のある計算を純粋関数で表現する」という、副作用と純粋関数の意味を考えると一見矛盾した要求に対して、モナドはみごとな解決策を与えているというわけです。IOモナドが一方向モナドであるため、純粋関数の役割を果たしていて、副作用を内包しながらも参照透明性が確保されている。これは実に巧妙というかなんというか、面白い。


F#やScalaなど副作用を許容する非純粋関数型言語においても、出来る限り参照透明性を保つようにプログラムを組むことが推奨される。非純粋関数型言語の「純粋さ」は開発者にゆだねられています。
IOモナドが副作用を構成可能な純粋関数としてくれるのならば、それは非純粋関数型言語屋にとっても朗報です。副作用をカプセル化してコンポーサブル化するということも、IOモナドの目的のひとつと言うことができるでしょう。



さて、無駄に長い前置きは以上です。





ここからが本題。


Haskellは純粋関数型言語です。副作用に対して厳格です。そして遅延評価を採用しています。よく訓練されたカンスウタガゲンガーは、副作用のある関数とない関数を分けて実装することを考えるそうです。しかし、それに依存したのでは、プログラムの純粋さを死守することはできません。そこで、HaskellではIOモナドというプラットフォーム依存のモナドを導入することでこの問題をエレガントに解決しました。言い方を変えると、Haskellでは、IOモナドによって副作用のある部分とない部分を完全に分けることをプログラマに強制させる仕組みを設けました。ゆえにHaskellは純粋でいられるのです。



先に「設計思想の異なる他の言語でHaskellのIOモナドを真似ることは難しいでしょう。」と述べました。F#でHaskellのIOモナドを完全模倣することはできません。が、「F#の立ち位置としてのIOモナド」ならば表現することはできなくはありません。


F#は非純粋関数型言語です。seq, asyncなどの組み込み済みのコンピューテーション式が提供されてはいますが、コンピューテーション式（によるモナドの実装）は基本的に自作してくださいというスタンスです。当然、IOモナドをはじめとしたHaskellで標準的に備わっているモナドはありません。
また、副作用に対しては比較的寛容で、プログラマのさじ加減ひとつでプログラムは純粋にも破壊的にもなります。


もちろん我々カンスウガタゲンガーは出来る限り純粋さを保つことを望んでいます。F#で開発する場合でも、副作用を適切に分けてプログラミングしたいという要求は当然あります。すべての副作用をIOモナドの中に封じ込めるいうのは、F#の場合あらゆる面で現実的ではありませんが、局所的に副作用をIOモナドによって管理することは、それなりに意味のあることです。なぜなら、よく訓練されたカンスウタガゲンガーは、副作用のある関数とない関数を分けて実装することを考えるから*4。


以上のことを踏まえて、F#でIOモナドを模倣することを考えてみます。しかし、これには大きな問題がいくつかあります。ひとつは、F#がオープンソースであるとは言え、Haskellのように評価器、実行器まで巻き込むことはできないこと。この点に関しては即詰みです。なので評価器と実行器のことは忘れて、能動的に着火する必要がある関数としてIOモナドの表現を考えます。また、副作用を含む合成可能な純粋関数としてのIOモナド（副作用のコンポーサブル化）を実現することを考えます。




では、さっそくF#でIOモナドを書いてみよう！となるわけですが、その前に、F#のもっとも優れた機能のひとつであり、F#でモナドを書く時に必要不可欠であるコンピューテーション式について簡単に触れておきたい。


コンピューテーション式は、あるF#コードを独自の解釈でユーザー定義することができる機能です。
つまり、F#言語構造の意味解析をプログラマが上書きしちゃえるんです。いわゆる言語指向プログラミング(LOP)を可能としています。非常に強力で面白い機能です。コンピューテーション式は、F#でモナドを実装するのにとても便利です。ただ、モナドを書くためだけに存在するものではなく、ドメイン固有言語(DSEL)としての利用も一般的です*5。for, if, yield!, use!, try withなどの補助的なキーワードの再定義も充実していて、モナドをより扱いやすいように式をカスタマイズすることもできます。目的によっては、コンピューテーション式（ビルダー）がモナドである（モナド則を満たす）必要はありません。




namespace CompExpr.Monad
open System
open Microsoft.FSharp.Core.Operators.Unchecked 

[<AutoOpen>]
module Base =
  /// ComExprBase
  type ComExprBase () = 
    member this.Using (x : #IDisposable, f) =
      use x = x 
      f x
    member this.TryWith (f, handler) =
      try f ()
      with e -> handler e
    member this.TryFinally (f, final) =
      try f ()
      finally final ()

/// IOモナドモジュール
module IO = 

  /// IO判別共用体
  type IO<'T> = internal IO of 'T

  let (>>) (_ : IO<_>) f = f ()
  /// bind
  let (>>=) (IO(a)) k : IO<_> = k a  

  let ioBind m k = m >>= k
  /// return
  let ioreturn a = IO a
  /// zero
  let iozero = IO ()

  /// IOビルダー
  type IOBuilder() =
    inherit ComExprBase ()
    member this.Bind (m, k) = m >>= k
    member this.Return x = ioreturn x
    member this.ReturnFrom m = m
    member this.Zero() = iozero
    member this.Delay (f : unit -> IO<_>) = f
    member this.Combine (g, f) = g >> f
    member this.For (xs : #seq<_>, f : (_ -> IO<unit>)) =
      xs |> Seq.fold (fun _ x -> f x) iozero 
    member this.Yield (x) = ioreturn x
    member this.YieldFrom (x) = x
    member this.While (condition, (f : (_ -> IO<unit>))) =
      while condition() do
        f () |> ignore 
      iozero

  /// IOビルダーを生成します。
  let io = IOBuilder ()

  let iowrap f a = IO (f a)
  let iowrap2 f a b = IO (f a b)
  let iowrap3 f a b c = IO (f a b c)

  let putChar = printf "%c" |> iowrap
  let putStr  = printf "%s"  |> iowrap
  let putStrLn  = printfn "%s"  |> iowrap
  let ioignore = fun _ ->  iozero

  let getLine = System.Console.ReadLine |> iowrap
  let getKey = System.Console.ReadKey |> iowrap
  let getCurrentTime = io { return DateTime.Now } <| ()

  let liftM f m = io { let! x = m <| ()
                       return f x}

  let join (IO(IO(a))) = io{ return a }

  type Either<'T, 'U> =
    |Left  of 'T
    |Right of 'U
       
  //try :: Exception e => IO a -> IO (Either e a)
  let tryIO io =
    try Right ((io:unit -> IO<_>) <| ())
    with e -> Left (id e)

  //catch :: Exception e => IO a -> (e -> IO a) -> IO a
  let catchIO io f = 
    try (io: unit->IO<_>) <| ()
    with e -> f e

  //finally :: IO a -> IO b -> IO a
  let finallyIO ioa iob = 
    try (ioa:unit -> IO<_>) <| ()
    finally (iob:unit ->IO<_>) <| () |> ignore

  let tryCatchFinallyIO io fio =
    try
      try Right ((io:unit->IO<_>) <| ())
      with e -> Left e
    finally
      (fio:unit -> IO<_>) <| () |> ignore

  let getContents =
    seq { let condition = ref true
          while !condition do
            let line = System.Console.ReadLine()
            if line = null then 
              condition := false
            yield fun () -> ioreturn line}

  let interact f = io { for x in getContents do
                          let! x = x <| ()
                          putStr (f x) |> ignore }


とりあずではありますが、IOモナドっぽい何かと、その周辺機能の一部を実装しました。モナド則も満たしています。着火タイミングについては、IOモナドの合成結果をunit -> IO<'T> にすることでプログラマが制御できるようにしています。また、コンピューテーション式の特徴を活かしてビルダー内で、if, for, use!, try with, try finally などが利用できるようにしました。



let hello = io { return! putStrLn "Hello,World!" }

let inout = io { let! s = getLine ()
                return! putStrLn s }
      
let h2 = 
  io { do! hello ()
       do! hello () 
       return "こんにちは、世界！"} 

let h3 = 
  io { let! s = h2 ()
       do! hello () 
       putStrLn s |> ignore
       do! inout ()
       do! hello ()
       return "さようなら" } 
      
let fire = 
io { let! s = h3 ()
        do! hello ()
        return s } 

fire () |> ignore
()

実行結果

Hello,World!
Hello,World!
Hello,World!
こんにちは、世界！
やっほー
やっほー
Hello,World!
Hello,World!


IOモナドであるinout内のgetLineで入力を求められるので、「やっほー」と入力します。すると、実行結果は上記のようになります。とりあえずOKですね。「さようなら」はignoreで捨てられました。



IOモナドの処理順序
モナドは評価順序を決定するという特徴をもっていました。それは遅延評価の場合のみ関係してくるわけではありません。それを確認するために、forld(foldl)とfoldBack(foldr)で、IOモナドの合成順序を逆にしても評価順序に変化がないことを確認してみましょう。


let aiueo = [io { return! putStrLn "あ"}; 
             io { return! putStrLn "い"};
             io { return! putStrLn "う"};
             io { return! putStrLn "え"}; 
             io { return! putStrLn "お"}]
                                      
aiueo |> Seq.iter (fun x -> x () |> ignore) 

let compose a b = fun () -> ioBind (a()) b
Console.WriteLine ("-----foldしても") |> ignore
let aiueo'' = List.fold (fun (a:unit->IO<_>) b -> compose a b) (fun ()->iozero) aiueo
aiueo'' () |> ignore

Console.WriteLine ("-----foldBackしても") |> ignore
let aiueo' = List.foldBack (fun (a:unit->IO<_>) b -> compose a b) aiueo (fun ()->iozero) 
aiueo' () |> ignore
Console.WriteLine ("同じ結果になるよね？") |> ignore

実行結果

あ
い
う
え
お
-----foldしても
あ
い
う
え
お
-----foldBackしても
あ
い
う
え
お
同じ結果になるよね？


はい。いずれも同じ結果になりますね。Haskellの場合はさらに遅延評価も絡んでくるのでまた事情がちょっと変わってきますが、正確評価のF#において、IOモナドの処理順序が確定的に明らかになっていることが確認できました。



IOモナドの無限リスト
IOモナドによって副作用を包み込むことで、副作用をあたかもファーストクラスとして扱えるようになりました。つまり、副作用を含む関数をリストに格納できることを意味します。IOモナドで、副作用の無限リストを表現してみましょう。

let hello = io { return! putStrLn "Hello,World!" }
let infiniteHello = Seq.initInfinite (fun x -> hello)
infiniteHello |> Seq.iter (fun x -> x () |> ignore)


Hello,World!フォーエバー…!!



5件だけ処理してみます。

let hello = io { return! putStrLn "Hello,World!" }
let infiniteHello = Seq.initInfinite (fun x -> hello)
infiniteHello |> Seq.take (5) |> Seq.iter (fun x -> x () |> ignore)


実行結果

Hello,World!
Hello,World!
Hello,World!
Hello,World!
Hello,World!


たいへんよくできました。



IOモナドと他のモナドを合成したい。
モナドを利用してプログラムを組んでいると、複数のモナドを組み合わせて扱いたくなるケースが多々でてきます。さまざまな領域の問題に対処するために必要なことです。例えば、IOモナドの中で「失敗するかもしれない計算」を扱いたいなんてことは、比較的多い要求のように思います。試しにIOモナドとMaybeモナドを組み合わせて利用してみましょう。

let fire = 
  io { 
    let! iom =  
      io {let! gl = getLine () 
          return maybe { return gl }
          } <| ()
    match iom with
    |Some x -> if x <> "" then 
                 putStrLn (x + x) |> ignore
               else 
                 putStrLn "入力してよねッ！ぷんぷくり〜ん（怒"  |> ignore
    |None -> ()}

fire () |> ignore


F#の立ち位置としてのIOモナドでは、上記のようにコンピューテーション式をネストして記述するかたちで、比較的簡単にモナドを合成することができます。ただ、ちょっと不吉なにおいがします。この程度のネストであれば許容範囲内かもしれないが、式が複雑化してくると可読性を犠牲にしてしまいそう。地獄のモナド「F#でモナドないわー、コンピューテーション式の多重入れ子ないわー、マジでないわー」と苛々しちゃうかもしれません。



そういえば、Haskellにはモナドを合成するための仕組みを持つ、モナド変換子というトランスレータがありました。IOモナドとMaybeモナドを合成するために、モナド変換子 MaybeTをちょっと真似てみましょう。




まず、合成対象のMaybeモナド

module Maybe = 
  open IO
  let bind x k =
      match x with
      | Some value -> k value
      | None   -> None

  let mreturn x = Some x

  type MaybeBuilder() =
    inherit ComExprBase ()
    member this.Bind(x, k) = bind x k
    member this.Return(x)  = mreturn x
    member this.ReturnFrom(x) = x
    member this.Delay(f)   = f()
    member this.Combine(a, b) = 
      if Option.isSome a  then a else b () 
    member this.Zero() = None
    member this.For(inp,f) =
        seq {for a in inp -> f a}
    member this.Yield(x) = mreturn x
    member this.YieldFrom(x) = x

  let maybe = new MaybeBuilder()

  let liftM f m = maybe { let! x = m
                          return f x}

そしてモナド変換子 MaybeT

module Maybe = 

......
　
  module Trans = 
 
    /// Maybeモナド変換子判別共用体
    type MaybeT<'T> = internal MaybeT of 'T

    /// bind
    let (>>=) (MaybeT(a)) k : MaybeT<_> = k a  

    let bindMaybeT m k = m >>= k
    /// return
    let maybeTreturn a = MaybeT a
    /// zero
    let maybeTzero = MaybeT ()
 
    /// Maybeモナド変換子ビルダー
    type MaybeTBuilder () =
      inherit ComExprBase ()
      member this.Bind(m, k) = m >>=  k
      member this.Return(a)  = maybeTreturn a
      member this.ReturnFrom(m) = m
      member this.Delay(f)   = f()
      member this.Combine(a, b) = 
        if Option.isSome a  then a else b () 
      member this.Zero() = maybeTzero
      member this.For(inp,f) =
          seq {for a in inp -> f a}
      member this.Yield(x) = maybeTreturn x
      member this.YieldFrom(x) = x

    // Maybeモナド変換子ビルダー
    let maybeT = new MaybeTBuilder ()

    /// MaybeTはMonadIOのインスタンスだとかなんとか
    /// IO a をMaybeT IO aに持ち上げます
    let liftIO (m:IO<_>) = maybeT {return m}

    /// MaybeTはMonadのインスタンスだとかなんとか
    let liftM f m = maybeT { return f m }

    /// コンストラクター
    /// MaybeT IO a -> IO (Maybe a)
    let runMaybeT (MaybeT(IO(a))) = 
      io { let! r = io { return maybe { return a } } <| () 
           return r}

module Unsafe =
  module IO =
    open IO
    /// 危険! (>_<)
    let unsafePerformIO (IO(a)) = a

MaybeTを使ってみます。

let fire = 
  io { 
    let iomaybe = Maybe.Trans.liftIO (getLine ()) |> runMaybeT <| ()
    let! x = iomaybe 
    match x with
    |Some x -> if x <> "" then 
                 putStrLn (x + x) |> ignore
               else 
                 putStrLn "入力してよねッ！ぷんぷくり〜ん（怒"  |> ignore
    |None -> ()}

fire () |> ignore


MaybeTを利用することで、IOモナドとMaybeモナドの合成をとてもシンプルに記述できました。それに、「ここでモナドを合成しているんだな！」ということが一目瞭然でわかりやすくなります。




F#で遅延評価をするには、unit -> 'T で処理の実行を遅らせる。あるいは System.Lazy<'T>によって、遅延評価をカプセル化します。つまり、遅延評価の処理を合成したい場合は、lazy関数の中で合成したいすべてのSystem.Lazy<'T>に対してForce()メソッドを呼び出せばよいということになります。

let result = 
  let a = lazy ("Hello,")
  let b = lazy ("World!")
  let h = lazy (a.Force() + b.Force()) 
  lazy ([for i in 0..4 -> h.Force()])

Seq.iter (printfn "%s")  <| result.Force()

たとえば、上記のような感じでlazyな関数は簡単に合成することができます。しかし、合成する際に必ず Force() で着火して評価しなればならず、着火漏れはバグの温床になりますし、見た目的にもどこか不恰好です。また、List.foldなどで、lazyな関数を合成したいような場合にも不便さを感じます。


F#のlazyは、System.Lazy<'T>型であらわされる遅延計算される値をカプセル化したものです。Lazy<'T>は遅延する値の入れ物とみなすことができます。ここで思い出されるのがモナド、あるいはコンピューテーション式です。モナドはジェネリックな関数合成を表現できて、どのように合成されるのかという実装の詳細を意識しなくてもよいという特徴がありました。ある入れ物に対して、モナド則を満たすようなBindとreturnを定義すれば、それはもう立派なモナドです。遅延評価な値を合成するための戦略を自作するとよさそうです。つまりオレオレモナドを作ることでこの不便さを解消できそうです。



とりあえず、基本的な実装をしてみます。以下のようになります。

namespace CompExpr.Monad

module Lazy =

  type LazyBuilder () =
    let force (x : Lazy<'T>) = x |> function | Lazy x -> x
    /// bind
    let (>>=) (x:Lazy<'a>) (f:('a -> Lazy<'a>)) : Lazy<'a> =
      lazy (x |> force |> f |> force)  
    /// zero
    let lazyzero = Seq.empty
    
    member this.Bind(x, f) = x >>= f
    member this.Return (x) = lazy x
    member this.ReturnFrom (x) = x
    member this.Zero() = lazyzero 
    member this.Delay f = f()

  let lazyz = LazyBuilder () 

  let lifM f (Lazy(a)) = lazy f a

利用側の実装サンプル

open System
open CompExpr.Monad.Lazy 

let result = 
  lazyz { let! a = lazy ("Hello,")
          let! b = lazy ("World!")
          return a + b}

result.Force() |> (printfn "%s") |> ignore
Console.ReadLine () |> ignore


実行結果

Hello,World!


で、とりあえずF#でコンピューテーション式として利用できるLazyモナドをつくることができたのですが、これだけだと利用する側は実はあまりうれしくありません。確かに、lazyな関数を合成する際に、Force ()メソッドを明示的に呼び出す部分を隠ぺいできましたが、この実装では単純な式を構築する場合にしか利用できません。lazyな関数をもっと直観的でかつ自由に組み立てることができる仕組みが欲しくなってきます。コンピューテーション式はそれができます。たとえば、コンピューテーション式内で、if式, for式, yield などを用いて遅延評価を合成しながら組み立てられるようにすると便利そうです。つまり、ドメイン固有言語（DSL)としての側面も持たせることで、さらに便利さが増します。





奥義とか言っちゃうと胡散臭さを禁じえませんが、あえてそう言い切っちゃいました。お察しください。



コンピューテーション式でドメイン固有言語（DSL)を作った経験をお持ちの方はおわかりの通り、
重要となってくるのは、Combine と Run をいかに使いこなすかということです。もちろん、コンピューテーション式で再定義可能なキーワードおよび、それに対応するすべてのメソッドが重要ですが、
コンピューテーション式を上手に使いこなす上で特に重要となってくるのが以下の２つメソッドです。



Combineメソッド



その名の通り式の「結合」を定義するためのものです。コンピューテーション式内の式の流れを統制するような役割を持っています。左から流れてくる式(式の境界線の上)を、右の式へ（式の境界線の下）受け流すというように、ムーディー勝山(消)をイメージすると理解しやすいです。さまざまな異なる式の変換をオーバーロード（多重定義）することで、柔軟な式を表現することができるようになります。ムーディー勝山は冗談なので忘れてください。




Runメソッド



これはコンピューテーション式の変換規則に明示されてはいませんが、ビルダークラス内で定義すると特殊な解釈がされます。Runメソッドを定義すると、builder {...}というコンピューテーション式を宣言すると同時にDelayメソッドが呼び出されます。つまり、最終的なビルダーの結果を決定づける定義を持たせることができ、最終的なビルダーの値を適切な型に変換する仕組みを提供していると解釈できます。Combineメソッドで扱っている式の流れにあわせて、最終的な式の結果を統一するのに役立ちます。もちろんオーバーロード（多重定義）可能です。Runメソッドの詳細については、The F# Draft Language Specification（http://goo.gl/7a1QH）を参照されたい。




F# Snippets(http://fssnip.net/)に投稿したものとして、冒頭でも紹介しましたが、LazyBuilderを作りました。


これは、ConbineとRunを効果的に利用した具体的な実装サンプルです。CombineおよびRunを多重定義することで、lazyな関数の合成を自然にコンピューテーション式内で表現可能にしています。また、IOモナドも扱えるように、F# Snippetsへ投稿したものに一部機能を追加しています。

namespace CompExpr.Monad
open CompExpr.Monad.IO 

module Lazy =

  type LazyBuilder () =
    let force (x : Lazy<'T>) = x |> function | Lazy x -> x
    /// bind
    let (>>=) (x:Lazy<'a>) (f:('a -> Lazy<'a>)) : Lazy<'a> =
      lazy (x |> force |> f |> force)  
    /// zero
    let lazyzero = Seq.empty

    let ioToLazyIgnore (xs:seq<Lazy<(unit -> IO<'T>)>>) = 
      xs |> Seq.reduce (fun (Lazy(a)) (Lazy(b)) -> 
            lazy (fun () -> (ioBind (a()) (fun x -> b()))) ) 
         |> fun (Lazy(x)) -> lazy (x() |> ignore)

    let ioToLazy (xs:seq<Lazy<(unit -> IO<'T>)>>) = 
      xs |> Seq.map (fun (Lazy(a)) -> a) |> fun x -> lazy (x)
    
    member this.Bind(x, f) = x >>= f
    member this.Return (x) = lazy x
    member this.ReturnFrom (x) = x
    member this.Zero() = lazyzero 
    member this.Delay f = f()

    member this.Combine (a,b) = 
      Seq.append a b 

    member this.Combine (a,b) = 
      Seq.append (Seq.singleton a) b

    member this.Combine (a,b) = 
      Seq.append a (Seq.singleton b) 

    member this.Combine (Lazy(a), Lazy(b)) = 
      lazy Seq.append a b 

    member this.Combine (a:Lazy<'T>, b:Lazy<seq<'T>>) = 
      (a,b) |> function | (Lazy x, Lazy y) -> lazy Seq.append (Seq.singleton x) y

    member this.Combine (a:Lazy<seq<'T>>, Lazy(b)) = 
      a |> function | Lazy x -> lazy Seq.append x (Seq.singleton b) 

    member this.Combine (a:Lazy<seq<'T>>, b:seq<Lazy<'T>>) =
      let notlazy (xs:seq<Lazy<'T>>) = xs |> Seq.map (fun (Lazy(a)) -> a)
      a |> function | Lazy x -> lazy Seq.append x (notlazy b) 

    member this.Combine (a:seq<Lazy<'T>>, b:Lazy<seq<'T>>) =
      let notlazy (xs:seq<Lazy<'T>>) = xs |> Seq.map (fun (Lazy(a)) -> a)
      b |> function | Lazy x -> lazy Seq.append (notlazy a) x  

    member this.For (s,f) =
      s |> Seq.map f 

    member this.Yield x = lazy x
    member this.YieldFrom x = x

    member this.Run (x:Lazy<'T>) = x
    member this.Run (xs:seq<Lazy<unit>>) = 
      xs |> Seq.reduce (fun a b -> this.Bind(a, fun _ -> b)) 
    member this.Run (xs:seq<Lazy<'T>>) = 
      xs |> Seq.map (fun (Lazy(a)) -> a) |> fun x -> lazy x

    member this.Run (xs:seq<Lazy<(unit -> IO<unit>)>>) = 
      xs |> ioToLazyIgnore
    member this.Run (xs:seq<Lazy<(unit -> IO<string>)>>) = 
      xs |> ioToLazy
    member this.Run (xs:seq<Lazy<(unit -> IO<int>)>>) = 
      xs |> ioToLazy
       
  let lazyz = LazyBuilder () 

  let liftM f (Lazy(a)) = lazy f a  
  let liftIO (Lazy(a)) = IO a


例1

let result = 
let h = 
  lazyz { let! a = lazy ("Hello,")
          let! b = lazy ("World!")
          return a + b}
  lazyz { for i in 0..4 do yield! h }
 
Seq.iter (printfn "%s")  <| result.Force()


実行結果

Hello,World!
Hello,World!
Hello,World!
Hello,World!
Hello,World!


例2
CombineとRunを実装しているので、以下のように書くことができる。

let lazyp n = lazy (printfn "%d" n)
let result2 = 
  let a = 
    lazyz {
        yield! lazyp 2
        ()}

  lazyz {
    yield! lazyp 0
    yield! lazyp 1
    yield! a
    for i in 3..5 do
      yield! lazyp i 
    yield! lazyp 6
    yield! lazyz {
              yield! lazyp 7
              yield! lazyp 8
              ()}
    for i in 9..10 do
      yield! lazyp i 
    yield! seq {for n in [11..15] -> lazyp n}
    yield! lazyz {
              yield! lazyp 16
              yield! lazyp 17
              ()}
    yield! lazyz {
              yield! lazyp 18
              yield! lazyp 19
              ()}
    yield! lazyp 20
    ()  }

result2.Force()


実行結果

0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20


例3
せっかくなのでIOモナドを利用したい。

let iom1 = 
  io { 
    return! getLine ()
    }

let iom2 = 
  io {
    let! s = iom1 ()
    return s}

let iom3 = 
  io {
    let! s = iom2 ()
    return! putStrLn s} 

let result1 = 
  lazyz {
    yield iom3
    yield iom3
    yield iom3
    ()
    }

let ioResult1 = io { return result1.Force()}
ioResult1 () |> ignore


let iom5 = 
  io {
    let! s = iom1 ()
    putStrLn s |> ignore
    return s}

let result2 = 
  lazyz {
    yield iom5
    yield iom5
    yield iom5
    ()
    }

let ioResult2 = result2.Force()
let io6 = 
  io{ 
      let xs = Seq.map (fun x -> x) ioResult2
      for x in xs do
        let! s =  x()
        putStrLn s |> ignore 
      return () 
  }

io6 () |> ignore
Console.ReadLine () |> ignore

まとめ


・モナドはさまざまなプログラミングの問題に適用できるメタ戦略である。圏論からきてるらしいけど、ただ使うぶんには小難しい理論は割とどうでもいい。
・モナドを理解するには、ある程度プログラミングの素養が必要だが、とんでもなく難しいというわけではない。無意識に使っていることさえある。
・ある問題に対するモナドの適用可能性については、モナドをジェネリックな関数合成として捉えるとイメージしやすい。
・F#の立ち位置としてのIOモナドは、「副作用のある関数とそうでない関数を切り分けて管理したい」という要求に対してはある程度意味のあることだ。
・コンピューテーション式でモナドを表現することができる。さらにそれを柔軟なものとする仕組みを持っている。
・コンピューテーション式のCombineとRunを効果的に使えるようになると、利便性の高いモナドあるいはDSELを作れるようになる。要チェックや。



お疲れさまでした。


追記：やばい。モナドって実は空気だった。

わたしはF#において、前方パイプライン演算子 (|>)はいい意味で空気のような存在だと思ってます*6。

(* F# *)
(>>) : ('a -> 'b) -> ('b -> 'c) -> ('a -> 'c)
(|>) : 'a -> ('a -> 'b) -> 'b


-- Haskell
(.) :: (b -> c) -> (a -> b) -> (a -> c)
($) :: (a -> b) -> a -> b
(=<<) :: Monad m => (a -> m b) -> m a -> m b
(>>=) :: Monad m => m a -> (a -> m b) -> m b
(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)


なるほど。($)演算子に似ているのは(=<<)の方だったかー。そして、(>>=)はF#の(|>)に似ているという事実。これつまり、モナドって空気だったんだ！（えっまじで？）みたいなアハ体験。そもそも、MonadはApplicative（適用可能）だったやん！ということに気づかされたのでありました。「ジェネリックな関数合成」というよりも「ジェネリックな関数適用」の方がより適切な表現でしたね。まぁイメージとしては大きくははずしていないと思うし、説明するための用語的には「関数合成」でもそんなにわるくはないとは思います。でも、これからは「関数適用」に改めたいと思います。本文中はそんな感じで脳内補完しつつ読みかえていただけると良いかなと思います。


いげ太先生ありがとう！

*1:モナドが満たすべき3つの法則

*2:数値や文字列のような基本的な値と同じように扱うことができる値

*3:値が実際に必要となるまで式の評価を遅らせる

*4:どうしてもすべての副作用をIOモナドの中に封じ込めたい！と言うのであれば、Haskellのような純粋関数型言語の利用をご検討ください。

*5:ただし、ほとんどの場合はモナドにしておいた方が便利で、きっと幸せになります。

*6:パイプライン演算子が好きすぎてC#で生きるのがつらい

F#で楽々breakとcontinue。継続モナドまじパネぇっす！

プログラミング F#2.0 F# Haskell 継続 コンピューテーション式 モナド

id:einblickerさんが、「F#で継続モナド - einblickerの日記」というステキな記事を書いてくださいました。グッジョブすぎる！


以前、F#で継続渡し形式(CPS)変換を抽象的に考えてみたら、それってつまりHaskellの継続モナドみたいなものでした。ということで継続ワークフロー(簡易版)作った。という記事を書いたのですが、
当時の私には継続モナドはとても難しく、モナドで包む部分とcallCCについて華麗にスルーしていました。
今回、einblickerさんのコードを読んで、継続モナドについて少し理解が深まりました。相変わらずとても難しいんですけど。


で、コードを読んでいて少し気づいたことがあったので、
einblickerさんのコードを踏まえつつ、自分ならこんな風に書くかなーというのを書いてみました。が、間違えていました。
コメントにてeinblickerさんにご指摘いただいたとおりに修正しました。また、YieldとYieldFromの実装を追加しました。
どうもありがとうございます。もう一度見直してみます。


ContMonad.fs

namespace Monad.ContMonad

[<AutoOpen>]
module ContMonad =
  type Cont<'r, 'a> = Cont of (('a -> 'r) -> 'r)

  let runCont (Cont c) = c
  let callCC f = Cont <| fun k -> runCont (f (fun a -> Cont <| fun _ -> k a)) k
  let creturn a = Cont <| fun k -> k a

  type ContBuilder () = 
    member this.Return(a) = creturn a 
    member this.ReturnFrom(a) = a
    member this.Bind(Cont c, f) = Cont <| fun k -> c (fun a -> runCont (f a) k)
    member this.Zero() = this.Return()
    member this.Combine(c1, c2) = this.Bind(c1, fun _ -> c2)
    member this.For(seq, f) = Seq.fold
                                (fun cc elem -> this.Combine(cc, f elem))
                                (f <| Seq.head seq) <| Seq.skip 1 seq
    member this.Delay (f) = f ()
    member this.Yield (a) = creturn a
    member this.YieldFrom (a) = a

  let cont = new ContBuilder ()

  type ContBuilder with 
    member this.foreach seq f =
      cont {
        do! callCC <| fun break' -> cont {
          for i in seq do
            do! callCC <| fun continue' -> cont {
              do! f i (break'()) (continue'())
            }
        }
      } |> runCont <| ignore


Sample.fs

namespace ConsoleApplication1

module Sample = 
  open Monad.ContMonad
  cont.foreach [1..20] (fun i  break' continue' -> cont {
      if i = 18 then
        do! break'
        printfn "foo"
      else if i % 2 = 0 then
        do! continue'
        printfn "bar"
      else
        printfn "%d" i
  })

  System.Console.WriteLine () |> ignore

  cont.foreach [1..20] (fun i  break' continue' -> cont {
      if i = 18 then
        do! break'
        printfn "foo"
      else
        for x in 1..i do
          printf "%d" x
        printfn ""
  })

  System.Console.ReadLine () |> ignore


実行結果

1
3
5
7
9
11
13
15
17

1
12
123
1234
12345
123456
1234567
12345678
123456789
12345678910
1234567891011
123456789101112
12345678910111213
1234567891011121314
123456789101112131415
12345678910111213141516
1234567891011121314151617


F#で楽々breakとcontinueできちゃってるよ。継続モナドまじパネぇっす！
（よいこは、「C#ならふつうにbreakとcontinueできるじゃん」とかなんとか言わない。）
ちなみに、 break と continue の２つのキーワードは将来利用するために予約されているので、
F#の今後のバージョンでサポートされるかもしれません。


おまけ：モナド則の確認

namespace ContMonad.UT

open System

module Tests = 
  open NUnit.Framework
  open FsUnit
  open Monad.ContMonad
      
  [<TestFixture>]
  type ``ContMonad モナド則`` () =
    let (>>=) m f = cont {let! x = m
                          return! f x}
    let return' x = cont { return x }

    let x = 1
    let m = cont { return 3 }
    let f x = cont { return 4 + x }
    let g x = cont { return 2 * x }

    let assertEqual (left, right) = 
      let result = cont {let! a1 = left
                         let! a2 = right
                         return a1 |> should equal a2} |> runCont <| ignore
      ()

    let (==) left right = assertEqual (left, right)

    [<Test>] 
    // モナド則１： return x >>= f == f x
    member test.``モナド則1`` () =
      return' x >>= f == f x

    [<Test>] 
    // モナド則２: m >>= return == m
    member test.``モナド則2`` () =
      m >>= return' == m

    [<Test>] 
    // モナド則３: (m >>= f) >>= g == m >>= (\x -> f x >>= g)
    member test.``モナド則3`` () =
      (m >>= f) >>= g == (m >>= (fun x -> f x >>= g))

  // nunit-gui-runner
  let main () = NUnit.Gui.AppEntry.Main([|System.Windows.Forms.Application.ExecutablePath|]) |> ignore
  main ()

Observableコンピューテーション式はモナド則を満たしているか否か。

プログラミング F#2.0 F# Rx コンピューテーション式 Haskell モナド

前回のエントリ「F#でRxる。よく訓練されたF#erはコンピューテーション式をつくる。」で紹介いたしました、
Observableコンピューテーション式について補足します。モナド則を満たしているか否かについてです。


Haskellにおいて、モナドがモナド則を満たしているとき、

1. (return x) >>= f == f x
　
2. m >>= return == m
　
3. (m >>= f) >>= g == m >>= (\x -> f x >>= g)

以上の三つの条件に満足しています。



モナドのすべてによると、最初の規則は return が >>=*1 に関して左単位元に なっていることを要請していて、
二番目の規則は return が >>= に関して右単位元になっていることを要請してる。 最後の規則は >>= に関する一種の結合法則とのことです。
これを初めて読んだときはさっぱりわかりませんでした。今も確信を持ってわかったとは言いきれませんが、まぁ、なんとなく雰囲気はつかんでいるつもりです。



Observableのコンピューテーション式では、どうでしょうか。

namespace FSharp.Rx.UT

open System

module Tests = 
  open System.Reactive 
  open NUnit.Framework
  open FsUnit
  open FSharp
  open FSharp.Rx
      
  [<TestFixture>]
  type ``monad soku `` () =
    [<Test>] 
    // モナド則１： return x >>= f == f x
    // return された値を保持するための変数(というか継続)は、なくしてしまうことができますよの規則
    // モナドで計算を繋ぐにしろ、もともと繋がっている計算をモナドでくるんでも一緒だね
    member test.``monad soku1`` () =
      observable {
        let! a1 = observable{ let! a = observable {return fun x -> x * 2} 
                              let! b = observable {return 3} 
                              return a b}
        let! a2 = observable{ return 3 |> fun x -> x * 2 }
        return a1 |> should equal a2
      } |> Rx.subscribe(fun _ -> ()) |> ignore 

    [<Test>] 
    // モナド則２： m >>= return == m
    // bindしてreturnしても結局同じことだよねの規則
    // あるいは、結局最後の式が return されることになるので、明示的な return は意味ナッシンというお話
    member test.``monad soku2`` () =
      let m1 = observable{ let! a = observable {return "F#"} 
                           return a}
      let m2 = observable{ return "F#" }
      Reactive.Testing.Extensions.AssertEqual(m1, m2)

    // モナド則３： m >>= (\x -> f x >>= g) == (m >>= f) >>= g
    // 多段ネストしたモナドでも(どんなに深くても)、結局のところ一段のモナドと等価ですよの規則
    [<Test>] 
    member test.``monad soku3`` () =
      let m1 = observable{ let! a = observable {return 3} 
                           let! b = observable {return 4}
                           let! x = observable {let! d = observable{return a}
                                                let! e = observable{return b}
                                                return d + e}
                           let! c = observable {return fun x -> x * 2}
                           return c x}
      let m2 = observable{ return 3 + 4 |> fun x -> x * 2 }
      Reactive.Testing.Extensions.AssertEqual(m1, m2)

  // nunit-gui-runner
  let main () = NUnit.Gui.AppEntry.Main([|System.Windows.Forms.Application.ExecutablePath|]) |> ignore
  main ()


ごくごく単純な確認ですので、正確な証明とまではいきませんが、
Observableコンピューテーション式が、モナド則を満たしているであろうことをゆるく確認することができます。
てゆうか、Observableコンピューテーション式は、単純にRxのObservableをはめ込んで適用しただけの代物なので、
Rxがそもそもモナド則を満たしているというのが本当のところです。RxのObservableはまさにモナドなのです。





[追記]

@nobuhisa_kさんに、コメントにてナイスつっこみを頂きました！
おっしゃるとおりで、上記のモナド則３の確認は間違えていますね。
モナド則３は、誤解を恐れずイメージしやすいように大雑把に言うと、「(2 * 3) * 4 * 5 == 2 * (3 * 4) * 5」だよねみたいな。
モナドにおいてもこれと同じことが成立していて欲しいと。していなきゃ困ると。


ということで、丸パクリで書き直してみました。


お手軽にお試しできる版

let x = 1
let m = observable { return 3 }
let f x = observable { return 4 + x }
let g x = observable { return 2 * x }
let (>>=) m f = observable {let! x = m
                            return! f x}

let return' x = observable { return x }

let prove (left,right) = 
  observable {let! x = (left:IObservable<'a>)
              let! y = (right:IObservable<'a>)
              return x = y}

prove (return' x >>= f, f x) |> Rx.subscribe(fun b -> printfn "モナド則1 : %b" b) |> ignore // true
prove (m >>= return', m) |> Rx.subscribe (fun b -> printfn "モナド則2 : %b" b) |> ignore // true
prove ((m >>= f) >>= g, m >>= (fun x -> f x >>= g)) |> Rx.subscribe(fun b -> printfn "モナド則3 : %b" b) |> ignore // true

よりテストっぽく

namespace FSharp.Rx.UT

open System

module Tests = 
  open System.Reactive 
  open NUnit.Framework
  open FsUnit
  open FSharp
  open FSharp.Rx
      
  [<TestFixture>]
  type ``Observable モナド則`` () =
    let (>>=) m f = observable {let! x = m
                                return! f x}
    let return' x = observable { return x }

    let x = 1
    let m = observable { return 3 }
    let f x = observable { return 4 + x }
    let g x = observable { return 2 * x }

    let assertEqual (left, right) = Reactive.Testing.Extensions.AssertEqual((left:IObservable<'a>), right)
    let (==) left right = assertEqual (left, right)

    [<Test>] 
    // モナド則１： return x >>= f == f x
    member test.``モナド則1`` () =
      return' x >>= f == f x

    [<Test>] 
    // モナド則２: m >>= return == m
    member test.``モナド則2`` () =
      m >>= return' == m

    [<Test>] 
    // モナド則３: (m >>= f) >>= g == m >>= (\x -> f x >>= g)
    member test.``モナド則3`` () =
      (m >>= f) >>= g == (m >>= (fun x -> f x >>= g))

  // nunit-gui-runner
  let main () = NUnit.Gui.AppEntry.Main([|System.Windows.Forms.Application.ExecutablePath|]) |> ignore
  main ()


わかりやすい。これならHaskellな人にも怒られなさそうですｗ
コンピューテーション式(Computation Expressions)をつくったら、
こんな風にモナド則を満たしているかどうか確認するとよいですね(実際はもっと抽象化した方がいい)。
これでモナド則ももうこわくないでござる。


あわせて読みたい

モナド則を満たすべき理由 - HaHaHa!(old)
http://haskell.g.hatena.ne.jp/nobsun/20080928/p1


これは参考になる

*1:bind

モナディックなパーサ・コンビネータFParsecを使おう。てゆうかParsec(Haskell)のApplicativeスタイルがやばい。

F#2.0 F# FParsec Haskell Parsec モナド パーサ・コンビネータ 構文解析 正規表現

Parsec(Haskell)のApplicativeスタイルがやばすぎるので、FParsecでApplicativeスタイルしてみた。


FParsecとは

FParsec とは Haskell のパーサ・コンビネータライブラリ Parsec をF#に移植したものです*1。
では、パーサ・コンビネータとはなんでしょうか。簡単に言うとパーサ(構文解析)の関数を組み合わせることで、
新たに複雑なパーサを作り上げるための仕組み(フレームワーク)と考えておけばよいでしょう。ファイルやいろいろな型のデータの構文解析に力を発揮します。


構文解析といえば正規表現を思い浮かべる人も多いかもしれません。正規表現は多くの場合とても便利ですが、複雑なデータ構造を扱うには不向きです。
パーサ・コンビネータは、時に正規表現に対する“より良い代替案”になり得ます*2。
FParsecを用いることで、無限先読みの文脈依存文法を解析したり、BNF記法で表すような複雑なパーサも比較的簡単に作ることができます。
噂によるとHaskellのParsecはLL構文解析において最高の性能を発揮するそうです。FParsecも同じような雰囲気ですたぶん。
ということで、難しいことはよくわかりませんが、魔神英雄伝ワタルよろしくなんだか面白カッコ良さそうなので利用しない手はないです。


環境

F# 2.0.0
FParsec 0.8.0.0


準備１：FParsecをビルドする

FParsecを利用するには、まずここ から FParsec のソースコードをダウンロードし、適当なディレクトリに解凍してビルドします。
すると、めでたくFParsec.dllとFParsecCS.dllを手に入れることができます。ありがたや。


準備２：参照設定とモジュールのオープン

さっそくFParsec.dllとFParsecCS.dllを参照設定に追加します。




そして、利用するFParsecの各モジュールをオープンします。

open System
open FParsec.Primitives
open FParsec.CharParsers
open FParsec.Error


これでFParsecを利用する環境が手に入りました。やったね。


FParsec：パースの基本

FParsec - A Parser Combinator Library for F#に解説と基本的なサンプルコードが出ています。
サンプルコードを動かすと、なんとなく雰囲気がつかめます。
ただ、ドキュメントの内容が古くなってしまっていて、すべてをそのまま適用できないのが残念なところです。


さっそく何かパースしてみましょう。
まったく面白くもなんともありませんが、例えば1つの文字をパースするパーサはこう書けます。

let test s = match run letter s with
             | Success (r,us,p)   -> printfn "success: %A" r
             | Failure (msg,err,us) -> printfn "failed: %s" msg

let _ = test "ふじこｌｐ777"
let _ = test "1ふじこｌｐ777"


実行結果

success: 'ふ'
failed: Error in Ln: 1 Col: 1
1ふじこｌｐ777
^
Expecting: letter


letterの型はParserとなっています。
正確には、unicode letter(System.Char.IsLetterがtrueを返すもの)をパースするシンプルなパーサです。
runはパーサと対象を受け取ってパースを実行して結果を返す関数で、
成功した場合はSuccess、失敗した場合はFailureを判別共用体 ParserResult<'Result,'UserState>で返します*3。
例の「"1ふじこｌｐ777"」のパースは、先頭が数字(System.Char.IsLetter('1')はfalse)なので失敗していることがわかります。



もちろん letter の他にも以下のような基本的なパーサがいくつも定義されています。
でもぶっちゃけ全然足りてないですね。字句解析を真面目にやるなら不足分は自分で作るしかないですね。

anyOf: string -> Parser<char,'u>
 「任意の文字列(引数:string)に含まれるすべてのchar」をパース

noneOf: string -> Parser<char,'u>
 「任意の文字列(引数:string)に含まれるすべてのchar」を含まないパース

asciiUpper: Parser<char,'u>
 ASCII letter (大文字)をパース

asciiLower: Parser<char,'u>
 ASCII letter (小文字)をパース

asciiLetter: Parser<char,'u>
 ASCII letterをパース

upper: Parser<char,'u>
 unicode letter(大文字)をパース

lower: Parser<char,'u>
 unicode letter(小文字)をパース

digit: Parser<char,'u>
 数字([0-9])をパース

ちなみに１つ以上の複数のunicode letter(System.Char.IsLetterがtrue)をパースするパーサはこう書けます。

let test2 s = match many1 letter |> run <| s with
              | Success (r, s, p) -> printfn "%A" r
              | Failure (msg, err, s) -> printfn "%s" msg

let _ = test2 "ふじこｌｐ777"
let _ = test2 "1ふじこｌｐ777"


実行結果

['ふ'; 'じ'; 'こ'; 'ｌ'; 'ｐ']
Error in Ln: 1 Col: 1
1ふじこｌｐ777
^
Expecting: letter


選択

(<|>)、choice関数

(<|>)演算子あるいは、choice関数でパーサを選択することができる。
意味としては、正規表現で言うところの「|」（どれかにマッチ）と同じと考えて差し支えはない。
ただし、(<|>)演算子は、常に左側の選択肢を最初に試すということには注意。

unicode letterあるいは数字に一致する１文字以上にパース

let ld = (letter <|> digit |> many1Chars) 
         |> run <| "ABC12D34;EF5"
match ld with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg


実行結果

"ABC12D34"


もちろんコンピューテーション式で記述することもできる

let ld' = parse {let! anc = choice [letter;digit] |> many1Chars
                 return anc}
          |> run <| "ABC12D34;EF5"
match ld' with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg
Console.WriteLine () |> ignore


(.>>)、(>>.)

括弧内の1つ以上の数字をcharのリストとしてパース
many1がみそですね。ただのmanyだと１文字もマッチしなくてもパースが成功します。

let e1 = run (pchar '(' >>. (many1 digit) .>> pchar ')') "(123456)"
match e1 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg


実行結果

['1'; '2'; '3'; '4'; '5'; '6']


括弧内の1つ以上の数字をstringとしてパース
many1Charsがみそですね。ただのmanyCharsもmanyと同様に、１文字もマッチしなくてもパースが成功します。

let f = pchar '(' >>. (many1Chars digit) .>> pchar ')'
        |> run <| "(123456)"
match f with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg


実行結果

"123456"


unicode letterおよび#+.をパース（ただし、lowerは読み捨てる）

let notlower1 = (letter <|> anyOf "#+.") .>> manyChars lower |> manyChars
               |> run <| "F#C#C++javaVB.NET"
match notlower1 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg


実行結果

"F#C#C++VB.NET"

連結

連結とはまさにパースとパースを繋ぎ合わせることです。
以下は、「unicode letterと数字が隣り合う文字列」に一致する１文字以上にパース

let cn = (pipe2 letter (many1Chars digit) (fun x y -> string(x)+string(y)) |> manyStrings) 
         |> run <| "A1B2C345;D6"
match cn with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg


もちろんコンピューテーション式として記述することもできる

let cn' = parse {let! anc = letter 
                 let! d = many1Chars digit 
                 return string(anc)+string(d)} |> manyStrings
          |> run <| "A1B2C345;D6"
match cn' with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

unicode letterと隣り合うセミコロンも許容する

let cn'' = parse {let! anc = letter 
                  let! d = many1Chars digit <|> (anyOf ";" |> many1Chars)
                  return string(anc)+string(d)} |> manyStrings
           |> run <| "A1B2C3D;E45;F6"
match cn'' with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg


実行結果

"A1B2C3D;E45"


正規表現の併用


正規表現を使わない場合

let str = @"(*comme
nt123a*)bc4d*)"

let comment1 = pstring "(*" >>. many1Chars (choice [digit;letter;newline] ) .>> pstring "*)"
               |> run <| str
match comment1 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg


正規表現を併用して使う

let comment2 = between (pstring "(*") (pstring "*)") (regex "[^*)]+") 
               |> run <| str
match comment2 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

実行結果

"comme
nt123a"
"comme
nt123a"

FParsecは正規表現の代替案になり得るのは間違いない。
しかし、正規表現の長所すべてを否定するものではない。
正規表現の長所はそのままFParsecの中で生かすことができる。

let kanji = regex "[一-龠]" <?> "kanji"

let kr = kanji |> many1 |> run <| "読書百遍意自ずから通ず"
match kr with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

実行結果

["読"; "書"; "百"; "遍"; "意"; "自"]


というように、正規表現を導入することで漢字のパーサを簡単かつ正確に作ることができます。
(<?>)演算子は、解析器が失敗したときのエラーメッセージをカスタマイズするためのものです。



とあるパーサをn回適用したパーサ


とあるパーサをn回適用したパーサを取得する関数repeatを定義する

let repeat n p =
  let rec repeat n p result =
    parse {if n > 0 then
             let! x = p
             let! xs = repeat (n - 1) p (result@[x])
             return xs
           else
             return result}
  repeat n p []


unicode letterを読み捨てて、数字3桁をパースする 

let d3 = letter <|> digit .>> many letter >>. repeat 3 digit
         |> run <| "aBc1234dEf"

match d3 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg


実行結果

['1'; '2'; '3']

let w = repeat 3 (pstring "うぇ")
         |> run <| "うぇうぇうぇうぇうぇうえぇえぇええｗｗｗｗ"

match w with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg


実行結果

["うぇ"; "うぇ"; "うぇ"]

先読み

FParsecにはattemptがあって、これを使って先読みを表現することができる(Parsecでいうところのtryに相当)。
attemptは解析関数(Parser<_,_>)を１つ取って、解析が成功しなかった場合、attempは入力を消費しない。
なので、(<|>)演算子の左側でattempを使うと、attemp内での消費がなかったものとして右側を試しま。attemptって名前のとおりです。

let w2 = repeat 3 (pstring "うぇうぇ")
         |> run <| "うぇうぇうぇうぇうぇうえぇえぇええｗｗｗ"

match w2 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg


let w3 = attempt (repeat 3 (pstring "うぇうぇ")) <|> (repeat 5 (pstring "うぇ"))
         |> run <| "うぇうぇうぇうぇうぇうえぇえぇええｗｗｗ"

match w3 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg


実行結果

Error in Ln: 1 Col: 9
うぇうぇうぇうぇうぇうえぇえぇええｗｗｗ
        ^
Expecting: 'うぇうぇ'

["うぇ"; "うぇ"; "うぇ"; "うぇ"; "うぇ"]


単純なパーサ：郵便番号

郵便番号パーサ　正規表現

let r = parse {let! d = regex "^\d{3}-\d{4}$" in return d}
let zip = (r, "001-0016") ||> run
match zip with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg


郵便番号パーサ 正規表現未使用

let zip2 = parse {let! p= pipe3 (repeat 3 digit) (pchar '-') (repeat 4 digit) (fun x y z -> x@[y]@z)
                  do! notFollowedBy (digit <|> letter)
                  return new string (List.toArray p)}
           |> run <| "001-0016"
match zip2 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg


実行結果

"001-0016"
"001-0016"


単純なパーサ：改行区切り

改行区切りでパースする

let pline =
   parse {let! first = anyChar 
          if first = '\n' then 
            return "" 
          else 
            let! txt = restOfLine 
            return (first.ToString()+txt)} 

let strings' = run (many pline) "\n\nHoge1\nFuga\n\nPiyo" 
match strings' with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

内部的にどうなっているのか、もっと詳細な書き方をした場合

let pline': Parser<string, unit> =
    fun state ->
       let mutable str = null
       let newState = state.SkipRestOfLine(true, &str)
       if not (LanguagePrimitives.PhysicalEquality state newState) then
           Reply(str, newState)
       else
           Reply(Error, NoErrorMessages, newState)

let strings'' = run (many pline') "\n\nHoge1\nFuga\n\nPiyo"
match strings'' with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg


実行結果

[""; ""; "Hoge1"; "Fuga"; ""; "Piyo"]
[""; ""; "Hoge1"; "Fuga"; ""; "Piyo"]


Applicativeスタイルがやばい

Applicativeのススメ - あどけない話
http://d.hatena.ne.jp/kazu-yamamoto/20101211/1292021817

Real World Haskell - Chapter 16. Using Parsec Applicative functors for parsing
http://book.realworldhaskell.org/read/using-parsec.html



Applicativeスタイル*4がやばい。やばすぎるよ！
ということで、冒頭でも書いたが、FParsecでApplicativeスタイルしてみた。


module FParsec.Applicative
open System
open FParsec.Primitives
open Microsoft.FSharp.Core.Operators.Unchecked 

/// ap :: Monad m => m (a -> b) -> m a -> m b
let inline ap f a = f >>= fun f' -> a >>= fun a' -> preturn (f' a') 

/// (<*>) :: Applicative f => f (a -> b) -> f a -> f b
let inline (<*>) f a = ap f a

/// (<**>) :: Applicative f => f a -> f (a -> b) -> f b
let inline apr f a = a <*> f
let inline (<**>) f a = apr f a

/// liftA :: Applicative f => (a -> b) -> f a -> f b
let inline liftA f a = a |>> f 

/// (<$>) :: Functor f => (a -> b) -> f a -> f b
let inline (<!>) f a = liftA f a 

/// (<$) :: Functor f => a -> f b -> f a
let inline (<!) f a = preturn f .>> a
let inline (!>) f a = f >>. preturn a

/// liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
let inline liftA2 f a b = pipe2 a b f         // preturn f <*> a <*> b 
let inline (<!!>) f a b = liftA2 f a b 

/// liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
let inline liftA3 f a b c = pipe3 a b c f
let inline (<!!!>) f a b c = liftA3 f a b c

/// ( *>) :: Applicative f => f a -> f b -> f b
let inline ( *>) x y = x >>. y                 // liftA2 (fun _ z -> z) x y 

/// (<*) :: Applicative f => f a -> f b -> f a
let inline ( <*) x y = x .>> y                 // liftA2 (fun z _ -> z) x y 

/// sequenceA :: Applicative f => [f a] -> f [a]
let sequenceA ps = List.foldBack (liftA2 (fun x y -> x::y)) ps (preturn [])

/// sequenceA_ :: Applicative f => [f a] -> f ()
let sequenceA_ ps = List.fold ( *>) (preturn ()) ps

/// mapA :: Applicative f => (a -> f b) -> [a] -> f [b]
let mapA f xs = sequenceA (List.map f xs)

/// mapA_ :: Applicative f => (a -> f b) -> [a] -> f ()
let mapA_ f xs = sequenceA_ (List.map f xs)

/// foreverA :: Applicative f => f a -> f b
let rec foreverA a = a *> foreverA a

/// asum :: Alternative f => [f a] -> f a
let sumA ps = List.fold (<|>) (preturn defaultof<'a>) ps

//filterA :: Applicative f => (a -> f Bool) -> f [a] -> f [a]
let filterA f ps = 
  let addIf x b xs = if b then x::xs else xs
  let consA x a = liftA2 (addIf x) (f x) a
  List.foldBack consA ([]) ps

/// zipWithA :: Applicative f => (a -> b -> f c) -> [a] -> [b] -> f [c]
let map2A f xs ys = sequenceA (List.map2 f xs ys)

/// zipWithA_ :: Applicative f => (a -> b -> f c) -> [a] -> [b] -> f ()
let map2A_ f xs ys = sequenceA_ (List.map2 f xs ys)

/// mapAndUnzipA :: Applicative f => (a -> f (b, c)) -> [a] -> f ([b], [c])
let mapAndUnzipA f xs = liftA List.unzip (mapA f xs)

/// replicateA :: Applicative f => Int -> f a -> f [a]
let replicateA n a = sequenceA (List.replicate n a)

/// replicateA_ :: Applicative f => Int -> f a -> f ()
let replicateA_ n a = sequenceA_ (List.replicate n a)

/// unlessA :: Applicative f => Bool -> f () -> f ()
let unlessA b a = if b then preturn () else a

/// guardA :: Alternative f => Bool -> f ()
let guardA b = unlessA b (preturn ())

/// whenA :: Applicative f => Bool -> f () -> f ()
let whenA b a = if b then a else preturn ()


ということで、FParsecはHaskellのParsec同様にモナディックなパーサ・コンビネータであることがわかります。
ちなみに、コメントの型表記はHaskell形式です。
当然ながらF#的な型を表すものではありませんし正確でもありません。あしからず。



Applicativeスタイルを適用すると、

let foo m1 m2 f = 
  parse {let! a= m1
         let! b = m2
         return f a b}

というように、コンピューテーション式でこう書いていたものが

let foo' m1 m2 f = f <!> m1 <*> m2

こう書けます。あらまあ、きれいにコンピューテーション式なスタイルがなくなりました。


(<!>)演算子と(<*>)演算子を隠してみると以下のようになります。

let foo' m1 m2 f = f m1 m2

これはつまり、Applicativeがf m1 m2 という関数適用の形になっていることを表します。
Applicaitveを用いると、パーサをとても自然に表現することができるということです。
これが Applicative (適用できる)と呼ばれる由来です。


CSVファイルのパース


リア充本としても知られる「Real World Haskell」に掲載されているParsecによるCSVファイルパーサのお手本。
http://book.realworldhaskell.org/read/using-parsec.html

import Text.ParserCombinators.Parsec

csvFile = endBy line eol
line = sepBy cell (char ',')
cell = quotedCell <|> many (noneOf ",\n\r")

quotedCell = 
    do char '"'
       content <- many quotedChar
       char '"' <?> "quote at end of cell"
       return content

quotedChar =
        noneOf "\""
    <|> try (string "\"\"" >> return '"')

eol =   try (string "\n\r")
    <|> try (string "\r\n")
    <|> string "\n"
    <|> string "\r"
    <?> "end of line"

parseCSV :: String -> Either ParseError [[String]]
parseCSV input = parse csvFile "(unknown)" input

main =
    do c <- getContents
       case parse csvFile "(stdin)" c of
            Left e -> do putStrLn "Error parsing input:"
                         print e
            Right r -> mapM_ print r

実にエレガントですね。



何も考えずに、F#へ移植してみる

let quotedChar = noneOf "\"" 
             <|> attempt (pstring "\"\"" >>. pchar '"')

let quotedCell = pchar '"' 
             >>. manyChars quotedChar 
             .>> pchar '"' 
             <?> "quote at end of cell"

let cell = quotedCell
       <|> manyChars (noneOf ",\n\r")

let line = sepBy cell (pchar ',')

let eol = attempt (newline) <?> "end of line"
let csvFile = sepEndBy line eol
let parseCSV input = (csvFile, input) ||> run

let ReadFile filename = System.IO.File.ReadAllText(filename,System.Text.Encoding.GetEncoding("UTF-8")) 
let csv = @"D:\test\Data\sample.csv" |>  ReadFile
match parseCSV csv with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg
Console.ReadLine () |> ignore

なんという写経。




適用箇所少ないけど、Applicativeスタイルにしてみる。

open FParsec.Applicative

let quotedChar = noneOf "\"" <|> attempt ('"' <! pstring "\"\"")
let quotedCell = pchar '"' *> manyChars quotedChar <* pchar '"' 
             <?> "quote at end of cell"
let cell = quotedCell <|> manyChars (noneOf ",\n\r")
let line = sepBy cell (pchar ',')
let eol = attempt newline <?> "end of line"
let csvFile = sepEndBy line eol
let parseCSV input = (csvFile, input) ||> run

let ReadFile filename = System.IO.File.ReadAllText(filename,System.Text.Encoding.GetEncoding("UTF-8")) 
let csv = @"D:\test\Data\sample.csv" |>  ReadFile 

match parseCSV csv with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg
Console.ReadLine () |> ignore


ふつくしい…！



あわせて読みたい

マジあわせて読みたい。


シンプルで高速な構文解析ライブラリ「Parsec」を.NETで使う^^ - yuji1982の日記
http://d.hatena.ne.jp/yuji1982/20080627/1214558307

最強のパーザー、Parser Combinator - 純粋関数型雑記帳
http://d.hatena.ne.jp/tanakh/comment?date=20040730

正規表現を超える - あどけない話
http://d.hatena.ne.jp/kazu-yamamoto/20090309/1236590230

正規表現ちっくなパーサーコンビネーター - あどけない話
http://d.hatena.ne.jp/kazu-yamamoto/20110131/1296466529

Applicativeのススメ - あどけない話
http://d.hatena.ne.jp/kazu-yamamoto/20101211/1292021817

Applicative よりも Monad の方が力が強い理由 - あどけない話
http://d.hatena.ne.jp/kazu-yamamoto/20100525/1274744955

Parsing with applicative functors in F# - Bug squash
http://bugsquash.blogspot.com/2011/01/parsing-with-applicative-functors-in-f.html

例によるApplicativeパーシング
http://www.mokehehe.com/realworldhaskell/index.php?Parsec%20%A5%D1%A1%BC%A5%B7%A5%F3%A5%B0%A5%E9%A5%A4%A5%D6%A5%E9%A5%EA#content_1_11

F# FParsec で（とりあえず）Forthを作る - 還暦プログラマの挑戦(Haskell に挑む→F#による言語造り)
http://www.cmas60.com/FS/fparsec.php


最後に

関数型的であり、ひじょーにCOOOOLなApplicativeスタイルではありますが、
当然ながら、使いこなすにはある程度の関数脳レベルが要求されるので、素人にはおすすめできない諸刃の剣。


ですから「F#でそれをやる意味あんの？」と問われたら、「慣れれば意味あるけど、慣れないうちは爆死必至だよ。」とでも答えよう。
そもそも、F#には、コンピューテーション式という、すばらしく可読性の高いステキスタイルがあらかじめ言語レベルで用意されているので、
あなたが、より意味を伝えるよう意識してコードを記述する善良なプログラマならば、わざわざApplicativeにする理由はこれっぽっちもない。
FParsecでのApplicativeスタイルは、まぎれもなく変態さん向け。変態さん個人で利用する場合、もしくは変態さんが
変態さんとコミュニケーションするためにはこの上ない良いツールです。それ以外のケースではうまく機能しないことは言うまでもありません。


なにはともあれ、FParsecは良い道具です。ご賞味あれ。

*1:FParsecもモナドだよとか言ったらその筋の人に怒られそうだけど、まぁ制限付モナドとして捉えるのは間違いじゃないんじゃないか

*2:便利だけど適用は割と難しい。主に学習コスト的な意味で。

*3:Parsec(Haskell)の場合だと、Eitherで返す

*4:「Real World Haskell」日本語翻訳版には、作用型解析という名前で紹介されています

F#で継続渡し形式(CPS)変換を抽象的に考えてみたら、それってつまりHaskellの継続モナドみたいなものでした。ということで継続ワークフロー(簡易版)作った。

プログラミング F# Haskell モナド

[前置き]

継続とは

プログラミングにおいて「継続」とは、ある計算のある時点における「残りの計算」を表す概念のこと。
つまり、ある計算過程の瞬間におけるその過程の未来全体を表すものを意味する。
プログラミング言語で継続を扱う機能を導入すると、ユーザによるプログラムの実行順序の制御が可能になる。
プログラミングスタイルとして継続を表現したのが、継続渡しスタイルである。


詳しくは、下記のページを参照されたい。
なんでも継続
http://practical-scheme.net/docs/cont-j.html


継続渡し形式(CPS)とは

継続渡しスタイル(Continuation Passing Styleの頭文字をとってCPS)は、実際のプログラムの中では
継続をクロージャとしてコールバック関数として渡すような関数を定義するプログラミングスタイルのこと。



[本題]

F#で継続渡しスタイル(CPS)変換を抽象的に考えてみたら、それってつまりHaskellの継続モナドみたいなものでした。

檜山正幸のキマイラ飼育記 - CPS（継続渡し方式）変換をJavaScriptで説明してみるべ、ナーニ、たいしたことねーべよ
http://d.hatena.ne.jp/m-hiyama/20080116/1200468797

を読んでいて、「CPS変換を行うメタメタ関数」ってのが面白いなあと思いまして、
継続渡しスタイル(CPS)を抽象的に考えて、F#でもCPS変換を簡易的に行えるメタメタ関数を作ったら面白そうかなと考えていました。
しばらくして、そういえばHaskellにそんなんあったっけなあ・・。そこで思い出したのがHaskellの継続モナド。

モナドのすべてより「Continuationモナド(継続モナド)」
http://www.sampou.org/haskell/a-a-monads/html/contmonad.html

上記リンク先の説明にあるように、継続モナドはCPSの計算を抽象的に表現しているモナドです。
継続渡しスタイルな関数(以下CPS関数)は、引数に関数をとり、自身の処理の最後でその関数(継続)を呼ぶというもので、CPS関数に継続として別のCPS関数を渡し、その別のCPS関数に継続として更に別のCPS関数を渡してゆく連鎖、つまりCPS関数のネストが、全体として継続渡しスタイルなプログラムを形成することになる。
CPS関数をモナドにくるんで >>=(bind関数)で繋ぐことで、継続モナドはCPS変換を行うメタメタ関数な表現を実現していると言える。


F#で継続ワークフロー(簡易版)を作ってみましょう
よろしいならばF#で継続ワークフローだ。
ということで、簡易なCPS変換をサポートする継続ワークフローを作ってみる。

ContinuationWorkflow.fs

#light
namespace Workflow

///継続ワークフロー
type ContinuationBuilder() = 
  ///CPS変換します
  member this.Return(a) = fun k -> k a
  ///継続バインド
  member this.Bind(m,f) = fun k -> m (fun a -> f a k)

module ContinuationWorkflow = 
 ///ContinuationBuilderを生成します
 let cps = new ContinuationBuilder()

たったこんだけです。基本的にHaskellの継続モナドからパクっただけみたいなってゆー(笑
モナドで包む部分とcallCCについては、よくわからない＆面倒くさい＆今回の主目的ではないので華麗にスルーしました。


ちなみに、Haskellの継続モナドの定義

newtype Cont r a = Cont { runCont :: ((a -> r) -> r) } 
  
instance Monad (Cont r) where 
    return a       = Cont $ \k -> k a                       
    (Cont c) >>= f = Cont $ \k -> c (\a -> runCont (f a) k) 

class (Monad m) => MonadCont m where 
    callCC :: ((a -> m b) -> m a) -> m a 
 
instance MonadCont (Cont r) where 
    callCC f = Cont $ \k -> runCont (f (\a -> Cont $ \_ -> k a)) k


継続ワークフローをお試し
では、さっそく継続ワークフローを味見してみる。

ContinuationWorkflowTest.fs

#light
open System
open Workflow.ContinuationWorkflow 

module CpsTest = 
 let Test1 =
  let f x = cps {return "F",x }
  let sharp (x,y) = cps {return  x + "#", y}
  let beginner (x,y) = cps {return y + "は" + x + "初心者です。"}
  let expert (x,y) = cps {return y + "は" + x + "達人です。"}

  //継続ワークフローで継続渡しスタイル (遅延評価)
  let fsharp x =
    cps {let! a = f x
         let! b = sharp a 
         match x with 
         "zecl"   -> let! c = beginner b
                     return lazy c
         | _      -> let! c = expert b
                     return lazy c
        }

  //お試し
  printfn "%s" <| fsharp "zecl" (fun x -> x.Force ())
  printfn "%s" <| fsharp "Don Syme" (fun x -> x.Force ())
  printfn ""


 let Test2 =
  //ふつうのフィボナッチ数列
  let rec fibo n =
    if n <= 1 then 1
    else fibo (n - 1) + fibo (n - 2)

  //継続渡しスタイルで書いたフィボナッチ数列
  let rec fiboCps n cont =
    if n <= 1 then cont 1
    else fun x -> fiboCps (n - 2) <| fun y -> cont (x + y)
         |> fiboCps (n - 1) 


  //継続渡しスタイルのフィボナッチ数列関数で周期 (遅延評価)
  let fiboCpsCycle n m =
    cps {let! a = fiboCps n 
         return lazy (a % m)
        }

  //ふつうのフィボナッチ関数を継続ワークフローで継続渡しスタイルに
  let fibo2 n = cps {return fibo n}
  //継続ワークフローでCPS変換したfibo2を使って周期 (遅延評価)
  let fibo2Cycle n m = 
    cps {let! a = fibo2 n
         return lazy (a % m)    
        }

  //print_anyして改行
  let panyn = print_any >> Console.WriteLine
  //お試し
  for i = 0 to 10 do (fibo i |> panyn)
  printfn ""
  for i = 0 to 10 do (fiboCps i (fun x -> panyn x))
  printfn ""
  for i = 0 to 10 do (fiboCpsCycle i 2 (fun x -> x.Force () |> panyn))
  printfn ""
  for i = 0 to 10 do (fibo2Cycle i 2 (fun x -> x.Force () |> panyn))

#if COMPILED
[<STAThread()>]
do
 CpsTest.Test1 
 CpsTest.Test2 
let key = Console.ReadKey ()
#endif


実行結果

zeclはF#初心者です。
Don SymeはF#達人です。

1
1
2
3
5
8
13
21
34
55
89

1
1
2
3
5
8
13
21
34
55
89

1
1
0
1
1
0
1
1
0
1
1

1
1
0
1
1
0
1
1
0
1
1


これはやさしいCPS変換サポーターですね。
脳内CPS変換が苦手な人にもかなり有用だと思います。継続ﾜｰｸﾌﾛｰ(ﾟДﾟ)ｳﾏｰ!!!
ですが、多様は禁物。やはりご利用は計画的にといった感じでしょうか。


ちなみに、C#でもクロージャ(ラムダ式)が使えるので、C#で継続渡し形式っぽく
プログラムを書くことも可能といえば可能なんだけど、
可読性やパフォーマンスの観点から言って、C#でやる意味は皆無っぽいですね。