chess.el

;;; Checking for Check in Chess
;;; Author: Sean Allred

(require 'dash)

;;; (mapcar #'chess:report-game (chess:read-file "state.txt"))


;;; Reading

;;; > The first line is an integer saying how many boards there will
;;; > be.  Each board takes up 9 lines, the first line is a comment,
;;; > and can be ignored.  The next 8 lines is the board.  Top and
;;; > Uppercase is black, bottom and lowercase is white.  P's are
;;; > pawns, K's are kings, Q's are queens, R's are rooks, N's are
;;; > kNights, B's are bishops.  Underscore is an unoccupied space.

(defun chess:read-file (path)
  "Read file at FILEPATH.  Return a list of team conses."
  (let ((boards
         (-partition
          9
          (-butlast
           (cdr
            (split-string
             (with-temp-buffer
               (insert-file-contents path)
               (buffer-string))
             "\n"))))))
    (mapcar
     (lambda (board)
       (let* ((board-rows (cdr board))
              (board-name (car board))
              (thing
               (mapcar
                (lambda (ri)
                  ;; RI is a cons of the row and its index
                  (mapcar
                   (lambda (team-spec)
                     (let ((range-min (car team-spec))
                           (range-max (cdr team-spec)))
                       ;; RANGE is a cons (MIN . MAX)
                       (chess:read-row
                        (car ri) (cdr ri)
                        (lambda (c)
                          ;; Determine case of C
                          (member c
                                  (number-sequence
                                   range-min range-max))))))
                   '((?A . ?Z) (?a . ?z))))
                (-zip board-rows
                      (number-sequence
                       1 (length board-rows))))))
         (list
          board-name
          (cons 'black (-flatten-n 1 (delq nil (mapcar #'car thing))))
          (cons 'white (-flatten-n 1 (delq nil (mapcar #'cadr thing)))))))
     boards)))

(defun chess:determine-game-winner (game)
  (let* ((board (cdr game))
         (black (cdr (assq 'black board)))
         (white (cdr (assq 'white board))))
    (cond
     ((chess:in-check-p black white) 'black)
     ((chess:in-check-p white black) 'white))))

(defun chess:report-game (game)
  (let ((winner (chess:determine-game-winner game)))
    (message (if winner "Winner of game '%s' is '%S'"
               "Game '%s' has no winner yet")
             (car game) (chess:determine-game-winner game))))

(defun chess:read-row (s &optional row-num team-function)
  "Return a list of pieces that make up S.
TEAM-FUNCTION is a function that returns non-nil when passed a
character that's part of the desired team."
  (-filter
   (lambda (piece) (chess:type-of-piece piece))
   (chess:record-piece-positions
    (mapcar #'chess:char-to-type
            (-map-when
             (lambda (c)
               (not (funcall (or team-function #'identity) c)))
             (lambda (c) ?_)
             (mapcar #'string-to-char
                     (split-string s "" t))))
    row-num)))

(defun chess:record-piece-positions (pieces file)
  (-zip-with
   (lambda (type n)
     (cons type (list (cons n file))))
   pieces
   (mapcar #'chess:-number-to-file (number-sequence 1 8))))


(defconst chess:char-to-type
  '((king ?K ?k)
    (queen ?Q ?q)
    (bishop ?B ?b)
    (knight ?N ?n)
    (rook ?R ?r)
    (pawn ?P ?p)))

(defun chess:char-to-type (c)
  (car (-first (lambda (type) (member c (cdr type)))
               chess:char-to-type)))

(defun chess:read-board (string))



;;; Game Rules

(defconst chess:file-to-number
  '((a . 1) (b . 2) (c . 3) (d . 4)
    (e . 5) (f . 6) (g . 7) (h . 8))
  "Rank/index equivalences.")

(defun chess:-generate-moves (offset)
  (-iterate
   (lambda (relative-position)
     (cons (+ (car relative-position) (car offset))
           (+ (cdr relative-position) (cdr offset))))
   '(0 . 0)
   10))

(defun chess:-generate-all-moves (offsets)
  (apply #'append (mapcar #'chess:-generate-moves offsets)))

(defconst chess:moves
  `((king
     (1 . 0) (0 . 1) (-1 . 0) (0 . -1))
    (rook
     ,@(chess:-generate-all-moves
        '((0 . 1) (0 . -1) (1 . 0) (-1 . 0))))
    (bishop
     ,@(chess:-generate-all-moves
        '((1 . 1) (1 . -1) (-1 . 1) (-1 . -1))))
    (queen
     ,@(chess:-generate-all-moves
        '((0 . 1) (0 . -1) (1 . 0) (-1 . 0)
          (1 . 1) (1 . -1) (-1 . 1) (-1 . -1))))
    (knight
     ( 1 .  2) ( 2 .  1) ( 2 . -1) ( 1 . -2)
     (-1 . -2) (-2 . -1) (-2 .  1) (-1 .  2))
    (pawn
     (1 . 1) (1 . -1)))
  "A list of all pieces and their possible moves.")


;;; Game State

;;; Team 1 has team 0 in check:
;;;
;;; (chess:in-check-p chess:1 chess:0) evaluates non-nil
;;; (chess:in-check-p chess:0 chess:1) evaluates nil

;;; From http://en.wikipedia.org/wiki/Check_(chess)
(defconst chess:0
  '((king (c . 6))))
(defconst chess:1
  '((rook (c . 2))
    (king (e . 1))
    (rook (d . 2))))


;;; Accessors

(defun chess:type-of-piece (piece)
  "Return the type PIECE is."
  (car piece))

(defun chess:position-of-piece (piece)
  "Return the position of PIECE."
  (cadr piece))

(defun chess:moves-for-type (type)
  "Return all possible moves (as offsets) a piece of TYPE can make."
  (cdr (assq type chess:moves)))

(defun chess:-file-to-number (file)
  "Return FILE as an index \(1, 2, 3, ...)"
  (cdr (assq file chess:file-to-number)))

(defun chess:-number-to-file (number)
  "Return NUMBER as a `file' \(a, b, c, ...)"
  (car (rassq number chess:file-to-number)))


;;; Game State Queries (Logical)

(defun chess:used-positions (team)
  "Return all positions currently in use by TEAM."
  (mapcar #'chess:position-of-piece team))

(defun chess:position-is-used-by-team-p (position team)
  "Return non-nil if POSITION is in use by TEAM."
  (member position (chess:used-positions team)))

(defun chess:position-is-viable-p (position)
  "Return non-nil if POSITION is on the board."
  (let ((file (chess:-file-to-number (car position)))
        (rank (cdr position)))
    (if (and file rank
             (< 0 file 9)
             (< 0 rank 9))
        position)))

(defun chess:positions-of-type-on-team (type team)
  "Return all positions of TYPE on TEAM."
  (mapcar #'chess:position-of-piece
          (-select (lambda (piece)
                     (eq type (chess:type-of-piece piece)))
                   team)))


;;; Calculating Moves

(defun chess:offset-position (position offset)
  "Return POSITION offset by OFFSET."
  (cons (chess:-number-to-file
         (+ (car offset) (chess:-file-to-number (car position))))
        (+ (cdr offset) (cdr position))))

(defun chess:reach-of-piece (piece)
  "Return positions reachable by PIECE on an empty board."
  (-select #'chess:position-is-viable-p
   (mapcar (lambda (offset)
             (chess:offset-position
              (chess:position-of-piece piece)
              offset))
           (chess:moves-for-type (chess:type-of-piece piece)))))

(defun chess:reach-of-piece-on-team (piece team)
  "Return all positions that PIECE (on TEAM) may reach."
  (-remove
   (lambda (position)
     (chess:position-is-used-by-team-p position team))
   (chess:reach-of-piece piece)))

(defun chess:reach-for-team (team)
  "Return all positions reachable by any piece on TEAM."
  (-uniq
   (apply #'append
          (mapcar (lambda (piece)
                    (chess:reach-of-piece-on-team piece team))
                  team))))


;;; High-Level

(defun chess:in-check-p (team-a team-b)
  "Return non-nil if TEAM-A has TEAM-B in check."
  (member (first (chess:positions-of-type-on-team 'king team-b))
          (chess:reach-for-team team-a)))

state.txt

2
Starting position
RNBQKBNR
PPPPPPPP
________
________
________
________
pppppppp
rnbqkbnr
Scholar's mate
R_BQKB_R
PPPP_qPP
__N__N__
____P___
__b_p___
________
pppp_ppp
rnb_k_nr