NFA -> DFA (2)

さらに書き換えて、よりDFA,NFA の定義通りにして、よりHaskellらしくできた、つもり。

• 状態 State 型は型変数を取ることにした。これで文字からなる状態も、状態の対からなる状態も、 Data.Set 、つまり集合からなる状態も、同じように扱える。
• 同じく、文字 Symbol 型も型変数を取ることにした。
• 新しい定義では、状態遷移関数は文字通り、関数になった。Dfa と Nfa は、この状態遷移関数の型が違う。Dfa は状態と文字を受け取り状態を返す。Nfa は同じく状態と文字を受け取るが、状態の集合を返す。

-- DFA の状態遷移関数
type Delta a b = State a -> Symbol b -> State a
-- NFA の状態遷移関数
type Delta' a b = State a -> Symbol b -> States a

• Dfa の合成は、同じアルファベットのときしか定義していない。違う場合はどうするのだろう？よく分かっていない。存在しない文字に対する遷移先、というものは定義できない気がするのだが。

• 小さな修正として、可能な限り Data.Set のメソッドを利用した。まだ使えるところもあるかもしれない。

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

-- DFA は5つ組である
-- 状態の集合 Q
-- '文字'の集合 Σ
-- 遷移関数 δ: Q × Σ → Q
-- 開始状態 q0
-- 終了状態の集合 F (Q の部分集合)
data State a = State a deriving (Eq, Show, Ord)
type States a = Set.Set (State a)
data Symbol a = Symbol a deriving (Eq, Show, Ord)
type Alphabet a = Set.Set (Symbol a)

type Delta a b = State a -> Symbol b -> State a
type Delta' a b = State a -> Symbol b -> States a

data Fa q c = Dfa (States q, Alphabet c, Delta q c, State q, States q) |
              Nfa (States q, Alphabet c, Delta' q c, State q, States q)

statesOf (Dfa (qs, cs, d, q0, fs)) = qs
alphabetOf (Dfa (qs, cs, d, q0, fs)) = cs
deltaOf (Dfa (qs, cs, d, q0, fs)) = d
startOf (Dfa (qs, cs, d, q0, fs)) = q0
acceptOf (Dfa (qs, cs, d, q0, fs)) = fs

delta alist = \q c -> case lookup (q, c) alist of
                           Just q' -> q'
                           Nothing -> error ("Invalid transition")

delta' alist = \q c -> case lookup (q, c) alist of
                            Just q' -> q'
                            Nothing -> Set.empty

accept (Dfa (qs, cs, d, q0, fs)) str = accept' q0 str where
    accept' q [] = Set.member q fs
    accept' q (s:ss) = accept' (d q s) ss

accept (Nfa (qs, cs, d, q0, fs)) str = accept'' (Set.singleton q0) str where
    accept'' rs [] = any (\x -> Set.member x fs) (Set.elems rs)
    accept'' rs (s:ss) = accept'' (Set.unions [ d r s | r <- (Set.elems rs) ] ) ss

union (Dfa (qs1, cs1, d1, q1, f1)) (Dfa (qs2, cs2, d2, q2, f2))
    | (cs1 == cs2) = Dfa (qs, cs, d, q0, fs) where
    qs1' = Set.elems qs1
    qs2' = Set.elems qs2
    qs = Set.fromList [ State (r1, r2) | r1 <- qs1', r2 <- qs2' ]
    cs = cs1 -- same alphabet
    q0 = State (q1, q2)
    fs = Set.fromList [ State (r1, r2) | r1 <- qs1', r2 <- qs2',
                        (Set.member r1 f1) || (Set.member r2 f2)]
    d = delta [ ((State (r1, r2), a), State (d1 r1 a, d2 r2 a))
                    | r1 <- qs1', r2 <- qs2', a <- Set.elems cs]

powerSet [] = [[]]
powerSet (x:xs) = yss ++ map (x:) yss
    where yss = powerSet xs

subset qs = Set.fromList (map (\x -> State (Set.fromList x))
                                  (powerSet (Set.elems qs)))

nfaToDfa (Nfa (qs, cs, d, q0, fs)) = Dfa (qs', cs', d', q0', fs') where
    expand (State s) = Set.elems s
    isAccept s = any (\x -> Set.member x fs) (expand s)
    qs' = subset qs
    cs' = cs
    unionState ss = State (Set.unions ss)
    d' = delta [ ((r, c), unionState [d r' c | r' <- expand r ]) | 
                 r <- Set.elems qs', c <- Set.elems cs]
    q0' = State (Set.singleton q0)
    fs' = Set.filter isAccept qs'

dfaToNfa (Dfa (qs, cs, d, q0, fs)) = Nfa (qs', cs', d', q0', fs') where
    qs' = qs
    cs' = cs
    d' = delta' [ ((r, c), Set.singleton (d r c)) | 
                  r <- Set.elems qs', c <- Set.elems cs ]
    q0' = q0
    fs' = fs

-- accept odd number of a
dfa1 = Dfa (Set.fromList [State "q0", State "q1"], -- states
            Set.fromList (map Symbol "ab"), -- alphabet
            delta [ ((State "q0", Symbol 'a'), State "q1"),
                    ((State "q0", Symbol 'b'), State "q0"),
                    ((State "q1", Symbol 'a'), State "q0"),
                    ((State "q1", Symbol 'b'), State "q1") ], -- transition function
            State "q0", -- start state
            Set.singleton (State "q1")) -- accept states