綱渡りと Category (と，Kleisli)

多価関数と Category ← 前の記事

前回に引き続き Category 型クラスについて考えていきます．
「失敗するかもしれない計算」が Category であることを示し，前回作った NonDet カテゴリーと比較します．
さらに，「モナドを返す計算」である Kleisli カテゴリーについて考えてみます．

次の記事 → (>>=) を (>=>) に書き換える

復習

NonDet

前回は非決定性計算を表す NonDet i o 型を次のように定義して，

newtype NonDet i o = NonDet { runNonDet :: i -> [o] }

さらにこれを Category とかいう型クラスのインスタンスにしました．

import Control.Category hiding (id, (.))
import qualified Control.Category as Cat
import Control.Monad

newtype NonDet i o = NonDet { runNonDet :: i -> [o] }

instance Category NonDet where
    id = NonDet return
    (NonDet f) . (NonDet g) = NonDet $ f <=< g

今回も Control.Category.id は Cat.id, (Control.Category..) は (Cat..) と書いていくことにします．

Category 型クラス

Category 型クラスは恒等計算 Cat.id と計算の合成 (Cat..) を提供してくれる型クラスでした．

また Control.Category モジュールには便利な函数 (>>>) と (<<<) があり，

(<<<) = (Cat..) = flip (>>>)

でした．

失敗するかもしれない計算

Possible i o 型

i -> [o] という型は，複数の出力をもつ非決定性計算を表していました．
今回は，i -> Maybe o という型について考えてみます．この型を持つ計算は，Maybe を返します．即ち，「失敗するかもしれない計算」を表していると言えます．

まず前回と同様，newtype で「失敗するかもしれない計算」を表す型を作ってみます．
いい型名が思い浮かばなかったので Possible で行きます．

newtype Possible i o = Possible { runPossible :: i -> Maybe o } 

例によって Possible 型の函数を実行するために runPossible を使います．

newtype Possible i o = Possible { runPossible :: i -> Maybe o } 

safeHead :: [t] -> Maybe t
safeHead []    = Nothing
safeHead (x:_) = Just x

safeHeadP :: Possible [t] t
safeHeadP = Possible safeHead

ghci

ghci> runPossible safeHeadP [10, 20, 30]
Just 10

ghci> runPossible safeHeadP []
Nothing

ghci> runPossible (Possible return) 10000
10000

「失敗するかもしれない計算」の合成

「失敗するかもしれない計算」の合成について考えてみます．
例えば次のような単純な函数について考えてみます．

biggerDouble :: (Ord t, Num t) => t -> t -> Maybe t
biggerDouble n x
  | n < x     = Just (x * 2)
  | otherwise = Nothing

例えば (biggerDouble 1) は 1 より大きい値を引数として与えると，引数を 2 倍したのち Just にくるんで返してくれます．しかし 1 以下の引数に対しては Nothing しか返してくれません．

(biggerDouble 2) ならば引数が 2 より大きい値のときのみ， 2 倍したのち Just にくるんで返してくれます．
同様に (biggerDouble 10000) ならば引数が 10000 より大きい値のときのみ，2 倍したのち Just にくるんで返します．

ghci

ghci> (biggerDouble 1) 10
Just 20

ghci> (biggerDouble 1) 2
Just 4

ghci> (biggerDouble 1) 1
Nothing

ghci> (biggerDouble 1) 0
Nothing

ghci> (biggerDouble 10000) 20000
Just 40000

ghci> (biggerDouble 10000) 5000
Nothing

(biggerDouble 1) :: (Ord t, Num t) => t -> Maybe t であるため，そのままでは例えば (biggerDouble 1) と (biggerDouble 10000) を合成する，というようなことはできません．

(biggerDouble n) と (biggerDouble m) を合成するとしたら，例えば

• 最初の計算の答えが Just x ならば x に対して次の計算を適用する．
• 最初の計算の答えが Nothing ならば次の計算の答えも Nothing とする．

とするような合成が考えられます．

ここで Maybe がファンクターであり，Maybe 値には fmap が使えることを利用してみます．

ghci> fmap (*2) (Just 2)
Just 4

ghci> fmap (*2) (Just 3)
Just 6

ghci> fmap (*2) Nothing
Nothing

ghci> fmap (\x -> Just (x * 2)) (Just 2) 
Just (Just 4)

ghci> fmap (\x -> Just (x * 2)) Nothing 
Nothing

このように fmap を使うと Just の中身に対して次の計算を適用することができそうです．さらに，Nothing に対して fmap するとちゃんと Nothing を返してくれます．

一つ問題は，Just (Just 4) のように入れ子になってしまうことです．Control.Monad モジュールには，この入れ子を解消してくれる join 関数が存在するので，これを使わせてもらいましょう．

ghci

ghci> join (Just (Just 4))
Just 4

ghci> join . fmap (\x -> Just (x * 2)) $ (Just 2)
Just 4

ghci> join . fmap (\x -> Just (x * 2)) $ Nothing
Nothing

以上より join . fmap を使うことで，「失敗するかもしれない計算」を次のように合成できることがわかりました．

ghci

ghci> join . fmap (biggerDouble 10) . (biggerDouble 2) $ 10
Just 40

ghci> join . fmap (biggerDouble 10) . (biggerDouble 2) $ 3
Nothing

ghci> join . fmap (biggerDouble 10) . join . fmap (biggerDouble 2) . (biggerDouble 2) $ 3
Just 24

ghci> join . fmap (biggerDouble 10) . join . fmap (biggerDouble 2) . (biggerDouble 4) $ 3
Nothing

前回は concat . map を使ったことを思い出すと，似たような合成になっています．
リストに対しての fmap が map であり，リストに対しての join が concat であるため実は同じことをやっている，ということがわかりました．

Possible を Category のインスタンスにする

「失敗するかもしれない計算」が join . fmap で合成できそう，ということがわかったので，前回の NonDet と同じ要領で「失敗するかもしれない計算」Possible を Category のインスタンスにしてみます．

import Control.Category hiding (id, (.))
import qualified Control.Category as Cat
import Control.Monad

newtype Possible i o = Possible { runPossible :: i -> Maybe o } 

instance Category Possible where
    id = Possible (\x -> Just x)
    (Possible f) . (Possible g) = Possible $ join . fmap f . g

biggerDouble の Possible 版を作って動かしてみましょう．

import Control.Category hiding (id, (.))
import qualified Control.Category as Cat
import Control.Monad

newtype Possible i o = Possible { runPossible :: i -> Maybe o } 

instance Category Possible where
    id = Possible (\x -> Just x)
    (Possible f) . (Possible g) = Possible $ join . fmap f . g

biggerDouble :: (Ord t, Num t) => t -> t -> Maybe t
biggerDouble n x
  | n < x     = Just (x * 2)
  | otherwise = Nothing

biggerDoubleP :: (Ord t, Num t) => t -> Possible t t
biggerDoubleP n = Possible (biggerDouble n)

ghci

ghci> runPossible ((biggerDoubleP 10) Cat.. (biggerDoubleP 2)) 10
Just 40

ghci> runPossible ((biggerDoubleP 10) <<< (biggerDoubleP 2)) 10
Just 40

ghci> runPossible ((biggerDoubleP 10) Cat.. (biggerDoubleP 2)) 3
Nothing

ghci> runPossible ((biggerDoubleP 10) Cat.. (biggerDoubleP 2) Cat.. (biggerDoubleP 2)) 3
Just 24

ghci> runPossible (Cat.id <<< (biggerDoubleP 10) <<< Cat.id <<< (biggerDoubleP 2) <<< (biggerDoubleP 2) <<< Cat.id) 3
Just 24

ghci> runPossible ((biggerDoubleP 10) <<< (biggerDoubleP 2) <<< (biggerDoubleP 4)) 3
Nothing

きちんと動いているようです！

綱渡り

すごい H 本¹ 中で登場する「綱渡り」について考えてみます．
(Learn You a Haskell for Great Good! : Walk the line)

バランス棒の左右に鳥がとまっていき，棒の左右にとまった鳥の数の差が 4 以上になってしまうと綱から転落してしまう，という状況です．

まず鳥の数とバランス棒は次のように表現されています．

type Birds = Int
type Pole = (Birds, Birds)

棒の左右に鳥がとまる函数は次のように定義されています．

landLeft :: Birds -> Pole -> Maybe Pole  
landLeft n (left,right)  
    | abs ((left + n) - right) < 4 = Just (left + n, right)  
    | otherwise                    = Nothing  

landRight :: Birds -> Pole -> Maybe Pole  
landRight n (left,right)  
    | abs (left - (right + n)) < 4 = Just (left, right + n)  
    | otherwise                    = Nothing

これで鳥がとまっていく過程を次のように記述できる，という訳です．
(詳しくはすごい H 本を読もう！)

ghci

ghci> return (0, 0) >>= landRight 2 >>= landLeft 2 >>= landRight 2
Just (2, 4)

ghci> return (0, 0) >>= landRight 1 >>= landLeft 4 >>= landRight (-1) >>= landRight 2
Nothing

さて，この landLeft 函数と landRight 函数は一つ引数を与えると i -> Maybe o のような型になります．
ということで，Possible i o 型の計算を作ってみましょう．

import Control.Category hiding (id, (.))
import qualified Control.Category as Cat
import Control.Monad

newtype Possible i o = Possible { runPossible :: i -> Maybe o } 

instance Category Possible where
    id = Possible (\x -> Just x)
    (Possible f) . (Possible g) = Possible $ join . fmap f . g

type Birds = Int
type Pole = (Birds, Birds)

landLeft :: Birds -> Pole -> Maybe Pole  
landLeft n (left,right)  
    | abs ((left + n) - right) < 4 = Just (left + n, right)  
    | otherwise                    = Nothing  

landRight :: Birds -> Pole -> Maybe Pole  
landRight n (left,right)  
    | abs (left - (right + n)) < 4 = Just (left, right + n)  
    | otherwise                    = Nothing

banana :: Pole -> Maybe Pole
banana _ = Nothing

landLeftP :: Birds -> Possible Pole Pole
landLeftP n = Possible (landLeft n)

landRightP :: Birds -> Possible Pole Pole
landRightP n = Possible (landRight n)

bananaP :: Possible Pole Pole
bananaP = Possible banana

新しく banana なるものが追加されていますが，これは強制的に綱渡りを失敗させます．

これで Possible を用いた綱渡りのシミュレートができるようになりました！

ghci

ghci> runPossible ((landRightP 2) >>> (landLeftP 2) >>> (landRightP 2)) (0, 0)
Just (2,4)

ghci> runPossible ((landRightP 1) >>> (landLeftP 4) >>> (landRightP (-1)) >>> (landRightP 2)) (0, 0)
Nothing

ghci> runPossible ((landLeftP 1) >>> bananaP >>> (landRightP 1)) (0, 0)
Nothing

instance Category Possible 再考

Maybe はリストと同じくモナドでした．Maybe の Monad インスタンスは次のようになっています．

Data.Maybe

instance  Monad Maybe  where
    (Just x) >>= k      = k x
    Nothing  >>= _      = Nothing

    (Just _) >>  k      = k
    Nothing  >>  _      = Nothing

    return              = Just
    fail _              = Nothing

これを見ると， \x -> Just x は Maybe モナドにおける return と等値であることがわかります．

これより Possible の Category インスタンス宣言は次のように書けます．

instance Category Possible where
    id = Possible return
    (Possible f) . (Possible g) = Possible $ join . fmap f . g

次は join . fmap f . g の部分について見ていきます．

実は join に関しては次のような事実が存在します．

• モナド値 x :: Monad m => m a と函数 f :: a -> m b に対して， x >>= f と join (fmap f x) が等価である

これはモナド則などから導き出せるのですが，とりあえず今はこの事実を利用して join . fmap f . g 部分を書き換えてみます．

join . fmap f . g
= \x -> join (fmap f (g x))
= \x -> (g x) >>= f
= g >=> f
= f <=< g

ここで (>=>) と (<=<) は Control.Monad モジュールで定義されている函数でした．

Control.Monad

-- | Left-to-right Kleisli composition of monads.
(>=>)       :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
f >=> g     = \x -> f x >>= g

-- | Right-to-left Kleisli composition of monads. @('>=>')@, with the arguments flipped
(<=<)       :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)
(<=<)       = flip (>=>)

最終的に，Possible の Category インスタンス宣言は次のように書けることがわかりました．

import Control.Category hiding (id, (.))
import qualified Control.Category as Cat
import Control.Monad

newtype Possible i o = Possible { runPossible :: i -> Maybe o } 

instance Category Possible where
    id = Possible return
    (Possible f) . (Possible g) = Possible $ f <=< g

Kleisli カテゴリー

NonDet と Possible を比べてみる

Possible の Category インスタンス宣言を見てみると，なんだか前回の NonDet と似ている気がします．ということで，比較してみましょう．

instance Category NonDet where
    id = NonDet return
    (NonDet f) . (NonDet g) = NonDet $ f <=< g

instance Category Possible where
    id = Possible return
    (Possible f) . (Possible g) = Possible $ f <=< g

似ているというか，Cat.id と (Cat..) の定義がまったく同じです！

ここまでくると，i -> IO o とか i -> State s o とか，他の「モナドを返す計算」も同じように Category のインスタンスにできそうな気がしてきます．

では，「モナドを返す計算」(Monad m) => i -> m o が Category のインスタンスであるということを見ていきましょう．

Kleisli カテゴリー

Control.Arrow モジュール内には Kleisli というカテゴリーが定義されています．

Control.Arrow

newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b }

instance Monad m => Category (Kleisli m) where
    id = Kleisli return
    (Kleisli f) . (Kleisli g) = Kleisli (\b -> g b >>= f)

\b -> g b >>= f は f <=< g と等価ですから，このインスタンス宣言は NonDet や Possible のインスタンス宣言とまったく同じであることがわかります．

NonDet のときの i -> [o] と同様， 直接 i -> m o という方を Category のインスタンスにすることは許されていないため，Kleisli という newtype で包んでから Category のインスタンスにしています．

Monad m => Kleisli m が Category のインスタンスであるということは，任意のモナド m に対して i -> m o という「モナドを返す計算」が Category のインスタンスになれるということです．
でも本当にそうなのでしょうか．Kleisli m が「本当に」 Category のインスタンスであるためには，Category 則を満たす必要があります．

Kleisli カテゴリーが Category 則を満たしていることの確認

Category 則

Category 則は以下の二つでした．

1. 恒等性 Cat.id >>> f = f >>> Cat.id = f
2. 結合性 (f >>> g) >>> h = f >>> (g >>> h)

恒等性の確認

f = Kleisli f' とおきます．

まず return x >>= g と g x が等価である，というモナドの左恒等性より Cat.id >>> f = f を示します．

Cat.id >>> f
= Kleisli return >>> Kleisli f'
= (Kleisli f') Cat.. (Kleisli return)
= Kleisli (\b -> return b >>= f')
= Kleisli (\b -> f' b)
= Kleisli f'
= f

次に m >>= return と m が等価である，というモナドの右恒等性より f >>> Cat.id = f を示します．

f >>> Cat.id
= Kleisli f' >>> Kleisli return
= (Kleisli return) Cat.. (Kleisli f')
= Kleisli (\b -> f' b >>= return)
= Kleisli (\b -> f' b)
= Kleisli f'
= f

よって Cat.id >>> f = f >>> Cat.id = f となります．

結合性の確認

\b -> g b >>= f が f <=< g と等価であることと
モナドの結合法則 f <=< (g <=< h) = (f <=< g) <=< h を利用します．

f = Kleisli f', g = Kleisli g', h = Kleisli h' とおくと，

(f >>> g) >>> h
= h <<< (g <<< f)
= Kleisli h' <<< (Kleisli g' <<< Kleisli f')
= Kleisli h' <<< (Kleisli $ g' <=< f')
= Kleisli $ h' <=< (g' <=< f')
= Kleisli $ (h' <=< g') <=< f'
= (Kleisli $ h' <=< g') <<< Kleisli f'
= (Kleisli h' <<< Kleisli g') <<< Kleisli f'
= (h <<< g) <<< f
= f >>> (g >>> h)

以上より，Kleisli カテゴリーが Category 則を満たしていることが証明できました．

これにより，任意のモナド m に対して i -> m o という「モナドを返す計算」が Category のインスタンスになれるということが証明されました．

Kleisli カテゴリーを使ってみる

最後に，Kleisli カテゴリーを実際に使ってみます．

綱渡りしてみる

import Control.Arrow

type Birds = Int
type Pole = (Birds, Birds)

landLeft :: Birds -> Pole -> Maybe Pole  
landLeft n (left,right)  
    | abs ((left + n) - right) < 4 = Just (left + n, right)  
    | otherwise                    = Nothing  

landRight :: Birds -> Pole -> Maybe Pole  
landRight n (left,right)  
    | abs (left - (right + n)) < 4 = Just (left, right + n)  
    | otherwise                    = Nothing

banana :: Pole -> Maybe Pole
banana _ = Nothing

ghci

ghci> runKleisli (Kleisli (landRight 2) >>> Kleisli (landLeft 2) >>> Kleisli (landRight 2)) (0, 0)
Just (2,4)

ghci> runKleisli (Kleisli (landRight 1) >>> Kleisli (landLeft 4) >>> Kleisli (landRight (-1)) >>> Kleisli (landRight 2)) (0, 0)
Nothing

ghci> runKleisli (Kleisli (landLeft 1) >>> Kleisli banana >>> Kleisli (landRight 1)) (0, 0)
Nothing

Possible の時と同じ結果が得られました．²

入出力してみる

ghci

ghci> :module + Control.Arrow

ghci> runKleisli (Kleisli (const getLine) >>> Kleisli (\s -> return (s ++ "?")) >>> Kleisli putStrLn) ()
Gochumon wa Usagi Desu ka
Gochumon wa Usagi Desu ka?

ghci> runKleisli (Kleisli (return . ("... " ++) ) >>> Kleisli putStrLn) "Onee-chan no nebosuke"
... Onee-chan no nebosuke

あとがき

Wikipedia で「クライスリ圏」について調べても「クライスリトリプル」ですでに挫折しました．圏論難しいですね．

続きを書く気力があれば，Category 型クラスの提供する恒等計算 id と計算の合成 (.) だけでは計算の中間結果を保存³できないことなどから Arrow を導入したいなあと思っています．

参考文献

Jeremy Gibbons and Oege de Moor 編，山下伸夫訳 「関数プログラミングの楽しみ」 (オーム社) 2010, 215-238

Miran Lipovača 著，田中英行・村主崇行訳 「すごい Haskell たのしく学ぼう！」 (オーム社) 2012

注釈

---

1. すごい Haskell 楽しく学ぼう！　本 ↩

2. Control.Arrow モジュールは函数 (<<<), (>>>) を再エクスポートしているため，別途 Control.Category をインポートする必要はありません． ↩

3. Just 3 >>= (\x -> Just "!" >>= (\y -> Just (show x ++ y))) みたいな ↩