forked from norvig/paip-lisp
-
Notifications
You must be signed in to change notification settings - Fork 0
/
gps1.lisp
60 lines (50 loc) · 2.06 KB
/
gps1.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-
;;; Code from Paradigms of Artificial Intelligence Programming
;;; Copyright (c) 1991 Peter Norvig
;;;; File gps1.lisp: First version of GPS (General Problem Solver)
(defvar *state* nil "The current state: a list of conditions.")
(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 *ops*)
"General Problem Solver: achieve all goals using *ops*."
(if (every #'achieve goals) 'solved))
(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))))
(defun appropriate-p (goal op)
"An op is appropriate to a goal if it is in its add list."
(member goal (op-add-list op)))
(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))
;;; ==============================
(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))))