しりとりモナド

しりとりの圏がいろいろ盛り上がっている（？）さなか、特に先日入れたツッコミ以降、ひらがなの集合の圏としりとりの圏の対応を考えててふと「これモナドになるんじゃね？」と思い立ちました。
以下参考：

• しりとりの圏における全単射と同型（＝同等） - たけをの日記＠天竺から帰ってきたよ
• しりとりごっこの輪 - 檜山正幸のキマイラ飼育記

ということで、おもむろにHaskellで書いてみた…けど、結構手抜き。頭の中では圏論チックに細かいところでいろいろ考えてたりしたんですが、コードがあまりにも大雑把で、詳細な内容が対応しないので、説明しません（ぇー
とりあえず、作って動かしてみたよ、ってことで。

※ 時間に追われて多少書きなぐったので、読みにくかったらすいません。日本語は後でちょこちょこ修正するかも。

実行例

実装の中身はあとまわしにして、まずは実行例。

しりとりの圏でいうところに射 「ああ」、「あい」、「いう」に相当する関数 aa, ai, iuをモナディックに定義します。日本語使うのめんどくさかったんで、ローマ字で代用です。あと、戻り値は、お尻の文字と、関数が持つ文字列のペアを返すようになってます。

aa, ai, iu :: Char -> Shiritori Char
aa 'a' = Writer ('a', Srtr "aa")
aa _ = sError

ai 'a' = Writer ('i', Srtr "ai")
ai _ = sError

iu 'i' = Writer ('u', Srtr "iu")
iu _ = sError

これらの関数を「合成」すると、しりとりになります。

 Main> display $ unit 'a'
"a"
*Main> display $ unit 'a' >>= ai
"ai"
*Main> display $ unit 'a' >>= ai >>= iu
"aiu"
*Main> display $ unit 'a' >>= aa >>= ai >>= iu
"aaiu"

unitはその名の通り、モナドの「単位」です。しりとりの圏での恒等射に相当するものを作ります。Haskellでは、本当はこれに相当するreturnって関数があるんですけど、都合悪いので今回は使ってません（ぇぇー

上の２つめと３つめの実行例を、いわゆる代数スタイル（でいいのかな？）に書き直すと、こんな感じで。

 Main> display $ unit ... (fmap ai) ... join $ 'a'
"ai"
*Main> display $ unit ... (fmap ai) ... (fmap (fmap iu)) ... join ... join $ 'a'
"aiu"
*Main> display $ unit ... (fmap ai) ... join ... (fmap iu) ... join $ 'a'
"aiu"

下2つの実行結果は同じになります。
ここで、使ってる各関数の説明。このモナドを <T, η, μ> としたとき、η＝unit, μ＝join（Haskellの標準関数） に相当。(...) は私がこさえた関数の合成で、f...g は f やって g。
本当はf;g って書きたかったけど、セミコロン使えなかったんで。

fmapはHaskellの標準関数で、モナドを一個上乗せする作用があります。f: X → TY, g: Y → TZ なるf, gがあったとして、fとgを「合成」させるために、Tg : TY → T(TZ)として、f;Tg: X → T(TZ) としちゃうのです。この、g に対して Tg を作る効果をfmapは提供してます。

※ 本当はfmapじゃなくて、モナド用にliftMって関数があるんですけど、都合悪いんで今回は使ってません（ぇぇぇー

んでもって、上乗せされて２重になったモナドを１個にまとめちゃうことができるのが、joinなのです。

その辺の話は、型で見るとよりわかりやすいです。

 Main> :t unit
unit :: Char -> Shiritori Char
*Main> :t unit ... (fmap ai)
unit ... (fmap ai) :: Char -> Writer SString (Shiritori Char)

<T, η, μ> でいう T ＝ Shiritori です。ほぼ。
あと実装コード見ればわかりますが、Writer SString ＝ Shiritori です。そこに注意すると、 unit ... (fmap ai) の型は

 Char -> Shiritori (Shiritori Char)

となります。
で、これの後に join を合成すると：

 Main> :t unit ... (fmap ai) ... join
unit ... (fmap ai) ... join :: Char -> Writer SString Char

型が Char -> Shiritori Char になってるのがわかります。自然変換μの効果。

で、以下の２つは同じ結果になります。

 Main> :t unit ... (fmap ai) ... (fmap (fmap iu)) ... join ... join 
unit ... (fmap ai) ... (fmap (fmap iu)) ... join ... join :: Char -> Writer SString Char
*Main> :t unit ... (fmap ai) ... join ... (fmap iu) ... join 
unit ... (fmap ai) ... join ... (fmap iu) ... join :: Char -> Writer SString Char

実装

上でも書きましたが、実装は結構手抜き。
Haskellの標準モナドであるWriterモナドを使ってます。

import Control.Monad.Writer

-- しりとり文字列
newtype SString = Srtr String
instance Show SString where
    show (Srtr s) = s

-- しりとり文字列はモノイド
instance Monoid SString where
    -- 単位元（今回は使わないので、未定義）
    mempty = undefined 
    -- 文字列上のモノイド演算子＝しりとり（ちょっと手抜き）
    mappend (Srtr xs) (Srtr ys) = Srtr $ mappend xs $ drop 1 ys 

-- しりとりモナド をWriterモナドを使って定義
type Shiritori = Writer SString

unit :: Char -> Shiritori Char
unit = \x -> Writer (x, Srtr [x])


-- モナディックな関数 「ああ」、「あい」、「いう」
aa, ai, iu :: Char -> Shiritori Char
aa 'a' = Writer ('a', Srtr "aa")
aa _ = sError

ai 'a' = Writer ('i', Srtr "ai")
ai _ = sError

iu 'i' = Writer ('u', Srtr "iu")
iu _ = sError


-- utilities
sError = error "Shiritori failure."

(...) :: (a -> b) -> (b -> c) -> a -> c
f ... g = g . f

display :: Shiritori Char -> String
display m = let (a, w) = runWriter m in show w