emacs-chess 2.0b6-1.1ubuntu1 / usr / share / emacs / site-lisp / chess / chess-ai.el

;;; chess-ai.el --- A Chess playing module

;; Copyright (C) 2004  Free Software Foundation, Inc.

;; Author: Mario Lang <mlang@delysid.org>

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Code:

(require 'chess-common)
(require 'chess-pos)
(require 'chess-ply)
(require 'cl)

(defgroup chess-ai ()
  "A simple chess engine written in elisp.

This module does not allow for configuring search time used to calculate
reply moves.  You can only specify the search depth (see `chess-ai-depth')."
  :group 'chess)

(defcustom chess-ai-depth 2
  "*The default depth used to prune the search tree."
  :group 'chess-ai
  :type 'integer)

(defcustom chess-ai-pawn-value 100
  "*Value of a Pawn."
  :group 'chess-ai
  :type 'integer)

(defcustom chess-ai-knight-value 300
  "*Value of a Knight."
  :group 'chess-ai
  :type 'integer)

(defcustom chess-ai-bishop-value 300
  "*Value of a Bishop."
  :group 'chess-ai
  :type 'integer)

(defcustom chess-ai-rook-value 500
  "*Value of a Rook."
  :group 'chess-ai
  :type 'intger)

(defcustom chess-ai-queen-value 900
  "*Value of a Queen."
  :group 'chess-ai
  :type 'integer)

(defcustom chess-ai-passed-pawn 50
  "*Extra Score for a passed Pawn."
  :group 'chess-ai
  :type 'integer)

(defun chess-eval-static (position)
  "Calculate the static score for POSITION."
  (assert (vectorp position))
  (let ((v 0)
	(status (chess-pos-status position)))
    (if (eq status :checkmate)
	-32767
      (if (eq status :stalemate)
	  0
	(let (white-queens black-queens white-rooks black-rooks
	      white-bishops black-bishops white-knights black-knights
	      white-pawns black-pawns)
	  (dotimes (i 64)
	    (let ((piece (aref position i)))
	      (unless (= piece ? )
		(cond
		 ((= piece ?P) (push i white-pawns) (incf v chess-ai-pawn-value))
		 ((= piece ?p) (push i black-pawns) (decf v chess-ai-pawn-value))
		 ((= piece ?Q) (push i white-queens) (incf v chess-ai-queen-value))
		 ((= piece ?q) (push i black-queens) (decf v chess-ai-queen-value))
		 ((= piece ?R) (push i white-rooks) (incf v chess-ai-rook-value))
		 ((= piece ?r) (push i black-rooks) (decf v chess-ai-rook-value))
		 ((= piece ?B) (push i white-bishops) (incf v chess-ai-bishop-value))
		 ((= piece ?b) (push i black-bishops) (decf v chess-ai-bishop-value))
		 ((= piece ?N) (push i white-knights) (incf v chess-ai-knight-value))
		 ((= piece ?n) (push i black-knights) (decf v chess-ai-knight-value))))))
	  ;; Reward passed Pawns
	  (when white-pawns
	    (setq v (+ (* (length
			   (chess-pos-passed-pawns position t white-pawns))
			  chess-ai-passed-pawn))))
	  (when black-pawns
	    (setq v (- v
		       (* (length
			   (chess-pos-passed-pawns position nil black-pawns))
			  chess-ai-passed-pawn))))
	  ;; Mobility
	  (setq
	   v
	   (+
	    v
	    (-
	     (length
	      (append (when white-queens
			(chess-legal-plies position :piece ?Q :candidates white-queens))
		      (when white-rooks
			(chess-legal-plies position :piece ?R :candidates white-rooks))
		      (when white-bishops
			(chess-legal-plies position :piece ?B :candidates white-bishops))
		      (when white-knights
			(chess-legal-plies position :piece ?N :candidates white-knights))))
	     (length
	      (append (when black-queens
			(chess-legal-plies position :piece ?q :candidates black-queens))
		      (when black-rooks
			(chess-legal-plies position :piece ?r :candidates black-rooks))
		      (when black-bishops
			(chess-legal-plies position :piece ?b :candidates black-bishops))
		      (when black-knights
			(chess-legal-plies position :piece ?n :candidates black-knights)))))))
	  (if (chess-pos-side-to-move position)
	      v
	    (- v)))))))

(defun chess-ai-eval (position depth alpha beta &optional line)
  "Evaluate POSITION using a simple AlphaBeta search algorithm using at most
DEPTH plies."
  ;; TBD: We do far too much consing
  (if (= depth 0)
      (cons (chess-eval-static position) line)
    (let ((plies (chess-legal-plies
		  position :color (chess-pos-side-to-move position)))
	  (ret (cons alpha line)))
      (if (= (length plies) 0)
	  (cons (chess-eval-static position) line)
	(while plies
	  (let* ((tmp1 (chess-ai-eval (chess-ply-next-pos (car plies))
				       (1- depth) (- beta) (- alpha)
				       (cons (car plies) line)))
		 (tmp (- (car tmp1))))
	    (if (> tmp alpha) (setq alpha tmp
				    ret (cons tmp (cdr tmp1))))
	    (if (>= alpha beta)
		(setq plies nil)
	      (setq plies (cdr plies)))))
	ret))))

(defun chess-ai-best-move (position depth &optional func)
  "Find the best move for POSITION using `chess-ai-eval' with DEPTH.
Returns (VALUE . LIST-OF-PLIES) where
 VALUE is the evaluated score of the move and
 LIST-OF-PLIES is the list of plies which were actually found."
  (let ((res (chess-ai-eval position  depth -100000 100000)))
    (cons (car res)
	  (if (functionp func)
	      (mapcar func (nreverse (cdr res)))
	    (nreverse (cdr res))))))

(defun chess-ai-handler (game event &rest args)
  (unless chess-engine-handling-event
    (cond
     ((eq event 'initialize)
      (setq chess-engine-opponent-name "Emacs AI")
      t)

     ((eq event 'new)
      (chess-engine-set-position nil))

     ((eq event 'move)
      (when (= 1 (chess-game-index game))
	(chess-game-set-tag game "White" chess-full-name)
	(chess-game-set-tag game "Black" chess-engine-opponent-name))
      (when (chess-game-over-p game)
	(chess-game-set-data game 'active nil)))

     ((eq event 'post-move)
      (unless (chess-game-over-p game)
	(let (chess-display-handling-event)
	  (message "Thinking...")
	  (funcall chess-engine-response-handler
		   'move (cadr (chess-ai-best-move (chess-engine-position nil)
						   chess-ai-depth)))
	  (message "Thinking... done"))))

     (t
      (apply 'chess-common-handler game event args)))))

(provide 'chess-ai)
;;; chess-ai.el ends here