Clojureによる数独解答プログラム

sudoku.clj

(def board-sample
  [
   0 9 0 0 1 0 0 2 0
   0 0 0 0 9 0 0 4 0
   5 0 0 0 0 0 0 0 6
   6 5 0 7 3 2 0 8 4
   0 0 9 0 0 0 7 1 3
   8 0 0 0 0 1 0 6 0
   2 1 4 8 5 3 0 7 9
   0 8 5 0 7 6 4 3 2
   0 7 6 4 2 9 0 0 1 ])

(defn take-from-board [board indexes]
    (map #(nth board %) indexes)
  )

(defn xline [board pos]
  (let [base (* (int (/ pos 9)) 9)
        indexes (range base (+ base 9))]
    (take-from-board board indexes)
    ))

(defn yline [board pos]
  (let [base (mod pos 9)
        indexes (map (fn [x] (+ base (* x 9))) (range 0 9))]
    (take-from-board board indexes)
    ))

(defn block [board pos]
  (let [xbase (int (/ (mod pos 9) 3))
        ybase (int (/ pos 27))
        indexes (map (fn [x] (+ (* ybase 27) (* xbase 3) x)) '(0 1 2 9 10 11 18 19 20))]
    (take-from-board board indexes)
    ))

(defn get-diff [& ss]
  (reduce clojure.set/difference #{1 2 3 4 5 6 7 8 9} (map #(set %) ss)))


(defn has-allnum? [s]
  (zero? (count (get-diff s))))

(defn cell-ok? [board pos]
  (and (has-allnum? (xline board pos))
       (has-allnum? (yline board pos))
       (has-allnum? (block board pos))))

(defn board-ok? [board]
  (every? #(cell-ok? board %) (range 0 81)))

(defn get-candidates [board pos]

  (when (zero? (nth board pos))
    (get-diff (xline board pos) 
              (yline board pos)
              (block board pos))))

(defn solve [board]
  (defn candidate-comp [[_ x] [_ y]]
    (compare (count x) (count y)))
  (defn try-solve [b [pos c]]
    (when-not (empty? c)
      (or (solve (assoc b pos (first c)))
          (recur b [pos (rest c)]))))

  (let [candidates (sort candidate-comp
                         (for [x (range 0 81) :when (zero? (nth board x))]
                           [x (get-candidates board x)]
                           ))]
    (if (empty? candidates) ; candidatesが空 = 全部埋まった
      board
      (if (empty? (second (first candidates))) ; 候補数0のセルがある = 失敗
        nil
        (let [def-candidates (filter (fn [[_ x]] (= 1 (count x))) candidates)]
          (if (empty? def-candidates)
            (trampoline try-solve board (first candidates))
            (recur (reduce (fn [b [pos c]] (assoc b pos (first c))) board def-candidates))))))))

(defn print-board [board]
  (when-not (nil? board)
  (clojure.pprint/cl-format true "~{~<~%~,18:;~1d ~>~}~&" board)))