From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Thu, 1 May 2003 19:26:46 +0000 (+0000)
Subject: r4726: *** empty log message ***
X-Git-Tag: debian-1.0.14-3~30
X-Git-Url: http://git.kpe.io/?p=reversi.git;a=commitdiff_plain;h=970bffc5f1e6a294659016aec57f17c822dee8cc

r4726: *** empty log message ***
---

diff --git a/io-clim.lisp b/io-clim.lisp
index e0146f5..61357dd 100644
--- a/io-clim.lisp
+++ b/io-clim.lisp
@@ -8,7 +8,7 @@
 ;;;;  Programer:      Kevin M. Rosenberg
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
-;;;; $Id: io-clim.lisp,v 1.9 2003/04/03 16:29:52 kevin Exp $
+;;;; $Id: io-clim.lisp,v 1.10 2003/05/01 19:26:46 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg 
 ;;;;
@@ -19,6 +19,8 @@
 
 (in-package :reversi)
 
+#+mcclim (shadowing-import 'clim-internals::stream-set-cursor-position)
+
 (defparameter cell-inner-width 40)
 (defparameter cell-inner-height 40)
 (defparameter half-cell-inner-width 20)
@@ -675,10 +677,7 @@
 		  (+ label-height (* cell-height i)
 		       half-cell-inner-height))
 		 :align-x :left :align-y :center))
-    (if (find-package 'mcclim)
-	(setf (stream-set-cursor-position stream)
-	      (values label-width label-height))
-	(stream-set-cursor-position stream label-width label-height))
+    (stream-set-cursor-position stream label-width label-height)
     (surrounding-output-with-border (stream)
       (formatting-table (stream :y-spacing 0 :x-spacing 0)
 	(dotimes (row 8)
diff --git a/original/othello-orig.lisp b/original/othello-orig.lisp
deleted file mode 100644
index d964c83..0000000
--- a/original/othello-orig.lisp
+++ /dev/null
@@ -1,451 +0,0 @@
-;;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-
-;;;; Code from Paradigms of AI Programming
-;;;; Copyright (c) 1991 Peter Norvig
-
-;;;; File othello.lisp: An othello monitor, with all strategies
-;;;; up to and including section 18.8
-
-;;; One bug fix by Alberto Segre, segre@cs.cornell.edu, March 1993.
-
-(defun mappend (fn list)
-  "Append the results of calling fn on each element of list.
-  Like mapcon, but uses append instead of nconc."
-  (apply #'append (mapcar fn list)))
-
-(defun random-elt (seq) 
-  "Pick a random element out of a sequence."
-  (elt seq (random (length seq))))
-
-(defun concat-symbol (&rest args)
-  "Concatenate symbols or strings to form an interned symbol"
-  (intern (format nil "~{~a~}" args)))
-
-(defun cross-product (fn xlist ylist)
-  "Return a list of all (fn x y) values."
-  (mappend #'(lambda (y)
-               (mapcar #'(lambda (x) (funcall fn x y))
-                       xlist))
-           ylist))
-
-(defconstant all-directions '(-11 -10 -9 -1 1 9 10 11))
-
-(defconstant empty 0 "An empty square")
-(defconstant black 1 "A black piece")
-(defconstant white 2 "A white piece")
-(defconstant outer 3 "Marks squares outside the 8x8 board")
-
-(deftype piece () `(integer ,empty ,outer))
-
-(defun name-of (piece) (char ".@O?" piece))
-
-(defun opponent (player) (if (eql player black) white black))
-
-(deftype board () '(simple-array piece (100)))
-
-(defun bref (board square) (aref board square))
-(defsetf bref (board square) (val) 
-  `(setf (aref ,board ,square) ,val))
-
-(defun copy-board (board)
-  (copy-seq board))
-
-(defconstant all-squares
-  (loop for i from 11 to 88 when (<= 1 (mod i 10) 8) collect i))
-
-(defun initial-board ()
-  "Return a board, empty except for four pieces in the middle."
-  ;; Boards are 100-element vectors, with elements 11-88 used,
-  ;; and the others marked with the sentinel OUTER.  Initially
-  ;; the 4 center squares are taken, the others empty.
-  (let ((board (make-array 100 :element-type 'piece
-                           :initial-element outer)))
-    (dolist (square all-squares)
-      (setf (bref board square) empty))
-    (setf (bref board 44) white   (bref board 45) black
-          (bref board 54) black   (bref board 55) white)
-    board))
-
-(defun count-difference (player board)
-  "Count player's pieces minus opponent's pieces."
-  (- (count player board)
-     (count (opponent player) board)))
-
-(defun valid-p (move)
-  "Valid moves are numbers in the range 11-88 that end in 1-8."
-  (and (integerp move) (<= 11 move 88) (<= 1 (mod move 10) 8)))
-
-(defun legal-p (move player board)
-  "A Legal move must be into an empty square, and it must
-  flip at least one opponent piece."
-  (and (eql (bref board move) empty)
-       (some #'(lambda (dir) (would-flip? move player board dir))
-             all-directions)))
-
-(defun make-move (move player board)
-  "Update board to reflect move by player"
-  ;; First make the move, then make any flips
-  (setf (bref board move) player)
-  (dolist (dir all-directions)
-    (make-flips move player board dir))
-  board)
-
-(defun make-flips (move player board dir)
-  "Make any flips in the given direction."
-  (let ((bracketer (would-flip? move player board dir)))
-    (when bracketer
-      (loop for c from (+ move dir) by dir until (eql c bracketer)
-            do (setf (bref board c) player)))))
-
-(defun would-flip? (move player board dir)
-  "Would this move result in any flips in this direction?
-  If so, return the square number of the bracketing piece."
-  ;; A flip occurs if, starting at the adjacent square, c, there
-  ;; is a string of at least one opponent pieces, bracketed by 
-  ;; one of player's pieces
-  (let ((c (+ move dir)))
-    (and (eql (bref board c) (opponent player))
-         (find-bracketing-piece (+ c dir) player board dir))))
-
-(defun find-bracketing-piece (square player board dir)
-  "Return the square number of the bracketing piece."
-  (cond ((eql (bref board square) player) square)
-        ((eql (bref board square) (opponent player))
-         (find-bracketing-piece (+ square dir) player board dir))
-        (t nil)))
-
-(defun next-to-play (board previous-player print)
-  "Compute the player to move next, or NIL if nobody can move."
-  (let ((opp (opponent previous-player)))
-    (cond ((any-legal-move? opp board) opp)
-          ((any-legal-move? previous-player board) 
-           (when print
-             (format t "~&~c has no moves and must pass."
-                     (name-of opp)))
-           previous-player)
-          (t nil))))
-
-(defun any-legal-move? (player board)
-  "Does player have any legal moves in this position?"
-  (some #'(lambda (move) (legal-p move player board))
-        all-squares))
-
-(defun random-strategy (player board)
-  "Make any legal move."
-  (random-elt (legal-moves player board)))
-
-(defun legal-moves (player board)
-  "Returns a list of legal moves for player"
-  ;;*** fix, segre, 3/30/93.  Was remove-if, which can share with all-squares.
-  (loop for move in all-squares
-	when (legal-p move player board) collect move))
-
-(defun maximize-difference (player board)
-  "A strategy that maximizes the difference in pieces."
-  (funcall (maximizer #'count-difference) player board))
-
-(defun maximizer (eval-fn)
-  "Return a strategy that will consider every legal move,
-  apply EVAL-FN to each resulting board, and choose 
-  the move for which EVAL-FN returns the best score.
-  FN takes two arguments: the player-to-move and board"
-  #'(lambda (player board)
-      (let* ((moves (legal-moves player board))
-             (scores (mapcar #'(lambda (move)
-				 (funcall
-				  eval-fn
-				  player
-				  (make-move move player
-					     (copy-board board))))
-                             moves))
-             (best  (apply #'max scores)))
-        (elt moves (position best scores)))))
-
-(defparameter *weights*
-  '#(0   0   0  0  0  0  0   0   0 0
-     0 120 -20 20  5  5 20 -20 120 0
-     0 -20 -40 -5 -5 -5 -5 -40 -20 0
-     0  20  -5 15  3  3 15  -5  20 0
-     0   5  -5  3  3  3  3  -5   5 0
-     0   5  -5  3  3  3  3  -5   5 0
-     0  20  -5 15  3  3 15  -5  20 0
-     0 -20 -40 -5 -5 -5 -5 -40 -20 0
-     0 120 -20 20  5  5 20 -20 120 0
-     0   0   0  0  0  0  0   0   0 0))
-
-(defun weighted-squares (player board)
-  "Sum of the weights of player's squares minus opponent's."
-  (let ((opp (opponent player)))
-    (loop for i in all-squares
-          when (eql (bref board i) player) 
-          sum (aref *weights* i)
-          when (eql (bref board i) opp)
-          sum (- (aref *weights* i)))))
-
-(defconstant winning-value most-positive-fixnum)
-(defconstant losing-value  most-negative-fixnum)
-
-(defun final-value (player board)
-  "Is this a win, loss, or draw for player?"
-  (case (signum (count-difference player board))
-    (-1 losing-value)
-    ( 0 0)
-    (+1 winning-value)))
-
-(defun minimax (player board ply eval-fn)
-  "Find the best move, for PLAYER, according to EVAL-FN,
-  searching PLY levels deep and backing up values."
-  (if (= ply 0)
-      (funcall eval-fn player board)
-      (let ((moves (legal-moves player board)))
-        (if (null moves)
-            (if (any-legal-move? (opponent player) board)
-                (- (minimax (opponent player) board
-                            (- ply 1) eval-fn))
-                (final-value player board))
-            (let ((best-move nil)
-                  (best-val nil))
-              (dolist (move moves)
-                (let* ((board2 (make-move move player
-                                          (copy-board board)))
-                       (val (- (minimax
-                                 (opponent player) board2
-                                 (- ply 1) eval-fn))))
-                  (when (or (null best-val)
-                            (> val best-val))
-                    (setf best-val val)
-                    (setf best-move move))))
-              (values best-val best-move))))))
-
-(defun minimax-searcher (ply eval-fn)
-  "A strategy that searches PLY levels and then uses EVAL-FN."
-  #'(lambda (player board)
-      (multiple-value-bind (value move)
-          (minimax player board ply eval-fn) 
-        (declare (ignore value))
-        move)))
-
-(defun alpha-beta (player board achievable cutoff ply eval-fn)
-  "Find the best move, for PLAYER, according to EVAL-FN,
-  searching PLY levels deep and backing up values,
-  using cutoffs whenever possible."
-  (if (= ply 0)
-      (funcall eval-fn player board)
-      (let ((moves (legal-moves player board)))
-        (if (null moves)
-            (if (any-legal-move? (opponent player) board)
-                (- (alpha-beta (opponent player) board
-                               (- cutoff) (- achievable)
-                               (- ply 1) eval-fn))
-                (final-value player board))
-            (let ((best-move (first moves)))
-              (loop for move in moves do
-                (let* ((board2 (make-move move player
-                                          (copy-board board)))
-                       (val (- (alpha-beta
-                                 (opponent player) board2
-                                 (- cutoff) (- achievable)
-                                 (- ply 1) eval-fn))))
-                  (when (> val achievable)
-                    (setf achievable val)
-                    (setf best-move move)))
-                until (>= achievable cutoff))
-              (values achievable best-move))))))
-
-(defun alpha-beta-searcher (depth eval-fn)
-  "A strategy that searches to DEPTH and then uses EVAL-FN."
-  #'(lambda (player board)
-      (multiple-value-bind (value move)
-          (alpha-beta player board losing-value winning-value
-                      depth eval-fn) 
-        (declare (ignore value))
-        move)))
-
-(defun modified-weighted-squares (player board)
-  "Like WEIGHTED-SQUARES, but don't take off for moving
-  near an occupied corner."
-  (let ((w (weighted-squares player board)))
-    (dolist (corner '(11 18 81 88))
-      (when (not (eql (bref board corner) empty))
-        (dolist (c (neighbors corner))
-          (when (not (eql (bref board c) empty))
-            (incf w (* (- 5 (aref *weights* c))
-                       (if (eql (bref board c) player)
-                           +1 -1)))))))
-    w))
-
-(let ((neighbor-table (make-array 100 :initial-element nil)))
-  ;; Initialize the neighbor table
-  (dolist (square all-squares)
-    (dolist (dir all-directions)
-      (if (valid-p (+ square dir))
-          (push (+ square dir)
-                (aref neighbor-table square)))))
-
-  (defun neighbors (square)
-    "Return a list of all squares adjacent to a square."
-    (aref neighbor-table square)))
-
-(let ((square-names 
-        (cross-product #'concat-symbol
-                       '(? a b c d e f g h ?)
-                       '(? 1 2 3 4 5 6 7 8 ?))))
-
-  (defun h8->88 (str)
-    "Convert from alphanumeric to numeric square notation."
-    (or (position (string str) square-names :test #'string-equal)
-        str))
-
-  (defun 88->h8 (num)
-    "Convert from numeric to alphanumeric square notation."
-    (if (valid-p num)
-        (elt square-names num)
-        num)))
-
-(defun human (player board)
-  "A human player for the game of Othello"
-  (format t "~&~c to move ~a: " (name-of player)
-          (mapcar #'88->h8 (legal-moves player board)))
-  (h8->88 (read)))
-
-(defvar *move-number* 1 "The number of the move to be played")
-
-(defun othello (bl-strategy wh-strategy 
-                &optional (print t) (minutes 30))
-  "Play a game of othello.  Return the score, where a positive
-  difference means black, the first player, wins."
-  (let ((board (initial-board))
-        (clock (make-array (+ 1 (max black white))
-                           :initial-element 
-                           (* minutes 60 
-                              internal-time-units-per-second))))
-    (catch 'game-over
-      (loop for *move-number* from 1
-            for player = black then (next-to-play board player print)
-            for strategy = (if (eql player black) 
-                               bl-strategy
-                               wh-strategy)
-            until (null player)
-            do (get-move strategy player board print clock))
-      (when print
-        (format t "~&The game is over.  Final result:")
-        (print-board board clock))
-      (count-difference black board))))
-
-(defvar *clock* (make-array 3) "A copy of the game clock")
-(defvar *board* (initial-board) "A copy of the game board")
-
-(defun get-move (strategy player board print clock)
-  "Call the player's strategy function to get a move.
-  Keep calling until a legal move is made."
-  ;; Note we don't pass the strategy function the REAL board.
-  ;; If we did, it could cheat by changing the pieces on the board.
-  (when print (print-board board clock))
-  (replace *clock* clock)
-  (let* ((t0 (get-internal-real-time))
-         (move (funcall strategy player (replace *board* board)))
-         (t1 (get-internal-real-time)))
-    (decf (elt clock player) (- t1 t0))
-    (cond
-      ((< (elt clock player) 0)
-       (format t "~&~c has no time left and forfeits."
-               (name-of player))
-       (THROW 'game-over (if (eql player black) -64 64)))
-      ((eq move 'resign)
-       (THROW 'game-over (if (eql player black) -64 64)))
-      ((and (valid-p move) (legal-p move player board))
-       (when print
-         (format t "~&~c moves to ~a." 
-                 (name-of player) (88->h8 move)))
-       (make-move move player board))
-      (t (warn "Illegal move: ~a" (88->h8 move))
-         (get-move strategy player board print clock)))))
-
-(defun print-board (&optional (board *board*) clock)
-  "Print a board, along with some statistics."
-  ;; First print the header and the current score
-  (format t "~2&    a b c d e f g h   [~c=~2a ~c=~2a (~@d)]"
-          (name-of black) (count black board)
-          (name-of white) (count white board)
-          (count-difference black board))
-  ;; Print the board itself
-  (loop for row from 1 to 8 do
-        (format t "~&  ~d " row)
-        (loop for col from 1 to 8
-              for piece = (bref board (+ col (* 10 row)))
-              do (format t "~c " (name-of piece))))
-  ;; Finally print the time remaining for each player
-  (when clock
-    (format t "  [~c=~a ~c=~a]~2&"
-            (name-of black) (time-string (elt clock black))
-            (name-of white) (time-string (elt clock white)))))
-
-(defun time-string (time)
-  "Return a string representing this internal time in min:secs."
-  (multiple-value-bind (min sec)
-      (floor (round time internal-time-units-per-second) 60)
-    (format nil "~2d:~2,'0d" min sec)))
-
-(defun random-othello-series (strategy1 strategy2 
-                              n-pairs &optional (n-random 10))
-  "Play a series of 2*n games, starting from a random position."
-  (othello-series
-    (switch-strategies #'random-strategy n-random strategy1)
-    (switch-strategies #'random-strategy n-random strategy2)
-    n-pairs))
-
-(defun switch-strategies (strategy1 m strategy2)
-  "Make a new strategy that plays strategy1 for m moves,
-  then plays according to strategy2."
-  #'(lambda (player board)
-      (funcall (if (<= *move-number* m) strategy1 strategy2)
-               player board)))
-
-(defun othello-series (strategy1 strategy2 n-pairs)
-  "Play a series of 2*n-pairs games, swapping sides."
-  (let ((scores
-          (loop repeat n-pairs
-             for random-state = (make-random-state)
-             collect (othello strategy1 strategy2 nil)
-             do (setf *random-state* random-state)
-             collect (- (othello strategy2 strategy1 nil)))))
-    ;; Return the number of wins (1/2 for a tie),
-    ;; the total of the point differences, and the
-    ;; scores themselves, all from strategy1's point of view.
-    (values (+ (count-if #'plusp scores)
-               (/ (count-if #'zerop scores) 2))
-            (apply #'+ scores)
-            scores)))
-
-(defun round-robin (strategies n-pairs &optional
-                    (n-random 10) (names strategies))
-  "Play a tournament among the strategies.
-  N-PAIRS = games each strategy plays as each color against
-  each opponent.  So with N strategies, a total of
-  N*(N-1)*N-PAIRS games are played."
-  (let* ((N (length strategies))
-         (totals (make-array N :initial-element 0))
-         (scores (make-array (list N N)
-                             :initial-element 0)))
-    ;; Play the games
-    (dotimes (i N)
-      (loop for j from (+ i 1) to (- N 1) do 
-          (let* ((wins (random-othello-series
-                         (elt strategies i)
-                         (elt strategies j)
-                         n-pairs n-random))
-                 (losses (- (* 2 n-pairs) wins)))
-            (incf (aref scores i j) wins)
-            (incf (aref scores j i) losses)
-            (incf (aref totals i) wins)
-            (incf (aref totals j) losses))))
-    ;; Print the results
-    (dotimes (i N)
-      (format t "~&~a~20T ~4f: " (elt names i) (elt totals i))
-      (dotimes (j N)
-        (format t "~4f " (if (= i j) '---
-                             (aref scores i j)))))))
-
-(defun mobility (player board)
-  "The number of moves a player has."
-  (length (legal-moves player board)))
-
diff --git a/original/othello2-orig.lisp b/original/othello2-orig.lisp
deleted file mode 100644
index 001d305..0000000
--- a/original/othello2-orig.lisp
+++ /dev/null
@@ -1,357 +0,0 @@
-;;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-
-;;;; Code from Paradigms of AI Programming
-;;;; Copyright (c) 1991 Peter Norvig
-
-;;;; File othello2.lisp:  More strategies for othello.lisp,
-;;;; from section 18.9 onward (alpha-beta2, alpha-beta3, iago).
-;;;; If a compiled version of edge-table.lisp exists, then merely
-;;;; load it after you load this file.  Otherwise, load this file,
-;;;; evaluate (init-edge-table) (this will take a really long time),
-;;;; then compile edge-table.lisp.  This will save the edge-table for
-;;;; future use.
-
-;(requires "othello")
-
-(defconstant all-squares
-  (sort (loop for i from 11 to 88 
-	      when (<= 1 (mod i 10) 8) collect i)
-        #'> :key #'(lambda (sq) (elt *weights* sq))))
-
-(defstruct (node) square board value)
-
-(defun alpha-beta-searcher2 (depth eval-fn)
-  "Return a strategy that does A-B search with sorted moves."
-  #'(lambda (player board)
-      (multiple-value-bind (value node)
-          (alpha-beta2
-            player (make-node :board board
-                              :value (funcall eval-fn player board))
-            losing-value winning-value depth eval-fn)
-        (declare (ignore value))
-        (node-square node))))
-
-(defun alpha-beta2 (player node achievable cutoff ply eval-fn)
-  "A-B search, sorting moves by eval-fn"
-  ;; Returns two values: achievable-value and move-to-make
-  (if (= ply 0)
-      (values (node-value node) node)
-      (let* ((board (node-board node))
-             (nodes (legal-nodes player board eval-fn)))
-        (if (null nodes)
-            (if (any-legal-move? (opponent player) board)
-                (values (- (alpha-beta2 (opponent player)
-                                        (negate-value node)
-                                        (- cutoff) (- achievable)
-                                        (- ply 1) eval-fn))
-                        nil)
-                (values (final-value player board) nil))
-            (let ((best-node (first nodes)))
-              (loop for move in nodes
-                    for val = (- (alpha-beta2
-                                   (opponent player)
-                                   (negate-value move)
-                                   (- cutoff) (- achievable)
-                                   (- ply 1) eval-fn))
-                    do (when (> val achievable)
-                         (setf achievable val)
-                         (setf best-node move))
-                    until (>= achievable cutoff))
-              (values achievable best-node))))))
-
-(defun negate-value (node)
-  "Set the value of a node to its negative."
-  (setf (node-value node) (- (node-value node)))
-  node)
-
-(defun legal-nodes (player board eval-fn)
-  "Return a list of legal moves, each one packed into a node."
-  (let ((moves (legal-moves player board)))
-    (sort (map-into
-            moves
-            #'(lambda (move)
-                (let ((new-board (make-move move player
-                                            (copy-board board))))
-                  (make-node
-                    :square move :board new-board
-                    :value (funcall eval-fn player new-board))))
-            moves)
-          #'> :key #'node-value)))
-
-(defvar *ply-boards*
-  (apply #'vector (loop repeat 40 collect (initial-board))))
-
-(defun alpha-beta3 (player board achievable cutoff ply eval-fn
-                    killer)
-  "A-B search, putting killer move first."
-  (if (= ply 0)
-      (funcall eval-fn player board)
-      (let ((moves (put-first killer (legal-moves player board))))
-        (if (null moves)
-            (if (any-legal-move? (opponent player) board)
-                (- (alpha-beta3 (opponent player) board
-                                (- cutoff) (- achievable)
-                                (- ply 1) eval-fn nil))
-                (final-value player board))
-            (let ((best-move (first moves))
-                  (new-board (aref *ply-boards* ply))
-                  (killer2 nil)
-                  (killer2-val winning-value))
-              (loop for move in moves
-                    do (multiple-value-bind (val reply)
-                           (alpha-beta3
-                             (opponent player)
-                             (make-move move player
-                                        (replace new-board board))
-                             (- cutoff) (- achievable)
-                             (- ply 1) eval-fn killer2)
-                         (setf val (- val))
-                         (when (> val achievable)
-                           (setf achievable val)
-                           (setf best-move move))
-                         (when (and reply (< val killer2-val))
-                           (setf killer2 reply)
-                           (setf killer2-val val)))
-                    until (>= achievable cutoff))
-              (values achievable best-move))))))
-
-(defun alpha-beta-searcher3 (depth eval-fn)
-  "Return a strategy that does A-B search with killer moves."
-  #'(lambda (player board)
-      (multiple-value-bind (value move)
-          (alpha-beta3 player board losing-value winning-value
-                       depth eval-fn nil)
-        (declare (ignore value))
-        move)))
-
-(defun put-first (killer moves)
-  "Move the killer move to the front of moves,
-  if the killer move is in fact a legal move."
-  (if (member killer moves)
-      (cons killer (delete killer moves))
-      moves))
-
-(defun mobility (player board)
-  "Current Mobility is the number of legal moves.
-  Potential mobility is the number of blank squares
-  adjacent to an opponent that are not legal moves.
-  Returns current and potential mobility for player."
-  (let ((opp (opponent player))
-        (current 0)    ; player's current mobility
-        (potential 0)) ; player's potential mobility
-    (dolist (square all-squares)
-      (when (eql (bref board square) empty)
-        (cond ((legal-p square player board)
-               (incf current))
-              ((some #'(lambda (sq) (eql (bref board sq) opp))
-                     (neighbors square))
-               (incf potential)))))
-    (values current (+ current potential))))
-
-(defvar *edge-table* (make-array (expt 3 10))
-  "Array of values to player-to-move for edge positions.")
-
-(defconstant edge-and-x-lists
-  '((22 11 12 13 14 15 16 17 18 27)
-    (72 81 82 83 84 85 86 87 88 77)
-    (22 11 21 31 41 51 61 71 81 72)
-    (27 18 28 38 48 58 68 78 88 77))
-  "The four edges (with their X-squares).")
-
-(defun edge-index (player board squares)
-  "The index counts 1 for player; 2 for opponent,
-  on each square---summed as a base 3 number."
-  (let ((index 0))
-    (dolist (sq squares)
-      (setq index (+ (* index 3)
-                     (cond ((eql (bref board sq) empty) 0)
-                           ((eql (bref board sq) player) 1)
-                           (t 2)))))
-    index))
-
-(defun edge-stability (player board)
-  "Total edge evaluation for player to move on board."
-  (loop for edge-list in edge-and-x-lists
-        sum (aref *edge-table*
-                  (edge-index player board edge-list))))
-
-(defconstant top-edge (first edge-and-x-lists))
-
-(defun init-edge-table ()
-  "Initialize *edge-table*, starting from the empty board."
-  ;; Initialize the static values
-  (loop for n-pieces from 0 to 10 do 
-        (map-edge-n-pieces
-          #'(lambda (board index)
-              (setf (aref *edge-table* index)
-                    (static-edge-stability black board)))
-          black (initial-board) n-pieces top-edge 0))
-  ;; Now iterate five times trying to improve:
-  (dotimes (i 5) 
-    ;; Do the indexes with most pieces first
-    (loop for n-pieces from 9 downto 1 do 
-          (map-edge-n-pieces
-            #'(lambda (board index)
-                (setf (aref *edge-table* index)
-                      (possible-edge-moves-value
-                        black board index)))
-            black (initial-board) n-pieces top-edge 0))))
-
-(defun map-edge-n-pieces (fn player board n squares index)
-  "Call fn on all edges with n pieces."
-  ;; Index counts 1 for player; 2 for opponent
-  (cond
-    ((< (length squares) n) nil)
-    ((null squares) (funcall fn board index))
-    (t (let ((index3 (* 3 index))
-             (sq (first squares)))
-         (map-edge-n-pieces fn player board n (rest squares) index3)
-         (when (and (> n 0) (eql (bref board sq) empty))
-           (setf (bref board sq) player)
-           (map-edge-n-pieces fn player board (- n 1) (rest squares)
-                              (+ 1 index3))
-           (setf (bref board sq) (opponent player))
-           (map-edge-n-pieces fn player board (- n 1) (rest squares)
-                              (+ 2 index3))
-           (setf (bref board sq) empty))))))
-
-(defun possible-edge-moves-value (player board index)
-  "Consider all possible edge moves. 
-  Combine their values into a single number."
-  (combine-edge-moves
-    (cons
-      (list 1.0 (aref *edge-table* index)) ;; no move
-      (loop for sq in top-edge             ;; possible moves
-            when (eql (bref board sq) empty)
-            collect (possible-edge-move player board sq)))
-    player))
-
-(defun possible-edge-move (player board sq)
-  "Return a (prob val) pair for a possible edge move."
-  (let ((new-board (replace (aref *ply-boards* player) board)))
-    (make-move sq player new-board)
-    (list (edge-move-probability player board sq)
-          (- (aref *edge-table*
-                   (edge-index (opponent player)
-                               new-board top-edge))))))
-
-(defun combine-edge-moves (possibilities player)
-  "Combine the best moves."
-  (let ((prob 1.0)
-        (val 0.0)
-        (fn (if (eql player black) #'> #'<)))
-    (loop for pair in (sort possibilities fn :key #'second)
-          while (>= prob 0.0)
-          do (incf val (* prob (first pair) (second pair)))
-             (decf prob (* prob (first pair))))
-    (round val)))
-
-(let ((corner/xsqs '((11 . 22) (18 . 27) (81. 72) (88 . 77))))
-  (defun corner-p (sq) (assoc sq corner/xsqs))
-  (defun x-square-p (sq) (rassoc sq corner/xsqs))
-  (defun x-square-for (corner) (cdr (assoc corner corner/xsqs)))
-  (defun corner-for (xsq) (car (rassoc xsq corner/xsqs))))
-
-(defun edge-move-probability (player board square)
-  "What's the probability that player can move to this square?"
-  (cond
-    ((x-square-p square) .5) ;; X-squares
-    ((legal-p square player board) 1.0) ;; immediate capture
-    ((corner-p square) ;; move to corner depends on X-square
-     (let ((x-sq (x-square-for square)))
-       (cond
-         ((eql (bref board x-sq) empty) .1)
-         ((eql (bref board x-sq) player) 0.001)
-         (t .9))))
-    (t (/ (aref
-            '#2A((.1  .4 .7)
-                 (.05 .3  *)
-                 (.01  *  *))
-            (count-edge-neighbors player board square)
-            (count-edge-neighbors (opponent player) board square))
-          (if (legal-p square (opponent player) board) 2 1)))))
-
-(defun count-edge-neighbors (player board square)
-  "Count the neighbors of this square occupied by player."
-  (count-if #'(lambda (inc)
-                (eql (bref board (+ square inc)) player))
-            '(+1 -1)))
-
-(defparameter *static-edge-table*
-  '#2A(;stab  semi    un 
-       (   *    0 -2000) ; X
-       ( 700    *     *) ; corner
-       (1200  200   -25) ; C
-       (1000  200    75) ; A
-       (1000  200    50) ; B
-       (1000  200    50) ; B
-       (1000  200    75) ; A
-       (1200  200   -25) ; C
-       ( 700    *     *) ; corner
-       (   *    0 -2000) ; X
-       ))
-
-(defun static-edge-stability (player board)
-  "Compute this edge's static stability"
-  (loop for sq in top-edge
-        for i from 0
-        sum (cond
-              ((eql (bref board sq) empty) 0)
-              ((eql (bref board sq) player)
-               (aref *static-edge-table* i
-                     (piece-stability board sq)))
-              (t (- (aref *static-edge-table* i
-                          (piece-stability board sq)))))))
-
-(let ((stable 0) (semi-stable 1) (unstable 2))
-  
-  (defun piece-stability (board sq)
-    (cond
-      ((corner-p sq) stable)
-      ((x-square-p sq)
-       (if (eql (bref board (corner-for sq)) empty)
-           unstable semi-stable))
-      (t (let* ((player (bref board sq))
-                (opp (opponent player))
-                (p1 (find player board :test-not #'eql
-                          :start sq :end 19))
-                (p2 (find player board :test-not #'eql
-                          :start 11 :end sq
-                          :from-end t)))
-           (cond
-             ;; unstable pieces can be captured immediately
-             ;; by playing in the empty square
-             ((or (and (eql p1 empty) (eql p2 opp))
-                  (and (eql p2 empty) (eql p1 opp)))
-              unstable)
-             ;; Semi-stable pieces might be captured
-             ((and (eql p1 opp) (eql p2 opp)
-                   (find empty board :start 11 :end 19))
-              semi-stable)
-             ((and (eql p1 empty) (eql p2 empty))
-              semi-stable)
-             ;; Stable pieces can never be captured
-             (t stable)))))))
-
-(defun Iago-eval (player board)
-  "Combine edge-stability, current mobility and
-  potential mobility to arrive at an evaluation."
-  ;; The three factors are multiplied by coefficients
-  ;; that vary by move number:
-  (let ((c-edg (+ 312000 (* 6240 *move-number*)))
-        (c-cur (if (< *move-number* 25)
-                   (+ 50000 (* 2000 *move-number*))
-                   (+ 75000 (* 1000 *move-number*))))
-        (c-pot 20000))
-    (multiple-value-bind (p-cur p-pot)
-        (mobility player board)
-      (multiple-value-bind (o-cur o-pot)
-          (mobility (opponent player) board)
-        ;; Combine the three factors into one sum:
-        (+ (round (* c-edg (edge-stability player board)) 32000)
-           (round (* c-cur (- p-cur o-cur)) (+ p-cur o-cur 2))
-           (round (* c-pot  (- p-pot o-pot)) (+ p-pot o-pot 2)))))))
-
-(defun Iago (depth)
-  "Use an approximation of Iago's evaluation function."
-  (alpha-beta-searcher3 depth #'iago-eval))
-