X-Git-Url: http://git.kpe.io/?p=reversi.git;a=blobdiff_plain;f=strategies.lisp;h=7bf81fe632485505e51d37b91f44926bc748ba0d;hp=48140bbe424019c7ac8ec2bdc094dfa42edb256f;hb=a8b65e823b3a59faba717887aee3a8a4a8cf0a28;hpb=062d6c95c94ac969bd49083dea184c9bb81d6fea 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" ) - - + +