もうね, 何番煎じか分からないよ. それでもFizzBuzzは飽きないから奥が深いよね.
昨日からArrowを初めて, 取り敢えずGeneralising Monads to Arrowsにさっと目を通した. 良い論文だった. つーこって, FizzBuzzを書いてみよう(お約束！！！
まず最初に書いたコードはこんな感じ.
{-# LANGUAGE Arrows #-} import Control.Arrow r s b = if b then s else "" fb = proc x -> do a <- (==0).(`mod`3) -< x b <- (==0).(`mod`5) -< x c <- r "Fizz" -< a d <- r "Buzz" -< b e <- arr (uncurry (++)) -< (c, d) f <- (=="") -< e g <- arr (uncurry r) -< (show x, f) arr (uncurry (++)) -< (g, e) main = mapM_ (putStrLn . fb) [1..100]
このコードで勿論ちゃんと動く. この時点では十分に読める内容だと思うし, ここでワケがわからない様だと先が思いやられる. この状態から, 順番にコードを変形していく. fb関数しか触らないからそれだけ書いていくよ.
まずやったのは,
- a <- ... と ... -< a というのがどちらも一箇所にしか表れない, そんなaを接続する
こと. aとbがそういう状態だから,
fb = proc x -> do c <- r "Fizz".(==0).(`mod`3) -< x d <- r "Buzz".(==0).(`mod`5) -< x e <- arr (uncurry (++)) -< (c, d) f <- (=="") -< e g <- arr (uncurry r) -< (show x, f) arr (uncurry (++)) -< (g, e)
のようになった. r関数はさっきと同じね.
次に,
- c <- f -< x, d <- g -< xと ... -< (c, d) を f &&& g -< x で結合
した. あと, show関数も中に押し込め, -<(x, f) とした後に(=="")も中に押し込めて-< (x, e)という風にする.
fb = proc x -> do e <- arr (uncurry (++)) <<< r "Fizz".(==0).(`mod`3) &&& r "Buzz".(==0).(`mod`5) -< x g <- arr (uncurry r) <<< show *** (=="") -< (x, e) arr (uncurry (++)) -< (g, e)
んでもって, コードをじっと見る. 入力はx, eに入ってくる奴, ... (x, e)からgに入る, ... (g, e)から答え... ... answer -< (g, e) と, g <- f -< (x, e)を結合できないかと考える. そうすると,
fb = proc x -> do e <- arr (uncurry (++)) <<< r "Fizz".(==0).(`mod`3) &&& r "Buzz".(==0).(`mod`5) -< x arr (uncurry (++)) <<< arr (uncurry r) *** id <<< (show *** (=="")) &&& snd -< (x, e)
というふうになる. まず, sndでeを取り出しておいて, その次にidでスルーすると言った具合だ. この時点ではfirstやsecondは使わないほうがいい.
いよいよ最終段階だ. e <- f -< xとanswer <- g -< (x, e) の2つから, answer <- g <<< id &&& f -< xのように変形できる.
fb = proc x -> do arr (uncurry (++)) <<< (arr (uncurry r) *** id) <<< (show *** (=="")) &&& snd <<< id *** arr (uncurry (++)) <<< id &&& r "Fizz".(==0).(`mod`3) &&& r "Buzz".(==0).(`mod`5) -< x
これでほとんど完成だ. 後は(f *** id) <<<のfを隣に押し込めて
fb = proc x -> do arr (uncurry (++)) <<< (arr(uncurry r) <<< show *** (=="")) &&& snd <<< id *** arr (uncurry (++)) <<< id &&& r "Fizz".(==0).(`mod`3) &&& r "Buzz".(==0).(`mod`5) -< x
あとモイッチョ (id *** g) <<< id &&& hの, gをhに押し込めて
fb = proc x -> do arr (uncurry (++)) <<< (arr(uncurry r) <<< show *** (=="")) &&& snd <<< id &&& (arr (uncurry(++)) <<< r "Fizz".(==0).(`mod`3) &&& r "Buzz".(==0).(`mod`5)) -< x
proc x -> ... -< xを消して
fb = arr (uncurry (++)) <<< (arr(uncurry r) <<< show *** (=="")) &&& snd <<< id &&& (arr (uncurry(++)) <<< r "Fizz".(==0).(`mod`3) &&& r "Buzz".(==0).(`mod`5))
完璧だ！ ただ, どうもarr (uncurry (op))というのが三回も出てきていて, 汚らしい. これってA -> B -> Cな演算子で2つの線をマージするようなイメージなのだけど, こういう場面っていっぱいあるから前もって用意して欲しいよね... というわけで次のような演算子を定義してみた.
infixr 2 <+< (<+<) op f = arr (uncurry op) <<< f
2つの線を結んで次に繋げるイメージだ. これを用いると,
fb = (++) <+< (r <+< show *** (=="")) &&& snd <<< id &&& ((++) <+< r "Fizz".(==0).(`mod`3) &&& r "Buzz".(==0).(`mod`5))
ワンライナーにして
fb = (++) <+< (r <+< show *** (=="")) &&& snd <<< id &&& ((++) <+< r "Fizz".(==0).(`mod`3) &&& r "Buzz".(==0).(`mod`5))
スペースを消して完成だ. 以下は, 完璧に動作する, Arrowを用いたFizzBuzzのコードになる.
import Control.Arrow infixr 2 <+< (<+<) op f = arr (uncurry op) <<< f r s b = if b then s else "" fb = (++)<+<(r<+<show***(==""))&&&snd<<<id&&&((++)<+<r"Fizz".(==0).(`mod`3)&&&r"Buzz".(==0).(`mod`5)) main = mapM_ (fb >>> putStrLn) [1..100]
こっそりmain関数の中も, (flip (.))から(>>>)に書き換えておいた. 矢印の向きを全て逆にすることもArrowなら簡単だ.
import Control.Arrow infixl 2 >+> (>+>) f op = f >>> arr (uncurry op) r s b = if b then s else "" fb = id&&&(r"Fizz".(==0).(`mod`3)&&&r"Buzz".(==0).(`mod`5)>+>(++))>>>(show***(=="")>+>r)&&&snd>+>(++) main = mapM_ (fb >>> putStrLn) [1..100]
ここで定義した<+<や>+>は, かなり優先度を下げているが, これが割と味噌なのだ. 優先度を上げると何が起こるかは, 読者が確認して欲しい.
結論
式変形はパズルだ. ブロック線図を書いて, そこからいきなり(&&&)や(***), (>>>)などのコンビネータを用いた表現を書こうとすると, 天才でなければ間違いなく失敗する. 最初の最初に書いたように, 誰でも分かるように-<を用いたところからスタートするといいだろう.
