This program is a simplified version of the General Problem Solver, loosely derived from Chapter 4 of Peter Norvig's Paradigms of Artificial Intelligence Programming (San Mateo, California: Morgan Kaufmann Publishers, 1991) and, even more loosely, from Alan Newell and Herbert A. Simon's ``GPS, a program that simulates human thought,'' in Edward A. Feigenbaum and Julian Feldman, Computers and Thought (New York: McGraw-Hill, 1963), pages 279 - 293.

```;; Programmer: John Stone, Grinnell College.
;; June 9, 1996.
```
The `GPS` procedure takes as arguments an initial state, a list of goals to be reached, and a list of operations that can be performed to transform the state in the course of a solution. If the specified goals can be attained from the given initial state, the GPS procedure displays the sequence of operations that will achieve them; otherwise, it reports that it is unable to find a solution.

```(define GPS
(lambda (initial-state goals operations)
(let ((result (achieve-all goals initial-state operations)))
(if result
(display-steps (cdr result))
(writeln "GPS was unable to find a solution.")))))
```
Given a list of goals, an initial state, and a list of state-transforming operations, the `achieve-all` procedure attempts to achieve each of the goals successively, using the final state reached during the achievement of a goal as the initial state for the achievement of the next. If it is successful, it returns a pair in which the first component is the state reached at the end of the entire process and the second component is a list of the operations by which the result was achieved. If it is unsuccessful in achieving any one of the goals, the achieve-all procedure returns `#f`.

```(define achieve-all
(lambda (goals initial-state operations)
(if (null? goals)
(cons initial-state '())
(let ((first-part (achieve (car goals) initial-state operations)))
(and first-part
(let ((rest-part
(achieve-all (cdr goals) (car first-part) operations)))
(and rest-part
(cons (car rest-part)
(append (cdr first-part) (cdr rest-part))))))))))
```
Given a single goal, an initial state, and a list of state-transforming operations, the `achieve` procedure tries to find a way to achieve the goal starting from the initial state. If the goal is already met in the initial state, the problem is trivial; otherwise, achieve searches for an appropriate operation -- one that would result in the addition of the goal to the current state -- and attempts to achieve all of the preconditions for that goal. If it succeeds, the achieve procedure returns a pair in which the first component is the state reached at the end of the process and the second component is a list of the operations by which the result was achieved. If it is unsuccessful, the achieve procedure returns `#f`.

```(define achieve
(lambda (goal initial-state operations)
(if (member? goal initial-state)
(cons initial-state '())
(try (lambda (possible)
(let ((result (achieve-all (preconditions possible)
initial-state
operations)))
(and result
(cons (apply-operation (car result) possible)
(attach-at-end possible (cdr result))))))
(filter (lambda (op)
(member? goal (products op)))
operations)))))
```
The `member?` procedure determines whether a given value occurs as an element of a given list.

```(define member?
(lambda (val li)
(cond ((null? li) #f)
((equal? val (car li)) #t)
(else (member? val (cdr li))))))
```
The `try` procedure takes a procedure and a list of potential arguments to that procedure. It applies the procedure to successive elements of the list until either the list is exhausted (in which case it returns `#f`) or the procedure returns a value other than `#f` (in which case the try procedure returns that value).

```(define try
(lambda (proc li)
(if (null? li)
#f
(or (proc (car li))
(try proc (cdr li))))))
```
The `filter` operation takes a predicate and a list and returns a list containing the elements from the given list that satisfy the predicate.

```(define filter
(lambda (pred li)
(letrec ((helper
(lambda (rest so-far)
(if (null? rest)
(reverse so-far)
(helper (cdr rest)
(let ((first (car rest)))
(if (pred first)
(cons first so-far)
so-far)))))))
(helper li '()))))
```
Given a value and a list, the `attach-at-end` procedure constructs and returns a new list, containing the same elements as the given list except that the given value has been added as the last element.

```(define attach-at-end
(lambda (val li)
(if (null? li)
(cons val '())
(cons (car li) (attach-at-end val (cdr li))))))
```
To apply an operation to the current state, remove the conditions that the operation consumes or falsifies and add those that it produces.
```(define apply-operation
(lambda (state operation)
(union (products operation)
(set-difference state (sumpta operation)))))
```
Given two lists, the `union` operation forms a list containing exactly those values that appear on one or both of the given lists.

```(define union
(lambda (set-1 set-2)
(letrec ((helper
(lambda (set so-far)
(if (null? set)
so-far
(helper (cdr set)
(let ((first (car set)))
(if (member first set-2)
so-far
(cons first so-far))))))))
(helper set-1 set-2))))
```
Given two lists, the `set-difference` operation forms a list containing exactly those values that appear in the first of the given lists and not in the second.

```(define set-difference
(lambda (set-1 set-2)
(letrec ((helper
(lambda (set so-far)
(if (null? set)
so-far
(helper (cdr set)
(let ((first (car set)))
(if (member first set-2)
so-far
(cons first so-far))))))))
(helper set-1 '()))))
```
An operation is a list of four elements: a string indicating what the operation does, a list of the preconditions for the operation, a list of the conditions that the operation produces, and a list of the conditions that it consumes or falsifies.

The `make-op` operation constructs such a list from its components.

```(define make-op
(lambda (action preconditions products sumpta)
(list action preconditions products sumpta)))
```
The following operations recover the respective fields of an operation.
```(define action car)
```
The `writeln` procedure writes out its arguments in order, immediately adjacent to one another, and then starts a new line.

```(define writeln
(lambda args
(for-each display args)
(newline)))
```
The `display-steps` procedure prints out the ``action'' field of each operation in a sequence, one operation to a line.

```(define display-steps
(lambda (operation-sequence)
(for-each (lambda (operation)
(writeln (action operation)))
operation-sequence)))
```
Here is the setting for one kind of problem that this simple version of `GPS` can solve: a collection of six operations from the daily life of a parent.

```(define *school-ops*
(list

;; If your son is at home and your car works, it is possible to drive
;; him to school.  (Then he'll be at school and will no longer be at
;; home.)

(make-op "drive son to school"
'(son-at-home car-works)
'(son-at-school)
'(son-at-home))

;; If your car needs a new battery, and the mechanic knows the problem
;; and has been paid, it is possible him to install the new battery.
;; Then the car will work.

(make-op "have the mechanic install a new battery"
'(car-needs-battery mechanic-knows-problem
mechanic-has-money)
'(car-works)
'(car-needs-battery))

;; If you can communicate with the mechanic, you can tell him about the
;; problem with your car, and then he'll know what it is.

(make-op "tell the mechanic what the problem is"
'(in-communication-with-mechanic)
'(mechanic-knows-problem)
'())

;; If you know the mechanic's telephone number, you can call him, and
;; then you'll be able to communicate with him.

(make-op "telephone the mechanic"
'(know-phone-number)
'(in-communication-with-mechanic)
'())

;; If you have a telephone book, you can look up the mechanic's number,
;; and then you'll know what it is.

(make-op "look up the telephone number"
'(have-phone-book)
'(know-phone-number)
'())

;; If you have money, then you can pay the mechanic.  Then he'll have
;; the money and you won't.

(make-op "pay the mechanic"
'(have-money)
'(mechanic-has-money)
'(have-money))))
```
Here, then, are a couple of problems that GPS can solve, using these operations:
```> (GPS '(son-at-home car-works) '(son-at-school) *school-ops*)
drive son to school

> (GPS '(son-at-home car-needs-battery have-phone-book have-money)
'(son-at-school)
*school-ops*)
look up the telephone number
telephone the mechanic
tell the mechanic what the problem is
pay the mechanic
have the mechanic install a new battery
drive son to school
```
On the other hand:
```> (GPS '(son-at-home car-needs-battery have-phone-book)
'(son-at-school)
*school-ops*)
GPS was unable to find a solution.
```

created June 21, 1996
last revised June 21, 1996