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  Mario Lang
   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 leave nodes at a certain depth.
  24 ;; To make it easier to identify specific problems we also count properties
  25 ;; of the individual (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 ;; Typically depths greater than 4 will result in very long runtimes.
  31 ;; We only define tests which do not take a lot of execution time
  32 ;; (less than a million nodes).
  33
  34 ;; To make it easier to selectively run tests, all tests provide tags
  35 ;; to indentify which type of ply they are covering.
  36 ;; The available ERT tags are:
  37 ;; :capture, :en-passant, :castle, :promotion, :check and :checkmate.
  38 ;;
  39 ;; For instance, to make sure castling plies work as expected, run
  40 ;; M-: (ert '(tag :castle)) RET
  41
  42 ;;; Code:
  43
  44 (require 'chess-fen)
  45 (require 'chess-ply)
  46 (require 'chess-pos)
  47 (require 'cl-lib)
  48 (require 'ert)
  49
  50 (defun chess-perft (position depth)
  51   "Count all leave nodes of the tree starting at POSITION pruned at DEPTH.
  52 The result is a list of the form
  53  (LEAVES CAPTURES EN-PASSANTS CASTLES PROMOTIONS CHECKS CHECKMATES)."
  54   (if (zerop depth)
  55       (cl-values 1 0 0 0 0)
  56     (let ((plies (chess-legal-plies position
  57                                     :color (chess-pos-side-to-move position))))
  58       (if (= depth 1)
  59           (cl-values (length plies)
  60                      ;; Captures
  61                      (cl-count-if
  62                       (lambda (ply)
  63                         (or (chess-pos-piece-p
  64                              (chess-ply-pos ply) (chess-ply-target ply)
  65                              (not (chess-pos-side-to-move (chess-ply-pos ply))))
  66                             (chess-ply-keyword ply :en-passant)))
  67                       plies)
  68                      ;; En passants
  69                      (cl-count-if
  70                       (lambda (ply)
  71                         (chess-ply-keyword ply :en-passant))
  72                       plies)
  73                      ;; Castles
  74                      (cl-count-if
  75                       (lambda (ply)
  76                         (chess-ply-any-keyword ply :castle :long-castle))
  77                       plies)
  78                      ;; Promotions
  79                      (cl-count-if
  80                       (lambda (ply)
  81                         (chess-ply-keyword ply :promote))
  82                       plies)
  83                      ;; Checks
  84                      (cl-count-if
  85                       (lambda (ply)
  86                         (chess-ply-any-keyword ply :check :checkmate))
  87                       plies)
  88                      ;; Checkmates
  89                      (cl-count-if
  90                       (lambda (ply)
  91                         (chess-ply-any-keyword ply :checkmate))
  92                       plies))
  93         (let ((nodes 0) (captures 0) (en-passants 0)
  94               (castles 0) (promotions 0)
  95               (checks 0) (checkmates 0))
  96           (dolist (ply plies (cl-values nodes
  97                                         captures en-passants
  98                                         castles promotions
  99                                         checks checkmates))
 100             (cl-multiple-value-bind (n c e ca p ch cm)
 101                 (chess-perft (chess-ply-next-pos ply) (1- depth))
 102               (cl-incf nodes n)
 103               (cl-incf captures c)
 104               (cl-incf en-passants e)
 105               (cl-incf castles ca)
 106               (cl-incf promotions p)
 107               (cl-incf checks ch)
 108               (cl-incf checkmates cm))))))))
 109
 110 (ert-deftest chess-perft-startpos-depth1 ()
 111   (should (equal (chess-perft (chess-pos-create) 1) '(20 0 0 0 0 0 0))))
 112
 113 (ert-deftest chess-perft-startpos-depth2 ()
 114   (should (equal (chess-perft (chess-pos-create) 2) '(400 0 0 0 0 0 0))))
 115
 116 (ert-deftest chess-perft-startpos-depth3 ()
 117   :tags '(:capture :check)
 118   (should (equal (chess-perft (chess-pos-create) 3) '(8902 34 0 0 0 12 0))))
 119
 120 (ert-deftest chess-perft-startpos-depth4 ()
 121   :tags '(:capture :check :checkmate)
 122   (should (equal (chess-perft (chess-pos-create) 4) '(197281 1576 0 0 0 469 8))))
 123
 124 (ert-deftest chess-perft-kiwipete-depth1 ()
 125   :tags '(:capture :castle)
 126   (let ((position
 127          (chess-fen-to-pos
 128           "r3k2r/p1ppqpb1/bn2pnp1/3PN3/1p2P3/2N2Q1p/PPPBBPPP/R3K2R w KQkq -")))
 129     (should (equal (chess-perft position 1) '(48 8 0 2 0 0 0)))))
 130
 131 (ert-deftest chess-perft-kiwipete-depth2 ()
 132   :tags '(:capture :en-passant :castle :check)
 133   (let ((position
 134          (chess-fen-to-pos
 135           "r3k2r/p1ppqpb1/bn2pnp1/3PN3/1p2P3/2N2Q1p/PPPBBPPP/R3K2R w KQkq -")))
 136     (should (equal (chess-perft position 2) '(2039 351 1 91 0 3 0)))))
 137
 138 (ert-deftest chess-perft-kiwipete-depth3 ()
 139   :tags '(:capture :en-passant :castle :check :checkmate)
 140   (let ((position
 141          (chess-fen-to-pos
 142           "r3k2r/p1ppqpb1/bn2pnp1/3PN3/1p2P3/2N2Q1p/PPPBBPPP/R3K2R w KQkq -")))
 143     (should (equal (chess-perft position 3) '(97862 17102 45 3162 0 993 1)))))
 144
 145 (ert-deftest chess-perft-pos3-depth1 ()
 146   :tags '(:capture :check)
 147   (let ((position (chess-fen-to-pos "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - -")))
 148     (should (equal (chess-perft position 1) '(14 1 0 0 0 2 0)))))
 149
 150 (ert-deftest chess-perft-pos3-depth2 ()
 151   :tags '(:capture :check)
 152   (let ((position (chess-fen-to-pos "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - -")))
 153     (should (equal (chess-perft position 2) '(191 14 0 0 0 10 0)))))
 154
 155 (ert-deftest chess-perft-pos3-depth3 ()
 156   :tags '(:capture :en-passant :check)
 157   (let ((position (chess-fen-to-pos "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - -")))
 158     (should (equal (chess-perft position 3) '(2812 209 2 0 0 267 0)))))
 159
 160 (ert-deftest chess-perft-pos3-depth4 ()
 161   :tags '(:capture :en-passant :check :checkmate)
 162   (let ((position (chess-fen-to-pos "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - -")))
 163     (should (equal (chess-perft position 4) '(43238 3348 123 0 0 1680 17)))))
 164
 165 (ert-deftest chess-perft-pos3-depth5 ()
 166   :tags '(:capture :en-passant :check)
 167   (let ((position (chess-fen-to-pos "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - -")))
 168     (should (equal (chess-perft position 5) '(674624 52051 1165 0 0 52950 0)))))
 169
 170 (ert-deftest chess-perft-pos4-depth1 ()
 171   (let ((chess-ply-allow-interactive-query nil)
 172         (position
 173          (chess-fen-to-pos
 174           "r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -")))
 175     (should (equal (chess-perft position 1) '(6 0 0 0 0 0 0)))))
 176
 177 (ert-deftest chess-perft-pos4-depth2 ()
 178   :tags '(:capture :castle :promotion :check)
 179   (let ((chess-ply-allow-interactive-query nil)
 180         (position
 181          (chess-fen-to-pos
 182           "r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -")))
 183     (should (equal (chess-perft position 2) '(264 87 0 6 48 10 0)))))
 184
 185 (ert-deftest chess-perft-pos4-depth3 ()
 186   :tags '(:capture :en-passant :promotion :check :checkmate)
 187   (let ((chess-ply-allow-interactive-query nil)
 188         (position
 189          (chess-fen-to-pos
 190           "r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -")))
 191     (should (equal (chess-perft position 3) '(9467 1021 4 0 120 38 22)))))
 192
 193 (ert-deftest chess-perft-pos4-depth4 ()
 194   :tags '(:capture :castle :promotion :check :checkmate)
 195   (let ((chess-ply-allow-interactive-query nil)
 196         (position
 197          (chess-fen-to-pos
 198           "r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -")))
 199     (should (equal (chess-perft position 4) '(422333 131393 0 7795 60032 15492 5)))))
 200
 201 (provide 'chess-perft)
 202 ;;; chess-perft.el ends here