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
12 ;;;; This file is Copyright (c) 2001-2003 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)
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))
45 (deftype edge-table () '(simple-array fixnum (*)))
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 n index)
54 (type (simple-array fixnum (100)) board)
56 (optimize (speed 3) (space 0) (safety 0)))
58 ((< (length squares) n) nil)
59 ((null squares) (funcall fn board index))
60 (t (let ((index3 (* 3 index))
62 (declare (fixnum index3 sq))
63 (map-edge-n-pieces fn player board n (rest squares) index3)
64 (when (and (plusp n) (= (bref board sq) empty))
65 (setf (bref board sq) player)
66 (map-edge-n-pieces fn player board (- n 1) (rest squares)
68 (setf (bref board sq) (opponent player))
69 (map-edge-n-pieces fn player board (- n 1) (rest squares)
71 (setf (bref board sq) empty))))))
75 (defun possible-edge-moves-value (player board index)
76 "Consider all possible edge moves.
77 Combine their values into a single number."
78 (declare (type board board)
83 (list 1f0 (aref *edge-table* index)) ;; no move
84 (loop for sq in *top-edge* ;; possible moves
85 when (= (bref board sq) empty)
86 collect (possible-edge-move player board sq)))
90 (defun edge-index (player board squares)
91 "The index counts 1 for player; 2 for opponent,
92 on each square---summed as a base 3 number."
93 (declare (type board board)
96 (optimize (speed 3) (safety 0) (space 0)))
98 (declare (fixnum index))
100 (declare (type square sq))
104 (the fixnum (* index 3))
105 (the fixnum (cond ((= (bref board sq) empty) 0)
106 ((= (bref board sq) player) 1)
110 (defun possible-edge-move (player board sq)
111 "Return a (prob val) pair for a possible edge move."
112 (declare (type board board)
115 (let ((new-board (replace-board (svref *ply-boards* player) board)))
116 (make-move sq player new-board)
117 (list (edge-move-probability player board sq)
118 (- (aref *edge-table*
119 (edge-index (opponent player)
120 new-board *top-edge*))))))
122 (defun combine-edge-moves (possibilities player)
123 "Combine the best moves."
124 (declare (type player player)
126 (optimize (speed 3) (safety 0) (space 0)))
129 (fn (if (= player black) #'> #'<)))
130 (declare (short-float prob val))
131 (loop for pair in (sort possibilities fn :key #'second)
133 do (incf val (* prob (first pair) (second pair)))
134 (decf prob (* prob (first pair))))
138 (eval-when (:compile-toplevel :load-toplevel :execute)
139 (let ((corner/xsqs '((11 . 22) (18 . 27) (81 . 72) (88 . 77))))
140 (defun corner-p (sq) (assoc sq corner/xsqs))
141 (defun x-square-p (sq) (rassoc sq corner/xsqs))
142 (defun x-square-for (corner) (cdr (assoc corner corner/xsqs)))
143 (defun corner-for (xsq) (car (rassoc xsq corner/xsqs)))))
145 (defun edge-move-probability (player board square)
146 "What's the probability that player can move to this square?"
147 (declare (type board board)
150 (optimize (speed 3) (safety 0) (space 0)))
152 ((x-square-p square) 5f-1) ;; X-squares
153 ((legal-p square player board) 1f0) ;; immediate capture
154 ((corner-p square) ;; move to corner depends on X-square
155 (let ((x-sq (x-square-for square)))
156 (declare (type square x-sq))
158 ((= (bref board x-sq) empty) 1f-1)
159 ((= (bref board x-sq) player) 1f-4)
162 '#2A((1f-1 4f-1 7f-1)
165 (count-edge-neighbors player board square)
166 (count-edge-neighbors (opponent player) board square))
167 (if (legal-p square (opponent player) board) 2 1)))))
169 (defun count-edge-neighbors (player board square)
170 "Count the neighbors of this square occupied by player."
171 (declare (type board board)
173 (type square square))
174 (count-if #'(lambda (inc)
175 (declare (type square inc))
176 (= (bref board (+ square inc)) player))
179 (defparameter *static-edge-table*
192 (declaim (type (simple-array t (* *)) *static-edge-table*))
194 (defun static-edge-stability (player board)
195 "Compute this edge's static stability"
196 (declare (type board board)
198 (optimize (speed 3) (safety 0) (space 0)))
199 (loop for sq in *top-edge*
203 ((= (bref board sq) empty) 0)
204 ((= (bref board sq) player)
205 (aref *static-edge-table* i
206 (piece-stability board sq)))
207 (t (- (aref *static-edge-table* i
208 (piece-stability board sq))))))))
210 (eval-when (:compile-toplevel :load-toplevel :execute)
211 (let ((stable 0) (semi-stable 1) (unstable 2))
212 (declare (type fixnum stable semi-stable unstable))
214 (defun piece-stability (board sq)
215 (declare (type board board)
217 (optimize (speed 3) (safety 0) (space 0)))
219 ((corner-p sq) stable)
221 (if (eql (bref board (corner-for sq)) empty)
222 unstable semi-stable))
223 (t (let* ((player (bref board sq))
224 (opp (opponent player))
225 (p1 (find player board :test-not #'eql
227 (p2 (find player board :test-not #'eql
230 (declare (fixnum player opp))
232 ;; unstable pieces can be captured immediately
233 ;; by playing in the empty square
234 ((or (and (eql p1 empty) (eql p2 opp))
235 (and (eql p2 empty) (eql p1 opp)))
237 ;; Semi-stable pieces might be captured
238 ((and (eql p1 opp) (eql p2 opp)
239 (find empty board :start 11 :end 19))
241 ((and (eql p1 empty) (eql p2 empty))
243 ;; Stable pieces can never be captured
247 (defun init-edge-table ()
248 "Initialize *edge-table*, starting from the empty board."
249 ;; Initialize the static values
250 (declare (optimize (speed 3) (safety 0) (space 0)))
251 (loop for n-pieces from 0 to 10 do
253 #'(lambda (board index)
254 (declare (type board board)
256 (setf (aref *edge-table* index)
257 (the fixnum (static-edge-stability black board))))
258 black (initial-board) n-pieces *top-edge* 0))
259 ;; Now iterate five times trying to improve:
262 ;; Do the indexes with most pieces first
263 (loop for n-pieces fixnum from 9 downto 1 do
265 #'(lambda (board index)
266 (declare (type board board)
268 (setf (aref *edge-table* index)
269 (the fixnum (possible-edge-moves-value black board index))))
270 black (initial-board) n-pieces *top-edge* 0))))