code.delx.au - gnu-emacs-elpa/blob - chess-ai.el

   1 ;;; chess-ai.el --- A Chess playing module
   2
   3 ;; Copyright (C) 2004  Free Software Foundation, Inc.
   4
   5 ;; Author: Mario Lang <mlang@delysid.org>
   6
   7 ;; This file is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 2, or (at your option)
  10 ;; any later version.
  11
  12 ;; This file is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  19 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 ;; Boston, MA 02111-1307, USA.
  21
  22 ;;; Code:
  23
  24 (require 'chess-common)
  25 (require 'chess-pos)
  26 (require 'chess-ply)
  27 (require 'cl)
  28
  29 (defgroup chess-ai ()
  30   "A simple chess engine written in elisp."
  31   :group 'chess)
  32
  33 (defcustom chess-ai-depth 2
  34   "*The depth used to prune the search tree."
  35   :group 'chess-ai
  36   :type 'integer)
  37
  38 (defvar chess-pawn-value 100)
  39 (defvar chess-knight-value 300)
  40 (defvar chess-bishop-value 300)
  41 (defvar chess-rook-value 500)
  42 (defvar chess-queen-value 900)
  43 (defvar chess-king-value 10000)
  44
  45 (defun chess-eval-static (position)
  46   "Find the static score for POSITION."
  47   (assert (vectorp position))
  48   (let ((v 0)
  49         (status (chess-pos-status position)))
  50     (if (eq status :checkmate)
  51         -64000
  52       (if (eq status :stalemate)
  53           v
  54         (dotimes (i 64 (if (chess-pos-side-to-move position) v (- v)))
  55           (let ((piece (aref position i)))
  56             (cond
  57              ((= piece ?P) (incf v chess-pawn-value))
  58              ((= piece ?p) (decf v chess-pawn-value))
  59              ((= piece ?K) (incf v chess-king-value))
  60              ((= piece ?k) (decf v chess-king-value))
  61              ((= piece ?Q) (incf v chess-queen-value))
  62              ((= piece ?q) (decf v chess-queen-value))
  63              ((= piece ?R) (incf v chess-rook-value))
  64              ((= piece ?r) (decf v chess-rook-value))
  65              ((= piece ?B) (incf v chess-bishop-value))
  66              ((= piece ?b) (decf v chess-bishop-value))
  67              ((= piece ?N) (incf v chess-knight-value))
  68              ((= piece ?n) (decf v chess-knight-value)))))))))
  69
  70 (defun chess-ai-eval (position depth alpha beta &optional line)
  71   "Evaluate POSITION using a simple AlphaBeta search algorithm using at most
  72 DEPTH plies."
  73   ;; TBD: We do far too much consing
  74   (if (= depth 0)
  75       (cons (chess-eval-static position) line)
  76     (let ((plies (chess-legal-plies
  77                   position :color (chess-pos-side-to-move position)))
  78           (ret (cons alpha line)))
  79       (if (= (length plies) 0)
  80           (cons (chess-eval-static position) line)
  81         (while plies
  82           (let* ((tmp1 (chess-ai-eval (chess-ply-next-pos (car plies))
  83                                        (1- depth) (- beta) (- alpha)
  84                                        (cons (car plies) line)))
  85                  (tmp (- (car tmp1))))
  86             (if (> tmp alpha) (setq alpha tmp
  87                                     ret (cons tmp (cdr tmp1))))
  88             (if (>= alpha beta)
  89                 (setq plies nil)
  90               (setq plies (cdr plies)))))
  91         ret))))
  92
  93 (defun chess-ai-best-move (position depth &optional func)
  94   "Find the best move for POSITION using `chess-ai-eval' with DEPTH.
  95 Returns (VALUE . LIST-OF-PLIES) where
  96  VALUE is the evaluated score of the move and
  97  LIST-OF-PLIES is the list of plies which were actually found."
  98   (let ((res (chess-ai-eval position  depth -100000 100000)))
  99     (cons (car res)
 100           (if (functionp func)
 101               (mapcar func (nreverse (cdr res)))
 102             (nreverse (cdr res))))))
 103
 104 ;; TBD: It is somewhat strange that we need to define this variable.
 105 (defvar chess-ai-regexp-alist nil)
 106
 107 (defun chess-ai-handler (game event &rest args)
 108   (unless chess-engine-handling-event
 109     (cond
 110      ((eq event 'initialize)
 111       (setq chess-engine-opponent-name "Emacs AI")
 112       t)
 113
 114      ((eq event 'new)
 115       (chess-engine-set-position nil))
 116
 117      ((eq event 'move)
 118       (when (= 1 (chess-game-index game))
 119         (chess-game-set-tag game "White" chess-full-name)
 120         (chess-game-set-tag game "Black" chess-engine-opponent-name))
 121       (when (chess-game-over-p game)
 122         (chess-game-set-data game 'active nil)))
 123
 124      ((eq event 'post-move)
 125       (unless (chess-game-over-p game)
 126         (let (chess-display-handling-event)
 127           (message "Thinking...")
 128           (funcall chess-engine-response-handler
 129                    'move (cadr (chess-ai-best-move (chess-engine-position nil)
 130                                                    chess-ai-depth)))
 131           (message "Thinking... done"))))
 132
 133      (t
 134       (apply 'chess-common-handler game event args)))))
 135
 136 (provide 'chess-ai)
 137 ;;; chess-ai.el ends here