Haskell でオートマトン Data.Set 版

状態の集合をほんとうに集合用のデータ構造 Data.Set を使って書いてみた。

module Fa where
import qualified Test.HUnit as Test
import qualified Data.Set as Set

data State = S String | S' (State, State) | S'' (Set.Set State)
             deriving (Eq, Show, Ord)
type States = Set.Set State
type Symbol = Char
type Alphabet = Set.Set Symbol
type Transition = ((State, Symbol), State)
type Transition' = ((State, Symbol), States)

data Dfa = Dfa (States, Alphabet, [Transition], State, States) deriving (Show, Eq)

makeDfa (qs, cs, d, q0, fs) =
    if (checkStart && checkAccept && and (map checkTransit d)) then
        Dfa (Set.fromList qs, Set.fromList cs, d, q0, Set.fromList fs)
    else
        error "Fail to makeDfa: Invalid data."
    where
      checkStart = (elem q0 qs)
      checkAccept = all (\x -> elem x qs) fs
      checkTransit ((s, c), n) = and [elem s qs, elem c cs, elem n qs]

transitDfa alist s0 c = case lookup (s0, c) alist of
                           Just s1 -> s1
                           Nothing -> error "Invalid transition."

accept :: Dfa -> [Symbol] -> Bool
accept (Dfa (qs, cs, d, q0, fs)) str = accept' q0 str
    where
      accept' s [] = Set.member s fs
      accept' s (c:cs) = accept' (transitDfa d s c) cs

union :: Dfa -> Dfa -> Dfa
-- union = undefined
union (Dfa (qs1, cs1, d1, q1, f1)) (Dfa (qs2, cs2, d2, q2, f2)) =
    makeDfa (qs, cs, d, q0, fs)
    where
      qs1' = Set.elems(qs1)
      qs2' = Set.elems(qs2)
      qs = [ S'(r1, r2) | r1 <- qs1', r2 <- qs2' ]
      cs = Set.elems(cs1) -- 両者のアルファベットは等しいと仮定
      q0 = S'(q1, q2)
      fs = [ S'(r1, r2) | r1 <- qs1', r2 <- qs2',
             (Set.member r1 f1) || (Set.member r2 f2)]
      d = [ ((S'(r1, r2), a), S'(transitDfa d1 r1 a, transitDfa d2 r2 a))
                | r1 <- qs1', r2 <- qs2', a <- cs]

集合データ型に対するリスト内包表記、みたいなものは今はないらしく、Data.Set から一度、リストに変えている点が冗長。Data.Set の導入ですごくよくなったか、というと微妙。ただこのあと、サブセット構成法で Nfa から Dfa にするとちょっと Data.Set 利点が出てくる、はず。