cKanren blog

evil-norvig.clj

(def evil-norvig
    [[0 0 0  0 0 6  0 0 0]
     [0 5 9  0 0 0  0 0 8]
     [2 0 0  0 0 8  0 0 0]
     
     [0 4 5  0 0 0  0 0 0]
     [0 0 3  0 0 0  0 0 0]
     [0 0 6  0 0 3  0 5 4]

     [0 0 0  3 2 5  0 0 6]
     [0 0 0  0 0 0  0 0 0]
     [0 0 0  0 0 0  0 0 0]])

sud.clj

(ns sud
  (:require [clojure.set :as s]
            [clojure.pprint :as pp]))

(defn possible
  "Possible values for a given position"
  [[x y] board]
  (let [horizontal (set (board x))
        vertical (reduce (fn [a c] (conj a (c y))) #{} board)
        x' (* (quot x 3) 3)
        y' (* (quot y 3) 3)
        local (reduce (fn [a r]
                        (->> (range y' (+ y' 3))
                             (map #(get-in board [r %]))
                             (into a)))
                      #{} (range x' (+ x' 3)))]
    (s/difference (set (range 1 10)) vertical horizontal local)))

(defn open
  "Get all open positions"
  [board]
  (reduce (fn [a r]
            (->> (second r)
                 (map-indexed vector)
                 (filter #(= 0 (second %)))
                 (map #(vector (first r) (first %)))
                 (into a)))
          [] (map-indexed vector board)))

(defn most-constrained
  "Get open positions and possibles sorted by the least possibles"
  [board]
  (->> board
       open
       (map #(vector % (possible % board)))
       (sort-by (comp count second))))

(defn solved? [board]
  (->> board
       (apply concat)
       (some #{0})
       (not= 0)))

(defn search [n board]
  (let [res (atom [])]
    ((fn sloop [board]
       (when (< (count @res) n)    
         (if (solved? board)
           (swap! res conj board)
           (letfn [(try-all [[[o ps]] & t]
                     (when o
                       (doseq [p ps]
                         (sloop (assoc-in board o p))
                         (try-all t))))]
             (try-all (most-constrained board))))))
     board)
    @res))

(def empty-board (vec (repeat 8 (vec (repeat 8 0)))))
(time (pp/pprint (search 5 empty-board)))

sud4.clj

(declare all-distincto)

(run 1 [q]
     (fresh [a1 a2 a3 a4                 ;; our 4x4 squares...
             b1 b2 b3 b4
             c1 c2 c3 c4
             d1 d2 d3 d4]

            (== q [[a1 a2 a3 a4]         ;; ... laid out like this on our board
                   [b1 b2 b3 b4]
                   [c1 c2 c3 c4]
                   [d1 d2 d3 d4]])

            (infd a1 a2 a3 a4            ;; all squares bound to 1-4 integer domain
                  b1 b2 b3 b4            ;; infd is a cKanren function
                  c1 c2 c3 c4
                  d1 d2 d3 d4
                  (interval 1 4))

            ;; define the rows, columns and sub-squares
            (let [row1 [a1 a2 a3 a4] row2 [b1 b2 b3 b4]
                  row3 [c1 c2 c3 c4] row4 [d1 d2 d3 d4]
                  col1 [a1 b1 c1 d1] col2 [a2 b2 c2 d2]
                  col3 [a3 b3 c3 d3] col4 [a4 b4 c4 d4]
                  sq1 [a1 a2 b1 b2]  sq2 [a3 a4 b3 b4]
                  sq3 [c1 c2 d1 d2]  sq4 [c3 c4 d3 d4]]
              
              ;; assert that the numbers in all rows, cols, squares are distinct
              (all-distincto [row1 row2 row3 row4
                              col1 col2 col3 col4
                              sq1 sq2 sq3 sq4]))))

(defne all-distincto [l]
  ([()])
  ([[h . t]]
     (distinctfd h)               ;; distrinctfd is a cKanren function
     (all-distincto t)))