エラトステネスの篩の前に, 階乗をArrowでやります. 理由はおいおい分かります.
階乗を普通に
fact n = if n == 0 then 1 else n * fact (n - 1) main = print $ fact 10
3628800
流石にこれはいいですね. はい.
Arrowに急ぐ前に, まずfixを使って書きましょう. 色々考えましたが, fixを介してArrowに行くのが一番近道です.
fix f = f (fix f) fact = fix fact' fact' f n = if n == 0 then 1 else n * f (n - 1) main = print $ fact 10
3628800
さっきのfactを, 第一引数で関数を回すようにしてやるだけですね.
階乗をArrowLoopで
さて, fixで書けたらもうお手の物です. というのも, 次の書き換えができるからです.
fix f ==> loop (\(n, g) -> (g n, f g))
これについては後述します. これを適用して,
import Control.Arrow fact = loop (\(n, g) -> (g n, fact' g)) fact' f n = if n == 0 then 1 else n * f (n - 1) main = print $ fact 10
となります. あとはfact'を消して
import Control.Arrow fact = loop (\(n, g) -> (g n, \n -> if n == 0 then 1 else n * g (n - 1))) main = print $ fact 10
できあがり! もうArrowLoopで再帰関数を書くのは怖くありません!
エラトステネスの篩
素数と言えば, こういうのを見たことがあります.
import Data.List primes = nubBy(((>1).).gcd)[2..] main = print $ take 20 primes
[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71]
これでは元も子もないですね...
次は, エラトステネスの篩のコードです.
p (x:xs) = x : p [y | y <- xs, mod y x /= 0] primes = 2:p [3,5..] main = print $ take 20 primes
これ, よく見ればpを再帰してますよね. 再帰呼び出し, 再帰, ... loop... ArrowLoopだ!!! だから先に(より簡単な関数である)階乗を持ってきたわけです.
まず, (x:xs)と, リスト内包表記を消します.
p x = head x : p (filter (\y -> mod y (head x) /= 0) (tail x)) primes = 2:p [3,5..]
再帰呼び出しをfixに直します.
fix f = f (fix f) p' f x = head x : f (filter (\y -> mod y (head x) /= 0) (tail x)) p = fix p' primes = 2:p [3,5..]
ここで,
fix p' ==> loop (\(n, g) -> (g n, p' g))
によって書き換えます.
import Control.Arrow p' f x = head x : f (filter (\y -> mod y (head x) /= 0) (tail x)) p = loop (\(n, g) -> (g n, p' g)) primes = 2:p [3,5..]
取り敢えずp'は放っておいて, loopの中身を書きなおしましょう.
p = loop (\(n, g) -> (g n, p' g))
g nとp' gをhoge (n, g)の形に変形します.
p = loop (\(n, g) -> (uncurry(flip($)) (n, g) , (p'.snd) (n, g)))
んでもって, (&&&)でつなげれば
p = loop (uncurry(flip($)) &&& p'.snd )
完成っと!
p'を変形しよう!
実はコイツがなかなか厄介. でもがんばるもん!
p' f x = head x : f (filter (\y -> mod y (head x) /= 0) (tail x))
headとtail, filterの中の関数を取り出します.
p' f x = h : f (filter g t) where h = head x t = tail x g y = mod y h /= 0
gを変形していきます.
g y = (/=0) $ mod y h
g y = (/=0) $ flip mod h y
g y = ( (/=0) . flip mod h ) y
g = (/=0) . flip mod h
g = (((/=0).) . flip mod) h
ここで,
f . g x == (f .) (g x) == ((f .) . g) x
の関係を使いました. p'全体はこうなりました.
p' f x = h : f (filter g t) where h = head x t = tail x g = (((/=0).) . flip mod) h
もちょっと変形.
p' f x = uncurry (:) (h, xs) where h = head x t = tail x g = (((/=0).) . flip mod) h xs = f (filter g t)
p' f x = uncurry (:) (h, xs) where h = head x t = tail x g = ((((/=0).) . flip mod).head) x xs = (\(g, t) -> f (filter g t)) (g, t)
xsのなかのgとtを消します.
xs = f $ (\(g, t) -> (filter g t)) (g, t)
xs = (f . uncurry filter) (g, t)
xsをhoge xの形に変形します.
p' f x = uncurry (:) (h, xs) where h = head x t = tail x xs = (f . uncurry filter) (((((/=0).) . flip mod).head) x, tail x)
(&&&)で分岐しよう!
p' f x = uncurry (:) (h, xs) where h = head x xs = (f <<< uncurry filter <<< (((((/=0).) . flip mod).head)&&& tail)) x
p' f x = uncurry (:) hxs where h = head x xs = (f <<< uncurry filter <<< (((((/=0).) . flip mod).head)&&& tail)) x hxs = (h, xs)
んー, でもxsの中に, fが入ってるよなー... つーこってhoge (f, x)の形にします. 変数aが中にあれば, とにかくhoge (a, foo)のようにタプルに直します. これ鉄則.
p' f x = uncurry (:) hxs where h = (head.snd) (f, x) xs = (uncurry ($) <<< id *** (uncurry filter <<< (((((/=0).) . flip mod).head)&&& tail))) (f, x) hxs = (h, xs)
ようやくhとxsを(&&&)で繋げられます.
p' f x = uncurry (:) hxs where hxs = ((head.snd) &&& (uncurry ($) <<< id *** (uncurry filter <<< (((((/=0).) . flip mod).head)&&& tail)))) (f, x)
hxsを消して...
p' f x = (uncurry (:) <<< (head.snd) &&& (uncurry ($) <<< id *** (uncurry filter <<< (((((/=0).) . flip mod).head)&&& tail)))) (f, x)
カーリー化して
p' f x = curry (uncurry (:) <<< (head.snd) &&& (uncurry ($) <<< id *** (uncurry filter <<< (((((/=0).) . flip mod).head)&&& tail)))) f x
引数を消す.
p' = curry (uncurry (:) <<< (head.snd) &&& uncurry ($) <<< id *** (uncurry filter <<< ((/=0).).flip mod.head&&&tail))
以上から, 全体像は
import Control.Arrow p' = curry(uncurry(:)<<<(head.snd)&&&(uncurry($)<<<id***(uncurry filter<<<(((((/=0).).flip mod).head)&&&tail)))) p = loop (uncurry(flip($)) &&& p'.snd ) primes = 2:p [3,5..] main = print $ take 20 primes
p'を消して
p = loop (uncurry(flip($)) &&& (curry(uncurry(:)<<<(head.snd)&&&(uncurry($)<<<id***(uncurry filter<<<(((((/=0).).flip mod).head)&&&tail)))).snd)) primes = 2:p [3,5..]
pも消そうかな
import Control.Arrow primes = 2:(loop$uncurry(flip($)) &&& (curry(uncurry(:)<<<(head.snd)&&&(uncurry($)<<<id***(uncurry filter<<<(((((/=0).).flip mod).head)&&&tail)))).snd))[3,5..] main = print $ take 20 primes
[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71]
で, でけたー!
お魚さん<+<を使うと
import Control.Arrow infixr 2 <+< (<+<) op f = arr (uncurry op) <<< f primes = 2:(loop$uncurry(flip($))&&&curry((:)<+<(head.snd)&&&(($)<+<id***(filter<+<((/=0).).flip mod.head&&&tail))).snd)[3,5..] main = print $ take 20 primes
なんかcurryしたりuncurryしたり忙しいけどまぁいいや.
あ, そう言えば,
curry f = (f.) . (,)
が成り立ちますから, (,)と(.)でcurryって消せるんですよね.
primes = 2:(loop$uncurry(flip($))&&&((((uncurry(:)<<<(head.snd)&&&(uncurry($)<<<id***(uncurry filter<<<(((((/=0).).flip mod).head)&&&tail)))).).(,)).snd))[3,5..]
fixからloopへの書き換えについて
fix f ==> loop (\(n, g) -> (g n, f g))
についてちょっと言っておきます. 直感的なものですが. fixの定義は
fix f = f (fix f)
というのはつまり, fix fという関数がfの不動点だ, ということです. よって
foo x = fix f x
とは, fの不動点にxを適用した値となります.
一方, loopの方は
loop f b = let (c,d) = f (b,d) in c
ですから,
loop (\(n, g) -> (g n, f g)) x = let (c,d) = (\(n, g) -> (g n, f g)) (x,d) in c = let (c, d) = (d x, f d) in c
となりますが, let d = f d, これは, dがfの不動点となります. んで, c = d xですから, 結果的にfの不動点にxを適用した値... と言うことはfix fと同じですね.
結論
ArrowLoopで再帰関数を書き直せるって言うことは, つまりその, えっと, どういうことでしょう(´・ω・`)
構造化定理の三つ目だ!!!( ´∀`)
なんかすごいことらしいです. ごめんなさい, よく分からなくて...