読者です 読者をやめる 読者になる 読者になる

究極のモナド「Idealモナド」を垣間見る

新年おめでとうございます。

突然だが、中身への関数適用(fmap)、シングルトンの生成(return)、ネストの結合(join)ができるコンテナを一般化するとモナドになる。

昨年話題になったのでご存知の方も多いと思うが、モナドをシングルトンの生成とネストの結合に関して一般化する、Freeモナドという構造がある。

さらにFreeモナドを一般化すると…Idealモナドになるのだ。

発端

イデアルモナド！？なにそれかっこいい！

そして、私の長い旅が始まる…

定義

Monads and More: Part 2によれば、

An ideal monad on C is a monad (T, η, μ) together with an endofunctor T' on C and a natural transformation μ' : T' T → T such that T = Id + T', η = inl, μ = [id, inr ◦ μ']

Tは対象のイデアルモナド、ηはreturn、μはjoin、IdはIdentity、+は直和型、inlは左のコンストラクタ、inrは右のコンストラクタに、[f, g]はeither f g的な関数に対応する。で、T'とμ'が新たに定義されるようだ。とりあえず愚直に組んでみる。

import Control.Monad

data Ideal f a = Pure a | Ideal (f a)        -- T = Id + T' 

class Functor f => Mu' f where
    mu' :: f (Ideal f a) -> f a              -- μ' : T' T → T

instance Mu' f => Monad (Ideal f) where
    return = Pure                            -- η = inl
    Pure a >>= k = k a                       -- id
    Ideal fa >>= k = Ideal $ mu' $ fmap k fa -- inr ◦ μ'

What is the correct definition of ideal monads?によれば、

  • mu' . fmap return = id :: Mu' f => f a -> f a
  • mu' . mu' = mu' . fmap join :: Mu' f => f (Ideal f (Ideal f a)) -> f a

の二つの式を満たすときイデアルモナドになる。ｺﾝﾊﾟｲﾙﾄｵｯﾀｧｧｧｧｧｗｗｗｗｗｗｗｗ

実例

これだけでは動かしようがないので、Freeモナドを構成してみよう。

newtype Liberty f a = Liberty (f (Free f a))

type Free f = Ideal (Liberty f)

instance Functor f => Functor (Liberty f) where
    fmap f (Liberty fia) = Liberty (fmap (liftM f) fia)

instance Functor f => Mu' (Liberty f) where
    mu' (Liberty fii) = Liberty $ fmap join fii

free :: Functor f => f (Free f a) -> Free f a
free f = Ideal (Liberty f)

Libertyは与えられたFunctorで包まれたFree、FreeはLibertyに対するIdealと定義する。

Freeモナド(=Ideal (Liberty f))に対するliftMとjoinを、それぞれLibertyの中身に使うことでfmapとmu'を実装している。

よし早速テスト…って、よく考えてみたらFreeモナドも単体では動かしようがないじゃないか！

実例の実例

仕方ないので、そろそろFreeモナドに関して一言いっとくかから例を引っ張り出してきた。

data CharIO a = GetCh (Char -> a) | PutCh Char a

instance Functor CharIO where
    fmap f (GetCh g) = GetCh (f . g)
    fmap f (PutCh c x) = PutCh c (f x)

getCh :: Free CharIO Char
getCh = free $ GetCh $ \ch -> Pure ch

putCh :: Char -> Free CharIO ()
putCh ch = free $ PutCh ch (Pure ())

runStdIO :: Free CharIO a -> IO a
runStdIO (Pure a) = return a
runStdIO (Ideal (Liberty (GetCh f)))       = getChar >>= \ch -> runStdIO (f ch)
runStdIO (Ideal (Liberty (PutCh ch cont))) = putChar ch >> runStdIO cont

main = runStdIO $ do
    mapM_ putCh "Hello, Haskeller! Please input a character: "
    ch <- getCh
    mapM_ putCh "The ordinal of the character is: "
    mapM_ putCh (show (ord ch))
    mapM_ putCh ".\nThank you!\n"

早速実行してみる。

Prelude> main
Hello, Haskeller! P(メモリをすごい勢いで消費しつつだんだん遅くなる)

理由は簡単だった。(>>=)はfmapとmu'を呼び出し、そのfmapとmu'はliftM、join経由で(>>=)を呼び出していたのだ！これでは組み合わせおねえさんめいて計算量が爆発四散してしまう！

2013/3/5追記: IdealをFunctorのインスタンスにし、Liberty (fmap (liftM f) fia)の代わりにLiberty (fmap (fmap f) fia)とすれば問題なく実行できる。

融合と本質

一つにしてしまえばこの問題は起こらないはずなので、fmapとmu'の機能を併せ持つ(>>~)を使うようにした。

class Idealize f where
    (>>~) :: f a -> (a -> Ideal f b) -> f b

instance Idealize f => Monad (Ideal f) where
    return = Pure
    Pure a >>= k = k a
    Ideal fa >>= k = Ideal $ fa >>~ k

newtype Liberty f a = Liberty (f (Free f a))

type Free f = Ideal (Liberty f)

instance Functor f => Idealize (Liberty f) where
    Liberty fm >>~ k = Liberty (fmap (>>=k) fm)

free :: Functor f => f (Free f a) -> Free f a
free f = Ideal (Liberty f)

おっと！？

おわかりいただけただろうか…Idealizeのインスタンス宣言をもう一度よく見て欲しい。

Liberty fm >>~ k = Liberty (fmap (>>=k) fm)

普通のFreeモナドの定義を思い出してみよう。

data Free f a = Pure a | Free (f (Free f a))

instance Functor f => Monad (Free f) where
    return = Pure
    Pure a >>= k = k a
    Free fm >>= k = Free (fmap (>>=k) fm)

そう、まさに(>>~)の定義は、Freeモナドをモナドたらしめる最も重要な式、Free fm >>= k = Free (fmap (>>=k) fm)と同じなのである！

無事に定義ができたので、早速動かしてみよう。

Prelude> main
Hello, Haskeller! Please input a character: m
The ordinal of the character is: 109.
Thank you!

当たり前だが、動いた！感動した！これが…モナドの力なのか…

まとめ

Freeのさらなる一般化、Ideal。抽象的すぎて実用性があるのかどうかわからないが、大変興味深い構造である。今のところ、Hackage上にIdealモナドを扱うパッケージはない(以前はあったが廃止されたようだ)ので、あとでアップロードするかもしれない。

この記事で使用したソースコードはhttps://gist.github.com/4445447にある。