EK201 HAND OUT #10 APRIL 1, 1987

  Time: 7:30-9:30 MON, 7:30-8:30 WED
  Instructor: George Carrette
  Office:     room 171, sociology building
  Hours:      6:30-7:30 Wed, on-line during evening hours

Topics: * common-lisp read-time conditionalization.
        * more tree searching
        * more game trees.

Homework: DUE MONDAY
   * modify the "2b" code to be "3b" code, that
     will represent the real tic-tac-to game.
   * write a function PLAY that will take the output of VISIT
     on a given board position, (say to a cutoff of 4 moves)
     and pick the best move(s) to make on the next turn.

Reading: Chapter 17 on Symbolic Pattern Matching.


* There are slight differences in various lisp implementations.
For example I am actually editing this file and running this code
on an LMI-LAMBDA lispmachine. A slight difference in defstruct
forces me to have to say #+LMI in some places. In eklisp,
which is built on FRANZ lisp, forms after #+LMI would be
ignored.


* Our basic function for generic operations:

(defun operation (q n)
  (or (get (type-of q) n)
      (error "unsupported operation")))

The code in ~gjc/search.l can be made generic thusly.
We also add a depth cut-off, by making the node entries
in the queue a cons of node and depth.

(defun node-name (x)
  (funcall (operation x 'node-name) x))

(defun node-children (x)
  (funcall (operation x 'node-children) x))

(defprop cons car node-name)
(defprop cons cdr node-children)

(defprop symbol symbol-node-name node-name)
(defprop symbol symbol-node-children node-children)

(defun symbol-node-name (x)
  x)

(defun symbol-node-children (x)
  (get x 'children))
				   
(defun visit-breadth-first (tree cutoff)
  (visit tree 'fifo cutoff))

(defun visit (tree qt cutoff)
  (let ((q (make-queue qt)))
    (queue-in (cons tree 0) q)
    (do ((names))
	((queue-empty q)
	 (reverse names))
      (let ((n (queue-out q)))
	(format t "~&= ~S~%" (node-name (car n)))
	(push (node-name (car n)) names)
	(when (or (not cutoff)
		  (< (cdr n) cutoff))
	  (dolist (c (node-children (car n)))
	    (or (member (node-name c) names)
		(queue-in (cons c (1+ (cdr n))) q))))))))

(setq t1 '(a (b (c (d) (e) (f (g))))
	     (h) (i (j) (k))))

Example output:

(visit-breadth-first t1 0)
= A
(A)

(visit-breadth-first t1 1)
= A
= B
= H
= I
(A B H I)

(visit-breadth-first t1 nil)
= A
= B
= H
= I
= C
= J
= K
= D
= E
= F
= G
(A B H I C J K D E F G)


* GAME TREE's, 

;; 2x2 tic-tac-to game tree.
;; (0 0) (0 1)
;; (1 0) (1 1)
;; board name is (((0 0) (0 1)) ((1 0) (1 1)))

(defstruct (2b #+LMI :named #+LMI (:print "#<2B ~S>" (2b-board 2b)))
  2b-board
  2b-superior
  2b-move
  2b-children-cache-p
  2b-children-cache)

(setq 2b-root (make-2b 2b-board '((nil nil) (nil nil))))

(defprop 2b 2b-children node-children)
(defprop 2b 2b-name node-name)

(defun 2b-name (x)
  (cons (2b-board x) (2b-moves x)))

(defun 2b-moves (x)
  (do ((moves nil (cons (2b-move node) moves))
       (node x (2b-superior node)))
      ((null (2b-superior node))
       moves)))

(defprop x o opposition)
(defprop o x opposition)
(defprop nil x opposition)

(defun 2b-children (b)
  (cond ((2b-children-cache-p b)
	 (2b-children-cache b))
	('else
	 (let ((cl))
	   (dotimes (x 2)
	     (dotimes (y 2)
	       (when (not (nth y (nth x (2b-board b))))
		 (let ((nb (copy-tree (2b-board b)))
		       (player (get (car (2b-move b)) 'opposition)))
		   (setf (nth y (nth x nb)) player)
		   (push (make-2b 2b-board nb
				  2b-superior b
				  2b-move (list player y x))
			 cl)))))
	   (setf (2b-children-cache-p b) t)
	   (setf (2b-children-cache b) cl)
	   cl))))
	 

Example output:

We can use the vist function to enumerate all possible games
of zero moves, followed by games of 1 move, 2 moves, 3 moves, etc.

The format of the output is
= (<game-board-position> . <list-of-moves>)

Where the list of moves is read right to left in order.

(visit-breadth-first 2b-root 0)
= (((NIL NIL) (NIL NIL)))

(visit-breadth-first 2b-root 1)
= (((NIL NIL) (NIL NIL)))
= (((NIL NIL) (NIL X)) (X 1 1))
= (((NIL NIL) (X NIL)) (X 0 1))
= (((NIL X) (NIL NIL)) (X 1 0))
= (((X NIL) (NIL NIL)) (X 0 0))

(visit-breadth-first 2b-root 2)
= (((NIL NIL) (NIL NIL)))
= (((NIL NIL) (NIL X)) (X 1 1))
= (((NIL NIL) (X NIL)) (X 0 1))
= (((NIL X) (NIL NIL)) (X 1 0))
= (((X NIL) (NIL NIL)) (X 0 0))
= (((NIL NIL) (O X)) (X 1 1) (O 0 1))
= (((NIL O) (NIL X)) (X 1 1) (O 1 0))
= (((O NIL) (NIL X)) (X 1 1) (O 0 0))
= (((NIL NIL) (X O)) (X 0 1) (O 1 1))
= (((NIL O) (X NIL)) (X 0 1) (O 1 0))
= (((O NIL) (X NIL)) (X 0 1) (O 0 0))
= (((NIL X) (NIL O)) (X 1 0) (O 1 1))
= (((NIL X) (O NIL)) (X 1 0) (O 0 1))
= (((O X) (NIL NIL)) (X 1 0) (O 0 0))
= (((X NIL) (NIL O)) (X 0 0) (O 1 1))
= (((X NIL) (O NIL)) (X 0 0) (O 0 1))
= (((X O) (NIL NIL)) (X 0 0) (O 1 0))