;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Commentary:
-
-;; BUGS: Opponent moves are not displayed on the board! But they are announced
-;; and shown in the mode-line, strange!
-
;;; Code:
+(require 'chess)
(require 'chess-common)
(require 'chess-pos)
(require 'chess-ply)
-
-(defvar chess-pawn-value 100)
-(defvar chess-knight-value 300)
-(defvar chess-bishop-value 300)
-(defvar chess-rook-value 500)
-(defvar chess-queen-value 900)
-(defvar chess-king-value 10000)
+(eval-when-compile
+ (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)
- -64000
+ -32767
(if (eq status :stalemate)
- v
- (dotimes (i 64 (if (chess-pos-side-to-move position) v (- v)))
- (let ((piece (aref position i)))
- (cond
- ((= piece ?P) (incf v chess-pawn-value))
- ((= piece ?p) (decf v chess-pawn-value))
- ((= piece ?K) (incf v chess-king-value))
- ((= piece ?k) (decf v chess-king-value))
- ((= piece ?Q) (incf v chess-queen-value))
- ((= piece ?q) (decf v chess-queen-value))
- ((= piece ?R) (incf v chess-rook-value))
- ((= piece ?r) (decf v chess-rook-value))
- ((= piece ?B) (incf v chess-bishop-value))
- ((= piece ?b) (decf v chess-bishop-value))
- ((= piece ?N) (incf v chess-knight-value))
- ((= piece ?n) (decf v chess-knight-value)))))))))
+ 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
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))))))
-(defvar chess-ai-regexp-alist nil)
-
(defun chess-ai-handler (game event &rest args)
(unless chess-engine-handling-event
(cond
((eq event 'initialize)
- (setq chess-engine-process t)
(setq chess-engine-opponent-name "Emacs AI")
t)
- ((eq event 'setup-pos)
- 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))
-
- (if (chess-game-over-p game)
- (chess-game-set-data game 'active nil))
- (let ((bm (chess-ai-best-move (chess-engine-position nil) 3)))
- (funcall chess-engine-response-handler 'move
- (cadr bm))))
+ (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