実用CommonLisp GPS バージョン１ 写経

; SLIME 2005-12-27
CL-USER> (defvar *state* nil "The current state: a list of conditions.")
*STATE*
CL-USER> (defvar *ops* nil "A list of available operators.")
*OPS*
CL-USER> (defstruct op "An operation"
    (action nil) (preconds nil) (add-list nil) (del-list nil))
OP
CL-USER> (defun GPS (*state* goals *ops*)
   "General Problem Solver: achieve all goals using *ops*."
   (if (every #'achieve goals) 'solved))
GPS
CL-USER> (defun achieve (goal)
   "A goal is achieved if it already holds,
            or if there is an appropriate op for it that is applicable."
   (or (member goal *state*)
       (some #'apply-op (find-all goal *ops* :test #'appropriate-p))))
ACHIEVE
CL-USER> (defun appropriate-p (goal op)
   "An op is appropriate to a goal if it ias in its add list."
   (member goal (op-add-list op)))
APPROPRIATE-P
CL-USER> (defun apply-op (op)
   "Print a message and update *state* if op is applicable."
   (when (every #'achieve (op-preconds op))
     (print (list 'executing (op-action op)))
     (setf *state* (set-difference *state* (op-del-list op)))
     (setf *state* (union *state* (op-add-list op)))
     t))
APPLY-OP
CL-USER> (defun find-all (item sequence &rest keyword-args &key (test
#'eql) test-not &allow-other-keys)
   (if test-not
       (apply #'remove item sequence :test-not (complement test-not)
keyword-args)
       (apply #'remove item sequence :test     (complement test    )
keyword-args)))
FIND-ALL
CL-USER>
; No value
CL-USER> (defparameter *school-ops*
   (list
    (make-op
     :action 'drive-son-to-school
     :preconds '(son-at-home car-works)
     :add-list '(son-at-school)
     :del-list '(son-at-home))
    (make-op
     :action 'shop-installs-battery
     :preconds '(car-needs-battery shop-knows-problem shop-has-money)
     :add-list '(car-works)
     )
    (make-op
     :action 'tell-shop-problem
     :preconds '(in-communication-with-shop)
     :add-list '(shop-knows-problem))
    (make-op
     :action 'telephone-shop
     :preconds '(know-phone-number)
     :add-list '(in-communication-with-shop))
    (make-op
     :action 'look-up-number
     :preconds '(have-phone-book)
     :add-list '(know-phone-number))
    (make-op
     :action 'give-shop-money
     :preconds '(have-money)
     :add-list '(shop-has-money)
     :del-list '(have-money))))
*SCHOOL-OPS*
CL-USER>
; No value
CL-USER> (gps '(son-at-home car-works) '(son-at-school) *school-ops*)

(EXECUTING DRIVE-SON-TO-SCHOOL)
SOLVED
CL-USER> (gps '(son-at-home car-nedds-battery have-money) '(son-at-school)
*school-ops*)
SOLVED
CL-USER> (gps '(son-at-home car-nedds-battery have-money have-phone-book)
'(son-at-school) *school-ops*)
NIL
CL-USER> (gps '(son-at-home car-needs-battery have-money have-phone-book)
'(son-at-school) *school-ops*)
NIL
CL-USER> (gps '(son-at-home car-needs-battery have-money have-phone-book)
'(son-at-school) *school-ops*)

(EXECUTING LOOK-UP-NUMBER)
(EXECUTING TELEPHONE-SHOP)
(EXECUTING TELL-SHOP-PROBLEM)
(EXECUTING GIVE-SHOP-MONEY)
(EXECUTING SHOP-INSTALLS-BATTERY)
(EXECUTING DRIVE-SON-TO-SCHOOL)

SOLVED
CL-USER>

状態Ａから状態Ｂに変化させるために、各オペレーションの
前提条件をクリアして行く。