ArrowでFizzBuzz(とArrowの再帰に関する問題点)

ふと、Arrowを使ってFizzBuzzが簡単に書けるかなと思ったので書いてみました。結論から言うとあんまり書きやすくはなかったです。ソースコードもちろんif then elseレベルで自分で実装をしているからでして、ライブラリが充実してくればそんなに書きにくいものでもないとは思います。

思わぬ収穫としてArrow用のmapであるmapAを使用する際には、よく注意しないと問題が発生することを見つけたのでそれについても書きます。

ArrowChoiceを使う

普通に剰余を使って書きます。せっかくArrowを使うので、1,2,3,4,5,....というストリームをフィルターに通していくという感じで実装しました。

まず剰余にしたがって分岐が必要なので、ArrowChoiceを使います。ArrowChoiceには4つの演算子があります。

まずleftという関数があって、これは普通のArrowを入力がEither型のLeftの場合だけ実行するようなArrowへと変換します。rightはその逆をします。

Either型ですから、LeftとRightには違う型の値を格納することができます。

> (left (+ 1) >>> right (++ " world")) (Left 3)
Left 4
> (left (+ 1) >>> right (++ " world")) (Right "hello")
Right "hello world"

演算子+++を使うと上のをまとめて書けます。

> ((+ 1) +++ (++ " world")) (Left 3)
Left 4
> ((+ 1) +++ (++ " world")) (Right "hello")
Right "hello world"

演算子|||は+++と似てますが、最後にLeftやRightを外して中身だけ取り出します。当然、Left,Rightの中身は同じ型じゃないと使えません。

> ((+ 1) ||| (* 2)) (Left 3)
4
> ((+ 1) ||| (* 2)) (Right 3)
6

分岐を用意する

ArrowChoiceはArrowに分岐を導入する為のものですが、実際のところ"choice"という名前にもあるように選択しか実現してくれません。分岐する部分は自分で用意します。id:MaD:20070817で用意したcondもその為のものです。

このcondは関数に対してしか使えませんでしたので、以下のようにpureをつけて、任意のArrowに対して使えるように変更します。

cond :: Arrow a => (x -> Bool) -> a x (Either x x)
cond f = pure $ \x -> if f x then Left x else Right x

これを使って、もうちょっと便利なbranchという分岐用のArrowジェネレータ(?)を作ります。*1

branch :: ArrowChoice a => (x -> Bool) -> a x b -> a x c -> a x (Either b c)
branch pred t e = cond pred >>> t+++e

condで条件分岐してpredが真を返したらtに入力して偽を返したらeに入力します。

これを使ってFizzBuzz用のフィルタを作ります。ここで、$以降は通常の関数ですが、condと同じく先頭にpureをつけて任意のArrowに自動的に変換されるようにします。変換するArrowの型の決定は前後に繋げたArrowに基づいて型推論により決められます。

fizz, buzz, fizzbuzz :: (Arrow a, Integral b) => a b (Either String b)
fizz     = pure $ branch ((`mod` 3)>>>(== 0)) (const "Fizz") id
buzz     = pure $ branch ((`mod` 5)>>>(== 0)) (const "Buzz") id
fizzbuzz = pure $ branch ((`mod`15)>>>(== 0)) (const "FizzBuzz") id

fizzは入力が3の倍数の時だけ"Fizz"という文字列をLeftのラインに出力をします。そうでないときはRightのラインに数値のまま出力します。

(注) : ここでは普通に引数を渡すことによって型推論器は普通の関数として解釈してくれます。なのでこの文脈では関数として呼び出せています。(正確には(->) a b型のArrowだと解釈します。)

> fizz 1
Right 1
> fizz 2
Right 2
> fizz 3
Left "Fizz"
> fizz 4
Right 4
> fizz 5
Right 5
> fizz 6
Left "Fizz"

fizzbuzz, fizz, buzzの順に直列につなげれば完成です。Rightに数値xを入力して順番にチェックしていき、条件を満たしたらLeftに放出し、その後は素通りして最後まで行くという感じです。どの条件も満たさなかったら最後にshowして数値を文字列化します。

branchは上の図のインターフェースに適合していないので、変換する為のものを作ります。

check :: ArrowChoice a => a b (Either d c) -> a (Either d b) (Either d c)
check a = pure Left|||a

Leftから入力がきたらそのままなにもせずLeftをつけなおし、Rightからきたら分岐を行うArrowであるaに入力します。

以上を使まとめると、"入力を1つだけとる"FizzBuzzは以下のようになります。(最初のRight >>> check fizzbuzzの部分はfizzbuzzだけでOKですが、上の図のイメージに併せてあえてこう書きました)

pure Right >>> check fizzbuzz >>> check fizz >>> check buzz >>> pure id|||pure show 

Right,id,showは普通の関数(とデータコンストラクタ)なのでpureをつけときます。checkやfizzbuzzなどは汎用的に作ってあるので不要です。

またpureには分配則があるので

pure (Right >>> check fizzbuzz >>> check fizz >>> check buzz >>> id|||show) 

と書いてもいいです。

実行例

> let f =  (pure Right >>> check fizzbuzz >>> check fizz >>> check buzz >>> pure id|||pure show)
> f 1
"1"
> f 2
"2"
> f 3
"Fizz"
> f 4
"4"
> f 5
"Buzz"

これをストリームに対して順番に適用できるようにします。Haskellではストリームはリストとして表現されますから、結局mapに相当するArrowジェネレータを用意すればOKです。これはJohn Hughes先生の論文から拝借します。

mapA :: ArrowChoice a => a b c -> a [b] [c]
mapA f = arr listcase >>>
         arr (const []) ||| (f *** mapA f >>> arr (uncurry (:)))
    where
      listcase []     = Left ()
      listcase (x:xs) = Right (x,xs)

入力が空かどうかで分岐して、空でない場合はmapAを再帰的に使用しています。

これを先ほどのFizzBuzzに適用します。

> mapA (pure Right >>> check fizzbuzz >>> check fizz >>> check buzz >>> pure id|||pure show) [1,2..]
["1","2","Fizz","4","Buzz","Fizz","7","8","Fizz","Buzz","11","Fizz","13","14","FizzBuzz",..

Kleisli Arrowに繋げる

上で生成した文字列の列を出力します。

main = runKleisli
 (mapA (pure Right >>> check fizzbuzz >>> check fizz 
 >>> check buzz >>> pure id|||pure show >>> Kleisli putStrLn)) [1,2..]

先ほどのArrowとKleisli putStrLnを非常に自然につなぐ事ができます。
また、この場合先ほどまでとFizzBuzzの部分の型が変わってKleisli IO型になっています。その差はpureが吸収し、まったく修正なく同じmapAという関数で使えています。

1
2
Fizz
4
Buzz
Fizz
7
8
Fizz
Buzz
11
Fizz
13
14
FizzBuzz
16
17
Fizz
19
Buzz
Fizz

mapAの問題

論文にはこういうサンプルコードがあります。

main = runKleisli (mapA (Kleisli print) >>> Kleisli print) [1..5]
1
2
3
4
5
[(),(),(),(),()]

これは良いです。ところが次のようなコードは動きません。

main = runKleisli (mapA (pure show) >>> Kleisli print) [1..]

次のコードは動きます。

main = runKleisli (pure (mapA show) >>> Kleisli print) [1..]

どちらもコンパイルは通ります。

いろいろ調べた結果原因はIOモナド再帰にあるのではないかと思います。
まず2つめのコードですがpureの中に入るのは普通の関数ですので、

mapA showの型は関数

です。
1つめのコードの場合はmapAとpure showのArrowの型は同じになりますので、

pure showの型はKleisli IO型のArrow

になります。そしてそれがmapA内で再帰されていることになります。

そもそもモナドを使う理由は計算の順序を保証する為です。ですので基本的には前の計算が終わるまで、次の計算は行われないようになっています。

しかし、IOモナドのgetContentsやputStrLnやprintなどの関数でそういうことをしてしまうと入力が終わるまでブロックしてしまうことになるので、入力の評価を遅延して先に出力の評価を行うなどといったことをしています。

しかしpure showは普通の関数をreturn.showという形でIOモナドにしたものです。その為に、無限リスト[1..]の全要素に対するshowが完了するまで停止します。

ではどうすればよいのかというと、Monadにはこういう場合の為にMonadFixというクラスが用意されていて、そのmfixという関数を使うようにすればいいらしいです。 Arrowの場合はどうすればよいかというとmapAをArrowLoopを使って書けばいいんじゃないかと思っています(ArrowLoopはKleisliの場合内部的にmfixを使用しています。)。まだ試していないので、後でまた結果を書きたいと思います。

[追記]これは間違い。

[追記]

mapAをdo記法で以下のように書いてみましたがやっぱりだめでした。

mapA f = proc xs -> 
    case xs of
         [] -> returnA -< []
         x:xs' -> do y <- f -< x
                     ys' <- mapA f -< xs'
                     returnA -< y:ys'

do記法でArrowLoopと同じことをするには...どうすればいいんだろう(汗)

*1:自分は最初こんがらがってたのですが、branchは高階Arrowではありません。高階Arrowは入力としてArrowをとりますが、branchはただの関数で引数としてArrowをとります。なのでとりあえずArrowジェネレータと呼んでみました。(ArrowTransformerなるものもあるようですが、これが何なのかはよく分かってません。)