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

   1 ;;; chess-perft.el --- Perft tests for emacs-chess   -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2014  Free Software Foundation, Inc.
   4
   5 ;; Author: Mario Lang <mlang@delysid.org>
   6 ;; Keywords: games
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; The classic perft function counts all leaf nodes at a certain depth.
  24 ;; To make it easier to identify specific problems we also count properties
  25 ;; of the (final) plies.  We count capturing plies, en passant plies,
  26 ;; castling plies, plies that promote to a piece,
  27 ;; plies which bring the opponent king in check and plies which result in
  28 ;; checkmate.
  29
  30 ;; For more details about perft in general, see
  31 ;; <URL:https://chessprogramming.wikispaces.com/Perft>.
  32
  33 ;; Typically, depths greater than 4 will result in very long runtimes.
  34 ;; We only define tests which don't take a lot of execution time
  35 ;; (less than a million nodes).
  36
  37 ;; To make it easier to selectively run tests, most tests provide tags
  38 ;; to indentify which types of plies they are covering.
  39 ;; The available ERT tags are:
  40 ;; `:capture', `:en-passant', `:castle', `:promotion',
  41 ;; `:check' and `:checkmate'.
  42 ;;
  43 ;; For instance, to make sure castling plies work as expected, you might run
  44 ;; M-: (ert '(tag :castle)) RET
  45
  46 ;;; Code:
  47
  48 (require 'chess-display)
  49 (require 'chess-fen)
  50 (require 'chess-ply)
  51 (require 'chess-pos)
  52 (require 'cl-lib)
  53 (require 'ert)
  54
  55 (defun chess-perft (position depth)
  56   "Count all leaf nodes of the tree starting at POSITION pruned at DEPTH.
  57 If not called interactively the result is a list of the form
  58 \(LEAFS CAPTURES EN-PASSANTS CASTLES PROMOTIONS CHECKS CHECKMATES)."
  59   (interactive (list (or (ignore-errors (chess-display-position nil))
  60                          (chess-fen-to-pos (read-string "FEN: " nil nil
  61                                                         (chess-pos-to-fen
  62                                                          (chess-pos-create)))))
  63                      (read-number "Depth: " 1)))
  64   (if (zerop depth)
  65       (cl-values 1 0 0 0 0 0 0)
  66     (let ((plies (chess-legal-plies position
  67                                     :color (chess-pos-side-to-move position)))
  68           (nodes 0) (captures 0) (en-passants 0) (castles 0) (promotions 0)
  69           (checks 0) (checkmates 0))
  70       (if (= depth 1)
  71           (dolist (ply plies)
  72             (cl-incf nodes)
  73             (when (let ((position (chess-ply-pos ply)))
  74                     (chess-pos-piece-p position (chess-ply-target ply)
  75                                        (not (chess-pos-side-to-move position))))
  76               (cl-incf captures))
  77             (when (chess-ply-keyword ply :en-passant)
  78               (cl-incf captures)
  79               (cl-incf en-passants))
  80             (if (chess-ply-any-keyword ply :castle :long-castle)
  81                 (cl-incf castles)
  82               (when (chess-ply-keyword ply :promote)
  83                 (cl-incf promotions)))
  84             (when (chess-ply-any-keyword ply :check :checkmate)
  85               (cl-incf checks))
  86             (when (chess-ply-any-keyword ply :checkmate)
  87               (cl-incf checkmates))         )
  88         (let ((progress (when (called-interactively-p 'any)
  89                           (make-progress-reporter "Perft... " 0 (length plies))))
  90               (index 0))
  91           (when (and (not noninteractive) (= depth 2)) (accept-process-output))
  92           (dolist (ply plies)
  93             (unless (chess-ply-final-p ply)
  94               (cl-multiple-value-bind (n c e ca p ch cm)
  95                   (chess-perft (chess-ply-next-pos ply) (1- depth))
  96                 (cl-incf nodes n)
  97                 (cl-incf captures c)
  98                 (cl-incf en-passants e)
  99                 (cl-incf castles ca)
 100                 (cl-incf promotions p)
 101                 (cl-incf checks ch)
 102                 (cl-incf checkmates cm)))
 103
 104             (when progress
 105               (cl-incf index)
 106               (progress-reporter-force-update
 107                progress index (format "Perft... (%d nodes) " nodes))))))
 108
 109       (if (called-interactively-p 'any)
 110           (message "%d nodes (%d captures (%d ep), %d castles, %d promotions and %d checks (%d mate))"
 111                    nodes captures en-passants castles promotions checks checkmates)
 112         (cl-values nodes
 113                    captures en-passants castles promotions checks checkmates)))))
 114
 115 (ert-deftest chess-perft-startpos-depth1 ()
 116   (should (equal (chess-perft (chess-pos-create) 1) '(20 0 0 0 0 0 0))))
 117
 118 (ert-deftest chess-perft-startpos-depth2 ()
 119   (should (equal (chess-perft (chess-pos-create) 2) '(400 0 0 0 0 0 0))))
 120
 121 (ert-deftest chess-perft-startpos-depth3 ()
 122   :tags '(:capture :check)
 123   (should (equal (chess-perft (chess-pos-create) 3) '(8902 34 0 0 0 12 0))))
 124
 125 (ert-deftest chess-perft-startpos-depth4 ()
 126   :tags '(:capture :check :checkmate)
 127   (should (equal (chess-perft (chess-pos-create) 4)
 128                  '(197281 1576 0 0 0 469 8))))
 129
 130 (ert-deftest chess-perft-startpos-depth5 ()
 131   :tags '(:capture :en-passant :check :checkmate)
 132   (should (equal (chess-perft (chess-pos-create) 5) '(4865609 82719 258 0 0 27351 347))))
 133
 134 (ert-deftest chess-perft-kiwipete-depth1 ()
 135   :tags '(:capture :castle)
 136   (let ((position
 137          (chess-fen-to-pos
 138           "r3k2r/p1ppqpb1/bn2pnp1/3PN3/1p2P3/2N2Q1p/PPPBBPPP/R3K2R w KQkq -")))
 139     (should (equal (chess-perft position 1) '(48 8 0 2 0 0 0)))))
 140
 141 (ert-deftest chess-perft-kiwipete-depth2 ()
 142   :tags '(:capture :en-passant :castle :check)
 143   (let ((position
 144          (chess-fen-to-pos
 145           "r3k2r/p1ppqpb1/bn2pnp1/3PN3/1p2P3/2N2Q1p/PPPBBPPP/R3K2R w KQkq -")))
 146     (should (equal (chess-perft position 2) '(2039 351 1 91 0 3 0)))))
 147
 148 (ert-deftest chess-perft-kiwipete-depth3 ()
 149   :tags '(:capture :en-passant :castle :check :checkmate)
 150   (let ((position
 151          (chess-fen-to-pos
 152           "r3k2r/p1ppqpb1/bn2pnp1/3PN3/1p2P3/2N2Q1p/PPPBBPPP/R3K2R w KQkq -")))
 153     (should (equal (chess-perft position 3) '(97862 17102 45 3162 0 993 1)))))
 154
 155 (ert-deftest chess-perft-kiwipete-depth4 ()
 156   :tags '(:capture :en-passant :castle :promote :check :checkmate)
 157   (let ((position
 158          (chess-fen-to-pos
 159           "r3k2r/p1ppqpb1/bn2pnp1/3PN3/1p2P3/2N2Q1p/PPPBBPPP/R3K2R w KQkq -")))
 160     (should (equal (chess-perft position 4)
 161                    '(4085603 757163 1929 128013 15172 25523 43)))))
 162
 163 (ert-deftest chess-perft-pos3-depth1 ()
 164   :tags '(:capture :check)
 165   (let ((position (chess-fen-to-pos "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - -")))
 166     (should (equal (chess-perft position 1) '(14 1 0 0 0 2 0)))))
 167
 168 (ert-deftest chess-perft-pos3-depth2 ()
 169   :tags '(:capture :check)
 170   (let ((position (chess-fen-to-pos "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - -")))
 171     (should (equal (chess-perft position 2) '(191 14 0 0 0 10 0)))))
 172
 173 (ert-deftest chess-perft-pos3-depth3 ()
 174   :tags '(:capture :en-passant :check)
 175   (let ((position (chess-fen-to-pos "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - -")))
 176     (should (equal (chess-perft position 3) '(2812 209 2 0 0 267 0)))))
 177
 178 (ert-deftest chess-perft-pos3-depth4 ()
 179   :tags '(:capture :en-passant :check :checkmate)
 180   (let ((position (chess-fen-to-pos "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - -")))
 181     (should (equal (chess-perft position 4) '(43238 3348 123 0 0 1680 17)))))
 182
 183 (ert-deftest chess-perft-pos3-depth5 ()
 184   :tags '(:capture :en-passant :check)
 185   (let ((position (chess-fen-to-pos "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - -")))
 186     (should (equal (chess-perft position 5) '(674624 52051 1165 0 0 52950 0)))))
 187
 188 (ert-deftest chess-perft-pos4-depth1 ()
 189   (let ((position
 190          (chess-fen-to-pos
 191           "r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -")))
 192     (should (equal (chess-perft position 1) '(6 0 0 0 0 0 0)))))
 193
 194 (ert-deftest chess-perft-pos4-depth2 ()
 195   :tags '(:capture :castle :promotion :check)
 196   (let ((position
 197          (chess-fen-to-pos
 198           "r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -")))
 199     (should (equal (chess-perft position 2) '(264 87 0 6 48 10 0)))))
 200
 201 (ert-deftest chess-perft-pos4-depth3 ()
 202   :tags '(:capture :en-passant :promotion :check :checkmate)
 203   (let ((position
 204          (chess-fen-to-pos
 205           "r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -")))
 206     (should (equal (chess-perft position 3) '(9467 1021 4 0 120 38 22)))))
 207
 208 (ert-deftest chess-perft-pos4-depth4 ()
 209   :tags '(:capture :castle :promotion :check :checkmate)
 210   (let ((position
 211          (chess-fen-to-pos
 212           "r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -")))
 213     (should (equal (chess-perft position 4) '(422333 131393 0 7795 60032 15492 5)))))
 214
 215 (provide 'chess-perft)
 216 ;;; chess-perft.el ends here