;;; Exercice 4.1 (defun achieve-all (goals) "Try to achieve each goal, then make sure they still hold." (and (every #'achieve goals) (subsetp goals *state*))) (defun GPS (*state* goals *ops*) "General Problem Solver: achieve all goals using *ops*." (when (achieve-all goals) 'solved)) (defun apply-op (op) "Print a message and update *state* if op is applicable." (when (achieve-all (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)) ; (gps '(son-at-home car-needs-battery have-money have-phone-book) ; '( have-money 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) ; NIL ;;; Exercice 4.2 (defun member-equal (item list) (member item list :test #'equal)) (defun subsetp-equal (subset set) (subsetp subset set :test #'equal)) (defun union-equal (set1 set2) (union set1 set2 :test #'equal)) (defun achieve-all (goals) "Try to achieve each goal, then make sure they still hold." (and (every #'achieve goals) (subsetp-equal goals *state*))) (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-equal goal *state*) (some #'apply-op (find-all goal *ops* :test #'appropriate-p)))) (defun apply-op (op) "Print a message and update *state* if op is applicable." (when (achieve-all (op-preconds op)) (print (list 'executing (op-action op))) (setf *state* (set-difference *state* (op-del-list op))) (setf *state* (union-equal *state* (op-add-list op))) t)) ;;; Exercice 4.3 (defun use (oplist) "Use oplist as the default list of operators." ;; Return something useful, but not too verbose: ;; the number of operators (length (setf *ops* oplist))) (defun gps (*state* goals &optional (*ops* *ops*)) "General Problem Solver: achieve all goals using *ops*." (when (achieve-all goals) 'solved)) ; (use *school-ops*) ; (gps '(son-at-home car-works) '(son-at-school)) ; (gps '(1) '(25)) ; (gps '(1) '(25) *maze-ops*) ;;; Exercice 4.4 ;;; Quand un opérateur est appliqué, au lieu d'imprimer un message, ;;; on retourne l'état résultant. (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) (mapc #'convert-op *school-ops*) (mapc #'convert-op *maze-ops*) (defun apply-op (op) "Update *state* if op is applicable." (when (achieve-all (op-preconds op)) (setf *state* (union-equal (set-difference *state* (op-del-list op) :test #'equalp) (op-add-list op))))) (defun gps (*state* goals &optional (*ops* *ops*)) "General Problem Solver: achieve all goals using *ops*." (when (achieve-all goals) (remove-if-not #'executing-p *state*))) ;(gps '(son-at-home car-needs-battery have-money have-phone-book) ; '(son-at-school) *school-ops*) ; ;((EXECUTING GIVE-SHOP-MONEY) (EXECUTING TELL-SHOP-PROBLEM) ; (EXECUTING LOOK-UP-NUMBER) (EXECUTING TELEPHONE-SHOP) ; (EXECUTING SHOP-INSTALLS-BATTERY) (EXECUTING DRIVE-SON-TO-SCHOOL)) * ;;; Exercice 4.5 (defun achieve-all (goals goal-stack) "Try to achieve each goal, then make sure they still hold." (and (every #'(lambda (g) (achieve g goal-stack)) goals) (subsetp-equal goals *state*))) (defun achieve (goal goal-stack) "A goal is achieved if it already holds, or if there is an appropriate op for it that is applicable." (cond ((member-equal goal *state*) t) ((member-equal goal goal-stack) nil) ; avoids infinite loop (t (some #'(lambda (op) (apply-op op goal goal-stack)) (find-all goal *ops* :test #'appropriate-p))))) (defun apply-op (op goal goal-stack) "Update *state* if op is applicable." (when (achieve-all (op-preconds op) (cons goal goal-stack)) (setf *state* (union-equal (set-difference *state* (op-del-list op) :test #'equalp) (op-add-list op))))) (defun gps (*state* goals &optional (*ops* *ops*)) "General Problem Solver: achieve all goals using *ops*." (when (achieve-all goals nil) (remove-if-not #'executing-p *state*))) (defparameter *maze-ops* (mapcar #'make-maze-ops '((25 20) (1 2) (2 3) (3 4) (4 9) (9 14) (9 8) (8 7) (7 12) (12 13) (12 11) (11 6) (11 16) (16 17) (17 22) (21 22) (22 23) (23 18) (23 24) (24 19) (19 20) (20 15) (15 10) (10 5) (20 25)))) (mapc #'convert-op *maze-ops*) ; (use *maze-ops*) ; (gps '(1) '(25)) ne boucle plus ;;; Exercice 6 ;;; Les fonctions apply-op, achieve, achieve-all renvoient l'état courant ;;; ou nil si échec ;;; (start) dans la liste d'états permet de différencier le cas d'échec du ;;; cas d'échec (liste vide). (defun action-p (x) "Is something that is (start) or (executing ...))" (or (equal x '(start)) (executing-p x))) (defun achieve-all (state goals goal-stack) "Try to achieve each goal, then make sure they still hold." (do ((gs goals (cdr gs)) (current-state state (achieve current-state (car gs) goal-stack))) ((or (endp gs) (null current-state)) (and (subsetp-equal goals current-state) 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." (cond ((member-equal goal state) state) ((member-equal goal goal-stack) nil) ; avoids infinite loop (t (some #'(lambda (op) (apply-op state goal op goal-stack)) (find-all goal *ops* :test #'appropriate-p))))) (defun apply-op (state goal op goal-stack) "Return a new transformed state if op is applicable." (let ((newstate (achieve-all state (op-preconds op) (cons goal goal-stack)))) (and newstate (union-equal (set-difference newstate (op-del-list op) :test #'equalp) (op-add-list op))))) (defun gps (state goals &optional (*ops* *ops*)) "General Problem Solver: achieve all goals using *ops*." (remove-if-not #'action-p (achieve-all (cons '(start) state) goals nil))) ; (gps '(1) '(25)) ;((START) (EXECUTING (MOVE FROM 1 TO 2)) (EXECUTING (MOVE FROM 2 TO 3)) ; (EXECUTING (MOVE FROM 3 TO 4)) (EXECUTING (MOVE FROM 4 TO 9)) ; (EXECUTING (MOVE FROM 9 TO 8)) (EXECUTING (MOVE FROM 8 TO 7)) ; (EXECUTING (MOVE FROM 7 TO 12)) (EXECUTING (MOVE FROM 12 TO 11)) ; (EXECUTING (MOVE FROM 11 TO 16)) (EXECUTING (MOVE FROM 16 TO 17)) ; (EXECUTING (MOVE FROM 17 TO 22)) (EXECUTING (MOVE FROM 22 TO 23)) ; (EXECUTING (MOVE FROM 23 TO 24)) (EXECUTING (MOVE FROM 24 TO 19)) ; (EXECUTING (MOVE FROM 19 TO 20)) (EXECUTING (MOVE FROM 20 TO 25)))