X-Git-Url: http://git.kpe.io/?p=reversi.git;a=blobdiff_plain;f=edge-table.lisp;h=521c7f1e3fce458ccd01f4e92459f94d03a15dc1;hp=653c0c12c118970e09d0a388b117e710dbad4416;hb=d92820d39c18a373611b5bfb018631cffe3e4bcd;hpb=48b1a775e575a66bc154620107a8e27321ea306c diff --git a/edge-table.lisp b/edge-table.lisp index 653c0c1..521c7f1 100644 --- a/edge-table.lisp +++ b/edge-table.lisp @@ -7,9 +7,9 @@ ;;;; Programer: Kevin M. Rosenberg based on code by Peter Norvig ;;;; Date Started: 1 Nov 2001 ;;;; -;;;; $Id: edge-table.lisp,v 1.3 2003/05/06 15:51:20 kevin Exp $ +;;;; $Id: edge-table.lisp,v 1.6 2003/06/17 05:47:18 kevin Exp $ ;;;; -;;;; 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 @@ -20,8 +20,6 @@ (in-package #:reversi) -(eval-when (:compile-toplevel) - (declaim (optimize (safety 1) (space 0) (speed 3) (compilation-speed 0)))) (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *edge-and-x-lists* @@ -44,15 +42,18 @@ (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) + (declare (fixnum n index) (type player player) (type square index) (type (simple-array fixnum (100)) board) - (list squares)) + (list squares) + (optimize (speed 3) (space 0) (safety 0))) (cond ((< (length squares) n) nil) ((null squares) (funcall fn board index)) @@ -60,7 +61,7 @@ (sq (first squares))) (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)) @@ -92,7 +93,7 @@ (declare (type board board) (type player player) (type cons squares) - (optimize (speed 3) (safety 1))) + (optimize (speed 3) (safety 0) (space 0))) (let ((index 0)) (declare (fixnum index)) (dolist (sq squares) @@ -120,6 +121,8 @@ (defun combine-edge-moves (possibilities player) "Combine the best moves." + (declare (type player player) + (optimize (speed 3) (safety 0) (space 0))) (let ((prob 1.0) (val 0.0) (fn (if (= player black) #'> #'<))) @@ -142,7 +145,8 @@ "What's the probability that player can move to this square?" (declare (type board board) (type player player) - (type square square)) + (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 @@ -189,12 +193,13 @@ (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) empty) 0d0) ((= (bref board sq) player) (aref *static-edge-table* i (piece-stability board sq))) @@ -203,43 +208,45 @@ (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 + (declare (optimize (speed 3) (safety 0) (space 0))) (loop for n-pieces from 0 to 10 do (map-edge-n-pieces #'(lambda (board index) @@ -252,11 +259,11 @@ (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))))