Skip to content

Instantly share code, notes, and snippets.

@forki
Created December 6, 2010 14:07
Show Gist options
  • Save forki/730317 to your computer and use it in GitHub Desktop.
Save forki/730317 to your computer and use it in GitHub Desktop.
Sudoku solver
open System.Collections.Generic
type Box = int
type Sudoku = Box array array
let rows = id
let cols (sudoku:Sudoku) =
sudoku
|> Array.mapi (fun a row -> row |> Array.mapi (fun b cell -> sudoku.[b].[a]))
let getBoxIndex count row col =
let n = row/count
let m = col/count
n * count + m
let boxes (sudoku:Sudoku) =
let d = sudoku |> Array.length |> float |> System.Math.Sqrt |> int
let list = new List<_>()
for a in 0..(d*d) - 1 do list.Add(new List<_>())
for a in 0..(Array.length sudoku - 1) do
for b in 0..(Array.length sudoku - 1) do
list.[getBoxIndex d a b].Add(sudoku.[a].[b])
list
|> Seq.map Seq.toArray
let toSudoku x : Sudoku =
x
|> Seq.map Seq.toArray
|> Seq.toArray
let allUnique numbers =
let set = new HashSet<_>()
numbers
|> Seq.filter ((<>) 0)
|> Seq.forall set.Add
let solvable sudoku =
rows sudoku
|> Seq.append (cols sudoku)
|> Seq.append (boxes sudoku)
|> Seq.forall allUnique
let replaceAtPos (x:Sudoku) row col newValue :Sudoku =
[| for a in 0..(Array.length x - 1) ->
[| for b in 0..(Array.length x - 1) ->
if a = row && b = col then newValue else x.[a].[b] |] |]
let rec substitute row col (x:Sudoku) =
let a,b = if col >= Array.length x then row+1,0 else row,col
if a >= Array.length x then seq { yield x } else
if x.[a].[b] = 0 then
[1..Array.length x]
|> Seq.map (replaceAtPos x a b)
|> Seq.filter solvable
|> Seq.map (substitute a (b+1))
|> Seq.concat
else substitute a (b+1) x
let getFirstSolution = substitute 0 0 >> Seq.head
let solve sudoku =
let start = System.DateTime.Now
let solution = getFirstSolution sudoku
printfn "%As" <| System.Math.Round((System.DateTime.Now - start).TotalSeconds,2)
printfn "%A" solution
let s1 =
[[1; 2; 3; 4]
[0; 4; 1; 2]
[0; 3; 0; 0]
[2; 0; 0; 0]]
|> toSudoku
let s2 =
[[0; 0; 8; 3; 0; 0; 6; 0; 0]
[0; 0; 4; 0; 0; 0; 0; 1; 0]
[6; 7; 0; 0; 8; 0; 0; 0; 0]
[0; 1; 6; 4; 3; 0; 0; 0; 0]
[0; 0; 0; 7; 9; 0; 0; 2; 0]
[0; 9; 0; 0; 0; 0; 4; 0; 1]
[0; 0; 0; 9; 1; 0; 0; 0; 5]
[0; 0; 3; 0; 5; 0; 0; 0; 2]
[0; 5; 0; 0; 0; 0; 0; 7; 4]]
|> toSudoku
solve s2
System.Console.ReadKey()
|> ignore
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment