Common Lisp常用輔助工具


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

《Common Lisp: An Introduction to Symbolic Computing》第14.11節的Keyboard Exercise。個人答案。


;;; 簡單有限狀態機(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))

(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)))

;; 節點查找函數
(defun find-node (name)
  (or (find name *nodes* :key #'node-name)
      (error "No node named ~A exists." name)))

;; 聯繫

;; 聯繫結構
(defstruct (arc (:print-function print-arc))

(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)))

;; 主要函數

;; 狀態機運行函數
(defun fsm (&optional (starting-point 'start))
  (setf *current-node* (find-node starting-point))
  (do nil
      ((null (node-outputs *current-node*)) nil)

(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美分的薄荷糖

;; 初始化

;; 建立節點
(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




(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 ()
     ,@(mapcar #'(lambda (node)
                   `(defun ,(node-name node) (input-syms &aux
                                                          (first input-syms))) 
                      ,(compile-node node)))

;; 對比了一下書中的答案,發現自己真的嫩得可以啊 @_@

;; OK,現在試試以下面的表達式開始測試
(start '(nickel nickel dime dime gum-button))



;; 真正的Compilation
(mapcar #'(lambda (node)
            (compile (node-name node)))

本網站無註明「轉載」的著作均由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.

登录 *

loading captcha image...
or Ctrl+Enter