Puzzle solver accompanying http://johnwalker.io/post/triangle-puzzle

puzzle.clj

(ns triangle.puzzle)

;; In part 1, we discussed the relationship between Ring Ideals and
;; the triangle peg puzzle, and showed that there was an isomorphism
;; between F4 and Z_2[x][y].

;; So, we should define our board like this:

(def board [:o
            :l :l
            :l :l :l
            :l :l :l :l
            :l :l :l :l :l])

;; Well, we'd like to be generate successors to the board. One
;; possible successor would be:

;; [:l
;;  :o :l
;;  :o :l :l
;;  :l :l :l :l
;;  :l :l :l :l :l]

;; And the other would be:

;; [:l
;;  :l :o
;;  :l :l :o
;;  :l :l :l :l
;;  :l :l :l :l :l]

;; There are no other successors for this board. Certainly a
;; backtracking problem. We need functions that describe coordinates
;; of moves.

;; Vertical moves starting from pegs at various positions should be:

;; 0 -> [0 1 3]
;; 1 -> [1 3 6]
;; 2 -> [2 4 7]
;; ...
;; 8 -> nil

(defn next-vertical [i]
  (cond
   (nil? i) nil
   (= 0 i) (inc i)
   (>= 2 i) (+ 2 i)
   (>= 5 i) (+ 3 i)
   (>= 9 i) (+ 4 i)
   :else nil))

;; And finally we can grab the next three indices:

(defn vertical-indices [i]
  (let [r (vec (take 3 (iterate next-vertical i)))]
    (when (every? integer? r) r)))

;; which seems right.

;; We'll do something similar for horizontal.

;;  0
;;  1  2
;;  3  4  5
;;  6  7  8  9
;; 10  11 12 13 14

(defn horizontal-indices [i]
  (when (or (= 3 i)
            (<= 6 i 7)
            (<= 10 i 12))
    (vec (take 3 (iterate inc i)))))

;; OK, and finally lets do the diagonal move. We'll reuse the vertical
;; indices function.

(defn diagonal-indices [i]
  (when-let [r (vertical-indices i)]
    (vec (map-indexed + r))))

;; There's still some work left. We have functions that generate indices
;; from which moves might be performed. But the board will never
;; change. Therefore, the possible positions that a move *could* occur
;; from is bounded by a constant. So we will generate them all ahead
;; of time. We will define a var that stores all indices.
(def all-moves
  (vec (for [i (range 15)
             [direction f] [[:horizontal horizontal-indices]
                            [:vertical vertical-indices]
                            [:diagonal diagonal-indices]]
             :let [res (f i)]
             :when (some? res)]
         {:direction direction
          :indices res})))


(defn next-entries [board indices]
  (let [entries (mapv #(nth board %) indices)]
    (case entries
      [:l :l :o] [:o :o :l]
      [:o :l :l] [:l :o :o]
      nil)))

(defn assoc-next-entries [board move]
  (assoc move :entries (next-entries board (:indices move))))

(defn apply-move [{:keys [entries indices]} board]
  (apply assoc board (interleave indices entries)))

(defn get-valid-moves [board]
  (->> all-moves
       (map (partial assoc-next-entries board))
       (filter :entries)))

(defn solve
  "Return a solution for a board if it exists, and nil otherwise."
  [board]
  (assert (= 15 (count board)) "Board must have 15 entries")
  (loop [board-stack [board]
         move-stack  []
         possible-moves [(vec (get-valid-moves board))]]
    (cond (= (count board-stack) 14) board-stack
          (empty? (peek possible-moves)) (recur (pop board-stack) (pop move-stack) (pop possible-moves))
          :else (let [our-move (peek (peek possible-moves))
                      next-board (apply-move our-move (peek board-stack))]
                  (recur (conj board-stack next-board)
                         (conj move-stack our-move)
                         (conj (conj (pop possible-moves)
                                     (pop (peek possible-moves)))
                               (vec (get-valid-moves next-board))))))))

(def puzzle-format (apply str
                          (interleave
                           (map #(apply str (interpose " " (repeat % "%s")))
                                [1 2 3 4 5])
                           (repeat "\n"))))
(defn format-puzzle [v]
  (apply format
         puzzle-format
         (map name v)))

(defn print-solution [solution]
  (doseq [board solution]
    (println (format-puzzle board))))

(def one-solution (solve board))
(print-solution one-solution)


(def board2 [:l
             :l :l
             :l :o :l
             :l :l :l :l
             :l :l :l :l :l])

(def second-solution (solve board2))
(print-solution second-solution)