;;;;***************************************************************************
;;;;
;;;; FILE IDENTIFICATION
-;;;;
+;;;;
;;;; Name: base.lisp
;;;; Purpose: Basic functions for reversi
;;;; Programer: Kevin Rosenberg based on code by Peter Norvig
;;;;
;;;; $Id$
;;;;
-;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg
+;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1998-2002 Peter Norvig
;;;;
;;;; Reversi users are granted the rights to distribute and use this software
(defun make-moves ()
(make-array 60 :element-type 'cons :fill-pointer 0
- :adjustable nil))
+ :adjustable nil))
(deftype moves () '(array cons (60)))
(defclass reversi-game ()
((bl-strategy :initarg :bl-strategy
- :documentation "Strategy function for black"
- :reader bl-strategy)
+ :documentation "Strategy function for black"
+ :reader bl-strategy)
(wh-strategy :initarg :wh-strategy
- :documentation "Strategy function for white"
- :reader wh-strategy)
+ :documentation "Strategy function for white"
+ :reader wh-strategy)
(board :type board :initarg :board
- :documentation "The board configuration"
- :reader board)
- (move-number :type fixnum :initarg :move-number
- :documentation "The number of the move to be played"
- :accessor move-number)
+ :documentation "The board configuration"
+ :reader board)
+ (move-number :type fixnum :initarg :move-number
+ :documentation "The number of the move to be played"
+ :accessor move-number)
(player :type player :initarg :player
- :documentation "ID of next player to move"
- :accessor player)
+ :documentation "ID of next player to move"
+ :accessor player)
(moves :type moves :initarg :moves
- :documentation "An array of moves played in the game"
- :accessor moves)
+ :documentation "An array of moves played in the game"
+ :accessor moves)
(print? :type boolean :initarg :print?
- :documentation "Whether to print progress of this game"
- :reader print?)
+ :documentation "Whether to print progress of this game"
+ :reader print?)
(record-game? :type boolean :initarg :record-game?
- :documentation "Whether to record moves and clcck of this game"
- :reader record-game?)
+ :documentation "Whether to record moves and clcck of this game"
+ :reader record-game?)
(final-result :type (or null fixnum) :initarg :final-result
- :documentation "Final count, is NIL while game in play"
- :accessor final-result)
+ :documentation "Final count, is NIL while game in play"
+ :accessor final-result)
(max-minutes :type fixnum :initarg :max-minutes
- :documentation "Maximum minites for each player"
- :reader max-minutes)
+ :documentation "Maximum minites for each player"
+ :reader max-minutes)
(clock :type clock :initarg :clock :initform nil
- :documentation "An array of time-units left"
- :accessor clock))
- (:default-initargs
+ :documentation "An array of time-units left"
+ :accessor clock))
+ (:default-initargs
:bl-strategy nil
:wh-strategy nil
:board (initial-board)
(defun title-of (piece)
(declare (fixnum piece))
(nth (the fixnum (1- piece)) '("Black" "White")) )
-
-(defmacro opponent (player)
+
+(defmacro opponent (player)
`(if (= ,player black) white black))
(defmacro bref (board square)
(defparameter all-squares
(loop for i fixnum from 11 to 88
- when (<= 1 (the fixnum (mod i 10)) 8)
- collect i)
+ when (<= 1 (the fixnum (mod i 10)) 8)
+ collect i)
"A list of all squares")
(defun initial-board ()
;; the 4 center squares are taken, the others empty.
(let ((board (make-array 100 :element-type 'fixnum
:initial-element outer
- :adjustable nil :fill-pointer nil)))
+ :adjustable nil :fill-pointer nil)))
(declare (type board board))
(dolist (square all-squares)
(declare (fixnum square))
(defgeneric make-clock (clock))
(defmethod make-clock ((clock array))
(make-array (+ 1 (max black white))
- :element-type 'integer
- :initial-contents clock
- :adjustable nil
- :fill-pointer nil))
+ :element-type 'integer
+ :initial-contents clock
+ :adjustable nil
+ :fill-pointer nil))
(defmethod make-clock ((minutes integer))
(make-array (+ 1 (max black white))
- :element-type 'integer
- :initial-element
- (* minutes 60
- internal-time-units-per-second)
- :adjustable nil
- :fill-pointer nil))
+ :element-type 'integer
+ :initial-element
+ (* minutes 60
+ internal-time-units-per-second)
+ :adjustable nil
+ :fill-pointer nil))
(defun count-difference (player board)
"Count player's pieces minus opponent's pieces."
(declare (type board board)
- (type fixnum player)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type fixnum player)
+ (optimize (speed 3) (safety 0) (space 0)))
(the fixnum (- (the fixnum (count player board))
- (the fixnum (count (opponent player) board)))))
+ (the fixnum (count (opponent player) board)))))
(defun valid-p (move)
(declare (type move move)
- (optimize (speed 3) (safety 0) (space 0)))
+ (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)))
"A Legal move must be into an empty square, and it must
flip at least one opponent piece."
(declare (type board board)
- (type move move)
- (type player player))
+ (type move move)
+ (type player player))
(and (= (the piece (bref board move)) empty)
(some #'(lambda (dir) (declare (type dir dir)) (would-flip? move player board dir))
+all-directions+)))
"A Legal move must be into an empty square, and it must
flip at least one opponent piece."
(declare (type board board)
- (type move move)
- (type player player)
- (optimize speed (safety 0) (space 0)))
+ (type move move)
+ (type player player)
+ (optimize speed (safety 0) (space 0)))
(if (= (bref board move) empty)
(block search
- (let ((i 0))
- (declare (fixnum i))
- (tagbody t
- (when (>= i 8) (return-from search nil))
- (when (would-flip? move player board (aref +all-directions+ i))
- (return-from search t))
- (incf i)
- (go t))))
+ (let ((i 0))
+ (declare (fixnum i))
+ (tagbody t
+ (when (>= i 8) (return-from search nil))
+ (when (would-flip? move player board (aref +all-directions+ i))
+ (return-from search t))
+ (incf i)
+ (go t))))
nil))
(defun legal-p (move player board)
"A Legal move must be into an empty square, and it must
flip at least one opponent piece."
(declare (type board board)
- (type move move)
- (type player player)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type move move)
+ (type player player)
+ (optimize (speed 3) (safety 0) (space 0)))
(if (= (the piece (bref board move)) empty)
(block search
- (dolist (dir +all-directions+)
- (declare (type dir dir))
- (when (would-flip? move player board dir)
- (return-from search t)))
- (return-from search nil))
+ (dolist (dir +all-directions+)
+ (declare (type dir dir))
+ (when (would-flip? move player board dir)
+ (return-from search t)))
+ (return-from search nil))
nil))
(defstruct (state (:constructor make-state-struct))
(defun make-game-move (game move player)
(when (record-game? game)
(vector-push (make-state move player (clock game) (board game))
- (moves game)))
+ (moves game)))
(make-move move player (board game))
(incf (move-number game)))
(defun reset-game (game &optional (move-number 1))
(if (record-game? game)
(when (< move-number (move-number game))
- (let ((old-state (aref (moves game) (1- move-number))))
- (if old-state
- (progn
- (setf (player game) (state-player old-state))
- (replace-board (board game) (state-board old-state))
- (replace (clock game) (state-clock old-state))
- (setf (fill-pointer (moves game)) (1- move-number))
- (setf (move-number game) move-number))
- (warn "Couldn't find old state"))))
+ (let ((old-state (aref (moves game) (1- move-number))))
+ (if old-state
+ (progn
+ (setf (player game) (state-player old-state))
+ (replace-board (board game) (state-board old-state))
+ (replace (clock game) (state-clock old-state))
+ (setf (fill-pointer (moves game)) (1- move-number))
+ (setf (move-number game) move-number))
+ (warn "Couldn't find old state"))))
(warn "Tried to reset game, but game is not being recorded")))
-
+
(defun make-move (move player board)
"Update board to reflect move by player"
;; First make the move, then make any flips
(declare (type board board)
- (type move move)
- (type player)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type move move)
+ (type player)
+ (optimize (speed 3) (safety 0) (space 0)))
(setf (bref board move) player)
(dolist (dir +all-directions+)
(declare (type dir dir))
(defun make-flips (move player board dir)
"Make any flips in the given direction."
(declare (type board board)
- (type move move)
- (type player player)
- (type dir dir)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type move move)
+ (type player player)
+ (type dir dir)
+ (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))
"Would this move result in any flips in this direction?
If so, return the square number of the bracketing piece."
;; A flip occurs if, starting at the adjacent square, c, there
- ;; is a string of at least one opponent pieces, bracketed by
+ ;; is a string of at least one opponent pieces, bracketed by
;; one of player's pieces
(declare (type board board)
- (type move move)
- (type player player)
- (type dir dir)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type move move)
+ (type player player)
+ (type dir dir)
+ (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 find-bracketing-piece (square player board dir)
"Return the square number of the bracketing piece."
(declare (type board board)
- (type square square)
- (type player player)
- (type dir dir)
- (optimize (speed 3) (safety 0))
+ (type square square)
+ (type player player)
+ (type dir dir)
+ (optimize (speed 3) (safety 0))
)
(cond ((= (bref board square) player) square)
((= (bref board square) (the player (opponent player)))
(defun next-to-play (board previous-player &optional (print nil))
"Compute the player to move next, or NIL if nobody can move."
(declare (type board board)
- (type player previous-player)
- (type boolean print))
+ (type player previous-player)
+ (type boolean print))
(let ((opp (opponent previous-player)))
(cond ((any-legal-move? opp board) opp)
- ((any-legal-move? previous-player board)
+ ((any-legal-move? previous-player board)
(when print
(format t "~&~c has no moves and must pass."
(name-of opp)))
(defun any-legal-move? (player board)
"Does player have any legal moves in this position?"
(declare (type player player)
- (type board board))
+ (type board board))
(some #'(lambda (move) (declare (type move move)) (legal-p move player board))
all-squares))
"Returns a list of legal moves for player"
;;*** fix, segre, 3/30/93. Was remove-if, which can share with all-squares.
(declare (type player player)
- (type board board))
+ (type board board))
(loop for move in all-squares
when (legal-p move player board) collect move))
(defvar *move-number* 1 "The number of the move to be played")
(declaim (type fixnum *move-number*))
-(defun make-game (bl-strategy wh-strategy
- &key
- (print t)
- (minutes +default-max-minutes+)
- (record-game nil))
+(defun make-game (bl-strategy wh-strategy
+ &key
+ (print t)
+ (minutes +default-max-minutes+)
+ (record-game nil))
(let ((game
- (make-instance 'reversi-game :bl-strategy bl-strategy
- :wh-strategy wh-strategy
- :print? print
- :record-game? record-game
- :max-minutes minutes)))
+ (make-instance 'reversi-game :bl-strategy bl-strategy
+ :wh-strategy wh-strategy
+ :print? print
+ :record-game? record-game
+ :max-minutes minutes)))
(setf (clock game) (make-clock minutes))
game))
(defun play-game (game)
(catch 'game-over
(until (null (player game))
- (setq *move-number* (move-number game))
- (get-move game
- (if (= (player game) black)
- (bl-strategy game)
- (wh-strategy game))
- (player game)
- (board game) (print? game) (clock game))
- (setf (player game)
- (next-to-play (board game) (player game) (print? game)))
- (incf (move-number game))))
+ (setq *move-number* (move-number game))
+ (get-move game
+ (if (= (player game) black)
+ (bl-strategy game)
+ (wh-strategy game))
+ (player game)
+ (board game) (print? game) (clock game))
+ (setf (player game)
+ (next-to-play (board game) (player game) (print? game)))
+ (incf (move-number game))))
(when (print? game)
(format t "~&The game is over. Final result:")
(print-board (board game) (clock game)))
(count-difference black (board game)))
-(defun reversi (bl-strategy wh-strategy
+(defun reversi (bl-strategy wh-strategy
&optional (print t) (minutes +default-max-minutes+))
(play-game (make-game bl-strategy wh-strategy :print print
- :record-game nil :minutes minutes)))
+ :record-game nil :minutes minutes)))
(defvar *clock* (make-clock +default-max-minutes+) "A copy of the game clock")
(defvar *board* (initial-board) "A copy of the game board")
(throw 'game-over (if (eql player black) -64 64)))
((and (valid-p move) (legal-p move player board))
(when print
- (format t "~&~c moves to ~a."
+ (format t "~&~c moves to ~a."
(name-of player) (88->h8 move)))
(make-game-move game move player))
(t (warn "Illegal move: ~a" (88->h8 move))
(get-move game strategy player board print clock)))))
-(defun random-reversi-series (strategy1 strategy2
+(defun random-reversi-series (strategy1 strategy2
n-pairs &optional (n-random 10))
"Play a series of 2*n games, starting from a random position."
(reversi-series
:initial-element 0)))
;; Play the games
(dotimes (i N)
- (loop for j from (+ i 1) to (- N 1) do
+ (loop for j from (+ i 1) to (- N 1) do
(let* ((wins (random-reversi-series
(elt strategies i)
(elt strategies j)
(format t "~&~a~20T ~4f: " (elt names i) (elt totals i))
(dotimes (j N)
(format t "~4f " (if (eql i j) '---
- (aref scores i j)))))))
+ (aref scores i j)))))))
projects / reversi.git / blobdiff