Script started on Sun Jan 02 08:49:58 2005
>lisp

Allegro CL Enterprise Edition 5.0.1 [SPARC] (6/29/99 16:47)
Copyright (C) 1985-1999, Franz Inc., Berkeley, CA, USA.  All Rights Reserved.
;; Optimization settings: safety 1, space 1, speed 1, debug 2.
;; For a complete description of all compiler switches given the
;; current optimization settings evaluate (EXPLAIN-COMPILER-SETTINGS).
USER(1): (load "auxfuns.^?^?^?          ns.lisp")
; Loading /home/futrelle/csg120sp05/code/paip/auxfns.lisp
T
USER(2): (requires "examples")
(do-examples :all); Loading /home/futrelle/csg120sp05/code/paip/examples.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/tutor.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/auxfns.lisp
("examples")
USER(3): (do-examples :all)


Chapter  1. Introduction to Lisp
This chapter is for people with little or no experince in Lisp.
Intermediate or advanced readers can skim or skip this chapter.

Lisp expressions are in prefix notation: the operator first.
; page 4
> (+ 2 2)
4
; page 5
> (+ 1 2 3 4 5 6 7 8 9 10)
55
This is Lisp for (900 + 900 + 90 + 9) - (5000 + 500 + 50 + 5)
> (- (+ 9000 900 90 9) (+ 5000 500 50 5))
4444

Section 1.1 Symbolic Computation
This is an example of computation on lists:
; page 6
> (append '(pat kim) '(robin sandy))
(PAT KIM ROBIN SANDY)
The quote mark instructs Lisp to treat the list as data.
> '(pat kim)
(PAT KIM)
Let's look at some more list processing functions

Section 1.4 Lists
; page 10
> (setf p '(john q public))
(JOHN Q PUBLIC)
> (first p)
JOHN
> (rest p)
(Q PUBLIC)
> (second p)
Q
> (third p)
PUBLIC
> (fourth p)
NIL
> (length p)
3
It is also possible to build up new lists
; page 11
> p
(JOHN Q PUBLIC)
> (cons 'mr p)
(MR JOHN Q PUBLIC)
> (cons (first p) (rest p))
(JOHN Q PUBLIC)
> (setf town (list 'anytown 'usa))
(ANYTOWN USA)
> (list p 'of town 'may 'have 'already 'won!)
((JOHN Q PUBLIC) OF (ANYTOWN USA) MAY HAVE ALREADY WON!)
> (append p '(of) town '(may have already won))
(JOHN Q PUBLIC OF ANYTOWN USA MAY HAVE ALREADY WON)
> p
(JOHN Q PUBLIC)

Section 1.5 Defining New Functions
The special form DEFUN stands for 'define function.'
It is used here to define a new function called last-name:
> (requires "intro")
; Loading /home/futrelle/csg120sp05/code/paip/intro.lisp
("intro")
; page 13
> (last-name p)
PUBLIC
> (last-name '(rex morgan md))
MD
> (last-name '(spot))
SPOT
> (last-name '(aristotle))
ARISTOTLE
We can also define the function first-name.
Even though the definition is trivial (it is the same as FIRST),
it is good practice to define first-name explicitly.
> p
(JOHN Q PUBLIC)
> (first-name p)
JOHN
> (first-name '(wilma flintstone))
WILMA
; page 14
> (setf names
        '((john q public) (malcolm x) (admiral grace murray hopper)
          (spot) (aristotle) (a a milne) (z z top) (sir larry olivier)
          (miss scarlet)))
((JOHN Q PUBLIC) (MALCOLM X) (ADMIRAL GRACE MURRAY HOPPER) (SPOT)
 (ARISTOTLE) (A A MILNE) (Z Z TOP) (SIR LARRY OLIVIER) (MISS SCARLET))
> (first-name (first names))
JOHN

Section 1.6 Using Functions
Consider the following expression, which can be used to test LAST-NAME:
> (mapcar #'last-name names)
(PUBLIC X HOPPER SPOT ARISTOTLE MILNE TOP OLIVIER SCARLET)
The #' notation maps the name of a function to the function itself.
; page 15
> (mapcar #'- '(1 2 3 4))
(-1 -2 -3 -4)
> (mapcar #'+ '(1 2 3 4) '(10 20 30 40))
(11 22 33 44)
Now that we understand mapcar, let's use it to test FIRST-NAME:
> (mapcar #'first-name names)
(JOHN MALCOLM GRACE SPOT ARISTOTLE A Z LARRY SCARLET)
Suppose we wanted a version of FIRST-NAME that ignored titles like Miss:
> (defparameter *titles*
      (quote (mr mrs miss ms sir madam dr admiral major general))
    "A list of titles that can appear at the start of a name.")
         being defined at the top level
*TITLES*
; page 16
> (defun first-name (name)
    "Select the first name from a name represented as a list."
    (if (member (first name) *titles*)
        (first-name (rest name))
      (first name)))
         being defined at the top level
FIRST-NAME
> (mapcar #'first-name names)
(JOHN MALCOLM GRACE SPOT ARISTOTLE A Z LARRY SCARLET)
> (first-name '(madam major general paula jones))
PAULA
We can see how this works by tracing the execution of first-name:
> (trace first-name)
(FIRST-NAME)
; page 17
> (first-name '(john q public))
 0: (FIRST-NAME (JOHN Q PUBLIC))
 0: returned JOHN
JOHN
> (first-name '(madam major general paula jones))
 0: (FIRST-NAME (MADAM MAJOR GENERAL PAULA JONES))
   1: (FIRST-NAME (MAJOR GENERAL PAULA JONES))
     2: (FIRST-NAME (GENERAL PAULA JONES))
       3: (FIRST-NAME (PAULA JONES))
       3: returned PAULA
     2: returned PAULA
   1: returned PAULA
 0: returned PAULA
PAULA
> (untrace first-name)
(FIRST-NAME)

Section 1.7 Higher-Order Functions
> (apply #'+ '(1 2 3 4))
10
> (apply #'append '((1 2 3) (a b c)))
(1 2 3 A B C)
Now we define a new function, self-and-double, and apply it to arguments.
> (defun self-and-double (x) (list x (+ x x)))
SELF-AND-DOUBLE
> (self-and-double 3)
(3 6)
> (apply #'self-and-double '(3))
(3 6)
Now let's return to the mapping functions:
> (mapcar #'self-and-double '(1 10 300))
((1 2) (10 20) (300 600))
> (mappend #'self-and-double '(1 10 300))
(1 2 10 20 300 600)
FUNCALL is similar to APPLY; it too takes a function as its
first argument and applies the function to a list of arguments,
but in the case of FUNCALL, the arguments are listed separately:
; page 20
> (funcall #'+ 2 3)
5
> (apply #'+ '(2 3))
5

Chapter  1. Introduction to Lisp done.

Chapter  2. A Simple Lisp Program
This chapter shows how to combine the basic functions and
special forms of Lisp into a complete program
The program generates random English sentences.

Section 2.2 A Straightforward Solution
We can test the program by generating a few random sentences.
(Note that since these are random, you won't get the same ones
as in the book.)
> (requires "simple")
; Loading /home/futrelle/csg120sp05/code/paip/simple.lisp
("simple")
; page 36
> (sentence)
(THE WOMAN HIT THE TABLE)
; page 36
> (sentence)
(A TABLE HIT THE MAN)
; page 36
> (sentence)
(A TABLE TOOK A BALL)
> (noun-phrase)
(THE MAN)
> (verb-phrase)
(TOOK A MAN)
; page 37
> (trace sentence noun-phrase verb-phrase article noun verb)
(VERB NOUN ARTICLE VERB-PHRASE NOUN-PHRASE SENTENCE)
> (sentence)
 0: (SENTENCE)
   1: (NOUN-PHRASE)
     2: (ARTICLE)
     2: returned (THE)
     2: (NOUN)
     2: returned (MAN)
   1: returned (THE MAN)
   1: (VERB-PHRASE)
     2: (VERB)
     2: returned (HIT)
     2: (NOUN-PHRASE)
       3: (ARTICLE)
       3: returned (A)
       3: (NOUN)
       3: returned (TABLE)
     2: returned (A TABLE)
   1: returned (HIT A TABLE)
 0: returned (THE MAN HIT A TABLE)
(THE MAN HIT A TABLE)
> (untrace)
NIL

Section 2.3 A Rule-Based Solution
An alternative implementation concentrates on making it easy
to write grammar rules.
; page 41
> (generate 'sentence)
(THE BALL LIKED A WOMAN)
; page 41
> (generate 'sentence)
(THE BALL LIKED A BALL)
; page 41
> (generate 'noun-phrase)
(A MAN)
; page 41
> (generate 'verb-phrase)
(TOOK A BALL)
One advantage of this approach is its easier to change grammars.
; page 43
> (setf *grammar* *bigger-grammar*)
((SENTENCE -> (NOUN-PHRASE VERB-PHRASE))
 (NOUN-PHRASE -> (ARTICLE ADJ* NOUN PP*) (NAME) (PRONOUN))
 (VERB-PHRASE -> (VERB NOUN-PHRASE PP*)) (PP* -> NIL (PP PP*))
 (ADJ* -> NIL (ADJ ADJ*)) (PP -> (PREP NOUN-PHRASE))
 (PREP -> TO IN BY WITH ON) (ADJ -> BIG LITTLE BLUE GREEN ADIABATIC)
 (ARTICLE -> THE A) (NAME -> PAT KIM LEE TERRY ROBIN)
 (NOUN -> MAN BALL WOMAN TABLE) (VERB -> HIT TOOK SAW LIKED)
 (PRONOUN -> HE SHE IT THESE THOSE THAT))
> (generate 'sentence)
(A MAN ON A WOMAN TO THE BALL ON IT TO ROBIN ON PAT LIKED IT BY A GREEN
 BLUE ADIABATIC BALL WITH A TABLE BY ROBIN ON A LITTLE BLUE BLUE BIG
 LITTLE LITTLE TABLE)
> (generate 'sentence)
(HE HIT IT)
Another advantage is that the same data (grammar) can be used
for more than one purpose.  Consider generate-tree:
; page 45
> (generate-tree 'sentence)
(SENTENCE (NOUN-PHRASE (PRONOUN THOSE))
          (VERB-PHRASE (VERB SAW) (NOUN-PHRASE (PRONOUN IT))
                       (PP* (PP (PREP WITH) (NOUN-PHRASE (PRONOUN IT)))
                            (PP* (PP
                                  (PREP ON)
                                  (NOUN-PHRASE (NAME ROBIN)))
                                 (PP*
                                  (PP
                                   (PREP IN)
                                   (NOUN-PHRASE
                                    (ARTICLE A)
                                    (ADJ*
                                     (ADJ BIG)
                                     (ADJ*
                                      (ADJ BIG)
                                      (ADJ*
                                       (ADJ ADIABATIC)
                                       (ADJ*
                                        (ADJ ADIABATIC)
                                        (ADJ*
                                         (ADJ GREEN)
                                         (ADJ*
                                          (ADJ LITTLE)
                                          (ADJ*
                                           (ADJ GREEN)
                                           (ADJ*
                                            (ADJ ADIABATIC)
                                            (ADJ*)))))))))
                                    (NOUN TABLE)
                                    (PP*
                                     (PP
                                      (PREP WITH)
                                      (NOUN-PHRASE (NAME KIM)))
                                     (PP*
                                      (PP
                                       (PREP BY)
                                       (NOUN-PHRASE (NAME LEE)))
                                      (PP*)))))
                                  (PP*))))))

Chapter  2. A Simple Lisp Program done.

Chapter  3. Overview of Lisp
This chapter briefly covers the most important special forms and
functions in Lisp.

Section 3.2 Special Forms
Start with functions and special forms for repetition:
First, functions like MAPCAR can apply to any number of lists:
; page 61
> (mapcar #'- '(1 2 3))
(-1 -2 -3)
> (mapcar #'+ '(1 2) '(10 20) '(100 200))
(111 222)
Second, many of the functions accept keywords:
; page 61
> (remove 1 '(1 2 3 2 1 0 -1))
(2 3 2 0 -1)
; page 61
> (remove 1 '(1 2 3 2 1 0 -1) :key #'abs)
(2 3 2 0)
; page 61
> (remove 1 '(1 2 3 2 1 0 -1) :test #'<)
(1 1 0 -1)
; page 61
> (remove 1 '(1 2 3 2 1 0 -1) :start 4)
(1 2 3 2 0 -1)
Third, some have corresponding -IF or -IF-NOT versions:
> (remove-if #'oddp '(1 2 3 2 1 0 -1))
(2 2 0)
> (remove-if-not #'oddp '(1 2 3 2 1 0 -1))
(1 3 1 -1)
The forms TRACE and UNTRACE are used to control debugging info:
> (requires "overview")
; Loading /home/futrelle/csg120sp05/code/paip/overview.lisp
("overview")
; page 65
> (trace length9)
(LENGTH9)
> (length9 '(1 b c))
 0: (LENGTH9 (1 B C))
   1: (LENGTH9 (B C))
     2: (LENGTH9 (C))
       3: (LENGTH9 NIL)
       3: returned 0
     2: returned 1
   1: returned 2
 0: returned 3
3
> (untrace length9)
(LENGTH9)
> (length9 '(1 b c))
3

Section 3.7 Functions on Trees
; page 76
> (setf tree '((a b) ((c)) (d e)))
((A B) ((C)) (D E))
> (tree-equal tree (copy-tree tree))
T
> (same-shape-tree tree '((1 2) ((3)) (4 5)))
T
> (same-shape-tree tree '((1 2) (3) (4 5)))
NIL
There are two functions for substituting a new expression into a tree:
> (subst 'new 'old '(old ((very old))))
(NEW ((VERY NEW)))
> (sublis '((old . new)) '(old ((very old))))
(NEW ((VERY NEW)))
> (subst 'new 'old 'old)
NEW
Here is an example:
; page 77
> (english->french '(hello my friend - how are you today?))
(BONJOUR MON AMI - COMMENT VA TU TODAY?)

Section 3.10 Destructive Functions
Consider the following:
; page 80
> (setq x '(a b c))
(A B C)
> (setq y '(1 2 3))
(1 2 3)
> (nconc x y)
(A B C 1 2 3)
> x
(A B C 1 2 3)
> y
(1 2 3)
NCONC computes the same result as APPEND, but it alters the first argument.
It is called a 'destructive' function.
There is quite a conceptual load on the programmer who uses NCONC.
The advantage of NCONC is that it doesn't use any storage.


Section 3.11 Overview of Data Types
The function TYPE-OF returns the type of its argument.
; page 82
> (type-of 123)
FIXNUM
> (typep 123 'fixnum)
T
> (typep 123 'integer)
T
> (typep 123.0 'integer)
NIL
> (subtypep 'fixnum 'integer)
T

Section 3.12 Input/Output
FORMAT is the main function for formatted output:
; page 84
> (format t "hello, world")
hello, world
NIL
> (format t "~&~a plus ~s is ~f" "two" "two" 4)
two plus "two" is 4.0
NIL
> (let ((numbers '(1 2 3 4 5)))
    (format t "~&~{~r~^ plus ~} is ~@r" numbers (apply #'+ numbers)))
one plus two plus three plus four plus five is XV
NIL

Section 3.13 Debugging tools
; page 87
> (documentation 'first 'function)
NIL
> (documentation 'pi 'variable)
NIL

Section 3.14 Antibugging Tools
; page 90
> (defun f (n) (dotimes (i n) nil))
F
> (time (f 10000))
; cpu time (non-gc) 30 msec user, 0 msec system
; cpu time (gc)     10 msec user, 0 msec system
; cpu time (total)  40 msec user, 0 msec system
; real time  38 msec
; space allocation:
;  110,009 cons cells, 0 symbols, 32 other bytes, 0 static bytes
NIL
> (compile 'f)
; While compiling F:
F
> (time (f 10000))
; cpu time (non-gc) 0 msec user, 0 msec system
; cpu time (gc)     0 msec user, 0 msec system
; cpu time (total)  0 msec user, 0 msec system
; real time  0 msec
; space allocation:
;  1 cons cell, 0 symbols, 0 other bytes, 0 static bytes
NIL

Section 3.15 Evaluation
The following five forms are equivalent:
; page 91
> (+ 1 2 3 4)
10
; page 91
> (funcall #'+ 1 2 3 4)
10
; page 91
> (apply #'+ '(1 2 3 4))
10
; page 91
> (apply #'+ 1 2 '(3 4))
10
; page 91
> (eval '(+ 1 2 3 4))
10

Section 3.16 Closures
In the general case, a function consists of the body of the function
coupled with any free lexical variables that the function references.
Consider the example:
; page 92
> (mapcar (adder 3) '(1 3 10))
(4 6 13)
; page 92
> (mapcar (adder 10) '(1 3 10))
(11 13 20)
In the following, two calls to BANK-ACCOUNT create two different closures,
each with a separate value for the lexical variable BALANCE.
; page 92
> (setf my-account (bank-account 500.0))
#<Interpreted Closure (:INTERNAL BANK-ACCOUNT) @ #x44c88f2>
; page 93
> (setf your-account (bank-account 250.0))
#<Interpreted Closure (:INTERNAL BANK-ACCOUNT) @ #x44c8bf2>
> (funcall my-account 'withdraw 75.0)
425.0
> (funcall your-account 'deposit 250.0)
500.0
> (funcall your-account 'withdraw 100.0)
400.0
> (funcall my-account 'withdraw 25.0)
400.0
This style of programming is covered in more detail in chapter 13.

Chapter  3. Overview of Lisp done.

Chapter  4. GPS: The General Problem Solver
The General problem Solver, developed in 1957 by Alan Newell and Herbert
Simon, embodied a grandiose vision: a single computer program that could
solve ANY problem.  GPS caused quite a stir ...

Section 4.4 Stage 4: test
> (requires "gps1")
; Loading /home/futrelle/csg120sp05/code/paip/gps1.lisp
("gps1")
Here are some examples of using GPS
The first example works with a complex chain of steps.
; page 118
> (gps '(son-at-home car-needs-battery have-money have-phone-book)
       '(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) 
SOLVED
The next example fails because there is no way to make the car work,
because we can't contact the shop to get the battery fixed.
> (gps '(son-at-home car-needs-battery have-money) '(son-at-school)
       *school-ops*)
NIL
The third example is easy, because the car is currently working.
> (gps '(son-at-home car-works) '(son-at-school) *school-ops*)

(EXECUTING DRIVE-SON-TO-SCHOOL) 
SOLVED

Section 4.7 The Clobbered Sibling Goal Problem
In the next example, GPS incorrectly reports success, when in fact it has
spent the money on the battery, and thus should fail.
; page 120
> (gps '(son-at-home have-money car-works) '(have-money son-at-school)
       *school-ops*)

(EXECUTING DRIVE-SON-TO-SCHOOL) 
SOLVED
The bug is that when (EVERY #'ACHIEVE GOALS) returns true, it means all the
goals were achieved in turn, but they might not still be all true.

Section 4.8 The Leaping before You Look Problem
What happens if we move the HAVE-MONEY goal to the end?
; page 121
> (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) 
SOLVED
GPS returns nil, but only after executing all the actions.
I call this the 'leaping before you look' problem, because if you asked
the program to solve for the two goals (JUMP-OFF-CLIFF LAND-SAFELY) it
would happily jump first, only to discover that it had no operator to land
safely.  This is less than prudent behavior.

Section 4.9 The Recursive Subgoal Problem
We won't show the problem (because it gets into an infinite loop),
but we will add the new operator to the *school-ops*; we'll use it later.
; page 122
> (push (make-op
          :action 'ask-phone-number
          :preconds '(in-communication-with-shop)
          :add-list '(know-phone-number))
        *school-ops*)
(#S(OP :ACTION ASK-PHONE-NUMBER :PRECONDS (IN-COMMUNICATION-WITH-SHOP)
       :ADD-LIST (KNOW-PHONE-NUMBER) :DEL-LIST NIL)
 #S(OP :ACTION DRIVE-SON-TO-SCHOOL :PRECONDS (SON-AT-HOME CAR-WORKS)
       :ADD-LIST (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 (CAR-WORKS) :DEL-LIST NIL)
 #S(OP :ACTION TELL-SHOP-PROBLEM :PRECONDS (IN-COMMUNICATION-WITH-SHOP)
       :ADD-LIST (SHOP-KNOWS-PROBLEM) :DEL-LIST NIL)
 #S(OP :ACTION TELEPHONE-SHOP :PRECONDS (KNOW-PHONE-NUMBER)
       :ADD-LIST (IN-COMMUNICATION-WITH-SHOP) :DEL-LIST NIL)
 #S(OP :ACTION LOOK-UP-NUMBER :PRECONDS (HAVE-PHONE-BOOK)
       :ADD-LIST (KNOW-PHONE-NUMBER) :DEL-LIST NIL)
 #S(OP :ACTION GIVE-SHOP-MONEY :PRECONDS (HAVE-MONEY)
       :ADD-LIST (SHOP-HAS-MONEY) :DEL-LIST (HAVE-MONEY)))

Section 4.11 GPS Version 2: A More General problem Solver
At this point we are ready to put together a new version of GPS with
solutions for the 'running around the block,' 'prerequisite clobbers
sibling goal,' 'leaping before you look,' and 'recursive subgoal' problems.
The most important change is that, instead of printing a message when each
operator is applied, we will instead have GPS return the resulting state.
> (requires "gps")
; Loading /home/futrelle/csg120sp05/code/paip/gps.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/gps1.lisp
("gps")
We use the list of operators that includes the 'asking the shop their
phone number' operator.
> (push (make-op
          :action 'ask-phone-number
          :preconds '(in-communication-with-shop)
          :add-list '(know-phone-number))
        *school-ops*)
(#S(OP :ACTION ASK-PHONE-NUMBER :PRECONDS (IN-COMMUNICATION-WITH-SHOP)
       :ADD-LIST (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)))
; page 130
> (use *school-ops*)
7
First we make sure the new version works on some of the examples that
version 1 worked on:
; page 131
> (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))
We can see what is going on here by turning on debugging temporarily:
> (debug :gps)
(:GPS)
; page 131
> (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: 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))
> (undebug)
NIL
Here is another old example:
; page 132
> (gps '(son-at-home car-works) '(son-at-school))
((START) (EXECUTING DRIVE-SON-TO-SCHOOL))
Now we see that version 2 can handle the three cases version 1 got wrong.
In each case the program avoids an infinite loop, and also avoids leaping
before it looks.
> (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
Finally, we see the new GPS also works on trivial problems:
> (gps '(son-at-home) '(son-at-home))
((START))

Section 4.12 The New Domain Problem: Monkey and Bananas
To show that GPS is at all general, we have to make it work in different
domains.  We start with a 'classic' AI problem: Monkey and Bananas
; page 133
> (use *banana-ops*)
6
We pose the problem of becoming not-hungry, given an initial state.
GPS can find a solution to this problem:
; page 133
> (gps '(at-door on-floor has-ball hungry chair-at-door) '(not-hungry))
((START) (EXECUTING PUSH-CHAIR-FROM-DOOR-TO-MIDDLE-ROOM)
 (EXECUTING CLIMB-ON-CHAIR) (EXECUTING DROP-BALL)
 (EXECUTING GRASP-BANANAS) (EXECUTING EAT-BANANAS))
Notice we did not need to make any changes at all to the GPS program.
We just used a different set of operators.

Section 4.13 The Maze Searching Domain
Next we will consider another 'classic' problem, maze searching.
We will assume a particular maze, diagrammed on page 134.
; page 134
> (use *maze-ops*)
48
; page 135
> (gps '((at 1)) '((at 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)))
We can define FIND-PATH to use the results of a GPS search:
; page 136
> (find-path 1 25)
(1 2 3 4 9 8 7 12 11 16 17 22 23 24 19 20 25)
> (find-path 1 1)
(1)
> (equal (find-path 1 25) (reverse (find-path 25 1)))
T

Section 4.14 The Blocks World Domain
Another domain that has attracted more than its share of attention in AI
circles is the blocks world domain.
; page 137
> (use (make-block-ops '(a b)))
4
The simplest possible problem is stacking one block on another.
> (gps '((a on table) (b on table) (space on a) (space on b)
         (space on table))
       '((a on b) (b on table)))
((START) (EXECUTING (MOVE A FROM TABLE TO B)))
Here is a slightly more complex problem: inverting a stack of two blocks.
This time we show the debugging output:
; page 138
> (debug :gps)
(:GPS)
> (gps '((a on b) (b on table) (space on a) (space on table))
       '((b on a)))
Goal: (B ON A)
Consider: (MOVE B FROM TABLE TO A)
  Goal: (SPACE ON B)
  Consider: (MOVE A FROM B TO TABLE)
    Goal: (SPACE ON A)
    Goal: (SPACE ON TABLE)
    Goal: (A ON B)
  Action: (MOVE A FROM B TO TABLE)
  Goal: (SPACE ON A)
  Goal: (B ON TABLE)
Action: (MOVE B FROM TABLE TO A)
((START) (EXECUTING (MOVE A FROM B TO TABLE))
 (EXECUTING (MOVE B FROM TABLE TO A)))
> (undebug)
NIL
Now we move on to the three block world.
> (use (make-block-ops '(a b c)))
18
We try some problems:
> (gps '((a on b) (b on c) (c on table) (space on a) (space on table))
       '((b on a) (c on b)))
((START) (EXECUTING (MOVE A FROM B TO TABLE))
 (EXECUTING (MOVE B FROM C TO A)) (EXECUTING (MOVE C FROM TABLE TO B)))
; page 141
> (gps '((c on a) (a on table) (b on table) (space on c) (space on b)
         (space on table))
       '((c on table) (a on b)))
((START) (EXECUTING (MOVE C FROM A TO TABLE))
 (EXECUTING (MOVE A FROM TABLE TO B)))
; page 141
> (gps '((a on b) (b on c) (c on table) (space on a) (space on table))
       '((b on a) (c on b)))
((START) (EXECUTING (MOVE A FROM B TO TABLE))
 (EXECUTING (MOVE B FROM C TO A)) (EXECUTING (MOVE C FROM TABLE TO B)))
> (gps '((a on b) (b on c) (c on table) (space on a) (space on table))
       '((c on b) (b on a)))
((START) (EXECUTING (MOVE A FROM B TO TABLE))
 (EXECUTING (MOVE B FROM C TO A)) (EXECUTING (MOVE C FROM TABLE TO B)))
The Sussman Anomaly
; page 142
> (setf start
        '((c on a) (a on table) (b on table) (space on c) (space on b)
          (space on table)))
((C ON A) (A ON TABLE) (B ON TABLE) (SPACE ON C) (SPACE ON B)
 (SPACE ON TABLE))
> (gps start '((a on b) (b on c)))
NIL
> (gps start '((b on c) (a on b)))
NIL

Section 4.16 The Not Looking after You Don't Leap Problem
; page 143
> (use (push (op 'taxi-son-to-school
               :preconds '(son-at-home have-money)
               :add-list '(son-at-school)
               :del-list '(son-at-home have-money))
             *school-ops*))
8
> (debug :gps)
(:GPS)
> (gps '(son-at-home have-money car-works) '(son-at-school have-money))
Goal: SON-AT-SCHOOL
Consider: TAXI-SON-TO-SCHOOL
  Goal: SON-AT-HOME
  Goal: HAVE-MONEY
Action: TAXI-SON-TO-SCHOOL
Goal: HAVE-MONEY
Goal: HAVE-MONEY
Goal: SON-AT-SCHOOL
Consider: TAXI-SON-TO-SCHOOL
  Goal: SON-AT-HOME
  Goal: HAVE-MONEY
Action: TAXI-SON-TO-SCHOOL
NIL
> (undebug)
NIL

Chapter  4. GPS: The General Problem Solver done.

Chapter  5. Eliza: Dialog with a Machine
ELIZA was one of the first programs to feature English output as well as input.
The program was named after the heroine of Pygmalion, who was taught to
speak proper English by a dedicated teacher.

Section 5.2 Pattern Matching
> (requires "eliza1")
; Loading /home/futrelle/csg120sp05/code/paip/eliza1.lisp
("eliza1")
The hard part is the notion of pattern matching and transformation.
All symbols beginning with ? are variables for the pattern matcher.
First we see how to substitute variable/value pairs into expressions:
; page 156
> (sublis '((?x . vacation))
          '(what would it mean to you if you got a ?x ?))
(WHAT WOULD IT MEAN TO YOU IF YOU GOT A VACATION ?)
Now a version of pat-match that works with such pairs:
; page 158
> (pat-match '(i need a ?x) '(i need a vacation))
((?X . VACATION))
Showing how to plug it in:
; page 159
> (sublis (pat-match '(i need a ?x) '(i need a vacation))
          '(what would it mean to you if you got a ?x ?))
(WHAT WOULD IT MEAN TO YOU IF YOU GOT A VACATION ?)
> (pat-match '(i need a ?x) '(i really need a vacation))
NIL
> (pat-match '(this is easy) '(this is easy))
((T . T))
> (pat-match '(?x is ?x) '((2 + 2) is 4))
NIL
> (pat-match '(?x is ?x) '((2 + 2) is (2 + 2)))
((?X 2 + 2))
> (pat-match '(?p need . ?x) '(i need a long vacation))
((?X A LONG VACATION) (?P . I))

Section 5.3 Segment Pattern Matching
We show how to have a variable that will match more than one element.
We call these segment variables, and denote them (?* name).
; page 160
> (pat-match '((?* ?p) need (?* ?x)) '(mr hulot and i need a vacation))
((?X A VACATION) (?P MR HULOT AND I))

Section 5.4 The Eliza Program: A Rule-Based Translator
> (requires "eliza")
; Loading /home/futrelle/csg120sp05/code/paip/eliza.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/eliza1.lisp
         the file /home/futrelle/csg120sp05/code/paip/eliza.lisp.
("eliza")
We can't show you an interactive ELIZA session, because the replies are
random, and thus change every time.  You can experiment on your own by
evaluating (ELIZA) and typing in your end of the conversation.
  Type (good bye) when you are done.

Chapter  5. Eliza: Dialog with a Machine done.

Chapter  6. Building Software Tools
In chapters 4 and 5 we were concerned with buildinng two particular
programs, GPS and ELIZA.  In this chapter, we will reexamine those
two programs to discover some common patterns.  Those patterns will be
abstracted out to form reusable software tools.

Section 6.2 A Pattern-Matching tool
> (requires "patmatch")
; Loading /home/futrelle/csg120sp05/code/paip/patmatch.lisp
("patmatch")
; page 179
> (pat-match '(x = (?is ?n numberp)) '(x = 34))
((?N . 34))
> (pat-match '(x = (?is ?n numberp)) '(x = x))
NIL
> (pat-match '(?x (?or < = >) ?y) '(3 < 4))
((?Y . 4) (?X . 3))
> (pat-match '(x = (?and (?is ?n numberp) (?is ?n oddp))) '(x = 3))
((?N . 3))
; page 180
> (pat-match '(?x /= (?not ?x)) '(3 /= 4))
((?X . 3))
> (pat-match '(?x > ?y (?if (> ?x ?y))) '(4 > 3))
((?Y . 3) (?X . 4))
; page 185
> (pat-match '(a (?* ?x) d) '(a b c d))
((?X B C))
> (pat-match '(a (?* ?x) (?* ?y) d) '(a b c d))
((?Y B C) (?X))
; page 186
> (pat-match '(a (?* ?x) (?* ?y) ?x ?y) '(a b c d (b c) (d)))
((?Y D) (?X B C))
> (pat-match '(?x ?op ?y is ?z (?if (eql (funcall ?op ?x ?y) ?z)))
             '(3 + 4 is 7))
((?Z . 7) (?Y . 4) (?OP . +) (?X . 3))
> (pat-match '(?x ?op ?y (?if (funcall ?op ?x ?y))) '(3 > 4))
NIL
; page 187
> (pat-match-abbrev '?x* '(?* ?x))
(?* ?X)
> (pat-match-abbrev '?y* '(?* ?y))
(?* ?Y)
> (setf axyd (expand-pat-match-abbrev '(a ?x* ?y* d)))
(A (?* ?X) (?* ?Y) D)
> (pat-match axyd '(a b c d))
((?Y B C) (?X))
> (pat-match '(((?* ?x) (?* ?y)) ?x ?y) '((a b c d) (a b) (c d)))
NIL
> (requires "eliza-pm")
; Loading /home/futrelle/csg120sp05/code/paip/eliza-pm.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/patmatch.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/eliza.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/eliza1.lisp
         the file /home/futrelle/csg120sp05/code/paip/eliza.lisp.
("eliza-pm")

Section 6.4 A Set of Searching Tools
> (requires "search")
; Loading /home/futrelle/csg120sp05/code/paip/search.lisp
("search")
; page 192
> (debug :search)
(:SEARCH)
We can search through the binary tree, looking for, say, 12 as the goal.
With breadth-first search this would yield an infinite loop, so we won't
do it.  Breadth-first search works better:
; page 193
> (breadth-first-search 1 (is 12) 'binary-tree)
;; Search: (1)
;; Search: (2 3)
;; Search: (3 4 5)
;; Search: (4 5 6 7)
;; Search: (5 6 7 8 9)
;; Search: (6 7 8 9 10 11)
;; Search: (7 8 9 10 11 12 13)
;; Search: (8 9 10 11 12 13 14 15)
;; Search: (9 10 11 12 13 14 15 16 17)
;; Search: (10 11 12 13 14 15 16 17 18 19)
;; Search: (11 12 13 14 15 16 17 18 19 20 21)
;; Search: (12 13 14 15 16 17 18 19 20 21 22 23)
12
; page 193
> (depth-first-search 1 (is 12) (finite-binary-tree 15))
;; Search: (1)
;; Search: (2 3)
;; Search: (4 5 3)
;; Search: (8 9 5 3)
;; Search: (9 5 3)
;; Search: (5 3)
;; Search: (10 11 3)
;; Search: (11 3)
;; Search: (3)
;; Search: (6 7)
;; Search: (12 13 7)
12
Guiding the Search
Best-first search takes an additional argument which estimates how close
we are to the goal.  We call this the cost function.
; page 195
> (best-first-search 1 (is 12) #'binary-tree (diff 12))
;; Search: (1)
;; Search: (3 2)
;; Search: (7 6 2)
;; Search: (14 15 6 2)
;; Search: (15 6 2 28 29)
;; Search: (6 2 28 29 30 31)
;; Search: (12 13 2 28 29 30 31)
12
> (best-first-search 1 (is 12) #'binary-tree (price-is-right 12))
;; Search: (1)
;; Search: (3 2)
;; Search: (7 6 2)
;; Search: (6 2 14 15)
;; Search: (12 2 13 14 15)
12
The function beam-search is just like best-first-search, except that after
we sort the states, we then take only the first beam-width states.
> (beam-search 1 (is 12) #'binary-tree (price-is-right 12) 2)
;; Search: (1)
;; Search: (3 2)
;; Search: (7 6)
;; Search: (6 14)
;; Search: (12 13)
12
As a concrete example of a problem that can be solved by search,
consider planning a flight across North America in a plane whose range is
limited to 1000 kilometers.  Here we plan a trip from SF to Boston.
; page 199
> (path-state (trip (city 'san-francisco) (city 'boston)))
;; Search: (#<Path to (SAN-FRANCISCO 122.26 37.47) cost 0.0>)
;; Search: (#<Path to (RENO 119.49 39.3) cost 4355.0>)
;; Search: (#<Path to (GRAND-JCT 108.37 39.05) cost 4427.3>)
;; Search: (#<Path to (DENVER 105.0 39.45) cost 4428.3>)
;; Search: (#<Path to (KANSAS-CITY 94.35 39.06) cost 4492.0>)
;; Search: (#<Path to (INDIANAPOLIS 86.1 39.46) cost 4507.1>)
;; Search: (#<Path to (PITTSBURGH 79.57 40.27) cost 4514.8>)
;; Search: (#<Path to (BOSTON 71.05 42.21) cost 4514.8>)
(BOSTON 71.05 42.21)
> (path-state (trip (city 'boston) (city 'san-francisco)))
;; Search: (#<Path to (BOSTON 71.05 42.21) cost 0.0>)
;; Search: (#<Path to (PITTSBURGH 79.57 40.27) cost 4418.4>)
;; Search: (#<Path to (CHICAGO 87.37 41.5) cost 4423.7>)
;; Search: (#<Path to (KANSAS-CITY 94.35 39.06) cost 4520.0>)
;; Search: (#<Path to (DENVER 105.0 39.45) cost 4521.4>)
;; Search: (#<Path to (GRAND-JCT 108.37 39.05) cost 4527.0>)
;; Search: (#<Path to (RENO 119.49 39.3) cost 4577.3>)
;; Search: (#<Path to (SAN-FRANCISCO 122.26 37.47) cost 4577.3>)
(SAN-FRANCISCO 122.26 37.47)
> (undebug :search)
NIL
; page 201
> (show-city-path (trip (city 'san-francisco) (city 'boston) 1))
#<Path 4514.8 km: San-Francisco - Reno - Grand-Jct - Denver - Kansas-City - Indianapolis - Pittsburgh - Boston>
NIL
> (show-city-path (trip (city 'boston) (city 'san-francisco) 1))
#<Path 4577.3 km: Boston - Pittsburgh - Chicago - Kansas-City - Denver - Grand-Jct - Reno - San-Francisco>
NIL
; page 202
> (show-city-path (trip (city 'boston) (city 'san-francisco) 3))
#<Path 4514.8 km: Boston - Pittsburgh - Indianapolis - Kansas-City - Denver - Grand-Jct - Reno - San-Francisco>
NIL
; page 205
> (iter-wide-search 1 (is 12) (finite-binary-tree 15) (diff 12))
12
; page 208
> (tree-search '(1) (is 6) #'next2 #'prepend)
6
> (graph-search '(1) (is 6) #'next2 #'prepend)
6
; page 210
> (path-states (a*-search (list (make-path :state 1)) (is 6) #'next2
                          #'(lambda (x y) 1) (diff 6)))
(6 5 3 1)

Section 6.5 GPS as Search
> (requires "gps-srch")
; Loading /home/futrelle/csg120sp05/code/paip/gps-srch.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/gps.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/gps1.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/search.lisp
("gps-srch")
; page 213
> (setf start
        '((c on a) (a on table) (b on table) (space on c) (space on b)
          (space on table)))
((C ON A) (A ON TABLE) (B ON TABLE) (SPACE ON C) (SPACE ON B)
 (SPACE ON TABLE))
> (use (make-block-ops '(a b c)))
18
; page 213
> (search-gps start '((a on b) (b on c)))
((START) (EXECUTING (MOVE C FROM A TO TABLE))
 (EXECUTING (MOVE B FROM TABLE TO C))
 (EXECUTING (MOVE A FROM TABLE TO B)))
> (search-gps start '((b on c) (a on b)))
((START) (EXECUTING (MOVE C FROM A TO TABLE))
 (EXECUTING (MOVE B FROM TABLE TO C))
 (EXECUTING (MOVE A FROM TABLE TO B)))

Chapter  6. Building Software Tools done.

Chapter  7. STUDENT: Solving Algebra Word Problems
STUDENT was another early language understanding program, written by Daniel
Bobrow in 1964.  It was designed to read and solve the kind of word
problems found in high school algebra books.

Section 7.1 Translating English into Equations
> (requires "student")
; Loading /home/futrelle/csg120sp05/code/paip/student.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/patmatch.lisp
("student")
; page 222
> (translate-to-expression '(if z is 3 |,| what is twice z))
((= Z 3) (= WHAT (* 2 Z)))

Section 7.2 Solving Algebra Equations
; page 229
> (trace isolate solve)
(SOLVE ISOLATE)
> (solve-equations '((= (+ 3 4) (* (- 5 (+ 2 x)) 7))
                     (= (+ (* 3 x) y) 12)))

The equations to be solved are:
   (3 + 4) = ((5 - (2 + X)) * 7)
   ((3 * X) + Y) = 12
 0: (SOLVE ((= (+ 3 4) (* (- 5 (+ 2 X)) 7)) (= (+ (* 3 X) Y) 12)) NIL)
   1: (ISOLATE (= (+ 3 4) (* (- 5 (+ 2 X)) 7)) X)
     2: (ISOLATE (= (* (- 5 (+ 2 X)) 7) (+ 3 4)) X)
       3: (ISOLATE (= (- 5 (+ 2 X)) (/ (+ 3 4) 7)) X)
         4: (ISOLATE (= (+ 2 X) (- 5 (/ (+ 3 4) 7))) X)
           5: (ISOLATE (= X (- (- 5 (/ (+ 3 4) 7)) 2)) X)
           5: returned (= X (- (- 5 (/ (+ 3 4) 7)) 2))
         4: returned (= X (- (- 5 (/ (+ 3 4) 7)) 2))
       3: returned (= X (- (- 5 (/ (+ 3 4) 7)) 2))
     2: returned (= X (- (- 5 (/ (+ 3 4) 7)) 2))
   1: returned (= X (- (- 5 (/ (+ 3 4) 7)) 2))
   1: (SOLVE ((= (+ (* 3 2) Y) 12)) ((= X 2)))
     2: (ISOLATE (= (+ (* 3 2) Y) 12) Y)
       3: (ISOLATE (= Y (- 12 (* 3 2))) Y)
       3: returned (= Y (- 12 (* 3 2)))
     2: returned (= Y (- 12 (* 3 2)))
     2: (SOLVE NIL ((= Y 6) (= X 2)))
     2: returned ((= Y 6) (= X 2))
   1: returned ((= Y 6) (= X 2))
 0: returned ((= Y 6) (= X 2))

The solution is:
   Y = 6
   X = 2
NIL
> (untrace isolate solve)
(ISOLATE SOLVE)

Section 7.3 Examples
; page 231
> (student '(if the
                number
              of
              customers
              tom
              gets
              is
              twice
              the
              square
              of
              20
              %
              of
              the
              number
              of
              advertisements
              he
              runs
              |,|
              and
              the
              number
              of
              advertisements
              is
              45
              |,|
              then
              what
              is
              the
              number
              of
              customers
              tom
              gets
              ?))

The equations to be solved are:
   CUSTOMERS = (2 *
                (((20 / 100) * ADVERTISEMENTS) *
                 ((20 / 100) * ADVERTISEMENTS)))
   ADVERTISEMENTS = 45
   WHAT = CUSTOMERS

The solution is:
   WHAT = 162
   CUSTOMERS = 162
   ADVERTISEMENTS = 45
NIL
> (student '(the daily cost of living for a group is the overhead cost
                 plus the running cost for each person times the number
                 of people in the group \. this cost for one group
                 equals $ 100 |,| and the number of people in the group
                 is 40 \. if the overhead cost is 10 times the running
                 cost |,| find the overhead and running cost for each
                 person \.))

The equations to be solved are:
   DAILY = (OVERHEAD + (RUNNING * PEOPLE))
   COST = 100
   PEOPLE = 40
   OVERHEAD = (10 * RUNNING)
   TO-FIND-1 = OVERHEAD
   TO-FIND-2 = RUNNING

The solution is:
   PEOPLE = 40
   COST = 100
NIL
> (student '(fran 's age divided by robin 's height is one half kelly
             's iq \. kelly 's iq minus 80 is robin 's height \. if
             robin is 4 feet tall |,| how old is fran ?))

The equations to be solved are:
   (FRAN / ROBIN) = (KELLY / 2)
   (KELLY - 80) = ROBIN
   ROBIN = 4
   HOW = FRAN

The solution is:
   HOW = 168
   FRAN = 168
   KELLY = 84
   ROBIN = 4
NIL
> (student '(fran 's age divided by robin 's height is one half kelly
             's iq \. kelly 's iq minus 80 is robin 's height \. if
             robin is 0 feet tall |,| how old is fran ?))

The equations to be solved are:
   (FRAN / ROBIN) = (KELLY / 2)
   (KELLY - 80) = ROBIN
   ROBIN = 0
   HOW = FRAN

The solution is:
   HOW = 0
   FRAN = 0
   KELLY = 80
   ROBIN = 0
NIL

Chapter  7. STUDENT: Solving Algebra Word Problems done.

Chapter  8. Symbolic Mathematics: A Simplification Program
'Symbolic mathematics' is to numerical mathematics as algebra is to
arithmetic: it deals with variables and expressions, not just numbers.
This chapter develops a program that simplifies algebraic expressions.
We then show that differentiation and even integration can be seen as
special cases of 'simplification.'  (Note that we replace calls to the
interactive function SIMPLIFIER with calls to the function SIMP.)

Section 8.2 Simplification Rules
> (requires "macsymar")
; Loading /home/futrelle/csg120sp05/code/paip/macsymar.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/macsyma.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/patmatch.lisp
("macsymar")
; page 245
> (simp '(2 + 2))
4
> (simp '(5 * 20 + 30 + 7))
137
> (simp '(5 * x - (4 + 1) * x))
0
> (simp '(y / z * (5 * x - (4 + 1) * x)))
0
> (simp '((4 - 3) * x + (y / y - 1) * z))
X
> (simp '(1 * f (x) + 0))
(F X)

Section 8.3 Associativity and Commutativity
; page 247
> (simp '(3 * 2 * x))
(6 * X)
> (simp '(2 * x * x * 3))
(6 * (X ^ 2))
> (simp '(2 * x * 3 * y * 4 * z * 5 * 6))
(720 * (X * (Y * Z)))
> (simp '(3 + x + 4 + x))
((2 * X) + 7)
> (simp '(2 * x * 3 * x * 4 * (1 / x) * 5 * 6))
(720 * X)

Section 8.4 Logs, Trig, and Differentiation
; page 250
> (simp '(d (x + x) / d x))
2
> (simp '(d (a * x ^ 2 + b * x + c) / d x))
((2 * (A * X)) + B)
For the next one, note we had an error in the first printing of the book;
the sign was reversed on the (d (u / v) ...) rule.
> (simp '(d ((a * x ^ 2 + b * x + c) / x) / d x))
(((X * ((2 * (A * X)) + B)) - ((A * (X ^ 2)) + ((B * X) + C))) /
 (X ^ 2))
> (simp '(log ((d (x + x) / d x) / 2)))
0
> (simp '(log (x + x) - log x))
(LOG 2)
> (simp '(x ^ cos pi))
(1 / X)
These next two examples were also affected by the (d (u / v) ...) rule.
> (simp '(d (3 * x + (cos x) / x) / d x))
((((X * (- (SIN X))) - (COS X)) / (X ^ 2)) + 3)
> (simp '(d ((cos x) / x) / d x))
(((X * (- (SIN X))) - (COS X)) / (X ^ 2))
> (simp '(d (3 * x ^ 2 + 2 * x + 1) / d x))
((6 * X) + 2)
> (simp '(sin (x + x) ^ 2 + cos (d x ^ 2 / d x) ^ 2))
1
> (simp '(sin (x + x) * sin (d x ^ 2 / d x) + cos (2 * x) * cos
              (x * d 2 * y / d y)))
1

Section 8.5 Limits of Rule-Based Approaches
In this section we return to some examples that pose problems.
For the following, we would prefer (2 * (x + y))
> (simp '(x + y + y + x))
(X + (Y + (Y + X)))
For the following, we would prefer (7 * X) and (Y + (8 * X)), respectively:
> (simp '(3 * x + 4 * x))
((3 * X) + (4 * X))
> (simp '(3 * x + y + x + 4 * x))
((3 * X) + (Y + (X + (4 * X))))
In chapter 15, we develop a new version of the program that handles this problem.

Section 8.6 Integration
; page 258
> (set-simp-fn 'int
               #'(lambda (exp) (integrate (exp-lhs exp) (exp-rhs exp))))
#<Interpreted Function (unnamed) @ #x44c90b2>
> (simp '(int x * sin (x ^ 2) d x))
(1/2 * (- (COS (X ^ 2))))
> (simp '(int ((3 * x ^ 3) - 1 / (3 * x ^ 3)) d x))
((3 * ((X ^ 4) / 4)) - (1/3 * ((X ^ -2) / -2)))
> (simp '(int (3 * x + 2) ^ -2/3 d x))
(((3 * X) + 2) ^ 1/3)
> (simp '(int sin (x) ^ 2 * cos (x) d x))
(((SIN X) ^ 3) / 3)
> (simp '(int sin (x) / (1 + cos (x)) d x))
(-1 * (LOG ((COS X) + 1)))
> (simp '(int (2 * x + 1) / (x ^ 2 + x - 1) d x))
(LOG ((X ^ 2) + (X - 1)))
> (simp '(int 8 * x ^ 2 / (x ^ 3 + 2) ^ 3 d x))
(8 * ((1/3 * (((X ^ 3) + 2) ^ -2)) / -2))
; page 259
> (set-simp-fn 'int
               #'(lambda (exp)
                   (unfactorize (factorize
                                 (integrate
                                  (exp-lhs exp)
                                  (exp-rhs exp))))))
#<Interpreted Function (unnamed) @ #x44bcca2>
> (simp '(int 8 * x ^ 2 / (x ^ 3 + 2) ^ 3 d x))
(-4/3 * (((X ^ 3) + 2) ^ -2))

Chapter  8. Symbolic Mathematics: A Simplification Program done.

Chapter  9. Efficiency Issues
One of the reasons Lisp has enjoyed a long history is because it is an
ideal language for what is called rapid-prototyping or rapid development.
Most real AI programs deal with large amounts of data.  Thus, efficiency
is important.  This chapter shows some ways to make programs efficient.

Section 9.1 Caching Results of Previous Computations: Memoization
; page 269
> (defun fib (n) (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))))
FIB
; page 270
> (setf memo-fib (memo #'fib))
#<Interpreted Closure (:INTERNAL MEMO) @ #x43a9222>
> (trace fib)
(FIB)
; page 270
> (funcall memo-fib 3)
 0: (FIB 2)
   1: (FIB 1)
   1: returned 1
   1: (FIB 0)
   1: returned 1
 0: returned 2
 0: (FIB 1)
 0: returned 1
3
> (funcall memo-fib 3)
3
> (untrace fib)
(FIB)
; page 272
> (memoize 'fib)
#<Interpreted Closure (:INTERNAL MEMO) @ #x43ad2ca>
> (trace fib)
(FIB)
> (fib 5)
 0: (FIB 5)
   1: (FIB 4)
     2: (FIB 3)
       3: (FIB 2)
         4: (FIB 1)
         4: returned 1
         4: (FIB 0)
         4: returned 1
       3: returned 2
       3: (FIB 1)
       3: returned 1
     2: returned 3
     2: (FIB 2)
     2: returned 2
   1: returned 5
   1: (FIB 3)
   1: returned 3
 0: returned 8
8
> (fib 5)
 0: (FIB 5)
 0: returned 8
8
> (fib 6)
 0: (FIB 6)
   1: (FIB 5)
   1: returned 8
   1: (FIB 4)
   1: returned 5
 0: returned 13
13
> (untrace fib)
(FIB)

Chapter  9. Efficiency Issues done.

Chapter 10. Low-Level Efficiency Issues
The efficiency techniques of the previous chapter all involved fairly
significant changes to an algorithm.  But what happens when you are already
using the best imaginable algorithms, and performance is still a problem?

Section 10.1 Use Declarations
Compare these functions with and without declarations:
; page 318
> (defun f (x y)
    (declare (fixnum x y) (optimize (safety 0) (speed 3)))
    (the fixnum (+ x y)))
F
> (defun g (x y) (+ x y))
G
Here is the disassembled code for f and g:
> (disassemble 'f)
;; disassembly of #<Function (:ANONYMOUS-LAMBDA 15) @ #x43b4412>
;; formals: X Y

;; code start: #x43b43ec:
   0: 90020009     add  %o0, %o1, %o0
   4: 86102001     mov  #x1, %g3
   8: 81c3e008     jmp  %o7 + 8
  12: 01000000     nop
NIL
; page 319
> (disassemble 'g)
;; disassembly of #<Function (:ANONYMOUS-LAMBDA 16) @ #x43b7502>
;; formals: X Y

;; code start: #x43b74a4:
   0: 9de3bf98     save %o6, #x-68, %o6
   4: 80a0e002     cmp  %g3, #x2
   8: 93d02010     tne  %g0, #x10
  12: 81100001     taddcctv     %g0, %g1, %g0
  16: 99060019     taddcc       %i0, %i1, %o4
  20: 2e800007     bvs,a        48
  24: 90100018     mov  %i0, %o0
  28: 9010000c     mov  %o4, %o0
  32: 86102001     mov  #x1, %g3
lb1:
  36: 81c7e008     jmp  %i7 + 8
  40: 91ea0000     restore      %o0, %g0, %o0
  44: 90100018     mov  %i0, %o0
lb2:
  48: c4013f87     ld   [%g4 + -121], %g2       ; EXCL::+_2OP
  52: 92100019     mov  %i1, %o1
  56: 9fc1200b     jmpl %g4 + 11, %o7
  60: 86182002     xor  %g0, #x2, %g3
  64: 10bffff9     ba   36
  68: 01000000     nop
NIL

Chapter 10. Low-Level Efficiency Issues done.

Chapter 11. Logic Programming
The idea behind logic programming is that the programmer should state the
relationships that describe a problem and its solution.
In this chapter we develop an interpreter for the Prolog language.

Section 11.1 Idea 1: A Uniform Data Base
> (requires "prolog1")
; Loading /home/futrelle/csg120sp05/code/paip/prolog1.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/unify.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/patmatch.lisp
("prolog1")
First let's make sure we're dealing with a brand new database.
> (clear-db)
NIL
Facts are entered into the data base with the <- macro
; page 350
> (<- (likes kim robin))
LIKES
> (<- (likes sandy lee))
LIKES
> (<- (likes sandy kim))
LIKES
> (<- (likes robin cats))
LIKES
We can also enter rules, which state contingent facts.
; page 351
> (<- (likes sandy ?x) (likes ?x cats))
LIKES
> (<- (likes kim ?x) (likes ?x lee) (likes ?x kim))
LIKES

Section 11.2 Idea 2: Unification of Logic Variables
> (requires "unify")
; Loading /home/futrelle/csg120sp05/code/paip/unify.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/patmatch.lisp
("unify")
; page 352
> (pat-match '(?x + ?y) '(2 + 1))
((?Y . 1) (?X . 2))
> (unify '(?x + 1) '(2 + ?y))
((?Y . 1) (?X . 2))
> (unify '(f ?x) '(f ?y))
((?X . ?Y))
> (unify '(?a + ?a = 0) '(?x + ?y = ?y))
((?Y . 0) (?X . ?Y) (?A . ?X))
> (unifier '(?a + ?a = 0) '(?x + ?y = ?y))
(0 + 0 = 0)
Let's try UNIFY on some (more) examples:
; page 357
> (unify '(?x ?y a) '(?y ?x ?x))
((?Y . A) (?X . ?Y))
> (unify '?x '(f ?x))
NIL
> (unify 'a 'a)
((T . T))
Here are some examples of UNIFIER:
> (unifier '(?x ?y a) '(?y ?x ?x))
(A A A)
> (unifier '((?a * ?x ^ 2) + (?b * ?x) + ?c) '(?z + (4 * 5) + 3))
((?A * 5 ^ 2) + (4 * 5) + 3)
Programming with Prolog
First we define the MEMBER relation in Prolog:
; page 358
> (<- (member ?item (?item . ?rest)))
MEMBER
> (<- (member ?item (?x . ?rest)) (member ?item ?rest))
MEMBER
Now we can make some queries:
> (?- (member 2 (1 2 3)))
Yes;
NIL
> (?- (member 2 (1 2 3 2 1)))
Yes;
Yes;
NIL
> (?- (member ?x (1 2 3)))
?X = 1;
?X = 2;
?X = 3;
NIL
Let's add one more rule to the Sandy and the cats facts:
; page 363
> (<- (likes ?x ?x))
LIKES
Now we can ask some queries:
; page 365
> (?- (likes sandy ?who))
?WHO = LEE;
?WHO = KIM;
?WHO = ROBIN;
?WHO = SANDY;
?WHO = CATS;
?WHO = SANDY;
NIL
> (?- (likes ?who sandy))
?WHO = SANDY;
?WHO = KIM;
?WHO = SANDY;
NIL
> (?- (likes robin lee))
No.
NIL
; page 366
> (?- (likes ?x ?y) (likes ?y ?x))
?Y = KIM
?X = SANDY;
?Y = SANDY
?X = SANDY;
?Y = SANDY
?X = SANDY;
?Y = SANDY
?X = KIM;
?Y = SANDY
?X = SANDY;
?Y = ?X8711
?X = ?X8711;
NIL

Section 11.3 Idea 3: Automatic Backtracking
Now we load the version that does automatic backtracking one step at a time
as opposed to the previous version, which collects all answers at once.
Since we don't want to involve you, the user, in typing input to move on
to the next step, we supply the input (a ; or a .) as in the book.
Unfortunately, it is not specified in Common Lisp whether read-char echoes
the character it reads, so you may or may not see the ; and . characters.
> (requires "prolog")
; Loading /home/futrelle/csg120sp05/code/paip/prolog.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/unify.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/patmatch.lisp
("prolog")
Let's add the definition of the relation LENGTH:
; page 370
> (<- (length nil 0))
LENGTH
> (<- (length (?x . ?y) (1+ ?n)) (length ?y ?n))
LENGTH
Here are some queries:
> (?- (length (a b c d) ?n))
?N = (1+ (1+ (1+ (1+ 0))))
No.
NIL
> (?- (length ?list (1+ (1+ 0))))
?LIST = (?X8999 ?X9002)
No.
NIL
> (?- (length ?list ?n))
?LIST = NIL
?N = 0
?LIST = (?X9014)
?N = (1+ 0)
?LIST = (?X9014 ?X9018)
?N = (1+ (1+ 0))
No.
NIL
> (?- (length ?l (1+ (1+ 0))) (member a ?l))
?L = (A ?X9029)
?L = (?X9035 A)
No.
NIL
(We won't try the example that leads to an infinite loop.)

Section 11.4 The Zebra Puzzle
First we define the NEXTO and IRIGHT (to the immediate right) relations:
; page 374
> (<- (nextto ?x ?y ?list) (iright ?x ?y ?list))
NEXTTO
> (<- (nextto ?x ?y ?list) (iright ?y ?x ?list))
NEXTTO
> (<- (iright ?left ?right (?left ?right . ?rest)))
IRIGHT
> (<- (iright ?left ?right (?x . ?rest)) (iright ?left ?right ?rest))
IRIGHT
> (<- (= ?x ?x))
=
Now we define the zebra puzzle:
> (<- (zebra ?h ?w ?z)
      (= ?h ((house norwegian ? ? ? ?) ? (house ? ? ? milk ?) ? ?))
      (member (house englishman ? ? ? red) ?h)
      (member (house spaniard dog ? ? ?) ?h)
      (member (house ? ? ? coffee green) ?h)
      (member (house ukrainian ? ? tea ?) ?h)
      (iright (house ? ? ? ? ivory) (house ? ? ? ? green) ?h)
      (member (house ? snails winston ? ?) ?h)
      (member (house ? ? kools ? yellow) ?h)
      (nextto (house ? ? chesterfield ? ?) (house ? fox ? ? ?) ?h)
      (nextto (house ? ? kools ? ?) (house ? horse ? ? ?) ?h)
      (member (house ? ? luckystrike oj ?) ?h)
      (member (house japanese ? parliaments ? ?) ?h)
      (nextto (house norwegian ? ? ? ?) (house ? ? ? ? blue) ?h)
      (member (house ?w ? ? water ?) ?h)
      (member (house ?z zebra ? ? ?) ?h))
ZEBRA
If you want to test this out, run the following query:
   ((?- (zebra ?houses ?water-drinker ?zebra-owner)))
It is not included as an example because it takes a minute or so to run.

Chapter 11. Logic Programming done.

Chapter 12. Compiling Logic Programs
This chapter presents a compiler that translates from Prolog to Lisp.
Unfortunatley, there's not much to see in terms of examples.
But we load the files for you, in case you want to play with them.
> (requires "prologc1" "prologc2" "prologcp")
; Loading /home/futrelle/csg120sp05/code/paip/prologc1.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/prolog.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/unify.lisp
;       Loading /home/futrelle/csg120sp05/code/paip/patmatch.lisp
; Loading /home/futrelle/csg120sp05/code/paip/prologc2.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/prolog.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/unify.lisp
;       Loading /home/futrelle/csg120sp05/code/paip/patmatch.lisp
; Loading /home/futrelle/csg120sp05/code/paip/prologcp.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/prologc.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/prolog.lisp
;       Loading /home/futrelle/csg120sp05/code/paip/unify.lisp
;         Loading /home/futrelle/csg120sp05/code/paip/patmatch.lisp
("prologc1" "prologc2" "prologcp")
; page 389
> (prolog-compile 'likes)
NIL
> (prolog-compile 'member)
NIL

Chapter 12. Compiling Logic Programs done.

Chapter 13. Object Oriented Programming
It is only natural that a wide range of programming styles have been
introduced to attack the wide range of problems in this book.
One style not yet covered is 'object-oriented programming'.
Peter Wegner (1987) proposes the following formula as a definition:
Object-orientation = Objects + Classes + Inheritance

Section 13.2 Objects
Now we're ready to get started.
> (requires "clos")
; Loading /home/futrelle/csg120sp05/code/paip/clos.lisp
("clos")
; page 438
> (setf acct (new-account "J. Random Customer" 1000.0))
#<Interpreted Closure (:INTERNAL NEW-ACCOUNT) @ #x44f2842>
> (send acct 'withdraw 500.0)
500.0
> (send acct 'deposit 123.45)
623.45
> (send acct 'name)
"J. Random Customer"
> (send acct 'balance)
623.45

Section 13.4 Classes
Now we define the class ACCOUNT with the define-class macro.
; page 440
> (define-class account (name &optional (balance 0.0))
                ((interest-rate 0.06))
                (withdraw (amt)
                          (if (<= amt balance)
                              (decf balance amt)
                            'insufficient-funds))
                (deposit (amt) (incf balance amt))
                (balance nil balance) (name nil name)
                (interest nil (incf balance (* interest-rate balance))))
ACCOUNT
Here are the generic functions defined by this macro:
> (setf acct2 (account "A. User" 2000.0))
#<Interpreted Closure (:INTERNAL ACCOUNT) @ #x43b07d2>
> (deposit acct2 42.0)
2042.0
> (interest acct2)
2164.52
; page 441
> (balance acct2)
2164.52
> (balance acct)
623.45

Section 13.5 Delegation
> (define-class password-account (password acct) nil
                (change-password (pass new-pass)
                 (if (equal pass password)
                     (setf password new-pass)
                   'wrong-password))
                (otherwise (pass &rest args)
                 (if (equal pass password)
                     (apply message acct args)
                   'wrong-password)))
PASSWORD-ACCOUNT
Now we see how the class PASSWORD-ACCOUNT can be used to provide protection
for an existing account:
; page 441
> (setf acct3 (password-account "secret" acct2))
#<Interpreted Closure (:INTERNAL PASSWORD-ACCOUNT) @ #x43b1e92>
> (balance acct3 "secret")
2164.52
> (withdraw acct3 "guess" 2000.0)
WRONG-PASSWORD
> (withdraw acct3 "secret" 2000.0)
164.52002

Section 13.7 CLOS: The Common Lisp Object System
Because some Lisp implementations can't convert a structure class into
a CLOS class, nor convert a regular function into a generic function,
we use the names account*, name*, balance*, interest-rate*.  If you were
doing a real application, not just some examples, you would choose one
implementation and get to use the regular names.
; page 445
> (defclass account* nil
            ((name :initarg :name :reader name*)
             (balance :initarg :balance :initform 0.0 :accessor
                      balance*)
             (interest-rate :allocation :class :initform 0.06 :reader
              interest-rate*)))
#<STANDARD-CLASS ACCOUNT*>
; page 446
> (setf a1 (make-instance 'account* :balance 5000.0 :name "Fred"))
#<ACCOUNT* @ #x43b3bc2>
> (name* a1)
"Fred"
> (balance* a1)
5000.0
> (interest-rate* a1)
0.06
; page 446
> (defmethod withdraw* ((acct account*) amt)
    (if (< amt (balance* acct))
        (decf (balance* acct) amt)
      'insufficient-funds))
#<STANDARD-METHOD WITHDRAW* (ACCOUNT* T)>
> (defclass limited-account (account*)
            ((limit :initarg :limit :reader limit)))
#<STANDARD-CLASS LIMITED-ACCOUNT>
> (defmethod withdraw* ((acct limited-account) amt)
    (if (> amt (limit acct)) 'over-limit (call-next-method)))
#<STANDARD-METHOD WITHDRAW* (LIMITED-ACCOUNT T)>
; page 447
> (setf a2
        (make-instance 'limited-account :name "A. Thrifty Spender"
                       :balance 500.0 :limit 100.0))
#<LIMITED-ACCOUNT @ #x43b5b12>
> (name* a2)
"A. Thrifty Spender"
> (withdraw* a2 200.0)
OVER-LIMIT
> (withdraw* a2 20.0)
480.0

Section 13.8 A CLOS Example: Searching Tools
; page 449
> (defclass problem nil
            ((states :initarg :states :accessor problem-states)))
#<STANDARD-CLASS PROBLEM>
> (defmethod searcher ((prob problem))
    "Find a state that solves the search problem."
    (cond ((no-states-p prob) fail)
          ((goal-p prob) (current-state prob))
          (t
           (let ((current (pop-state prob)))
             (setf (problem-states prob)
                   (problem-combiner prob
                    (problem-successors prob current)
                    (problem-states prob))))
           (searcher prob))))
#<STANDARD-METHOD SEARCHER (PROBLEM)>
> (defmethod current-state ((prob problem))
    "The current state is the first of the possible states."
    (first (problem-states prob)))
#<STANDARD-METHOD CURRENT-STATE (PROBLEM)>
> (defmethod pop-state ((prob problem))
    "Remove and return the current state." (pop (problem-states prob)))
#<STANDARD-METHOD POP-STATE (PROBLEM)>
> (defmethod no-states-p ((prob problem))
    "Are there any more unexplored states?"
    (null (problem-states prob)))
#<STANDARD-METHOD NO-STATES-P (PROBLEM)>
; page 450
> (defmethod searcher :before ((prob problem))
    (dbg 'search "~&;; Search: ~a" (problem-states prob)))
#<STANDARD-METHOD SEARCHER :BEFORE (PROBLEM)>
> (defclass eql-problem (problem)
            ((goal :initarg :goal :reader problem-goal)))
#<STANDARD-CLASS EQL-PROBLEM>
> (defmethod goal-p ((prob eql-problem))
    (eql (current-state prob) (problem-goal prob)))
#<STANDARD-METHOD GOAL-P (EQL-PROBLEM)>
> (defclass dfs-problem (problem) nil
            (:documentation "Depth-first search problem."))
#<STANDARD-CLASS DFS-PROBLEM>
> (defclass bfs-problem (problem) nil
            (:documentation "Breadth-first search problem."))
#<STANDARD-CLASS BFS-PROBLEM>
> (defmethod problem-combiner ((prob dfs-problem) new old)
    "Depth-first search looks at new states first." (append new old))
#<STANDARD-METHOD PROBLEM-COMBINER (DFS-PROBLEM T T)>
> (defmethod problem-combiner ((prob bfs-problem) new old)
    "Depth-first search looks at old states first." (append old new))
#<STANDARD-METHOD PROBLEM-COMBINER (BFS-PROBLEM T T)>
; page 451
> (defclass binary-tree-problem (problem) nil)
#<STANDARD-CLASS BINARY-TREE-PROBLEM>
> (defmethod problem-successors ((prob binary-tree-problem) state)
    (let ((n (* 2 state))) (list n (+ n 1))))
#<STANDARD-METHOD PROBLEM-SUCCESSORS (BINARY-TREE-PROBLEM T)>
> (defclass binary-tree-eql-bfs-problem
            (binary-tree-problem eql-problem bfs-problem) nil)
#<STANDARD-CLASS BINARY-TREE-EQL-BFS-PROBLEM>
> (setf p1
        (make-instance 'binary-tree-eql-bfs-problem :states '(1) :goal
                       12))
#<BINARY-TREE-EQL-BFS-PROBLEM @ #x44d3f5a>
> (searcher p1)
12
; page 452
> (defclass best-problem (problem) nil
            (:documentation "A Best-first search problem."))
#<STANDARD-CLASS BEST-PROBLEM>
> (defmethod problem-combiner ((prob best-problem) new old)
    "Best-first search sorts new and old according to cost-fn."
    (sort (append new old) #'<
      :key #'(lambda (state) (cost-fn prob state))))
#<STANDARD-METHOD PROBLEM-COMBINER (BEST-PROBLEM T T)>
> (defmethod cost-fn ((prob eql-problem) state)
    (abs (- state (problem-goal prob))))
#<STANDARD-METHOD COST-FN (EQL-PROBLEM T)>
> (defclass beam-problem (problem)
            ((beam-width :initarg :beam-width :initform nil :reader
              problem-beam-width)))
#<STANDARD-CLASS BEAM-PROBLEM>
> (defmethod problem-combiner :around ((prob beam-problem) new old)
    (let ((combined (call-next-method)))
      (subseq combined 0
              (min (problem-beam-width prob) (length combined)))))
#<STANDARD-METHOD PROBLEM-COMBINER :AROUND (BEAM-PROBLEM T T)>
> (defclass binary-tree-eql-best-beam-problem
            (binary-tree-problem eql-problem best-problem beam-problem)
            nil)
#<STANDARD-CLASS BINARY-TREE-EQL-BEST-BEAM-PROBLEM>
> (setf p3
        (make-instance 'binary-tree-eql-best-beam-problem :states '(1)
                       :goal 12 :beam-width 3))
#<BINARY-TREE-EQL-BEST-BEAM-PROBLEM @ #x44d7b42>
> (searcher p3)
12
; page 453
> (defclass trip-problem (binary-tree-eql-best-beam-problem)
            ((beam-width :initform 1)))
#<STANDARD-CLASS TRIP-PROBLEM>
> (defmethod cost-fn ((prob trip-problem) city)
    (air-distance (problem-goal prob) city))
#<STANDARD-METHOD COST-FN (TRIP-PROBLEM T)>
> (defmethod problem-successors ((prob trip-problem) city)
    (neighbors city))
#<STANDARD-METHOD PROBLEM-SUCCESSORS (TRIP-PROBLEM T)>
> (setf p4
        (make-instance 'trip-problem :states (list (city 'new-york))
                       :goal (city 'san-francisco)))
#<TRIP-PROBLEM @ #x44e107a>
> (searcher p4)
(SAN-FRANCISCO 122.26 37.47)

Section 13.9 Is CLOS Object-oriented?
; page 454
> (defmethod conc ((x null) y) y)
#<STANDARD-METHOD CONC (NULL T)>
> (defmethod conc (x (y null)) x)
#<STANDARD-METHOD CONC (T NULL)>
> (defmethod conc ((x list) (y list))
    (cons (first x) (conc (rest x) y)))
#<STANDARD-METHOD CONC (LIST LIST)>
> (defmethod conc ((x vector) (y vector))
    (let ((vect (make-array (+ (length x) (length y)))))
      (replace vect x)
      (replace vect y :start1 (length x))))
#<STANDARD-METHOD CONC (VECTOR VECTOR)>
; page 455
> (conc nil '(a b c))
(A B C)
> (conc '(a b c) nil)
(A B C)
> (conc '(a b c) '(d e f))
(A B C D E F)
> (conc '#(a b c) '#(d e f))
#(A B C D E F)

Chapter 13. Object Oriented Programming done.

Chapter 14. Knowledge Representation and Reasoning
In this chapter we explore means of indexing facts so that they can be
retrieved and reasoned with efficiently.
Section 14.1 to 14.7 discuss problems with logical reasoning systems
such as Prolog.

Section 14.8 A Solution to the Indexing Problem
Here we show how to index facts in a kind of table that makes it easy to
add, delete, and retrieve entries.  We will develop an extension of the
trie or discrimination tree data structure built in section 10.5 (page 344).
> (requires "krep1")
; Loading /home/futrelle/csg120sp05/code/paip/krep1.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/prolog.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/unify.lisp
;       Loading /home/futrelle/csg120sp05/code/paip/patmatch.lisp
("krep1")
Now we define a function to test the indexing routine.  Compare the output
with figure 14.1 on page 474.
; page 478
> (test-index)
((#6=(P A B) #5=(P A C) #4=(P A ?X) #3=(P B C) #2=(P B (F C))
  #1=(P A (F . ?X)))
 #(#(NIL NIL ((P 6 #1# #2# #3# #4# #5# #6#)) (0))
   #(#(NIL NIL ((B 2 #2# #3#) (A 4 #1# #4# #5# #6#)) (0))
     #(#(#(NIL NIL ((F 2 #1# #2#)) (0))
         #(#(NIL NIL ((C 1 #2#)) (0)) #(NIL NIL NIL (0)) NIL (1 #1#))
         ((C 2 #3# #5#) (B 1 #6#)) (1 #4#))
       #(NIL NIL NIL (0)) NIL (0))
     NIL (0))
   NIL (0)))
NIL
Here is an example of fetching from the index
; page 480
> (fetch '(p ? c))
(((P B C) (P A C)) ((P A ?X)))
We can make a change to rename variables before indexing facts.
; page 481
> (defun index (key)
    "Store key in a dtree node.  Key must be (predicate . args);
  it is stored in the predicate's dtree."
    (dtree-index key (rename-variables key)
                 (get-dtree (predicate key))))
INDEX
We have to reindex:
> (test-index)
((#4=(P A B) #3=(P A C) (P A ?X) #2=(P B C) #1=(P B (F C))
  (P A (F . ?X)))
 #(#(NIL NIL
     ((P 6 #5=(P A (F . #:?X11874)) #1# #2# #6=(P A #:?X11819) #3#
       #4#))
     (0))
   #(#(NIL NIL ((B 2 #1# #2#) (A 4 #5# #6# #3# #4#)) (0))
     #(#(#(NIL NIL ((F 2 #5# #1#)) (0))
         #(#(NIL NIL ((C 1 #1#)) (0)) #(NIL NIL NIL (0)) NIL (1 #5#))
         ((C 2 #2# #3#) (B 1 #4#)) (1 #6#))
       #(NIL NIL NIL (0)) NIL (0))
     NIL (0))
   NIL (0)))
NIL
We are now ready to test the retrieval mechanism:
; page 481
> (fetch '(p ?x c))
(((P B C) (P A C)) ((P A #:?X11819)))
; page 481
> (retrieve '(p ?x c))
(((#:?X11819 . C) (?X . A)) ((?X . A)) ((?X . B)))
> (retrieve-matches '(p ?x c))
((P A C) (P A C) (P B C))
> (retrieve-matches '(p ?x (?fn c)))
((P A (?FN C)) (P A (F C)) (P B (F C)))
; page 482
> (query-bind (?x ?fn) '(p ?x (?fn c))
              (format t "~&P holds between ~a and ~a of c." ?x ?fn))
P holds between B and F of c.
P holds between A and F of c.
P holds between A and ?FN of c.
NIL

Section 14.10 Solutions to the Expressiveness Problems
In this section we introduce a frame-like language, using the primitives
sub, rel, ind, val, and and.
> (requires "krep")
; Loading /home/futrelle/csg120sp05/code/paip/krep.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/krep2.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/krep1.lisp
;       Loading /home/futrelle/csg120sp05/code/paip/prolog.lisp
;         Loading /home/futrelle/csg120sp05/code/paip/unify.lisp
;           Loading /home/futrelle/csg120sp05/code/paip/patmatch.lisp
("krep")
We add some facts about dogs and bears, both as individuals and species:
; page 488
> (add-fact '(sub dog animal))
T
> (add-fact '(sub bear animal))
T
> (add-fact '(ind fido dog))
T
> (add-fact '(ind yogi bear))
T
> (add-fact '(val color yogi brown))
T
> (add-fact '(val color fido golden))
T
> (add-fact '(val latin-name bear ursidae))
T
> (add-fact '(val latin-name dog canis-familiaris))
T
Now retrieve-fact is used to answer three questions: What kinds of animals
are there?
> (retrieve-fact '(sub ?kind animal))
(((?KIND . DOG)) ((?KIND . BEAR)))
What are the Latin names of each kind of animal?
> (retrieve-fact '(and (sub ?kind animal)
                       (val latin-name ?kind ?latin)))
(((?LATIN . CANIS-FAMILIARIS) (?KIND . DOG))
 ((?LATIN . URSIDAE) (?KIND . BEAR)))
What are the colors of each individual bear?
; page 489
> (retrieve-fact '(and (ind ?x bear) (val color ?x ?c)))
(((?C . BROWN) (?X . YOGI)))
; page 492
> (test-bears)
 0: (INDEX (SUB BEAR ANIMAL))
 0: returned T
 0: (INDEX (SUB BEAR THING))
 0: returned T
 0: (INDEX (SUB GRIZZLY THING))
 0: returned T
 0: (INDEX (SUB POLAR-BEAR THING))
 0: returned T
 0: (INDEX (SUB BEAR LIVING-THING))
 0: returned T
 0: (INDEX (SUB GRIZZLY LIVING-THING))
 0: returned T
 0: (INDEX (SUB POLAR-BEAR LIVING-THING))
 0: returned T
 0: (INDEX (SUB GRIZZLY ANIMAL))
 0: returned T
 0: (INDEX (SUB POLAR-BEAR ANIMAL))
 0: returned T
 0: (INDEX (IND LARS LIVING-THING))
 0: returned T
 0: (INDEX (IND HELGA LIVING-THING))
 0: returned T
 0: (INDEX (IND YOGI LIVING-THING))
 0: returned T
 0: (INDEX (IND LARS THING))
 0: returned T
 0: (INDEX (IND HELGA THING))
 0: returned T
 0: (INDEX (IND YOGI THING))
 0: returned T
 0: (INDEX (IND LARS ANIMAL))
 0: returned T
 0: (INDEX (IND HELGA ANIMAL))
 0: returned T
 0: (INDEX (IND YOGI ANIMAL))
 0: returned T
(INDEX)

Chapter 14. Knowledge Representation and Reasoning done.

Chapter 15. Symbolic Mathematics with Canonical Forms
This chapter uses a canonical representation for polynomials
to achieve a more efficient program than the rules-based one in Chapter 8.

Section 15.1 A Canonical Form for Polynomials
> (requires "cmacsyma")
; Loading /home/futrelle/csg120sp05/code/paip/cmacsyma.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/macsyma.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/patmatch.lisp
("cmacsyma")
We represent polynomials as vectors, with the variable in element 0,
and the coefficients starting in element 1 and going up from there.
Here is the representation of 5x^3 + 10x^2 + 20x + 30
; page 511
> '#(x 30 20 10 5)
#(X 30 20 10 5)
Here are some examples (without the interactive loop):
; page 521
> (canon '(3 + x + 4 - x))
7
> (canon '(x + y + y + x))
((2 * X) + (2 * Y))
> (canon '(3 * x + 4 * x))
(7 * X)
> (canon '(3 * x + y + x + 4 * x))
((8 * X) + Y)
> (canon '((x + 1) ^ 10))
((X ^ 10) + (10 * (X ^ 9)) + (45 * (X ^ 8)) + (120 * (X ^ 7)) +
 (210 * (X ^ 6)) + (252 * (X ^ 5)) + (210 * (X ^ 4)) + (120 * (X ^ 3))
 + (45 * (X ^ 2)) + (10 * X) + 1)
> (canon '((x + 1) ^ 10 - (x - 1) ^ 10))
((20 * (X ^ 8)) + (240 * (X ^ 7)) + (504 * (X ^ 5)) + (240 * (X ^ 3)) +
 (20 * X))
; page 522
> (canon '(d (3 * x ^ 2 + 2 * x + 1) / d x))
((6 * X) + 2)
> (canon '(d (z + 3 * x + 3 * z * x ^ 2 + z ^ 2 * x ^ 3) / d z))
(((2 * Z) * (X ^ 3)) + (3 * (X ^ 2)) + 1)

Chapter 15. Symbolic Mathematics with Canonical Forms done.

Chapter 16. Expert Systems
In this chapter we develop an expert system shell, and give it a few rules
about infectious disease, thus duplicating some of the Mycin system.
> (requires "mycin-r")
; Loading /home/futrelle/csg120sp05/code/paip/mycin-r.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/mycin.lisp
("mycin-r")
Because this is an interactive system, we can't show the interaction here.
You can try it yourself by evaluating (mycin)

Chapter 16. Expert Systems done.

Chapter 17. Line Diagram Labelling by Constraint Satisfaction
In this chapter we look at the line-diagram labeling problem: Given a list
of lines and the vertexes at which they intersect, how can we determine
what the lines represent?
> (requires "waltz")
; Loading /home/futrelle/csg120sp05/code/paip/waltz.lisp
("waltz")

Section 17.2 Combining Constraints and Searching
First let's test that we can find the possible labelings for a vertex class:
; page 574
> (possible-labelings 'y)
((+ + +) (- - -) (L R -) (- L R) (R - L))
Notice how matrix-transpose works:
> (matrix-transpose (possible-labelings 'y))
((+ - L - R) (+ - R L -) (+ - - R L))
; page 575
> (defdiagram cube (a y b c d) (b w g e a) (c w e f a) (d w f g a)
              (e l c b) (f l d c) (g l b d))
CUBE

Section 17.3 Labelling Diagrams
We are now ready to try labelling diagrams.  First the cube:
; page 577
> (print-labelings (diagram 'cube))
The initial diagram is:
   A/5 Y: AB=[+-L-R] AC=[+-RL-] AD=[+--RL]
   B/3 W: BG=[L-+] BE=[R-+] BA=[++-]
   C/3 W: CE=[L-+] CF=[R-+] CA=[++-]
   D/3 W: DF=[L-+] DG=[R-+] DA=[++-]
   E/6 L: EC=[RL+L-R] EB=[LRR+L-]
   F/6 L: FD=[RL+L-R] FC=[LRR+L-]
   G/6 L: GB=[RL+L-R] GD=[LRR+L-]
For 29,160 interpretations.

After constraint propagation the diagram is:
   A/1 Y: AB=[+] AC=[+] AD=[+]
   B/2 W: BG=[L-] BE=[R-] BA=[++]
   C/2 W: CE=[L-] CF=[R-] CA=[++]
   D/2 W: DF=[L-] DG=[R-] DA=[++]
   E/3 L: EC=[R-R] EB=[LL-]
   F/3 L: FD=[R-R] FC=[LL-]
   G/3 L: GB=[R-R] GD=[LL-]
For 216 interpretations.

There are four solutions:

Diagram:
   A/1 Y: AB=[+] AC=[+] AD=[+]
   B/1 W: BG=[L] BE=[R] BA=[+]
   C/1 W: CE=[L] CF=[R] CA=[+]
   D/1 W: DF=[L] DG=[R] DA=[+]
   E/1 L: EC=[R] EB=[L]
   F/1 L: FD=[R] FC=[L]
   G/1 L: GB=[R] GD=[L]

Diagram:
   A/1 Y: AB=[+] AC=[+] AD=[+]
   B/1 W: BG=[L] BE=[R] BA=[+]
   C/1 W: CE=[L] CF=[R] CA=[+]
   D/1 W: DF=[-] DG=[-] DA=[+]
   E/1 L: EC=[R] EB=[L]
   F/1 L: FD=[-] FC=[L]
   G/1 L: GB=[R] GD=[-]

Diagram:
   A/1 Y: AB=[+] AC=[+] AD=[+]
   B/1 W: BG=[L] BE=[R] BA=[+]
   C/1 W: CE=[-] CF=[-] CA=[+]
   D/1 W: DF=[L] DG=[R] DA=[+]
   E/1 L: EC=[-] EB=[L]
   F/1 L: FD=[R] FC=[-]
   G/1 L: GB=[R] GD=[L]

Diagram:
   A/1 Y: AB=[+] AC=[+] AD=[+]
   B/1 W: BG=[-] BE=[-] BA=[+]
   C/1 W: CE=[L] CF=[R] CA=[+]
   D/1 W: DF=[L] DG=[R] DA=[+]
   E/1 L: EC=[R] EB=[-]
   F/1 L: FD=[R] FC=[L]
   G/1 L: GB=[-] GD=[L]
NIL
The cube should have given four solutions.
We can get down to one solution by grounding line GD:
; page 580
> (print-labelings (ground (diagram 'cube) 'g 'd))
The initial diagram is:
   A/5 Y: AB=[+-L-R] AC=[+-RL-] AD=[+--RL]
   B/3 W: BG=[L-+] BE=[R-+] BA=[++-]
   C/3 W: CE=[L-+] CF=[R-+] CA=[++-]
   D/3 W: DF=[L-+] DG=[R-+] DA=[++-]
   E/6 L: EC=[RL+L-R] EB=[LRR+L-]
   F/6 L: FD=[RL+L-R] FC=[LRR+L-]
   G/1 L: GB=[R] GD=[-]
For 4,860 interpretations.

After constraint propagation the diagram is:
   A/1 Y: AB=[+] AC=[+] AD=[+]
   B/1 W: BG=[L] BE=[R] BA=[+]
   C/1 W: CE=[L] CF=[R] CA=[+]
   D/1 W: DF=[-] DG=[-] DA=[+]
   E/1 L: EC=[R] EB=[L]
   F/1 L: FD=[-] FC=[L]
   G/1 L: GB=[R] GD=[-]
NIL
For the more complex cube on a plate, we get similar results;
Four interpretations, which turn to one after grounding line KM:
; page 581
> (defdiagram cube-on-plate (a y b c d) (b w g e a) (c w e f a)
              (d w f g a) (e l c b) (f y d c i) (g y b d h) (h w l g j)
              (i w f m j) (j y h i k) (k w m l j) (l l h k) (m l k i))
CUBE-ON-PLATE
; page 582
> (print-labelings (ground (diagram 'cube-on-plate) 'k 'm))
The initial diagram is:
   A/5 Y: AB=[+-L-R] AC=[+-RL-] AD=[+--RL]
   B/3 W: BG=[L-+] BE=[R-+] BA=[++-]
   C/3 W: CE=[L-+] CF=[R-+] CA=[++-]
   D/3 W: DF=[L-+] DG=[R-+] DA=[++-]
   E/6 L: EC=[RL+L-R] EB=[LRR+L-]
   F/5 Y: FD=[+-L-R] FC=[+-RL-] FI=[+--RL]
   G/5 Y: GB=[+-L-R] GD=[+-RL-] GH=[+--RL]
   H/3 W: HL=[L-+] HG=[R-+] HJ=[++-]
   I/3 W: IF=[L-+] IM=[R-+] IJ=[++-]
   J/5 Y: JH=[+-L-R] JI=[+-RL-] JK=[+--RL]
   K/1 W: KM=[-] KL=[-] KJ=[+]
   L/6 L: LH=[RL+L-R] LK=[LRR+L-]
   M/6 L: MK=[RL+L-R] MI=[LRR+L-]
For 32,805,000 interpretations.

After constraint propagation the diagram is:
   A/1 Y: AB=[+] AC=[+] AD=[+]
   B/1 W: BG=[L] BE=[R] BA=[+]
   C/1 W: CE=[L] CF=[R] CA=[+]
   D/1 W: DF=[-] DG=[-] DA=[+]
   E/1 L: EC=[R] EB=[L]
   F/1 Y: FD=[-] FC=[L] FI=[R]
   G/1 Y: GB=[R] GD=[-] GH=[L]
   H/1 W: HL=[L] HG=[R] HJ=[+]
   I/1 W: IF=[L] IM=[R] IJ=[+]
   J/1 Y: JH=[+] JI=[+] JK=[+]
   K/1 W: KM=[-] KL=[-] KJ=[+]
   L/1 L: LH=[R] LK=[-]
   M/1 L: MK=[-] MI=[L]
NIL
It is interesting to try the algorithm on an 'impossible' diagram.
It turns out the algorithm correctly finds no interpretation for this
well-known illusion:
; page 583
> (defdiagram poiuyt (a l b g) (b l j a) (c l d l) (d l h c) (e l f i)
              (f l k e) (g l a l) (h l l d) (i l e k) (j l k b)
              (k w j i f) (l w h g c))
POIUYT
; page 583
> (print-labelings (diagram 'poiuyt))
The initial diagram is:
   A/6 L: AB=[RL+L-R] AG=[LRR+L-]
   B/6 L: BJ=[RL+L-R] BA=[LRR+L-]
   C/6 L: CD=[RL+L-R] CL=[LRR+L-]
   D/6 L: DH=[RL+L-R] DC=[LRR+L-]
   E/6 L: EF=[RL+L-R] EI=[LRR+L-]
   F/6 L: FK=[RL+L-R] FE=[LRR+L-]
   G/6 L: GA=[RL+L-R] GL=[LRR+L-]
   H/6 L: HL=[RL+L-R] HD=[LRR+L-]
   I/6 L: IE=[RL+L-R] IK=[LRR+L-]
   J/6 L: JK=[RL+L-R] JB=[LRR+L-]
   K/3 W: KJ=[L-+] KI=[R-+] KF=[++-]
   L/3 W: LH=[L-+] LG=[R-+] LC=[++-]
For 544,195,584 interpretations.

After constraint propagation the diagram is:
   A/5 L: AB=[RL+-R] AG=[LRRL-]
   B/5 L: BJ=[RLL-R] BA=[LR+L-]
   C/2 L: CD=[LR] CL=[+-]
   D/3 L: DH=[RL-] DC=[LRL]
   E/3 L: EF=[RLR] EI=[LR-]
   F/2 L: FK=[+-] FE=[RL]
   G/4 L: GA=[RL-R] GL=[L+L-]
   H/4 L: HL=[R+-R] HD=[LRL-]
   I/4 L: IE=[RL-R] IK=[L+L-]
   J/4 L: JK=[R+-R] JB=[LRL-]
   K/3 W: KJ=[L-+] KI=[R-+] KF=[++-]
   L/3 W: LH=[L-+] LG=[R-+] LC=[++-]
For 2,073,600 interpretations.

There are zero solutions:
NIL
Now we try a more complex diagram:
; page 584
> (defdiagram tower (a y b c d) (n l q o) (b w g e a) (o w y j n)
              (c w e f a) (p l r i) (d w f g a) (q w n s w) (e l c b)
              (r w s p x) (f y d c i) (s l r q) (g y b d h) (t w w x z)
              (h w l g j) (u w x y z) (i w f m p) (v w y w z)
              (j y h o k) (w y t v q) (k w m l j) (x y r u t) (l l h k)
              (y y v u o) (m l k i) (z y t u v))
TOWER
; page 584
> (print-labelings (ground (diagram 'tower) 'l 'k))
The initial diagram is:
   A/5 Y: AB=[+-L-R] AC=[+-RL-] AD=[+--RL]
   N/6 L: NQ=[RL+L-R] NO=[LRR+L-]
   B/3 W: BG=[L-+] BE=[R-+] BA=[++-]
   O/3 W: OY=[L-+] OJ=[R-+] ON=[++-]
   C/3 W: CE=[L-+] CF=[R-+] CA=[++-]
   P/6 L: PR=[RL+L-R] PI=[LRR+L-]
   D/3 W: DF=[L-+] DG=[R-+] DA=[++-]
   Q/3 W: QN=[L-+] QS=[R-+] QW=[++-]
   E/6 L: EC=[RL+L-R] EB=[LRR+L-]
   R/3 W: RS=[L-+] RP=[R-+] RX=[++-]
   F/5 Y: FD=[+-L-R] FC=[+-RL-] FI=[+--RL]
   S/6 L: SR=[RL+L-R] SQ=[LRR+L-]
   G/5 Y: GB=[+-L-R] GD=[+-RL-] GH=[+--RL]
   T/3 W: TW=[L-+] TX=[R-+] TZ=[++-]
   H/3 W: HL=[L-+] HG=[R-+] HJ=[++-]
   U/3 W: UX=[L-+] UY=[R-+] UZ=[++-]
   I/3 W: IF=[L-+] IM=[R-+] IP=[++-]
   V/3 W: VY=[L-+] VW=[R-+] VZ=[++-]
   J/5 Y: JH=[+-L-R] JO=[+-RL-] JK=[+--RL]
   W/5 Y: WT=[+-L-R] WV=[+-RL-] WQ=[+--RL]
   K/3 W: KM=[L-+] KL=[R-+] KJ=[++-]
   X/5 Y: XR=[+-L-R] XU=[+-RL-] XT=[+--RL]
   L/1 L: LH=[R] LK=[-]
   Y/5 Y: YV=[+-L-R] YU=[+-RL-] YO=[+--RL]
   M/6 L: MK=[RL+L-R] MI=[LRR+L-]
   Z/5 Y: ZT=[+-L-R] ZU=[+-RL-] ZV=[+--RL]
For 1,614,252,037,500,000 interpretations.

After constraint propagation the diagram is:
   A/1 Y: AB=[+] AC=[+] AD=[+]
   N/1 L: NQ=[R] NO=[-]
   B/1 W: BG=[L] BE=[R] BA=[+]
   O/1 W: OY=[+] OJ=[+] ON=[-]
   C/1 W: CE=[L] CF=[R] CA=[+]
   P/1 L: PR=[L] PI=[+]
   D/1 W: DF=[-] DG=[-] DA=[+]
   Q/1 W: QN=[L] QS=[R] QW=[+]
   E/1 L: EC=[R] EB=[L]
   R/1 W: RS=[L] RP=[R] RX=[+]
   F/1 Y: FD=[-] FC=[L] FI=[R]
   S/1 L: SR=[R] SQ=[L]
   G/1 Y: GB=[R] GD=[-] GH=[L]
   T/1 W: TW=[+] TX=[+] TZ=[-]
   H/1 W: HL=[L] HG=[R] HJ=[+]
   U/1 W: UX=[+] UY=[+] UZ=[-]
   I/1 W: IF=[L] IM=[R] IP=[+]
   V/1 W: VY=[+] VW=[+] VZ=[-]
   J/1 Y: JH=[+] JO=[+] JK=[+]
   W/1 Y: WT=[+] WV=[+] WQ=[+]
   K/1 W: KM=[-] KL=[-] KJ=[+]
   X/1 Y: XR=[+] XU=[+] XT=[+]
   L/1 L: LH=[R] LK=[-]
   Y/1 Y: YV=[+] YU=[+] YO=[+]
   M/1 L: MK=[-] MI=[L]
   Z/1 Y: ZT=[-] ZU=[-] ZV=[-]
NIL

Chapter 17. Line Diagram Labelling by Constraint Satisfaction done.

Chapter 18. Search and the Game of Othello
In this chapter we will develop a simplified Othello-playing program.
It will not be a champion, but is much better than beginning players.

Section 18.2 Representation Choices
> (requires "othello")
; Loading /home/futrelle/csg120sp05/code/paip/othello.lisp
("othello")
First, we see that our choices for representing the board seem to work:
; page 604
> (print-board (initial-board))

    a b c d e f g h   [@=2  O=2  (+0)]
  1 . . . . . . . . 
  2 . . . . . . . . 
  3 . . . . . . . . 
  4 . . . O @ . . . 
  5 . . . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . . 
NIL
Now we can compare the weighted squares and count difference strategies
by playing two games, alternating who goes first.  The NIL as third argument
means don't print the board after each move.
; page 610
> (othello (maximizer #'weighted-squares)
           (maximizer #'count-difference) nil)
20
> (othello (maximizer #'count-difference)
           (maximizer #'weighted-squares) nil)
13

Section 18.4 Searching Ahead: Minimax
We can test the minimax strategy, and see that searching ahead 3 ply is
indeed better than looking at only 1 ply.  We can follow the whole game
; page 614
> (othello (minimax-searcher 3 #'count-difference)
           (maximizer #'count-difference))

    a b c d e f g h   [@=2  O=2  (+0)]
  1 . . . . . . . . 
  2 . . . . . . . . 
  3 . . . . . . . . 
  4 . . . O @ . . . 
  5 . . . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=30:00 O=30:00]

@ moves to D3.

    a b c d e f g h   [@=4  O=1  (+3)]
  1 . . . . . . . . 
  2 . . . . . . . . 
  3 . . . @ . . . . 
  4 . . . @ @ . . . 
  5 . . . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=30:00 O=30:00]

O moves to C3.

    a b c d e f g h   [@=3  O=3  (+0)]
  1 . . . . . . . . 
  2 . . . . . . . . 
  3 . . O @ . . . . 
  4 . . . O @ . . . 
  5 . . . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=30:00 O=30:00]

@ moves to B3.

    a b c d e f g h   [@=5  O=2  (+3)]
  1 . . . . . . . . 
  2 . . . . . . . . 
  3 . @ @ @ . . . . 
  4 . . . O @ . . . 
  5 . . . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:59 O=30:00]

O moves to B2.

    a b c d e f g h   [@=4  O=4  (+0)]
  1 . . . . . . . . 
  2 . O . . . . . . 
  3 . @ O @ . . . . 
  4 . . . O @ . . . 
  5 . . . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:59 O=30:00]

@ moves to C4.

    a b c d e f g h   [@=6  O=3  (+3)]
  1 . . . . . . . . 
  2 . O . . . . . . 
  3 . @ O @ . . . . 
  4 . . @ @ @ . . . 
  5 . . . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:59 O=30:00]

O moves to E3.

    a b c d e f g h   [@=4  O=6  (-2)]
  1 . . . . . . . . 
  2 . O . . . . . . 
  3 . @ O O O . . . 
  4 . . @ @ O . . . 
  5 . . . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:59 O=30:00]

@ moves to F3.

    a b c d e f g h   [@=9  O=2  (+7)]
  1 . . . . . . . . 
  2 . O . . . . . . 
  3 . @ @ @ @ @ . . 
  4 . . @ @ @ . . . 
  5 . . . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:57 O=30:00]

O moves to E2.

    a b c d e f g h   [@=7  O=5  (+2)]
  1 . . . . . . . . 
  2 . O . . O . . . 
  3 . @ @ @ O @ . . 
  4 . . @ @ O . . . 
  5 . . . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:57 O=30:00]

@ moves to D1.

    a b c d e f g h   [@=9  O=4  (+5)]
  1 . . . @ . . . . 
  2 . O . . @ . . . 
  3 . @ @ @ O @ . . 
  4 . . @ @ O . . . 
  5 . . . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:55 O=30:00]

O moves to A3.

    a b c d e f g h   [@=6  O=8  (-2)]
  1 . . . @ . . . . 
  2 . O . . @ . . . 
  3 O O O O O @ . . 
  4 . . @ @ O . . . 
  5 . . . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:55 O=30:00]

@ moves to A1.

    a b c d e f g h   [@=9  O=6  (+3)]
  1 @ . . @ . . . . 
  2 . @ . . @ . . . 
  3 O O @ O O @ . . 
  4 . . @ @ O . . . 
  5 . . . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:53 O=30:00]

O moves to B4.

    a b c d e f g h   [@=7  O=9  (-2)]
  1 @ . . @ . . . . 
  2 . @ . . @ . . . 
  3 O O @ O O @ . . 
  4 . O O O O . . . 
  5 . . . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:53 O=30:00]

@ moves to B5.

    a b c d e f g h   [@=12 O=5  (+7)]
  1 @ . . @ . . . . 
  2 . @ . . @ . . . 
  3 O @ @ @ O @ . . 
  4 . @ @ O O . . . 
  5 . @ . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:50 O=30:00]

O moves to A4.

    a b c d e f g h   [@=10 O=8  (+2)]
  1 @ . . @ . . . . 
  2 . @ . . @ . . . 
  3 O @ @ @ O @ . . 
  4 O O O O O . . . 
  5 . @ . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:50 O=30:00]

@ moves to A5.

    a b c d e f g h   [@=12 O=7  (+5)]
  1 @ . . @ . . . . 
  2 . @ . . @ . . . 
  3 O @ @ @ O @ . . 
  4 O @ O O O . . . 
  5 @ @ . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:49 O=30:00]

O moves to C2.

    a b c d e f g h   [@=9  O=11 (-2)]
  1 @ . . @ . . . . 
  2 . @ O . @ . . . 
  3 O O O O O @ . . 
  4 O @ O O O . . . 
  5 @ @ . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:49 O=30:00]

@ moves to A2.

    a b c d e f g h   [@=14 O=7  (+7)]
  1 @ . . @ . . . . 
  2 @ @ O . @ . . . 
  3 @ @ O O O @ . . 
  4 @ @ @ O O . . . 
  5 @ @ . @ O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:47 O=30:00]

O moves to C5.

    a b c d e f g h   [@=12 O=10 (+2)]
  1 @ . . @ . . . . 
  2 @ @ O . @ . . . 
  3 @ @ O O O @ . . 
  4 @ @ O O O . . . 
  5 @ @ O O O . . . 
  6 . . . . . . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:47 O=30:00]

@ moves to E6.

    a b c d e f g h   [@=18 O=5  (+13)]
  1 @ . . @ . . . . 
  2 @ @ O . @ . . . 
  3 @ @ O O @ @ . . 
  4 @ @ @ O @ . . . 
  5 @ @ O @ @ . . . 
  6 . . . . @ . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:46 O=30:00]

O moves to F5.

    a b c d e f g h   [@=15 O=9  (+6)]
  1 @ . . @ . . . . 
  2 @ @ O . @ . . . 
  3 @ @ O O @ @ . . 
  4 @ @ @ O O . . . 
  5 @ @ O O O O . . 
  6 . . . . @ . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:46 O=30:00]

@ moves to C1.

    a b c d e f g h   [@=18 O=7  (+11)]
  1 @ . @ @ . . . . 
  2 @ @ @ . @ . . . 
  3 @ @ @ O @ @ . . 
  4 @ @ @ O O . . . 
  5 @ @ O O O O . . 
  6 . . . . @ . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:44 O=30:00]

O moves to E1.

    a b c d e f g h   [@=16 O=10 (+6)]
  1 @ . @ @ O . . . 
  2 @ @ @ . O . . . 
  3 @ @ @ O O @ . . 
  4 @ @ @ O O . . . 
  5 @ @ O O O O . . 
  6 . . . . @ . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:44 O=30:00]

@ moves to F1.

    a b c d e f g h   [@=20 O=7  (+13)]
  1 @ . @ @ @ @ . . 
  2 @ @ @ . @ . . . 
  3 @ @ @ @ O @ . . 
  4 @ @ @ O O . . . 
  5 @ @ O O O O . . 
  6 . . . . @ . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:42 O=30:00]

O moves to B1.

    a b c d e f g h   [@=18 O=10 (+8)]
  1 @ O @ @ @ @ . . 
  2 @ @ O . @ . . . 
  3 @ @ @ O O @ . . 
  4 @ @ @ O O . . . 
  5 @ @ O O O O . . 
  6 . . . . @ . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:42 O=30:00]

@ moves to F4.

    a b c d e f g h   [@=21 O=8  (+13)]
  1 @ O @ @ @ @ . . 
  2 @ @ O . @ . . . 
  3 @ @ @ O O @ . . 
  4 @ @ @ @ @ @ . . 
  5 @ @ O O O O . . 
  6 . . . . @ . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:41 O=30:00]

O moves to G1.

    a b c d e f g h   [@=17 O=13 (+4)]
  1 @ O O O O O O . 
  2 @ @ O . @ . . . 
  3 @ @ @ O O @ . . 
  4 @ @ @ @ @ @ . . 
  5 @ @ O O O O . . 
  6 . . . . @ . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:41 O=30:00]

@ moves to H1.

    a b c d e f g h   [@=24 O=7  (+17)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ O . @ . . . 
  3 @ @ @ O O @ . . 
  4 @ @ @ @ @ @ . . 
  5 @ @ O O O O . . 
  6 . . . . @ . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:39 O=30:00]

O moves to F2.

    a b c d e f g h   [@=22 O=10 (+12)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ O . @ O . . 
  3 @ @ @ O O O . . 
  4 @ @ @ @ @ O . . 
  5 @ @ O O O O . . 
  6 . . . . @ . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:39 O=30:00]

@ moves to D2.

    a b c d e f g h   [@=25 O=8  (+17)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ O . . 
  3 @ @ @ @ O O . . 
  4 @ @ @ @ @ O . . 
  5 @ @ O O O O . . 
  6 . . . . @ . . . 
  7 . . . . . . . . 
  8 . . . . . . . .   [@=29:37 O=30:00]

O moves to D7.

    a b c d e f g h   [@=24 O=10 (+14)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ O . . 
  3 @ @ @ @ O O . . 
  4 @ @ @ @ @ O . . 
  5 @ @ O O O O . . 
  6 . . . . O . . . 
  7 . . . O . . . . 
  8 . . . . . . . .   [@=29:37 O=30:00]

@ moves to G2.

    a b c d e f g h   [@=27 O=8  (+19)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ . 
  3 @ @ @ @ O @ . . 
  4 @ @ @ @ @ O . . 
  5 @ @ O O O O . . 
  6 . . . . O . . . 
  7 . . . O . . . . 
  8 . . . . . . . .   [@=29:36 O=30:00]

O moves to G3.

    a b c d e f g h   [@=26 O=10 (+16)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ . 
  3 @ @ @ @ O O O . 
  4 @ @ @ @ @ O . . 
  5 @ @ O O O O . . 
  6 . . . . O . . . 
  7 . . . O . . . . 
  8 . . . . . . . .   [@=29:36 O=30:00]

@ moves to H3.

    a b c d e f g h   [@=30 O=7  (+23)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ . 
  3 @ @ @ @ @ @ @ @ 
  4 @ @ @ @ @ O . . 
  5 @ @ O O O O . . 
  6 . . . . O . . . 
  7 . . . O . . . . 
  8 . . . . . . . .   [@=29:35 O=30:00]

O moves to H2.

    a b c d e f g h   [@=29 O=9  (+20)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ O 
  3 @ @ @ @ @ @ O @ 
  4 @ @ @ @ @ O . . 
  5 @ @ O O O O . . 
  6 . . . . O . . . 
  7 . . . O . . . . 
  8 . . . . . . . .   [@=29:35 O=30:00]

@ moves to G5.

    a b c d e f g h   [@=35 O=4  (+31)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ O 
  3 @ @ @ @ @ @ O @ 
  4 @ @ @ @ @ @ . . 
  5 @ @ @ @ @ @ @ . 
  6 . . . . O . . . 
  7 . . . O . . . . 
  8 . . . . . . . .   [@=29:35 O=30:00]

O moves to D6.

    a b c d e f g h   [@=33 O=7  (+26)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ O 
  3 @ @ @ @ @ @ O @ 
  4 @ @ @ @ @ O . . 
  5 @ @ @ @ O @ @ . 
  6 . . . O O . . . 
  7 . . . O . . . . 
  8 . . . . . . . .   [@=29:35 O=30:00]

@ moves to G4.

    a b c d e f g h   [@=36 O=5  (+31)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ O 
  3 @ @ @ @ @ @ @ @ 
  4 @ @ @ @ @ @ @ . 
  5 @ @ @ @ O @ @ . 
  6 . . . O O . . . 
  7 . . . O . . . . 
  8 . . . . . . . .   [@=29:34 O=30:00]

O moves to H5.

    a b c d e f g h   [@=34 O=8  (+26)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ O 
  3 @ @ @ @ @ @ @ @ 
  4 @ @ @ @ @ @ @ . 
  5 @ @ @ @ O O O O 
  6 . . . O O . . . 
  7 . . . O . . . . 
  8 . . . . . . . .   [@=29:34 O=30:00]

@ moves to G6.

    a b c d e f g h   [@=37 O=6  (+31)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ O 
  3 @ @ @ @ @ @ @ @ 
  4 @ @ @ @ @ @ @ . 
  5 @ @ @ @ O @ @ O 
  6 . . . O O . @ . 
  7 . . . O . . . . 
  8 . . . . . . . .   [@=29:34 O=30:00]

O moves to H4.

    a b c d e f g h   [@=36 O=8  (+28)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ O 
  3 @ @ @ @ @ @ @ O 
  4 @ @ @ @ @ @ @ O 
  5 @ @ @ @ O @ @ O 
  6 . . . O O . @ . 
  7 . . . O . . . . 
  8 . . . . . . . .   [@=29:34 O=30:00]

@ moves to H6.
O has no moves and must pass.

    a b c d e f g h   [@=41 O=4  (+37)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ @ 
  3 @ @ @ @ @ @ @ @ 
  4 @ @ @ @ @ @ @ @ 
  5 @ @ @ @ O @ @ @ 
  6 . . . O O . @ @ 
  7 . . . O . . . . 
  8 . . . . . . . .   [@=29:33 O=30:00]

@ moves to E7.

    a b c d e f g h   [@=45 O=1  (+44)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ @ 
  3 @ @ @ @ @ @ @ @ 
  4 @ @ @ @ @ @ @ @ 
  5 @ @ @ @ @ @ @ @ 
  6 . . . @ @ . @ @ 
  7 . . . O @ . . . 
  8 . . . . . . . .   [@=29:33 O=30:00]

O moves to F7.

    a b c d e f g h   [@=44 O=3  (+41)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ @ 
  3 @ @ @ @ @ @ @ @ 
  4 @ @ @ @ @ @ @ @ 
  5 @ @ @ @ @ @ @ @ 
  6 . . . @ @ . @ @ 
  7 . . . O O O . . 
  8 . . . . . . . .   [@=29:33 O=30:00]

@ moves to F8.
O has no moves and must pass.

    a b c d e f g h   [@=46 O=2  (+44)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ @ 
  3 @ @ @ @ @ @ @ @ 
  4 @ @ @ @ @ @ @ @ 
  5 @ @ @ @ @ @ @ @ 
  6 . . . @ @ . @ @ 
  7 . . . O @ O . . 
  8 . . . . . @ . .   [@=29:33 O=30:00]

@ moves to F6.

    a b c d e f g h   [@=48 O=1  (+47)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ @ 
  3 @ @ @ @ @ @ @ @ 
  4 @ @ @ @ @ @ @ @ 
  5 @ @ @ @ @ @ @ @ 
  6 . . . @ @ @ @ @ 
  7 . . . O @ @ . . 
  8 . . . . . @ . .   [@=29:33 O=30:00]

O moves to G7.

    a b c d e f g h   [@=46 O=4  (+42)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ @ 
  3 @ @ @ @ @ @ @ @ 
  4 @ @ @ @ @ @ @ @ 
  5 @ @ @ @ @ @ @ @ 
  6 . . . @ @ @ @ @ 
  7 . . . O O O O . 
  8 . . . . . @ . .   [@=29:33 O=30:00]

@ moves to E8.
O has no moves and must pass.

    a b c d e f g h   [@=49 O=2  (+47)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ @ 
  3 @ @ @ @ @ @ @ @ 
  4 @ @ @ @ @ @ @ @ 
  5 @ @ @ @ @ @ @ @ 
  6 . . . @ @ @ @ @ 
  7 . . . O @ @ O . 
  8 . . . . @ @ . .   [@=29:33 O=30:00]

@ moves to H7.
O has no moves and must pass.

    a b c d e f g h   [@=51 O=1  (+50)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ @ 
  3 @ @ @ @ @ @ @ @ 
  4 @ @ @ @ @ @ @ @ 
  5 @ @ @ @ @ @ @ @ 
  6 . . . @ @ @ @ @ 
  7 . . . O @ @ @ @ 
  8 . . . . @ @ . .   [@=29:33 O=30:00]

@ moves to C6.
The game is over.  Final result:

    a b c d e f g h   [@=53 O=0  (+53)]
  1 @ @ @ @ @ @ @ @ 
  2 @ @ @ @ @ @ @ @ 
  3 @ @ @ @ @ @ @ @ 
  4 @ @ @ @ @ @ @ @ 
  5 @ @ @ @ @ @ @ @ 
  6 . . @ @ @ @ @ @ 
  7 . . . @ @ @ @ @ 
  8 . . . . @ @ . .   [@=29:33 O=30:00]

53

Section 18.5 Smarter Searching: Alpha-Beta Search
The following should produce the same result, only faster:
> (othello (alpha-beta-searcher 3 #'count-difference)
           (maximizer #'count-difference) nil)
53

Section 18.8 Playing a Series of Games
A single game is not enough to establish that one strategy is better than
another.  The function RANDOM-OTHELLO-SERIES allows two strategies to
compete in a series of games.
> (requires "othello2")
; Loading /home/futrelle/csg120sp05/code/paip/othello2.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/othello.lisp
         (11 12 13 14 15 16 17 18 21 22 23 24 25 26 27 28 31 32 33 34
          35 36 37 38 41 42 43 44 45 46 47 48 51 52 53 54 55 56 57 58
          61 62 63 64 65 66 67 68 71 72 73 74 75 76 77 78 81 82 83 84
          85 86 87 88)
         to
         (11 18 81 88 13 16 31 38 61 68 83 86 33 36 63 66 14 15 41 48
          51 58 84 85 34 35 43 44 45 46 53 54 55 56 64 65 23 24 25 26
          32 37 42 47 52 57 62 67 73 74 75 76 12 17 21 28 71 78 82 87
          22 27 72 77).
("othello2")
; page 628
> (random-othello-series (alpha-beta-searcher 2 #'weighted-squares)
    (alpha-beta-searcher 2 #'modified-weighted-squares) 5)
4
Here is a comparison of five strategies that search only 1 ply.
To save time, we run 2 pairs of games each, not 5 pairs.
; page 629
> (round-robin (list (maximizer #'count-difference)
                     (maximizer #'mobility)
                     (maximizer #'weighted-squares)
                     (maximizer #'modified-weighted-squares)
                     #'random-strategy)
               2 10
               '(count-difference mobility weighted modified-weighted
                                  random))
COUNT-DIFFERENCE      8.0:  ---  2.5  1.5  1.0  3.0 
MOBILITY              5.5:  1.5  ---  1.0  0.0  3.0 
WEIGHTED             10.5:  2.5  3.0  ---  2.0  3.0 
MODIFIED-WEIGHTED    13.0:  3.0  4.0  2.0  ---  4.0 
RANDOM                3.0:  1.0  1.0  1.0  0.0  --- 
NIL
Now we compare alpha-beta searchers at 3 ply for 1 pair of games each.
In the book it was 4 ply for 5 pairs each, but that takes too long.
> (round-robin (list (alpha-beta-searcher 3 #'count-difference)
                     (alpha-beta-searcher 3 #'weighted-squares)
                     (alpha-beta-searcher 3
                                          #'modified-weighted-squares)
                     #'random-strategy)
               1 10
               '(count-difference weighted modified-weighted random))
COUNT-DIFFERENCE      1.5:  ---  0.5  0.0  1.0 
WEIGHTED              4.5:  1.5  ---  1.0  2.0 
MODIFIED-WEIGHTED     4.0:  2.0  1.0  ---  1.0 
RANDOM                2.0:  1.0  0.0  1.0  --- 
NIL

Chapter 18. Search and the Game of Othello done.

Chapter 19. Introduction to Natural Language
This chapter is a brief introduction to natural language processing.

Section 19.1 Parsing with a Phrase-Structure Grammar
We start with the grammar defined on page 39 for the GENERATE program.
I include 'noun' and 'verb' as nouns in the grammar *grammar3*
> (requires "syntax1")
; Loading /home/futrelle/csg120sp05/code/paip/syntax1.lisp
("syntax1")
; page 657
> *grammar3*
((SENTENCE -> (NP VP)) (NP -> (ART NOUN)) (VP -> (VERB NP))
 (ART -> THE) (ART -> A) (NOUN -> MAN) (NOUN -> BALL) (NOUN -> WOMAN)
 (NOUN -> TABLE) (NOUN -> NOUN) (NOUN -> VERB) (VERB -> HIT)
 (VERB -> TOOK) (VERB -> SAW) (VERB -> LIKED))
> (use *grammar3*)
15
> (parser '(the table))
((NP (ART THE) (NOUN TABLE)))
> (parser '(the ball hit the table))
((SENTENCE (NP (ART THE) (NOUN BALL))
           (VP (VERB HIT) (NP (ART THE) (NOUN TABLE)))))
> (parser '(the noun took the verb))
((SENTENCE (NP (ART THE) (NOUN NOUN))
           (VP (VERB TOOK) (NP (ART THE) (NOUN VERB)))))
The range of sentences we can parse is quite limited.
The following grammar includes a wider variety.
; page 661
> *grammar4*
((S -> (NP VP)) (NP -> (D N)) (NP -> (D A+ N)) (NP -> (NP PP))
 (NP -> (PRO)) (NP -> (NAME)) (VP -> (V NP)) (VP -> (V))
 (VP -> (VP PP)) (PP -> (P NP)) (A+ -> (A)) (A+ -> (A A+)) (PRO -> I)
 (PRO -> YOU) (PRO -> HE) (PRO -> SHE) (PRO -> IT) (PRO -> ME)
 (PRO -> HIM) (PRO -> HER) (NAME -> JOHN) (NAME -> MARY) (A -> BIG)
 (A -> LITTLE) (A -> OLD) (A -> YOUNG) (A -> BLUE) (A -> GREEN)
 (A -> ORANGE) (A -> PERSPICUOUS) (D -> THE) (D -> A) (D -> AN)
 (N -> MAN) (N -> BALL) (N -> WOMAN) (N -> TABLE) (N -> ORANGE)
 (N -> SAW) (N -> SAWS) (N -> NOUN) (N -> VERB) (P -> WITH) (P -> FOR)
 (P -> AT) (P -> ON) (P -> BY) (P -> OF) (P -> IN) (V -> HIT)
 (V -> TOOK) (V -> SAW) (V -> LIKED) (V -> SAWS))
> (use *grammar4*)
54
> (parser '(the man hit the table with the ball))
((S (NP (D THE) (N MAN))
  (VP (VP (V HIT) (NP (D THE) (N TABLE)))
   (PP (P WITH) (NP (D THE) (N BALL)))))
 (S (NP (D THE) (N MAN))
  (VP (V HIT)
   (NP (NP (D THE) (N TABLE)) (PP (P WITH) (NP (D THE) (N BALL)))))))
Here we see a phrase that is ambiguous between a sentence and a noun phrase:
; page 662
> (parser '(the orange saw))
((S (NP (D THE) (N ORANGE)) (VP (V SAW)))
 (NP (D THE) (A+ (A ORANGE)) (N SAW)))

Section 19.4 The Unknown-Word Problem
As it stands, the parser cannot deal with unknown words.
One way of treating unknown words is to allow them to be any of the
'open-class' categories--nouns, verbs, adjectives, and names.
; page 664
> (parser '(john liked mary))
((S (NP (NAME JOHN)) (VP (V LIKED) (NP (NAME MARY)))))
; page 665
> (parser '(dana liked dale))
((S (NP (NAME DANA)) (VP (V LIKED) (NP (NAME DALE)))))
We see the parser works as well with words it knows (John and Mary)
as with new words (Dana and Dale), which it can recognize as names
because of their position in the sentence.
> (parser '(the rab zaggled the woogly quax))
((S (NP (D THE) (N RAB))
  (VP (V ZAGGLED) (NP (D THE) (A+ (A WOOGLY)) (N QUAX)))))
> (parser '(the slithy toves gymbled))
((S (NP (D THE) (N SLITHY)) (VP (V TOVES) (NP (NAME GYMBLED))))
 (S (NP (D THE) (A+ (A SLITHY)) (N TOVES)) (VP (V GYMBLED)))
 (NP (D THE) (A+ (A SLITHY) (A+ (A TOVES))) (N GYMBLED)))
> (parser '(the slithy toves gymbled on the wabe))
((S (NP (D THE) (N SLITHY))
  (VP (VP (V TOVES) (NP (NAME GYMBLED)))
   (PP (P ON) (NP (D THE) (N WABE)))))
 (S (NP (D THE) (N SLITHY))
  (VP (V TOVES)
   (NP (NP (NAME GYMBLED)) (PP (P ON) (NP (D THE) (N WABE))))))
 (S (NP (D THE) (A+ (A SLITHY)) (N TOVES))
  (VP (VP (V GYMBLED)) (PP (P ON) (NP (D THE) (N WABE)))))
 (NP (NP (D THE) (A+ (A SLITHY) (A+ (A TOVES))) (N GYMBLED))
  (PP (P ON) (NP (D THE) (N WABE)))))

Section 19.5 Parsing into a Semantic Representation
> (requires "syntax2")
; Loading /home/futrelle/csg120sp05/code/paip/syntax2.lisp
("syntax2")
Syntactic parse trees of a sentence may be interesting, but by themselves
they're not very useful.  We use sentences to communicate ideas, not to
display grammatical structures.

Imagine a compact disc player for which you can punch buttons like
'play 1 to 5 without 3'.  We will define such a language.
The meaning of a sentence in the language is the list of tracks played.
; page 667
> *grammar5*
((NP -> (NP CONJ NP) INFIX-FUNCALL) (NP -> (N) LIST)
 (NP -> (N P N) INFIX-FUNCALL) (N -> (DIGIT) IDENTITY)
 (P -> TO INTEGERS) (CONJ -> AND ORDERED-UNION)
 (CONJ -> WITHOUT ORDERED-SET-DIFFERENCE) (N -> 1 1) (N -> 2 2)
 (N -> 3 3) (N -> 4 4) (N -> 5 5) (N -> 6 6) (N -> 7 7) (N -> 8 8)
 (N -> 9 9) (N -> 0 0))
> (use *grammar5*)
17
; page 669
> (meanings '(1 to 5 without 3))
((1 2 4 5))
> (meanings '(1 to 4 and 7 to 9))
((1 2 3 4 7 8 9))
> (meanings '(1 to 6 without 3 and 4))
((1 2 4 5 6) (1 2 5 6))
The example '1 to 6 without 3 and 4' is ambiguous.
The syntactic ambiguity leads to a semantic ambiguity.
We can define a new grammar that eliminates some ambiguities:
; page 669
> *grammar6*
((NP -> (NP CONJ NP) INFIX-FUNCALL) (NP -> (N) LIST)
 (NP -> (N P N) INFIX-FUNCALL) (N -> (DIGIT) IDENTITY)
 (N -> (N DIGIT) 10*N+D) (P -> TO INTEGERS) (CONJ -> AND UNION*)
 (CONJ -> WITHOUT SET-DIFF) (DIGIT -> 1 1) (DIGIT -> 2 2)
 (DIGIT -> 3 3) (DIGIT -> 4 4) (DIGIT -> 5 5) (DIGIT -> 6 6)
 (DIGIT -> 7 7) (DIGIT -> 8 8) (DIGIT -> 9 9) (DIGIT -> 0 0))
> (use *grammar6*)
18
With this new grammar, we can get single interpretations out of most inputs
> (meanings '(1 to 6 without 3 and 4))
((1 2 5 6))
> (meanings '(1 and 3 to 7 and 9 without 5 and 6))
((1 3 4 7 9))
> (meanings '(1 and 3 to 7 and 9 without 5 and 2))
((1 3 4 6 7 9 2))
> (meanings '(1 9 8 to 2 0 1))
((198 199 200 201))
> (meanings '(1 2 3))
(123 (123))

Section 19.6 Parsing with Preferences
> (requires "syntax3")
; Loading /home/futrelle/csg120sp05/code/paip/syntax3.lisp
("syntax3")
We need some compromise between the permissive grammar, which generated
all possible parses, and the restrictive grammar, which eliminates too
many parses.  To get the 'best' interpretation we will need not only a
new grammar, we will also need to modify the program to compare the
relative worth of candidate interpretations.
; page 673
> *grammar7*
((NP -> (NP CONJ NP) INFIX-FUNCALL INFIX-SCORER)
 (NP -> (N P N) INFIX-FUNCALL INFIX-SCORER) (NP -> (N) LIST)
 (NP -> ([ NP ]) ARG2) (NP -> (NP ADJ) REV-FUNCALL REV-SCORER)
 (NP -> (NP OP N) INFIX-FUNCALL) (N -> (D) IDENTITY)
 (N -> (N D) 10*N+D) (P -> TO INTEGERS PREFER<) ([ -> [ [) (] -> ] ])
 (OP -> REPEAT REPEAT) (CONJ -> AND APPEND PREFER-DISJOINT)
 (CONJ -> WITHOUT ORDERED-SET-DIFFERENCE PREFER-SUBSET)
 (ADJ -> REVERSED REVERSE INV-SPAN)
 (ADJ -> SHUFFLED PERMUTE PREFER-NOT-SINGLETON) (D -> 1 1) (D -> 2 2)
 (D -> 3 3) (D -> 4 4) (D -> 5 5) (D -> 6 6) (D -> 7 7) (D -> 8 8)
 (D -> 9 9) (D -> 0 0))
> (use *grammar7*)
26
We will need a way to show off the prefernce rankings:
; page 675
> (all-parses '(1 to 6 without 3 and 4))

Score  Semantics         (1 TO 6 WITHOUT 3 AND 4)
=====  =========         ============================
  0.3  (1 2 5 6)         ((1 TO 6) WITHOUT (3 AND 4))
 -0.7  (1 2 4 5 6 4)     (((1 TO 6) WITHOUT 3) AND 4)
NIL
> (all-parses '(1 and 3 to 7 and 9 without 5 and 6))

Score  Semantics         (1 AND 3 TO 7 AND 9 WITHOUT 5 AND 6)
=====  =========         ============================
  0.2  (1 3 4 7 9)       (1 AND (((3 TO 7) AND 9) WITHOUT (5 AND 6)))
  0.1  (1 3 4 7 9)       (((1 AND (3 TO 7)) AND 9) WITHOUT (5 AND 6))
  0.1  (1 3 4 7 9)       ((1 AND ((3 TO 7) AND 9)) WITHOUT (5 AND 6))
 -0.8  (1 3 4 6 7 9 6)   ((1 AND (((3 TO 7) AND 9) WITHOUT 5)) AND 6)
 -0.8  (1 3 4 6 7 9 6)   (1 AND ((((3 TO 7) AND 9) WITHOUT 5) AND 6))
 -0.9  (1 3 4 6 7 9 6)   ((((1 AND (3 TO 7)) AND 9) WITHOUT 5) AND 6)
 -0.9  (1 3 4 6 7 9 6)   (((1 AND ((3 TO 7) AND 9)) WITHOUT 5) AND 6)
 -2.0  (1 3 4 5 6 7 9)   ((1 AND (3 TO 7)) AND (9 WITHOUT (5 AND 6)))
 -2.0  (1 3 4 5 6 7 9)   (1 AND ((3 TO 7) AND (9 WITHOUT (5 AND 6))))
 -3.0  (1 3 4 5 6 7 9 6) (((1 AND (3 TO 7)) AND (9 WITHOUT 5)) AND 6)
 -3.0  (1 3 4 5 6 7 9 6) ((1 AND (3 TO 7)) AND ((9 WITHOUT 5) AND 6))
 -3.0  (1 3 4 5 6 7 9 6) ((1 AND ((3 TO 7) AND (9 WITHOUT 5))) AND 6)
 -3.0  (1 3 4 5 6 7 9 6) (1 AND (((3 TO 7) AND (9 WITHOUT 5)) AND 6))
 -3.0  (1 3 4 5 6 7 9 6) (1 AND ((3 TO 7) AND ((9 WITHOUT 5) AND 6)))
NIL
; page 676
> (all-parses '(1 and 3 to 7 and 9 without 5 and 2))

Score  Semantics         (1 AND 3 TO 7 AND 9 WITHOUT 5 AND 2)
=====  =========         ============================
  0.2  (1 3 4 6 7 9 2)   ((1 AND (((3 TO 7) AND 9) WITHOUT 5)) AND 2)
  0.2  (1 3 4 6 7 9 2)   (1 AND ((((3 TO 7) AND 9) WITHOUT 5) AND 2))
  0.1  (1 3 4 6 7 9 2)   ((((1 AND (3 TO 7)) AND 9) WITHOUT 5) AND 2)
  0.1  (1 3 4 6 7 9 2)   (((1 AND ((3 TO 7) AND 9)) WITHOUT 5) AND 2)
 -2.0  (1 3 4 5 6 7 9 2) (((1 AND (3 TO 7)) AND (9 WITHOUT 5)) AND 2)
 -2.0  (1 3 4 5 6 7 9 2) ((1 AND (3 TO 7)) AND ((9 WITHOUT 5) AND 2))
 -2.0  (1 3 4 5 6 7 9)   ((1 AND (3 TO 7)) AND (9 WITHOUT (5 AND 2)))
 -2.0  (1 3 4 5 6 7 9 2) ((1 AND ((3 TO 7) AND (9 WITHOUT 5))) AND 2)
 -2.0  (1 3 4 5 6 7 9 2) (1 AND (((3 TO 7) AND (9 WITHOUT 5)) AND 2))
 -2.0  (1 3 4 5 6 7 9 2) (1 AND ((3 TO 7) AND ((9 WITHOUT 5) AND 2)))
 -2.0  (1 3 4 5 6 7 9)   (1 AND ((3 TO 7) AND (9 WITHOUT (5 AND 2))))
 -2.8  (1 3 4 6 7 9)     (1 AND (((3 TO 7) AND 9) WITHOUT (5 AND 2)))
 -2.9  (1 3 4 6 7 9)     (((1 AND (3 TO 7)) AND 9) WITHOUT (5 AND 2))
 -2.9  (1 3 4 6 7 9)     ((1 AND ((3 TO 7) AND 9)) WITHOUT (5 AND 2))
NIL
In each case, the preference rules are able to assign higher scores to
more reasonable interpretations.  What we really want is to pick the best.
Here we see some examples:
> (meaning '(1 to 5 without 3 and 4))
(1 2 5)
> (meaning '(1 to 5 without 3 and 6))
(1 2 4 5 6)
> (meaning '(1 to 5 without 3 and 6 shuffled))
(5 4 6 1 2)
> (meaning '([ 1 to 5 without [ 3 and 6 ] ] reversed))
(5 4 2 1)
> (meaning '(1 to 5 to 9))
Sorry, I didn't understand that.
NIL

Chapter 19. Introduction to Natural Language done.

Chapter 20. Unification Grammars
Prolog was invented as a formalism to describe the grammar of French.
It is still useful to view a grammar as a set of logic programming clauses.
This chapter describes how that can be done.
> (requires "unifgram")
; Loading /home/futrelle/csg120sp05/code/paip/unifgram.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/prologcp.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/prologc.lisp
;       Loading /home/futrelle/csg120sp05/code/paip/prolog.lisp
;         Loading /home/futrelle/csg120sp05/code/paip/unify.lisp
;           Loading /home/futrelle/csg120sp05/code/paip/patmatch.lisp
("unifgram")

Section 20.3 A Simple Grammar in DCG Format
Here is the trivial grammar from page 688 in DCG format:
> (clear-db)
(IF AND OR ZEBRA = IRIGHT NEXTTO LENGTH MEMBER LIKES)
; page 692
> (rule (s (?pred ?subj)) --> (np ?agr ?subj) (vp ?agr ?pred))
S
> (rule (np ?agr (?det ?n)) --> (det ?agr ?det) (n ?agr ?n))
NP
; page 693
> (rule (np 3sg (the male)) --> (:word he))
NP
> (rule (np ~3sg (some objects)) --> (:word they))
NP
> (rule (vp 3sg sleep) --> (:word sleeps))
VP
> (rule (vp ~3sg sleep) --> (:word sleep))
VP
> (rule (det ?any the) --> (:word the))
DET
> (rule (n 3sg (young male human)) --> (:word boy))
N
> (rule (n 3sg (young female human)) --> (:word girl))
N
We can parse some of the sentences from page 689 (but in DCG format).
Parsing:
> (?- (s ?sem (he sleeps) nil))
; While compiling DET/4:
?SEM = (SLEEP (THE MALE))
No.
NIL
Generating:
> (?- (s (sleep (the male)) ?words nil))
?WORDS = (HE SLEEPS)
No.
NIL
Enumerating:
> (?- (s ?sem ?words nil))
?SEM = (SLEEP (THE (YOUNG MALE HUMAN)))
?WORDS = (THE BOY SLEEPS)
?SEM = (SLEEP (THE (YOUNG FEMALE HUMAN)))
?WORDS = (THE GIRL SLEEPS)
?SEM = (SLEEP (THE MALE))
?WORDS = (HE SLEEPS)
?SEM = (SLEEP (SOME OBJECTS))
?WORDS = (THEY SLEEP)
No.
NIL
If we want the interpretation of 'Terry kisses Jean' to be
(kiss Terry Jean) not ((lambda (x) (kiss x Jean)) Terry), then we need
a way to unify semantic components together.  Here's one way:
> (clear-db)
(TOP-LEVEL-QUERY N DET VP NP S IF AND OR ZEBRA = IRIGHT NEXTTO LENGTH
 MEMBER LIKES)
; page 694
> (rule (s ?pred) --> (np ?agr ?subj) (vp ?agr ?subj ?pred))
S
> (rule (vp ?agr ?subj ?pred) --> (verb/tr ?agr ?subj ?pred ?obj)
        (np ?any-agr ?obj))
VP
> (rule (vp ?agr ?subj ?pred) --> (verb/intr ?agr ?subj ?pred))
VP
> (rule (verb/tr ~3sg ?x (kiss ?x ?y) ?y) --> (:word kiss))
VERB/TR
> (rule (verb/tr 3sg ?x (kiss ?x ?y) ?y) --> (:word kisses))
VERB/TR
> (rule (verb/tr ?any ?x (kiss ?x ?y) ?y) --> (:word kissed))
VERB/TR
> (rule (verb/intr ~3sg ?x (sleep ?x)) --> (:word sleep))
VERB/INTR
> (rule (verb/intr 3sg ?x (sleep ?x)) --> (:word sleeps))
VERB/INTR
> (rule (verb/intr ?any ?x (sleep ?x)) --> (:word slept))
VERB/INTR
Here are the rules for noun phrases and nouns
> (rule (np ?agr ?sem) --> (name ?agr ?sem))
NP
> (rule (np ?agr (?det-sem ?noun-sem)) --> (det ?agr ?det-sem)
        (noun ?agr ?noun-sem))
NP
> (rule (name 3sg terry) --> (:word terry))
NAME
> (rule (name 3sg jean) --> (:word jean))
NAME
; page 695
> (rule (noun 3sg (young male human)) --> (:word boy))
NOUN
> (rule (noun 3sg (young female human)) --> (:word girl))
NOUN
> (rule (noun ~3sg (group (young male human))) --> (:word boys))
NOUN
> (rule (noun ~3sg (group (young female human))) --> (:word girls))
NOUN
> (rule (det ?any the) --> (:word the))
DET
> (rule (det 3sg a) --> (:word a))
DET
This grammar and lexicon generates more sentences, although it is still
rather limited.  Here are some examples:
; page 695
> (?- (s ?sem (the boys kiss a girl) nil))
?SEM = (KISS (THE (GROUP (YOUNG MALE HUMAN))) (A (YOUNG FEMALE HUMAN)))
No.
NIL
> (?- (s ?sem (the girls kissed the girls) nil))
?SEM = (KISS (THE (GROUP (YOUNG FEMALE HUMAN)))
        (THE (GROUP (YOUNG FEMALE HUMAN))))
No.
NIL
> (?- (s ?sem (terry kissed the girl) nil))
?SEM = (KISS TERRY (THE (YOUNG FEMALE HUMAN)))
No.
NIL
> (?- (s ?sem (the girls kisses the boys) nil))
No.
NIL
> (?- (s ?sem (terry kissed a girls) nil))
No.
NIL
> (?- (s ?sem (terry sleeps jean) nil))
No.
NIL

Section 20.4 A DCG Grammar with Quantifiers
> (clear-db)
(NOUN NAME VERB/INTR VERB/TR TOP-LEVEL-QUERY N DET VP NP S IF AND OR
      ZEBRA = IRIGHT NEXTTO LENGTH MEMBER LIKES)
; page 697
> (rule (det ?any ?x ?p ?q (the ?x (and ?p ?q))) --> (:word the))
DET
> (rule (det 3sg ?x ?p ?q (exists ?x (and ?p ?q))) --> (:word a))
DET
> (rule (det 3sg ?x ?p ?q (all ?x (-> ?p ?q))) --> (:word every))
DET
; page 698
> (rule (noun 3sg ?x (picture ?x)) --> (:word picture))
NOUN
> (rule (noun 3sg ?x (story ?x)) --> (:word story))
NOUN
> (rule (noun 3sg ?x (and (young ?x) (male ?x) (human ?x))) -->
        (:word boy))
NOUN
> (rule (np ?agr ?x ?pred ?pred) --> (name ?agr ?name))
NP
> (rule (np ?agr ?x ?pred ?np) --> (det ?agr ?x ?noun&rel ?pred ?np)
        (noun ?agr ?x ?noun) (rel-clause ?agr ?x ?noun ?noun&rel))
NP
> (rule (rel-clause ?agr ?x ?np ?np) -->)
REL-CLAUSE
> (rule (rel-clause ?agr ?x ?np (and ?np ?rel)) --> (:word that)
        (vp ?agr ?x ?rel))
REL-CLAUSE
; page 699
> (rule (verb/tr ~3sg ?x ?y (paint ?x ?y)) --> (:word paint))
VERB/TR
> (rule (verb/tr 3sg ?x ?y (paint ?x ?y)) --> (:word paints))
VERB/TR
> (rule (verb/tr ?any ?x ?y (paint ?x ?y)) --> (:word painted))
VERB/TR
> (rule (verb/intr ~3sg ?x (sleep ?x)) --> (:word sleep))
VERB/INTR
> (rule (verb/intr 3sg ?x (sleep ?x)) --> (:word sleeps))
VERB/INTR
> (rule (verb/intr ?any ?x (sleep ?x)) --> (:word slept))
VERB/INTR
> (rule (verb/intr 3sg ?x (sells ?x)) --> (:word sells))
VERB/INTR
> (rule (verb/intr 3sg ?x (stinks ?x)) --> (:word stinks))
VERB/INTR
> (rule (vp ?agr ?x ?vp) --> (verb/tr ?agr ?x ?obj ?verb)
        (np ?any-agr ?obj ?verb ?vp))
VP
> (rule (vp ?agr ?x ?vp) --> (verb/intr ?agr ?x ?vp))
VP
> (rule (s ?np) --> (np ?agr ?x ?vp ?np) (vp ?agr ?x ?vp))
S
Now we define a function to show the output from a query.
In the book, you just saw the output of such a function.
> (defun do-s (words) (top-level-prove `((s ?sem ,words nil))))
DO-S
; page 699
> (do-s '(every picture paints a story))
         NP/6.
         NP/6.
         NOUN/5, DET/7.
?SEM = (ALL ?4
        (-> (PICTURE ?4) (EXISTS ?13 (AND (STORY ?13) (PAINT ?4 ?13)))))
No.
NIL
> (do-s '(every boy that paints a picture sleeps))
?SEM = (ALL ?4
        (->
         (AND (AND (YOUNG ?4) (MALE ?4) (HUMAN ?4))
              (EXISTS ?18 (AND (PICTURE ?18) (PAINT ?4 ?18))))
         (SLEEP ?4)))
No.
NIL
> (do-s '(every boy that sleeps paints a picture))
?SEM = (ALL ?4
        (-> (AND (AND (YOUNG ?4) (MALE ?4) (HUMAN ?4)) (SLEEP ?4))
         (EXISTS ?21 (AND (PICTURE ?21) (PAINT ?4 ?21)))))
No.
NIL
; page 700
> (do-s '(every boy that paints a picture that sells paints a picture
                that stinks))
?SEM = (ALL ?4
        (->
         (AND (AND (YOUNG ?4) (MALE ?4) (HUMAN ?4))
              (EXISTS ?18
               (AND (AND (PICTURE ?18) (SELLS ?18)) (PAINT ?4 ?18))))
         (EXISTS ?35
          (AND (AND (PICTURE ?35) (STINKS ?35)) (PAINT ?4 ?35)))))
No.
NIL

Section 20.5 Preserving Quantifier Scope Ambiguity
> (clear-db)
(REL-CLAUSE NOUN NAME VERB/INTR VERB/TR TOP-LEVEL-QUERY N DET VP NP S
 IF AND OR ZEBRA = IRIGHT NEXTTO LENGTH MEMBER LIKES)
; page 701
> (rule (s (and ?np ?vp)) --> (np ?agr ?x ?np) (vp ?agr ?x ?vp))
S
> (rule (vp ?agr ?x (and ?verb ?obj)) --> (verb/tr ?agr ?x ?o ?verb)
        (np ?any-agr ?o ?obj))
VP
> (rule (vp ?agr ?x ?verb) --> (verb/intr ?agr ?x ?verb))
VP
> (rule (np ?agr ?name t) --> (name ?agr ?name))
NP
> (rule (np ?agr ?x ?det) --> (det ?agr ?x (and ?noun ?rel) ?det)
        (noun ?agr ?x ?noun) (rel-clause ?agr ?x ?rel))
NP
> (rule (rel-clause ?agr ?x t) -->)
REL-CLAUSE
> (rule (rel-clause ?agr ?x ?rel) --> (:word that) (vp ?agr ?x ?rel))
REL-CLAUSE
> (rule (name 3sg terry) --> (:word terry))
NAME
> (rule (name 3sg jean) --> (:word jean))
NAME
> (rule (det 3sg ?x ?restr (all ?x ?restr)) --> (:word every))
DET
> (rule (noun 3sg ?x (man ?x)) --> (:word man))
NOUN
> (rule (verb/tr 3sg ?x ?y (love ?x ?y)) --> (:word loves))
VERB/TR
> (rule (verb/intr 3sg ?x (lives ?x)) --> (:word lives))
VERB/INTR
> (rule (det 3sg ?x ?res (exists ?x ?res)) --> (:word a))
DET
> (rule (noun 3sg ?x (woman ?x)) --> (:word woman))
NOUN
Here is an example of the new representation:
; page 701
> (do-s '(every man loves a woman))
?SEM = (AND (ALL ?4 (AND (MAN ?4) T))
            (AND (LOVE ?4 ?13) (EXISTS ?13 (AND (WOMAN ?13) T))))
No.
NIL

Chapter 20. Unification Grammars done.

Chapter 21. A Grammar of English
; page 715
> (if (boundp 'clear-db) (clear-db))
NIL
> (requires "grammar" "lexicon")
; Loading /home/futrelle/csg120sp05/code/paip/grammar.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/unifgram.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/prologcp.lisp
;       Loading /home/futrelle/csg120sp05/code/paip/prologc.lisp
;         Loading /home/futrelle/csg120sp05/code/paip/prolog.lisp
;           Loading /home/futrelle/csg120sp05/code/paip/unify.lisp
;             Loading /home/futrelle/csg120sp05/code/paip/patmatch.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/lexicon.lisp
; Loading /home/futrelle/csg120sp05/code/paip/lexicon.lisp
("grammar" "lexicon")
> (prolog-compile-symbols)
         IF/3.
         IF/3.
         IF/3.
         TENSE-SEM/3.
         CLAUSE/9, VP/9, ADVP/7, NP/9, PP/10.
; While compiling COMPLEMENT/9:
         SLOT-CONSTITUENT/4.
         CLAUSE/9, MODIFIERS/10, SUBJECT/9.
         CLAUSE/9.
         IF/3, NP/9.
         VP/9.
         MODIFIERS/10.
         IF/3.
         NP/9.
; While compiling IF/2:
         IF/3.
NIL

Section 21.10 Word Categories
> (?- (word sees verb ?infl ?senses))
?INFL = (FINITE (- - + -) PRESENT)
?SENSES = ((UNDERSTAND ((AGT 1 (NP ?3)))
            ((EXP 1 (NP ?4)) (CON 2 (CLAUSE (THAT) (FINITE ?5 ?6)))))
           (LOOK ((AGT 1 (NP ?7)) (OBJ 2 (NP ?8))))
           (DATING ((AGT 1 (NP ?9)) (OBJ 2 (NP ?10)))))
No.
NIL
> (try s john promised kim to persuade lee to sleep)
?SEM = (AND (THE ?173 (NAME JOHN ?173)) (AGT ?173 ?2) (PAST ?2)
            (PROMISE ?2) (GOAL ?2 ?118) (THE ?118 (NAME KIM ?118))
            (CON ?2 ?130) (AGT ?173 ?130) (PERSUADE ?130)
            (GOAL ?130 ?383) (THE ?383 (NAME LEE ?383)) (CON ?130 ?340)
            (AGT ?383 ?340) (SLEEP ?340))
No.
NIL

Section 21.14 Examples
; page 746
> (try s when did john promise kim to persuade lee to sleep)
?SEM = (AND (WH ?1521 (TIME ?1870 ?1521)) (PAST ?2)
            (THE ?1703 (NAME JOHN ?1703)) (AGT ?1703 ?2) (PROMISE ?2)
            (GOAL ?2 ?1648) (THE ?1648 (NAME KIM ?1648)) (CON ?2 ?1660)
            (AGT ?1703 ?1660) (PERSUADE ?1660) (GOAL ?1660 ?1913)
            (THE ?1913 (NAME LEE ?1913)) (CON ?1660 ?1870)
            (AGT ?1913 ?1870) (SLEEP ?1870))
?SEM = (AND (WH ?1521 (TIME ?1660 ?1521)) (PAST ?2)
            (THE ?1703 (NAME JOHN ?1703)) (AGT ?1703 ?2) (PROMISE ?2)
            (GOAL ?2 ?1648) (THE ?1648 (NAME KIM ?1648)) (CON ?2 ?1660)
            (AGT ?1703 ?1660) (PERSUADE ?1660) (GOAL ?1660 ?1913)
            (THE ?1913 (NAME LEE ?1913)) (CON ?1660 ?1870)
            (AGT ?1913 ?1870) (SLEEP ?1870))
?SEM = (AND (WH ?1521 (TIME ?2 ?1521)) (PAST ?2)
            (THE ?1703 (NAME JOHN ?1703)) (AGT ?1703 ?2) (PROMISE ?2)
            (GOAL ?2 ?1648) (THE ?1648 (NAME KIM ?1648)) (CON ?2 ?1660)
            (AGT ?1703 ?1660) (PERSUADE ?1660) (GOAL ?1660 ?1913)
            (THE ?1913 (NAME LEE ?1913)) (CON ?1660 ?1870)
            (AGT ?1913 ?1870) (SLEEP ?1870))
?SEM = (AND (WH ?1521 (TIME ?1660 ?1521)) (PAST ?2)
            (THE ?1703 (NAME JOHN ?1703)) (AGT ?1703 ?2) (PROMISE ?2)
            (GOAL ?2 ?1648) (THE ?1648 (NAME KIM ?1648)) (CON ?2 ?1660)
            (AGT ?1703 ?1660) (PERSUADE ?1660) (GOAL ?1660 ?2484)
            (THE ?2484 (NAME LEE ?2484)) (CON ?1660 ?2441)
            (AGT ?2484 ?2441) (SLEEP ?2441))
No.
NIL
; page 747
> (try s kim would not have been looking for lee)
?SEM = (AND (THE ?33 (NAME KIM ?33)) (EXPECTED ?1500) (NOT ?1500)
            (PAST-PARTICIPLE ?1500) (AGT ?33 ?1500) (PROGRESSIVE ?1500)
            (SEARCH ?1500) (PAT ?1500 ?1501) (PAT ?1500 ?1501)
            (THE ?1501 (NAME LEE ?1501)))
?SEM = (AND (THE ?33 (NAME KIM ?33)) (EXPECTED ?2) (NOT ?2)
            (PAST-PARTICIPLE ?2) (AGT ?33 ?2) (PROGRESSIVE ?2)
            (LOOK ?2) (FOR ?2 ?2033) (THE ?2033 (NAME LEE ?2033)))
No.
NIL
> (try s it should not surprise you that kim does not like lee)
?SEM = (AND (MANDATORY ?2) (NOT ?2) (SURPRISE ?2) (EXP ?2 ?682)
            (PRO ?682 (LISTENER ?682)) (CON ?2 ?722)
            (THE ?725 (NAME KIM ?725)) (PRESENT ?722) (NOT ?722)
            (AGT ?725 ?722) (LIKE-1 ?722) (OBJ ?722 ?1066)
            (THE ?1066 (NAME LEE ?1066)))
No.
NIL

Chapter 21. A Grammar of English done.

Chapter 22. Scheme: An Uncommon Lisp
This chapter presents the Scheme dialect of Lisp and an interpreter for it.
Understanding the interpreter can give you a better appreciation of Lisp.

Section 22.1 A Scheme Interpreter
> (requires "interp1")
; Loading /home/futrelle/csg120sp05/code/paip/interp1.lisp
("interp1")
We're ready to try out the interpreter.  Note we provide an argument
to avoid going into a read-eval-print loop with SCHEME.  This is a new
functionality, no in the book, added to make these examples easier.
; page 760
> (scheme '(+ 2 2))
4
> (scheme '((if (= 1 2) * +) 3 4))
7
; page 761
> (scheme '((if (= 1 1) * +) 3 4))
12
> (scheme '(set! fact (lambda (n) (if (= n 0) 1 (* n (fact (- n 1)))))))
#<Interpreted Closure (:INTERNAL LENGTH=1) @ #x457673a>
> (scheme '(fact 5))
120
> (scheme '(set! table
            (lambda (f start end)
              (if (<= start end)
                  (begin (write (list start (f start))) (newline)
                   (table f (+ start 1) end))))))
#<Interpreted Closure (:INTERNAL LENGTH=1) @ #x457b132>
> (scheme '(table fact 1 10))
(1 1)
(2 2)
(3 6)
(4 24)
(5 120)
(6 720)
(7 5040)
(8 40320)
(9 362880)
(10 3628800)
NIL
> (scheme '(table (lambda (x) (* x x x)) 5 10))
(5 125)
(6 216)
(7 343)
(8 512)
(9 729)
(10 1000)
NIL

Section 22.2 Syntactic Extension with Macros
Scheme has a number of special forms that were not listed above.
These can be implemented by macros (although macros are not officially
part of Scheme).  We can test out the macro facility:
; page 765
> (scheme-macro-expand '(and p q))
(IF P (AND Q))
> (scheme-macro-expand '(and q))
Q
> (scheme-macro-expand '(let ((x 1) (y 2)) (+ x y)))
((LAMBDA (X Y) (+ X Y)) 1 2)
> (scheme-macro-expand '(letrec
                         ((even?
                           (lambda (x) (or (= x 0) (odd? (- x 1)))))
                          (odd? (lambda (x) (even? (- x 1)))))
                         (even? z)))
((LAMBDA (EVEN? ODD?)
   (SET! EVEN? (LAMBDA (X) (OR (= X 0) (ODD? (- X 1)))))
   (SET! ODD? (LAMBDA (X) (EVEN? (- X 1))))
   (EVEN? Z))
 NIL NIL)
Now let's look at uses of the macros DEFINE and LET*
> (scheme '(define (reverse l)
            (if (null? l)
                nil
              (append (reverse (cdr l)) (list (car l))))))
REVERSE
> (scheme '(reverse '(a b c d)))
(D C B A)
> (scheme '(let* ((x 5) (y (+ x x)))
             (if (or (= x 0) (and (< 0 y) (< y 20)))
                 (list x y)
               (+ y x))))
(5 10)

Section 22.4 Throw, Catch, and Call/cc
> (requires "interp3")
; Loading /home/futrelle/csg120sp05/code/paip/interp3.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/interp1.lisp
("interp3")
Non-local flow of control is provided in Scheme with a very general and
powerful procedure, CALL-WITH-CURRENT-CONTINUATION, which is often
abbreviated CALL/CC.  Here are some examples:
; page 770
> (scheme '(+ 1 (call/cc (lambda (cc) (+ 20 300)))))

321 
321
The above example ignores CC and computes (+ 1 (+ 20 300))
The next example does make use of CC:
> (scheme '(+ 1 (call/cc (lambda (cc) (+ 20 (cc 300))))))

301 
301
The above passes 300 to CC, thus bypassing the addition of 20.
It effectively throws 300 out to the catch point established by call/cc.

Chapter 22. Scheme: An Uncommon Lisp done.

Chapter 23. Compiling Lisp
Compilers are simple to write and useful to know about.
In this chapter we develop a simple compiler for Scheme.

> (requires "compile1")
; Loading /home/futrelle/csg120sp05/code/paip/compile1.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/interp1.lisp
("compile1")
Now we are ready to show the simple compiler at work:
; page 791
> (comp-show '(if (= x y) (f (g x)) (h x y (h 1 2))))
        ARGS    0       
        GVAR    X       
        GVAR    Y       
        GVAR    =       
        CALL    2       
        FJUMP   L1      
        GVAR    X       
        GVAR    G       
        CALL    1       
        GVAR    F       
        CALL    1       
        JUMP    L2      
L1:     GVAR    X       
        GVAR    Y       
        CONST   1       
        CONST   2       
        GVAR    H       
        CALL    2       
        GVAR    H       
        CALL    3       
L2:     RETURN  
NIL
Here are some places where a compiler could do better than an interpreter
(although our compiler currently does not):
; page 792
> (comp-show '(begin "doc" (write x) y))
        ARGS    0       
        CONST   doc     
        POP     
        GVAR    X       
        GVAR    WRITE   
        CALL    1       
        POP     
        GVAR    Y       
        RETURN  
NIL
We should not have to push 'doc' on the stack just to pop it off.
Here's another example:
> (comp-show '(begin (+ (* a x) (f x)) x))
        ARGS    0       
        GVAR    A       
        GVAR    X       
        GVAR    *       
        CALL    2       
        GVAR    X       
        GVAR    F       
        CALL    1       
        GVAR    +       
        CALL    2       
        POP     
        GVAR    X       
        RETURN  
NIL
Here's an example using local variables:
; page 794
> (comp-show '((lambda (x) ((lambda (y z) (f x y z)) 3 x)) 4))
        ARGS    0       
        CONST   4       
        FN      
                ARGS    1       
                CONST   3       
                LVAR    0       0       ;       X       
                FN      
                        ARGS    2       
                        LVAR    1       0       ;       X       
                        LVAR    0       0       ;       Y       
                        LVAR    0       1       ;       Z       
                        GVAR    F       
                        CALL    3       
                        RETURN  
                CALL    2       
                RETURN  
        CALL    1       
        RETURN  
NIL

Section 23.1 A Properly Tail-Recursive Compiler
Notice the two new instructions, CALLJ and SAVE
> (requires "compile2")
; Loading /home/futrelle/csg120sp05/code/paip/compile2.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/interp1.lisp
("compile2")
First we see how nested function calls work:
; page 796
> (comp-show '(f (g x)))
        ARGS    0       
        SAVE    K1      
        GVAR    X       
        GVAR    G       
        CALLJ   1       
K1:     GVAR    F       
        CALLJ   1       
NIL
In the next example we see that unneeded constants and variables in BEGIN
expressions are ignored:
; page 797
> (comp-show '(begin "doc" x (f x) y))
        ARGS    0       
        SAVE    K1      
        GVAR    X       
        GVAR    F       
        CALLJ   1       
K1:     POP     
        GVAR    Y       
        RETURN  
NIL
> (comp-show '(begin (+ (* a x) (f x)) x))
        ARGS    0       
        SAVE    K1      
        GVAR    X       
        GVAR    F       
        CALLJ   1       
K1:     POP     
        GVAR    X       
        RETURN  
NIL
Here are some examples of IF expressions:
; page 801
> (comp-show '(if p (+ x y) (* x y)))
        ARGS    0       
        GVAR    P       
        FJUMP   L1      
        GVAR    X       
        GVAR    Y       
        +       
        RETURN  
L1:     GVAR    X       
        GVAR    Y       
        *       
        RETURN  
NIL
If we put the same code inside a BEGIN we get something quite different:
; page 802
> (comp-show '(begin (if p (+ x y) (* x y)) z))
        ARGS    0       
        GVAR    Z       
        RETURN  
NIL
Here are some more examples of the compiler at work:
; page 806
> (comp-show '(if (null? (car l)) (f (+ (* a x) b)) (g (/ x 2))))
        ARGS    0       
        GVAR    L       
        CAR     
        FJUMP   L1      
        GVAR    X       
        2       
        /       
        GVAR    G       
        CALLJ   1       
L1:     GVAR    A       
        GVAR    X       
        *       
        GVAR    B       
        +       
        GVAR    F       
        CALLJ   1       
NIL
; page 807
> (comp-show '(define (last1 l)
               (if (null? (cdr l)) (car l) (last1 (cdr l)))))
        ARGS    0       
        FN      
                ARGS    1       
                LVAR    0       0       ;       L       
                CDR     
                FJUMP   L1      
                LVAR    0       0       ;       L       
                CDR     
                GVAR    LAST1   
                CALLJ   1       
L1:             LVAR    0       0       ;       L       
                CAR     
                RETURN  
        GSET    LAST1   
        POP     
        CONST   LAST1   
        RETURN  
NIL
; page 808
> (comp-show '(define (length l)
               (if (null? l) 0 (+ 1 (length (cdr l))))))
        ARGS    0       
        FN      
                ARGS    1       
                LVAR    0       0       ;       L       
                FJUMP   L2      
                1       
                SAVE    K1      
                LVAR    0       0       ;       L       
                CDR     
                GVAR    LENGTH  
                CALLJ   1       
K1:             +       
                RETURN  
L2:             0       
                RETURN  
        GSET    LENGTH  
        POP     
        CONST   LENGTH  
        RETURN  
NIL
Of course, it is possible to write LENGTH in tail-recursive fashion:
> (comp-show '(define (length l)
               (letrec
                ((len
                  (lambda (l n)
                    (if (null? l) n (len (rest l) (+ n 1))))))
                (len l 0))))
        ARGS    0       
        FN      
                ARGS    1       
                NIL     
                FN      
                        ARGS    1       
                        FN      
                                ARGS    2       
                                LVAR    0       0       ;       L       
                                FJUMP   L2      
                                SAVE    K1      
                                LVAR    0       0       ;       L       
                                GVAR    REST    
                                CALLJ   1       
K1:                             LVAR    0       1       ;       N       
                                1       
                                +       
                                LVAR    1       0       ;       LEN     
                                CALLJ   2       
L2:                             LVAR    0       1       ;       N       
                                RETURN  
                        LSET    0       0       ;       LEN     
                        POP     
                        LVAR    1       0       ;       L       
                        0       
                        LVAR    0       0       ;       LEN     
                        CALLJ   2       
                CALLJ   1       
        GSET    LENGTH  
        POP     
        CONST   LENGTH  
        RETURN  
NIL

Section 23.4 A Peephole Optimizer
In this section we investigate a simple technique that will generate
slightly better code in cases where the compiler is less than perfect.
> (requires "compile3" "compopt")
; Loading /home/futrelle/csg120sp05/code/paip/compile3.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/interp1.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/compile1.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/interp1.lisp
;   Loading /home/futrelle/csg120sp05/code/paip/compile2.lisp
;     Loading /home/futrelle/csg120sp05/code/paip/interp1.lisp
; Loading /home/futrelle/csg120sp05/code/paip/compopt.lisp
("compile3" "compopt")
; page 818
> (comp-show '(begin (if (if t 1 (f x)) (set! x 2)) x))
   0: ARGS    0       
   1: 2       
   2: GSET    X       
   3: RETURN  
NIL

Chapter 23. Compiling Lisp done.
0