## A sudoku solver in F#

I have never really enjoyed solving sudokus by hand. The reason for this, I think, is that it is so mechanical. It’s all about applying an algorithm, which is something that computers are very good at and humans, well humans should write programs instead… 🙂

Yesterday, I was challanged by the Project Euler, to create – thats right – a sudoku solver. Normally, I do not write about my solutions since the fun of the Project Euler is to find your own solutions and the solutions are, well not that useful really, once they are found out. Sudokus, however, are well known outside the domain of the Project Euler. Thus, here we are.

The solver stores the game state in a two dimensional array. Each array element contains a set of integers representing the possible values for that cell.

type Solution = Set<int>[,]

The two dimensional array turned out to be a good choice due to the elegant support for slicing. I ended up extending the Array2D module as shown below:

module Array2D

// ref: http://cs.hubfs.net/forums/thread/14066.aspx

let getRow (arr : ‘a[,]) r = arr.[r..r,*]

let getColumn (arr : ‘a[,]) c = arr.[*,c..c]

let getGroup (arr : ‘a[,]) gc gr size=

let r = gr * size

let c = gc * size

arr.[r..r+size-1,c..c+size-1]

let enumerateBy (f : int -> int -> ‘a -> ‘b) (arr : ‘a[,]) =

seq {

let rc = Array2D.length1 arr

let cc = Array2D.length2 arr

for r in 0..rc-1 do

for c in 0..cc-1 do

yield f r c arr.[r,c]

}

let enumerate (arr : ‘a[,]) =

enumerateBy (fun r c v -> v) arr

let enumeratei (arr : ‘a[,]) =

enumerateBy (fun r c v -> v,(r,c)) arr

The algorithm then consists of two separate parts. One part is the iterative that can solve the simplest class of sudokus and by such I mean sudokus that do not require guessing.

let solveCell a c r =

let filterByRow s = Set.difference s (selectRow a r)

let filterByColumn s = Set.difference s (selectColumn a c)

let filterByGroup s = Set.difference s (selectGroup a (c/3) (r/3))

a.[r,c] |>

filterByRow |>

filterByColumn |>

filterByGroup

let iterateSolve (arr : Solution) =

let updateSingleCell (a : Solution) c r =

let prev = a.[r,c]

a.[r,c] <- solveCell a c r

prev <> a.[r,c]

let updateAllCells (arr : Solution) =

Array2D.enumeratei arr |>

Seq.filter (fun (s,_) -> s.Count > 1) |>

Seq.fold (fun st (_,(r,c)) -> let changed = updateSingleCell arr c r in st || changed) false

let arr’ = Array2D.copy arr

while updateAllCells arr’ do ()

arr’

SelectRow, SelectColumn and SelectGroup are thin wrappers around Array2D.getRow, Array2D.getColumn and Array2D.getGroup. The second part of the algorithm handles the guessing by implementing back tracking. Here we go:

let rec backTrackSearch (f : ‘a -> ‘a list) (initial : ‘a) =

match f initial with

| [] -> None

| [solution] -> Some solution

| solutions ->

solutions |>

Seq.map (backTrackSearch f) |>

Seq.tryPick (fun x -> x)

let solve (s : Solution) =

let unfold (arr : Solution) : Solution list =

let cells = Array2D.enumerateBy (fun r c (s : Set<int>) -> s.Count,(r,c)) arr

if Seq.tryFind (fun (count,_) -> count = 0) cells |> Option.isSome then

[]

elif Seq.forall (fun (count,_) -> count = 1) cells then

[arr]

else

[ let (_,(r,c)) = cells |> Seq.filter (fun (count,_) -> count > 1) |> Seq.minBy fst

for candidate in arr.[r,c] do

let arr’ = Array2D.copy arr

arr’.[r,c] <- Set.singleton candidate

yield arr’ ]

backTrackSearch (iterateSolve>>unfold) s

That is actually all there is to it. I was surprised by how little code that was actually needed for a efficient sudoku solver. To make it more useful I also added a very simple WPF based user interface.

The entire source code can be downloaded here.