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.3 2003/05/06 15:51:20 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 ;;;;***************************************************************************
21 (in-package #:reversi)
23 (eval-when (:compile-toplevel)
24 (declaim (optimize (safety 1) (space 0) (speed 3) (compilation-speed 0))))
26 (eval-when (:compile-toplevel :load-toplevel :execute)
27 (defparameter *edge-and-x-lists*
28 '((22 11 12 13 14 15 16 17 18 27)
29 (72 81 82 83 84 85 86 87 88 77)
30 (22 11 21 31 41 51 61 71 81 72)
31 (27 18 28 38 48 58 68 78 88 77))
32 "The four edges (with their X-squares)."))
34 (defparameter *top-edge* (first *edge-and-x-lists*))
36 (defvar *edge-table* nil
37 "Array of values to player-to-move for edge positions.")
39 ;;(declaim (type (simple-array fixnum #.(expt 3 10)) *edge-table*))
41 (defun make-edge-table ()
42 (setq *edge-table* (make-array (expt 3 10) :element-type 'fixnum
43 :adjustable nil :fill-pointer nil))
48 (defun map-edge-n-pieces (fn player board n squares index)
49 "Call fn on all edges with n pieces."
50 ;; Index counts 1 for player; 2 for opponent
51 (declare (fixnum index)
54 (type (simple-array fixnum (100)) board)
57 ((< (length squares) n) nil)
58 ((null squares) (funcall fn board index))
59 (t (let ((index3 (* 3 index))
61 (declare (fixnum index3 sq))
62 (map-edge-n-pieces fn player board n (rest squares) index3)
63 (when (and (> n 0) (eql (bref board sq) empty))
64 (setf (bref board sq) player)
65 (map-edge-n-pieces fn player board (- n 1) (rest squares)
67 (setf (bref board sq) (opponent player))
68 (map-edge-n-pieces fn player board (- n 1) (rest squares)
70 (setf (bref board sq) empty))))))
74 (defun possible-edge-moves-value (player board index)
75 "Consider all possible edge moves.
76 Combine their values into a single number."
77 (declare (type board board)
82 (list 1.0 (aref *edge-table* index)) ;; no move
83 (loop for sq in *top-edge* ;; possible moves
84 when (= (bref board sq) empty)
85 collect (possible-edge-move player board sq)))
89 (defun edge-index (player board squares)
90 "The index counts 1 for player; 2 for opponent,
91 on each square---summed as a base 3 number."
92 (declare (type board board)
95 (optimize (speed 3) (safety 1)))
97 (declare (fixnum index))
99 (declare (type square sq))
103 (the fixnum (* index 3))
104 (the fixnum (cond ((= (bref board sq) empty) 0)
105 ((= (bref board sq) player) 1)
109 (defun possible-edge-move (player board sq)
110 "Return a (prob val) pair for a possible edge move."
111 (declare (type board board)
114 (let ((new-board (replace-board (svref *ply-boards* player) board)))
115 (make-move sq player new-board)
116 (list (edge-move-probability player board sq)
117 (- (aref *edge-table*
118 (edge-index (opponent player)
119 new-board *top-edge*))))))
121 (defun combine-edge-moves (possibilities player)
122 "Combine the best moves."
125 (fn (if (= player black) #'> #'<)))
126 (declare (short-float prob val))
127 (loop for pair in (sort possibilities fn :key #'second)
129 do (incf val (* prob (first pair) (second pair)))
130 (decf prob (* prob (first pair))))
134 (eval-when (:compile-toplevel :load-toplevel :execute)
135 (let ((corner/xsqs '((11 . 22) (18 . 27) (81. 72) (88 . 77))))
136 (defun corner-p (sq) (assoc sq corner/xsqs))
137 (defun x-square-p (sq) (rassoc sq corner/xsqs))
138 (defun x-square-for (corner) (cdr (assoc corner corner/xsqs)))
139 (defun corner-for (xsq) (car (rassoc xsq corner/xsqs)))))
141 (defun edge-move-probability (player board square)
142 "What's the probability that player can move to this square?"
143 (declare (type board board)
145 (type square square))
147 ((x-square-p square) .5) ;; X-squares
148 ((legal-p square player board) 1.0) ;; immediate capture
149 ((corner-p square) ;; move to corner depends on X-square
150 (let ((x-sq (x-square-for square)))
151 (declare (type square x-sq))
153 ((= (bref board x-sq) empty) .1)
154 ((= (bref board x-sq) player) 0.001)
160 (count-edge-neighbors player board square)
161 (count-edge-neighbors (opponent player) board square))
162 (if (legal-p square (opponent player) board) 2 1)))))
164 (defun count-edge-neighbors (player board square)
165 "Count the neighbors of this square occupied by player."
166 (declare (type board board)
168 (type square square))
169 (count-if #'(lambda (inc)
170 (declare (type square inc))
171 (= (bref board (+ square inc)) player))
174 (defparameter *static-edge-table*
187 (declaim (type (simple-array t (* *)) *static-edge-table*))
189 (defun static-edge-stability (player board)
190 "Compute this edge's static stability"
191 (declare (type board board)
192 (type player player))
193 (loop for sq in *top-edge*
197 ((= (bref board sq) empty) 0)
198 ((= (bref board sq) player)
199 (aref *static-edge-table* i
200 (piece-stability board sq)))
201 (t (- (aref *static-edge-table* i
202 (piece-stability board sq))))))))
204 (eval-when (:compile-toplevel :load-toplevel :execute)
205 (let ((stable 0) (semi-stable 1) (unstable 2))
206 (declaim (type fixnum stable semi-stable unstable))
208 (defun piece-stability (board sq)
209 (declare (type board board)
212 ((corner-p sq) stable)
214 (if (eql (bref board (corner-for sq)) empty)
215 unstable semi-stable))
216 (t (let* ((player (bref board sq))
217 (opp (opponent player))
218 (p1 (find player board :test-not #'eql
220 (p2 (find player board :test-not #'eql
223 (declare (fixnum player opp))
225 ;; unstable pieces can be captured immediately
226 ;; by playing in the empty square
227 ((or (and (eql p1 empty) (eql p2 opp))
228 (and (eql p2 empty) (eql p1 opp)))
230 ;; Semi-stable pieces might be captured
231 ((and (eql p1 opp) (eql p2 opp)
232 (find empty board :start 11 :end 19))
234 ((and (eql p1 empty) (eql p2 empty))
236 ;; Stable pieces can never be captured
240 (defun init-edge-table ()
241 "Initialize *edge-table*, starting from the empty board."
242 ;; Initialize the static values
243 (loop for n-pieces from 0 to 10 do
245 #'(lambda (board index)
246 (declare (type board board)
248 (setf (aref *edge-table* index)
249 (the fixnum (static-edge-stability black board))))
250 black (initial-board) n-pieces *top-edge* 0))
251 ;; Now iterate five times trying to improve:
254 ;; Do the indexes with most pieces first
255 (loop for n-pieces from 9 downto 1 do
257 #'(lambda (board index)
258 (declare (type board board)
260 (setf (aref *edge-table* index)
261 (the fixnum (possible-edge-moves-value black board index))))
262 black (initial-board) n-pieces *top-edge* 0))))