X-Git-Url: http://git.kpe.io/?p=reversi.git;a=blobdiff_plain;f=edge-table.lisp;h=c11e7b3095907e5d27900da54e7b4b4695d4b91a;hp=30a8ccc659c0627843e7f31a0a3a76496db9f05b;hb=HEAD;hpb=1758cfb593196dd65c70199aa1ebd90cbd6e7ee5 diff --git a/edge-table.lisp b/edge-table.lisp index 30a8ccc..c11e7b3 100644 --- a/edge-table.lisp +++ b/edge-table.lisp @@ -1,15 +1,15 @@ ;;;;*************************************************************************** ;;;; ;;;; FILE IDENTIFICATION -;;;; +;;;; ;;;; Name: edge-table.lisp ;;;; Purpose: Edge table routines for reversi ;;;; Programer: Kevin M. Rosenberg based on code by Peter Norvig ;;;; Date Started: 1 Nov 2001 ;;;; -;;;; $Id: edge-table.lisp,v 1.2 2002/10/25 09:23:39 kevin Exp $ +;;;; $Id$ ;;;; -;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg +;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg ;;;; and Copyright (c) 1998-2002 Peter Norvig ;;;; ;;;; Reversi users are granted the rights to distribute and use this software @@ -18,8 +18,8 @@ ;;;;*************************************************************************** -(in-package :reversi) -(declaim (optimize (safety 1) (debug 3) (speed 3) (compilation-speed 0))) +(in-package #:reversi) + (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *edge-and-x-lists* @@ -38,27 +38,30 @@ (defun make-edge-table () (setq *edge-table* (make-array (expt 3 10) :element-type 'fixnum - :adjustable nil :fill-pointer nil)) + :adjustable nil :fill-pointer nil)) (init-edge-table) *edge-table*) +(deftype edge-table () '(simple-array fixnum (*))) + (defun map-edge-n-pieces (fn player board n squares index) "Call fn on all edges with n pieces." ;; Index counts 1 for player; 2 for opponent - (declare (fixnum index) - (type player player) - (type square index) - (type (simple-array fixnum (100)) board) - (list squares)) + (declare (fixnum n index) + (type player player) + (type square index) + (type (simple-array fixnum (100)) board) + (list squares) + (optimize (speed 3) (space 0) (safety 0))) (cond ((< (length squares) n) nil) ((null squares) (funcall fn board index)) (t (let ((index3 (* 3 index)) (sq (first squares))) - (declare (fixnum index3 sq)) + (declare (fixnum index3 sq)) (map-edge-n-pieces fn player board n (rest squares) index3) - (when (and (> n 0) (eql (bref board sq) empty)) + (when (and (plusp n) (= (bref board sq) empty)) (setf (bref board sq) player) (map-edge-n-pieces fn player board (- n 1) (rest squares) (+ 1 index3)) @@ -70,14 +73,14 @@ (defun possible-edge-moves-value (player board index) - "Consider all possible edge moves. + "Consider all possible edge moves. Combine their values into a single number." (declare (type board board) - (type player player) - (type square index)) + (type player player) + (type square index)) (combine-edge-moves (cons - (list 1.0 (aref *edge-table* index)) ;; no move + (list 1f0 (aref *edge-table* index)) ;; no move (loop for sq in *top-edge* ;; possible moves when (= (bref board sq) empty) collect (possible-edge-move player board sq))) @@ -88,49 +91,52 @@ "The index counts 1 for player; 2 for opponent, on each square---summed as a base 3 number." (declare (type board board) - (type player player) - (type cons squares) - (optimize (speed 3) (safety 1))) + (type player player) + (type cons squares) + (optimize (speed 3) (safety 0) (space 0))) (let ((index 0)) (declare (fixnum index)) (dolist (sq squares) (declare (type square sq)) - (setq index - (the fixnum - (+ - (the fixnum (* index 3)) - (the fixnum (cond ((= (bref board sq) empty) 0) - ((= (bref board sq) player) 1) - (t 2))))))) + (setq index + (the fixnum + (+ + (the fixnum (* index 3)) + (the fixnum (cond ((= (bref board sq) empty) 0) + ((= (bref board sq) player) 1) + (t 2))))))) index)) (defun possible-edge-move (player board sq) "Return a (prob val) pair for a possible edge move." (declare (type board board) - (type player player) - (type square sq)) + (type player player) + (type square sq)) (let ((new-board (replace-board (svref *ply-boards* player) board))) (make-move sq player new-board) (list (edge-move-probability player board sq) (- (aref *edge-table* - (edge-index (opponent player) + (edge-index (opponent player) new-board *top-edge*)))))) (defun combine-edge-moves (possibilities player) "Combine the best moves." - (let ((prob 1.0) - (val 0.0) + (declare (type player player) + (list possibilities) + (optimize (speed 3) (safety 0) (space 0))) + (let ((prob 1f0) + (val 0f0) (fn (if (= player black) #'> #'<))) (declare (short-float prob val)) (loop for pair in (sort possibilities fn :key #'second) - while (>= prob 0.0) - do (incf val (* prob (first pair) (second pair))) - (decf prob (* prob (first pair)))) + while (>= prob 0f0) + do (incf val (* prob (first pair) (second pair))) + (decf prob (* prob (first pair)))) (round val))) (eval-when (:compile-toplevel :load-toplevel :execute) - (let ((corner/xsqs '((11 . 22) (18 . 27) (81. 72) (88 . 77)))) + (let ((corner/xsqs '((11 . 22) (18 . 27) (81 . 72) (88 . 77)))) (defun corner-p (sq) (assoc sq corner/xsqs)) (defun x-square-p (sq) (rassoc sq corner/xsqs)) (defun x-square-for (corner) (cdr (assoc corner corner/xsqs))) @@ -139,22 +145,23 @@ (defun edge-move-probability (player board square) "What's the probability that player can move to this square?" (declare (type board board) - (type player player) - (type square square)) + (type player player) + (type square square) + (optimize (speed 3) (safety 0) (space 0))) (cond - ((x-square-p square) .5) ;; X-squares - ((legal-p square player board) 1.0) ;; immediate capture + ((x-square-p square) 5f-1) ;; X-squares + ((legal-p square player board) 1f0) ;; immediate capture ((corner-p square) ;; move to corner depends on X-square (let ((x-sq (x-square-for square))) (declare (type square x-sq)) (cond - ((= (bref board x-sq) empty) .1) - ((= (bref board x-sq) player) 0.001) - (t .9)))) + ((= (bref board x-sq) empty) 1f-1) + ((= (bref board x-sq) player) 1f-4) + (t 9f-1)))) (t (/ (aref - '#2A((.1 .4 .7) - (.05 .3 *) - (.01 * *)) + '#2A((1f-1 4f-1 7f-1) + (5f-2 3f-1 *) + (1f-2 * *)) (count-edge-neighbors player board square) (count-edge-neighbors (opponent player) board square)) (if (legal-p square (opponent player) board) 2 1))))) @@ -162,15 +169,15 @@ (defun count-edge-neighbors (player board square) "Count the neighbors of this square occupied by player." (declare (type board board) - (type player player) - (type square square)) + (type player player) + (type square square)) (count-if #'(lambda (inc) - (declare (type square inc)) + (declare (type square inc)) (= (bref board (+ square inc)) player)) '(+1 -1))) (defparameter *static-edge-table* - '#2A(;stab semi un + '#2A(;stab semi un ( * 0 -2000) ; X ( 700 * *) ; corner (1200 200 -25) ; C @@ -187,74 +194,77 @@ (defun static-edge-stability (player board) "Compute this edge's static stability" (declare (type board board) - (type player player)) + (type player player) + (optimize (speed 3) (safety 0) (space 0))) (loop for sq in *top-edge* for i from 0 - sum (the fixnum - (cond - ((= (bref board sq) empty) 0) - ((= (bref board sq) player) - (aref *static-edge-table* i - (piece-stability board sq))) - (t (- (aref *static-edge-table* i - (piece-stability board sq)))))))) + sum (the fixnum + (cond + ((= (bref board sq) empty) 0) + ((= (bref board sq) player) + (aref *static-edge-table* i + (piece-stability board sq))) + (t (- (aref *static-edge-table* i + (piece-stability board sq)))))))) (eval-when (:compile-toplevel :load-toplevel :execute) (let ((stable 0) (semi-stable 1) (unstable 2)) - (declaim (type fixnum stable semi-stable unstable)) - + (declare (type fixnum stable semi-stable unstable)) + (defun piece-stability (board sq) (declare (type board board) - (fixnum sq)) - (cond - ((corner-p sq) stable) - ((x-square-p sq) - (if (eql (bref board (corner-for sq)) empty) - unstable semi-stable)) - (t (let* ((player (bref board sq)) - (opp (opponent player)) - (p1 (find player board :test-not #'eql - :start sq :end 19)) - (p2 (find player board :test-not #'eql - :start 11 :end sq - :from-end t))) - (declare (fixnum player opp)) - (cond - ;; unstable pieces can be captured immediately - ;; by playing in the empty square - ((or (and (eql p1 empty) (eql p2 opp)) - (and (eql p2 empty) (eql p1 opp))) - unstable) - ;; Semi-stable pieces might be captured - ((and (eql p1 opp) (eql p2 opp) - (find empty board :start 11 :end 19)) - semi-stable) - ((and (eql p1 empty) (eql p2 empty)) - semi-stable) - ;; Stable pieces can never be captured - (t stable)))))))) + (fixnum sq) + (optimize (speed 3) (safety 0) (space 0))) + (cond + ((corner-p sq) stable) + ((x-square-p sq) + (if (eql (bref board (corner-for sq)) empty) + unstable semi-stable)) + (t (let* ((player (bref board sq)) + (opp (opponent player)) + (p1 (find player board :test-not #'eql + :start sq :end 19)) + (p2 (find player board :test-not #'eql + :start 11 :end sq + :from-end t))) + (declare (fixnum player opp)) + (cond + ;; unstable pieces can be captured immediately + ;; by playing in the empty square + ((or (and (eql p1 empty) (eql p2 opp)) + (and (eql p2 empty) (eql p1 opp))) + unstable) + ;; Semi-stable pieces might be captured + ((and (eql p1 opp) (eql p2 opp) + (find empty board :start 11 :end 19)) + semi-stable) + ((and (eql p1 empty) (eql p2 empty)) + semi-stable) + ;; Stable pieces can never be captured + (t stable)))))))) (defun init-edge-table () "Initialize *edge-table*, starting from the empty board." ;; Initialize the static values - (loop for n-pieces from 0 to 10 do + (declare (optimize (speed 3) (safety 0) (space 0))) + (loop for n-pieces from 0 to 10 do (map-edge-n-pieces - #'(lambda (board index) - (declare (type board board) - (fixnum index)) + #'(lambda (board index) + (declare (type board board) + (fixnum index)) (setf (aref *edge-table* index) (the fixnum (static-edge-stability black board)))) - black (initial-board) n-pieces *top-edge* 0)) + black (initial-board) n-pieces *top-edge* 0)) ;; Now iterate five times trying to improve: - (dotimes (i 5) + (dotimes (i 5) (declare (fixnum i)) ;; Do the indexes with most pieces first - (loop for n-pieces from 9 downto 1 do + (loop for n-pieces fixnum from 9 downto 1 do (map-edge-n-pieces #'(lambda (board index) - (declare (type board board) - (fixnum index)) + (declare (type board board) + (fixnum index)) (setf (aref *edge-table* index) (the fixnum (possible-edge-moves-value black board index)))) black (initial-board) n-pieces *top-edge* 0))))