モノイドとモナドの対応関係

# 想定読者

モノイドやカリー化や自由モノイドを
それとなく理解している人に向けて。

モノイドとモナドの対応関係を見ることで
モナドに詳しくなった気分に浸ろう。



# モノイド

モノイドは種が `*` な型に対して定義できる。

## Monoid クラス

```haskell:Monoid
{-# LANGUAGE TypeOperators #-}
import Prelude hiding (Monoid(..), Foldable(..), curry, uncurry, (*))

class Monoid m where
    (<>)    :: m ~> (m *> m)
    mappend :: (m * m) ~> m
    mempty  :: Id ~> m
    {-# MINIMAL ((<>) | mappend), mempty #-}
    (<>) = curry mappend
    mappend = uncurry (<>)

newtype a *  b = Product { unProduct :: (a, b) }
newtype a *> b = Hom { unHom :: a -> b }
newtype Id = Id { runId :: () }
type a ~> b = a -> b
```

型 `a` と `b` の直積を `a * b` であらわしている。

積 `m * m` を引数とする関数 `mappend` と
それをカリー化した `(<>)` の両方を定義した。

## カリー化

```haskell:カリー化
curry :: ((a * b) ~> c) -> (a ~> (b *> c))
curry f = fmap' f . unit
  where
    unit :: a ~> (b *> (a * b))
    unit = Hom . fmap (fmap Product) (,)
    fmap' :: (a ~> b) -> ((c *> a) ~> (c *> b))
    fmap' h  = Hom . fmap h . unHom

uncurry :: (a ~> (b *> c)) -> ((a * b) ~> c)
uncurry g = counit . fmap' g
  where
    counit :: ((b *> c) * b) -> c
    counit (Product (f, a)) = unHom f a
    fmap' :: (a ~> b) -> ((a * c) ~> (b * c))
    fmap' h = h * id

(*) :: (a ~> a') -> (b ~> b') -> ((a * b) ~> (a' * b'))
(f * g) (Product (a, b)) = Product (f a, g b)
```

定義はごちゃごちゃしているが、実体は普通のカリー化だ。

## モノイド則

以下の関数を用いて結合律と単位律を記述する。

```haskell:モノイド則
--結合律--
asL :: Monoid m => ((m * m) * m) ~> m
asL = mappend . (mappend * id)
asR :: Monoid m => (m * (m * m)) ~> m
asR = mappend . (id * mappend)
--単位律--
idL :: Monoid m => (Id * m) ~> m
idL = mappend . (mempty * id)
idR :: Monoid m => (m * Id) ~> m
idR = mappend . (id * mempty)
--補助関数--
alpha :: ((a * b) * c) ~> (a * (b * c))
alpha (Product ((Product (a ,b)), c)) = Product (a, Product (b, c))
lambda :: (Id * b) ~> b
lambda = snd . unProduct
rho :: (a * Id) ~> a
rho = fst . unProduct
```

1. （結合律）`asL` $=$ `asR . alpha`

2. （単位律）`idL` $=$ `lambda ` と `idR` $=$ `rho`

## 自由モノイド

`Foldable` は自由モノイドに変換できる型だ[^toFMon]。

```haskell:自由モノイド
class Foldable t where
    foldMap  :: Monoid m =>                     (a ~> m) -> t a ~> m
    foldMap' ::  ((m * m) ~> m) -> (Id ~> m) -> (a ~> m) -> t a ~> m
    foldr    :: (a ~> (m *> m)) -> (Id ~> m) ->             t a ~> m
    {-# MINIMAL foldMap | foldr #-}
    foldMap         u    = foldr (curry mappend . u) mempty
    foldMap' mu eta u    = foldr (curry mu      . u) eta
    foldr    v  eta   ta = foldMap (\a -> Endo $ v a) ta `appEndo` eta

newtype Endo m = Endo (m *> m)
appEndo :: Endo m -> (Id -> m) -> m
appEndo (Endo (Hom f)) g = f (g (Id ()))

instance Monoid (Endo a) where
    mappend (Product (Endo (Hom a), Endo (Hom b))) = Endo $ Hom $ a . b
    mempty _ = Endo $ Hom id
```



# モナド

モナドは種が `* -> *` な型構築子に対して定義できる。

## Monad クラス

```haskell:Monad
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeOperators #-}
import Prelude hiding (Monad(..), Foldable(..), curry, uncurry, (*))

class Functor m => Monad m where
    (>>=)  :: m ~> (m *> m)
    join   :: (m * m) ~> m
    return :: Id ~> m
    {-# MINIMAL ((>>=) | join), return #-}
    (>>=) = curry join
    join = uncurry (>>=)

newtype (a *  b) i = Compose { unCompose :: a (b i) }
newtype (a *> b) i = Ran { unRan :: forall j. (Id i -> a j) -> b j }
newtype Id i = Id { runId :: i }
type a ~> b = forall i. a i -> b i
```

関手 `a` と `b` の合成を `a * b` であらわしている。

積 `m * m` を引数とする関数 `join` と
それをカリー化した `(>>=)` の両方を定義した。

## カリー化

```haskell:カリー化
curry :: Functor a => ((a * b) ~> c) -> (a ~> (b *> c))
curry f = fmap' f . unit
  where
    unit :: Functor a => a ~> (b *> (a * b))
    unit a = Ran $ \h -> Compose (fmap (h . Id) a)
    fmap' :: (a ~> b) -> ((c *> a) ~> (c *> b))
    fmap' h (Ran ca) = Ran $ fmap h ca

uncurry :: (a ~> (b *> c)) -> ((a * b) ~> c)
uncurry g = counit . fmap' g
  where
    counit :: ((b *> c) * b) ~> c
    counit (Compose (Ran h)) = h (id . runId)
    fmap' :: (a ~> b) -> ((a * c) ~> (b * c))
    fmap' h = Compose . h . unCompose

(*) :: Functor a => (a ~> a') -> (b ~> b') -> ((a * b) ~> (a' * b'))
f * g = Compose . f . fmap g . unCompose

instance (Functor a, Functor b) => Functor (a * b) where
    fmap f (Compose h) = Compose $ fmap (fmap f) $ h
instance Functor Id where
    fmap f = Id . f . runId
```

普通のカリー化とは違うけど、カリー化に見えるはずだ。

## モナド則

以下の関数を用いて結合律と単位律を記述する。

```haskell:モナド則
--結合律--
asL :: Monad m => (m * (m * m)) ~> m
asL = join . (id * join)
asR :: Monad m => ((m * m) * m) ~> m
asR = join . (join * id)
--単位律--
idL :: Monad m => (m * Id) ~> m
idL = join . (id * return)
idR :: Monad m => (Id * m) ~> m
idR = join . (return * id)
--補助関数--
alpha :: Functor c => (c * (b * a)) ~> ((c * b) * a)
alpha = Compose . Compose . fmap unCompose . unCompose
lambda :: Functor b => (b * Id) ~> b
lambda = fmap runId . unCompose
rho :: (Id * a) ~> a
rho = runId . unCompose
```

1. （結合律）`asL` $=$ `asR . alpha`

2. （単位律）`idL` $=$ `lambda ` と `idR` $=$ `rho`

## 自由モナド

`Foldable` は自由モナドに変換できる型だ。

```haskell:自由モナド
class Foldable t where
    foldMap  ::   Monad m =>                                (a ~> m) -> t a ~> m
    foldMap' :: Functor m => ((m * m) ~> m) -> (Id ~> m) -> (a ~> m) -> t a ~> m
    foldr    ::             (a ~> (m *> m)) -> (Id ~> m) ->             t a ~> m
    {-# MINIMAL foldMap | foldr #-}
    foldMap         u    = foldr (curry join . u) return
    foldMap' mu eta u    = foldr (curry mu   . u) eta
    foldr    v  eta   ta = foldMap (\a -> Codensity $ v a) ta `runCodensity` eta

newtype Codensity m i = Codensity ((m *> m) i)
runCodensity :: Codensity m i -> (Id i -> m j) -> m j
runCodensity (Codensity (Ran f)) = f

instance Functor (Codensity m) where
    fmap f ma = (>>=) ma `unRan` (return . fmap f)

instance Monad (Codensity m) where
    return a = Codensity $ Ran $ \k -> k a
    (>>=) m = Ran $ \k -> Codensity $ Ran $ \c -> runCodensity m $ \a -> runCodensity (k a) c
```



# コモノイド

コモノイドは種が `*` な型に対して定義できる。

## CoMonoid クラス

```haskell:CoMonoid
{-# LANGUAGE TypeOperators #-}
import Prelude hiding ((*))

class CoMonoid w where
    split   :: w ~> (w * w)
    destroy :: w ~> Id
    {-# MINIMAL split, destroy #-}

newtype a * b = Product { unProduct :: (a, b) }
newtype Id = Id { runId :: () }
type a ~> b = a -> b
```

型 `a` と `b` の直積を `a * b` であらわしている。

積 `w * w` を戻値とする関数 `split` と
それをカリー化した `(><)` を定義したいができない。

## カリー化

```haskell:カリー化
(*) :: (a ~> a') -> (b ~> b') -> ((a * b) ~> (a' * b'))
(f * g) (Product (a, b)) = Product (f a, g b)
```

カリー化に相当する一対一対応はたぶん存在しない。

## コモノイド則

以下の関数を用いて結合律と単位律を記述する。

```haskell:コモノイド則
--余結合律--
asL :: CoMonoid w => w -> ((w * w) * w)
asL = (split * id) . split
asR :: CoMonoid w => w -> (w * (w * w))
asR = (id * split) . split
--余単位律--
idL :: CoMonoid w => w ~> (Id * w)
idL = (destroy * id) . split
idR :: CoMonoid w => w ~> (w * Id)
idR = (id * destroy) . split
--補助関数--
alpha :: (a * (b * c)) ~> ((a * b) * c)
alpha (Product ((a, Product (b ,c)))) = Product (Product (a, b), c)
lambda :: b ~> (Id * b)
lambda b = Product (Id (), b)
rho :: a ~> (a * Id)
rho a = Product (a, Id ())
```

1. （余結合律）`asL` $=$ `alpha . asR`

2. （余単位律）`idL` $=$ `lambda ` と `idR` $=$ `rho`

## 余自由コモノイド

`CoFoldable` は余自由コモノイドから変換できる型だ。

```haskell:余自由コモノイド
class CoFoldable t where
    cofoldMap  :: CoMonoid w =>                  (w ~> a) -> w ~> t a
    cofoldMap' :: (w ~> (w * w)) -> (w ~> Id) -> (w ~> a) -> w ~> t a
    cofoldr    :: (w ~> (a * w)) -> (w ~> Id) ->             w ~> t a
    {-# MINIMAL cofoldr #-}
    cofoldMap         u   = cofoldr ((u * id) . split) destroy
    cofoldMap' mu eps u   = cofoldr ((u * id) . mu   ) eps
```

`cofoldMap` で `cofoldr` を定義できない気がする。
カリー化が存在しないことと関係があるかもしれない。



# コモナド

コモナドは種が `* -> *` な型構築子に対して定義できる。

## CoMonad クラス

```haskell:CoMonad
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE TypeOperators #-}
import Prelude hiding (curry, uncurry, (*))

class Functor w => CoMonad w where
    (<<=)     :: (w *> w) ~> w
    duplicate :: w ~> (w * w)
    extract   :: w ~> Id
    {-# MINIMAL ((<<=) | duplicate), extract #-}
    (<<=) = curry duplicate
    duplicate = uncurry (<<=)

newtype (a *  b) i = Compose { unCompose :: a (b i) } deriving Show
data    (a *> b) i = forall j. Lan { unLan :: (a j -> Id i, b j) }
newtype Id i = Id { runId :: i } deriving Show
type a ~> b = forall i. a i -> b i
```

関手 `a` と `b` の合成を `a * b` であらわしている。

積 `w * w` を戻値とする関数 `duplicate` と
それをカリー化した `(<<=)` の両方を定義した。

## カリー化

```haskell:カリー化
curry :: Functor a => (c ~> (a * b)) -> ((b *> c) ~> a)
curry g = counit . fmap' g
  where
    counit :: Functor a => (b *> (a * b)) ~> a
    counit (Lan (h, (Compose ab))) = fmap (runId . h) ab
    fmap' :: (c ~> b) -> ((a *> c) ~> (a *> b))
    fmap' h (Lan (a, c)) = Lan (a, h c)

uncurry :: ((b *> c) ~> a) -> (c ~> (a * b))
uncurry f = fmap' f . unit
  where
    unit :: c ~> ((b *> c) * b)
    unit c = Compose $ Lan (Id . id, c)
    fmap' :: (b ~> a) -> ((b * c) ~> (a * c))
    fmap' h = Compose . h . unCompose

(*) :: Functor a => (a ~> a') -> (b ~> b') -> ((a * b) ~> (a' * b'))
f * g = Compose . f . fmap g . unCompose

instance (Functor a, Functor b) => Functor (a * b) where
    fmap f (Compose h) = Compose $ fmap (fmap f) $ h
instance Functor Id where
    fmap f = Id . f . runId
```

普通のカリー化とは違うけど、カリー化に見えるはずだ。

## コモナド則

以下の関数を用いて結合律と単位律を記述する。

```haskell:コモナド則
--余結合律--
asL :: CoMonad w => w ~> (w * (w * w))
asL = (id * duplicate) . duplicate
asR :: CoMonad w => w ~> ((w * w) * w)
asR = (duplicate * id) . duplicate
--余単位律--
idL :: CoMonad w => w ~> (w * Id)
idL = (id * extract) . duplicate
idR :: CoMonad w => w ~> (Id * w)
idR = (extract * id) . duplicate
--補助関数--
alpha :: Functor c => ((c * b) * a) ~> (c * (b * a))
alpha = Compose . fmap Compose . unCompose . unCompose
lambda :: Functor b => b ~> (b * Id)
lambda b = Compose $ fmap Id b
rho :: a ~> (Id * a)
rho a = Compose $ Id a
```

1. （余結合律）`asL` $=$ `alpha . asR`

2. （余単位律）`idL` $=$ `lambda ` と `idR` $=$ `rho`

## 余自由コモナド

`CoFoldable` は余自由コモナドから変換できる型だ。

```haskell:余自由コモナド
class CoFoldable t where
    cofoldMap  :: CoMonad w =>                                (w ~> a) -> w ~> t a
    cofoldMap' :: Functor w => (w ~> (w * w)) -> (w ~> Id) -> (w ~> a) -> w ~> t a
    cofoldr    ::             ((w *> w) ~> a) -> (w ~> Id) ->             w ~> t a
    {-# MINIMAL cofoldMap | cofoldr #-}
    cofoldMap         u   = cofoldr (u . curry duplicate) extract
    cofoldMap' mu eps u   = cofoldr (u . curry mu  ) eps
    cofoldr    v  eps   w = cofoldMap (v . runDensity) $ (Density . Lan) (eps, w)

newtype Density w i = Density { runDensity :: (w *> w) i }

instance Functor (Density w) where
    fmap f (Density (Lan (g, w))) = Density $ Lan (Id . f . runId . g, w)

instance CoMonad (Density w) where
    (<<=) (Lan (f, (Density (Lan (g, w))))) = Density $ Lan (f . Density . Lan . ((,) g), w)
    extract (Density (Lan (f, w))) = f w
```



# まとめ

[__モノイド__](#モノイド)と[__モナド__](#モナド)が似ていることが分かると思う。

特に何かの役に立つわけではないけれど、
色々と見比べると何か楽しくないですかね。

[__コモノイド__](#コモノイド)と[__コモナド__](#コモナド)に関しての記述は
かなり怪しい気がするので注意してください。



[^toFMon]: [「Data.Foldableの正体」(2019-04-25)](https://qiita.com/lotz/items/424abee02fe598c60247)