X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=strategies.lisp;h=48140bbe424019c7ac8ec2bdc094dfa42edb256f;hb=4c844bde197de54c0343f7ab500153278f859ec6;hp=3d0570b1052bfa8b9b585866af67ee8fe89e142b;hpb=b29c5d666cbd1d0c08d4da49b32e4ed41c6dabba;p=reversi.git diff --git a/strategies.lisp b/strategies.lisp index 3d0570b..48140bb 100644 --- a/strategies.lisp +++ b/strategies.lisp @@ -1,25 +1,30 @@ +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: reversi -*- ;;;;*************************************************************************** ;;;; ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: strategies.cl +;;;; Name: strategies.lisp ;;;; Purpose: Strategy routines for reversi -;;;; Programer: Kevin M. Rosenberg, M.D. +;;;; Programer: Kevin Rosenberg based on code by Peter Norvig ;;;; Date Started: 1 Nov 2001 -;;;; CVS Id: $Id: strategies.lisp,v 1.1 2002/10/25 08:36:42 kevin Exp $ ;;;; +;;;; $Id$ +;;;; +;;;; 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 +;;;; as governed by the terms of the Lisp Lesser GNU Public License +;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;;*************************************************************************** -(in-package :reversi) -(declaim (optimize (safety 1) (debug 3) (speed 3) (compilation-speed 0))) - +(in-package #:reversi) (defun random-strategy (player board) "Make any legal move." (declare (type player player) (type board board)) - (random-elt (legal-moves player board))) - + (random-nth (legal-moves player board))) (defun maximize-difference (player board) "A strategy that maximizes the difference in pieces." @@ -43,8 +48,8 @@ (make-move move player (copy-board board)))) moves)) - (best (apply #'max scores))) - (declare (fixnum moves best)) + (best (apply #'max scores))) + (declare (fixnum best)) (elt moves (position best scores))))) (eval-when (:compile-toplevel :load-toplevel :execute) @@ -110,7 +115,8 @@ searching PLY levels deep and backing up values." (declare (type player player) (type board board) - (fixnum ply)) + (fixnum ply) + (optimize (speed 3) (space 0) (safety 0))) (if (= ply 0) (funcall eval-fn player board) (let ((moves (legal-moves player board))) @@ -149,7 +155,8 @@ using cutoffs whenever possible." (declare (type player player) (type board board) - (fixnum achievable cutoff ply)) + (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))) @@ -190,7 +197,8 @@ "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)) @@ -227,9 +235,9 @@ (defstruct (node) - (square nil :type square) - (board nil :type board) - (value nil :type integer)) + (square(missing-argument) :type square) + (board (missing-argument) :type board) + (value (missing-argument) :type integer)) (defun alpha-beta-searcher2 (depth eval-fn) "Return a strategy that does A-B search with sorted moves." @@ -247,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)) @@ -274,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) @@ -295,7 +306,8 @@ killer) (declare (type board board) (type player player) - (type fixnum achievable cutoff ply)) + (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) @@ -336,7 +348,8 @@ (declare (type board board) (type player player) (type fixnum achievable cutoff ply) - (type move killer)) + (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) @@ -387,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, @@ -407,7 +418,7 @@ Returns current and potential mobility for player." (declare (type board board) (type player player) - (optimize (speed 3) (safety 0 ))) + (optimize (speed 3) (safety 0) (space 0))) (let ((opp (opponent player)) (current 0) ; player's current mobility (potential 0)) ; player's potential mobility @@ -428,7 +439,7 @@ (declare (type board board) (type player opp) (type cons neighbors) - (optimize (speed 3) (safety 0))) + (optimize (speed 3) (safety 0) (space 0))) (block search (dolist (sq neighbors) (declare (type square sq)) @@ -439,10 +450,10 @@ (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 @@ -450,7 +461,8 @@ ;; 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*)) @@ -474,6 +486,7 @@ (defun iago (depth) "Use an approximation of Iago's evaluation function." + (declare (fixnum depth)) (alpha-beta-searcher3 depth #'iago-eval)) ;; Maximizer (1-ply) @@ -509,12 +522,15 @@ (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)) @@ -526,6 +542,9 @@ '(random ab3-df ab3-wt ab3-md-wt iago))) +(defun text-reversi () + "Sets up a text game between player and computer" + )