Common Lisp常用輔助工具


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

《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.

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