;;;; Programer: Kevin Rosenberg based on code by Peter Norvig
;;;; Date Started: 1 Nov 2001
;;;;
-;;;; $Id: base.lisp,v 1.3 2003/05/06 15:51:20 kevin Exp $
+;;;; $Id: base.lisp,v 1.4 2003/06/12 12:42:13 kevin Exp $
;;;;
;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1998-2002 Peter Norvig
(in-package #:reversi)
-(eval-when (:compile-toplevel)
- (declaim (optimize (safety 1) (space 0) (speed 3) (compilation-speed 0))))
-
(defparameter +all-directions+ '(-11 -10 -9 -1 1 9 10 11))
(defconstant +default-max-minutes+ 30)
`(the piece (aref (the board ,board) (the square ,square))))
(defparameter all-squares
- (loop for i from 11 to 88 when (<= 1 (mod i 10) 8) collect i)
+ (loop for i fixum from 11 to 88 when (<= 1 (mod i 10) 8) collect i)
"A list of all squares")
(defun initial-board ()
(defun count-difference (player board)
"Count player's pieces minus opponent's pieces."
(declare (type board board)
- (fixnum player))
- (- (count player board)
- (count (opponent player) board)))
+ (fixnum player)
+ (optimize (speed 3) (safety 0) (space 0)))
+ (the fixnum (- (the fixnum (count player board))
+ (the fixum (count (opponent player) board)))))
(defun valid-p (move)
- (declare (type move move))
+ (declare (type move move)
+ (optimize (speed 3) (safety 0) (space 0)))
"Valid moves are numbers in the range 11-88 that end in 1-8."
(and (typep move 'move) (<= 11 move 88) (<= 1 (mod move 10) 8)))
(declare (type board board)
(type move move)
(type player player)
- (optimize (speed 3) (safety 0))
-)
+ (optimize (speed 3) (safety 0) (space 0)))
(if (= (the piece (bref board move)) empty)
(block search
(dolist (dir +all-directions+)
(declare (type board board)
(type move move)
(type player)
- (optimize (speed 3) (safety 0))
-)
+ (optimize (speed 3) (safety 0) (space 0)))
(setf (bref board move) player)
(dolist (dir +all-directions+)
(declare (type dir dir))
(type move move)
(type player player)
(type dir dir)
- (optimize (speed 3) (safety 0))
-)
+ (optimize (speed 3) (safety 0) (space 0)))
(let ((bracketer (would-flip? move player board dir)))
(when bracketer
(loop for c from (+ move dir) by dir until (= c (the fixnum bracketer))
(type move move)
(type player player)
(type dir dir)
- (optimize (speed 3) (safety 0))
-)
+ (optimize (speed 3) (safety 0) (space 0)))
(let ((c (+ move dir)))
(declare (type square c))
(and (= (the piece (bref board c)) (the player (opponent player)))
(defun replace-board (to from)
(replace to from))
-#+ignore
-(defun replace-board (to from)
- (declare (type board to from)
- (optimize (safety 0) (debug 0) (speed 3))
-)
- (dotimes (i 100)
- (declare (type 'fixnum i))
- (setf (aref to i) (aref from i)))
- to)
-
#+allegro
(defun replace-board (to from)
(declare (type board to from))
(apply #'vector (loop repeat 40 collect (initial-board))))
-
(defvar *move-number* 1 "The number of the move to be played")
(declaim (type fixnum *move-number*))
;;;; Programer: Kevin Rosenberg
;;;; Date Started: 1 Nov 2001
;;;;
-;;;; $Id: edge-table-storage.lisp,v 1.3 2002/10/25 12:39:15 kevin Exp $
+;;;; $Id: edge-table-storage.lisp,v 1.4 2003/06/12 12:42:13 kevin Exp $
;;;;
-;;;; This file is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg
;;;;
;;;; 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)
+(in-package #:reversi)
(defparameter *et-path* nil)
;;;; 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.4 2003/06/12 12:42:13 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
(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*
(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))
(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)
(defun combine-edge-moves (possibilities player)
"Combine the best moves."
+ (declare (optimize (speed 3) (safety 0) (space 0)))
(let ((prob 1.0)
(val 0.0)
(fn (if (= player black) #'> #'<)))
"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
(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
(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)
(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))))
;;;; Programer: Kevin M. Rosenberg
;;;; Date Started: 1 Nov 2001
;;;;
-;;;; $Id: io-clim.lisp,v 1.12 2003/05/06 15:53:47 kevin Exp $
+;;;; $Id: io-clim.lisp,v 1.13 2003/06/12 12:42:13 kevin Exp $
;;;;
-;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg
+;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg
;;;;
;;;; Reversi users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;;;; Programer: Kevin Rosenberg based on code by Peter Norvig
;;;; Date Started: 1 Nov 2001
;;;;
-;;;; $Id: io.lisp,v 1.3 2003/05/06 15:51:20 kevin Exp $
+;;;; $Id: io.lisp,v 1.4 2003/06/12 12:42:13 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
(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)
(let ((square-names
;;;; Programer: Kevin M. Rosenberg
;;;; Date Started: 1 Nov 2001
;;;;
-;;;; $Id: package.lisp,v 1.5 2003/05/06 16:17:53 kevin Exp $
+;;;; $Id: package.lisp,v 1.6 2003/06/12 12:42:13 kevin Exp $
;;;;
-;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg
+;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg
;;;;
;;;; Reversi users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;;;; Programer: Kevin Rosenberg based on code by Peter Norvig
;;;; Date Started: 1 Nov 2001
;;;;
-;;;; $Id: strategies.lisp,v 1.5 2003/05/06 15:51:20 kevin Exp $
+;;;; $Id: strategies.lisp,v 1.6 2003/06/12 12:42:13 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
(in-package #:reversi)
-(eval-when (:compile-toplevel)
- (declaim (optimize (safety 1) (space 0) (speed 3) (compilation-speed 0))))
-
(defun random-strategy (player board)
"Make any legal move."
(declare (type player player)
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)))
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)))
"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))
(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))
(defun negate-value (node)
"Set the value of a node to its negative."
+ (declare (fixnum node)
+ (speed 3) (safety 0) (space 0))
(setf (node-value node) (- (node-value node)))
node)
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)
(declare (type board board)
(type player player)
(type fixnum achievable cutoff ply)
- (type move killer))
+ (type move killer)
+ (optimize (speed 3) (safety 0) (space 0)))
"A-B search, putting killer move first."
(if (= ply 0)
(funcall eval-fn player board)
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
(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))
(defun edge-stability (player board)
"Total edge evaluation for player to move on board."
(declare (type board board)
- (type player player))
+ (type player player)
+ (optimize (speed 3) (safety 0) (space 0))
(loop for edge-list in *edge-and-x-lists*
sum (aref *edge-table*
(edge-index player board edge-list))))
;; 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*))
;;;; Programer: Kevin M. Rosenberg
;;;; Date Started: 1 Nov 2001
;;;;
-;;;; $Id: utils.lisp,v 1.4 2003/05/06 15:51:20 kevin Exp $
+;;;; $Id: utils.lisp,v 1.5 2003/06/12 12:42:13 kevin Exp $
;;;;
-;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg
+;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg
;;;;
;;;; Reversi users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
(in-package #:reversi)
-(eval-when (:compile-toplevel)
- (declaim (optimize (safety 1) (space 0) (speed 3) (compilation-speed 0))))
(defmacro missing-argument ()
`(error "Missing an argument to a constructor"))
projects / reversi.git / commitdiff