Haskell でオートマトン(3)

さらに考え直して、Transition を無くしてみた。あんまり美しくない気がするが、ほぼ DFA の定義通りだ。

module Fa where
import System.Environment

data State = State String deriving (Eq, Show)
type Symbol = Char
type Alphabet = [Symbol]

-- Dfa states alphabet transition-function "start state" "accept states"
data Dfa = Dfa [State] Alphabet [(State, Symbol, [State])] State [State] deriving (Show, Eq)

transit' (s0, a0, ss) s a | (s0 == s) && (a0 == a) = ss
                          | otherwise = []
single x = (length x) == 1

transit (Dfa states alphabet delta start accepts) s a = next
    where nexts = concat [ transit' x s a | x <- delta ]
          next = if (single nexts) then head nexts
                 else (error "Invalid transition")

accept :: Dfa -> [Symbol] -> Bool
accept (Dfa states alphabet delta start accepts) str =
    accept' (Dfa states alphabet delta start accepts) start str
    where accept' dfa s (c:cs) = accept' dfa (transit dfa s c) cs
          accept' dfa s [] = elem s accepts

-- accept odd number of 'a' s
dfa1 = Dfa [State "q0", State "q1"] -- states
       "ab" -- alphabet
       [ (State "q0", 'a', [State "q1"]),
         (State "q0", 'b', [State "q0"]),
         (State "q1", 'a', [State "q0"]),
         (State "q1", 'b', [State "q1"])] -- transition function
       (State "q0") -- start state
       [State "q1"] -- accept states

-- 計算理論の基礎 オートマトンと言語より。
dfaM4 = Dfa [State "s", State "q1", State "q2", State "r1", State "r2"]
        "ab"
        [ (State "s", 'a', [State "q1"]),
          (State "s", 'b', [State "r1"]),
          (State "q1", 'a', [State "q1"]),
          (State "q1", 'b', [State "q2"]),
          (State "q2", 'a', [State "q1"]),
          (State "q2", 'b', [State "q2"]),
          (State "r1", 'a', [State "r2"]),
          (State "r1", 'b', [State "r1"]),
          (State "r2", 'a', [State "r2"]),
          (State "r2", 'b', [State "r1"]) ]
        (State "s")
        [State "q1", State "r1"]