Norvig.orgをみると、コードのライツが定義してあって、条件さえまもれば改変公開が可能なようだ。なので、コードも載せちゃう。
;;;; お断り：日本語を含むコメントはakaがつけたものです。debugとundebugの名前をそれぞれmy-debugとmy-undebugに改変しました。
;;; GPS Version 2
(defvar *ops* nil "A list of available operators.")
;; Version 1 からそのまま
;; メモ：
;; 問題領域で使用できるoperatorのリスト。例は次のとおり。
;;(#S(OP :ACTION ASK-PHONE-NUMBER
;; :PRECONDS (IN-COMMUNICATION-WITH-SHOP)
;; :ADD-LIST ((EXECUTING ASK-PHONE-NUMBER) KNOW-PHONE-NUMBER)
;; :DEL-LIST NIL)
;; #S(OP :ACTION DRIVE-SON-TO-SCHOOL
;; :PRECONDS (SON-AT-HOME CAR-WORKS)
;; :ADD-LIST ((EXECUTING DRIVE-SON-TO-SCHOOL) SON-AT-SCHOOL)
;; :DEL-LIST (SON-AT-HOME))
;; #S(OP :ACTION SHOP-INSTALLS-BATTERY
;; :PRECONDS (CAR-NEEDS-BATTERY SHOP-KNOWS-PROBLEM SHOP-HAS-MONEY)
;; :ADD-LIST ((EXECUTING SHOP-INSTALLS-BATTERY) CAR-WORKS)
;; :DEL-LIST NIL)
;; #S(OP :ACTION TELL-SHOP-PROBLEM
;; :PRECONDS (IN-COMMUNICATION-WITH-SHOP)
;; :ADD-LIST ((EXECUTING TELL-SHOP-PROBLEM) SHOP-KNOWS-PROBLEM)
;; :DEL-LIST NIL)
;; #S(OP :ACTION TELEPHONE-SHOP :PRECONDS (KNOW-PHONE-NUMBER) :ADD-LIST ((EXECUTING TELEPHONE-SHOP) IN-COMMUNICATION-WITH-SHOP) :DEL-LIST NIL)
;; #S(OP :ACTION LOOK-UP-NUMBER :PRECONDS (HAVE-PHONE-BOOK) :ADD-LIST ((EXECUTING LOOK-UP-NUMBER) KNOW-PHONE-NUMBER) :DEL-LIST NIL)
;; #S(OP :ACTION GIVE-SHOP-MONEY :PRECONDS (HAVE-MONEY) :ADD-LIST ((EXECUTING GIVE-SHOP-MONEY) SHOP-HAS-MONEY) :DEL-LIST (HAVE-MONEY)))
;; (defvar *state* nil "The current state: a list of conditions.")
;; Version 2では廃止。
;; stateはspecial variableではなくlexical variableとして関数の引数で渡されていく。
(defstruct op "An operation"
(action nil)
(preconds nil)
(add-list nil)
(del-list nil))
;; Version 1 からそのまま
;; ただし、Version 1では単にmake-opしたのがstructure opだったが、
;; Version 2ではconvert-opされたものがstructure opである。
;; 例は
;; #S(OP :ACTION DRIVE-SON-TO-SCHOOL
;; :PRECONDS (SON-AT-HOME CAR-WORKS)
;; :ADD-LIST ((EXECUTING DRIVE-SON-TO-SCHOOL) SON-AT-SCHOOL)
;; :DEL-LIST (SON-AT-HOME))
(defun executing-p (x)
"Is x of the form: (executing ...) ?"
(starts-with x 'executing))
;; Version 2 で新設
(defun starts-with (list x)
"Is this a list whose first element is x?"
(and (consp list) (eql (first list))))
;; Version 2 で新設
(defun convert-op (op)
"Make op conform to the (EXECUTING op) convention."
(unless (some #'executing-p (op-add-list op))
(push (list 'executing (op-action op)) (op-add-list op)))
op)
;; Version 2 で新設
;; convert-op理解のためのメモ
;; someの値はt or nil。(some #'oddp '(1 2)) => T, (some #'oddp '(2 4)) => NIL
;; executing-pのものがひとつもなければ、opに副作用してopを返す。
;; ひとつもなければ、という条件があるので、convert-opを複数回実行しても大丈夫。
;; (op-add-list op)はもともとは、'(KNOW-PHONE-NUMBER)とか。
;; この関数によって、それが'((EXECUTING ASK-PHONE-NUMBER) KNOW-PHONE-NUMBER)となる。
;; #S(OP :ACTION ASK-PHONE-NUMBER
;; :PRECONDS (IN-COMMUNICATION-WITH-SHOP)
;; :ADD-LIST (KNOW-PHONE-NUMBER)
;; :DEL-LIST NIL)
;; #S(OP :ACTION ASK-PHONE-NUMBER
;; :PRECONDS (IN-COMMUNICATION-WITH-SHOP)
;; :ADD-LIST ((EXECUTING ASK-PHONE-NUMBER) KNOW-PHONE-NUMBER)
;; :DEL-LIST NIL)
;; という変換ということ。
(defun op (action &key preconds add-list del-list)
"Make a new operator that obeys the (EXECUTION op) convention."
(convert-op
(make-op :action action :preconds preconds
:add-list add-list :del-list del-list)))
;; Version 2 で新設
;; structure op の生成関数
(defun GPS (state goals &optional (*ops* *ops*))
"General Problem Solover: from state, achieve goals using *ops*."
(remove-if #'atom (achive-all (cons '(start) state) goals nil)))
;; Version 2で変更
;; special variables版。こちらの方が簡明。
;; goal-stack: ここでnilとして開始する。
(defun GPS (state goals &optional (ops *ops*))
"General Problem Solover: from state, achieve goals using *ops*."
(let ((old-ops *ops*))
(setf *ops* ops)
(let ((result (remove-if #'atom
(achive-all (cons '(start) state) goals nil))))
(setf *ops* old-ops)
result)))
;; Version 2で変更
;; special variablesを使わずに同様の効果を自分で作った版。
;; goal-stack: ここでnilとして開始する。
;; '(start)をconsしているのはstateがnilで入った場合の防御。
(defun apply-op (state goal op goal-stack)
"Return a new, transformed state if op is applicable."
(dbg-indent :gps (length goal-stack) "Consider: ~a" (op-action op))
(let ((state2 (achive-all state (op-preconds op)
(cons goal goal-stack)))) ; =1=
(unless (null state2)
;; Return an updated state
(dbg-indent :gps (length goal-stack) "Action: ~a" (op-action op))
(append (remove-if #'(lambda (x)
(member-equal x (op-del-list op)))
state2)
(op-add-list op)))))
;; Version 2で変更
;; state goal goal-stack がgivenな状態で、指定されたopを適用する。
;; このopはこのひとつのgoalを満たす(add-listにふくむ)ものであることをこの関数は想定している。
;; 適用不可能であれば、NILを返し、適用可能であれば適用後のstateを返す。
;; 動作:
;; state2について
;; そのopのprecondsをgoalとして、achive-allしたもの。
;; ここでachive-allはachiveを呼び、achiveはapply-opを呼ぶので再帰になっている。
;; state2がNILならおしまい。
;; NILじゃなければ、そのときgoalをgoal-stackにいれてよい。なので、=1=のconsがある。
;;
;; unless内部について
;; remove-ifでopのdel-listに含まれるconditionsをstate2から削除。
;; 前行のものとopのadd-listに含まれるconditionsをappendしたものが新しいstate。
(defun appropriate-p (goal op)
"An op is appropriate to a goal if it is in its add list."
(member-equal goal (op-add-list op)))
;; Version 2で変更
(defun achive-all (state goals goal-stack)
"Achive each goal, and make sure they still hold at the end."
(let ((current-state state))
(if (and (every #'(lambda (g)
(setf current-state
(achive current-state g goal-stack)))
goals)
(subsetp goals current-state :test #'equal))
current-state)))
;; Version 2 で新設
;; current-stateまたはNILを返す。
;; goal-stack: ここではachiveに渡すだけ。
;; 動作:
;; stateを局所current-stateにする理由がわからない。
;; goalsに含まれるgoalを順番にachiveにかける。achiveが返す
(defun achive (state goal goal-stack)
"A goal is achived if it already holds,
or if there is an appropriate op for it that is applicable."
(dbg-indent :gps (length goal-stack) "Goal:~a" goal)
(cond ((member-equal goal state) state) ; =1=
((member-equal goal goal-stack) nil) ;=2=
(t (some #'(lambda (op) (apply-op state goal op goal-stack)) ; =3=
(find-all goal *ops* :test #'appropriate-p)))))
;; Version 2で変更
;; 動作:
;; =1=: goalがすでにstateにあるなら、何もしなくてよい。stateを返す。
;; =2=: goalがすでにgoal-stackにあるなら、ループしている。NILを返す(終了)。
;; =3=:
;; goalを含むopをfind-allでlistにする。
;; そのlistの要素にlambdaを適用する。
;; このlambdaの中身は、apply-opなので、そのgoalを達成できる場合、新しいstatusを返す。そうでなければnilを返す。
;; someなので、goalを達成できるopがあればT、なければNILをachiveの値として返す。
(defun member-equal (item list)
(member item list :test #'equal))
;; Version 2 で新設
(defun use (oplist)
"Use oplist as the default list of operators."
;; Return something useful, but not too verbose:
;; the number fo operators.
(length (setf *ops* oplist)))
;; Version 2 で新設
;;; Test
;; ops作成
(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))))
;; 既存のデータをVersion 2用に変換
(mapc #'convert-op *school-ops*)
;; 関数opも使ってみる。
(push (op 'ask-phone-number
:preconds '(in-communication-with-shop)
:add-list '(know-phone-number))
*school-ops*)
(use *school-ops*)
*ops*
(gps '(son-at-home car-needs-battery have-money have-phone-book)
'(son-at-school))
;;->
;;((START) (EXECUTING LOOK-UP-NUMBER) (EXECUTING TELEPHONE-SHOP) (EXECUTING TELL-SHOP-PROBLEM) (EXECUTING GIVE-SHOP-MONEY)
;; (EXECUTING SHOP-INSTALLS-BATTERY) (EXECUTING DRIVE-SON-TO-SCHOOL))
(my-debug :gps)
(gps '(son-at-home car-needs-battery have-money have-phone-book)
'(son-at-school))
;;->
;;Goal:SON-AT-SCHOOL
;;Consider: DRIVE-SON-TO-SCHOOL
;; Goal:SON-AT-HOME
;; Goal:CAR-WORKS
;; Consider: SHOP-INSTALLS-BATTERY
;; Goal:CAR-NEEDS-BATTERY
;; Goal:SHOP-KNOWS-PROBLEM
;; Consider: TELL-SHOP-PROBLEM
;; Goal:IN-COMMUNICATION-WITH-SHOP
;; Consider: TELEPHONE-SHOP
;; Goal:KNOW-PHONE-NUMBER
;; Consider: ASK-PHONE-NUMBER
;; Goal:IN-COMMUNICATION-WITH-SHOP
;; Consider: LOOK-UP-NUMBER
;; Goal:HAVE-PHONE-BOOK
;; Action: LOOK-UP-NUMBER
;; Action: TELEPHONE-SHOP
;; Action: TELL-SHOP-PROBLEM
;; Goal:SHOP-HAS-MONEY
;; Consider: GIVE-SHOP-MONEY
;; Goal:HAVE-MONEY
;; Action: GIVE-SHOP-MONEY
;; Action: SHOP-INSTALLS-BATTERY
;;Action: DRIVE-SON-TO-SCHOOL
;;((START) (EXECUTING LOOK-UP-NUMBER) (EXECUTING TELEPHONE-SHOP) (EXECUTING TELL-SHOP-PROBLEM) (EXECUTING GIVE-SHOP-MONEY)
;; (EXECUTING SHOP-INSTALLS-BATTERY) (EXECUTING DRIVE-SON-TO-SCHOOL))
(my-undebug)
(gps '(son-at-home car-needs-battery have-money have-phone-book)
'(have-money son-at-school))
;;-> NIL
(gps '(son-at-home car-needs-battery have-money have-phone-book)
'(son-at-school have-money))
;; -> NIL
(gps '(son-at-home car-needs-battery have-money)
'(son-at-school))
;; -> NIL
(gps '(son-at-home) '(son-at-home))
;; -> ((START))
うーむ。まだもやもやしているな。とりあえずこの後の展開はGPSをいろいろな問題に適用していくようなので、もやもやを抱えたまま進んでみる。
こつこつ。
0 件のコメント:
コメントを投稿