an_nfa1.lisp

this code define non-deterministic finite automata using lisp

;;;; simulate a non-deterministic finite automata, aka nfa

;;; example nfa in list form w/input strings
(defparameter *nfa/input*
'(((0 1) ;alphabet
(q0 q1 q2 ) ;states
(q0) ;start states
(q0 q2) ;accept states
((q0 epsilon q0);transition relation table,
(q0 1 q1) ;(state input result)
(q0 epsilon q2) ;where 'epsilon = no input
(q1 0 q0) 
(q1 0 q2)
(q1 1 q2)
))
((epsilon) ;input strings
(1 1)
(1 0)
(1 0 1 0 1 1)
(1 0 1 0 1 0 1 0 1 0)
(0 1 0 1)
))) 
;;; structure to hold a given nfa
(defstruct nfa
alphabet
states
starts
accepts
transition-fn)

;;; build nfa structure from list of nfa fields
;;; should probably do error checking for consistency of nfa
(defun list->nfa (lst)
"takes a list of nfa fields according to spec, returns an nfa
structure"
(let ((transition-hash (make-hash-table :test 'equal)))
(dolist (trans (fifth lst))
(push (third trans)
(gethash (cons (first trans) (second trans)) transition-hash)))
(make-nfa :alphabet (first lst)
:states (second lst)
:starts (third lst)
:accepts (fourth lst)
:transition-fn (lambda (state sym)
(gethash (cons state sym) transition-hash)))))

;;;convenience functions
(defun mappend (fn lst)
(apply #'append (mapcar fn lst)))

(defun set-union (&rest args)
(remove-duplicates (apply #'union args)))

(defun set-intersection (&rest args)
(remove-duplicates (apply #'intersection args)))

;;; follow transitions that don't consume input, avoid loops
(defun eps (start-states transition-fn)
"return set of all states reachable from start-states by 0 or more
epsilon transitions"
(labels ((reach-from (lst)
(mappend (lambda (s) (funcall transition-fn s 'epsilon))
lst)))
(do ((result start-states (set-union result new-states))
(new-states (reach-from start-states) (reach-from new-states)))
((null (set-difference new-states result)) result))))

;;; simulate nfa, breadth-first search, iterative style
(defun simulate-nfa (nfa input)
"return accepting states, if any, reached by nfa on list of symbols
given as input"
(let* ((trans-fn (nfa-transition-fn nfa))
(current-states (eps (nfa-starts nfa) trans-fn)))
(dolist (sym input)
(let ((next-states nil))
(dolist (state current-states)
(setf next-states (set-union next-states
(eps (funcall trans-fn state sym) trans-fn))))
(setf current-states next-states)))
(set-intersection current-states (nfa-accepts nfa))))

;;;same thing, more functional style
(defun simulate-nfa2 (nfa input)
"return accepting states, if any, reached by nfa on list of symbols
given as input"
(let* ((trans-fn (nfa-transition-fn nfa))
(start-states (eps (nfa-starts nfa) trans-fn)))
(set-intersection (nfa-accepts nfa)
(reduce (lambda (states sym)
(eps (mappend (lambda (state)
(funcall trans-fn state sym))
states)
trans-fn))
input
:initial-value start-states))))

(defun test (nfa/input sim-fn)
"test a single nfa/input list using sim-fn"
(let ((nfa (list->nfa (first nfa/input)))
(inputs (second nfa/input)))
(dolist (input inputs)
;(format t "~20A -> ~A~%" input (funcall sim-fn nfa input))
(if (eq (funcall sim-fn nfa input) nil)
(format t "~%~D is Not Accept" input) 
(format t "~%~D is Accept" input)
 ) 
))) 



(test *nfa/input* #'simulate-nfa)