Created
April 30, 2011 13:19
-
-
Save fwaris/949657 to your computer and use it in GitHub Desktop.
Solve Sudoku with Solver Foundation and F#
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
//update the paths below to correctly reference the external resources | |
#r @"C:\ws\ReferenceAssemblies\Solver30\Microsoft.Solver.Foundation.dll" | |
#load @"C:\Users\Fai\Documents\Microsoft Solver Foundation\Samples\FSharp\SfsMeasures\SfsWrapper.fs" | |
;; | |
open Microsoft.SolverFoundation.Services | |
open Microsoft.SolverFoundation.SfsWrapper | |
;; | |
let sudokuPuzzle = | |
//9x9 matrix as list of 81 cells | |
//use 0 for blank cell | |
[0; 5; 0; 4; 8; 1; 0; 9; 0; | |
8; 0; 0; 0; 0; 0; 0; 0; 2; | |
0; 0; 1; 0; 0; 0; 7; 0; 0; | |
3; 2; 0; 9; 0; 5; 0; 1; 6; | |
0; 0; 0; 0; 3; 0; 0; 0; 0; | |
6; 8; 0; 2; 0; 7; 0; 3; 5; | |
0; 0; 3; 0; 0; 0; 4; 0; 0; | |
5; 0; 0; 0; 0; 0; 0; 0; 1; | |
0; 7; 0; 3; 2; 4; 0; 6; 0] | |
//create model | |
let ctx = SolverContext.GetContext() | |
ctx.ClearModel() | |
let mdl = SfsModel(ctx) | |
//map puzzle cells to model terms | |
let p2 = | |
sudokuPuzzle |> List.map(fun cell -> | |
match cell with | |
| 0 -> mdl.CreateIntRangeVariable(1, 9) :> SfsIntTerm<1> //variable term if 0 | |
| x when x >= 1 && x <= 9 -> mdl.CreateIntConstant(cell) //constant term otherwise | |
| _ -> failwith "cell values should be 0 to 9") | |
//we bin each cell 3 ways; the row, col and group it belongs to | |
let binnedCells = p2 |> List.mapi (fun i cell -> | |
let row = i / 9 | |
let col = i % 9 | |
let group = (row / 3, col / 3) | |
(row, col, group, cell)) | |
//function to add 'all different' constraints for each group | |
//(the grouping function is provided as input) | |
let addConstraints groupByFunction aList = | |
//function to extract just the cell term from a tuple | |
let f2 = fun (row,col,group,cell:SfsIntTerm<1>) -> cell | |
aList | |
|> Seq.groupBy groupByFunction | |
|> Seq.map (fun (_,xs) -> xs |> Seq.map f2 |> Seq.toArray |> mdl.AllDifferent) | |
|> Seq.toArray | |
|> mdl.AddConstraints | |
//for each row, col and group we add the 'all different' constraints | |
let rowConstraints = binnedCells |> addConstraints (fun (row,_,_,_) -> row) | |
let colConstrains = binnedCells |> addConstraints (fun (_,col,_,_) -> col) | |
let groupConstraints = binnedCells |> addConstraints (fun (_,_,group,_) -> group) | |
;; | |
let sol = mdl.Solve(SolverDirectives.ConstraintProgramming) | |
if sol.Quality = SolverQuality.Feasible then | |
printfn "Solution found:" | |
printfn "%A" p2 | |
else | |
printfn "No solution found" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment