X-Git-Url: http://git.kpe.io/?p=reversi.git;a=blobdiff_plain;f=strategies.lisp;h=7bf81fe632485505e51d37b91f44926bc748ba0d;hp=e7d2fe681063a35c0c402e28b0a035c7cb99a2dc;hb=HEAD;hpb=48b1a775e575a66bc154620107a8e27321ea306c diff --git a/strategies.lisp b/strategies.lisp index e7d2fe6..7bf81fe 100644 --- a/strategies.lisp +++ b/strategies.lisp @@ -2,15 +2,15 @@ ;;;;*************************************************************************** ;;;; ;;;; FILE IDENTIFICATION -;;;; +;;;; ;;;; Name: strategies.lisp ;;;; Purpose: Strategy routines for reversi ;;;; Programer: Kevin Rosenberg based on code by Peter Norvig ;;;; Date Started: 1 Nov 2001 ;;;; -;;;; $Id: strategies.lisp,v 1.5 2003/05/06 15:51:20 kevin Exp $ +;;;; $Id$ ;;;; -;;;; This file is Copyright (c) 2001-2002 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 @@ -20,74 +20,70 @@ (in-package #:reversi) -(eval-when (:compile-toplevel) - (declaim (optimize (safety 1) (space 0) (speed 3) (compilation-speed 0)))) - (defun random-strategy (player board) "Make any legal move." (declare (type player player) - (type board board)) - (random-elt (legal-moves player 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))))) @@ -98,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) @@ -107,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)) @@ -118,8 +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)) + (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))) @@ -146,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))) @@ -157,8 +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)) + (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))) @@ -168,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)))) @@ -188,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))) @@ -199,14 +197,15 @@ "Like WEIGHTED-SQUARES, but don't take off for moving near an occupied corner." (declare (type player player) - (type board board)) + (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) @@ -235,7 +234,7 @@ -(defstruct (node) +(defstruct (node) (square(missing-argument) :type square) (board (missing-argument) :type board) (value (missing-argument) :type integer)) @@ -244,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,6 +255,8 @@ (defun alpha-beta2 (player node achievable cutoff ply eval-fn) "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))) (if (= ply 0) (values (node-value node) node) (let* ((board (node-board node)) @@ -268,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) @@ -283,6 +284,7 @@ (defun negate-value (node) "Set the value of a node to its negative." + (declare (optimize (speed 3) (safety 0) (space 0))) (setf (node-value node) (- (node-value node))) node) @@ -303,8 +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)) + (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) @@ -319,33 +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 move killer)) + (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) @@ -360,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)))))) @@ -386,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) @@ -396,11 +400,9 @@ (defun alpha-beta-searcher3w (depth eval-fn) "Return a strategy that does A-B search with killer moves." #'(lambda (player board) - (multiple-value-bind (value move) - (alpha-beta3w player board losing-value winning-value - depth eval-fn nil) - (declare (ignore value)) - move))) + (nth-value 1 + (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, @@ -415,43 +417,43 @@ 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 ))) + (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))) + (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)) - (loop for edge-list in *edge-and-x-lists* - sum (aref *edge-table* - (edge-index player board edge-list)))) + (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)))) (defun iago-eval (player board) "Combine edge-stability, current mobility and @@ -459,11 +461,12 @@ ;; The three factors are multiplied by coefficients ;; that vary by move number: (declare (type board board) - (type player player)) + (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) @@ -472,17 +475,18 @@ (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 iago (depth) "Use an approximation of Iago's evaluation function." + (declare (fixnum depth)) (alpha-beta-searcher3 depth #'iago-eval)) ;; Maximizer (1-ply) @@ -518,26 +522,29 @@ (defun ab3w-df (ply) + (declare (fixnum ply)) (alpha-beta-searcher3w ply #'count-difference)) (defun ab3w-wt (ply) + (declare (fixnum ply)) (alpha-beta-searcher3w ply #'weighted-squares)) (defun ab3w-md-wt (ply) + (declare (fixnum ply)) (alpha-beta-searcher3w ply #'modified-weighted-squares)) (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" ) - - + +