Control.Arrow

http://www.nicovideo.jp/watch/sm5103132 で、Haskell(というかGHC?)のControl.Arrowに関心を持ったので、すこしいじってみた。

loop その1

まず、理解が難しいloopから。なぜなら、どうもArrowを使うときにはトップダウンで考えないとわけが分からなくなるようなので。そしてあとで出す例もそうだけど、繰り返しをする仕事は一番上がloopになるので、loopに何を入れるべきなのかから考えはじめることになる。

とりあえず、(->)型(関数そのものの型)のloopの定義は次のとおり:

class Arrow a => ArrowLoop a where
        loop :: a (b,d) (c,d) -> a b c

instance ArrowLoop (->) where
        loop f b = let (c,d) = f (b,d) in c

Arrowクラス*1は(->)型以外にもあるので、ちょっと分かりにくい書き方になっているけど、(->)型に即して書けば次のとおり:

class Arrow a => ArrowLoop a where
        loop :: ((b,d) -> (c,d)) -> (b -> c)

instance ArrowLoop (->) where
        loop f b = let (c,d) = f (b,d) in c

(b,d)->(c,d)の関数をとって、(b->c)の関数を返す、高階関数。 このloopを使うと、次のように文字通りループを作ることができる(これは無限ループなので、最初の「take 20」をつけなければ、無限リストが得られる):

Prelude Control.Arrow> let list1 = loop (\(b',d') -> (d',1:d'))
Prelude Control.Arrow> :t list1
list1 :: b -> [Integer]
Prelude Control.Arrow> take 20 (list1 [])
[1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]

これがどう簡約されているのか考えてみるけど、loopの定義をちょっと考えやすいように書き換えておく:

instance ArrowLoop (->) where
        loop f b = let (c,d) = f (b,d) in c

instance ArrowLoop (->) where
        loop f = \b -> let (c,d) = f (b,d)
                       in c

list1 = loop (\(b',d') -> (d',1:d'))

list1 = \b -> let (c,d) = (\(b',d') -> (d',1:d')) (b,d)
              in c

list1 = \b -> let (c,d) = (d,1:d) 
              in c

ここでlist1のbに何をいれても、cを評価するとd、dを評価すると1:dなので、[1,1,1,1,1,1,...という無限リストになる。逆に考えると、つぎのようになる:

• まず、欲しい関数は1の無限リストを作る関数で、\a -> (1:(1:(1:(1: ... という感じ。
• loopに入れる関数は、\(b',d') -> (c',d'')という感じになる。ただし、d''はd'を含む式で、この関数によってd'を使ってd''が評価され、loopによってd'はd''の値に評価される。ここで繰り返しが起きる。
• そうすると、今回させたいループは、(1:(1:(1:(1: ... なので、d''は(1:d')。このd''=(1:d')のd'がloopによってd''の値に評価されれば欲しい結果が得られる。
• 今まで分かったところは、loopに入れる関数は\(b',d')->(c',1:d')という感じになるはず。
• 繰り返しから出力される結果は、c'の値。今回は、d' = (1:(1:(1: ... それ自体をそのまま出力させればよい。
• よって、結論。loopに入れる関数は、\(b',d') -> (d',1:d')。

Prelude Control.Arrow> take 20 $ loop (\(b',d') -> (d',1:d')) []
[1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]

loop その2

このエントリ全体がそうですが、とくにこの節は、http://d.hatena.ne.jp/propella/20070904/p1 と http://d.hatena.ne.jp/MaD/20070818 を参考にしました。

でも、無限ループだけでは、あまり役に立たない(Haskellでは無限ループも有用なんだけど)。こんどは、任意の整数から0までカウントダウンするリストを作ってみる:

Prelude Control.Arrow> countdown 12
[12,11,10,9,8,7,6,5,4,3,2,1,0]

• まず、欲しい関数は、\n -> (n:(n-1:(n-2:(n-3: ... という感じ。
• loopに入れる関数は、\(b',d') -> (c',d'')という感じになる。loopによってd'はd''の値に評価される。
• loopに入れる関数は\(b',d')->(c',d':f (d'-1))という感じになるはず…

あ、だめだ。d'とd''=d':f (d'-1)の型が違うので、これではうまくいかない。loopがd'をd''に評価するので、d'とd''は同じ型でなくてはならない。では、d'とd''はどういう型にすれば良いんだろうか。答えは、関数型。b'からc'を作るための関数をループで作る(これを最初に思いついた人はすごい)。

• loopに入れる関数は\(b',f)->(f c', g f)という感じになる。この関数の外で、loopによって、fが(g f)に評価され、さらに(g (g f))に評価され、(g (g (g f)))に評価され… そしてその(g (g (g ... )))がfとして入力b'に適用されて、出力c'を返す。

正直、僕も混乱している。でも、型を中心に考えていけば、すこし先が見えてくる:

• 今回は、b'はカウントダウンを開始する整数、c'はカウントダウンした数列なので、b'からc'を作る関数fの型はInt->[Int]になる。
• fがInt->[Int]型になるっていうことは、(g f)もInt->[Int]型、fをとってfと同じ型の値を返すgは(Int->[Int])->(Int->[Int])型。

何をつくれば良いか見えてきた。

• g f = \n -> ??? という感じになる(Int->[Int]型)。ここをもうちょっとよく考える。
  • iが0以外のときは、g f = \n -> n : f (n-1)という感じになっているはずだ。これは、fの型がInt->[Int]型（であるとすると）､(g f)もInt->[Int]型、よって自動的にgは(Int->[Int])->(Int->[Int])型、ということに一致している。
  • nが0のときは、g f = \n -> [0]。(g f)がInt->[Int]型だということを考えれば、自然にこの結論になる。
  • よって、g f = \n -> if n==0 then [0] else n : f (n-1)
• 結論。loopに入れる関数は、\(b',f) -> (f b',\n -> if n==0 then [0] else n : f (n-1))。

Prelude Control.Arrow> loop (\(b',f) -> (f b',\n -> if n==0 then [0] else n : f (n-1))) 12
[12,11,10,9,8,7,6,5,4,3,2,1,0]

(>>>)、(<<<)

Arrowを使うときに一番基本となる演算子、つまり二項関数(>>>)はじつはCategoryクラスで宣言されている。(->)型なら、例えば、次のように使う:

Prelude Control.Arrow> let f = (++ "I ") >>> (++ "love ") >>> ((++ "Haskell."))
Prelude Control.Arrow> f "Yes! "
"Yes! I love Haskell."
Prelude Control.Arrow> f "No! "
"No! I love Haskell."

(>>>)は関数を右から適用していくわけ。実際、(->)に置ける定義は、次のとおり:

-- | Left-to-right composition
(>>>) :: Category cat => cat a b -> cat b c -> cat a c
f >>> g = g . f

反対方向の(<<<)もある:

-- | Left-to-right composition
(<<<) :: Category cat => cat b c -> cat a b -> cat a c
(<<<) = (.)

その他の関数は、http://www.haskell.org/ghc/docs/latest/html/libraries/base/src/Control-Category.html にある。

const

いろんなサイトのArrowの例に出てくるのが、const関数。これは、GHC.Baseにある。

例えば、こういうことはできない:

Prelude Control.Arrow> let f = "I " >>> (++ "love ") >>> ((++ "Scheme."))

<interactive>:1:8:
    Couldn't match expected type `a b' against inferred type `[]'
      Expected type: a b c
      Inferred type: [Char]
    In the first argument of `(>>>)', namely `"I "'
    In the expression: "I " >>> (++ "love ") >>> ((++ "Scheme."))
Prelude Control.Arrow> 

演算子>>>の両側は同じArrowのインスタンス(ここでは関数)でなくてはならなくって、"I "は関数ではないから。じゃぁ、どうするんだっていうと、こうする:

Prelude Control.Arrow> let f = (const "I ") >>> (++ "love ") >>> ((++ "Scheme."))
Prelude Control.Arrow> f "Not: "
"I love Scheme."

constは引数を捨てて、あらかじめ設定しておいた定数を返す関数を作り出す。

(***)、curry、uncurry

やっと、Arrowクラス。

まず、(***)演算子。これは型を確認すれば、何をしたいのか分かる(Haskellにおいて、型はすごく有益な情報):

(***) :: a b c -> a b' c' -> a (b, b') (c, c')
(***) f g ~(x,y) = (f x, g y)

関数型でいえば、次のような感じ:

(***) :: (b -> c) -> (b' -> c') -> ((b, b') -> (c, c'))
f *** g = \(x,y) -> (f x, g y)

二つのArrow型(ここでは関数)を並列化させて、タプルからタプルを作る関数を作り出す。

Prelude Control.Arrow> let f = (++ "ABC") *** (+ 10)
Prelude Control.Arrow> f ("abc:", 2)
("abc:ABC",12)

さて、次のような関数の等価物を作ってみよう:

Prelude Control.Arrow> let f x y = (x * 2, y * 3)
Prelude Control.Arrow> f 4 5
(8,15)

つぎのようにやっても、うまくいかない:

Prelude Control.Arrow> let g = (* 2) *** (* 3)
Prelude Control.Arrow> g 4 5

<interactive>:1:0:
    Couldn't match expected type `t1 -> t'
           against inferred type `(Integer, Integer)'
    In the expression: g 4 5
    In the definition of `it': it = g 4 5

なぜなら、型が違うから:

Prelude Control.Arrow> :t f
f :: (Num a, Num a1) => a -> a1 -> (a, a1)
Prelude Control.Arrow> :t (* 2) *** (* 3)
(* 2) *** (* 3) :: (Num b', Num b) => (b, b') -> (b, b')

fは二引数関数*2なのに、(* 2) *** (* 3) はタプルをとる関数。こういうときは、関数curryを使う:

Prelude Control.Arrow> :t curry
curry :: ((a, b) -> c) -> a -> b -> c
Prelude Control.Arrow> let h = (curry ((* 2) *** (* 3)))
Prelude Control.Arrow> h 4 5
(8,15)

では、その逆の次の関数の等価物は?

Prelude Control.Arrow> let f (x, y) = x*2 + y*3
Prelude Control.Arrow> f (4, 5)
23

このときは、curryの逆関数uncurryを使う(こともできる):

Prelude Control.Arrow> let g = (* 2) *** (* 3) >>> uncurry (+)  -- >>>は***より結合力が低い
Prelude Control.Arrow> g (4, 5)
23

curryとuncurryを組み合わせて次のようにできる:

Prelude Control.Arrow> let f x y = x*2 + y*3
Prelude Control.Arrow> f 4 5
23
Prelude Control.Arrow> let g = curry ((* 2) *** (* 3) >>> uncurry (+))
Prelude Control.Arrow> g 4 5
23

すでに難読化の兆しが見えはじめている…

(&&&)

では、さらに、さらに次の関数の等価物はどう作れば良いのだろうか？

Prelude Control.Arrow> let f x = x^2 + x^3
Prelude Control.Arrow> f 4
80

こういうときは、(&&&)演算子を使う:

(&&&) :: a b c -> a b c' -> a b (c,c')
f &&& g = arr (\b -> (b,b)) >>> f *** g

関数型に直せば、こんな感じ:

(&&&) :: (b -> c) -> (b -> c') -> (b -> (c,c'))
f &&& g = \b -> (f b, g b)

これを使って:

Prelude Control.Arrow> let g = (^ 2) &&& (^ 3)
Prelude Control.Arrow> g 4
(16,64)

さらに、uncurryを使って:

Prelude Control.Arrow> let h = (^ 2) &&& (^ 3) >>> uncurry (+)
Prelude Control.Arrow> h 4
80

これがお題のfの等価物。

組み合わせた例

ずっと、「次の関数の等価物は？」というお題が続く。>>>と***と&&&の組み合わせで結構いろいろなことができる。例えば、次の関数の等価物は？

Prelude Control.Arrow> let f x y = (x + 1) * (x + 2) * ((y + 3) ^ 2)
Prelude Control.Arrow> f 10 0
1188

Prelude Control.Arrow> let g = curry ((((+ 1) &&& (+ 2)) >>> uncurry (*)) *** ((+ 3) >>> (^ 2)) >>> uncurry (*))
Prelude Control.Arrow> g 10 0
1188

app

そして、app関数:

class Arrow a => ArrowApply a where
        app :: a (a b c, b) c

instance ArrowApply (->) where
        app (f,x) = f x

見てのとおり、ArrowApplyサブクラスに入っているものしか使えない。もっとも、ArrowApplyでないArrowにどんなものがあるのか僕には分からないけど。さて、これをどういった風に使うかといえば、簡単な例:

Prelude Control.Arrow> let f (f', x) = f' (x * 2)
Prelude Control.Arrow> f ((+ 10), 2)
14
Prelude Control.Arrow> let g = id *** (* 2) >>> app
Prelude Control.Arrow> g ((+ 10), 2)
14

上の節で、次のような等価書き換えを紹介した:

Prelude Control.Arrow> let f x = x^2 + x^3
Prelude Control.Arrow> f 4
80
Prelude Control.Arrow> let h = (^ 2) &&& (^ 3) >>> uncurry (+)
Prelude Control.Arrow> h 4
80

これはapp関数を使って次のように書くこともできる:

Prelude Control.Arrow> let h2 = ((^ 2) >>> (+)) &&& (^ 3) >>> app
Prelude Control.Arrow> h2 4
80

分かりやすさでいえば、前者のhのほうが分かりやすいだろう。第一に、h2だと&&&の右側のラインを流れている値の型が途中で数値型から関数型に変化している。第二に、二つのラインの最後にそれを合流させるのは(+)ですよということが分かる。これが初めから関数型のラインなのであれば、appで合流させたほうが自然だけど。加えて、第三に、後者のh2のほうが括弧が増えている。

でも、後者のh2のほうがちょっとだけ、よりArrow的だと僕は感じる。なんでそう感じるのかはよく分からないけど。うーん… uncurryが如何にも技巧的な感じがするのかなぁ…

first、second、fst、snd

first関数とsecond関数は次のように定義されている:

class Category a => Arrow a where
        first :: a b c -> a (b,d) (c,d)
        second :: a b c -> a (d,b) (d,c)
        second f = arr swap >>> first f >>> arr swap
                        where   swap ~(x,y) = (y,x)

instance Arrow (->) where
        first f = f *** id
        second f = id *** f

ということは、さっきの関数はつぎのように、ちょっとだけスマートに書ける:

Prelude Control.Arrow> let f (f', x) = f' (x * 2)
Prelude Control.Arrow> f ((+ 10), 2)
14
Prelude Control.Arrow> let g = id *** (* 2) >>> app
Prelude Control.Arrow> g ((+ 10), 2)
14
Prelude Control.Arrow> let h = second (* 2) >>> app
Prelude Control.Arrow> h ((+ 10), 2)
14

しかし、例えば、つぎの関数の等価物はどうすれば良いのだろうか？

Prelude Control.Arrow> let f (x, f') = f' (x * 2)
Prelude Control.Arrow> f (3, (+ 10))
16

つぎのように書いてはうまくいかない:

Prelude Control.Arrow> let g = first (* 2) >>> (flip app)
Prelude Control.Arrow> g (3, (+ 10))

<interactive>:1:0:
    No instance for (Show ((b -> (Integer, a -> a) -> c, b) -> c))
      arising from a use of `print' at <interactive>:1:0-12
    Possible fix:
      add an instance declaration for
      (Show ((b -> (Integer, a -> a) -> c, b) -> c))
    In the expression: print it
    In a 'do' expression: print it

型自体、おかしいもん:

Prelude Control.Arrow> :t f
f :: (Num t) => (t, t -> t1) -> t1
Prelude Control.Arrow> :t g
g :: (Integer, d) -> (b -> (Integer, d) -> c, b) -> c

app関数はflipできない（というか、できるけど、ここで意図したようには動かない）。なぜなら、app関数は1引数であるタプルの第一要素を第二要素に適用する関数だけど、flipは第一引数と第二引数を交換する関数だから。つぎのflip関数の等価物flip'とここで意図していることをやってくれるflipAを見てみれば分かる:

Prelude Control.Arrow> let flip' f a b = f b a
Prelude Control.Arrow> (flip (/)) 2 10
5.0
Prelude Control.Arrow> let flipA f (a, b) = f (b, a)
Prelude Control.Arrow> (flipA (uncurry (/))) (2, 10)
5.0

このflipA関数、あるいは「app' (a, f) = app (f, a)」みたいな関数はよく使うだろうと思うのに、どうも用意されていないみたい（見落としかも）。ひとまず、こういう関数を用意して、意図したことをすることはできる:

Prelude Control.Arrow> let f (x, f') = f' (x * 2)
Prelude Control.Arrow> f (3, (+ 10))
16
Prelude Control.Arrow> let flipA f (a, b) = f (b, a)
Prelude Control.Arrow> let app' = flipA app
Prelude Control.Arrow> let g2 = first (* 2) >>> (flipA app)
Prelude Control.Arrow> g2 (3, (+ 10))
16
Prelude Control.Arrow> let g3 = first (* 2) >>> app'
Prelude Control.Arrow> g3 (3, (+ 10))
16

でも、この解決は十分簡潔でわかりやすいけど、Arrowにこだわるという一点について、次のタプル操作関数fst、sndを使った方がよりArrow的だと思う:

fst :: (a, b) -> a
snd :: (a, b) -> b

これで、さっきの関数はこう書ける:

Prelude Control.Arrow> let h = first (* 2) >>> snd &&& fst >>> app
Prelude Control.Arrow> h (3, (+ 10))
16

(snd &&& fst)の部分で、1.タプルを複製する、2.複製した一方のタプルの第二要素を取り出す、3.もう一方のタプルの第一要素を取り出す、4.2と3で取り出した要素をこの順序でタプルにする、という操作によって、タプルの要素を入れ替えている。

ちなみに、次のように書くこともできる:

h2 = first ((* 2) >>> flip ($)) >>> app)

Arrowの中でのfst、sndにはいらない引数を捨てるという機能もあり、とくにcurryと組み合わせると有用だと思う:

Prelude Control.Arrow> let f x y = x * 2
Prelude Control.Arrow> f 1 10
2
Prelude Control.Arrow> let h = curry (fst >>> (* 2))
Prelude Control.Arrow> h 1 10
2

(つづく)

*1:正確にはここではArrowLoopクラス。

*2:厳密には違うけど。