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
  32 This module does not allow for configuring search time used to calculate
  33 reply moves.  You can only specify the search depth (see `chess-ai-depth')."
  34   :group 'chess)
  35
  36 (defcustom chess-ai-depth 2
  37   "*The default depth used to prune the search tree."
  38   :group 'chess-ai
  39   :type 'integer)
  40
  41 (defcustom chess-ai-pawn-value 100
  42   "*Value of a Pawn."
  43   :group 'chess-ai
  44   :type 'integer)
  45
  46 (defcustom chess-ai-knight-value 300
  47   "*Value of a Knight."
  48   :group 'chess-ai
  49   :type 'integer)
  50
  51 (defcustom chess-ai-bishop-value 300
  52   "*Value of a Bishop."
  53   :group 'chess-ai
  54   :type 'integer)
  55
  56 (defcustom chess-ai-rook-value 500
  57   "*Value of a Rook."
  58   :group 'chess-ai
  59   :type 'intger)
  60
  61 (defcustom chess-ai-queen-value 900
  62   "*Value of a Queen."
  63   :group 'chess-ai
  64   :type 'integer)
  65
  66 (defcustom chess-ai-passed-pawn 50
  67   "*Extra Score for a passed Pawn."
  68   :group 'chess-ai
  69   :type 'integer)
  70
  71 (defun chess-eval-static (position)
  72   "Calculate the static score for POSITION."
  73   (assert (vectorp position))
  74   (let ((v 0)
  75         (status (chess-pos-status position)))
  76     (if (eq status :checkmate)
  77         -32767
  78       (if (eq status :stalemate)
  79           0
  80         (let (white-pawns black-pawns)
  81           (dotimes (i 64)
  82             (let ((piece (aref position i)))
  83               (unless (= piece ? )
  84                 (cond
  85                  ((= piece ?P) (push i white-pawns) (incf v chess-ai-pawn-value))
  86                  ((= piece ?p) (push i black-pawns) (decf v chess-ai-pawn-value))
  87                  ((= piece ?Q) (incf v chess-ai-queen-value))
  88                  ((= piece ?q) (decf v chess-ai-queen-value))
  89                  ((= piece ?R) (incf v chess-ai-rook-value))
  90                  ((= piece ?r) (decf v chess-ai-rook-value))
  91                  ((= piece ?B) (incf v chess-ai-bishop-value))
  92                  ((= piece ?b) (decf v chess-ai-bishop-value))
  93                  ((= piece ?N) (incf v chess-ai-knight-value))
  94                  ((= piece ?n) (decf v chess-ai-knight-value))))))
  95           ;; Reward passed Pawns
  96           (unless white-pawns
  97             (setq v (+ (* (length
  98                            (chess-pos-passed-pawns position t white-pawns))
  99                           chess-ai-passed-pawn))))
 100           (unless black-pawns
 101             (setq v (- v
 102                        (* (length
 103                            (chess-pos-passed-pawns position nil black-pawns))
 104                           chess-ai-passed-pawn))))
 105           (if (chess-pos-side-to-move position)
 106               v
 107             (- v)))))))
 108
 109 (defun chess-ai-eval (position depth alpha beta &optional line)
 110   "Evaluate POSITION using a simple AlphaBeta search algorithm using at most
 111 DEPTH plies."
 112   ;; TBD: We do far too much consing
 113   (if (= depth 0)
 114       (cons (chess-eval-static position) line)
 115     (let ((plies (chess-legal-plies
 116                   position :color (chess-pos-side-to-move position)))
 117           (ret (cons alpha line)))
 118       (if (= (length plies) 0)
 119           (cons (chess-eval-static position) line)
 120         (while plies
 121           (let* ((tmp1 (chess-ai-eval (chess-ply-next-pos (car plies))
 122                                        (1- depth) (- beta) (- alpha)
 123                                        (cons (car plies) line)))
 124                  (tmp (- (car tmp1))))
 125             (if (> tmp alpha) (setq alpha tmp
 126                                     ret (cons tmp (cdr tmp1))))
 127             (if (>= alpha beta)
 128                 (setq plies nil)
 129               (setq plies (cdr plies)))))
 130         ret))))
 131
 132 (defun chess-ai-best-move (position depth &optional func)
 133   "Find the best move for POSITION using `chess-ai-eval' with DEPTH.
 134 Returns (VALUE . LIST-OF-PLIES) where
 135  VALUE is the evaluated score of the move and
 136  LIST-OF-PLIES is the list of plies which were actually found."
 137   (let ((res (chess-ai-eval position  depth -100000 100000)))
 138     (cons (car res)
 139           (if (functionp func)
 140               (mapcar func (nreverse (cdr res)))
 141             (nreverse (cdr res))))))
 142
 143 (defun chess-ai-handler (game event &rest args)
 144   (unless chess-engine-handling-event
 145     (cond
 146      ((eq event 'initialize)
 147       (setq chess-engine-opponent-name "Emacs AI")
 148       t)
 149
 150      ((eq event 'new)
 151       (chess-engine-set-position nil))
 152
 153      ((eq event 'move)
 154       (when (= 1 (chess-game-index game))
 155         (chess-game-set-tag game "White" chess-full-name)
 156         (chess-game-set-tag game "Black" chess-engine-opponent-name))
 157       (when (chess-game-over-p game)
 158         (chess-game-set-data game 'active nil)))
 159
 160      ((eq event 'post-move)
 161       (unless (chess-game-over-p game)
 162         (let (chess-display-handling-event)
 163           (message "Thinking...")
 164           (funcall chess-engine-response-handler
 165                    'move (cadr (chess-ai-best-move (chess-engine-position nil)
 166                                                    chess-ai-depth)))
 167           (message "Thinking... done"))))
 168
 169      (t
 170       (apply 'chess-common-handler game event args)))))
 171
 172 (provide 'chess-ai)
 173 ;;; chess-ai.el ends here