Before we come to the implementation of the program, it helps to get a good debugging tool, so that we can
see what it is doing:
(def ^:dynamic *dbg-ids*)
(defn debug
([id str] (debug id 0 str))
([id indent str]
(when (contains? *dbg-ids* id)
(do (dotimes [i indent]
(print " "))
(println str)))))
=> #'PAIP2clojure.Chapter4/debug
Here is the common-lisp code. It first transforms all the ops to a new form, which has an '(Executing action)
in its add list.
(defun executing-p (x)
"Is x of the form: (executing ...) ?"
(starts-with x 'executing))
(defun starts-with (list x)
"Is this a list whose first element is x?"
(and (consp list) (eql (first list) x)))
(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)
(defun op (action &key preconds add-list del-list)
"Make a new operator that obeys the (EXECUTING op) convention."
(convert-op
(make-op :action action :preconds preconds
:add-list add-list :del-list del-list)))
;;; ==============================
(mapc #'convert-op *school-ops*)
The new version of GPS will return the new state instead of printing the actions and removes all non-atoms from
the state so that only (Executing action) forms are left
(defvar *ops* nil "A list of available operators.")
(defstruct op "An operation"
(action nil) (preconds nil) (add-list nil) (del-list nil))
(defun GPS (state goals &optional (*ops* *ops*))
"General Problem Solver: from state, achieve goals using *ops*."
(remove-if #'atom (achieve-all (cons '(start) state) goals nil)))
(defun achieve-all (state goals goal-stack)
"Achieve each goal, and make sure they still hold at the end."
(let ((current-state state))
(if (and (every #'(lambda (g)
(setf current-state
(achieve current-state g goal-stack)))
goals)
(subsetp goals current-state :test #'equal))
current-state)))
(defun achieve (state goal goal-stack)
"A goal is achieved 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)
((member-equal goal goal-stack) nil)
(t (some #'(lambda (op) (apply-op state goal op goal-stack))
(find-all goal *ops* :test #'appropriate-p)))))
(defun member-equal (item list)
(member item list :test #'equal))
(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 (achieve-all state (op-preconds op)
(cons goal goal-stack))))
(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)))))
(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)))
The function achieve-all abstracts away the (every #'achieve …) from the first version and checks whether
the resulting state is still a subset of the goal-state. Also, it updates the current state for each application
of achieve (destructively modifying..)
Also note, that in apply-op append and remove-if are used. They are needed because in this version, the order
of the conditions in the current state counts (because they contain (Executing action) elements.
Again, I will not follow the implementation given in PAIP. Especially I want to avoid the side-effects in
achieve-all and the mixing of actual conditions and (Executing action) forms, which would prevent to represent
states with sets. It turned out, that I needed only three small changes from the first version of the program:
- The state is now divided in the current-state and a list-of-actions taken so far. Thanks to clojure's destructuring,
it is easy to take the state apart again.
- there is a goal-stack which contains all goals tried so far. achieve gives up if it encounters a goal that is
in the goal-stack to avoid stack-overflow-errors.
- every-time an action is executed, it is appendet to the list-of-actions.
(use 'clojure.set)
(use 'auto-declare.core)
(with-auto-declare _
(defn GPS [state goals]
(let [[new-state list-of-actions] (_every-accum? (partial achieve []) [state []] goals)]
(if (nil? new-state)
nil
list-of-actions)))
(defn achieve
"return the new-state after the goal is achieved or nil
if it could not be archieved"
[goal-stack [current-state list-of-actions] goal]
(debug :gps (count goal-stack) (str "Goal " goal))
(cond (contains? current-state goal) [current-state list-of-actions]
(contains? goal-stack goal) [nil list-of-actions]
:else (some (partial _apply-op goal-stack goal [current-state list-of-actions])
(filter #(_appropriate? goal %) *ops*))))
(defn appropriate? [goal op]
(contains? (:add-list op) goal))
(defn every-accum? [func start coll]
(reduce #(if (nil? %1)
nil
(func %1 %2)) start coll))
(defn apply-op [goal-stack goal state op]
(debug :gps (count goal-stack) (str "Consider: " (:action op)))
(let [[new-current-state new-list-of-actions](every-accum? (partial achieve (conj goal-stack goal))
state (:preconds op))]
(if (nil? new-current-state)
[nil new-list-of-actions]
(do (debug :gps (count goal-stack) (str "Action " (:action op)))
[(-> new-current-state (difference (:del-list op)) (union (:add-list op)))
(conj new-list-of-actions (:action op))])))))
=> #'PAIP2clojure.Chapter4/apply-op
This implementation solves the problems mentioned above.
The next parts of Chapter 4 show how the program performs in new domains. Feel free to port the
ops in these domains to clojure and report whether the program worked or not.
Here is one example domain: monkey and bananas:
(def ^:dynamic *banana-ops*
[{:action "climb-on-chair"
:preconds #{"chair-at-middle-room" "at-middle-room" "on-floor"}
:add-list #{"at-bananas" "on-chair"}
:del-list #{"at-middle-room" "on-floor"}}
{:action "push-chair-from-door-to-middle-room"
:preconds #{"chair-at-door" "at-door"}
:add-list #{"chair-at-middle-room" "at-middle-room"}
:del-list #{"chair-at-door" "at-middle-room"}}
{:action "walk-from-door-to-middle-room"
:preconds #{"at-door" "on-floor"}
:add-list #{"at-middle-room"}
:del-list #{"at-door"}}
{:action "grasp-bananas"
:preconds #{"at-bananas" "empty-handed"}
:add-list #{"has-bananas"}
:del-list #{"at-door"}}
{:action "drop-ball"
:preconds #{"has-ball"}
:add-list #{"empty-handed"}
:del-list #{"has-ball"}}
{:action "eat-bananas"
:preconds #{"has-bananas"}
:add-list #{"empty-handed" "not-hungry"}
:del-list #{"has-bananas" "hungry"}}])
(def ^:dynamic *ops* *banana-ops*)
=> #'PAIP2clojure.Chapter4/*ops*
(binding [*dbg-ids* #{:gps }]
(GPS #{"at-door" "on-floor" "has-ball" "hungry" "chair-at-door"}
#{"not-hungry"}))
Goal not-hungry
Consider: eat-bananas
Goal has-bananas
Consider: grasp-bananas
Goal empty-handed
Consider: drop-ball
Goal has-ball
Action drop-ball
Goal at-bananas
Consider: climb-on-chair
Goal chair-at-middle-room
Consider: push-chair-from-door-to-middle-room
Goal chair-at-door
Goal at-door
Action push-chair-from-door-to-middle-room
Goal at-middle-room
Goal on-floor
Action climb-on-chair
Action grasp-bananas
Action eat-bananas
=> ["drop-ball" "push-chair-from-door-to-middle-room" "climb-on-chair" "grasp-bananas" "eat-bananas"]
The Chapter in PAIP ends with a discussion of how general the GPS really is. It turns out, that it has severe
limitations and I encourage everyone to read the sections in the book. Many of this issues will be addressed
in later chapters using more sophisticated techniques, such as full-fledged search and backtracking, like
prolog does.
Puh, that was more work than I thought. But I hope that I managed to translate it to ideomatic clojure which is not
to hard to follow.
Feel free to comment, if you have questions, anything is not clear, you enounter bugs or have some other advice.
Chapter 5 is next to come. It contains an implementation of the
ELIZA program.
