edge-table.lisp

   1 ;;;;***************************************************************************
   2 ;;;;
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   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
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg
  13 ;;;; and Copyright (c) 1998-2002 Peter Norvig
  14 ;;;;
  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 ;;;;***************************************************************************
  19
  20
  21 (in-package #:reversi)
  22
  23
  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)."))
  31
  32 (defparameter *top-edge* (first *edge-and-x-lists*))
  33
  34 (defvar *edge-table* nil
  35   "Array of values to player-to-move for edge positions.")
  36
  37 ;;(declaim (type (simple-array fixnum #.(expt 3 10)) *edge-table*))
  38
  39 (defun make-edge-table ()
  40   (setq *edge-table* (make-array (expt 3 10) :element-type 'fixnum
  41                                  :adjustable nil :fill-pointer nil))
  42   (init-edge-table)
  43   *edge-table*)
  44
  45 (deftype edge-table () '(simple-array fixnum (*)))
  46
  47
  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)
  52            (type player player)
  53            (type square index)
  54            (type (simple-array fixnum (100)) board)
  55            (list squares)
  56            (optimize (speed 3) (space 0) (safety 0)))
  57   (cond
  58     ((< (length squares) n) nil)
  59     ((null squares) (funcall fn board index))
  60     (t (let ((index3 (* 3 index))
  61              (sq (first squares)))
  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)
  67                               (+ 1 index3))
  68            (setf (bref board sq) (opponent player))
  69            (map-edge-n-pieces fn player board (- n 1) (rest squares)
  70                               (+ 2 index3))
  71            (setf (bref board sq) empty))))))
  72
  73
  74
  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)
  79            (type player player)
  80            (type square index))
  81   (combine-edge-moves
  82    (cons
  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)))
  87     player))
  88
  89
  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)
  94            (type player player)
  95            (type cons squares)
  96            (optimize (speed 3) (safety 0) (space 0)))
  97   (let ((index 0))
  98     (declare (fixnum index))
  99     (dolist (sq squares)
 100       (declare (type square sq))
 101       (setq index
 102         (the fixnum
 103           (+
 104            (the fixnum (* index 3))
 105            (the fixnum (cond ((= (bref board sq) empty) 0)
 106                              ((= (bref board sq) player) 1)
 107                              (t 2)))))))
 108     index))
 109
 110 (defun possible-edge-move (player board sq)
 111   "Return a (prob val) pair for a possible edge move."
 112   (declare (type board board)
 113            (type player player)
 114            (type square sq))
 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*))))))
 121
 122 (defun combine-edge-moves (possibilities player)
 123   "Combine the best moves."
 124   (declare (type player player)
 125            (list possibilities)
 126            (optimize (speed 3) (safety 0) (space 0)))
 127   (let ((prob 1f0)
 128         (val 0f0)
 129         (fn (if (= player black) #'> #'<)))
 130     (declare (short-float prob val))
 131     (loop for pair in (sort possibilities fn :key #'second)
 132           while (>= prob 0f0)
 133         do (incf val (* prob (first pair) (second pair)))
 134            (decf prob (* prob (first pair))))
 135     (round val)))
 136
 137
 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)))))
 144
 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)
 148            (type player player)
 149            (type square square)
 150            (optimize (speed 3) (safety 0) (space 0)))
 151   (cond
 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))
 157        (cond
 158          ((= (bref board x-sq) empty) 1f-1)
 159          ((= (bref board x-sq) player) 1f-4)
 160          (t 9f-1))))
 161     (t (/ (aref
 162             '#2A((1f-1 4f-1 7f-1)
 163                  (5f-2 3f-1 *)
 164                  (1f-2 *    *))
 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)))))
 168
 169 (defun count-edge-neighbors (player board square)
 170   "Count the neighbors of this square occupied by player."
 171   (declare (type board board)
 172            (type player player)
 173            (type square square))
 174   (count-if #'(lambda (inc)
 175                 (declare (type square inc))
 176                 (= (bref board (+ square inc)) player))
 177             '(+1 -1)))
 178
 179 (defparameter *static-edge-table*
 180   '#2A(;stab  semi    un
 181        (   *    0 -2000) ; X
 182        ( 700    *     *) ; corner
 183        (1200  200   -25) ; C
 184        (1000  200    75) ; A
 185        (1000  200    50) ; B
 186        (1000  200    50) ; B
 187        (1000  200    75) ; A
 188        (1200  200   -25) ; C
 189        ( 700    *     *) ; corner
 190        (   *    0 -2000) ; X
 191        ))
 192 (declaim (type (simple-array t (* *)) *static-edge-table*))
 193
 194 (defun static-edge-stability (player board)
 195   "Compute this edge's static stability"
 196   (declare (type board board)
 197            (type player player)
 198            (optimize (speed 3) (safety 0) (space 0)))
 199   (loop for sq in *top-edge*
 200       for i from 0
 201       sum (the fixnum
 202             (cond
 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))))))))
 209
 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))
 213
 214     (defun piece-stability (board sq)
 215       (declare (type board board)
 216                (fixnum sq)
 217                (optimize (speed 3) (safety 0) (space 0)))
 218       (cond
 219         ((corner-p sq) stable)
 220         ((x-square-p sq)
 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
 226                             :start sq :end 19))
 227                   (p2 (find player board :test-not #'eql
 228                             :start 11 :end sq
 229                             :from-end t)))
 230              (declare (fixnum player opp))
 231              (cond
 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)))
 236                 unstable)
 237                ;; Semi-stable pieces might be captured
 238                ((and (eql p1 opp) (eql p2 opp)
 239                      (find empty board :start 11 :end 19))
 240                 semi-stable)
 241                ((and (eql p1 empty) (eql p2 empty))
 242                 semi-stable)
 243                ;; Stable pieces can never be captured
 244                (t stable))))))))
 245
 246
 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
 252         (map-edge-n-pieces
 253          #'(lambda (board index)
 254              (declare (type board board)
 255                       (fixnum index))
 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:
 260   (dotimes (i 5)
 261     (declare (fixnum i))
 262     ;; Do the indexes with most pieces first
 263     (loop for n-pieces fixnum from 9 downto 1 do
 264           (map-edge-n-pieces
 265             #'(lambda (board index)
 266                 (declare (type board board)
 267                          (fixnum index))
 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))))
 271