1 people like it.

Every spot in the puzzle belongs to a (horizontal) row and a (vertical) column, as well as to one single 3x3 square (which we call "square" for short). At the beginning, some of the spots carry a single-digit number between 1 and 9. The problem is to fill the missing spots with digits in such a way that every number between 1 and 9 appears exactly once in each row, in each column, and in each square.

Sample sudoku board

 ``` 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: ``` ``````let problem = """ . . 4 | 8 . . | . 1 7 | | 6 7 . | 9 . . | . . . | | 5 . 8 | . 3 . | . . 4 --------+---------+-------- 3 . . | 7 4 . | 1 . . | | . 6 9 | . . . | 7 8 . | | . . 1 | . 6 9 | . . 5 --------+---------+-------- 1 . . | . 8 . | 3 . 6 | | . . . | . . 6 | . 9 1 | | 2 4 . | . . 1 | 5 . . """ ``````

Parsing sudoku board and helpers

 ``` 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: ``` ``````/// Returns all possible positions on a Sudoku board let positions = seq { for x in 0 .. 8 do for y in 0 .. 8 do yield x, y } /// Set of numbers that can appear in a place let numbers = set [ 1 .. 9 ] /// Create 2D array containing 'None' for every blank space and /// 'Some n' for every assigned number. We do this by iterating /// over lines & over characters and skipping everything that is /// not '.' or a valid number let task = [ for line in problem.Split('\n') do let parsed = [ for c in line do if c = '.' then yield None elif c >= '0' && c <= '9' then yield Some(int c - 48) ] if parsed <> [] then yield parsed ] |> array2D /// We represent the state of the board as a map from indices /// (this lets us do recursive backtracking nicely) type Sudoku = Map /// Turn the 2D array into a 'Sudoku' value let state : Sudoku = positions |> Seq.choose (fun (x, y) -> task.[x, y] |> Option.map (fun v -> (x, y), v)) |> Map.ofSeq ``````

Sudoku solver

 ``` 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: ``` ``````/// Returns the first empty position in the game /// (or 'None' when all the positions are filled) let findEmpty (state : Sudoku) = positions |> Seq.tryFind (state.ContainsKey >> not) /// Returns a list with 3 lists that contain positions /// on the board that have to be unique (that is, horizontal /// line, vertical line and the small square) let findLines (x, y) = let xs, ys = x/3*3, y/3*3 [ [ for y in 0 .. 8 -> x, y ] [ for x in 0 .. 8 -> x, y ] [ for x in 0 .. 2 do for y in 0 .. 2 do yield xs + x, ys + y ] ] /// Find numbers that are not used on a 'line' let getUnusedOnLine (state:Sudoku) line = numbers - set (line |> Seq.choose state.TryFind) /// Recursive sudoku solver. Keeps the current state /// in an immutable map to make backtracking easy let rec solve (state:Sudoku) = match findEmpty state with | Some pos -> // If there is an empty place, find all numbers that we can put there let alternatives = findLines pos |> Seq.map (getUnusedOnLine state) |> Set.intersectMany // Iterate over alternatives, add the number to the current 'pos' // and try calling 'solve' recursively for the rest of the board alternatives |> Seq.tryPick (fun v -> solve (Map.add pos v state)) | None -> Some(state) ``````

Printing the result

 ``` 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: ``` ``````/// Nicely format sudoku board that we get from the solver let printState (state:Sudoku) = let newBlock () = [ for i in 0 .. 2 -> String.replicate 9 "-" ] |> String.concat "+" |> printfn "+%s+" newBlock () for x in 0 .. 8 do printf "|" for y in 0 .. 8 do match state.TryFind (x, y) with | Some v -> printf " %d " v | _ -> printf ". " if y % 3 = 2 then printf "|" printfn "" if x % 3 = 2 then newBlock() // Run the solver and print the result! let solved = solve state printState solved.Value ``````

Result for the sample board

 ``` 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: ``` ``````// +---------+---------+---------+ // | 9 3 4 | 8 2 5 | 6 1 7 | // | 6 7 2 | 9 1 4 | 8 5 3 | // | 5 1 8 | 6 3 7 | 9 2 4 | // +---------+---------+---------+ // | 3 2 5 | 7 4 8 | 1 6 9 | // | 4 6 9 | 1 5 3 | 7 8 2 | // | 7 8 1 | 2 6 9 | 4 3 5 | // +---------+---------+---------+ // | 1 9 7 | 5 8 2 | 3 4 6 | // | 8 5 3 | 4 7 6 | 2 9 1 | // | 2 4 6 | 3 9 1 | 5 7 8 | // +---------+---------+---------+ ``````
val problem : string
val positions : seq<int * int>

Returns all possible positions on a Sudoku board
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

--------------------
type seq<'T> = System.Collections.Generic.IEnumerable<'T>
val x : int
val y : int
val numbers : Set<int>

Set of numbers that can appear in a place
val set : elements:seq<'T> -> Set<'T> (requires comparison)
val task : int option [,]

Create 2D array containing 'None' for every blank space and
'Some n' for every assigned number. We do this by iterating
over lines & over characters and skipping everything that is
not '.' or a valid number
val line : string
System.String.Split([<System.ParamArray>] separator: char []) : string []
System.String.Split(separator: string [], options: System.StringSplitOptions) : string []
System.String.Split(separator: string,?options: System.StringSplitOptions) : string []
System.String.Split(separator: char [], options: System.StringSplitOptions) : string []
System.String.Split(separator: char [], count: int) : string []
System.String.Split(separator: char,?options: System.StringSplitOptions) : string []
System.String.Split(separator: string [], count: int, options: System.StringSplitOptions) : string []
System.String.Split(separator: string, count: int,?options: System.StringSplitOptions) : string []
System.String.Split(separator: char [], count: int, options: System.StringSplitOptions) : string []
System.String.Split(separator: char, count: int,?options: System.StringSplitOptions) : string []
val parsed : int option list
val c : char
union case Option.None: Option<'T>
union case Option.Some: Value: 'T -> Option<'T>
Multiple items
val int : value:'T -> int (requires member op_Explicit)

--------------------
type int = int32

--------------------
type int<'Measure> = int
val array2D : rows:seq<#seq<'T>> -> 'T [,]
type Sudoku = Map<(int * int),int>

We represent the state of the board as a map from indices
(this lets us do recursive backtracking nicely)
Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
interface IEnumerable
interface IComparable
interface IEnumerable<KeyValuePair<'Key,'Value>>
interface ICollection<KeyValuePair<'Key,'Value>>
interface IDictionary<'Key,'Value>
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
member Add : key:'Key * value:'Value -> Map<'Key,'Value>
member ContainsKey : key:'Key -> bool
...

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
val state : Sudoku

Turn the 2D array into a 'Sudoku' value
module Seq

from Microsoft.FSharp.Collections
val choose : chooser:('T -> 'U option) -> source:seq<'T> -> seq<'U>
module Option

from Microsoft.FSharp.Core
val map : mapping:('T -> 'U) -> option:'T option -> 'U option
val v : int
val ofSeq : elements:seq<'Key * 'T> -> Map<'Key,'T> (requires comparison)
val findEmpty : state:Sudoku -> (int * int) option

Returns the first empty position in the game
(or 'None' when all the positions are filled)
val state : Sudoku
val tryFind : predicate:('T -> bool) -> source:seq<'T> -> 'T option
member Map.ContainsKey : key:'Key -> bool
val not : value:bool -> bool
val findLines : x:int * y:int -> (int * int) list list

Returns a list with 3 lists that contain positions
on the board that have to be unique (that is, horizontal
line, vertical line and the small square)
val xs : int
val ys : int
val getUnusedOnLine : state:Sudoku -> line:seq<int * int> -> Set<int>

Find numbers that are not used on a 'line'
val line : seq<int * int>
member Map.TryFind : key:'Key -> 'Value option
val solve : state:Sudoku -> Sudoku option

Recursive sudoku solver. Keeps the current state
in an immutable map to make backtracking easy
val pos : int * int
val alternatives : Set<int>
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>
Multiple items
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
interface IComparable
interface IEnumerable
interface IEnumerable<'T>
interface ICollection<'T>
new : elements:seq<'T> -> Set<'T>
member Add : value:'T -> Set<'T>
member Contains : value:'T -> bool
override Equals : obj -> bool
member IsProperSubsetOf : otherSet:Set<'T> -> bool
...

--------------------
new : elements:seq<'T> -> Set<'T>
val intersectMany : sets:seq<Set<'T>> -> Set<'T> (requires comparison)
val tryPick : chooser:('T -> 'U option) -> source:seq<'T> -> 'U option
val add : key:'Key -> value:'T -> table:Map<'Key,'T> -> Map<'Key,'T> (requires comparison)
val printState : state:Sudoku -> unit

Nicely format sudoku board that we get from the solver
val newBlock : (unit -> unit)
val i : int
module String

from Microsoft.FSharp.Core
val replicate : count:int -> str:string -> string
val concat : sep:string -> strings:seq<string> -> string
val printfn : format:Printf.TextWriterFormat<'T> -> 'T
val x : int32
val printf : format:Printf.TextWriterFormat<'T> -> 'T
val y : int32
val solved : Sudoku option
property Option.Value: Sudoku with get