sudoku.clj

(ns sudoku
  (:require [clojure.set :as set]))

(defn row-values
  [board [row _]]
  (set (get board row)))

(defn- transpose
  [matrix]
  (vec (apply map vector matrix)))

(defn col-values
  [board [_ col]]
  (set (get (transpose board) col)))

(defn- constrain-coord
  [coord]
  (mapv (fn [n]
          (cond (< n 3) 0
                (< n 6) 3
                :else 6))
        coord))
  
(defn block-values
  [board coord]
  (let [[row col] (constrain-coord coord)]
    (set (mapcat #(subvec % col (+ col 3))
                 (subvec board row (+ row 3))))))

(defn entities
  [f coords board]
  (mapv (partial f board) coords))

(def rows
  (partial entities row-values
           (map vector (range 9) (repeat 0))))

(def cols
  (partial entities col-values
           (map vector (repeat 0) (range 9))))

(def blocks
  (partial entities block-values
           (map vector (range 0 9 3) (range 0 9 3))))

(def all-values #{1 2 3 4 5 6 7 8 9})

(defn valid-entity?
  [entity]
  (every? (partial = all-values) entity))

(defn valid-solution?
  [board]
  (every? true?
          (map valid-entity?
               [(cols board) (rows board) (blocks board)])))

(defn- map-matrix
  [f matrix]
  (map-indexed (fn [row-n row]
                 (map-indexed
                   (fn [col-n value]
                     (f value row-n col-n))
                   row))
               matrix))

(defn find-empty-point
  [board]
  (first (mapcat (partial remove nil?)
                 (map-matrix (fn [value row col]
                               (when (zero? value)
                                 [row col]))
                             board))))

(defn valid-values-for
  [board coord]
  (if-not (zero? (get-in board coord))
    #{}
    (let [used-values (set/union
                        (block-values board coord)
                        (row-values board coord)
                        (col-values board coord))]
      (set/difference all-values used-values))))

(defn filled?
  [board]
  (not (some zero? (flatten board))))

(defn solutions
  [board]
  (letfn [(solve [board]
            (let [point (find-empty-point board)
                  values (valid-values-for board point)]
              (mapcat (fn [value]
                        (let [board (assoc-in board point value)]
                          (cond (valid-solution? board) [board]
                                (filled? board) nil
                                :else (lazy-seq (solve board)))))
                      values)))]
    (solve board)))

(first (solutions [[5 3 0 0 7 0 0 0 0]
                   [6 0 0 1 9 5 0 0 0]
                   [0 9 8 0 0 0 0 6 0]
                   [8 0 0 0 6 0 0 0 3]
                   [4 0 0 8 0 3 0 0 1]
                   [7 0 0 0 2 0 0 0 6]
                   [0 6 0 0 0 0 2 8 0]
                   [0 0 0 4 1 9 0 0 5]
                   [0 0 0 0 8 0 0 7 9]]))
; =>
; [[5 3 4 6 7 8 9 1 2]
;  [6 7 2 1 9 5 3 4 8]
;  [1 9 8 3 4 2 5 6 7]
;  [8 5 9 7 6 1 4 2 3]
;  [4 2 6 8 5 3 7 9 1]
;  [7 1 3 9 2 4 8 5 6]
;  [9 6 1 5 3 7 2 8 4]
;  [2 8 7 4 1 9 6 3 5]
;  [3 4 5 2 8 6 1 7 9]]

sudoku.fs

module Array2D =
  let toArray (matrix: 'T [,]) = matrix |> Seq.cast<'T> |> Seq.toArray
  let toSet (matrix: 'T [,]) = matrix |> toArray |> Set.ofArray

let size = 9

let board = Array2D.zeroCreate<int> size size

let hasValue (board : int[,]) (x,y) = 0 <> (board.[x,y])

let rowValues (board : int[,]) row =
  board.[row..row, 0..size-1] |> Array2D.toSet

let colValues (board : int[,]) col =
  board.[0..size-1, col..col] |> Array2D.toSet

let blockValues (board : int[,]) row col =
  let constrain = function
    | n when n < 3 -> 0
    | n when n < 6 -> 3
    | _ -> 6
  let row = constrain row
  let col = constrain col
  board.[row..row + 2, col..col + 2] |> Array2D.toSet

let allValues = Set.ofSeq [1..9]

let validValuesFor board (row, col) =
  if hasValue board (row, col)
    then Set.empty
    else let usedValues =
           List.reduce Set.union [(colValues board col)
                                  ; (rowValues board row)
                                  ; (blockValues board row col)]
         Set.difference allValues usedValues

let valuesForCoords f board coords =
  Seq.map (fun coord -> f board  coord) coords

let rows board =
  let coords = Seq.map (fun row -> (row, 0)) [1..size-1]
  Seq.map (fun (row, _) -> rowValues board row) coords

let cols board =
  let coords = Seq.map (fun col -> (0, col)) [1..size-1]
  Seq.map (fun (_, col) -> colValues board col) coords

let blocks board =
  let coords = seq { for row in [0..3..9] do
                     for col in [0..3..9] do yield (row, col) }
  Seq.map (fun (row, col) -> blockValues board row col) coords

let valid values =
  Seq.forall (fun entity -> entity = allValues) values

let validSolution board =
  [rows board ; cols board ; blocks board]
  |> Seq.map valid
  |> Seq.forall ((=) true)

let setValueAt board (row, col) value =
  let copy = Array2D.copy board
  copy.[row, col] <- value
  copy

let findEmptyPoint board =
  let res = Array2D.mapi (fun row col value -> if value = 0
                                                 then Some(row, col)
                                                 else None)
                         board
            |> Array2D.toArray
            |> Seq.filter (fun x -> x.IsSome)
            |> Seq.head
  res.Value

let filled board =
  Array2D.toSet board
  |> Set.contains 0
  |> not

let solutions board =
  let rec solve board =
    let point = findEmptyPoint board
    let values = validValuesFor board point
    Seq.collect (fun value ->
                   let board = setValueAt board point value
                   match board with
                     | _ when validSolution board -> Seq.ofList [board]
                     | _ when filled board -> Seq.empty 
                     | _ -> solve board)
                (Set.toSeq values)
  solve board

let board = array2D [[5;3;0;0;7;0;0;0;0];
                     [6;0;0;1;9;5;0;0;0];
                     [0;9;8;0;0;0;0;6;0];
                     [8;0;0;0;6;0;0;0;3];
                     [4;0;0;8;0;3;0;0;1];
                     [7;0;0;0;2;0;0;0;6];
                     [0;6;0;0;0;0;2;8;0];
                     [0;0;0;4;1;9;0;0;5];
                     [0;0;0;0;8;0;0;7;9]]

solutions board |> Seq.head
// ->
// [[5; 3; 4; 6; 7; 8; 9; 1; 2]
//  [6; 7; 2; 1; 9; 5; 3; 4; 8]
//  [1; 9; 8; 3; 4; 2; 5; 6; 7]
//  [8; 5; 9; 7; 6; 1; 4; 2; 3]
//  [4; 2; 6; 8; 5; 3; 7; 9; 1]
//  [7; 1; 3; 9; 2; 4; 8; 5; 6]
//  [9; 6; 1; 5; 3; 7; 2; 8; 4]
//  [2; 8; 7; 4; 1; 9; 6; 3; 5]
//  [3; 4; 5; 2; 8; 6; 1; 7; 9]]