7
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

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

Last updated at Posted at 2020-04-03

想定読者

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

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

モノイド

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

Monoid クラス

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

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

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

カリー化

カリー化
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)

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

モノイド則

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

モノイド則
--結合律--
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 は自由モノイドに変換できる型だ1

自由モノイド
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 クラス

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

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

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

カリー化

カリー化
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

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

モナド則

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

モナド則
--結合律--
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 は自由モナドに変換できる型だ。

自由モナド
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 クラス

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

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

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

カリー化

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

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

コモノイド則

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

コモノイド則
--余結合律--
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 は余自由コモノイドから変換できる型だ。

余自由コモノイド
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

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

コモナド

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

CoMonad クラス

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

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

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

カリー化

カリー化
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

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

コモナド則

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

コモナド則
--余結合律--
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 は余自由コモナドから変換できる型だ。

余自由コモナド
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

まとめ

モノイドモナドが似ていることが分かると思う。

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

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

  1. 「Data.Foldableの正体」(2019-04-25)

7
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
7
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?