Fix types/initforms

[reversi.git] / edge-table.lisp

diff --git a/edge-table.lisp b/edge-table.lisp
index aae2779e3255d83d6c7478d46048d105b2c706b9..c11e7b3095907e5d27900da54e7b4b4695d4b91a 100644 (file)
--- a/edge-table.lisp
+++ b/edge-table.lisp
@@ -1,7 +1,7 @@
 ;;;;***************************************************************************
 ;;;;
 ;;;; FILE IDENTIFICATION
 ;;;;***************************************************************************
 ;;;;
 ;;;; FILE IDENTIFICATION

-;;;; 
+;;;;

 ;;;;  Name:           edge-table.lisp
 ;;;;  Purpose:        Edge table routines for reversi
 ;;;;  Programer:      Kevin M. Rosenberg based on code by Peter Norvig
 ;;;;  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$
 ;;;;
 ;;;;
 ;;;; $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
 ;;;; 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
 
 (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*)
 
   (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)
   "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)))
   (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)
          (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,14 +73,14 @@
 
 
 (defun possible-edge-moves-value (player board index)
 
 
 (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)
   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
   (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)))
       (loop for sq in *top-edge*             ;; possible moves
             when (= (bref board sq) empty)
             collect (possible-edge-move player board sq)))


@@ -91,51 +91,52 @@
   "The index counts 1 for player; 2 for opponent,
   on each square---summed as a base 3 number."
   (declare (type board board)
   "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))
   (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)
     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*
   (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)
                                new-board *top-edge*))))))
 
 (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)
+           (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)
         (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)
     (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)))
     (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)))


@@ -144,23 +145,23 @@
 (defun edge-move-probability (player board square)
   "What's the probability that player can move to this square?"
   (declare (type board board)
 (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
   (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
     ((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
     (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)))))
             (count-edge-neighbors player board square)
             (count-edge-neighbors (opponent player) board square))
           (if (legal-p square (opponent player) board) 2 1)))))


@@ -168,15 +169,15 @@
 (defun count-edge-neighbors (player board square)
   "Count the neighbors of this square occupied by player."
   (declare (type board board)
 (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)
   (count-if #'(lambda (inc)

-               (declare (type square inc))
+                (declare (type square inc))

                 (= (bref board (+ square inc)) player))
             '(+1 -1)))
 
 (defparameter *static-edge-table*
                 (= (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
        (   *    0 -2000) ; X
        ( 700    *     *) ; corner
        (1200  200   -25) ; C


@@ -193,77 +194,77 @@
 (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)
-          (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
   (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))
 
 (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)
     (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
       (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)))
 
 
 (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
         (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))))
               (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:
   ;; Now iterate five times trying to improve:

-  (dotimes (i 5) 
+  (dotimes (i 5)

     (declare (fixnum i))
     ;; Do the indexes with most pieces first
     (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)
           (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))))