;;;;***************************************************************************
;;;;
;;;; 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)))))))
;;;;***************************************************************************
;;;;
;;;; FILE IDENTIFICATION
-;;;;
+;;;;
;;;; Name: edge-table-storage.lisp
;;;; Purpose: Store precompiled edge table for reversi
;;;; Programer: Kevin Rosenberg
(eval-when (:load-toplevel :execute)
(let ((precompiled-path (make-pathname
- :directory '(:absolute "usr" "share" "common-lisp"
- "source" "reversi")
- :name "edge-table"
- :type "dat")))
+ :directory '(:absolute "usr" "share" "common-lisp"
+ "source" "reversi")
+ :name "edge-table"
+ :type "dat")))
(if (probe-file precompiled-path)
- (setq *et-path* precompiled-path)
+ (setq *et-path* precompiled-path)
(setq *et-path* (make-pathname
- :directory (pathname-directory *load-truename*)
- :host (pathname-host *load-truename*)
- :device (pathname-device *load-truename*)
- :name "edge-table"
- :type "dat"))))
+ :directory (pathname-directory *load-truename*)
+ :host (pathname-host *load-truename*)
+ :device (pathname-device *load-truename*)
+ :name "edge-table"
+ :type "dat"))))
(defun store-edge-table (et &optional (path *et-path*))
(declare (type edge-table et))
(with-open-file (stream path :direction :output
- :if-exists :supersede)
+ :if-exists :supersede)
(print (length et) stream)
(dotimes (i (length et))
- (declare (fixnum i))
- (print (aref et i) stream))))
-
+ (declare (fixnum i))
+ (print (aref et i) stream))))
+
(defun load-edge-table (&optional (path *et-path*))
(when (probe-file path)
(with-open-file (stream path :direction :input)
- (let* ((length (read stream))
- (et (make-array length :element-type 'fixnum)))
- (declare (type (simple-array fixnum (*)) et))
- (dotimes (i length)
- (declare (fixnum i))
- (setf (aref et i) (read stream)))
- et))))
-
+ (let* ((length (read stream))
+ (et (make-array length :element-type 'fixnum)))
+ (declare (type (simple-array fixnum (*)) et))
+ (dotimes (i length)
+ (declare (fixnum i))
+ (setf (aref et i) (read stream)))
+ et))))
+
(unless (probe-file *et-path*)
(format *trace-output* ";; Recompiling edge-table, this make take several minutes")
(store-edge-table (make-edge-table)))
-
+
(unless *edge-table*
(setq *edge-table* (load-edge-table))))
;;;;***************************************************************************
;;;;
;;;; FILE IDENTIFICATION
-;;;;
+;;;;
;;;; Name: edge-table.lisp
;;;; Purpose: Edge table routines for reversi
;;;; Programer: Kevin M. Rosenberg based on code by Peter Norvig
;;;;
;;;; $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
(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*)
"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)))
- (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)
(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)
- (type player player)
- (type square index))
+ (type player player)
+ (type square index))
(combine-edge-moves
(cons
(list 1.0 (aref *edge-table* index)) ;; no move
"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))
- (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)
- (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*
- (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)
- (list possibilities)
- (optimize (speed 3) (safety 0) (space 0)))
+ (list possibilities)
+ (optimize (speed 3) (safety 0) (space 0)))
(let ((prob 1.0)
(val 0.0)
(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))))
+ do (incf val (* prob (first pair) (second pair)))
+ (decf prob (* prob (first pair))))
(round val)))
(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
((x-square-p square) .5) ;; X-squares
((legal-p square player board) 1.0) ;; immediate capture
(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)
- (declare (type square inc))
+ (declare (type square inc))
(= (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
(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
- 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))
-
+
(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
- ((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)))
- (loop for n-pieces from 0 to 10 do
+ (loop for n-pieces from 0 to 10 do
(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))))
- black (initial-board) n-pieces *top-edge* 0))
+ black (initial-board) n-pieces *top-edge* 0))
;; Now iterate five times trying to improve:
- (dotimes (i 5)
+ (dotimes (i 5)
(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)
- (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))))
;;;;***************************************************************************
;;;;
;;;; FILE IDENTIFICATION
-;;;;
+;;;;
;;;; Name: io-clim.lisp
;;;; Purpose: CLIM GUI for reversi
;;;; Programer: Kevin M. Rosenberg
;;;;
;;;; $Id$
;;;;
-;;;; This file is Copyright (c) 2001-2003 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
(defun make-gui-player (&key id name strategy searcher-id eval-id (ply 0))
(let ((p (make-gui-player-struct :id id :ply ply
- :name name :strategy strategy
- :searcher-id searcher-id :eval-id eval-id))
- (search-func
- (cond
- ((eq searcher-id :human)
- #'human)
- ((eq searcher-id :minimax)
- #'minimax-searcher)
- ((eq searcher-id :alpha-beta)
- #'alpha-beta-searcher)
- ((eq searcher-id :alpha-beta2)
- #'alpha-beta-searcher2)
- ((eq searcher-id :alpha-beta3)
- #'alpha-beta-searcher3)
- ((eq searcher-id :random)
- #'random-strategy)))
- (eval-func
- (cond
- ((eq eval-id :difference)
- #'count-difference)
- ((eq eval-id :weighted)
- #'weighted-squares)
- ((eq eval-id :modified-weighted)
- #'modified-weighted-squares)
- ((eq eval-id :iago)
- #'iago-eval))))
+ :name name :strategy strategy
+ :searcher-id searcher-id :eval-id eval-id))
+ (search-func
+ (cond
+ ((eq searcher-id :human)
+ #'human)
+ ((eq searcher-id :minimax)
+ #'minimax-searcher)
+ ((eq searcher-id :alpha-beta)
+ #'alpha-beta-searcher)
+ ((eq searcher-id :alpha-beta2)
+ #'alpha-beta-searcher2)
+ ((eq searcher-id :alpha-beta3)
+ #'alpha-beta-searcher3)
+ ((eq searcher-id :random)
+ #'random-strategy)))
+ (eval-func
+ (cond
+ ((eq eval-id :difference)
+ #'count-difference)
+ ((eq eval-id :weighted)
+ #'weighted-squares)
+ ((eq eval-id :modified-weighted)
+ #'modified-weighted-squares)
+ ((eq eval-id :iago)
+ #'iago-eval))))
(unless strategy
(cond
((eq search-func #'human)
- )
+ )
((eq search-func #'random-strategy)
- (setf (gui-player-strategy p) search-func))
+ (setf (gui-player-strategy p) search-func))
(t
- (setf (gui-player-strategy p)
- (funcall search-func ply eval-func)))))
+ (setf (gui-player-strategy p)
+ (funcall search-func ply eval-func)))))
p))
(defun current-gui-player (frame)
(if frame
- (aif (reversi-game frame)
- (cond
- ((null (player it))
- nil)
- ((= (player it) black)
- (black-player frame))
- ((= (player it) white)
- (white-player frame))
- (t
- nil))
- nil)
+ (aif (reversi-game frame)
+ (cond
+ ((null (player it))
+ nil)
+ ((= (player it) black)
+ (black-player frame))
+ ((= (player it) white)
+ (white-player frame))
+ (t
+ nil))
+ nil)
nil))
(defun current-gui-player-human? (frame)
(define-application-frame reversi ()
((game :initform nil
- :accessor reversi-game)
+ :accessor reversi-game)
(minutes :initform 30
- :accessor minutes)
+ :accessor minutes)
(black-player :initform nil
- :accessor black-player)
+ :accessor black-player)
(white-player :initform nil
- :accessor white-player)
+ :accessor white-player)
(debug-messages :initform nil
- :accessor debug-messages)
+ :accessor debug-messages)
(msgbar-string :initform nil
- :accessor msgbar-string)
+ :accessor msgbar-string)
(human-time-start :initform nil
- :accessor reversi-human-time-start))
+ :accessor reversi-human-time-start))
(:panes
(board :application
- :display-function 'draw-board
- :text-style '(:sans-serif :bold :very-large)
-;; :incremental-redisplay t
- :text-cursor nil
- :background +green+
- :borders nil
- :scroll-bars nil
- :width (+ label-width board-width)
- :height (+ label-height board-height)
- :min-width board-width
- :min-height board-height
- :max-width +fill+
- :max-height +fill+
- )
+ :display-function 'draw-board
+ :text-style '(:sans-serif :bold :very-large)
+;; :incremental-redisplay t
+ :text-cursor nil
+ :background +green+
+ :borders nil
+ :scroll-bars nil
+ :width (+ label-width board-width)
+ :height (+ label-height board-height)
+ :min-width board-width
+ :min-height board-height
+ :max-width +fill+
+ :max-height +fill+
+ )
(status :application
- :display-function 'draw-status
- :text-style '(:sans-serif :bold :large)
- :incremental-redisplay t
- :text-cursor nil
- :background +white+
- :scroll-bars nil
- :width status-width
- :max-width +fill+
- :max-height +fill+
- :height :compute)
+ :display-function 'draw-status
+ :text-style '(:sans-serif :bold :large)
+ :incremental-redisplay t
+ :text-cursor nil
+ :background +white+
+ :scroll-bars nil
+ :width status-width
+ :max-width +fill+
+ :max-height +fill+
+ :height :compute)
(history :application
- :display-function 'draw-history
- :text-style '(:fix :roman :normal)
- :incremental-redisplay t
- :text-cursor nil
- :background +white+
- :width 220
- :height :compute
- :min-width 100
- :initial-cursor-visibility :on
- :scroll-bars :vertical
- :max-width +fill+
- :max-height +fill+
+ :display-function 'draw-history
+ :text-style '(:fix :roman :normal)
+ :incremental-redisplay t
+ :text-cursor nil
+ :background +white+
+ :width 220
+ :height :compute
+ :min-width 100
+ :initial-cursor-visibility :on
+ :scroll-bars :vertical
+ :max-width +fill+
+ :max-height +fill+
:end-of-page-action :scroll
- :end-of-line-action :scroll)
+ :end-of-line-action :scroll)
(debug-window :application
- :display-function 'draw-debug-window
- :text-style '(:serif :roman :normal)
- :incremental-redisplay t
- :text-cursor nil
- :background +white+
- :width :compute
- :height :compute
- :scroll-bars :vertical
- :max-width +fill+
- :max-height +fill+
- :end-of-page-action :scroll
- :end-of-line-action :scroll
- )
+ :display-function 'draw-debug-window
+ :text-style '(:serif :roman :normal)
+ :incremental-redisplay t
+ :text-cursor nil
+ :background +white+
+ :width :compute
+ :height :compute
+ :scroll-bars :vertical
+ :max-width +fill+
+ :max-height +fill+
+ :end-of-page-action :scroll
+ :end-of-line-action :scroll
+ )
(msgbar :application
- :display-function 'draw-msgbar
- :text-style '(:sans-serif :roman :normal)
- :incremental-redisplay t
- :text-cursor nil
- :background (make-rgb-color 0.75 0.75 0.75)
- :foreground +red+
- :scroll-bars nil
- :width :compute
- :height 25
- :max-width +fill+
- :max-height +fill+
- :end-of-page-action :scroll
- :end-of-line-action :scroll))
+ :display-function 'draw-msgbar
+ :text-style '(:sans-serif :roman :normal)
+ :incremental-redisplay t
+ :text-cursor nil
+ :background (make-rgb-color 0.75 0.75 0.75)
+ :foreground +red+
+ :scroll-bars nil
+ :width :compute
+ :height 25
+ :max-width +fill+
+ :max-height +fill+
+ :end-of-page-action :scroll
+ :end-of-line-action :scroll))
(:pointer-documentation nil)
(:command-table (reversi
- :inherit-from (user-command-table
- reversi-game-table
- reversi-help-table)
- :menu (("Game"
- :menu reversi-game-table
- :keystroke #\G
- :documentation "Game commands")
- ("Help"
- :menu reversi-help-table
- :keystroke #\H
- :documentation "Help Commands"))))
+ :inherit-from (user-command-table
+ reversi-game-table
+ reversi-help-table)
+ :menu (("Game"
+ :menu reversi-game-table
+ :keystroke #\G
+ :documentation "Game commands")
+ ("Help"
+ :menu reversi-help-table
+ :keystroke #\H
+ :documentation "Help Commands"))))
(:menu-bar t)
(:layouts
- (default
- (horizontally ()
- (vertically ()
- (horizontally ()
- board status)
- msgbar
- debug-window)
- history)
+ (default
+ (horizontally ()
+ (vertically ()
+ (horizontally ()
+ board status)
+ msgbar
+ debug-window)
+ history)
))
)
- ;;(:spacing 3)
+ ;;(:spacing 3)
(defmethod frame-standard-input ((reversi reversi))
(get-frame-pane reversi 'debug-window))
(defmethod read-frame-command ((reversi reversi) &key (stream *standard-input*))
(let ((abort-chars #+Genera '(#\Abort #\End)
- #-Genera nil))
+ #-Genera nil))
(let ((command (read-command-using-keystrokes
- (frame-command-table reversi) abort-chars
- :stream stream)))
+ (frame-command-table reversi) abort-chars
+ :stream stream)))
(if (characterp command)
- (frame-exit reversi)
- command))))
+ (frame-exit reversi)
+ command))))
(define-presentation-type reversi-cell ()
:inherit-from '(integer 11 88))
#-lispworks
-(define-presentation-method highlight-presentation ((type reversi-cell)
- record stream state)
+(define-presentation-method highlight-presentation ((type reversi-cell)
+ record stream state)
state
(multiple-value-bind (xoff yoff)
- (clim::convert-from-relative-to-absolute-coordinates
+ (clim::convert-from-relative-to-absolute-coordinates
stream (output-record-parent record))
(with-bounding-rectangle* (left top right bottom) record
(draw-rectangle* stream
- (+ left xoff) (+ top yoff)
- (+ right xoff) (+ bottom yoff)
- :ink +flipping-ink+))))
+ (+ left xoff) (+ top yoff)
+ (+ right xoff) (+ bottom yoff)
+ :ink +flipping-ink+))))
-(define-reversi-command com-select-cell ((move 'reversi-cell))
+(define-reversi-command com-select-cell ((move 'reversi-cell))
(with-application-frame (frame)
(with-slots (game) frame
(let ((gui-player (current-gui-player frame)))
- (when (and game gui-player (gui-player-human? gui-player))
- (if (not (legal-p move (gui-player-id gui-player) (board game)))
- (set-msgbar frame
- (format nil "Illegal move: ~a"
- (symbol-name (88->h8 move))))
- (progn
- (decf (elt (clock game) (player game))
- (- (get-internal-real-time) (gui-player-start-time gui-player)))
- (make-move-gui game move (gui-player-id gui-player))
- (setf (player game) (next-to-play (board game) (player game)))
- (get-move-gui frame))))))))
-
+ (when (and game gui-player (gui-player-human? gui-player))
+ (if (not (legal-p move (gui-player-id gui-player) (board game)))
+ (set-msgbar frame
+ (format nil "Illegal move: ~a"
+ (symbol-name (88->h8 move))))
+ (progn
+ (decf (elt (clock game) (player game))
+ (- (get-internal-real-time) (gui-player-start-time gui-player)))
+ (make-move-gui game move (gui-player-id gui-player))
+ (setf (player game) (next-to-play (board game) (player game)))
+ (get-move-gui frame))))))))
+
(define-presentation-to-command-translator select-cell
- (reversi-cell com-select-cell reversi
+ (reversi-cell com-select-cell reversi
:documentation "Select cell"
:tester ((object frame window) (cell-selectable-p object frame window)))
(object)
(defun cell-selectable-p (object frame window)
(when (and (eq (get-frame-pane frame 'board) window)
- (reversi-game frame))
+ (reversi-game frame))
(let ((game (reversi-game frame)))
(if (legal-p object (player game) (board game))
- t
- nil))))
+ t
+ nil))))
(defun new-game-gui (frame)
- (setf (reversi-game frame)
- (make-game
+ (setf (reversi-game frame)
+ (make-game
(gui-player-strategy (black-player frame))
(gui-player-strategy (white-player frame))
:record-game t
(get-move-gui frame))
-
+
(defmethod initialize-reversi ((reversi reversi))
- (setf (black-player reversi)
+ (setf (black-player reversi)
(make-gui-player :id black :searcher-id :human)
)
(setf (white-player reversi)
- (make-gui-player :id white
- :searcher-id :alpha-beta3
- :eval-id :iago
- :ply 5)))
+ (make-gui-player :id white
+ :searcher-id :alpha-beta3
+ :eval-id :iago
+ :ply 5)))
(defun square-number (row column)
(let ((game (reversi-game reversi)))
(when game
(if (null (player game))
- (progn
- (setf (final-result game) (count-difference black (board game)))
- (format stream "Game Over~2%"))
- (format stream "Move Number ~d~2%" (move-number game)))
+ (progn
+ (setf (final-result game) (count-difference black (board game)))
+ (format stream "Game Over~2%"))
+ (format stream "Move Number ~d~2%" (move-number game)))
(format stream "Pieces~% ~a ~2d~% ~a ~2d~% Difference ~2d~2&"
- (title-of black) (count black (board game))
- (title-of white) (count white (board game))
- (count-difference black (board game)))
+ (title-of black) (count black (board game))
+ (title-of white) (count white (board game))
+ (count-difference black (board game)))
(when (clock game)
- (format stream "Time Remaining~% ~a ~a~% ~a ~a~2%"
- (title-of black) (time-string (elt (clock game) black))
- (title-of white) (time-string (elt (clock game) white))))
+ (format stream "Time Remaining~% ~a ~a~% ~a ~a~2%"
+ (title-of black) (time-string (elt (clock game) black))
+ (title-of white) (time-string (elt (clock game) white))))
(let ((gui-player (current-gui-player reversi)))
- (when (and gui-player (gui-player-human? gui-player))
- (let ((legal-moves
- (loop for move in (legal-moves (gui-player-id gui-player)
- (board game))
- collect (symbol-name (88->h8 move)))))
- (if legal-moves
- (format stream "Valid Moves~%~A"
- (list-to-delimited-string legal-moves #\space)))))
- (when (null (player game))
- (cond
- ((zerop (final-result game))
- (format stream "It's a draw!"))
- ((plusp (final-result game))
- (format stream "Black wins by ~d!" (final-result game)))
- (t
- (format stream "White wins by ~d!" (- 0 (final-result game))))))))))
+ (when (and gui-player (gui-player-human? gui-player))
+ (let ((legal-moves
+ (loop for move in (legal-moves (gui-player-id gui-player)
+ (board game))
+ collect (symbol-name (88->h8 move)))))
+ (if legal-moves
+ (format stream "Valid Moves~%~A"
+ (list-to-delimited-string legal-moves #\space)))))
+ (when (null (player game))
+ (cond
+ ((zerop (final-result game))
+ (format stream "It's a draw!"))
+ ((plusp (final-result game))
+ (format stream "Black wins by ~d!" (final-result game)))
+ (t
+ (format stream "White wins by ~d!" (- 0 (final-result game))))))))))
(let ((game (reversi-game reversi)))
(when (and game (> (move-number game) 1))
(formatting-item-list (stream :move-cursor t :row-wise nil :n-columns 1)
- (dotimes (i (1- (move-number game)))
- (let ((state (aref (moves game) i)))
- (when state
- (let ((str (format nil "~2d: ~5a ~2a"
- (1+ i) (title-of (state-player state))
- (88->h8 (state-move state)))))
- (updating-output (stream :unique-id i :cache-value str)
- (with-end-of-page-action (stream :scroll)
- (formatting-cell (stream :align-x :right :align-y :top)
- (format stream str)
- (terpri stream))))))))))))
+ (dotimes (i (1- (move-number game)))
+ (let ((state (aref (moves game) i)))
+ (when state
+ (let ((str (format nil "~2d: ~5a ~2a"
+ (1+ i) (title-of (state-player state))
+ (88->h8 (state-move state)))))
+ (updating-output (stream :unique-id i :cache-value str)
+ (with-end-of-page-action (stream :scroll)
+ (formatting-cell (stream :align-x :right :align-y :top)
+ (format stream str)
+ (terpri stream))))))))))))
#+ignore
(defmethod draw-history ((reversi reversi) stream &key max-width max-height)
(let ((game (reversi-game reversi)))
(when (and game (> (move-number game) 1))
(formatting-item-list (stream :move-cursor t :row-wise nil :n-columns 2)
- (dotimes (i (1- (move-number game)))
- (let ((state (aref (moves game) i)))
- (when state
- (let ((str (format nil "~2d: ~5a ~2a"
- (1+ i) (title-of (state-player state))
- (88->h8 (state-move state)))))
- (updating-output (stream :unique-id i :cache-value str)
- (with-end-of-page-action (stream :scroll)
- (formatting-cell (stream :align-x :right :align-y :top)
- (format stream str)
- (terpri stream))))))))))))
+ (dotimes (i (1- (move-number game)))
+ (let ((state (aref (moves game) i)))
+ (when state
+ (let ((str (format nil "~2d: ~5a ~2a"
+ (1+ i) (title-of (state-player state))
+ (88->h8 (state-move state)))))
+ (updating-output (stream :unique-id i :cache-value str)
+ (with-end-of-page-action (stream :scroll)
+ (formatting-cell (stream :align-x :right :align-y :top)
+ (format stream str)
+ (terpri stream))))))))))))
#|
(let ((viewport (window-viewport stream)))
- (multiple-value-bind (x y) (stream-cursor-position stream)
- (add-debug reversi (format nil "~d ~d: ~s" x y viewport))
- (if (> y (bounding-rectangle-bottom viewport))
- (decf y (bounding-rectangle-bottom viewport)))
- (window-set-viewport-position stream 0 0))))))
- |#
-
-
+ (multiple-value-bind (x y) (stream-cursor-position stream)
+ (add-debug reversi (format nil "~d ~d: ~s" x y viewport))
+ (if (> y (bounding-rectangle-bottom viewport))
+ (decf y (bounding-rectangle-bottom viewport)))
+ (window-set-viewport-position stream 0 0))))))
+ |#
+
+
(defvar *reversi-frame* nil)
(defun run-frame (frame-name frame)
(flet ((do-it ()
- (when (or *force* (null frame))
- (setq frame (make-application-frame frame-name)))
- (run-frame-top-level frame)))
+ (when (or *force* (null frame))
+ (setq frame (make-application-frame frame-name)))
+ (run-frame-top-level frame)))
#+allegro
(mp:process-run-function (write-to-string frame-name) #'do-it)
#-allegro
(define-command-table reversi-game-table
:menu (("New" :command com-reversi-new)
- ("Backup" :command (com-reversi-backup))
- ("Exit" :command (com-reversi-exit))))
+ ("Backup" :command (com-reversi-backup))
+ ("Exit" :command (com-reversi-exit))))
(define-command-table reversi-help-table)
(define-command (com-reversi-new :name "New Game"
- :command-table reversi-game-table
- :keystroke (:n :control)
- :menu ("New Game"
- :after :start
- :documentation "New Game"))
+ :command-table reversi-game-table
+ :keystroke (:n :control)
+ :menu ("New Game"
+ :after :start
+ :documentation "New Game"))
()
(with-application-frame (frame)
(new-game-gui frame)))
(define-command (com-reversi-recommend :name "Recommend Move"
- :command-table reversi-game-table
- :keystroke (:r :control)
- :menu ("Recommend Move"
- :after "New Game"
- :documentation "Recommend Move"))
+ :command-table reversi-game-table
+ :keystroke (:r :control)
+ :menu ("Recommend Move"
+ :after "New Game"
+ :documentation "Recommend Move"))
()
(with-application-frame (frame)
(let ((game (reversi-game frame))
- (player (current-gui-player frame)))
+ (player (current-gui-player frame)))
(when (and game player)
- (when (gui-player-human? player)
- (let* ((port (find-port))
- (pointer (port-pointer port)))
- (when pointer
- (setf (pointer-cursor pointer) :busy))
- (set-msgbar frame "Thinking...")
- (let ((move (funcall (iago 8) (gui-player-id player)
- (board game))))
- (when pointer
- (setf (pointer-cursor pointer) :default))
- (when move
- (set-msgbar frame
- (format nil "Recommend move to ~a"
- (symbol-name (88->h8 move))))))))))))
+ (when (gui-player-human? player)
+ (let* ((port (find-port))
+ (pointer (port-pointer port)))
+ (when pointer
+ (setf (pointer-cursor pointer) :busy))
+ (set-msgbar frame "Thinking...")
+ (let ((move (funcall (iago 8) (gui-player-id player)
+ (board game))))
+ (when pointer
+ (setf (pointer-cursor pointer) :default))
+ (when move
+ (set-msgbar frame
+ (format nil "Recommend move to ~a"
+ (symbol-name (88->h8 move))))))))))))
(define-command (com-reversi-backup :name "Backup Move"
- :command-table reversi-game-table
- :keystroke (:b :control)
- :menu ("Backup Move"
- :after "Recommend Move"
- :documentation "Backup Move"))
+ :command-table reversi-game-table
+ :keystroke (:b :control)
+ :menu ("Backup Move"
+ :after "Recommend Move"
+ :documentation "Backup Move"))
()
(with-application-frame (frame)
(let ((game (reversi-game frame)))
(when (and game (> (move-number game) 2))
- (reset-game game (- (move-number game) 2))))))
+ (reset-game game (- (move-number game) 2))))))
(define-command (com-reversi-exit :name "Exit"
- :command-table reversi-game-table
- :keystroke (:q :control)
- :menu ("Exit"
- :after "Backup Move"
- :documentation "Quit application"))
+ :command-table reversi-game-table
+ :keystroke (:q :control)
+ :menu ("Exit"
+ :after "Backup Move"
+ :documentation "Quit application"))
()
(clim:frame-exit clim:*application-frame*))
(define-command (com-reversi-options :name "Game Options"
- :command-table reversi-game-table
- :menu ("Game Options" :documentation "Game Options"))
+ :command-table reversi-game-table
+ :menu ("Game Options" :documentation "Game Options"))
()
(with-application-frame (frame)
(game-dialog frame)))
; :inherit-menu t)
(define-command (com-about :command-table reversi-help-table
- :menu
- ("About Reversi"
- :after :start
- :documentation "About Reversi"))
+ :menu
+ ("About Reversi"
+ :after :start
+ :documentation "About Reversi"))
()
t)
;; (acl-clim::pop-up-about-climap-dialog *application-frame*))
(defun make-move-gui (game move player)
(make-game-move game move player))
-
+
(defun get-move-gui (frame)
(let ((gui-player (current-gui-player frame)))
(when gui-player
(if (gui-player-human? gui-player)
- (setf (gui-player-start-time gui-player) (get-internal-real-time))
- (computer-move gui-player frame)))))
+ (setf (gui-player-start-time gui-player) (get-internal-real-time))
+ (computer-move gui-player frame)))))
(defun computer-move (gui-player frame)
(let* ((game (reversi-game frame))
- (port (find-port))
- (pointer (port-pointer port)))
+ (port (find-port))
+ (pointer (port-pointer port)))
(setq pointer nil) ;; pointer causes crash in CLIM. ? port value wrong
(when pointer
(setf (pointer-cursor pointer) :busy))
(set-msgbar frame "Thinking...")
(while (eq gui-player (current-gui-player frame))
- (setf (gui-player-start-time gui-player)
- (get-internal-real-time))
- (let ((move (funcall (gui-player-strategy gui-player)
- (player game)
- (replace-board *board* (board game)))))
- (when (and move (legal-p move (player game) (board game)))
- (decf (elt (clock game) (player game))
- (- (get-internal-real-time)
- (gui-player-start-time gui-player)))
- (make-move-gui game move (player game))
- (setf (player game)
- (next-to-play (board game) (player game))))))
+ (setf (gui-player-start-time gui-player)
+ (get-internal-real-time))
+ (let ((move (funcall (gui-player-strategy gui-player)
+ (player game)
+ (replace-board *board* (board game)))))
+ (when (and move (legal-p move (player game) (board game)))
+ (decf (elt (clock game) (player game))
+ (- (get-internal-real-time)
+ (gui-player-start-time gui-player)))
+ (make-move-gui game move (player game))
+ (setf (player game)
+ (next-to-play (board game) (player game))))))
(set-msgbar frame nil)
(when pointer
(setf (pointer-cursor pointer) :default)))
(redisplay-frame-pane frame (get-frame-pane frame 'board)))
(get-move-gui frame))
-
+
(defun game-dialog (frame)
(let* ((stream (get-frame-pane frame 'debug-window))
- ;; (white-strategy-id (white-strategy-id frame)
- ;; (black-strategy-id (black-strategy-id frame))
- (wh (white-player frame))
- (bl (black-player frame))
- (white-searcher (gui-player-searcher-id wh))
- (white-evaluator (gui-player-eval-id wh))
- (white-ply (gui-player-ply wh))
- (black-searcher (gui-player-searcher-id bl))
- (black-evaluator (gui-player-eval-id bl))
- (black-ply (gui-player-ply bl))
- (minutes (minutes frame)))
-
+ ;; (white-strategy-id (white-strategy-id frame)
+ ;; (black-strategy-id (black-strategy-id frame))
+ (wh (white-player frame))
+ (bl (black-player frame))
+ (white-searcher (gui-player-searcher-id wh))
+ (white-evaluator (gui-player-eval-id wh))
+ (white-ply (gui-player-ply wh))
+ (black-searcher (gui-player-searcher-id bl))
+ (black-evaluator (gui-player-eval-id bl))
+ (black-ply (gui-player-ply bl))
+ (minutes (minutes frame)))
+
(accepting-values (stream :own-window t
- :label "Reversi Parameters")
+ :label "Reversi Parameters")
(setq minutes
- (accept 'integer
- :stream stream
- :prompt "Maximum minutes" :default minutes))
+ (accept 'integer
+ :stream stream
+ :prompt "Maximum minutes" :default minutes))
(terpri stream)
(format stream "White Player~%")
(setq white-searcher
- (accept '(member :human :random :minimax :alpha-beta3)
- :stream stream
- :prompt "White Player Search" :default white-searcher))
+ (accept '(member :human :random :minimax :alpha-beta3)
+ :stream stream
+ :prompt "White Player Search" :default white-searcher))
(terpri stream)
(setq white-evaluator
- (accept '(member :difference :weighted :modified-weighted :iago)
- :stream stream
- :prompt "White Player Evaluator" :default white-evaluator))
+ (accept '(member :difference :weighted :modified-weighted :iago)
+ :stream stream
+ :prompt "White Player Evaluator" :default white-evaluator))
(terpri stream)
- (setq white-ply
- (accept 'integer
- :stream stream
- :prompt "White Ply" :default white-ply))
+ (setq white-ply
+ (accept 'integer
+ :stream stream
+ :prompt "White Ply" :default white-ply))
(terpri stream)
(terpri stream)
(format stream "Black Player~%")
(terpri stream)
(setq black-searcher
- (accept '(member :human :random :minimax :alpha-beta3)
- :stream stream
- :prompt "Black Player Search" :default black-searcher))
+ (accept '(member :human :random :minimax :alpha-beta3)
+ :stream stream
+ :prompt "Black Player Search" :default black-searcher))
(terpri stream)
(setq black-evaluator
- (accept '(member :difference :weighted :modified-weighted :iago)
- :stream stream
- :prompt "Black Player Evaluator" :default black-evaluator))
+ (accept '(member :difference :weighted :modified-weighted :iago)
+ :stream stream
+ :prompt "Black Player Evaluator" :default black-evaluator))
(terpri stream)
- (setq black-ply
- (accept 'integer
- :stream stream
- :prompt "Black Ply" :default black-ply))
+ (setq black-ply
+ (accept 'integer
+ :stream stream
+ :prompt "Black Ply" :default black-ply))
(terpri stream)
)
(setf (minutes frame) minutes)
- (setf (white-player frame) (make-gui-player :id white
- :searcher-id white-searcher
- :eval-id white-evaluator
- :ply white-ply))
- (setf (black-player frame) (make-gui-player :id black
- :searcher-id black-searcher
- :eval-id black-evaluator
- :ply black-ply))
+ (setf (white-player frame) (make-gui-player :id white
+ :searcher-id white-searcher
+ :eval-id white-evaluator
+ :ply white-ply))
+ (setf (black-player frame) (make-gui-player :id black
+ :searcher-id black-searcher
+ :eval-id black-evaluator
+ :ply black-ply))
))
(declare (ignore max-width max-height))
(let ((game (reversi-game reversi)))
(dotimes (i 8)
- (draw-text stream
- (elt "abcdefgh" i)
- (make-point
- (+ label-width (* cell-width i)
- half-cell-inner-width)
- 0)
- :align-x :center :align-y :top))
+ (draw-text stream
+ (elt "abcdefgh" i)
+ (make-point
+ (+ label-width (* cell-width i)
+ half-cell-inner-width)
+ 0)
+ :align-x :center :align-y :top))
(dotimes (i 8)
- (draw-text stream
- (format nil "~d" (1+ i))
- (make-point
- 0
- (+ label-height (* cell-height i)
- half-cell-inner-height))
- :align-x :left :align-y :center))
+ (draw-text stream
+ (format nil "~d" (1+ i))
+ (make-point
+ 0
+ (+ label-height (* cell-height i)
+ half-cell-inner-height))
+ :align-x :left :align-y :center))
(stream-set-cursor-position stream label-width label-height)
(surrounding-output-with-border (stream)
(formatting-table (stream :y-spacing 0 :x-spacing 0)
- (dotimes (row 8)
- (formatting-row (stream)
- (dotimes (column 8)
- (let* ((cell-id (square-number row column))
- (value
- (if game
- (bref (board game) cell-id)
- empty)))
- (updating-output (stream :unique-id cell-id
- :cache-value value)
- (formatting-cell (stream :align-x :right :align-y :top)
- (with-output-as-presentation (stream cell-id 'reversi-cell)
- (draw-rectangle* stream 0 0 cell-width cell-height :filled t :ink +green+)
- (draw-rectangle* stream 0 0 cell-width cell-height :filled nil)
- (cond
- ((= value black)
- (draw-circle*
- stream
- half-cell-inner-width
- half-cell-inner-height
- piece-radius :filled t :ink +black+))
- ((= value white)
- (draw-circle*
- stream
- half-cell-inner-width
- half-cell-inner-height
- piece-radius :filled t :ink +white+))))))))))))))
+ (dotimes (row 8)
+ (formatting-row (stream)
+ (dotimes (column 8)
+ (let* ((cell-id (square-number row column))
+ (value
+ (if game
+ (bref (board game) cell-id)
+ empty)))
+ (updating-output (stream :unique-id cell-id
+ :cache-value value)
+ (formatting-cell (stream :align-x :right :align-y :top)
+ (with-output-as-presentation (stream cell-id 'reversi-cell)
+ (draw-rectangle* stream 0 0 cell-width cell-height :filled t :ink +green+)
+ (draw-rectangle* stream 0 0 cell-width cell-height :filled nil)
+ (cond
+ ((= value black)
+ (draw-circle*
+ stream
+ half-cell-inner-width
+ half-cell-inner-height
+ piece-radius :filled t :ink +black+))
+ ((= value white)
+ (draw-circle*
+ stream
+ half-cell-inner-width
+ half-cell-inner-height
+ piece-radius :filled t :ink +white+))))))))))))))
;;;;***************************************************************************
;;;;
;;;; FILE IDENTIFICATION
-;;;;
+;;;;
;;;; Name: io.lisp
;;;; Purpose: Basic Input-Output for reversi
;;;; Programer: Kevin Rosenberg based on code by Peter Norvig
;;;;
;;;; $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
(eval-when (:compile-toplevel :load-toplevel :execute)
-(let ((square-names
+(let ((square-names
(cross-product #'concat-symbol
'(? A B C D E F G H ?)
'(? 1 2 3 4 5 6 7 8 ?))))
(let (move-list)
(dotimes (i (length moves))
(push (format nil "~2d: ~a ~a~%"
- (1+ i)
- (title-of (nth 1 (elt moves i)))
- (symbol-name (88->h8 (nth 0 (elt moves i)))))
- move-list))
+ (1+ i)
+ (title-of (nth 1 (elt moves i)))
+ (symbol-name (88->h8 (nth 0 (elt moves i)))))
+ move-list))
(setq move-list (nreverse move-list))
(list-to-delimited-string move-list #\space))))
(format nil "~2d:~2,'0d" min sec)))
-
-
+
+
;;;;***************************************************************************
;;;;
;;;; FILE IDENTIFICATION
-;;;;
+;;;;
;;;; Name: package.lisp
;;;; Purpose: Package definition for reversi
;;;; Programer: Kevin M. Rosenberg
;;;;
;;;; $Id$
;;;;
-;;;; This file is Copyright (c) 2001-2003 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
(defpackage #:reversi
(:use #:common-lisp
- #+clisp #:ext
- #+clim #:clim
- #+clim #:clim-sys)
+ #+clisp #:ext
+ #+clim #:clim
+ #+clim #:clim-sys)
#+clim
(:shadowing-import-from :clim :pathname)
#+clim
(:shadowing-import-from :clim :interactive-stream-p)
#+clim
(:shadowing-import-from :clim :boolean)
-
+
(:export
#:reversi
#:random-reversi-series
;;;;***************************************************************************
;;;;
;;;; FILE IDENTIFICATION
-;;;;
+;;;;
;;;; Name: strategies.lisp
;;;; Purpose: Strategy routines for reversi
;;;; Programer: Kevin Rosenberg based on code by Peter Norvig
;;;;
;;;; $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
(defun random-strategy (player board)
"Make any legal move."
(declare (type player player)
- (type board board))
+ (type board board))
(random-nth (legal-moves player board)))
(defun maximize-difference (player board)
"A strategy that maximizes the difference in pieces."
(declare (type player player)
- (type board board))
+ (type board board))
(funcall (maximizer #'count-difference) player board))
(defun maximizer (eval-fn)
"Return a strategy that will consider every legal move,
- apply EVAL-FN to each resulting board, and choose
+ apply EVAL-FN to each resulting board, and choose
the move for which EVAL-FN returns the best score.
FN takes two arguments: the player-to-move and board"
#'(lambda (player board)
(declare (type player player)
- (type board board))
+ (type board board))
(let* ((moves (legal-moves player board))
(scores (mapcar #'(lambda (move)
- (funcall
- eval-fn
- player
- (make-move move player
- (copy-board board))))
+ (funcall
+ eval-fn
+ player
+ (make-move move player
+ (copy-board board))))
moves))
(best (apply #'max scores)))
- (declare (fixnum best))
+ (declare (fixnum best))
(elt moves (position best scores)))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *weights*
- (make-array 100 :element-type 'fixnum
- :fill-pointer nil :adjustable nil
- :initial-contents
- '(0 0 0 0 0 0 0 0 0 0
- 0 120 -20 20 5 5 20 -20 120 0
- 0 -20 -40 -5 -5 -5 -5 -40 -20 0
- 0 20 -5 15 3 3 15 -5 20 0
- 0 5 -5 3 3 3 3 -5 5 0
- 0 5 -5 3 3 3 3 -5 5 0
- 0 20 -5 15 3 3 15 -5 20 0
- 0 -20 -40 -5 -5 -5 -5 -40 -20 0
- 0 120 -20 20 5 5 20 -20 120 0
- 0 0 0 0 0 0 0 0 0 0)))
+ (make-array 100 :element-type 'fixnum
+ :fill-pointer nil :adjustable nil
+ :initial-contents
+ '(0 0 0 0 0 0 0 0 0 0
+ 0 120 -20 20 5 5 20 -20 120 0
+ 0 -20 -40 -5 -5 -5 -5 -40 -20 0
+ 0 20 -5 15 3 3 15 -5 20 0
+ 0 5 -5 3 3 3 3 -5 5 0
+ 0 5 -5 3 3 3 3 -5 5 0
+ 0 20 -5 15 3 3 15 -5 20 0
+ 0 -20 -40 -5 -5 -5 -5 -40 -20 0
+ 0 120 -20 20 5 5 20 -20 120 0
+ 0 0 0 0 0 0 0 0 0 0)))
(declaim (type (simple-array fixnum (100)) *weights*))
)
(eval-when (:compile-toplevel :load-toplevel :execute)
- (setq all-squares
- (sort (loop for i from 11 to 88
- when (<= 1 (mod i 10) 8) collect i)
- #'> :key #'(lambda (sq) (elt *weights* sq)))))
+ (setq all-squares
+ (sort (loop for i from 11 to 88
+ when (<= 1 (mod i 10) 8) collect i)
+ #'> :key #'(lambda (sq) (elt *weights* sq)))))
(defun weighted-squares (player board)
"Sum of the weights of player's squares minus opponent's."
(declare (type player player)
- (type board board))
+ (type board board))
(let ((opp (opponent player)))
(loop for i in all-squares
- when (= (bref board i) player)
+ when (= (bref board i) player)
sum (aref *weights* i)
when (= (bref board i) opp)
sum (- (aref *weights* i)))))
(defun final-value (player board)
"Is this a win, loss, or draw for player?"
(declare (type player player)
- (type board board))
+ (type board board))
(case (signum (count-difference player board))
(-1 losing-value)
( 0 0)
(defun final-value-weighted (player board)
"Is this a win, loss, or draw for player?"
(declare (type player player)
- (type board board))
+ (type board board))
(let ((diff (count-difference player board)))
(case (signum diff)
(-1 (+ losing-value diff))
"Find the best move, for PLAYER, according to EVAL-FN,
searching PLY levels deep and backing up values."
(declare (type player player)
- (type board board)
- (fixnum ply)
- (optimize (speed 3) (space 0) (safety 0)))
+ (type board board)
+ (fixnum ply)
+ (optimize (speed 3) (space 0) (safety 0)))
(if (= ply 0)
(funcall eval-fn player board)
(let ((moves (legal-moves player board)))
"A strategy that searches PLY levels and then uses EVAL-FN."
#'(lambda (player board)
(declare (type player player)
- (type board board))
+ (type board board))
(multiple-value-bind (value move)
- (minimax player board ply eval-fn)
+ (minimax player board ply eval-fn)
(declare (ignore value))
move)))
searching PLY levels deep and backing up values,
using cutoffs whenever possible."
(declare (type player player)
- (type board board)
- (fixnum achievable cutoff ply)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type board board)
+ (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)))
(- cutoff) (- achievable)
(- ply 1) eval-fn))
(final-value player board))
- (let ((best-move (first moves)))
- (declare (type move best-move))
- (loop for move in moves do
- (let* ((board2 (make-move move player
- (copy-board board)))
- (val (- (alpha-beta
+ (let ((best-move (first moves)))
+ (declare (type move best-move))
+ (loop for move in moves do
+ (let* ((board2 (make-move move player
+ (copy-board board)))
+ (val (- (alpha-beta
(opponent player) board2
(- cutoff) (- achievable)
(- ply 1) eval-fn))))
(declare (fixnum depth))
#'(lambda (player board)
(declare (type board board)
- (type player player))
+ (type player player))
(multiple-value-bind (value move)
(alpha-beta player board losing-value winning-value
- depth eval-fn)
+ depth eval-fn)
(declare (ignore value))
move)))
"Like WEIGHTED-SQUARES, but don't take off for moving
near an occupied corner."
(declare (type player player)
- (type board board)
- (optimize (speed 3) (safety 0) (space 0)))
+ (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))
(declare (type square corner))
(when (not (= (bref board corner) empty))
(dolist (c (neighbors corner))
- (declare (type square c))
+ (declare (type square c))
(when (not (= (bref board c) empty))
(incf w (* (- 5 (aref *weights* c))
(if (= (bref board c) player)
-(defstruct (node)
+(defstruct (node)
(square(missing-argument) :type square)
(board (missing-argument) :type board)
(value (missing-argument) :type integer))
"Return a strategy that does A-B search with sorted moves."
#'(lambda (player board)
(declare (type player player)
- (type board board))
+ (type board board))
(multiple-value-bind (value node)
(alpha-beta2
player (make-node :board board
"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)))
+ (optimize (speed 3) (space 0) (safety 0)))
(if (= ply 0)
(values (node-value node) node)
(let* ((board (node-board node))
(- ply 1) eval-fn))
nil)
(values (final-value player board) nil))
- (let ((best-node (first nodes)))
+ (let ((best-node (first nodes)))
(loop for move in nodes
for val = (- (alpha-beta2
(opponent player)
(defun alpha-beta3 (player board achievable cutoff ply eval-fn
killer)
(declare (type board board)
- (type player player)
- (type fixnum achievable cutoff ply)
- (optimize (speed 3) (space 0) (safety 0)))
+ (type player player)
+ (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)
(new-board (svref *ply-boards* ply))
(killer2 nil)
(killer2-val winning-value))
- (declare (type move best-move)
- (type board new-board)
- (type fixnum killer2-val))
+ (declare (type move best-move)
+ (type board new-board)
+ (type fixnum killer2-val))
(loop for move in moves
- do (multiple-value-bind (val reply)
- (alpha-beta3
- (opponent player)
- (make-move move player
- (replace-board new-board board))
- (- cutoff) (- achievable)
- (- ply 1) eval-fn killer2)
- (setf val (- val))
- (when (> val achievable)
- (setq achievable val)
- (setq best-move move))
- (when (and reply (< val killer2-val))
- (setq killer2 reply)
- (setq killer2-val val)))
- until (>= achievable cutoff))
+ do (multiple-value-bind (val reply)
+ (alpha-beta3
+ (opponent player)
+ (make-move move player
+ (replace-board new-board board))
+ (- cutoff) (- achievable)
+ (- ply 1) eval-fn killer2)
+ (setf val (- val))
+ (when (> val achievable)
+ (setq achievable val)
+ (setq best-move move))
+ (when (and reply (< val killer2-val))
+ (setq killer2 reply)
+ (setq killer2-val val)))
+ until (>= achievable cutoff))
(values achievable best-move))))))
(defun alpha-beta3w (player board achievable cutoff ply eval-fn
killer)
(declare (type board board)
- (type player player)
- (type fixnum achievable cutoff ply)
- (type (or null move) killer)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type player player)
+ (type fixnum achievable cutoff ply)
+ (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)
(new-board (svref *ply-boards* ply))
(killer2 nil)
(killer2-val winning-value))
- (declare (type move best-move)
- (type board new-board)
- (type fixnum killer2-val))
+ (declare (type move best-move)
+ (type board new-board)
+ (type fixnum killer2-val))
(loop for move in moves
- do (multiple-value-bind (val reply)
- (alpha-beta3
- (opponent player)
- (make-move move player
- (replace-board new-board board))
- (- cutoff) (- achievable)
- (- ply 1) eval-fn killer2)
- (setf val (- val))
- (when (> val achievable)
- (setq achievable val)
- (setq best-move move))
- (when (and reply (< val killer2-val))
- (setq killer2 reply)
- (setq killer2-val val)))
- until (>= achievable cutoff))
+ do (multiple-value-bind (val reply)
+ (alpha-beta3
+ (opponent player)
+ (make-move move player
+ (replace-board new-board board))
+ (- cutoff) (- achievable)
+ (- ply 1) eval-fn killer2)
+ (setf val (- val))
+ (when (> val achievable)
+ (setq achievable val)
+ (setq best-move move))
+ (when (and reply (< val killer2-val))
+ (setq killer2 reply)
+ (setq killer2-val val)))
+ until (>= achievable cutoff))
(values achievable best-move))))))
"Return a strategy that does A-B search with killer moves."
#'(lambda (player board)
(declare (type board board)
- (type player player))
+ (type player player))
(multiple-value-bind (value move)
(alpha-beta3 player board losing-value winning-value
depth eval-fn nil)
"Return a strategy that does A-B search with killer moves."
#'(lambda (player board)
(nth-value 1
- (alpha-beta3w player board losing-value winning-value
- depth eval-fn nil))))
+ (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,
adjacent to an opponent that are not legal moves.
Returns current and potential mobility for player."
(declare (type board board)
- (type player player)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type player player)
+ (optimize (speed 3) (safety 0) (space 0)))
(let ((opp (opponent player))
(current 0) ; player's current mobility
- (potential 0)) ; player's potential mobility
+ (potential 0)) ; player's potential mobility
(declare (type player opp)
- (type fixnum current potential))
+ (type fixnum current potential))
(dolist (square all-squares)
(declare (type square square))
(when (= (bref board square) empty)
(cond ((legal-p square player board)
(incf current))
- ((some-neighbors board opp (neighbors square))
- (incf potential))
- )))
+ ((some-neighbors board opp (neighbors square))
+ (incf potential))
+ )))
(values current (the fixnum (+ current potential)))))
(defun some-neighbors (board opp neighbors)
(declare (type board board)
- (type player opp)
- (type cons neighbors)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type player opp)
+ (type cons neighbors)
+ (optimize (speed 3) (safety 0) (space 0)))
(block search
(dolist (sq neighbors)
(declare (type square sq))
(when (= (bref board sq) opp)
- (return-from search t)))
+ (return-from search t)))
(return-from search nil)))
(defun edge-stability (player board)
"Total edge evaluation for player to move on board."
(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 edge-list of-type (simple-array fixnum (*)) 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)
- (optimize (speed 3) (safety 0) (space 0)))
+ (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*))
- (+ 75000 (* 1000 *move-number*))))
+ (+ 50000 (* 2000 *move-number*))
+ (+ 75000 (* 1000 *move-number*))))
(c-pot 20000))
(declare (fixnum c-edg c-cur c-pot))
(multiple-value-bind (p-cur p-pot)
(mobility (opponent player) board)
;; Combine the three factors into one sum:
(+ (round (* c-edg (edge-stability player board))
- 32000)
- (round (* c-cur (- p-cur o-cur))
- (+ p-cur o-cur 2))
- (round (* c-pot (- p-pot o-pot))
- (+ p-pot o-pot 2)))))))
+ 32000)
+ (round (* c-cur (- p-cur o-cur))
+ (+ p-cur o-cur 2))
+ (round (* c-pot (- p-pot o-pot))
+ (+ p-pot o-pot 2)))))))
;; Strategy Functions
(defun rr (ply n-pairs)
- (round-robin
- (list #'random-strategy (ab3-df ply) (ab3-wt ply) (ab3-md-wt ply) (iago 3))
- n-pairs
+ (round-robin
+ (list #'random-strategy (ab3-df ply) (ab3-wt ply) (ab3-md-wt ply) (iago 3))
+ n-pairs
10
'(random ab3-df ab3-wt ab3-md-wt iago)))
-
+
(defun text-reversi ()
"Sets up a text game between player and computer"
)
-
-
+
+
;;;;***************************************************************************
;;;;
;;;; FILE IDENTIFICATION
-;;;;
+;;;;
;;;; Name: reversi-base.lisp
;;;; Purpose: Basic functions for reversi
;;;; Programer: Kevin M. Rosenberg
;;;;
;;;; $Id$
;;;;
-;;;; This file is Copyright (c) 2001-2003 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
(let ((output (when list (format nil "~A" (car list)))))
(dolist (obj (rest list))
(setq output (concatenate 'string output
- (format nil "~A" separator)
- (format nil "~A" obj))))
+ (format nil "~A" separator)
+ (format nil "~A" obj))))
output))
-
+
projects / reversi.git / commitdiff