;;; chess-perft.el --- Perft tests for emacs-chess -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Free Software Foundation, Inc. ;; Author: Mario Lang ;; Keywords: games ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; The classic perft function counts all leaf nodes at a certain depth. ;; To make it easier to identify specific problems we also count properties ;; of the (final) plies. We count capturing plies, en passant plies, ;; castling plies, plies that promote to a piece, ;; plies which bring the opponent king in check and plies which result in ;; checkmate. ;; For more details about perft in general, see ;; . ;; Typically, depths greater than 4 will result in very long runtimes. ;; We only define tests which don't take a lot of execution time ;; (less than a million nodes). ;; To make it easier to selectively run tests, most tests provide tags ;; to indentify which types of plies they are covering. ;; The available ERT tags are: ;; `:capture', `:en-passant', `:castle', `:promotion', ;; `:check' and `:checkmate'. ;; ;; For instance, to make sure castling plies work as expected, you might run ;; M-: (ert '(tag :castle)) RET ;;; Code: (require 'chess-display) (require 'chess-fen) (require 'chess-ply) (require 'chess-pos) (require 'cl-lib) (require 'ert) (defun chess-perft (position depth) "Count all leaf nodes of the tree starting at POSITION pruned at DEPTH. If not called interactively the result is a list of the form \(LEAFS CAPTURES EN-PASSANTS CASTLES PROMOTIONS CHECKS CHECKMATES)." (interactive (list (or (ignore-errors (chess-display-position nil)) (chess-fen-to-pos (read-string "FEN: " nil nil (chess-pos-to-fen (chess-pos-create))))) (read-number "Depth: " 1))) (if (zerop depth) (cl-values 1 0 0 0 0 0 0) (let ((plies (chess-legal-plies position :color (chess-pos-side-to-move position))) (nodes 0) (captures 0) (en-passants 0) (castles 0) (promotions 0) (checks 0) (checkmates 0)) (if (= depth 1) (dolist (ply plies) (cl-incf nodes) (when (let ((position (chess-ply-pos ply))) (chess-pos-piece-p position (chess-ply-target ply) (not (chess-pos-side-to-move position)))) (cl-incf captures)) (when (chess-ply-keyword ply :en-passant) (cl-incf captures) (cl-incf en-passants)) (if (chess-ply-any-keyword ply :castle :long-castle) (cl-incf castles) (when (chess-ply-keyword ply :promote) (cl-incf promotions))) (when (chess-ply-any-keyword ply :check :checkmate) (cl-incf checks)) (when (chess-ply-any-keyword ply :checkmate) (cl-incf checkmates)) ) (let ((progress (when (called-interactively-p 'any) (make-progress-reporter "Perft... " 0 (length plies)))) (index 0)) (when (and (not noninteractive) (= depth 2)) (accept-process-output)) (dolist (ply plies) (unless (chess-ply-final-p ply) (cl-multiple-value-bind (n c e ca p ch cm) (chess-perft (chess-ply-next-pos ply) (1- depth)) (cl-incf nodes n) (cl-incf captures c) (cl-incf en-passants e) (cl-incf castles ca) (cl-incf promotions p) (cl-incf checks ch) (cl-incf checkmates cm))) (when progress (cl-incf index) (progress-reporter-force-update progress index (format "Perft... (%d nodes) " nodes)))))) (if (called-interactively-p 'any) (message "%d nodes (%d captures (%d ep), %d castles, %d promotions and %d checks (%d mate))" nodes captures en-passants castles promotions checks checkmates) (cl-values nodes captures en-passants castles promotions checks checkmates))))) (ert-deftest chess-perft-startpos-depth1 () (should (equal (chess-perft (chess-pos-create) 1) '(20 0 0 0 0 0 0)))) (ert-deftest chess-perft-startpos-depth2 () (should (equal (chess-perft (chess-pos-create) 2) '(400 0 0 0 0 0 0)))) (ert-deftest chess-perft-startpos-depth3 () :tags '(:capture :check) (should (equal (chess-perft (chess-pos-create) 3) '(8902 34 0 0 0 12 0)))) (ert-deftest chess-perft-startpos-depth4 () :tags '(:capture :check :checkmate) (should (equal (chess-perft (chess-pos-create) 4) '(197281 1576 0 0 0 469 8)))) (ert-deftest chess-perft-startpos-depth5 () :tags '(:capture :en-passant :check :checkmate) (should (equal (chess-perft (chess-pos-create) 5) '(4865609 82719 258 0 0 27351 347)))) (ert-deftest chess-perft-kiwipete-depth1 () :tags '(:capture :castle) (let ((position (chess-fen-to-pos "r3k2r/p1ppqpb1/bn2pnp1/3PN3/1p2P3/2N2Q1p/PPPBBPPP/R3K2R w KQkq -"))) (should (equal (chess-perft position 1) '(48 8 0 2 0 0 0))))) (ert-deftest chess-perft-kiwipete-depth2 () :tags '(:capture :en-passant :castle :check) (let ((position (chess-fen-to-pos "r3k2r/p1ppqpb1/bn2pnp1/3PN3/1p2P3/2N2Q1p/PPPBBPPP/R3K2R w KQkq -"))) (should (equal (chess-perft position 2) '(2039 351 1 91 0 3 0))))) (ert-deftest chess-perft-kiwipete-depth3 () :tags '(:capture :en-passant :castle :check :checkmate) (let ((position (chess-fen-to-pos "r3k2r/p1ppqpb1/bn2pnp1/3PN3/1p2P3/2N2Q1p/PPPBBPPP/R3K2R w KQkq -"))) (should (equal (chess-perft position 3) '(97862 17102 45 3162 0 993 1))))) (ert-deftest chess-perft-kiwipete-depth4 () :tags '(:capture :en-passant :castle :promote :check :checkmate) (let ((position (chess-fen-to-pos "r3k2r/p1ppqpb1/bn2pnp1/3PN3/1p2P3/2N2Q1p/PPPBBPPP/R3K2R w KQkq -"))) (should (equal (chess-perft position 4) '(4085603 757163 1929 128013 15172 25523 43))))) (ert-deftest chess-perft-pos3-depth1 () :tags '(:capture :check) (let ((position (chess-fen-to-pos "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - -"))) (should (equal (chess-perft position 1) '(14 1 0 0 0 2 0))))) (ert-deftest chess-perft-pos3-depth2 () :tags '(:capture :check) (let ((position (chess-fen-to-pos "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - -"))) (should (equal (chess-perft position 2) '(191 14 0 0 0 10 0))))) (ert-deftest chess-perft-pos3-depth3 () :tags '(:capture :en-passant :check) (let ((position (chess-fen-to-pos "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - -"))) (should (equal (chess-perft position 3) '(2812 209 2 0 0 267 0))))) (ert-deftest chess-perft-pos3-depth4 () :tags '(:capture :en-passant :check :checkmate) (let ((position (chess-fen-to-pos "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - -"))) (should (equal (chess-perft position 4) '(43238 3348 123 0 0 1680 17))))) (ert-deftest chess-perft-pos3-depth5 () :tags '(:capture :en-passant :check) (let ((position (chess-fen-to-pos "8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8 w - -"))) (should (equal (chess-perft position 5) '(674624 52051 1165 0 0 52950 0))))) (ert-deftest chess-perft-pos4-depth1 () (let ((position (chess-fen-to-pos "r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -"))) (should (equal (chess-perft position 1) '(6 0 0 0 0 0 0))))) (ert-deftest chess-perft-pos4-depth2 () :tags '(:capture :castle :promotion :check) (let ((position (chess-fen-to-pos "r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -"))) (should (equal (chess-perft position 2) '(264 87 0 6 48 10 0))))) (ert-deftest chess-perft-pos4-depth3 () :tags '(:capture :en-passant :promotion :check :checkmate) (let ((position (chess-fen-to-pos "r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -"))) (should (equal (chess-perft position 3) '(9467 1021 4 0 120 38 22))))) (ert-deftest chess-perft-pos4-depth4 () :tags '(:capture :castle :promotion :check :checkmate) (let ((position (chess-fen-to-pos "r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -"))) (should (equal (chess-perft position 4) '(422333 131393 0 7795 60032 15492 5))))) (provide 'chess-perft) ;;; chess-perft.el ends here