Control.Arrow (2)
http://d.hatena.ne.jp/mzsms/20091119/1258657366 のつづき。
階乗
このエントリ全体がそうですが、この節はとくに、http://d.hatena.ne.jp/takkan_m/20070905/1189001272 を参考にしました。
ここまでの道具立てで、階乗関数が書けるので、階乗関数を書いてみよう。まず、書きたい関数はつぎのようなもの:
module Scrach where import Control.Arrow fac 1 = 1 fac n = n * fac (n - 1)
*Scrach> fac 5 120
まず、パターンマッチングではなく、ifを使った書き方に、それも次の補助関数if'を使った書き方に書き換える:
if' b t e = if b then t else e fac' n = if' (n == 1) 1 (n * fac'(n - 1))
つぎに、これは明らかにloopを使うので、どういう関数をloopに渡すのかを考える:
- loopに渡す関数は、\(b, d) -> (c, d)という形。
- これは有限ループなので、たぶん、\(b, f) -> (f b, g f)というイディオムを使う。
- 入力bはInt型、出力(f b)もInt型、よってfはInt->Int型、gは(Int->Int)->(Int->Int)型。
- gについてさらに考える:
- g f = \n -> ??? という形になるはず。
- nが1以外のとき、g f = \n -> n * (f (n - 1))。これで、nがInt型、fがInt->Int型だとすれば、すべて型があっている。
- nが1のとき、g f = \n -> 1。もちろん、型はあっている。
- よって、g f = \n -> if' (n == 1) 1 (n * f (n - 1))
- loopに渡す関数は、\(b, f) -> (f b, \n -> if' (n == 1) 1 (n * f (n - 1)))
fac' = loop (\(b, f) -> (f b, \n -> if' (n == 1) 1 (n * f (n - 1))))
次に、\(b, f) -> という部分をどう消すかを考える。
- これはタプルを受けて、タプルを返しているので、その点だけをみれば(***)の出番のように思える。
- しかし、(***)は出力タプルの第一要素は入力タプルの第一要素だけ、出力タプルの第二要素は入力タプルの第二要素だけしか参照できないところ、この関数は出力タプルの第一要素が入力タプルの第二要素を参照しているので、使えない。
- だから、(&&&)を使って、入力タプルを複製し、それぞれを出力タプルの第一要素、第二要素に変換することにする。イメージとして、「(Int, Int -> Int) -> Int &&& (Int, Int -> Int) -> (Int -> Int)」のような感じ。
fac' = loop ((snd &&& fst >>> app) &&& (\(b, f) n -> if' (n == 1) 1 (n * f (n - 1))))
最後の\(b, f) n -> ... の部分は、二引数関数だというのがネック。他にも方法がありそうな気はするけど、これは一度タプルにして操作してcurryで二引数関数に戻すことにする:
fac' = loop ((snd &&& fst >>> app) &&& curry (\((b, f), n) -> if' (n == 1) 1 (n * f (n - 1))))
その上で、\((b, f), n) -> を消す。ここはいろいろ試行錯誤したんだけど… とりあえず、次のように書くこともできる:
fac' = loop ((snd &&& fst >>> app) &&& curry f) f = snd *** (flip (-) 1) &&& id &&& ((== 1) >>> if' >>> ($ 1)) >>> ((second fst) >>> app) &&& (snd >>> snd) >>> (second fst >>> uncurry (*)) &&& (snd >>> snd) >>> snd &&& fst >>> app
(いま改めて書いたら、一発で動いた！)
これは補助関数fの先頭でnを参照する操作分だけ分岐させて、それを順番にfを参照したラインに、いわば組み込んでいっている。でも、そうするくらいだったら、nを参照するラインを一つだけにしてそこではnを変更せずに保持し、もう一つのラインに適宜組み込んでいくようにしたほうが分かりやすいかもしれない*1。
fac' = loop ((snd &&& fst >>> app) &&& curry f) f = first snd >>> (second (flip (-) 1) >>> app) &&& snd >>> uncurry (*) &&& snd >>> second ((== 1) >>> if' >>> ($ 1)) >>> snd &&& fst >>> app
解説つけると、こんな感じ:
fac' = loop ((snd &&& fst >>> app) &&& curry f)
f = -- ((b, f), n)
first snd -- (f, n)
>>> (second (flip (-) 1) >>> app) &&& snd -- (f (n - 1), n)
>>> uncurry (*) &&& snd -- ((f (n - 1)) * n, n)
>>> second ((== 1) >>> if' >>> ($ 1)) -- ((f (n - 1)) * n, if' (n == 1) 1)
>>> snd &&& fst -- (if' (n == 1) 1, (f (n - 1)) * n)
>>> app -- if' (n == 1) 1 (f (n - 1)) * n)補助関数fをfac'に組み込んで、完成:
module Scrach where import Control.Arrow fac 1 = 1 fac n = n * fac (n - 1) if' b t e = if b then t else e fac' = loop ((snd &&& fst >>> app) &&& curry (first snd >>> (second (flip (-) 1) >>> app) &&& snd >>> uncurry (*) &&& snd >>> second ((== 1) >>> if' >>> ($ 1)) >>> snd &&& fst >>> app))
*Scrach Control.Arrow> fac 5 120 *Scrach Control.Arrow> fac 10 3628800 *Scrach Control.Arrow> fac' 5 120 *Scrach Control.Arrow> fac' 10 3628800
先生！ 階乗関数の難読化に成功しました！
(|||)、(+++)、left、right
さらに、(|||)、(+++)、left、right:
-- Data.Either
data Either a b = Left a | Right b deriving (Eq, Ord, Read, Show)
either :: (a -> c) -> (b -> c) -> Either a b -> c
either f _ (Left x) = f x
either _ g (Right y) = g y
-- Control.Arrow
class Arrow a => ArrowChoice a where
left :: a b c -> a (Either b d) (Either c d)
right :: a b c -> a (Either d b) (Either d c)
right f = arr mirror >>> left f >>> arr mirror
where mirror (Left x) = Right x
mirror (Right y) = Left y
(+++) :: a b c -> a b' c' -> a (Either b b') (Either c c')
f +++ g = left f >>> right g
(|||) :: a b d -> a c d -> a (Either b c) d
f ||| g = f +++ g >>> arr untag
where untag (Left x) = x
untag (Right y) = y
instance ArrowChoice (->) where
left f = f +++ id
right f = id +++ f
f +++ g = (Left . f) ||| (Right . g)
(|||) = either例えば、次のように使える:
module Scrach where import Data.Either f :: (Num t) => Either t [Char] -> String f (Left x) = show (x + 10) f (Right s) = "String: " ++ s ++ " + 10"
*Scrach> f (Left 10) "20" *Scrach> f (Right "10") "String: 10 + 10"
カリー=ハワード対応だと、論理和に対応するのかな？ まぁ、それはともかく。(|||)、(+++)、left、rightは、このEitherをArrowの中で駆使する手段。(***)、(&&&)、appが使うタプルは、例えば(Int, String)型だと、Int型とString型の両方の値が入っている。これが Either Int String だと、Int型かString型のどちらかの値が入っている、ということになる。
(つづく)
