Eight Queens in core.logic

(ns eight-queens
  (:refer-clojure :exclude [==])
  (:require
   [clojure.string :as str]
   [clojure.core.logic :refer :all :as l]
   [clojure.core.logic.fd :as fd]))

;; Classic AI problem:
;;
;;
;; Find a chess board configuration, where (n=8) queens are on the board;
;; And no pairs attack each other.
;;

;;
;; representation:
;;
;; permutation <1...8>,
;; 1 number per row,
;; so that [1,2,3,4,5,6,7,8] is placing all queens on a diagonal (everybody attacks each other).
;;
;; - constrains the configuration:
;; - all queens are on different rows.
;; - all queens are on different columns.
;;
;; This is fine, because those configurations are not in the set of solutions.
;;
;;

  (defn queens-logic
    [n]
    ;; make (n=8) logic variables, for each row
    (let [colvars (map (fn [i] (l/lvar (str "col-" i))) (range n))]
      (l/run* [q]
        ;; 1. assign the domain 0-8
        (everyg (fn [lv] (fd/in lv (fd/interval (dec n)))) colvars)
        ;; 2. 'row must be different' constraint // permutation
        (fd/distinct colvars)
        ;; 3. diagonal constraint
        ;; for each queen, say that the other queens are not attacking diagonally
        (and* (for [i (range n)
                    j (range (inc i) n)
                    :let [row-diff (- j i)
                          ci (nth colvars i)
                          cj (nth colvars j)]]
                (fresh []
                  ;; handle south-east and north-east cases
                  (fd/eq (!= cj (+ ci row-diff)))
                  ;; '-' relation didn't work somehow
                  (fd/eq (!= ci (+ cj row-diff))))))
        (l/== q colvars))))

  (take 1 (queens-logic 8))
  '((1 3 5 7 2 0 6 4))

(comment

  ;; reference is definend below
  (def refence-outcome (find-all-solutions 8))

  (def outcome (queens-logic 8))

  [(= (into #{} refence-outcome) (into #{} outcome))
   (every? zero? (map quality refence-outcome))
   (every? zero? (map quality outcome)) (count outcome)]

  ;; =>
  [true true true 92])

;; ============================
;; Helpers and non-relational solutions

(defn quality
  "Count the number of queens attacking each other in the given board configuration.
   board-config is a vector of column positions, one per row.
   Returns the number of pairs of queens that attack each other."
  [board-config]
  (let [n (count board-config)]
    (loop [row1 0
           conflicts 0]
      (if (>= row1 n)
        conflicts
        (let [col1 (nth board-config row1)
              new-conflicts (loop [row2 (inc row1)
                                   acc 0]
                              (if (>= row2 n)
                                acc
                                (let [col2 (nth board-config row2)
                                      ;; Check diagonal attacks
                                      diag-attack? (= (Math/abs (- row1 row2))
                                                      (Math/abs (- col1 col2)))]
                                  (recur (inc row2)
                                         (if diag-attack? (inc acc) acc)))))]
          (recur (inc row1) (+ conflicts new-conflicts)))))))

(defn valid-solution?
  "Returns true if the board configuration has no conflicts."
  [board-config]
  (zero? (quality board-config)))

(defn print-board
  "Prints a visual representation of the board."
  [board-config]
  (let [n (count board-config)]
    (doseq [row (range n)]
      (let [col (nth board-config row)]
        (println (apply str (for [c (range n)]
                              (if (= c col) "Q " ". ")))))))
  (println))

(defn solve-backtrack
  "Solves the N-Queens problem using backtracking.
   Returns the first valid solution found, or nil if none exists."
  [n]
  (letfn [(safe? [board row col]
            (let [board-vec (vec board)]
              ;; Check if placing a queen at [row col] is safe
              (not (some (fn [r]
                           (let [c (nth board-vec r)]
                             (or (= c col)
                                 (= (Math/abs (- r row))
                                    (Math/abs (- c col))))))
                         (range row)))))

          (place-queens [board row]
            (if (= row n)
              board ;; Solution found
              (some (fn [col]
                      (when (safe? board row col)
                        (place-queens (conj board col) (inc row))))
                    (range n))))]

    (place-queens [] 0)))

(defn find-all-solutions
  "Finds all solutions to the N-Queens problem.
   Returns a sequence of all valid board configurations."
  [n]
  (letfn [(safe? [board row col]
            (let [board-vec (vec board)]
              (not (some (fn [r]
                           (let [c (nth board-vec r)]
                             (or (= c col)
                                 (= (Math/abs (- r row))
                                    (Math/abs (- c col))))))
                         (range row)))))

          (place-queens [board row]
            (if (= row n)
              [board] ;; Return solution in a vector
              (mapcat (fn [col]
                        (when (safe? board row col)
                          (place-queens (conj board col) (inc row))))
                      (range n))))]

    (place-queens [] 0)))

(defn random-config
  "Generates a random board configuration of size n."
  [n]
  (vec (shuffle (range n))))


(defn solve-hill-climbing
  "Solves the N-Queens problem using hill climbing with random restarts.
   max-restarts: maximum number of random restarts to attempt.
   max-steps: maximum steps per climb attempt."
  [n & {:keys [max-restarts max-steps]
        :or {max-restarts 100 max-steps 1000}}]
  (letfn [(swap-positions [config i j]
            (assoc config i (nth config j) j (nth config i)))

          (get-neighbors [config]
            (for [i (range n)
                  j (range (inc i) n)]
              (swap-positions config i j)))

          (climb [config steps]
            (if (or (zero? steps) (valid-solution? config))
              config
              (let [current-quality (quality config)
                    neighbors (get-neighbors config)
                    better-neighbors (filter #(< (quality %) current-quality) neighbors)]
                (if (empty? better-neighbors)
                  config ;; Local minimum reached
                  (recur (first (sort-by quality better-neighbors))
                         (dec steps))))))]

    (loop [restarts 0]
      (if (>= restarts max-restarts)
        nil ;; Failed to find solution
        (let [start-config (random-config n)
              result (climb start-config max-steps)]
          (if (valid-solution? result)
            result
            (recur (inc restarts))))))))


(comment
  ;; Example usage:

  ;; Test the quality function
  (quality [0 1 2 3 4 5 6 7]) ;; All on diagonal - many conflicts
  ;; => 28

  (quality [0 4 7 5 2 6 1 3]) ;; A valid solution
  ;; => 0

  ;; Solve for 8 queens using backtracking
  (def solution (solve-backtrack 8))
  solution
  ;; => [0 4 7 5 2 6 1 3]

  (print-board solution)
  ;; Q . . . . . . .
  ;; . . . . Q . . .
  ;; . . . . . . . Q
  ;; . . . . . Q . .
  ;; . . Q . . . . .
  ;; . . . . . . Q .
  ;; . Q . . . . . .
  ;; . . . Q . . . .

  ;; Find all solutions
  (def all-sols (find-all-solutions 8))
  (count all-sols)
  ;; => 92 (there are 92 distinct solutions for 8 queens)

  ;; Solve using hill climbing
  (def hc-solution (solve-hill-climbing 8))
  (print-board hc-solution)

  ;; Test quality on various board sizes
  (quality [0 1]) ;; => 0 (2 queens, no conflict)
  (quality [0 2 1]) ;; => 0 (3 queens, valid)
  (quality [1 3 0 2]) ;; => 0 (4 queens, valid)
  )

(require '[hiccup2.core :as html])

(defn board-to-hiccup
  "Converts a board configuration to hiccup format with checkerboard pattern."
  [board-config]
  (let [n (count board-config)]
    [:div {:style {:display "inline-block"
                   :border "2px solid #333"}}
     (for [row (range n)]
       (let [col (nth board-config row)]
         [:div {:style {:display "flex"}}
          (for [c (range n)]
            (let [is-dark? (odd? (+ row c))
                  has-queen? (= c col)]
              [:div {:style {:width "60px"
                             :height "60px"
                             :background-color (if is-dark? "#769656" "#eeeed2")
                             :display "flex"
                             :align-items "center"
                             :justify-content "center"
                             :font-size "40px"
                             :font-weight "bold"
                             :color "#000"}}
               (when has-queen? "♕")]))]))]))

(spit
 "board.html"
 (html/html
     [:div
      {:style
       {:display "flex"
        :padding "8px"
        :gap "8px"
        :flex-wrap "wrap"}}
      (doall (map board-to-hiccup (queens-logic 8)))]))