「決定性有限オートマトン」を Haskell で実装してみた

先日、Qiita で 「HaksellのStateモナドとReaderモナドで決定性有限オートマトンの実行」 という記事を見かけて、以前自分も Haskell で 決定性有限オートマトンを書いたことを思い出しました。

見直してみると 、遷移関数に漏れがあるとエラーになってしまうという情けない仕様だったので少し手直しをしてみました。

なお、「決定性有限オートマトン」に関しては 「HaksellのStateモナドとReaderモナドで決定性有限オートマトンの実行」 を参照してください。

実装の方針

• 「現在の状態」は再帰関数の変数として渡す。
• 遷移関数を連想リストで表現し、lookup 関数で探す。
• Maybe モナドを使用することで、遷移関数を見つけられなかった場合でもエラーにならないようにする。

実装

dfa.hs

-----------------------------------------------------------------------
--
-- << DFA ( 決定性有限オートマトン ) >>
--
-- 参考：
--   http://d.hatena.ne.jp/cranebird/20120327/1332857936
--   http://kurt.scitec.kobe-u.ac.jp/~kikyo/lec/07/automaton/k2.pdf
--
-----------------------------------------------------------------------

import Data.Maybe (fromJust)
import Data.List  (foldl')


type State = String                   -- 状態
type Delta = [((State, Char), State)] -- 遷移関数
type F     = [State]                  -- 受理状態の集合


-- isAccept 遷移関数 受理状態の集合 初期状態 文字列  =>  真偽
isAccept :: Delta -> F -> State -> String -> Bool
isAccept ds f q0 cs = (result /= Nothing) && (elem (fromJust result) f)
  where
    result = foldl' g (Just q0) cs
    g st c = st >>= \x -> lookup (x, c) ds

-- makeDfa 遷移関数 受理状態の集合 初期状態  =>  dfa
makeDfa :: Delta -> F -> State -> String -> String
makeDfa ds f q0 cs = if (isAccept ds f q0 cs) then "Accept" else "Not Accept"



-- 例 1
-- Σ = {a}, 奇数個の 'a' からなる文字列を受理する
dfa1 :: String -> String
dfa1 = makeDfa ds f q0
  where
    ds = [(("Even", 'a'), "Odd"), (("Odd", 'a'), "Even")]
    f  = ["Odd"]
    q0 = "Even"


-- 例 2
-- Σ = {a, b}, 奇数個の 'a' からなる文字列を受理する
dfa2 :: String -> String
dfa2 = makeDfa ds f q0
  where
    -- 0 : 偶数個, 1 : 奇数個
    ds = [(("0", 'a'), "1"), (("0", 'b'), "0"),
          (("1", 'a'), "0"), (("1", 'b'), "1")]
    f  = ["1"]
    q0 = "0"


-- 例 3
-- Σ = {a, b}, 奇数個の a と偶数個の b からなる文字列を受理する
-- (0 は偶数とする)
dfa3 :: String -> String
dfa3 = makeDfa ds f q0
  where
    -- 一桁目 : a, 二桁目 : b
    -- 0 : 偶数個, 1 : 奇数個
    ds = [(("00", 'a'), "10"), (("00", 'b'), "01"),
          (("10", 'a'), "00"), (("10", 'b'), "11"),
          (("01", 'a'), "11"), (("01", 'b'), "00"),
          (("11", 'a'), "01"), (("11", 'b'), "10")]
    f  = ["10"]
    q0 = "00"


-- 問 4
-- Σ = {a, b, c}, 奇数個の a と偶数個の b からなる文字列を受理する
-- (0 は偶数とする)
dfa4 :: String -> String
dfa4 = makeDfa ds f q0
  where
    -- 一桁目 : a, 二桁目 : b
    -- 0 : 偶数個, 1 : 奇数個
    ds = [(("00", 'a'), "10"), (("00", 'b'), "01"), (("00", 'c'), "00"),
          (("10", 'a'), "00"), (("10", 'b'), "11"), (("10", 'c'), "10"),
          (("01", 'a'), "11"), (("01", 'b'), "00"), (("01", 'c'), "01"),
          (("11", 'a'), "01"), (("11", 'b'), "10"), (("11", 'c'), "11")]
    f  = ["10"]
    q0 = "00"

λ> dfa1 "a"
"Accept"
λ> dfa1 "aa"
"Not Accept"
λ> dfa1 "aaa"
"Accept"
λ> dfa1 "aaab"
"Not Accept"

Maybe モナドと畳み込みを使うことで、コードがかなりすっきりしたと思います。