445 PurelyFunctional.tv Newsletter

00 Dueling Knights.md

Dueling Knights

A chess board has nothing but knights ♞ and empty spaces. In this setup, the color of the knights doesn't matter. Each knight could potentially capture any other. Your job is to write a function to figure out which knights can capture each other, if any.

A board is represented as a vector of vectors, each 8 elements long. A 0 represents an empty square. A 1 represents a knight. Your function should return a collection of pairs. The pairs represent the positions of the two knights that can capture each other.

For reference, see this site for understanding how knights move and capture.

Examples

(captures [[0 0 0 1 0 0 0 0]
           [0 0 0 0 0 0 0 0]
           [0 1 0 0 0 1 0 0]
           [0 0 0 0 1 0 1 0]
           [0 1 0 0 0 1 0 0]
           [0 0 0 0 0 0 0 0]
           [0 1 0 0 0 0 0 1]
           [0 0 0 0 1 0 0 0]]) ;=> [] ;; no captures

(captures [[0 0 0 1 0 0 0 0]
           [0 0 0 0 0 0 0 0]
           [0 0 0 0 1 0 0 0]
           [0 0 0 0 0 0 0 0]
           [0 0 0 0 0 0 0 0]
           [0 0 0 0 0 0 0 0]
           [0 0 0 0 0 0 0 0]
           [0 0 0 0 0 0 0 0]]) ;=> [#{[0 3] [2 4]}] ;; one capture

(captures [[0 0 0 1 0 0 0 0]
           [0 0 0 0 0 0 0 0]
           [0 0 0 0 1 0 0 0]
           [0 0 1 0 0 0 0 0]
           [0 0 0 0 0 0 0 0]
           [0 0 0 0 0 0 0 0]
           [0 0 0 0 0 0 0 0]
           [0 0 0 0 0 0 0 0]]) ;=> [#{[0 3] [2 4]} #{[2 4] [3 2]}] ;; two capture

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

Please submit your solutions as comments on this gist.

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

(defn piece-ij [board]
  (set (mapcat (fn [i row] (keep-indexed #(when (= 1 %2) [i %1]) row))
               (range)
               board)))

(defn knight-jumps-down [[i j]]
  [[(inc i) (- j 2)]
   [(inc i) (+ j 2)]
   [(+ i 2) (dec j)]
   [(+ i 2) (inc j)]])

(defn captures [board]
  (let [knights (piece-ij board)]
    (set (mapcat (fn [x] (keep #(when (knights %1) #{x %1}) (knight-jumps-down x)))
                 knights))))

(defn neighbours [[x y]]
  [[(+ x 2) (inc y)]
   [(+ x 2) (dec y)]
   [(inc x) (+ y 2)]
   [(inc x) (- y 2)]])

(defn captures [[row :as board]]
  (apply concat
    (for [i (range (count board))
          j (range (count row))
          :when (= 1 (get-in board [i j]))]
      (let [x (get-in board [i j])]
        (->> (neighbours [i j])
             (filter #(= 1 (get-in board %)))
             (map #(set [% [i j]])))))))

(defn captures [board]
  (for [[a & r] (iterate rest (for [[i row] (map-indexed vector board)
                                    [j knight?] (map-indexed vector row)
                                    :when (= 1 knight?)]
                                [i j])) :while (seq r)
        b r :when (= 5 (apply + (map (comp #(* % %) -) a b)))]
    #{a b}))

(defn captures [board]
  (let [knight? (fn [r+c] (= 1 (get-in board r+c)))
        up-moves   (fn [[r c]] [[(- r 1) (+ c 2)] [(- r 2) (+ c 1)]   ;; Q1
                                [(- r 2) (- c 1)] [(- r 1) (- c 2)]]) ;; Q2
        down-moves (fn [[r c]] [[(+ r 1) (- c 2)] [(+ r 2) (- c 1)]   ;; Q3
                                [(+ r 2) (+ c 1)] [(+ r 1) (+ c 2)]]) ;; Q4
        positions (for [i (range (count board))
                        j (range (count (get board i [])))]
                    [i j])]
    (for [p1 positions
          :when (knight? p1)
          p2 (down-moves p1)
          :when (knight? p2)]
      #{p1 p2})))

(defn movesfornight [kpos]
  (letfn [(padd [[a1 a2] [b1 b2]] [(+ a1 b1) (+ a2 b2)])]  ;; pairwise add
    (map #(padd kpos %) [[1 -2] [1 2] [2 -1] [2 1]])))

(defn captures [brd]
  (letfn [(isknight? [[x y]] (= (get (get brd x) y) 1))
          (kck [kpos] (seq (map hash-set (repeat kpos)
                      (filter isknight? (movesfornight kpos)))))]
    (let [npos (filter isknight? (for [x (range 8) y (range 8)] [x y]))]
      (into [] (distinct (apply concat (mapv kck npos)))))))

Added captures for other pieces as well:

(defn abs [x]
  (if (neg? x) (- x) x))

(defn dueling-pred [row+col-diffs]
  (fn [[r1 c1] [r2 c2]]
    (some (fn [[dr dc]]
            (and (= dr (abs (- r2 r1)))
                 (= dc (abs (- c2 c1)))))
          row+col-diffs)))

(defn captures 
  ([board] ;; knight captures by default
   (captures board (dueling-pred [[1 2] [2 1]])))
  ([board dueling?]
   (let [rowsiz (count board)
         colsiz (count (first board))]
     (for [i (range rowsiz)
           j (range colsiz)
           :when (pos? (get-in board [i j]))
           i' (range i rowsiz)
           j' (range colsiz)
           :let [base [i j] other [i' j']]
           :when (and (if (= i i') (< j j') true)
                      (pos? (get-in board other))
                      (dueling? base other))]
       #{base other}))))

(defn diagonal-diffs [board] 
  (map vector (range 1 (count board)) (range 1 (count (first board)))))

(defn grid-diffs [board] 
  (concat (map vector (repeat 0) (range 1 (count board)))
          (map vector (range 1 (count (first board))) (repeat 0))))

(defn line-diffs [board] 
  (concat (diagonal-diffs board) (grid-diffs board)))

(defn captures-bishops [board]
  (captures board (dueling-pred (diagonal-diffs board))))

(defn captures-rooks [board]
  (captures board (dueling-pred (grid-diffs board))))

(defn captures-queens [board]
  (captures board (dueling-pred (line-diffs board))))

(def mixed-board [[0 0 0 1 0 0 0 0]
                  [0 0 0 0 0 0 0 0]
                  [0 0 0 0 1 0 0 0]
                  [0 0 1 0 0 0 1 0]
                  [0 0 0 0 0 0 0 0]
                  [0 0 0 0 1 0 0 0]
                  [0 0 0 0 0 0 0 0]
                  [0 0 0 0 0 0 0 0]]) 

(captures mixed-board) ;=> (#{[0 3][2 4]} #{[2 4][3 2]} #{[2 4][3 6]}])
(captures-bishops mixed-board) ;=> (#{[0 3][3 6]} #{[3 2][5 4]} #{[3 6][5 4]}])
(captures-rooks mixed-board) ;=>(#{[2 4][5 4]} {[3 2][3 6]})
(= (into #{} (concat (captures-bishops mixed-board)
                     (captures-rooks mixed-board)))
   (set (captures-queens mixed-board))) ;;=> true