1 ;;;;***************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: edge-table.lisp
6 ;;;; Purpose: Edge table routines for reversi
7 ;;;; Programer: Kevin M. Rosenberg based on code by Peter Norvig
8 ;;;; Date Started: 1 Nov 2001
10 ;;;; $Id: edge-table.lisp,v 1.2 2002/10/25 09:23:39 kevin Exp $
12 ;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg
13 ;;;; and Copyright (c) 1998-2002 Peter Norvig
15 ;;;; Reversi users are granted the rights to distribute and use this software
16 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
17 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
18 ;;;;***************************************************************************
22 (declaim (optimize (safety 1) (debug 3) (speed 3) (compilation-speed 0)))
24 (eval-when (:compile-toplevel :load-toplevel :execute)
25 (defparameter *edge-and-x-lists*
26 '((22 11 12 13 14 15 16 17 18 27)
27 (72 81 82 83 84 85 86 87 88 77)
28 (22 11 21 31 41 51 61 71 81 72)
29 (27 18 28 38 48 58 68 78 88 77))
30 "The four edges (with their X-squares)."))
32 (defparameter *top-edge* (first *edge-and-x-lists*))
34 (defvar *edge-table* nil
35 "Array of values to player-to-move for edge positions.")
37 ;;(declaim (type (simple-array fixnum #.(expt 3 10)) *edge-table*))
39 (defun make-edge-table ()
40 (setq *edge-table* (make-array (expt 3 10) :element-type 'fixnum
41 :adjustable nil :fill-pointer nil))
46 (defun map-edge-n-pieces (fn player board n squares index)
47 "Call fn on all edges with n pieces."
48 ;; Index counts 1 for player; 2 for opponent
49 (declare (fixnum index)
52 (type (simple-array fixnum (100)) board)
55 ((< (length squares) n) nil)
56 ((null squares) (funcall fn board index))
57 (t (let ((index3 (* 3 index))
59 (declare (fixnum index3 sq))
60 (map-edge-n-pieces fn player board n (rest squares) index3)
61 (when (and (> n 0) (eql (bref board sq) empty))
62 (setf (bref board sq) player)
63 (map-edge-n-pieces fn player board (- n 1) (rest squares)
65 (setf (bref board sq) (opponent player))
66 (map-edge-n-pieces fn player board (- n 1) (rest squares)
68 (setf (bref board sq) empty))))))
72 (defun possible-edge-moves-value (player board index)
73 "Consider all possible edge moves.
74 Combine their values into a single number."
75 (declare (type board board)
80 (list 1.0 (aref *edge-table* index)) ;; no move
81 (loop for sq in *top-edge* ;; possible moves
82 when (= (bref board sq) empty)
83 collect (possible-edge-move player board sq)))
87 (defun edge-index (player board squares)
88 "The index counts 1 for player; 2 for opponent,
89 on each square---summed as a base 3 number."
90 (declare (type board board)
93 (optimize (speed 3) (safety 1)))
95 (declare (fixnum index))
97 (declare (type square sq))
101 (the fixnum (* index 3))
102 (the fixnum (cond ((= (bref board sq) empty) 0)
103 ((= (bref board sq) player) 1)
107 (defun possible-edge-move (player board sq)
108 "Return a (prob val) pair for a possible edge move."
109 (declare (type board board)
112 (let ((new-board (replace-board (svref *ply-boards* player) board)))
113 (make-move sq player new-board)
114 (list (edge-move-probability player board sq)
115 (- (aref *edge-table*
116 (edge-index (opponent player)
117 new-board *top-edge*))))))
119 (defun combine-edge-moves (possibilities player)
120 "Combine the best moves."
123 (fn (if (= player black) #'> #'<)))
124 (declare (short-float prob val))
125 (loop for pair in (sort possibilities fn :key #'second)
127 do (incf val (* prob (first pair) (second pair)))
128 (decf prob (* prob (first pair))))
132 (eval-when (:compile-toplevel :load-toplevel :execute)
133 (let ((corner/xsqs '((11 . 22) (18 . 27) (81. 72) (88 . 77))))
134 (defun corner-p (sq) (assoc sq corner/xsqs))
135 (defun x-square-p (sq) (rassoc sq corner/xsqs))
136 (defun x-square-for (corner) (cdr (assoc corner corner/xsqs)))
137 (defun corner-for (xsq) (car (rassoc xsq corner/xsqs)))))
139 (defun edge-move-probability (player board square)
140 "What's the probability that player can move to this square?"
141 (declare (type board board)
143 (type square square))
145 ((x-square-p square) .5) ;; X-squares
146 ((legal-p square player board) 1.0) ;; immediate capture
147 ((corner-p square) ;; move to corner depends on X-square
148 (let ((x-sq (x-square-for square)))
149 (declare (type square x-sq))
151 ((= (bref board x-sq) empty) .1)
152 ((= (bref board x-sq) player) 0.001)
158 (count-edge-neighbors player board square)
159 (count-edge-neighbors (opponent player) board square))
160 (if (legal-p square (opponent player) board) 2 1)))))
162 (defun count-edge-neighbors (player board square)
163 "Count the neighbors of this square occupied by player."
164 (declare (type board board)
166 (type square square))
167 (count-if #'(lambda (inc)
168 (declare (type square inc))
169 (= (bref board (+ square inc)) player))
172 (defparameter *static-edge-table*
185 (declaim (type (simple-array t (* *)) *static-edge-table*))
187 (defun static-edge-stability (player board)
188 "Compute this edge's static stability"
189 (declare (type board board)
190 (type player player))
191 (loop for sq in *top-edge*
195 ((= (bref board sq) empty) 0)
196 ((= (bref board sq) player)
197 (aref *static-edge-table* i
198 (piece-stability board sq)))
199 (t (- (aref *static-edge-table* i
200 (piece-stability board sq))))))))
202 (eval-when (:compile-toplevel :load-toplevel :execute)
203 (let ((stable 0) (semi-stable 1) (unstable 2))
204 (declaim (type fixnum stable semi-stable unstable))
206 (defun piece-stability (board sq)
207 (declare (type board board)
210 ((corner-p sq) stable)
212 (if (eql (bref board (corner-for sq)) empty)
213 unstable semi-stable))
214 (t (let* ((player (bref board sq))
215 (opp (opponent player))
216 (p1 (find player board :test-not #'eql
218 (p2 (find player board :test-not #'eql
221 (declare (fixnum player opp))
223 ;; unstable pieces can be captured immediately
224 ;; by playing in the empty square
225 ((or (and (eql p1 empty) (eql p2 opp))
226 (and (eql p2 empty) (eql p1 opp)))
228 ;; Semi-stable pieces might be captured
229 ((and (eql p1 opp) (eql p2 opp)
230 (find empty board :start 11 :end 19))
232 ((and (eql p1 empty) (eql p2 empty))
234 ;; Stable pieces can never be captured
238 (defun init-edge-table ()
239 "Initialize *edge-table*, starting from the empty board."
240 ;; Initialize the static values
241 (loop for n-pieces from 0 to 10 do
243 #'(lambda (board index)
244 (declare (type board board)
246 (setf (aref *edge-table* index)
247 (the fixnum (static-edge-stability black board))))
248 black (initial-board) n-pieces *top-edge* 0))
249 ;; Now iterate five times trying to improve:
252 ;; Do the indexes with most pieces first
253 (loop for n-pieces from 9 downto 1 do
255 #'(lambda (board index)
256 (declare (type board board)
258 (setf (aref *edge-table* index)
259 (the fixnum (possible-edge-moves-value black board index))))
260 black (initial-board) n-pieces *top-edge* 0))))