r11859: Canonicalize whitespace
[reversi.git] / base.lisp
index a6a79469ac7a9aa0c4cdd5e0e2aacdaddf3ebd9d..f47126c941604b657358846fd0072f4e52007e48 100644 (file)
--- a/base.lisp
+++ b/base.lisp
@@ -2,7 +2,7 @@
 ;;;;***************************************************************************
 ;;;;
 ;;;; FILE IDENTIFICATION
 ;;;;***************************************************************************
 ;;;;
 ;;;; FILE IDENTIFICATION
-;;;; 
+;;;;
 ;;;;  Name:           base.lisp
 ;;;;  Purpose:        Basic functions for reversi
 ;;;;  Programer:      Kevin Rosenberg based on code by Peter Norvig
 ;;;;  Name:           base.lisp
 ;;;;  Purpose:        Basic functions for reversi
 ;;;;  Programer:      Kevin Rosenberg based on code by Peter Norvig
@@ -10,7 +10,7 @@
 ;;;;
 ;;;; $Id$
 ;;;;
 ;;;;
 ;;;; $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
 ;;;; 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
 
 (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
 (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
    (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
    (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
    (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
    (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?
    (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?
    (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
    (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
    (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
    (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)
       :bl-strategy nil
     :wh-strategy nil
     :board (initial-board)
 (defun title-of (piece)
   (declare (fixnum piece))
   (nth (the fixnum (1- piece)) '("Black" "White")) )
 (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)
   `(if (= ,player black) white black))
 
 (defmacro bref (board square)
 
 (defparameter all-squares
     (loop for i fixnum from 11 to 88
 
 (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 ()
   "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
   ;; 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))
     (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))
 (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))
 
 (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)
 
 (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 (- (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)
 
 (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)))
 
   "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)
   "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+)))
   (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)
   "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
   (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)
     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
   (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))
     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))
 (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))
   (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")))
   (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)
 (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))
   (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)
 (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))
   (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
   "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)
   ;; 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)))
   (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)
 (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)))
 )
   (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)
 (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)
   (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)))
            (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)
 (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))
 
   (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)
   "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))
 
   (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*))
 
 (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
   (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))
     (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)))
 
 
   (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
                 &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")
 
 (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
        (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)))))
 
 
                  (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
                               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)
                              :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)
           (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) '---
       (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)))))))