;;;; Name: strategies.lisp
;;;; Purpose: Strategy routines for reversi
;;;; Programer: Kevin Rosenberg based on code by Peter Norvig
;;;; Date Started: 1 Nov 2001
;;;;
;;;; Name: strategies.lisp
;;;; Purpose: Strategy routines for reversi
;;;; Programer: Kevin Rosenberg based on code by Peter Norvig
;;;; Date Started: 1 Nov 2001
;;;;
;;;; 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
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;;***************************************************************************
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;;***************************************************************************
(defun maximize-difference (player board)
"A strategy that maximizes the difference in pieces."
(declare (type player player)
(defun maximize-difference (player board)
"A strategy that maximizes the difference in pieces."
(declare (type player player)
(funcall (maximizer #'count-difference) player board))
(defun maximizer (eval-fn)
"Return a strategy that will consider every legal move,
(funcall (maximizer #'count-difference) player board))
(defun maximizer (eval-fn)
"Return a strategy that will consider every legal move,
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)
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)
- (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)
(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)
(defun weighted-squares (player board)
"Sum of the weights of player's squares minus opponent's."
(declare (type player player)
(defun final-value (player board)
"Is this a win, loss, or draw for player?"
(declare (type player player)
(defun final-value (player board)
"Is this a win, loss, or draw for player?"
(declare (type player player)
(defun final-value-weighted (player board)
"Is this a win, loss, or draw for player?"
(declare (type player player)
(defun final-value-weighted (player board)
"Is this a win, loss, or draw for player?"
(declare (type player player)
"Find the best move, for PLAYER, according to EVAL-FN,
searching PLY levels deep and backing up values."
(declare (type player player)
"Find the best move, for PLAYER, according to EVAL-FN,
searching PLY levels deep and backing up values."
(declare (type player player)
searching PLY levels deep and backing up values,
using cutoffs whenever possible."
(declare (type player player)
searching PLY levels deep and backing up values,
using cutoffs whenever possible."
(declare (type player player)
- (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
"Like WEIGHTED-SQUARES, but don't take off for moving
near an occupied corner."
(declare (type player player)
"Like WEIGHTED-SQUARES, but don't take off for moving
near an occupied corner."
(declare (type player player)
(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))
(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))
(when (not (= (bref board c) empty))
(incf w (* (- 5 (aref *weights* c))
(if (= (bref board c) player)
(when (not (= (bref board c) empty))
(incf w (* (- 5 (aref *weights* c))
(if (= (bref board c) player)
(square(missing-argument) :type square)
(board (missing-argument) :type board)
(value (missing-argument) :type integer))
(square(missing-argument) :type square)
(board (missing-argument) :type board)
(value (missing-argument) :type integer))
(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
(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
"A-B search, putting killer move first."
(if (= ply 0)
(funcall eval-fn player board)
"A-B search, putting killer move first."
(if (= ply 0)
(funcall eval-fn player board)
- 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)
(values achievable best-move))))))
(defun alpha-beta3w (player board achievable cutoff ply eval-fn
killer)
(declare (type board board)
"A-B search, putting killer move first."
(if (= ply 0)
(funcall eval-fn player board)
"A-B search, putting killer move first."
(if (= ply 0)
(funcall eval-fn player board)
- 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))
(defun alpha-beta-searcher3w (depth eval-fn)
"Return a strategy that does A-B search with killer moves."
#'(lambda (player board)
(defun alpha-beta-searcher3w (depth eval-fn)
"Return a strategy that does A-B search with killer moves."
#'(lambda (player board)
(defun put-first (killer moves)
"Move the killer move to the front of moves,
(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)
adjacent to an opponent that are not legal moves.
Returns current and potential mobility for player."
(declare (type board board)
(dolist (square all-squares)
(declare (type square square))
(when (= (bref board square) empty)
(cond ((legal-p square player board)
(incf current))
(dolist (square all-squares)
(declare (type square square))
(when (= (bref board square) empty)
(cond ((legal-p square player board)
(incf current))
(values current (the fixnum (+ current potential)))))
(defun some-neighbors (board opp neighbors)
(declare (type board board)
(values current (the fixnum (+ current potential)))))
(defun some-neighbors (board opp neighbors)
(declare (type board board)
(return-from search nil)))
(defun edge-stability (player board)
"Total edge evaluation for player to move on board."
(declare (type board board)
(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
(defun iago-eval (player board)
"Combine edge-stability, current mobility and
;; The three factors are multiplied by coefficients
;; that vary by move number:
(declare (type board board)
;; The three factors are multiplied by coefficients
;; that vary by move number:
(declare (type board board)
(mobility (opponent player) board)
;; Combine the three factors into one sum:
(+ (round (* c-edg (edge-stability player board))
(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)))))))