X-Git-Url: http://git.kpe.io/?p=reversi.git;a=blobdiff_plain;f=edge-table.lisp;h=524fbcbb40a515d58a4f1c1f00d0c48e40a3c7fa;hp=d61cb889cbc4430bf3e7171c2857ff7d64ed2770;hb=a8b65e823b3a59faba717887aee3a8a4a8cf0a28;hpb=062d6c95c94ac969bd49083dea184c9bb81d6fea diff --git a/edge-table.lisp b/edge-table.lisp index d61cb88..524fbcb 100644 --- a/edge-table.lisp +++ b/edge-table.lisp @@ -1,7 +1,7 @@ ;;;;*************************************************************************** ;;;; ;;;; FILE IDENTIFICATION -;;;; +;;;; ;;;; Name: edge-table.lisp ;;;; Purpose: Edge table routines for reversi ;;;; Programer: Kevin M. Rosenberg based on code by Peter Norvig @@ -9,7 +9,7 @@ ;;;; ;;;; $Id$ ;;;; -;;;; This file is Copyright (c) 2001-2003 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 @@ -38,7 +38,7 @@ (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*) @@ -49,17 +49,17 @@ "Call fn on all edges with n pieces." ;; Index counts 1 for player; 2 for opponent (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))) + (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 (plusp n) (= (bref board sq) empty)) (setf (bref board sq) player) @@ -73,11 +73,11 @@ (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 @@ -91,47 +91,47 @@ "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 0) (space 0))) + (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." (declare (type player player) - (list possibilities) - (optimize (speed 3) (safety 0) (space 0))) + (list possibilities) + (optimize (speed 3) (safety 0) (space 0))) (let ((prob 1.0) (val 0.0) (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)))) + do (incf val (* prob (first pair) (second pair))) + (decf prob (* prob (first pair)))) (round val))) @@ -145,9 +145,9 @@ (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) - (optimize (speed 3) (safety 0) (space 0))) + (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 @@ -169,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 @@ -194,77 +194,77 @@ (defun static-edge-stability (player board) "Compute this edge's static stability" (declare (type board board) - (type player player) - (optimize (speed 3) (safety 0) (space 0))) + (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)) (declare (type fixnum stable semi-stable unstable)) - + (defun piece-stability (board sq) (declare (type board board) - (fixnum sq) - (optimize (speed 3) (safety 0) (space 0))) + (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)))))))) + ((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 (declare (optimize (speed 3) (safety 0) (space 0))) - (loop for n-pieces from 0 to 10 do + (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 fixnum 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))))