X-Git-Url: http://git.kpe.io/?p=reversi.git;a=blobdiff_plain;f=edge-table.lisp;h=521c7f1e3fce458ccd01f4e92459f94d03a15dc1;hp=ec5013c0ed7388e5ba5fe23fffe95e2d7bb53532;hb=d92820d39c18a373611b5bfb018631cffe3e4bcd;hpb=b29c5d666cbd1d0c08d4da49b32e4ed41c6dabba diff --git a/edge-table.lisp b/edge-table.lisp index ec5013c..521c7f1 100644 --- a/edge-table.lisp +++ b/edge-table.lisp @@ -2,17 +2,24 @@ ;;;; ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: edge-table.cl +;;;; Name: edge-table.lisp ;;;; Purpose: Edge table routines for reversi -;;;; Programer: Kevin M. Rosenberg, M.D. +;;;; Programer: Kevin M. Rosenberg based on code by Peter Norvig ;;;; Date Started: 1 Nov 2001 -;;;; CVS Id: $Id: edge-table.lisp,v 1.1 2002/10/25 08:36:42 kevin Exp $ ;;;; +;;;; $Id: edge-table.lisp,v 1.6 2003/06/17 05:47:18 kevin Exp $ +;;;; +;;;; 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 +;;;; as governed by the terms of the Lisp Lesser GNU Public License +;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;;*************************************************************************** -(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* @@ -35,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)) @@ -51,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)) @@ -83,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) @@ -111,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) #'> #'<))) @@ -133,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 @@ -180,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))) @@ -194,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) @@ -243,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))))