Try to improve the promotion situation on ICS by allowing chess-ply to query for...

[gnu-emacs-elpa] / chess-ai.el

diff --git a/chess-ai.el b/chess-ai.el
index 7aeabe8ce7228e19ae878d051a8c4fc321e56ca7..4dca2cf1760615eb1ac2d6db7ca356f44a2bb9b0 100644 (file)
--- a/chess-ai.el
+++ b/chess-ai.el
@@ -21,10 +21,12 @@
 
 ;;; Code:
 
+(require 'chess)
 (require 'chess-common)
 (require 'chess-pos)
 (require 'chess-ply)
-(require 'cl)
+(eval-when-compile
+  (require 'cl))
 
 (defgroup chess-ai ()
   "A simple chess engine written in elisp.
@@ -77,31 +79,57 @@ reply moves.  You can only specify the search depth (see `chess-ai-depth')."
        -32767
       (if (eq status :stalemate)
          0
-       (let (white-pawns black-pawns)
+       (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) (incf v chess-ai-queen-value))
-                ((= piece ?q) (decf v chess-ai-queen-value))
-                ((= piece ?R) (incf v chess-ai-rook-value))
-                ((= piece ?r) (decf v chess-ai-rook-value))
-                ((= piece ?B) (incf v chess-ai-bishop-value))
-                ((= piece ?b) (decf v chess-ai-bishop-value))
-                ((= piece ?N) (incf v chess-ai-knight-value))
-                ((= piece ?n) (decf v chess-ai-knight-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
-         (unless white-pawns
+         (when white-pawns
            (setq v (+ (* (length
                           (chess-pos-passed-pawns position t white-pawns))
                          chess-ai-passed-pawn))))
-         (unless black-pawns
+         (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)))))))