[CLisp]有限狀態機練習
《Common Lisp: An Introduction to Symbolic Computing》第14.11節的Keyboard Exercise。個人答案。
首先,設計好簡單的狀態機,主要有節點(node)和聯繫(arc)。
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 簡單有限狀態機(Finite State Machines, FSMs) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 全局變量 (defvar *nodes*) ; 儲存節點用 (defvar *arcs*) ; 儲存關聯用 (defvar *current-node*) ; 當前的節點 ;; 初始化函數 (defun initialize () (setf *nodes* nil *arcs* nil *current-node* nil)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 節點 ;; 節點結構 (defstruct (node (:print-function print-node)) name inputs outputs) (defun print-node (node stream depth) (format stream "#<Node ~A>" (node-name node))) ;; 節點建立宏 (defmacro defnode (name) `(add-node ',name)) (defun add-node (name) (let ((new-node (make-node :name name))) (setf *nodes* (nconc *nodes* (list new-node))) new-node)) ;; 節點查找函數 (defun find-node (name) (or (find name *nodes* :key #'node-name) (error "No node named ~A exists." name))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 聯繫 ;; 聯繫結構 (defstruct (arc (:print-function print-arc)) from to label action) (defun print-arc (arc stream depth) (format stream "#<ARC ~A / ~A / ~A>" (node-name (arc-from arc)) (arc-label arc) (node-name (arc-to arc)))) ;; 聯繫建立宏 (defmacro defarc (from label to &optional action) `(add-arc ',from ',label ',to ',action)) (defun add-arc (from-name label to-name action) (let* ((from (find-node from-name)) (to (find-node to-name)) (new-arc (make-arc :from from :label label :to to :action action))) (setf *arcs* (nconc *arcs* (list new-arc))) (setf (node-outputs from) (nconc (node-outputs from) (list new-arc))) (setf (node-inputs to) (nconc (node-inputs to) (list new-arc))) new-arc)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 主要函數 ;; 狀態機運行函數 (defun fsm (&optional (starting-point 'start)) (setf *current-node* (find-node starting-point)) (do nil ((null (node-outputs *current-node*)) nil) (one-transition))) (defun one-transition () (format t "~&State ~A. Input: " (node-name *current-node*)) (let* ((ans (read)) (arc (find ans (node-outputs *current-node*) :key #'arc-label))) (unless arc (format t "~&No arc from ~A has label ~A.~%" (node-name *current-node*) ans) (return-from one-transition nil)) (let ((new (arc-to arc))) (format t "~&~A" (arc-action arc)) (setf *current-node* new)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; FSMs之——自動售賣機 ;; 此機出售15美分的口香糖和20美分的薄荷糖 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 初始化 (initialize) ;; 建立節點 (defnode start) (defnode have-5) (defnode have-10) (defnode have-15) (defnode have-20) (defnode end) ;; 建立聯繫 (defarc start nickel have-5 "Clunk!") (defarc start dime have-10 "Clink!") (defarc start coin-return start "Nothing to return.") (defarc have-5 nickel have-10 "Clunk!") (defarc have-5 dime have-15 "Clink!") (defarc have-5 coin-return start "Returned five cents.") (defarc have-10 nickel have-15 "Clunk!") (defarc have-10 dime have-20 "Clink!") (defarc have-10 coin-return start "Returned ten cents.") (defarc have-15 nickel have-20 "Clunk!") (defarc have-15 dime have-20 "Nickel change.") (defarc have-15 gum-button end "Deliver gum.") (defarc have-15 coin-return start "Returned fifteen cents.") (defarc have-20 nickel have-20 "Nickel returned.") (defarc have-20 dime have-20 "Dime returned.") (defarc have-20 gum-button end "Deliver gum, nickel change.") (defarc have-20 mint-button end "Deliver mints.") (defarc have-20 coin-return start "Returned twenty cents.") ;; 然後開始測試吧! (fsm) ; 接著可輸入nickel、dime、coin-return、gum-button、mint-button
節點函數化
現在,為了提升狀態機的速度(若狀態機複雜化),要避免用find-node
搜索所有節點。直接將節點變為函數,利用cond
直接跳轉到對應節點函數。
例如,將start
節點變成:
(defun start (input-syms &aux (this-input (first input-syms)))
(cond ((null input-syms) 'start)
((equal this-input 'nickel)
(format t "~&~A" "Clunk!")
(have-5 (rest input-syms)))
((equal this-input 'dime)
(format t "~&~A" "Clink!")
(have-10 (rest input-syms)))
((equal this-input 'coin-return)
(format t "~&~A" "Nothing to return.")
(start (rest input-syms)))
(t (error "No arc from ~A with label ~A." 'start this-input))))
;; 聯繫->函數 (defun compile-arc (arc) `((equal this-input ',(arc-label arc)) (format t "~&~A" ,(arc-action arc)) (,(node-name (arc-to arc)) (rest input-syms)))) ;; 節點->函數 (defun compile-node (node) `(cond ((null input-syms) ',(node-name node)) ,@(mapcar #'compile-arc (node-outputs node)) (t (error "No arc from ~A with label ~A." ',(node-name node) this-input)))) ;; 所有節點->函數 (defmacro compile-machine () `(progn ,@(mapcar #'(lambda (node) `(defun ,(node-name node) (input-syms &aux (this-input (first input-syms))) ,(compile-node node))) *nodes*) 'done)) ;; 對比了一下書中的答案,發現自己真的嫩得可以啊 @_@ ;; OK,現在試試以下面的表達式開始測試 (compile-machine) (start '(nickel nickel dime dime gum-button))
太神奇了……執行完(Compile-Machine)
的那一刻,很興奮>_<
假如再這樣有限狀態機就更快了:
;; 真正的Compilation (mapcar #'(lambda (node) (compile (node-name node))) *nodes*)
本網站無註明「轉載」的著作均由Jak Wings製作 CC BY-NC-SA 2.5
Creative Commons 保持署名-相同方式分享 2.5
Aug 21, 2022 02:22:30 PM
Rajasthan Board Model Paper 2023 Class 3 Pdf Download with Answers for Rajasthani Medium, English Medium, Hindi Medium, Urdu Medium & Students for Small Answers, Long Answer, Very Long Answer Questions, and Essay Type Questions to Term1 & Term2 Exams at official website. Rajasthan Board Question Paper Class 3 New Exam Scheme or Question Pattern for Sammittive Assignment Exams (SA1 & SA2): Very Long Answer (VLA), Long Answer (LA), Small Answer (SA), Very Small Answer (VSA), Single Answer, Multiple Choice and etc.
Jan 13, 2023 10:36:22 PM
A finite state machine, or FSA for short, is a mathematical model for representing the behavior of a system. In particular, it can be used to represent the behavior of a system that can be in one of a finite number of states, and that can transition from one state to another in a well-defined way. There are find your dream home Norwalk a number of ways to design and build a finite state machine. One common approach is to use a state transition table, which lists all of the possible states that the system can be in, and all of the possible transitions between those states.