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.5 2003/06/12 13:28:55 kevin Exp $
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))
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)
54 (optimize (speed 3) (space 0) (safety 0)))
56 ((< (length squares) n) nil)
57 ((null squares) (funcall fn board index))
58 (t (let ((index3 (* 3 index))
60 (declare (fixnum index3 sq))
61 (map-edge-n-pieces fn player board n (rest squares) index3)
62 (when (and (> n 0) (eql (bref board sq) empty))
63 (setf (bref board sq) player)
64 (map-edge-n-pieces fn player board (- n 1) (rest squares)
66 (setf (bref board sq) (opponent player))
67 (map-edge-n-pieces fn player board (- n 1) (rest squares)
69 (setf (bref board sq) empty))))))
73 (defun possible-edge-moves-value (player board index)
74 "Consider all possible edge moves.
75 Combine their values into a single number."
76 (declare (type board board)
81 (list 1.0 (aref *edge-table* index)) ;; no move
82 (loop for sq in *top-edge* ;; possible moves
83 when (= (bref board sq) empty)
84 collect (possible-edge-move player board sq)))
88 (defun edge-index (player board squares)
89 "The index counts 1 for player; 2 for opponent,
90 on each square---summed as a base 3 number."
91 (declare (type board board)
94 (optimize (speed 3) (safety 0) (space 0)))
96 (declare (fixnum index))
98 (declare (type square sq))
102 (the fixnum (* index 3))
103 (the fixnum (cond ((= (bref board sq) empty) 0)
104 ((= (bref board sq) player) 1)
108 (defun possible-edge-move (player board sq)
109 "Return a (prob val) pair for a possible edge move."
110 (declare (type board board)
113 (let ((new-board (replace-board (svref *ply-boards* player) board)))
114 (make-move sq player new-board)
115 (list (edge-move-probability player board sq)
116 (- (aref *edge-table*
117 (edge-index (opponent player)
118 new-board *top-edge*))))))
120 (defun combine-edge-moves (possibilities player)
121 "Combine the best moves."
122 (declare (optimize (speed 3) (safety 0) (space 0)))
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)
146 (optimize (speed 3) (safety 0) (space 0)))
148 ((x-square-p square) .5) ;; X-squares
149 ((legal-p square player board) 1.0) ;; immediate capture
150 ((corner-p square) ;; move to corner depends on X-square
151 (let ((x-sq (x-square-for square)))
152 (declare (type square x-sq))
154 ((= (bref board x-sq) empty) .1)
155 ((= (bref board x-sq) player) 0.001)
161 (count-edge-neighbors player board square)
162 (count-edge-neighbors (opponent player) board square))
163 (if (legal-p square (opponent player) board) 2 1)))))
165 (defun count-edge-neighbors (player board square)
166 "Count the neighbors of this square occupied by player."
167 (declare (type board board)
169 (type square square))
170 (count-if #'(lambda (inc)
171 (declare (type square inc))
172 (= (bref board (+ square inc)) player))
175 (defparameter *static-edge-table*
188 (declaim (type (simple-array t (* *)) *static-edge-table*))
190 (defun static-edge-stability (player board)
191 "Compute this edge's static stability"
192 (declare (type board board)
194 (optimize (speed 3) (safety 0) (space 0)))
195 (loop for sq in *top-edge*
199 ((= (bref board sq) empty) 0)
200 ((= (bref board sq) player)
201 (aref *static-edge-table* i
202 (piece-stability board sq)))
203 (t (- (aref *static-edge-table* i
204 (piece-stability board sq))))))))
206 (eval-when (:compile-toplevel :load-toplevel :execute)
207 (let ((stable 0) (semi-stable 1) (unstable 2))
208 (declare (type fixnum stable semi-stable unstable))
210 (defun piece-stability (board sq)
211 (declare (type board board)
213 (optimize (speed 3) (safety 0) (space 0)))
215 ((corner-p sq) stable)
217 (if (eql (bref board (corner-for sq)) empty)
218 unstable semi-stable))
219 (t (let* ((player (bref board sq))
220 (opp (opponent player))
221 (p1 (find player board :test-not #'eql
223 (p2 (find player board :test-not #'eql
226 (declare (fixnum player opp))
228 ;; unstable pieces can be captured immediately
229 ;; by playing in the empty square
230 ((or (and (eql p1 empty) (eql p2 opp))
231 (and (eql p2 empty) (eql p1 opp)))
233 ;; Semi-stable pieces might be captured
234 ((and (eql p1 opp) (eql p2 opp)
235 (find empty board :start 11 :end 19))
237 ((and (eql p1 empty) (eql p2 empty))
239 ;; Stable pieces can never be captured
243 (defun init-edge-table ()
244 "Initialize *edge-table*, starting from the empty board."
245 ;; Initialize the static values
246 (declare (optimize (speed 3) (safety 0) (space 0)))
247 (loop for n-pieces from 0 to 10 do
249 #'(lambda (board index)
250 (declare (type board board)
252 (setf (aref *edge-table* index)
253 (the fixnum (static-edge-stability black board))))
254 black (initial-board) n-pieces *top-edge* 0))
255 ;; Now iterate five times trying to improve:
258 ;; Do the indexes with most pieces first
259 (loop for n-pieces fixnum from 9 downto 1 do
261 #'(lambda (board index)
262 (declare (type board board)
264 (setf (aref *edge-table* index)
265 (the fixnum (possible-edge-moves-value black board index))))
266 black (initial-board) n-pieces *top-edge* 0))))