想定読者
モノイドやカリー化や自由モノイドを
それとなく理解している人に向けて。
モノイドとモナドの対応関係を見ることで
モナドに詳しくなった気分に浸ろう。
モノイド
モノイドは種が * な型に対して定義できる。
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
型 a と b の直積を 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
（結合律）
asL$=$asR . alpha（単位律）
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
関手 a と b の合成を 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
（結合律）
asL$=$asR . alpha（単位律）
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
型 a と b の直積を 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 ())
（余結合律）
asL$=$alpha . asR（余単位律）
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
cofoldMap で cofoldr を定義できない気がする。
カリー化が存在しないことと関係があるかもしれない。
コモナド
コモナドは種が * -> * な型構築子に対して定義できる。
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
関手 a と b の合成を 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
（余結合律）
asL$=$alpha . asR（余単位律）
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
まとめ
特に何かの役に立つわけではないけれど、
色々と見比べると何か楽しくないですかね。