FizzBuzz問題から学ぶモナド

前回のエントリでモナドについて熱く語りました。今回はゆるいモナドの雑記です。
モナドを利用して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モナド