r5141: Auto commit for Debian build

[reversi.git] / edge-table.lisp

diff --git a/edge-table.lisp b/edge-table.lisp
index 30a8ccc659c0627843e7f31a0a3a76496db9f05b..521c7f1e3fce458ccd01f4e92459f94d03a15dc1 100644 (file)
--- 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
 ;;;;
 ;;;;  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: 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
 ;;;; 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*
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defparameter *edge-and-x-lists*


@@ -42,15 +42,18 @@
   (init-edge-table)
   *edge-table*)
 
   (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
 
 (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)
           (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))
   (cond
     ((< (length squares) n) nil)
     ((null squares) (funcall fn board index))


@@ -58,7 +61,7 @@
              (sq (first squares)))
         (declare (fixnum index3 sq))
          (map-edge-n-pieces fn player board n (rest squares) index3)
              (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))
            (setf (bref board sq) player)
            (map-edge-n-pieces fn player board (- n 1) (rest squares)
                               (+ 1 index3))


@@ -90,7 +93,7 @@
   (declare (type board board)
           (type player player)
           (type cons squares)
   (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)
   (let ((index 0))
     (declare (fixnum index))
     (dolist (sq squares)


@@ -118,6 +121,8 @@
 
 (defun combine-edge-moves (possibilities player)
   "Combine the best moves."
 
 (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) #'> #'<)))
   (let ((prob 1.0)
         (val 0.0)
         (fn (if (= player black) #'> #'<)))


@@ -140,7 +145,8 @@
   "What's the probability that player can move to this square?"
   (declare (type board board)
           (type player player)
   "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
   (cond
     ((x-square-p square) .5) ;; X-squares
     ((legal-p square player board) 1.0) ;; immediate capture


@@ -187,12 +193,13 @@
 (defun static-edge-stability (player board)
   "Compute this edge's static stability"
   (declare (type board board)
 (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
   (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)))
             ((= (bref board sq) player)
              (aref *static-edge-table* i
                    (piece-stability board sq)))


@@ -201,43 +208,45 @@
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (let ((stable 0) (semi-stable 1) (unstable 2))
 
 (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)
     
     (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
 
 
 (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)
   (loop for n-pieces from 0 to 10 do 
         (map-edge-n-pieces
         #'(lambda (board index)


@@ -250,11 +259,11 @@
   (dotimes (i 5) 
     (declare (fixnum i))
     ;; Do the indexes with most pieces first
   (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)
           (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))))
                 (setf (aref *edge-table* index)
                       (the fixnum (possible-edge-moves-value black board index))))
             black (initial-board) n-pieces *top-edge* 0))))