From a8b65e823b3a59faba717887aee3a8a4a8cf0a28 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Fri, 31 Aug 2007 18:04:31 +0000 Subject: [PATCH] r11859: Canonicalize whitespace --- base.lisp | 250 +++++++------- edge-table-storage.lisp | 48 +-- edge-table.lisp | 168 ++++----- io-clim.lisp | 750 ++++++++++++++++++++-------------------- io.lisp | 18 +- package.lisp | 12 +- strategies.lisp | 260 +++++++------- utils.lisp | 10 +- 8 files changed, 758 insertions(+), 758 deletions(-) diff --git a/base.lisp b/base.lisp index a6a7946..f47126c 100644 --- a/base.lisp +++ b/base.lisp @@ -2,7 +2,7 @@ ;;;;*************************************************************************** ;;;; ;;;; FILE IDENTIFICATION -;;;; +;;;; ;;;; Name: base.lisp ;;;; Purpose: Basic functions for reversi ;;;; Programer: Kevin Rosenberg based on code by Peter Norvig @@ -10,7 +10,7 @@ ;;;; ;;;; $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 @@ -48,45 +48,45 @@ (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) @@ -104,8 +104,8 @@ (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) @@ -113,8 +113,8 @@ (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 () @@ -124,7 +124,7 @@ ;; 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)) @@ -139,31 +139,31 @@ (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))) @@ -172,8 +172,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+))) @@ -183,35 +183,35 @@ "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)) @@ -223,31 +223,31 @@ (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)) @@ -257,10 +257,10 @@ (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)) @@ -270,13 +270,13 @@ "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))) @@ -285,10 +285,10 @@ (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))) @@ -298,11 +298,11 @@ (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))) @@ -312,7 +312,7 @@ (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)) @@ -321,7 +321,7 @@ "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)) @@ -335,43 +335,43 @@ (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") @@ -396,14 +396,14 @@ (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 @@ -446,7 +446,7 @@ :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) @@ -461,5 +461,5 @@ (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))))))) diff --git a/edge-table-storage.lisp b/edge-table-storage.lisp index 7e8e88d..f8d3b10 100644 --- a/edge-table-storage.lisp +++ b/edge-table-storage.lisp @@ -1,7 +1,7 @@ ;;;;*************************************************************************** ;;;; ;;;; FILE IDENTIFICATION -;;;; +;;;; ;;;; Name: edge-table-storage.lisp ;;;; Purpose: Store precompiled edge table for reversi ;;;; Programer: Kevin Rosenberg @@ -22,43 +22,43 @@ (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)))) diff --git a/edge-table.lisp b/edge-table.lisp index d61cb88..524fbcb 100644 --- a/edge-table.lisp +++ b/edge-table.lisp @@ -1,7 +1,7 @@ ;;;;*************************************************************************** ;;;; ;;;; FILE IDENTIFICATION -;;;; +;;;; ;;;; Name: edge-table.lisp ;;;; Purpose: Edge table routines for reversi ;;;; Programer: Kevin M. Rosenberg based on code by Peter Norvig @@ -9,7 +9,7 @@ ;;;; ;;;; $Id$ ;;;; -;;;; 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 @@ -38,7 +38,7 @@ (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*) @@ -49,17 +49,17 @@ "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) @@ -73,11 +73,11 @@ (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 @@ -91,47 +91,47 @@ "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))) @@ -145,9 +145,9 @@ (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 @@ -169,15 +169,15 @@ (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 @@ -194,77 +194,77 @@ (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)))) diff --git a/io-clim.lisp b/io-clim.lisp index 79718de..bc6a24d 100644 --- a/io-clim.lisp +++ b/io-clim.lisp @@ -2,7 +2,7 @@ ;;;;*************************************************************************** ;;;; ;;;; FILE IDENTIFICATION -;;;; +;;;; ;;;; Name: io-clim.lisp ;;;; Purpose: CLIM GUI for reversi ;;;; Programer: Kevin M. Rosenberg @@ -10,7 +10,7 @@ ;;;; ;;;; $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 @@ -44,41 +44,41 @@ (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)) @@ -87,17 +87,17 @@ (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) @@ -110,116 +110,116 @@ (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)) @@ -233,49 +233,49 @@ (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) @@ -283,17 +283,17 @@ (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 @@ -303,16 +303,16 @@ (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) @@ -325,35 +325,35 @@ (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)))))))))) @@ -381,17 +381,17 @@ (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) @@ -399,29 +399,29 @@ (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) @@ -441,9 +441,9 @@ (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 @@ -453,74 +453,74 @@ (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))) @@ -536,10 +536,10 @@ ; :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*)) @@ -548,35 +548,35 @@ (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))) @@ -586,74 +586,74 @@ (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)) )) @@ -662,51 +662,51 @@ (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+)))))))))))))) diff --git a/io.lisp b/io.lisp index c31392e..3de7a2a 100644 --- a/io.lisp +++ b/io.lisp @@ -2,7 +2,7 @@ ;;;;*************************************************************************** ;;;; ;;;; FILE IDENTIFICATION -;;;; +;;;; ;;;; Name: io.lisp ;;;; Purpose: Basic Input-Output for reversi ;;;; Programer: Kevin Rosenberg based on code by Peter Norvig @@ -10,7 +10,7 @@ ;;;; ;;;; $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 @@ -22,7 +22,7 @@ (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 ?)))) @@ -43,10 +43,10 @@ (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)))) @@ -84,5 +84,5 @@ (format nil "~2d:~2,'0d" min sec))) - - + + diff --git a/package.lisp b/package.lisp index 927c4ff..d8617e8 100644 --- a/package.lisp +++ b/package.lisp @@ -1,7 +1,7 @@ ;;;;*************************************************************************** ;;;; ;;;; FILE IDENTIFICATION -;;;; +;;;; ;;;; Name: package.lisp ;;;; Purpose: Package definition for reversi ;;;; Programer: Kevin M. Rosenberg @@ -9,7 +9,7 @@ ;;;; ;;;; $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 @@ -20,16 +20,16 @@ (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 diff --git a/strategies.lisp b/strategies.lisp index 48140bb..7bf81fe 100644 --- a/strategies.lisp +++ b/strategies.lisp @@ -2,7 +2,7 @@ ;;;;*************************************************************************** ;;;; ;;;; FILE IDENTIFICATION -;;;; +;;;; ;;;; Name: strategies.lisp ;;;; Purpose: Strategy routines for reversi ;;;; Programer: Kevin Rosenberg based on code by Peter Norvig @@ -10,7 +10,7 @@ ;;;; ;;;; $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 @@ -23,67 +23,67 @@ (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))))) @@ -94,7 +94,7 @@ (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) @@ -103,7 +103,7 @@ (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)) @@ -114,9 +114,9 @@ "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))) @@ -143,9 +143,9 @@ "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))) @@ -154,9 +154,9 @@ 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))) @@ -166,12 +166,12 @@ (- 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)))) @@ -186,10 +186,10 @@ (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))) @@ -197,15 +197,15 @@ "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) @@ -234,7 +234,7 @@ -(defstruct (node) +(defstruct (node) (square(missing-argument) :type square) (board (missing-argument) :type board) (value (missing-argument) :type integer)) @@ -243,7 +243,7 @@ "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 @@ -256,7 +256,7 @@ "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)) @@ -269,7 +269,7 @@ (- 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) @@ -305,9 +305,9 @@ (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) @@ -322,34 +322,34 @@ (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) @@ -364,25 +364,25 @@ (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)))))) @@ -390,7 +390,7 @@ "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) @@ -401,8 +401,8 @@ "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, @@ -417,41 +417,41 @@ 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)))) @@ -461,12 +461,12 @@ ;; 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) @@ -475,11 +475,11 @@ (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 @@ -535,16 +535,16 @@ (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" ) - - + + diff --git a/utils.lisp b/utils.lisp index 1dfa25c..92f9f99 100644 --- a/utils.lisp +++ b/utils.lisp @@ -1,7 +1,7 @@ ;;;;*************************************************************************** ;;;; ;;;; FILE IDENTIFICATION -;;;; +;;;; ;;;; Name: reversi-base.lisp ;;;; Purpose: Basic functions for reversi ;;;; Programer: Kevin M. Rosenberg @@ -9,7 +9,7 @@ ;;;; ;;;; $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 @@ -78,9 +78,9 @@ (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)) - + -- 2.34.1