綱渡りと Category (と，Kleisli)

[多価関数と Category](http://qiita.com/CyLomw/items/a618b7c7326d9abede63 "多価関数と Category") ← 前の記事

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

次の記事 → [(>>=) を (>=>) に書き換える](http://qiita.com/CyLomw/items/a874cee33c69653f53c6 "(>>=) を (>=>) に書き換える")

# 復習

## `NonDet`

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

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

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

```hs
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` モジュールには便利な函数 `(>>>)` と `(<<<)` があり，

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

でした．

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

## `Possible i o` 型

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

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

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

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

```hs
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
```

```hs:ghci
ghci> runPossible safeHeadP [10, 20, 30]
Just 10

ghci> runPossible safeHeadP []
Nothing

ghci> runPossible (Possible return) 10000
10000
```

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

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

```hs
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 にくるんで返します．

```hs: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` が使えることを利用してみます．

```hs
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` 関数が存在するので，これを使わせてもらいましょう．

```hs: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` を使うことで，「失敗するかもしれない計算」を次のように合成できることがわかりました．

```hs: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` のインスタンスにしてみます． 

```hs
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` 版を作って動かしてみましょう．

```hs
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)
```

```hs: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 本[^1] 中で登場する「綱渡り」について考えてみます．
([Learn You a Haskell for Great Good! : Walk the line](http://learnyouahaskell.com/a-fistful-of-monads#walk-the-line))

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

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

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

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

```hs
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 本を読もう！)

```hs: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` 型の計算を作ってみましょう．

```hs
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` を用いた綱渡りのシミュレートができるようになりました！

```hs: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` インスタンスは次のようになっています．


```hs: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` インスタンス宣言は次のように書けます．

```hs
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` モジュールで定義されている函数でした．

```hs: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` インスタンス宣言は次のように書けることがわかりました．

```hs
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` と似ている気がします．ということで，比較してみましょう．


```hs
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` というカテゴリーが定義されています．

```hs: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`
1. 結合性 `(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` カテゴリーを実際に使ってみます．

### 綱渡りしてみる

```hs
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
```

```hs: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` の時と同じ結果が得られました．[^2]

### 入出力してみる

```hs: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` と計算の合成 `(.)` だけでは計算の中間結果を保存[^3]できないことなどから `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)))` みたいな