(ns clj-sudoku.core
  (:gen-class))

;;; Records

(defrecord Square [pos x y num hints sure unit])
(defrecord Item [square state])

;;; Grids

(def easy-grid ".931.564.7.......55.12.93.72.......3.369.752.9.......13.24.81.96.......4.473.285.")
(def medium-grid "4.....8.5.3..........7......2.....6.....8.4......1.......6.3.7.5..2.....1.4......")
(def hard-grid "..............3.85..1.2.......5.7.....4...1...9.......5......73..2.1........4...9")
(def hard-grid2 "....9..5..1.....3...23..7....45...7.8.....2.......64...9..1.....8..6......54....7")
(def hard-grid3 "4...3.......6..8..........1....5..9..8....6...7.2........1.27..5.3....4.9........")

;;; Gen table

(defn- parser [e y]
  (map #(let [num (if (= \. %1) nil (Integer/parseInt (str %1)))]
          (Square. (+ (* 9 (- y 1)) %2) %2 y num (if num nil (range 1 10))
                   (if num true false) nil)) e (range 1 10)))

(defn- process [u i]
  (map (fn [a]
         (let [tmp (partition 3 a)]
           (map (fn [e c]
                  (map #(assoc % :unit c) e))
                tmp (range i (+ i 3))))) u))

(defn- make-units [sudoku]
  (let [[tu1-3 tu4-6 tu7-9] (partition 3 (partition 9 (vals (sort sudoku))))]
    (apply assoc sudoku
           (mapcat
            #(list (:pos %) %)
            (flatten
             (concat (process tu1-3 1)
                     (process tu4-6 4)
                     (process tu7-9 7)))))))

(defn- gen-sudoku [s]
  (make-units (zipmap (range 1 82)
                      (mapcat parser (partition 9 s) (range 1 10)))))

;;; Methods

(defn- valid-state? [state]
  (empty? (filter #(and (empty? (:hints %))
                       (false? (:sure %))
                       (nil? (:num %))) (vals state))))

(defn- valid-square? [square peers]
  (empty? (filter #(= (:num %) (:num square)) peers)))

(defn- clean-hints [sq num]
  (let [hints (remove #(= % num) (:hints sq))]
    (assoc sq :hints hints)))

(defn- new-state [state square peers]
  (let [n-state (apply assoc state
                       (mapcat #(list (:pos %) %)
                               (map #(clean-hints % (:num square)) peers)))]
    (assoc n-state (:pos square) square)))

(defn- get-peers [state square]
  (let [row (filter #(= (:y %) (:y square)) (vals state))
        col (filter #(= (:x %) (:x square)) (vals state))
        peers (filter #(= (:unit square) (:unit %)) (vals state))]
    (remove #(= % square) (flatten [row col peers]))))

(defn- few-hints-square [state]
  (let [v (vals state)
        ss (filter #(not (empty? (:hints %))) v)]
    (first (sort-by #(count (:hints %)) ss))))

(defn- complete-sures [state]
  (let [sures (filter #(true? (:sure %)) (vals state))]
    (loop [queue sures
           state state]
      (let [square (last queue)
            peers (get-peers state square)
            n-state (new-state state square peers)
            n-queue (butlast queue)]
        (if n-queue
          (recur n-queue n-state)
          n-state)))))

(defn- solve-sudoku [state]
  (let [f-st (complete-sures state)]
    (loop [queue (cons {:square (few-hints-square f-st)
                        :state f-st} '())]
      (let [current (last queue)
            {square :square state :state} current]
        (if (:hints square)
          (let [hints (:hints square)
                nexts (reverse (map #(hash-map :square (assoc square :num % :hints nil)
                                               :state state) hints))]
            (recur (concat (butlast queue) nexts)))
          (let [peers (get-peers state square)
                n-state (new-state state square peers)
                n-square (few-hints-square n-state)]
            (if (and (valid-square? square peers)
                     (valid-state? n-state))
              (if n-square
                (recur (cons {:square n-square
                              :state n-state} (butlast queue)))
                n-state)
              (recur (butlast queue)))))))))

(defn solve-grid [grid]
  (let [sudoku (gen-sudoku grid)]
    (solve-sudoku sudoku)))

(defn -main []
  (let [solution (solve-grid easy-grid)]
    (map #(:num %) (vals (sort solution)))))