Skip to content

Instantly share code, notes, and snippets.

@ericnormand

ericnormand/00 Chess moves.md

Created January 3, 2022 22:34
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save ericnormand/655bca753bced9299363ee8d41df8b5e to your computer and use it in GitHub Desktop.
Save ericnormand/655bca753bced9299363ee8d41df8b5e to your computer and use it in GitHub Desktop.
Download ZIP
457 PurelyFunctional.tv Newsletter
Raw
00 Chess moves.md

Chess moves

Write a function that determines if a chess piece, on an empty board, can move from one space to another in one move.

Examples

(can-move? :pawn "A2" "A3") ;=> true
(can-move? :queen "H1" "A8") ;=> true
(can-move? :knight "A4" "A5") ;=> false ;; (that's not how knights move)
(can-move? :king "A8" "A9") ;=> false ;; (that's off the board)

Notes

  • This page has a nice graphic of all of the chess pieces and their moves.
  • Assume that pawns are moving from the low to the high numbers.
  • You can ignore en passant, pawn's capture, castling, and pawn's two-square move on the second rank.

Thanks to this site for the problem idea, where it is rated Very Hard in Java. The problem has been modified.

Please submit your solutions as comments on this gist.

To subscribe: https://purelyfunctional.tv/newsletter/

@steffan-westcott
Copy link

steffan-westcott commented Jan 4, 2022 •
edited 

(defn sq-coords [sq]
  (let [sq' (mapv #(- (int %1) %2) sq [65 49])]
    (when (every? #(<= 0 % 7) sq')
      sq')))

(defn can-move? [piece orig dest]
  (let [orig-sq (sq-coords orig)
        dest-sq (sq-coords dest)]
    (if (and orig-sq dest-sq (not= orig dest))
      (let [[dx dy] (map - dest-sq orig-sq)
            same-rank? (zero? dy)
            same-file? (zero? dx)
            same-diagonal? (= (* dx dx) (* dy dy))]
        (case piece
          :pawn (and same-file? (= 1 dy) (pos? (get orig-sq 1)))
          :rook (or same-file? same-rank?)
          :bishop same-diagonal?
          :queen (or same-file? same-rank? same-diagonal?)
          :king (every? #(<= -1 % 1) [dx dy])
          :knight (= 5 (+ (* dx dx) (* dy dy)))
          false))
      false)))

@jonasseglare
Copy link

jonasseglare commented Jan 4, 2022 •
edited

Revised version using lookup table:

(def r (set (range 8)))

(defn decode-step [src-dst]
  (let [v (map #(- (int %1) (int %2)) src-dst "A1A1")
        [x0 y0 x1 y1] v]
    (and (every? r v) (+ (- x1 x0 -7) (* 15 (- y1 y0 -7))))))

(def piece-map {:rook 1
                :queen 2
                :bishop 4
                :pawn 8
                :king 16
                :knight 32})

(defn can-move? [piece src dst]
  (let [i (decode-step (str src dst))
        piece (piece-map piece)]
    (->> i
         (nth "&      #      & &     #     &   &    #    &     &   #   &       &  #  &         & # &           636      ######3 3######      6;6           & # &         &  #  &       &   #   &     &    #    &   &     #     & &      #      &")
         int
         (bit-and piece )
         zero?
         not
         (and i piece))))

@miner
Copy link

miner commented Jan 6, 2022 

(defn can-move? [piece a b]
  (let [file (fn [cc] (case (nth cc 0)
                        \A 0  \B 1  \C 2  \D 3  \E 4
                        \F 5  \G 6  \H 7  nil))
        rank (fn [cc] (case (nth cc 1)
                        \1 0  \2 1  \3 2  \4 3  \5 4
                        \6 5  \7 6  \8 7  nil))
        abs (fn [n] (if (neg? n) (- n) n))]   
    (when-not (= a b)
      (when-let [ra (rank a)]
        (when-let [rb (rank b)]
          (when-let [fa (file a)]
            (when-let [fb (file b)]
              (let [df (- fb fa)
                    dr (- rb ra)]
                (case piece
                  :pawn (and (= dr 1) (zero? df))
                  :king (and (<= (abs dr) 1) (<= (abs df) 1))
                  :queen (or (zero? df)
                             (zero? dr)
                             (= (abs df) (abs dr)))
                  :rook (or (zero? df) (zero? dr))
                  :bishop  (= (abs df) (abs dr))
                  :knight  (let [ar (abs dr)
                                 af (abs df)]
                             (and (= (min ar af) 1)
                                  (= (max ar af) 2))))))))))))

@KingCode
Copy link

KingCode commented May 28, 2022 •
edited

EDIT: I went (a little) overboard and added pawn-move qualifiers in a second version.

(def files "ABCDEFGH")
(def ranks "12345678")
(def file->idx (->> (range) rest (map vector files) (into {})))
(def rank->idx (->> (range) rest (map vector ranks) (into {})))

(defn file [square] (or (-> square first file->idx) false))
(defn rank [square] (or (-> square second rank->idx) false))

(defn over-range-no-zero [lo hi tgen xf] 
  (->> hi (range lo) 
       (transduce (comp (remove zero?) (tgen xf)) conj [])))

(defn radius-diffs [abs-file+rank-diffs]
  (let [ops [[+ +] [- -] [- +] [+ -]]]
    (->> abs-file+rank-diffs
         (into [] (comp (mapcat (fn [[fd rd]]
                                  (->> ops (map (fn [[op1 op2]]
                                                  [(op1 fd) (op2 rd)])))))
                        (distinct))))))

(def diffs (let [bishops (->> (range 1 8) (map #(vector % %)) radius-diffs) 
                 rooks (over-range-no-zero -7 8 mapcat (fn [x] [[0 x] [x 0]]))]
             {:pawn [[0 1] [0 -1]]
              :pawn-initial-white [[0 2]]
              :pawn-initial-black [[0 -2]]
              :pawn-captures-white [[-1 1] [1 1]]
              :pawn-captures-black [[-1 -1] [1 -1]]
              :king  (radius-diffs [[0 1] [1 0] [1 1]])
              :queen (concat bishops rooks)
              :knight (radius-diffs [[1 2] [2 1]])
              :bishop bishops
              :rook rooks}))

(defn pawn? [piece] (= :pawn piece))

(defn legit-from-if-pawn-or-other? [piece from-rank]
  (if (pawn? piece) (< 1  from-rank 8) true))

(defn qualify-pawn-move [sofar piece from-rank to-rank fr-diffs]
  (cond 
    (not (pawn? piece))
    sofar 
    (and (= 2 from-rank) 
         (some #{fr-diffs} (diffs :pawn-initial-white))) 
    :maybe-on-initial-move-for-white
    (and (= 7 from-rank) 
         (some #{fr-diffs} (diffs :pawn-initial-black))) 
    :maybe-on-initial-move-for-black
    (some #{fr-diffs} (diffs :pawn-captures-white)) 
    :yes-if-white-captures
    (some #{fr-diffs} (diffs :pawn-captures-black)) 
    :yes-if-black-captures
    (= -1 (- to-rank from-rank))
    :yes-if-black
    (= 1 (- to-rank from-rank))
    :yes-if-white
    :else 
    sofar))

(defn file&rank-diffs [f1 r1 f2 r2]
  [(-> f2 (- f1)),
   (-> r2 (- r1))])

(defn can-move? [piece from to]
  (let [[f1 r1 f2 r2] [(file from) (rank from) (file to) (rank to)]
        fr-diffs (and f1 r1 f2 r2 (file&rank-diffs f1 r1 f2 r2))]
    (and fr-diffs
         (legit-pawn-or-other? piece r1)
         (-> #{fr-diffs}
             (some (diffs piece)) 
             (or false) (and true)
             (qualify-pawn-move piece r1 r2 fr-diffs) ))))


(can-move? :pawn "A2" "A3") ;=> true
(can-move? :pawn "A3" "A2") ;=> false
(can-move? :queen "H1" "A8") ;=> true
(can-move? :knight "A4" "A5") ;=> false ;; (that's not how knights move)
(can-move? :king "A8" "A9") ;=> false ;; (that's off the board)
(can-move? :pawn "H7" "H5");=> :maybe-on-initial-move-for-black
(can-move? :pawn "A2" "A4") ;=> :maybe-on-initial-move-for-white
(can-move? :pawn "C5" "C4");=> :yes-if-black
(can-move? :pawn "F2" "G3") ;=> :yes-if-white-captures

@KingCode
Copy link

KingCode commented May 28, 2022 •
edited

@jonasseglare

Your solution is just brilliant (even though obfuscated :)! I am enjoying picking it apart.

So far I can gather that you encoded all valid moves as indexes into a table (string) of characters, each of which's
underlying int has its compatible pieces' bits set - very clever.

I still have to figure out precisely how you managed to organize and encode all 225 (from the table size)
valid moves across all pieces.

Nice work!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment