F# - Sudoku Solver using search trees Step Six: Solving Sudoku

Post date: Feb 12, 2012 11:45:24 AM

Part one: https://sites.google.com/site/mrmbookmarks/msg/F---Sudoku-Solver-using-search-trees-Step-one-Defining-the-datastructure

Part two: https://sites.google.com/site/mrmbookmarks/msg/F---Sudoku-Solver-using-search-trees-Step-two-The-algorithm

Part Three: https://sites.google.com/site/mrmbookmarks/msg/F---Sudoku-Solver-using-search-trees-Step-Three-Adding-Unit-Tests

Part Four: https://sites.google.com/site/mrmbookmarks/msg/F---Sudoku-Solver-using-search-trees-Step-Four-Adding-more-Unit-Tests

Part Five: https://sites.google.com/site/mrmbookmarks/msg/F---Sudoku-Solver-using-search-trees-Step-Five-Defining-the-data-structure-for-the-complete-problem

Part Six: https://sites.google.com/site/mrmbookmarks/msg/F---Sudoku-Solver-using-search-trees-Step-Six-Solving-Sudoku

Party Seven: https://sites.google.com/site/mrmbookmarks/msg/F---Sudoku-Solver-using-search-trees-Step-Seven-Increasing-performance-using-parallel-tasks

Full Source: http://code.google.com/p/peter-henell-f-sharp-sudoku-solver/source/browse/#git%2FSearchTrees

The biggest change done to solve the complete sudoku problem is to create the data structure with it's supporting functions.

The code in my last post has a few bugs and most of the functions were not implemented fully.

One of the hard parts was to implement the getRegion function of the inner data structure.

As its argument it get a region number (1 to 9 ) and it should return a list of the items in that region.

With the use of some integer division it is possible to calculate the position of the first (top left) cell in a region, and

based on that we can jump to the remaining cells just by addition.

The indexToRCR function could be written in a similar manner but my patience ran out and I more or less

hard coded the mappings between a position and the region it belong to.

In the SudokuNode type we have created a function for creating a new array based on the current array but with

one of the elements replaced by a chosen number.

This function, replaceAt, was more or less stolen from Stackoverflow but modified to fit my much simpler requirements.

See the link in the code for source. I cannot help but think that there should be an easier way however.

The most interesting function in the SudokuNode type is getChildren.

By using the functions getRow, getCol and getRegion (they all return a list of int) we can easily find out what number are valid for

the current spot. We do this by using the fact that Sets will remove any duplicate items.

By starting with all number from 1 to 9 and then removing all the numbers that exists in the row, column and region we then get a set

containing only number that have not yet been taken. I.e a set of valid numbers.

When we have that set of valid numbers we can simply generate a list of valid child nodes by copying

the array and inserting those valid numbers into the chosen spot in the copies.

The Solver type itself have only gone through some cleanup, it is still the same algorithm with no logical difference since the last version.

To test all of this i have (at the bottom of this post) used two sudoku problems taken from the web. One of them is considered easy and the other hard.

The easy problem is solved within seconds and the hard problem is solved in about one minute. This is on my machine, results may vary.

To see all the unit tests i have written to help develop this solution, please go to the google code project page, linked at top of this post.

DataStructure2.fs:

module DataStructure2 type SudokuProblemComplete(board : list<int>) = // Regions // 1; 2; 3 // 4; 5; 6 // 7; 8; 9 member this.getRegion r = let nb n = List.nth board n let r = r - 1 // The starting position for every region let m = (((r / 3) * (3 * 9)) + ((r % 3) * 3)) [ nb m ; nb ( m + 1) ; nb (m + 2) nb (m + 9) ; nb ( m + 1 + 9) ; nb (m + 2 + 9) nb (m + 18) ; nb ( m + 1 + 18) ; nb (m + 2 + 18) ] member this.getRow r = let r = r - 1 [for i in 0..8 -> List.nth board (i + r * 9)] member this.getCol c = let c = c - 1 [for i in 0..8 -> List.nth board (c + i * 9)] member this.printTests = for i in 0..80 do printf "%O ;" (List.nth board i ) if (i + 1) % 9 = 0 then printfn "" printfn "" member this.Board = board member this.findFreeSpot = board |> List.findIndex(fun x -> x = 0) // from index number to Row/Column/region member this.indexToRCR i = let row = (i / 9) + 1 let column = (i % 9) + 1 let region = match column with | 1 | 2 | 3 -> match row with | 1 | 2 | 3 -> 1 | 4 | 5 | 6 -> 4 | 7 | 8 | 9 -> 7 | _ -> failwith "out of bounds" | 4 | 5 | 6 -> match row with | 1 | 2 | 3 -> 2 | 4 | 5 | 6 -> 5 | 7 | 8 | 9 -> 8 | _ -> failwith "out of bounds" | 7 | 8 | 9 -> match row with | 1 | 2 | 3 -> 3 | 4 | 5 | 6 -> 6 | 7 | 8 | 9 -> 9 | _ -> failwith "out of bounds" | _ -> failwith "out of bounds" (row, column, region)type SudokuNode(content : SudokuProblemComplete) = // Based on example from here: http://stackoverflow.com/questions/2889961/f-insert-remove-item-from-list let replaceAt index newEl input = // For each element, we generate a list of elements that should // replace the original one - either singleton list or two elements // for the specified index input |> List.mapi (fun i el -> if i = index then newEl else el) member this.Content = content member this.isGoal = // if all the slots are taken then we are at the goal not (List.exists(fun x -> x = 0) content.Board) member this.getChildren = // find the index of a free spot to place our next number let freeSpot = content.findFreeSpot // get the row, column and region based on that index let (row, column, region) = content.indexToRCR freeSpot // Get all number between 1 and 9 that do not exists in the row nor column nor region let possible = (Set.ofList [1..9]) - Set.ofList( (content.getRow row) @ (content.getCol column) @ (content.getRegion region)) |> Set.toList // Create a new list of sudokuNodes where all the elements are the same except the freeSpot replaced with one of the possible numbers let neww = possible |> List.map(fun x -> new SudokuNode(new SudokuProblemComplete(replaceAt freeSpot x content.Board))) neww // Nodes are equal if their underlying boards (arrays) are the same member this.equalTo (other : SudokuNode) = content.Board = other.Content.Board member this.print = content.printTests

Solver.fs:

module Solver open DataStructure2 exception NoSolutionFound of stringexception SolutionWasFound of SudokuNode type Solver() = // Right now the internalSolve is not really recursive, it is more of a loop. Todo: Figure out a good way of making it use recursion in a smart way member this.solve (root: SudokuNode) = let rec internalSolve (nodesToExamine : List<SudokuNode>) (closedNodes : List<SudokuNode>) = if nodesToExamine.Length = 0 then raise (NoSolutionFound("Could not find solution even after " + closedNodes.Length.ToString() + " tries" )) let node = nodesToExamine.Head // pick up the node we are going to examine if node.isGoal then node.print raise(SolutionWasFound(node)) // Get the children of node and remove nodes that already exist in openNodes or closedNodes let nodes = node.getChildren |> List.filter(fun t -> not (List.exists(fun e -> t.equalTo e ) nodesToExamine )) |> List.filter(fun t -> not (List.exists(fun e -> t.equalTo e ) closedNodes )) // add these nodes to the end of openNodes // add thse to the begining of openNodes to use bredth first search internalSolve (nodes @ nodesToExamine.Tail) (node::closedNodes) internalSolve (root :: []) []

Program.fs:

module Program open DataStructure2 open Solver //We are throwing different kind of exceptions to handle failure and success. //Todo: Do not use exceptions lol let easy = [ 3;0;9;7;0;5;8;0;1; 0;0;2;0;0;0;5;0;0; 0;1;0;0;0;0;0;6;0; 0;0;5;4;0;3;2;0;0; 6;0;0;0;0;0;0;0;7; 0;0;3;8;0;6;1;0;0; 0;4;0;0;0;0;0;2;0; 0;0;7;0;0;0;3;0;0; 2;0;8;1;0;9;6;0;4;]let s = new Solver()try let res = s.solve (new SudokuNode(new SudokuProblemComplete(easy) )) res |> ignore with | :? NoSolutionFound as notFound -> printfn "%O" notFound.Data0 | :? SolutionWasFound as found -> printfn "%O" (found.ToString()) printfn "ok, next"let hard = [ 0;0;5;0;3;4;0;0;0; 0;0;6;7;0;0;3;0;0; 0;0;0;9;0;0;0;7;2; 0;0;2;8;0;0;5;0;3; 0;1;0;0;0;0;0;4;0; 8;0;4;0;0;3;2;0;0; 2;5;0;0;0;8;0;0;0; 0;0;7;0;0;6;1;0;0; 0;0;0;4;9;0;7;0;0;]try let res = s.solve (new SudokuNode(new SudokuProblemComplete(hard) )) res |> ignore with | :? NoSolutionFound as notFound -> printfn "%O" notFound.Data0 | :? SolutionWasFound as found -> printfn "%O" (found.ToString()) System.Console.ReadKey() |> ignore printfn "ok, all done"