Haskell でオートマトン(5)
状態の合成を扱えるよう、定義を少し変更して、正規演算の和集合演算を書いてみた。
リスト内包表記だと直積がエレガント。教科書の定義そのままに書ける。
まだテストしてないけどとりあえず。
data State = State String | State2 (State, State) deriving (Eq, Show) union :: Dfa -> Dfa -> Dfa --union = undefined union m1 m2 = Dfa states alphabet transit start accept where qs1 = statesOf m1 qs2 = statesOf m2 states = [ State2 (r1, r2) | r1 <- qs1, r2 <- qs2 ] alphabet = alphabetOf m1 -- fixme start = State2 (startOf m1, startOf m2) accept = [ State2 (r1, r2) | r1 <- qs1, r2 <- qs2, (elem r1 (acceptOf m1)) || (elem r2 (acceptOf m2))] transit = [ ((State2 (r1, r2), a), State2 ((transitDfa m1 r1 a), (transitDfa m2 r2 a))) | r1 <- qs1, r2 <- qs2, a <- alphabet ]
前に Common Lisp で書いた Union との比較。今なら Common Lisp でももっと簡潔に書けるように気を配るだろうけど。
;; union (defmethod union-fa ((m1 dfa) (m2 dfa)) (loop with dfa = (make-instance 'dfa :states nil :alphabet (union (alphabet-of m1) (alphabet-of m2)) :start (combine-state (start-state-of m1) (start-state-of m2)) :accept nil) for (s1 . s2) in (cartesian-product (states-of m1) (states-of m2)) for s = (combine-state s1 s2) if (or (member s1 (accept-states-of m1) :test #'state=) (member s2 (accept-states-of m2) :test #'state=)) do (push s (accept-states-of dfa)) do (push s (states-of dfa)) (loop for a in (alphabet-of dfa) do (setf (transit dfa s a) (combine-state (transit m1 s1 a) (transit m2 s2 a)))) finally (return (rename dfa))))