2010年3月7日日曜日

CommonLispで非決定性有限オートマトン

DFAの次は当然NFA。

NFAは現在取りうる状態の集合から、入力により次の状態の集合へと遷移する操作を繰り返し、最終的な状態の集合に受理状態が含まれていれば受理、そうでなければ拒否となると考えれば良いと思われる。これは、すべての遷移を並行処理しているようなイメージだろう。

'次の状態'には、イプシロン遷移で辿れるすべての状態を含む。

CommonLispでリストを集合として扱う関数にunion(nunion),set-difference(nset-difference) ,intersection(nintersection)などがある。

果たして正しく動いているのかどうか。

;;; Nondeterministic Finit Automaton

;;イプシロン遷移を表す特殊な入力記号として利用する
(defparameter *epsilon* '@)

(defclass NFA ()
((terminals :accessor terminals :initarg :terminals)
(move-functions :accessor move-functions :initarg :move-functions)
(entry-state :accessor entry-state :initarg :entry-state)
(all-states :accessor all-states :initarg :all-states)
(current-states :accessor current-states :initarg :current-states)))

;;;すべての状態を抜き出す
;;;結局使わないけれど。
(defun get-all-states (entry terminals rules)
(let ((states (copy-list (cons entry terminals))))
(loop :for rule in rules
:do
(pushnew (car rule) states)
(dolist (mv-rule (cdr rule))
(dolist (s (cdr mv-rule))
(pushnew s states))))
states))

(defmacro define-nfa (name (entry (&rest terminals)) &body rules)
`(defclass ,name (NFA)
((terminals :reader terminals :initform ',terminals)
(move-functions :reader move-functinos :initform ',rules)
(entry-state :reader entry-state :initform ',entry)
(all-states :reader all-states :initform (get-all-states ',entry ',terminals ',rules))
(current-states :accessor current-states
:initform (adjoin ',entry (move-epsilon ',entry ',rules nil))))))

;;;nfaが受理状態かどうか
(defun accept? (nfa)
(let ((terminals (terminals nfa)))
(loop :for s in (current-states nfa)
:when (find s terminals)
:do (return-from accept? t))
nil))

;;この時点ではイプシロン遷移しない。現在の状態に移ったときに完了しているはず。
(defun move (nfa input)
(let ((states (current-states nfa))
(result nil))
(let ((acc nil))
(dolist (s states)
(unless (eq s *epsilon*)
(push (move-inner s input (move-functions nfa)) acc)))
(dolist (next-states acc)
(dolist (s next-states)
(pushnew s result))))
(setf (current-states nfa) result)))

(defun move-inner (state input rules)
(let ((rule (assoc state rules)))
(let ((r (assoc input (cdr rule))))
(when r
(let ((result (cdr r)))
(reduce #'union
(mapcar
#'(lambda (s)
(move-epsilon s rules result))
result)
:initial-value result))))))

;;イプシロン遷移
;;tracked-statesは今までに現れた'次の状態'の集合
;;ループしたときに終了させる手段として保持
(defun move-epsilon (state rules tracked-states)
(let ((rule (assoc state rules)))
(let ((r (assoc *epsilon* (cdr rule))))
(when r
(let ((result (cdr r)))
(let ((next-tracked-states (union result tracked-states)))
(reduce #'union
(mapcar
#'(lambda (s)
(if (find s tracked-states)
nil
(move-epsilon s rules next-tracked-states)))
result)
:initial-value result)))))))

(defmethod run ((obj nfa) symbols)
(dolist (s symbols)
(setf (current-states obj)
(move obj s)))
(accept? obj))

(defmethod run ((obj symbol) symbols)
(let ((nfa (make-instance obj)))
(run nfa symbols)))

;;; テスト
(define-nfa test-nfa (:0 (:q :r))
(:0
(@ :q :r))
(:q
(0 :q)
(@ :a))
(:a
(0 :q))
(:r
(1 :r)))

;;"a(a|b)*bb"を受理する
(define-nfa test-nfa-2 (:i (:f))
(:i
(#\a :1))
(:1
(@ :2 :4))
(:2
(#\a :3)
(#\b :3))
(:3
(@ :2 :4))
(:4
(#\b :5))
(:5
(#\b :f)))

;;(trace move)
;;(run 'test-nfa '(0 1))
;;(run 'test-nfa '(1 1))
;;(run 'test-nfa-2 (coerce "aababb" 'list))

綺麗に書けたと納得のいくソースコードが書けるようになるのはいつの日のことか。

0 件のコメント:

コメントを投稿