HaksellのStateモナドとReaderモナドで決定性有限オートマトンの実行


[正規表現技術入門](http://gihyo.jp/book/2015/978-4-7741-7270-5)を読んでたら、
昔、Stateモナド使わずにDFA(決定性有限オートマトン)を実装するという謎の努力をしていたこと思い出した。

当時はモナドがちっともわからなかったけど、
今は、少しわかるようになった...かな?

せっかくなので、State モナド使って DFA （の実行シミュレーション）を実装してみた。

# 先に感想を述べておくと

本質的な部分を下記のような簡潔なコードで書けるモナド、すごい

```.hs
askAccept :: RunDFA s a (s -> Bool)
askAccept = envAccept <$> ask

askTransition :: RunDFA s a (s -> a -> s)
askTransition = envTransition <$> ask

acceptWord :: [a] -> RunDFA s a Bool
acceptWord xs = do
  putWord xs
  acceptNow

putWord :: [a] -> RunDFA s a ()
putWord xs = forM_ xs putAlphabet

putAlphabet :: a -> RunDFA s a ()
putAlphabet x = do
  f <- askTransition
  modify $ flip f x

acceptNow :: RunDFA s a Bool
acceptNow = askAccept `ap` get
```

# 実装の方針

## DFAとは？

[正規表現技術入門](http://gihyo.jp/book/2015/978-4-7741-7270-5)を読もう（完）

一応、形式的な定義とWikipediaのリンクを貼っておく。

* 形式的な定義 = \<Q, Σ, δ, q, F\> の５つの組
  * Q 状態の有限集合
  * ∑ 入力記号の有限集合
  * δ : Q × ∑ -> Q 状態遷移関数 
  * q ∈ Q 初期状態
  * F ⊂ Q 受理状態の集合

* Wikipedia
	* [決定性有限オートマトン](http://ja.wikipedia.org/wiki/%E6%B1%BA%E5%AE%9A%E6%80%A7%E6%9C%89%E9%99%90%E3%82%AA%E3%83%BC%E3%83%88%E3%83%9E%E3%83%88%E3%83%B3)


## DFAの実行に必要な要素

\<Q, Σ, δ, q, F\> の５つ全ては必要ない。

DFAは、
* **初期状態** から始まる
* **現在の状態** と **入力された文字** から **状態遷移関数** に従い次の状態が確定される
* 最後の文字を入力し終わった段階で **現在の状態** が **受理状態の集合に属すとき、かつその時に限り** 入力文字列を受理する

そのため、Q,Σ 以外の （初期｜現在）の状態、状態遷移関数、受理状態の集合が必要になる。
なお、入力文字列は外部から与えられるため、DFA側で用意する必要はない。


## DFAの実行に必要なモナド

（初期｜現在）の状態は当然 State モナドで表現する。

一方で、状態遷移関数、受理状態の集合は状態ではない。
ただ、状態遷移や受理の判定のため、シミュレーション中は常に参照できる必要がある。
言ってしまえば、状態遷移関数、受理状態の集合は環境（設定？）のようなものである。
そこで、そのような環境を Reader モナドで表現することにする。

したがって、DFAの実行に必要なモナドは State モナドと Reader モナドを組み合わせた下記のようなモナドということになる。

``` RegExpr/StateR.hs
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module RegExpr.StateR(StateR, runStateR) where

import Control.Monad.Reader(Reader, MonadReader, runReader)
import Control.Monad.State(StateT, MonadState, runStateT)

-- | State モナドと Reader モナドと組合わせたモナド
newtype StateR s r a = StateR {runStateR' :: StateT s (Reader r) a}
  deriving(Functor, Monad, MonadState s, MonadReader r)

-- | Readerモナドと合わせた時の runState
-- | (値, 状態)を取り出す
runStateR :: StateR s r a -> s -> r -> (a, s)
runStateR m s r = (`runReader` r) . (`runStateT` s) $ runStateR' m
```

# 実装

## 実行中のDFAを表す型

とりあえず`Control.Monad`界隈から便利そうな関数をimportしておく。

```RegExpr/RunDFA.hs
module RegExpr.RunDFA where

import Control.Monad(ap, forM_)
import Control.Monad.Reader(ask)
import Control.Monad.State(get, modify)
import Data.Functor((<$>))

import RegExpr.StateR(StateR, runStateR)
```

前節で、実行中のDFAを次のように表す事にしたので、それに従い型を定義する。[^1]

[^1]: 「受理状態の集合」を「受理状態の集合に属するか判定する関数」に差し替えている部分は気にしてはいけない。ScalaのSet[A]が(A) => Boolean を継承してる感じのノリ

* State ：ひとつの状態
* Reader：｛状態遷移関数, 受理状態の集合 *に属するか判定する関数* ｝からなる環境


```RegExpr/RunDFA.hs
type RunDFA s a b = StateR s (EnvDFA s a) b

data EnvDFA s a = EnvDFA { envAccept     :: s -> Bool
                         , envTransition :: s -> a -> s
                         }
```

## 環境へのアクセス

複数の値が環境にあると参照する時にややこしいので、
それぞれ一発で参照できるよう、下記のような補助関数を定義しておく。

```RegExpr/RunDFA.hs
askAccept :: RunDFA s a (s -> Bool)
askAccept = envAccept <$> ask

askTransition :: RunDFA s a (s -> a -> s)
askTransition = envTransition <$> ask
```

## DFAの実行

DFA は

1. 文字列を受け取り状態を変化させ(`putWord`)、
2. 最終的に現在の状態が受理状態に属するか判定する(`acceptNow`)

のでそのように定義する。

```RegExpr/RunDFA.hs
acceptWord :: [a] -> RunDFA s a Bool
acceptWord xs = do
  putWord xs
  acceptNow
```

## 文字列を受け取り状態を変化させる

モナドで繰り返し処理するときは`forM`だか`forM_`だか使っとけってばっちゃが言ってた

ので、文字を受け取り状態を変化させる関数の繰り返しとして定義しておく

```
putWord :: [a] -> RunDFA s a ()
putWord xs = forM_ xs putAlphabet
```

## 文字を受け取り状態を変化させる

`modify`使って部分適用した遷移関数を現在の状態に作用させれば良し

```
putAlphabet :: a -> RunDFA s a ()
putAlphabet x = do
  f <- askTransition
  modify $ flip f x
```

## 現在の状態が受理状態に属するか判定する

モナドに包まれた関数にモナドに包まれた値を適用させる`ap`という奇っ怪な関数を使うと、下記の通りに定義できる。

```RegExpr/RunDFA.hs
acceptNow :: RunDFA s a Bool
acceptNow = askAccept `ap` get
```

# 使ってみる

## その前に、`runStateR` 使うと DFA 実行してる感じが薄れるので補助関数を増やす

実行前の初期状態を表す型と、それを受け取って実行する関数３つを定義しておく

```RegExpr/RunDFA.hs
data InitDFA s a = InitDFA s (EnvDFA s a)

runDFA :: RunDFA s a b -> InitDFA s a -> (b, s)
runDFA m (InitDFA s env) = runStateR m s env

evalDFA :: RunDFA s a b -> InitDFA s a -> b
evalDFA m = fst . runDFA m

execDFA :: RunDFA s a b -> InitDFA s a -> s
execDFA m = snd . runDFA m
```

## テスト用のDFA

{0, 1}上の文字列のうち、1が偶数個含まれている文字列を受理するDFA

```RegExpr/main.hs
import RegExpr.RunDFA

-- | 初期状態、受理状態が 0 で、
-- | '1'を入るたびに状態 0 1 が入れ替わるDFA
testDFARunner :: InitDFA Int Char
testDFARunner = InitDFA 0 $ EnvDFA (== 0) testTransition
  where
    testTransition x '0' = x
    testTransition 0 '1' = 1
    testTransition 1 '1' = 0
    testTransition _  _  = 2
```

## 	とりあえず動かす

適当にmain関数を書く

```RegExpr/main.hs
main :: IO ()
main = do
  -- run, eval, exec の違い
  printFunc "runDFA "  runDFA
  printFunc "evalDFA" evalDFA
  printFunc "execDFA" execDFA
    where
      printFunc name f = do
        let xs = "010010"
        putStrLn $ ">>> " ++ name ++ " " ++ show xs
        print . (`f` testDFARunner) $ acceptWord xs
```

実行

```.bsh
$ ./RegExpr/main
>>> runDFA  "010010"
(True,0)
>>> evalDFA "010010"
True
>>> execDFA "010010"
0
```

## 入力いくつか変えて動かす

mainの差し替え

```RegExpr/main.hs
main :: IO ()
main = do
  -- | testDFARunner の挙動
  printAccept "010010"
  printAccept "10111"
  printAccept "111"
  printAccept "0010"
    where
      printAccept xs = do
        putStrLn $ ">>> accept " ++ show xs
        print . (`evalDFA` testDFARunner) $ acceptWord xs
```

実行結果

```.bsh
$ ./RegExpr/main
>>> accept "010010"
True
>>> accept "10111"
True
>>> accept "111"
False
>>> accept "0010"
Flase
```

# 感想

大したことやってないけど、実際使ってみるとモナドすごい。
あと do 記法強い。