Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
A solves sudoku puzzels using Microsoft Solver Foundation and F#.
open Microsoft.SolverFoundation.Services
open Microsoft.SolverFoundation.Common
open System.Collections.Generic
open Microsoft.SolverFoundation.SfsWrapper
// helper functions for grouping elements of the solution
let flatten (matrix:'a[,]) = matrix |> Seq.cast<'a> |> Seq.toArray
let getColumn c (matrix:_[,]) =
flatten matrix.[*,c..c]
let getRow r (matrix:_[,]) =
flatten matrix.[r..r,*]
let getSquare s (vars: 'a[,]) =
let x = s % 3
let y = s / 3
let startx, endx = x * 3, (x + 1) * 3 - 1
let starty, endy = y * 3, (y + 1) * 3 - 1
flatten vars.[startx .. endx, starty .. endy]
// prints out a solution
let printSolution (sol: int[,]) =
for y in 0 .. 8 do
if y % 3 = 0 then
for _ in 1 .. 35 do printf "-"
printfn ""
getRow y sol |>
Seq.iteri(fun x value ->
if x % 3 = 0 then
printf " | "
printf " %i " value)
printfn ""
let solveSudoku (input: seq<int>) =
// sanity check on inputs
let check setType i set =
let set = Array.filter ((<>) 0) set
let set' = Set.ofSeq set
if set.Length <> set'.Count then
failwith (sprintf "Error in %s[%i] contains non-unique number" setType i)
let input' = Array.ofSeq input
let squareInput = Array2D.init 9 9 (fun x y -> input'.[ x + (9 * y)])
for i in 0 .. 8 do
getRow i squareInput |> check "row" i
getColumn i squareInput |> check "col" i
getSquare i squareInput |> check "square" i
// get context and create the model
let context = SolverContext.GetContext()
let model = new SfsModel(context)
// create the variables that will represent each place in the puzzel
let vars = Array2D.init 9 9 (fun _ _ -> model.CreateIntRangeVariable(1, 9))
// helper to add contraint to model that terms are all different
let addVarsAllDiff varArray =
let termArray = varArray |> Seq.cast<SfsIntTerm<1>> |> Array.ofSeq
let contraint = model.AllDifferent termArray
model.AddConstraint contraint |> ignore
// go though each column, rom, and square and add all diff contraint
// i.e. these are the basic rules of the game
for i in 0 .. 8 do
addVarsAllDiff (getColumn i vars)
addVarsAllDiff (getRow i vars)
addVarsAllDiff (getSquare i vars)
// add the contraints from the inputs to the model
let varsFlat = flatten vars
input |>
Seq.iteri(fun i x ->
if x <> 0 then
model.AddConstraint (varsFlat.[i] ==== x) |> ignore)
// tell the model to solve the problem, using a "Constraint Programming" solver
let sol = model.Solve ConstraintProgramming
// print the solution quality and if apporiate the solution itself
printfn "Solution: %A" sol.Quality
if sol.Quality = SolverQuality.Feasible then
context.PropagateDecisions()
let res = vars |> Array2D.map (fun x -> x.Value)
printSolution res
// generate a blank input
let inputEmpty = [for _ in 1 .. 81 do yield 0]
// an explicit blank input, useful for creating new inputs from
let inputBlank =
[ 0; 0; 0; 0; 0; 0; 0; 0; 0;
0; 0; 0; 0; 0; 0; 0; 0; 0;
0; 0; 0; 0; 0; 0; 0; 0; 0;
0; 0; 0; 0; 0; 0; 0; 0; 0;
0; 0; 0; 0; 0; 0; 0; 0; 0;
0; 0; 0; 0; 0; 0; 0; 0; 0;
0; 0; 0; 0; 0; 0; 0; 0; 0;
0; 0; 0; 0; 0; 0; 0; 0; 0;
0; 0; 0; 0; 0; 0; 0; 0; 0; ]
// an example puzzle
let input =
[ 0; 9; 4; 2; 8; 0; 0; 0; 0;
0; 3; 0; 1; 0; 6; 0; 0; 0;
6; 0; 0; 0; 0; 0; 2; 0; 0;
0; 8; 2; 4; 9; 0; 7; 0; 0;
4; 0; 0; 0; 0; 7; 0; 9; 0;
0; 0; 0; 0; 0; 0; 0; 0; 0;
0; 6; 0; 0; 0; 0; 0; 5; 2;
0; 0; 0; 0; 0; 0; 6; 4; 0;
7; 0; 0; 9; 0; 0; 0; 0; 1; ]
// solve the example puzzel
solveSudoku input
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment