trifle

技術メモ

Haskellでも非決定性有限オートマトンがしたい!

理学部オートマトン学科に在籍しているので, オートマトンについて勉強させられています.

f:id:HelloRusk:20181013201125p:plain:w400

これは決定性有限オートマトンという良いオートマトンです. 各状態と各文字に対して, 状態遷移がちょうど1つだけ定められています. 形もかっこいいですね.

f:id:HelloRusk:20181013201445p:plain:w400

これは非決定性有限オートマトンというダメなオートマトンです. 各状態と各文字に対して, 状態遷移が2通り以上あったり, そもそもなかったりします. 形もキモいですね.
ただ, こっちの方が作るのは面白そうだったので, 作ってみます.

data Jyotai = Q0 | Q1 | Q2 | Q3 deriving(Show)

状態を定義します.

final :: Jyotai -> Bool
final Q3 = True
final _  = False

受理状態を定義します.

tr :: Char -> Jyotai -> [Jyotai]
tr '0' Q0 = [Q0, Q1]
tr '0' Q1 = [Q1]
tr '0' Q2 = [Q2, Q3]
tr '0' Q3 = []
tr '1' Q0 = [Q0, Q2]
tr '1' Q1 = [Q1, Q3]
tr '1' Q2 = [Q2]
tr '1' Q3 = []

遷移を定義します.

automaton :: String -> State [Jyotai] Bool
automaton (x:xs) = do
    modify $ concatMap (tr x)
    automaton xs

automaton [] = do
    jyotaiList <- get
    return $ or $ fmap final jyotaiList

これがオートマトンです. 何をやっているか分かりにくいので説明しましょう.
1段目では, Stateモナドで1文字ずつ読み取りながら状態を変化させています. modify というのが(修正という意の通り)Stateモナドから状態を受け取り新しく状態を返す関数です.
例えば,  x = 1 であるとして, 受け取った状態が  [Q_0, Q_2] なら, tr x の部分で,  [[Q_0, Q_2], Q_2] になり, concatMap で内側のネストが外れます. (厳密には concatMapconcatmap を兼ね備えているのでこの説明は正しくない)
2段目では, final 関数を状態の各要素にあてて, 一つでも受理状態が含まれていれば True になります. なぜなら or 関数が論理和になっているからです.

というわけで,

NondeterministicFiniteAutomation.hs

module Main(main) where

import Control.Monad.State

data Jyotai = Q0 | Q1 | Q2 | Q3 deriving(Show)

final :: Jyotai -> Bool
final Q3 = True
final _  = False

tr :: Char -> Jyotai -> [Jyotai]
tr '0' Q1 = [Q1]
tr '0' Q0 = [Q0, Q1]
tr '0' Q2 = [Q2, Q3]
tr '0' Q3 = []
tr '1' Q0 = [Q0, Q2]
tr '1' Q1 = [Q1, Q3]
tr '1' Q2 = [Q2]
tr '1' Q3 = []

automaton :: String -> State [Jyotai] Bool
automaton (x:xs) = do
    modify $ concatMap (tr x)
    automaton xs

automaton [] = do
    jyotaiList <- get
    return $ or $ fmap final jyotaiList

main :: IO ()
main = do
    alphabet <- getLine
    print $ execState (automaton alphabet) [Q0]
    case evalState (automaton alphabet) [Q0] of
        True  -> putStrLn("OK")
        False -> putStrLn("NG")

標準入力に対して受理されるか否かを判定するオートマトンです. ありうる受理計算を全探索します.

$ stack runghc NondeterministicFiniteAutomation.hs
1001
[Q0,Q2,Q1,Q3,Q1,Q3,Q2]
OK

 Q_3が2つ含まれていることからわかるように, 1001の受理計算が2通りあります.

0000
[Q0,Q1,Q1,Q1,Q1]
NG
1111
[Q0,Q2,Q2,Q2,Q2]
NG

0000 や 1111 は受理されません.

このようにして完成しましたが, 受理されるか否かを判定するだけなら状態が重複するのは無駄ですね. そもそも, 非決定性有限オートマトンで起こりうる状態を集めた集合を新たに状態として定義してオートマトンを作れば, それは決定性になるので, 決定性有限オートマトンに受理されることと非決定性有限オートマトンに受理されることは同値なのです.

まあそんなことはどうでもよく, 修正します.

data Jyotai = Q0 | Q1 | Q2 | Q3 deriving(Show, Eq)

Eq 型クラスを引っ張ってきて,

chofuku_kesu :: [Jyotai] -> [Jyotai]
chofuku_kesu [] = []
chofuku_kesu (x:xs) = 
    case x `elem` xs of 
        True  -> chofuku_kesu xs
        False -> [x] ++ (chofuku_kesu xs)

こうすれば重複が消えていいんじゃないんでしょうか. ためしに時間計測することを考えました.

module Main(main) where

import Control.Monad.State
import System.Random

data Jyotai = Q0 | Q1 | Q2 | Q3 deriving(Show, Eq)

final :: Jyotai -> Bool
final Q3 = True
final _  = False

tr :: Char -> Jyotai -> [Jyotai]
tr '0' Q0 = [Q0, Q1]
tr '0' Q1 = [Q1]
tr '0' Q2 = [Q2, Q3]
tr '0' Q3 = []
tr '1' Q0 = [Q0, Q2]
tr '1' Q1 = [Q1, Q3]
tr '1' Q2 = [Q2]
tr '1' Q3 = []

automaton :: String -> State [Jyotai] Bool
automaton (x:xs) = do
    modify $ concatMap (tr x)
    automaton xs

automaton [] = do
    jyotaiList <- get
    return $ or $ fmap final jyotaiList

automaton2 :: String -> State [Jyotai] Bool
automaton2 (x:xs) = do
    jyotaiList <- get
    put $ chofuku_kesu $ concatMap (tr x) jyotaiList -- 重複を消した
    automaton xs

automaton2 [] = do
    jyotaiList <- get
    return $ or $ fmap final jyotaiList

main :: IO ()
main = do
    let alphabet = fmap chosei $ take 10000 (randomRs (0, 1) (mkStdGen 20181013))
    case evalState (automaton alphabet) [Q0] of -- ここを変えてテスト
        True  -> putStrLn("OK")
        False -> putStrLn("NG")

chosei :: Int -> Char
chosei 0 = '0'
chosei 1 = '1'

chofuku_kesu :: [Jyotai] -> [Jyotai]
chofuku_kesu [] = []
chofuku_kesu (x:xs) = 
    case x `elem` xs of 
        True  -> chofuku_kesu xs
        False -> [x] ++ (chofuku_kesu xs)

一万個の{0, 1}からなる乱数列を発生させて時間を計測します.

重複を消さない場合

OK
real         0.73
user         0.47
sys          0.17

重複を消す場合

OK
real         0.78
user         0.53
sys          0.17

100000個に増やす.

重複を消さない場合

OK
real         0.97
user         0.68
sys          0.18

重複を消す場合

OK
real         1.62
user         1.33
sys          0.20

期待に反して遅くなってしまいました. 毎回重複を消す方が計算コストがかかるということでしょう.