Common Lisp常用輔助工具
λ在Chito的第二個CSS設置[原主題:SimpleModern]

[CLisp]有限狀態機練習

λ posted @ 2011年12月14日 14:38 in Mixture with tags exercise lisp , 4280 阅读

《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

Rajasthan Board Ques 说:
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.

Emma 说:
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.

SCERT Assam 1st Cla 说:
Aug 11, 2023 06:39:39 PM

SCERT Assam Board Follows NCERT Curriculum These Textbooks are Updated as per the Syllabus Prescribed by Assam Board. Students of 1st Class Should follow Prescribed Textbooks while Preparing for Exam. Our Team Refer to the Respective Subject Textbook while Preparing the Final Important questions. Students Best Practice Study Materiel about Textbooks are the Fact that they are so SCERT Assam 1st Class Book 2024 Comprehensible that it does not require the aid of a Subject Literate.SCERT Assam has Developed the new Textbooks at the Elementary Standard in Prepare by Senior experts. Assam Board once Publishes the Assam 1st Standard Textbooks 2024


登录 *


loading captcha image...
(输入验证码)
or Ctrl+Enter