Control.ArrowでFibonacci

フィボナッチの綴りが分からなくてググったのは内緒です.

先にControl.ArrowでFizzBuzz - プログラムモグモグの方を読んで下さい.

ArrowにはArrowLoopってのがあって, コイツがなかなか面白い. これを使ったらフィボナッチ数列が出来る. 例えばhttp://d.hatena.ne.jp/MaD/20070818などにも書かれているけど, このポスト書いた人はかなりArrowに慣れてるようで, 僕にはすぐには理解できなかった.

やっぱりprocで書いてから徐々に変形するのが良いようだ. いきなり(&&&)やら(***)で関数を作り上げられるほど, ぼくの頭は良くない. loopが発生したときは尚更.

では始めるよ. まずは手始めに, 普通にフィボナッチ数列を書いてみよう.

fib = 1:1:zipWith (+) (tail fib) fib
main = print $ take 100 fib

うむ. 苦しうない.

ArrowLoopの使い方を確認してみる.

{-# LANGUAGE Arrows #-}
import Control.Arrow
arrowFib = proc (b, c) -> do d <- id -< c
                             e <- id -< b:c
                             id -< (d, e)
fib = loop arrowFib 1
main = print $ take 100 fib
[1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]

bに入ってきた1を, ずっとコンスし続けるループ. なるほど...

じゃぁ, こうすると?

{-# LANGUAGE Arrows #-}
import Control.Arrow
arrowFib = proc (b, c) -> do d <- id -< c
                             e <- id -< b:map (+1) c
                             id -< (d, e)
fib = loop arrowFib 1
main = print $ take 100 fib
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100]

1からどんどん増えるような数列ができた.

よろしい. ならばフィボナッチだ.

{-# LANGUAGE Arrows #-}
import Control.Arrow
arrowFib = proc (b, c) -> do d <- id -< c
                             e <- id -< b:zipWith (+) c (tail c)
                             id -< (d, e)
fib = loop arrowFib 1
main = print $ take 100 fib

ってのは間違い. なんか帰ってこなくなった. (´・ω・`) 正しくは,

{-# LANGUAGE Arrows #-}
import Control.Arrow
arrowFib = proc (b, c) -> do d <- id -< c
                             e <- id -< b:b:zipWith (+) c (tail c)
                             id -< (d, e)
fib = loop arrowFib 1
main = print $ take 100 fib
[1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946,17711,28657,46368,75025,121393,196418,317811,514229,832040,1346269,2178309,3524578,5702887,9227465,14930352,24157817,39088169,63245986,102334155,165580141,267914296,433494437,701408733,1134903170,1836311903,2971215073,4807526976,7778742049,12586269025,20365011074,32951280099,53316291173,86267571272,139583862445,225851433717,365435296162,591286729879,956722026041,1548008755920,2504730781961,4052739537881,6557470319842,10610209857723,17167680177565,27777890035288,44945570212853,72723460248141,117669030460994,190392490709135,308061521170129,498454011879264,806515533049393,1304969544928657,2111485077978050,3416454622906707,5527939700884757,8944394323791464,14472334024676221,23416728348467685,37889062373143906,61305790721611591,99194853094755497,160500643816367088,259695496911122585,420196140727489673,679891637638612258,1100087778366101931,1779979416004714189,2880067194370816120,4660046610375530309,7540113804746346429,12200160415121876738,19740274219868223167,31940434634990099905,51680708854858323072,83621143489848422977,135301852344706746049,218922995834555169026,354224848179261915075]

げっちゃ! 初めてArrowでフィボナッチ数列を作ることに成功した!

じゃぁこれを変形していくよ. まず, id -< b:b:...を, 関数を中に入れたい. いきなりはできないから, まずbの方を処理しよう. ここからはarrowFib関数だけ書いていくよ.

arrowFib = proc (b, c) -> do d <- id -< c
                             e <- uncurry ($) <<< (\b -> (b:).(b:)) *** id -< (b, zipWith (+) c (tail c))
                             id -< (d, e)

不細工だから\b -> (b:).(b:)も変形するよ.

arrowFib = proc (b, c) -> do d <- id -< c
                             e <- uncurry ($) <<< (uncurry (.) <<< (:) &&& (:)) *** id -< (b, zipWith (+) c (tail c))
                             id -< (d, e)

次は, cを処理しよう. 中の*** id のidを書き換える.

arrowFib = proc (b, c) -> do d <- id -< c
                             e <- uncurry ($) <<< (uncurry (.) <<< (:) &&& (:)) *** (\c -> zipWith (+) c (tail c)) -< (b, c)
                             id -< (d, e)

いやいや(ヾノ・∀・`).... そうじゃないって.

arrowFib = proc (b, c) -> do d <- id -< c
                             e <- uncurry ($) <<< (uncurry (.) <<< (:) &&& (:)) *** (uncurry (zipWith (+)) <<< id &&& tail) -< (b, c)
                             id -< (d, e)

こうだよね. 後は簡単で, dを消して

arrowFib = proc (b, c) -> do e <- uncurry ($) <<< (uncurry (.) <<< (:) &&& (:)) *** (uncurry (zipWith (+)) <<< id &&& tail) -< (b, c)
                             id -< (c, e)

eを消すには, (b, c)のcだけをsndで取り出す.

arrowFib = proc (b, c) -> do snd &&& (uncurry ($) <<< (uncurry (.) <<< (:) &&& (:)) *** (uncurry (zipWith (+)) <<< id &&& tail)) -< (b, c)

できた! あとはproc (b, c)と-< (b, c)を消して

arrowFib = snd &&& (uncurry ($) <<< (uncurry (.) <<< (:) &&& (:)) *** (uncurry (zipWith (+)) <<< id &&& tail))

前の記事Control.ArrowでFizzBuzz - プログラムモグモグでもそうだけど, uncurryがいっぱい出てきてかっこ良くないので, お魚さん演算子<+<を定義する.

arrowFib = snd &&& (($) <+< ((.) <+< (:) &&& (:)) *** (zipWith (+) <+< id &&& tail))
infixr 2 <+<
(<+<) op f = arr (uncurry op) <<< f

以上の変形から, コード全体はこうなった.

import Control.Arrow
arrowFib = snd &&& (($) <+< ((.) <+< (:) &&& (:)) *** (zipWith (+) <+< id &&& tail))
infixr 2 <+<
(<+<) op f = arr (uncurry op) <<< f
fib = loop arrowFib 1
main = print $ take 100 fib

arrowFibを消して,

import Control.Arrow
infixr 2 <+<
(<+<) op f = arr (uncurry op) <<< f
fib = loop (snd&&&(($)<+<((.)<+<(:)&&&(:))***(zipWith(+)<+<id&&&tail))) 1
main = print $ take 100 fib

\できた/ 矢印を全て逆向きにすると,

import Control.Arrow
infixl 2 >+>
(>+>) f op = f >>> arr (uncurry op)
fib = loop (snd&&&(((:)&&&(:)>+>(.))***(id&&&tail>+>zipWith(+))>+>($))) 1
main = print $ take 100 fib

ヤバイ, このpoint freeなパズル, 超楽しい.



ところで, id:MaDさんの2007-08-18 - mad日記にある例はもっともっとシンプルで,

import Control.Arrow
fib = loop $ snd >>> id&&&(id&&&tail >>> uncurry (zipWith (+)) >>> (1:) >>> (1:))
main = print $ take 100 $ fib 0

で動く. およよ, これって入力を使ってないではないか! すごくシンプル! お魚さん演算子を用いると,

infixl 2 >+>
(>+>) f op = f >>> arr (uncurry op)
fib = loop $ snd >>> id&&&(id&&&tail >+> zipWith (+) >>> (1:) >>> (1:))

ってなる. 素晴らしい.