r10498: fix number type

[reversi.git] / strategies.lisp

diff --git a/strategies.lisp b/strategies.lisp
index 5529d01d4361dc33467e5e38b036150119d04057..48140bbe424019c7ac8ec2bdc094dfa42edb256f 100644 (file)
--- a/strategies.lisp
+++ b/strategies.lisp
@@ -8,9 +8,9 @@
 ;;;;  Programer:      Kevin Rosenberg based on code by Peter Norvig
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
 ;;;;  Programer:      Kevin Rosenberg based on code by Peter Norvig
 ;;;;  Date Started:   1 Nov 2001
 ;;;;

-;;;; $Id: strategies.lisp,v 1.4 2002/10/25 13:09:11 kevin Exp $
+;;;; $Id$

 ;;;;
 ;;;;

-;;;; 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,15 +18,13 @@
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;;***************************************************************************
 
 ;;;; (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)

 
 (defun random-strategy (player board)
   "Make any legal move."
   (declare (type player player)
           (type board board))
 
 (defun random-strategy (player board)
   "Make any legal move."
   (declare (type player player)
           (type board board))

-  (random-elt (legal-moves player board)))
-
+  (random-nth (legal-moves player board)))

 
 (defun maximize-difference (player board)
   "A strategy that maximizes the difference in pieces."
 
 (defun maximize-difference (player board)
   "A strategy that maximizes the difference in pieces."


@@ -117,7 +115,8 @@
   searching PLY levels deep and backing up values."
   (declare (type player player)
           (type board board)
   searching PLY levels deep and backing up values."
   (declare (type player player)
           (type board board)

-          (fixnum ply))
+          (fixnum ply)
+          (optimize (speed 3) (space 0) (safety 0)))

   (if (= ply 0)
       (funcall eval-fn player board)
       (let ((moves (legal-moves player board)))
   (if (= ply 0)
       (funcall eval-fn player board)
       (let ((moves (legal-moves player board)))


@@ -156,7 +155,8 @@
   using cutoffs whenever possible."
   (declare (type player player)
           (type board board)
   using cutoffs whenever possible."
   (declare (type player player)
           (type board board)

-          (fixnum achievable cutoff ply))
+          (fixnum achievable cutoff ply)
+          (optimize (speed 3) (safety 0) (space 0)))

   (if (= ply 0)
       (funcall eval-fn player board)
       (let ((moves (legal-moves player board)))
   (if (= ply 0)
       (funcall eval-fn player board)
       (let ((moves (legal-moves player board)))


@@ -197,7 +197,8 @@
   "Like WEIGHTED-SQUARES, but don't take off for moving
   near an occupied corner."
   (declare (type player player)
   "Like WEIGHTED-SQUARES, but don't take off for moving
   near an occupied corner."
   (declare (type player player)

-          (type board board))
+          (type board board)
+          (optimize (speed 3) (safety 0) (space 0)))

   (let ((w (weighted-squares player board)))
     (declare (fixnum w))
     (dolist (corner '(11 18 81 88))
   (let ((w (weighted-squares player board)))
     (declare (fixnum w))
     (dolist (corner '(11 18 81 88))


@@ -254,6 +255,8 @@
 (defun alpha-beta2 (player node achievable cutoff ply eval-fn)
   "A-B search, sorting moves by eval-fn"
   ;; Returns two values: achievable-value and move-to-make
 (defun alpha-beta2 (player node achievable cutoff ply eval-fn)
   "A-B search, sorting moves by eval-fn"
   ;; Returns two values: achievable-value and move-to-make

+  (declare (fixnum ply)
+          (optimize (speed 3) (space 0) (safety 0)))

   (if (= ply 0)
       (values (node-value node) node)
       (let* ((board (node-board node))
   (if (= ply 0)
       (values (node-value node) node)
       (let* ((board (node-board node))


@@ -281,6 +284,7 @@
 
 (defun negate-value (node)
   "Set the value of a node to its negative."
 
 (defun negate-value (node)
   "Set the value of a node to its negative."

+  (declare (optimize (speed 3) (safety 0) (space 0)))

   (setf (node-value node) (- (node-value node)))
   node)
 
   (setf (node-value node) (- (node-value node)))
   node)
 


@@ -302,7 +306,8 @@
                     killer)
   (declare (type board board)
           (type player player)
                     killer)
   (declare (type board board)
           (type player player)

-          (type fixnum achievable cutoff ply))
+          (type fixnum achievable cutoff ply)
+          (optimize (speed 3) (space 0) (safety 0)))

   "A-B search, putting killer move first."
   (if (= ply 0)
       (funcall eval-fn player board)
   "A-B search, putting killer move first."
   (if (= ply 0)
       (funcall eval-fn player board)


@@ -343,7 +348,8 @@
   (declare (type board board)
           (type player player)
           (type fixnum achievable cutoff ply)
   (declare (type board board)
           (type player player)
           (type fixnum achievable cutoff ply)

-          (type move killer))
+          (type (or null move) killer)
+          (optimize (speed 3) (safety 0) (space 0)))

   "A-B search, putting killer move first."
   (if (= ply 0)
       (funcall eval-fn player board)
   "A-B search, putting killer move first."
   (if (= ply 0)
       (funcall eval-fn player board)


@@ -394,11 +400,9 @@
 (defun alpha-beta-searcher3w (depth eval-fn)
   "Return a strategy that does A-B search with killer moves."
   #'(lambda (player board)
 (defun alpha-beta-searcher3w (depth eval-fn)
   "Return a strategy that does A-B search with killer moves."
   #'(lambda (player board)

-      (multiple-value-bind (value move)
-          (alpha-beta3w player board losing-value winning-value
-                       depth eval-fn nil)
-        (declare (ignore value))
-        move)))
+      (nth-value 1
+                (alpha-beta3w player board losing-value winning-value
+                              depth eval-fn nil))))

 
 (defun put-first (killer moves)
   "Move the killer move to the front of moves,
 
 (defun put-first (killer moves)
   "Move the killer move to the front of moves,


@@ -414,7 +418,7 @@
   Returns current and potential mobility for player."
   (declare (type board board)
           (type player player)
   Returns current and potential mobility for player."
   (declare (type board board)
           (type player player)

-          (optimize (speed 3) (safety 0 )))
+          (optimize (speed 3) (safety 0) (space 0)))

   (let ((opp (opponent player))
         (current 0)    ; player's current mobility
         (potential 0))                 ; player's potential mobility
   (let ((opp (opponent player))
         (current 0)    ; player's current mobility
         (potential 0))                 ; player's potential mobility


@@ -435,7 +439,7 @@
   (declare (type board board)
           (type player opp)
           (type cons neighbors)
   (declare (type board board)
           (type player opp)
           (type cons neighbors)

-          (optimize (speed 3) (safety 0)))
+          (optimize (speed 3) (safety 0) (space 0)))

   (block search
     (dolist (sq neighbors)
       (declare (type square sq))
   (block search
     (dolist (sq neighbors)
       (declare (type square sq))


@@ -446,10 +450,10 @@
 (defun edge-stability (player board)
   "Total edge evaluation for player to move on board."
   (declare (type board board)
 (defun edge-stability (player board)
   "Total edge evaluation for player to move on board."
   (declare (type board board)

-          (type player player))
-  (loop for edge-list in *edge-and-x-lists*
-        sum (aref *edge-table*
-                  (edge-index player board edge-list))))
+          (type player player)
+          (optimize (speed 3) (safety 0) (space 0)))
+  (loop for edge-list of-type (simple-array fixnum (*)) in *edge-and-x-lists*
+      sum (aref *edge-table* (edge-index player board edge-list))))

 
 (defun iago-eval (player board)
   "Combine edge-stability, current mobility and
 
 (defun iago-eval (player board)
   "Combine edge-stability, current mobility and


@@ -457,7 +461,8 @@
   ;; The three factors are multiplied by coefficients
   ;; that vary by move number:
   (declare (type board board)
   ;; The three factors are multiplied by coefficients
   ;; that vary by move number:
   (declare (type board board)

-          (type player player))
+          (type player player)
+          (optimize (speed 3) (safety 0) (space 0)))

   (let ((c-edg  (+ 312000 (* 6240 *move-number*)))
         (c-cur (if (< *move-number* 25)
                   (+ 50000 (* 2000 *move-number*))
   (let ((c-edg  (+ 312000 (* 6240 *move-number*)))
         (c-cur (if (< *move-number* 25)
                   (+ 50000 (* 2000 *move-number*))


@@ -481,6 +486,7 @@
 
 (defun iago (depth)
   "Use an approximation of Iago's evaluation function."
 
 (defun iago (depth)
   "Use an approximation of Iago's evaluation function."

+  (declare (fixnum depth))

   (alpha-beta-searcher3 depth #'iago-eval))
 
 ;; Maximizer (1-ply)
   (alpha-beta-searcher3 depth #'iago-eval))
 
 ;; Maximizer (1-ply)


@@ -516,12 +522,15 @@
 
 
 (defun ab3w-df (ply)
 
 
 (defun ab3w-df (ply)

+  (declare (fixnum ply))

   (alpha-beta-searcher3w ply #'count-difference))
 
 (defun ab3w-wt (ply)
   (alpha-beta-searcher3w ply #'count-difference))
 
 (defun ab3w-wt (ply)

+  (declare (fixnum ply))

   (alpha-beta-searcher3w ply #'weighted-squares))
 
 (defun ab3w-md-wt (ply)
   (alpha-beta-searcher3w ply #'weighted-squares))
 
 (defun ab3w-md-wt (ply)

+  (declare (fixnum ply))

   (alpha-beta-searcher3w ply #'modified-weighted-squares))
 
 
   (alpha-beta-searcher3w ply #'modified-weighted-squares))