;;;;***************************************************************************
;;;;
;;;; FILE IDENTIFICATION
-;;;;
+;;;;
;;;; Name: strategies.lisp
;;;; Purpose: Strategy routines for reversi
;;;; Programer: Kevin Rosenberg based on code by Peter Norvig
;;;;
;;;; $Id$
;;;;
-;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg
+;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg
;;;; and Copyright (c) 1998-2002 Peter Norvig
;;;;
;;;; Reversi users are granted the rights to distribute and use this software
(defun random-strategy (player board)
"Make any legal move."
(declare (type player player)
- (type board board))
+ (type board board))
(random-nth (legal-moves player board)))
(defun maximize-difference (player board)
"A strategy that maximizes the difference in pieces."
(declare (type player player)
- (type board board))
+ (type board board))
(funcall (maximizer #'count-difference) player board))
(defun maximizer (eval-fn)
"Return a strategy that will consider every legal move,
- apply EVAL-FN to each resulting board, and choose
+ apply EVAL-FN to each resulting board, and choose
the move for which EVAL-FN returns the best score.
FN takes two arguments: the player-to-move and board"
#'(lambda (player board)
(declare (type player player)
- (type board board))
+ (type board board))
(let* ((moves (legal-moves player board))
(scores (mapcar #'(lambda (move)
- (funcall
- eval-fn
- player
- (make-move move player
- (copy-board board))))
+ (funcall
+ eval-fn
+ player
+ (make-move move player
+ (copy-board board))))
moves))
(best (apply #'max scores)))
- (declare (fixnum best))
+ (declare (fixnum best))
(elt moves (position best scores)))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *weights*
- (make-array 100 :element-type 'fixnum
- :fill-pointer nil :adjustable nil
- :initial-contents
- '(0 0 0 0 0 0 0 0 0 0
- 0 120 -20 20 5 5 20 -20 120 0
- 0 -20 -40 -5 -5 -5 -5 -40 -20 0
- 0 20 -5 15 3 3 15 -5 20 0
- 0 5 -5 3 3 3 3 -5 5 0
- 0 5 -5 3 3 3 3 -5 5 0
- 0 20 -5 15 3 3 15 -5 20 0
- 0 -20 -40 -5 -5 -5 -5 -40 -20 0
- 0 120 -20 20 5 5 20 -20 120 0
- 0 0 0 0 0 0 0 0 0 0)))
+ (make-array 100 :element-type 'fixnum
+ :fill-pointer nil :adjustable nil
+ :initial-contents
+ '(0 0 0 0 0 0 0 0 0 0
+ 0 120 -20 20 5 5 20 -20 120 0
+ 0 -20 -40 -5 -5 -5 -5 -40 -20 0
+ 0 20 -5 15 3 3 15 -5 20 0
+ 0 5 -5 3 3 3 3 -5 5 0
+ 0 5 -5 3 3 3 3 -5 5 0
+ 0 20 -5 15 3 3 15 -5 20 0
+ 0 -20 -40 -5 -5 -5 -5 -40 -20 0
+ 0 120 -20 20 5 5 20 -20 120 0
+ 0 0 0 0 0 0 0 0 0 0)))
(declaim (type (simple-array fixnum (100)) *weights*))
)
(eval-when (:compile-toplevel :load-toplevel :execute)
- (setq all-squares
- (sort (loop for i from 11 to 88
- when (<= 1 (mod i 10) 8) collect i)
- #'> :key #'(lambda (sq) (elt *weights* sq)))))
+ (setq all-squares
+ (sort (loop for i from 11 to 88
+ when (<= 1 (mod i 10) 8) collect i)
+ #'> :key #'(lambda (sq) (elt *weights* sq)))))
(defun weighted-squares (player board)
"Sum of the weights of player's squares minus opponent's."
(declare (type player player)
- (type board board))
+ (type board board))
(let ((opp (opponent player)))
(loop for i in all-squares
- when (= (bref board i) player)
+ when (= (bref board i) player)
sum (aref *weights* i)
when (= (bref board i) opp)
sum (- (aref *weights* i)))))
(defun final-value (player board)
"Is this a win, loss, or draw for player?"
(declare (type player player)
- (type board board))
+ (type board board))
(case (signum (count-difference player board))
(-1 losing-value)
( 0 0)
(defun final-value-weighted (player board)
"Is this a win, loss, or draw for player?"
(declare (type player player)
- (type board board))
+ (type board board))
(let ((diff (count-difference player board)))
(case (signum diff)
(-1 (+ losing-value diff))
"Find the best move, for PLAYER, according to EVAL-FN,
searching PLY levels deep and backing up values."
(declare (type player player)
- (type board board)
- (fixnum ply)
- (optimize (speed 3) (space 0) (safety 0)))
+ (type board board)
+ (fixnum ply)
+ (optimize (speed 3) (space 0) (safety 0)))
(if (= ply 0)
(funcall eval-fn player board)
(let ((moves (legal-moves player board)))
"A strategy that searches PLY levels and then uses EVAL-FN."
#'(lambda (player board)
(declare (type player player)
- (type board board))
+ (type board board))
(multiple-value-bind (value move)
- (minimax player board ply eval-fn)
+ (minimax player board ply eval-fn)
(declare (ignore value))
move)))
searching PLY levels deep and backing up values,
using cutoffs whenever possible."
(declare (type player player)
- (type board board)
- (fixnum achievable cutoff ply)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type board board)
+ (fixnum achievable cutoff ply)
+ (optimize (speed 3) (safety 0) (space 0)))
(if (= ply 0)
(funcall eval-fn player board)
(let ((moves (legal-moves player board)))
(- cutoff) (- achievable)
(- ply 1) eval-fn))
(final-value player board))
- (let ((best-move (first moves)))
- (declare (type move best-move))
- (loop for move in moves do
- (let* ((board2 (make-move move player
- (copy-board board)))
- (val (- (alpha-beta
+ (let ((best-move (first moves)))
+ (declare (type move best-move))
+ (loop for move in moves do
+ (let* ((board2 (make-move move player
+ (copy-board board)))
+ (val (- (alpha-beta
(opponent player) board2
(- cutoff) (- achievable)
(- ply 1) eval-fn))))
(declare (fixnum depth))
#'(lambda (player board)
(declare (type board board)
- (type player player))
+ (type player player))
(multiple-value-bind (value move)
(alpha-beta player board losing-value winning-value
- depth eval-fn)
+ depth eval-fn)
(declare (ignore value))
move)))
"Like WEIGHTED-SQUARES, but don't take off for moving
near an occupied corner."
(declare (type player player)
- (type board board)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type board board)
+ (optimize (speed 3) (safety 0) (space 0)))
(let ((w (weighted-squares player board)))
(declare (fixnum w))
(dolist (corner '(11 18 81 88))
(declare (type square corner))
(when (not (= (bref board corner) empty))
(dolist (c (neighbors corner))
- (declare (type square c))
+ (declare (type square c))
(when (not (= (bref board c) empty))
(incf w (* (- 5 (aref *weights* c))
(if (= (bref board c) player)
-(defstruct (node)
+(defstruct (node)
(square(missing-argument) :type square)
(board (missing-argument) :type board)
(value (missing-argument) :type integer))
"Return a strategy that does A-B search with sorted moves."
#'(lambda (player board)
(declare (type player player)
- (type board board))
+ (type board board))
(multiple-value-bind (value node)
(alpha-beta2
player (make-node :board board
"A-B search, sorting moves by eval-fn"
;; Returns two values: achievable-value and move-to-make
(declare (fixnum ply)
- (optimize (speed 3) (space 0) (safety 0)))
+ (optimize (speed 3) (space 0) (safety 0)))
(if (= ply 0)
(values (node-value node) node)
(let* ((board (node-board node))
(- ply 1) eval-fn))
nil)
(values (final-value player board) nil))
- (let ((best-node (first nodes)))
+ (let ((best-node (first nodes)))
(loop for move in nodes
for val = (- (alpha-beta2
(opponent player)
(defun alpha-beta3 (player board achievable cutoff ply eval-fn
killer)
(declare (type board board)
- (type player player)
- (type fixnum achievable cutoff ply)
- (optimize (speed 3) (space 0) (safety 0)))
+ (type player player)
+ (type fixnum achievable cutoff ply)
+ (optimize (speed 3) (space 0) (safety 0)))
"A-B search, putting killer move first."
(if (= ply 0)
(funcall eval-fn player board)
(new-board (svref *ply-boards* ply))
(killer2 nil)
(killer2-val winning-value))
- (declare (type move best-move)
- (type board new-board)
- (type fixnum killer2-val))
+ (declare (type move best-move)
+ (type board new-board)
+ (type fixnum killer2-val))
(loop for move in moves
- do (multiple-value-bind (val reply)
- (alpha-beta3
- (opponent player)
- (make-move move player
- (replace-board new-board board))
- (- cutoff) (- achievable)
- (- ply 1) eval-fn killer2)
- (setf val (- val))
- (when (> val achievable)
- (setq achievable val)
- (setq best-move move))
- (when (and reply (< val killer2-val))
- (setq killer2 reply)
- (setq killer2-val val)))
- until (>= achievable cutoff))
+ do (multiple-value-bind (val reply)
+ (alpha-beta3
+ (opponent player)
+ (make-move move player
+ (replace-board new-board board))
+ (- cutoff) (- achievable)
+ (- ply 1) eval-fn killer2)
+ (setf val (- val))
+ (when (> val achievable)
+ (setq achievable val)
+ (setq best-move move))
+ (when (and reply (< val killer2-val))
+ (setq killer2 reply)
+ (setq killer2-val val)))
+ until (>= achievable cutoff))
(values achievable best-move))))))
(defun alpha-beta3w (player board achievable cutoff ply eval-fn
killer)
(declare (type board board)
- (type player player)
- (type fixnum achievable cutoff ply)
- (type (or null move) killer)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type player player)
+ (type fixnum achievable cutoff ply)
+ (type (or null move) killer)
+ (optimize (speed 3) (safety 0) (space 0)))
"A-B search, putting killer move first."
(if (= ply 0)
(funcall eval-fn player board)
(new-board (svref *ply-boards* ply))
(killer2 nil)
(killer2-val winning-value))
- (declare (type move best-move)
- (type board new-board)
- (type fixnum killer2-val))
+ (declare (type move best-move)
+ (type board new-board)
+ (type fixnum killer2-val))
(loop for move in moves
- do (multiple-value-bind (val reply)
- (alpha-beta3
- (opponent player)
- (make-move move player
- (replace-board new-board board))
- (- cutoff) (- achievable)
- (- ply 1) eval-fn killer2)
- (setf val (- val))
- (when (> val achievable)
- (setq achievable val)
- (setq best-move move))
- (when (and reply (< val killer2-val))
- (setq killer2 reply)
- (setq killer2-val val)))
- until (>= achievable cutoff))
+ do (multiple-value-bind (val reply)
+ (alpha-beta3
+ (opponent player)
+ (make-move move player
+ (replace-board new-board board))
+ (- cutoff) (- achievable)
+ (- ply 1) eval-fn killer2)
+ (setf val (- val))
+ (when (> val achievable)
+ (setq achievable val)
+ (setq best-move move))
+ (when (and reply (< val killer2-val))
+ (setq killer2 reply)
+ (setq killer2-val val)))
+ until (>= achievable cutoff))
(values achievable best-move))))))
"Return a strategy that does A-B search with killer moves."
#'(lambda (player board)
(declare (type board board)
- (type player player))
+ (type player player))
(multiple-value-bind (value move)
(alpha-beta3 player board losing-value winning-value
depth eval-fn nil)
"Return a strategy that does A-B search with killer moves."
#'(lambda (player board)
(nth-value 1
- (alpha-beta3w player board losing-value winning-value
- depth eval-fn nil))))
+ (alpha-beta3w player board losing-value winning-value
+ depth eval-fn nil))))
(defun put-first (killer moves)
"Move the killer move to the front of moves,
adjacent to an opponent that are not legal moves.
Returns current and potential mobility for player."
(declare (type board board)
- (type player player)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type player player)
+ (optimize (speed 3) (safety 0) (space 0)))
(let ((opp (opponent player))
(current 0) ; player's current mobility
- (potential 0)) ; player's potential mobility
+ (potential 0)) ; player's potential mobility
(declare (type player opp)
- (type fixnum current potential))
+ (type fixnum current potential))
(dolist (square all-squares)
(declare (type square square))
(when (= (bref board square) empty)
(cond ((legal-p square player board)
(incf current))
- ((some-neighbors board opp (neighbors square))
- (incf potential))
- )))
+ ((some-neighbors board opp (neighbors square))
+ (incf potential))
+ )))
(values current (the fixnum (+ current potential)))))
(defun some-neighbors (board opp neighbors)
(declare (type board board)
- (type player opp)
- (type cons neighbors)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type player opp)
+ (type cons neighbors)
+ (optimize (speed 3) (safety 0) (space 0)))
(block search
(dolist (sq neighbors)
(declare (type square sq))
(when (= (bref board sq) opp)
- (return-from search t)))
+ (return-from search t)))
(return-from search nil)))
(defun edge-stability (player board)
"Total edge evaluation for player to move on board."
(declare (type board board)
- (type player player)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type player player)
+ (optimize (speed 3) (safety 0) (space 0)))
(loop for edge-list of-type (simple-array fixnum (*)) in *edge-and-x-lists*
sum (aref *edge-table* (edge-index player board edge-list))))
;; The three factors are multiplied by coefficients
;; that vary by move number:
(declare (type board board)
- (type player player)
- (optimize (speed 3) (safety 0) (space 0)))
+ (type player player)
+ (optimize (speed 3) (safety 0) (space 0)))
(let ((c-edg (+ 312000 (* 6240 *move-number*)))
(c-cur (if (< *move-number* 25)
- (+ 50000 (* 2000 *move-number*))
- (+ 75000 (* 1000 *move-number*))))
+ (+ 50000 (* 2000 *move-number*))
+ (+ 75000 (* 1000 *move-number*))))
(c-pot 20000))
(declare (fixnum c-edg c-cur c-pot))
(multiple-value-bind (p-cur p-pot)
(mobility (opponent player) board)
;; Combine the three factors into one sum:
(+ (round (* c-edg (edge-stability player board))
- 32000)
- (round (* c-cur (- p-cur o-cur))
- (+ p-cur o-cur 2))
- (round (* c-pot (- p-pot o-pot))
- (+ p-pot o-pot 2)))))))
+ 32000)
+ (round (* c-cur (- p-cur o-cur))
+ (+ p-cur o-cur 2))
+ (round (* c-pot (- p-pot o-pot))
+ (+ p-pot o-pot 2)))))))
;; Strategy Functions
(defun rr (ply n-pairs)
- (round-robin
- (list #'random-strategy (ab3-df ply) (ab3-wt ply) (ab3-md-wt ply) (iago 3))
- n-pairs
+ (round-robin
+ (list #'random-strategy (ab3-df ply) (ab3-wt ply) (ab3-md-wt ply) (iago 3))
+ n-pairs
10
'(random ab3-df ab3-wt ab3-md-wt iago)))
-
+
(defun text-reversi ()
"Sets up a text game between player and computer"
)
-
-
+
+
projects / reversi.git / blobdiff