+++ /dev/null
-;;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-
-;;;; Code from Paradigms of AI Programming
-;;;; Copyright (c) 1991 Peter Norvig
-
-;;;; File othello.lisp: An othello monitor, with all strategies
-;;;; up to and including section 18.8
-
-;;; One bug fix by Alberto Segre, segre@cs.cornell.edu, March 1993.
-
-(defun mappend (fn list)
- "Append the results of calling fn on each element of list.
- Like mapcon, but uses append instead of nconc."
- (apply #'append (mapcar fn list)))
-
-(defun random-elt (seq)
- "Pick a random element out of a sequence."
- (elt seq (random (length seq))))
-
-(defun concat-symbol (&rest args)
- "Concatenate symbols or strings to form an interned symbol"
- (intern (format nil "~{~a~}" args)))
-
-(defun cross-product (fn xlist ylist)
- "Return a list of all (fn x y) values."
- (mappend #'(lambda (y)
- (mapcar #'(lambda (x) (funcall fn x y))
- xlist))
- ylist))
-
-(defconstant all-directions '(-11 -10 -9 -1 1 9 10 11))
-
-(defconstant empty 0 "An empty square")
-(defconstant black 1 "A black piece")
-(defconstant white 2 "A white piece")
-(defconstant outer 3 "Marks squares outside the 8x8 board")
-
-(deftype piece () `(integer ,empty ,outer))
-
-(defun name-of (piece) (char ".@O?" piece))
-
-(defun opponent (player) (if (eql player black) white black))
-
-(deftype board () '(simple-array piece (100)))
-
-(defun bref (board square) (aref board square))
-(defsetf bref (board square) (val)
- `(setf (aref ,board ,square) ,val))
-
-(defun copy-board (board)
- (copy-seq board))
-
-(defconstant all-squares
- (loop for i from 11 to 88 when (<= 1 (mod i 10) 8) collect i))
-
-(defun initial-board ()
- "Return a board, empty except for four pieces in the middle."
- ;; Boards are 100-element vectors, with elements 11-88 used,
- ;; and the others marked with the sentinel OUTER. Initially
- ;; the 4 center squares are taken, the others empty.
- (let ((board (make-array 100 :element-type 'piece
- :initial-element outer)))
- (dolist (square all-squares)
- (setf (bref board square) empty))
- (setf (bref board 44) white (bref board 45) black
- (bref board 54) black (bref board 55) white)
- board))
-
-(defun count-difference (player board)
- "Count player's pieces minus opponent's pieces."
- (- (count player board)
- (count (opponent player) board)))
-
-(defun valid-p (move)
- "Valid moves are numbers in the range 11-88 that end in 1-8."
- (and (integerp move) (<= 11 move 88) (<= 1 (mod move 10) 8)))
-
-(defun legal-p (move player board)
- "A Legal move must be into an empty square, and it must
- flip at least one opponent piece."
- (and (eql (bref board move) empty)
- (some #'(lambda (dir) (would-flip? move player board dir))
- all-directions)))
-
-(defun make-move (move player board)
- "Update board to reflect move by player"
- ;; First make the move, then make any flips
- (setf (bref board move) player)
- (dolist (dir all-directions)
- (make-flips move player board dir))
- board)
-
-(defun make-flips (move player board dir)
- "Make any flips in the given direction."
- (let ((bracketer (would-flip? move player board dir)))
- (when bracketer
- (loop for c from (+ move dir) by dir until (eql c bracketer)
- do (setf (bref board c) player)))))
-
-(defun would-flip? (move player board dir)
- "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
- ;; one of player's pieces
- (let ((c (+ move dir)))
- (and (eql (bref board c) (opponent player))
- (find-bracketing-piece (+ c dir) player board dir))))
-
-(defun find-bracketing-piece (square player board dir)
- "Return the square number of the bracketing piece."
- (cond ((eql (bref board square) player) square)
- ((eql (bref board square) (opponent player))
- (find-bracketing-piece (+ square dir) player board dir))
- (t nil)))
-
-(defun next-to-play (board previous-player print)
- "Compute the player to move next, or NIL if nobody can move."
- (let ((opp (opponent previous-player)))
- (cond ((any-legal-move? opp board) opp)
- ((any-legal-move? previous-player board)
- (when print
- (format t "~&~c has no moves and must pass."
- (name-of opp)))
- previous-player)
- (t nil))))
-
-(defun any-legal-move? (player board)
- "Does player have any legal moves in this position?"
- (some #'(lambda (move) (legal-p move player board))
- all-squares))
-
-(defun random-strategy (player board)
- "Make any legal move."
- (random-elt (legal-moves player board)))
-
-(defun legal-moves (player board)
- "Returns a list of legal moves for player"
- ;;*** fix, segre, 3/30/93. Was remove-if, which can share with all-squares.
- (loop for move in all-squares
- when (legal-p move player board) collect move))
-
-(defun maximize-difference (player board)
- "A strategy that maximizes the difference in pieces."
- (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
- the move for which EVAL-FN returns the best score.
- FN takes two arguments: the player-to-move and board"
- #'(lambda (player board)
- (let* ((moves (legal-moves player board))
- (scores (mapcar #'(lambda (move)
- (funcall
- eval-fn
- player
- (make-move move player
- (copy-board board))))
- moves))
- (best (apply #'max scores)))
- (elt moves (position best scores)))))
-
-(defparameter *weights*
- '#(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))
-
-(defun weighted-squares (player board)
- "Sum of the weights of player's squares minus opponent's."
- (let ((opp (opponent player)))
- (loop for i in all-squares
- when (eql (bref board i) player)
- sum (aref *weights* i)
- when (eql (bref board i) opp)
- sum (- (aref *weights* i)))))
-
-(defconstant winning-value most-positive-fixnum)
-(defconstant losing-value most-negative-fixnum)
-
-(defun final-value (player board)
- "Is this a win, loss, or draw for player?"
- (case (signum (count-difference player board))
- (-1 losing-value)
- ( 0 0)
- (+1 winning-value)))
-
-(defun minimax (player board ply eval-fn)
- "Find the best move, for PLAYER, according to EVAL-FN,
- searching PLY levels deep and backing up values."
- (if (= ply 0)
- (funcall eval-fn player board)
- (let ((moves (legal-moves player board)))
- (if (null moves)
- (if (any-legal-move? (opponent player) board)
- (- (minimax (opponent player) board
- (- ply 1) eval-fn))
- (final-value player board))
- (let ((best-move nil)
- (best-val nil))
- (dolist (move moves)
- (let* ((board2 (make-move move player
- (copy-board board)))
- (val (- (minimax
- (opponent player) board2
- (- ply 1) eval-fn))))
- (when (or (null best-val)
- (> val best-val))
- (setf best-val val)
- (setf best-move move))))
- (values best-val best-move))))))
-
-(defun minimax-searcher (ply eval-fn)
- "A strategy that searches PLY levels and then uses EVAL-FN."
- #'(lambda (player board)
- (multiple-value-bind (value move)
- (minimax player board ply eval-fn)
- (declare (ignore value))
- move)))
-
-(defun alpha-beta (player board achievable cutoff ply eval-fn)
- "Find the best move, for PLAYER, according to EVAL-FN,
- searching PLY levels deep and backing up values,
- using cutoffs whenever possible."
- (if (= ply 0)
- (funcall eval-fn player board)
- (let ((moves (legal-moves player board)))
- (if (null moves)
- (if (any-legal-move? (opponent player) board)
- (- (alpha-beta (opponent player) board
- (- cutoff) (- achievable)
- (- ply 1) eval-fn))
- (final-value player board))
- (let ((best-move (first moves)))
- (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))))
- (when (> val achievable)
- (setf achievable val)
- (setf best-move move)))
- until (>= achievable cutoff))
- (values achievable best-move))))))
-
-(defun alpha-beta-searcher (depth eval-fn)
- "A strategy that searches to DEPTH and then uses EVAL-FN."
- #'(lambda (player board)
- (multiple-value-bind (value move)
- (alpha-beta player board losing-value winning-value
- depth eval-fn)
- (declare (ignore value))
- move)))
-
-(defun modified-weighted-squares (player board)
- "Like WEIGHTED-SQUARES, but don't take off for moving
- near an occupied corner."
- (let ((w (weighted-squares player board)))
- (dolist (corner '(11 18 81 88))
- (when (not (eql (bref board corner) empty))
- (dolist (c (neighbors corner))
- (when (not (eql (bref board c) empty))
- (incf w (* (- 5 (aref *weights* c))
- (if (eql (bref board c) player)
- +1 -1)))))))
- w))
-
-(let ((neighbor-table (make-array 100 :initial-element nil)))
- ;; Initialize the neighbor table
- (dolist (square all-squares)
- (dolist (dir all-directions)
- (if (valid-p (+ square dir))
- (push (+ square dir)
- (aref neighbor-table square)))))
-
- (defun neighbors (square)
- "Return a list of all squares adjacent to a square."
- (aref neighbor-table square)))
-
-(let ((square-names
- (cross-product #'concat-symbol
- '(? a b c d e f g h ?)
- '(? 1 2 3 4 5 6 7 8 ?))))
-
- (defun h8->88 (str)
- "Convert from alphanumeric to numeric square notation."
- (or (position (string str) square-names :test #'string-equal)
- str))
-
- (defun 88->h8 (num)
- "Convert from numeric to alphanumeric square notation."
- (if (valid-p num)
- (elt square-names num)
- num)))
-
-(defun human (player board)
- "A human player for the game of Othello"
- (format t "~&~c to move ~a: " (name-of player)
- (mapcar #'88->h8 (legal-moves player board)))
- (h8->88 (read)))
-
-(defvar *move-number* 1 "The number of the move to be played")
-
-(defun othello (bl-strategy wh-strategy
- &optional (print t) (minutes 30))
- "Play a game of othello. Return the score, where a positive
- difference means black, the first player, wins."
- (let ((board (initial-board))
- (clock (make-array (+ 1 (max black white))
- :initial-element
- (* minutes 60
- internal-time-units-per-second))))
- (catch 'game-over
- (loop for *move-number* from 1
- for player = black then (next-to-play board player print)
- for strategy = (if (eql player black)
- bl-strategy
- wh-strategy)
- until (null player)
- do (get-move strategy player board print clock))
- (when print
- (format t "~&The game is over. Final result:")
- (print-board board clock))
- (count-difference black board))))
-
-(defvar *clock* (make-array 3) "A copy of the game clock")
-(defvar *board* (initial-board) "A copy of the game board")
-
-(defun get-move (strategy player board print clock)
- "Call the player's strategy function to get a move.
- Keep calling until a legal move is made."
- ;; Note we don't pass the strategy function the REAL board.
- ;; If we did, it could cheat by changing the pieces on the board.
- (when print (print-board board clock))
- (replace *clock* clock)
- (let* ((t0 (get-internal-real-time))
- (move (funcall strategy player (replace *board* board)))
- (t1 (get-internal-real-time)))
- (decf (elt clock player) (- t1 t0))
- (cond
- ((< (elt clock player) 0)
- (format t "~&~c has no time left and forfeits."
- (name-of player))
- (THROW 'game-over (if (eql player black) -64 64)))
- ((eq move 'resign)
- (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."
- (name-of player) (88->h8 move)))
- (make-move move player board))
- (t (warn "Illegal move: ~a" (88->h8 move))
- (get-move strategy player board print clock)))))
-
-(defun print-board (&optional (board *board*) clock)
- "Print a board, along with some statistics."
- ;; First print the header and the current score
- (format t "~2& a b c d e f g h [~c=~2a ~c=~2a (~@d)]"
- (name-of black) (count black board)
- (name-of white) (count white board)
- (count-difference black board))
- ;; Print the board itself
- (loop for row from 1 to 8 do
- (format t "~& ~d " row)
- (loop for col from 1 to 8
- for piece = (bref board (+ col (* 10 row)))
- do (format t "~c " (name-of piece))))
- ;; Finally print the time remaining for each player
- (when clock
- (format t " [~c=~a ~c=~a]~2&"
- (name-of black) (time-string (elt clock black))
- (name-of white) (time-string (elt clock white)))))
-
-(defun time-string (time)
- "Return a string representing this internal time in min:secs."
- (multiple-value-bind (min sec)
- (floor (round time internal-time-units-per-second) 60)
- (format nil "~2d:~2,'0d" min sec)))
-
-(defun random-othello-series (strategy1 strategy2
- n-pairs &optional (n-random 10))
- "Play a series of 2*n games, starting from a random position."
- (othello-series
- (switch-strategies #'random-strategy n-random strategy1)
- (switch-strategies #'random-strategy n-random strategy2)
- n-pairs))
-
-(defun switch-strategies (strategy1 m strategy2)
- "Make a new strategy that plays strategy1 for m moves,
- then plays according to strategy2."
- #'(lambda (player board)
- (funcall (if (<= *move-number* m) strategy1 strategy2)
- player board)))
-
-(defun othello-series (strategy1 strategy2 n-pairs)
- "Play a series of 2*n-pairs games, swapping sides."
- (let ((scores
- (loop repeat n-pairs
- for random-state = (make-random-state)
- collect (othello strategy1 strategy2 nil)
- do (setf *random-state* random-state)
- collect (- (othello strategy2 strategy1 nil)))))
- ;; Return the number of wins (1/2 for a tie),
- ;; the total of the point differences, and the
- ;; scores themselves, all from strategy1's point of view.
- (values (+ (count-if #'plusp scores)
- (/ (count-if #'zerop scores) 2))
- (apply #'+ scores)
- scores)))
-
-(defun round-robin (strategies n-pairs &optional
- (n-random 10) (names strategies))
- "Play a tournament among the strategies.
- N-PAIRS = games each strategy plays as each color against
- each opponent. So with N strategies, a total of
- N*(N-1)*N-PAIRS games are played."
- (let* ((N (length strategies))
- (totals (make-array N :initial-element 0))
- (scores (make-array (list N N)
- :initial-element 0)))
- ;; Play the games
- (dotimes (i N)
- (loop for j from (+ i 1) to (- N 1) do
- (let* ((wins (random-othello-series
- (elt strategies i)
- (elt strategies j)
- n-pairs n-random))
- (losses (- (* 2 n-pairs) wins)))
- (incf (aref scores i j) wins)
- (incf (aref scores j i) losses)
- (incf (aref totals i) wins)
- (incf (aref totals j) losses))))
- ;; Print the results
- (dotimes (i N)
- (format t "~&~a~20T ~4f: " (elt names i) (elt totals i))
- (dotimes (j N)
- (format t "~4f " (if (= i j) '---
- (aref scores i j)))))))
-
-(defun mobility (player board)
- "The number of moves a player has."
- (length (legal-moves player board)))
-
+++ /dev/null
-;;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-
-;;;; Code from Paradigms of AI Programming
-;;;; Copyright (c) 1991 Peter Norvig
-
-;;;; File othello2.lisp: More strategies for othello.lisp,
-;;;; from section 18.9 onward (alpha-beta2, alpha-beta3, iago).
-;;;; If a compiled version of edge-table.lisp exists, then merely
-;;;; load it after you load this file. Otherwise, load this file,
-;;;; evaluate (init-edge-table) (this will take a really long time),
-;;;; then compile edge-table.lisp. This will save the edge-table for
-;;;; future use.
-
-;(requires "othello")
-
-(defconstant all-squares
- (sort (loop for i from 11 to 88
- when (<= 1 (mod i 10) 8) collect i)
- #'> :key #'(lambda (sq) (elt *weights* sq))))
-
-(defstruct (node) square board value)
-
-(defun alpha-beta-searcher2 (depth eval-fn)
- "Return a strategy that does A-B search with sorted moves."
- #'(lambda (player board)
- (multiple-value-bind (value node)
- (alpha-beta2
- player (make-node :board board
- :value (funcall eval-fn player board))
- losing-value winning-value depth eval-fn)
- (declare (ignore value))
- (node-square node))))
-
-(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
- (if (= ply 0)
- (values (node-value node) node)
- (let* ((board (node-board node))
- (nodes (legal-nodes player board eval-fn)))
- (if (null nodes)
- (if (any-legal-move? (opponent player) board)
- (values (- (alpha-beta2 (opponent player)
- (negate-value node)
- (- cutoff) (- achievable)
- (- ply 1) eval-fn))
- nil)
- (values (final-value player board) nil))
- (let ((best-node (first nodes)))
- (loop for move in nodes
- for val = (- (alpha-beta2
- (opponent player)
- (negate-value move)
- (- cutoff) (- achievable)
- (- ply 1) eval-fn))
- do (when (> val achievable)
- (setf achievable val)
- (setf best-node move))
- until (>= achievable cutoff))
- (values achievable best-node))))))
-
-(defun negate-value (node)
- "Set the value of a node to its negative."
- (setf (node-value node) (- (node-value node)))
- node)
-
-(defun legal-nodes (player board eval-fn)
- "Return a list of legal moves, each one packed into a node."
- (let ((moves (legal-moves player board)))
- (sort (map-into
- moves
- #'(lambda (move)
- (let ((new-board (make-move move player
- (copy-board board))))
- (make-node
- :square move :board new-board
- :value (funcall eval-fn player new-board))))
- moves)
- #'> :key #'node-value)))
-
-(defvar *ply-boards*
- (apply #'vector (loop repeat 40 collect (initial-board))))
-
-(defun alpha-beta3 (player board achievable cutoff ply eval-fn
- killer)
- "A-B search, putting killer move first."
- (if (= ply 0)
- (funcall eval-fn player board)
- (let ((moves (put-first killer (legal-moves player board))))
- (if (null moves)
- (if (any-legal-move? (opponent player) board)
- (- (alpha-beta3 (opponent player) board
- (- cutoff) (- achievable)
- (- ply 1) eval-fn nil))
- (final-value player board))
- (let ((best-move (first moves))
- (new-board (aref *ply-boards* ply))
- (killer2 nil)
- (killer2-val winning-value))
- (loop for move in moves
- do (multiple-value-bind (val reply)
- (alpha-beta3
- (opponent player)
- (make-move move player
- (replace new-board board))
- (- cutoff) (- achievable)
- (- ply 1) eval-fn killer2)
- (setf val (- val))
- (when (> val achievable)
- (setf achievable val)
- (setf best-move move))
- (when (and reply (< val killer2-val))
- (setf killer2 reply)
- (setf killer2-val val)))
- until (>= achievable cutoff))
- (values achievable best-move))))))
-
-(defun alpha-beta-searcher3 (depth eval-fn)
- "Return a strategy that does A-B search with killer moves."
- #'(lambda (player board)
- (multiple-value-bind (value move)
- (alpha-beta3 player board losing-value winning-value
- depth eval-fn nil)
- (declare (ignore value))
- move)))
-
-(defun put-first (killer moves)
- "Move the killer move to the front of moves,
- if the killer move is in fact a legal move."
- (if (member killer moves)
- (cons killer (delete killer moves))
- moves))
-
-(defun mobility (player board)
- "Current Mobility is the number of legal moves.
- Potential mobility is the number of blank squares
- adjacent to an opponent that are not legal moves.
- Returns current and potential mobility for player."
- (let ((opp (opponent player))
- (current 0) ; player's current mobility
- (potential 0)) ; player's potential mobility
- (dolist (square all-squares)
- (when (eql (bref board square) empty)
- (cond ((legal-p square player board)
- (incf current))
- ((some #'(lambda (sq) (eql (bref board sq) opp))
- (neighbors square))
- (incf potential)))))
- (values current (+ current potential))))
-
-(defvar *edge-table* (make-array (expt 3 10))
- "Array of values to player-to-move for edge positions.")
-
-(defconstant edge-and-x-lists
- '((22 11 12 13 14 15 16 17 18 27)
- (72 81 82 83 84 85 86 87 88 77)
- (22 11 21 31 41 51 61 71 81 72)
- (27 18 28 38 48 58 68 78 88 77))
- "The four edges (with their X-squares).")
-
-(defun edge-index (player board squares)
- "The index counts 1 for player; 2 for opponent,
- on each square---summed as a base 3 number."
- (let ((index 0))
- (dolist (sq squares)
- (setq index (+ (* index 3)
- (cond ((eql (bref board sq) empty) 0)
- ((eql (bref board sq) player) 1)
- (t 2)))))
- index))
-
-(defun edge-stability (player board)
- "Total edge evaluation for player to move on board."
- (loop for edge-list in edge-and-x-lists
- sum (aref *edge-table*
- (edge-index player board edge-list))))
-
-(defconstant top-edge (first edge-and-x-lists))
-
-(defun init-edge-table ()
- "Initialize *edge-table*, starting from the empty board."
- ;; Initialize the static values
- (loop for n-pieces from 0 to 10 do
- (map-edge-n-pieces
- #'(lambda (board index)
- (setf (aref *edge-table* index)
- (static-edge-stability black board)))
- black (initial-board) n-pieces top-edge 0))
- ;; Now iterate five times trying to improve:
- (dotimes (i 5)
- ;; Do the indexes with most pieces first
- (loop for n-pieces from 9 downto 1 do
- (map-edge-n-pieces
- #'(lambda (board index)
- (setf (aref *edge-table* index)
- (possible-edge-moves-value
- black board index)))
- black (initial-board) n-pieces top-edge 0))))
-
-(defun map-edge-n-pieces (fn player board n squares index)
- "Call fn on all edges with n pieces."
- ;; Index counts 1 for player; 2 for opponent
- (cond
- ((< (length squares) n) nil)
- ((null squares) (funcall fn board index))
- (t (let ((index3 (* 3 index))
- (sq (first squares)))
- (map-edge-n-pieces fn player board n (rest squares) index3)
- (when (and (> n 0) (eql (bref board sq) empty))
- (setf (bref board sq) player)
- (map-edge-n-pieces fn player board (- n 1) (rest squares)
- (+ 1 index3))
- (setf (bref board sq) (opponent player))
- (map-edge-n-pieces fn player board (- n 1) (rest squares)
- (+ 2 index3))
- (setf (bref board sq) empty))))))
-
-(defun possible-edge-moves-value (player board index)
- "Consider all possible edge moves.
- Combine their values into a single number."
- (combine-edge-moves
- (cons
- (list 1.0 (aref *edge-table* index)) ;; no move
- (loop for sq in top-edge ;; possible moves
- when (eql (bref board sq) empty)
- collect (possible-edge-move player board sq)))
- player))
-
-(defun possible-edge-move (player board sq)
- "Return a (prob val) pair for a possible edge move."
- (let ((new-board (replace (aref *ply-boards* player) board)))
- (make-move sq player new-board)
- (list (edge-move-probability player board sq)
- (- (aref *edge-table*
- (edge-index (opponent player)
- new-board top-edge))))))
-
-(defun combine-edge-moves (possibilities player)
- "Combine the best moves."
- (let ((prob 1.0)
- (val 0.0)
- (fn (if (eql player black) #'> #'<)))
- (loop for pair in (sort possibilities fn :key #'second)
- while (>= prob 0.0)
- do (incf val (* prob (first pair) (second pair)))
- (decf prob (* prob (first pair))))
- (round val)))
-
-(let ((corner/xsqs '((11 . 22) (18 . 27) (81. 72) (88 . 77))))
- (defun corner-p (sq) (assoc sq corner/xsqs))
- (defun x-square-p (sq) (rassoc sq corner/xsqs))
- (defun x-square-for (corner) (cdr (assoc corner corner/xsqs)))
- (defun corner-for (xsq) (car (rassoc xsq corner/xsqs))))
-
-(defun edge-move-probability (player board square)
- "What's the probability that player can move to this square?"
- (cond
- ((x-square-p square) .5) ;; X-squares
- ((legal-p square player board) 1.0) ;; immediate capture
- ((corner-p square) ;; move to corner depends on X-square
- (let ((x-sq (x-square-for square)))
- (cond
- ((eql (bref board x-sq) empty) .1)
- ((eql (bref board x-sq) player) 0.001)
- (t .9))))
- (t (/ (aref
- '#2A((.1 .4 .7)
- (.05 .3 *)
- (.01 * *))
- (count-edge-neighbors player board square)
- (count-edge-neighbors (opponent player) board square))
- (if (legal-p square (opponent player) board) 2 1)))))
-
-(defun count-edge-neighbors (player board square)
- "Count the neighbors of this square occupied by player."
- (count-if #'(lambda (inc)
- (eql (bref board (+ square inc)) player))
- '(+1 -1)))
-
-(defparameter *static-edge-table*
- '#2A(;stab semi un
- ( * 0 -2000) ; X
- ( 700 * *) ; corner
- (1200 200 -25) ; C
- (1000 200 75) ; A
- (1000 200 50) ; B
- (1000 200 50) ; B
- (1000 200 75) ; A
- (1200 200 -25) ; C
- ( 700 * *) ; corner
- ( * 0 -2000) ; X
- ))
-
-(defun static-edge-stability (player board)
- "Compute this edge's static stability"
- (loop for sq in top-edge
- for i from 0
- sum (cond
- ((eql (bref board sq) empty) 0)
- ((eql (bref board sq) player)
- (aref *static-edge-table* i
- (piece-stability board sq)))
- (t (- (aref *static-edge-table* i
- (piece-stability board sq)))))))
-
-(let ((stable 0) (semi-stable 1) (unstable 2))
-
- (defun piece-stability (board sq)
- (cond
- ((corner-p sq) stable)
- ((x-square-p sq)
- (if (eql (bref board (corner-for sq)) empty)
- unstable semi-stable))
- (t (let* ((player (bref board sq))
- (opp (opponent player))
- (p1 (find player board :test-not #'eql
- :start sq :end 19))
- (p2 (find player board :test-not #'eql
- :start 11 :end sq
- :from-end t)))
- (cond
- ;; unstable pieces can be captured immediately
- ;; by playing in the empty square
- ((or (and (eql p1 empty) (eql p2 opp))
- (and (eql p2 empty) (eql p1 opp)))
- unstable)
- ;; Semi-stable pieces might be captured
- ((and (eql p1 opp) (eql p2 opp)
- (find empty board :start 11 :end 19))
- semi-stable)
- ((and (eql p1 empty) (eql p2 empty))
- semi-stable)
- ;; Stable pieces can never be captured
- (t stable)))))))
-
-(defun Iago-eval (player board)
- "Combine edge-stability, current mobility and
- potential mobility to arrive at an evaluation."
- ;; The three factors are multiplied by coefficients
- ;; that vary by move number:
- (let ((c-edg (+ 312000 (* 6240 *move-number*)))
- (c-cur (if (< *move-number* 25)
- (+ 50000 (* 2000 *move-number*))
- (+ 75000 (* 1000 *move-number*))))
- (c-pot 20000))
- (multiple-value-bind (p-cur p-pot)
- (mobility player board)
- (multiple-value-bind (o-cur o-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)))))))
-
-(defun Iago (depth)
- "Use an approximation of Iago's evaluation function."
- (alpha-beta-searcher3 depth #'iago-eval))
-
projects / reversi.git / commitdiff