
Sudoku, Revisited
Posted
Tuesday, February 17th 2015 in
Programming 
Permalink
My last adventure with trying to solve Sudoku did not go as planned. My naive attempt to compare a starting board to all possible permutations of boards created from the values allowed for the remaining squares turned out to be too much to solve a problem in a reasonable amount of time. I then set about to try again at creating a Sudoku solver. This time, I now attempt to solve the puzzle as any normal human would. For example, consider the following puzzle:
As a normal player would do, we play the game by checking out every square, and we try to figure out all of the possible numbers that could go in that square. Ideally, we would like to find a square that only has one possible value available to it. In this example, we see that we can play 6 in the middle square:
Based on the rules of Sudoku, we infer that the only number that could go into that space is six. To solve the puzzle, we hope that we can simply continue applying this strategy until all empty spaces are filled. However, we could run into a problem as we try to solve the puzzle.
Say that as we are in the middle of solving a puzzle, we run into a situation where no square has a single possible value that it must contain. Perhaps we have a space that could take two possible values, and that is the best thing that we know. Well, to continue solving the game, we would need to try each of these numbers in this square and continue solving the puzzle fully in each case, until we either solve the puzzle or determine that it is unsolvable.
We can outline our solving strategy as follows:
1. For every empty space on the board:
2. Determine the numbers that could fit there legally with what we know so far.
3. If there exists a space that only has one possible number in it,
place that number in that square, then start over at step 1. with
the updated board.
4. Otherwise, take the first empty space that has the least amount of possible
numbers that could legally go in it. Create copies of the board, with
each of them having one of the possible values for this space filled in.
Start over at step 1. with each of these boards.
As you can see, the steps necessary to solve Sudoku are pretty simple. We will emulate this strategy in Haskell. First, let’s begin by defining some data. We will define a simple data structure to hold information for all of the spaces in the board. A space simply has the value in it and its coordinates as an ordered tuple.
data Square = Square
{
value :: Int,
pos :: (Int, Int)
} deriving (Show, Read, Eq)
type Squares = [Square]
Our first problem is to determine the legal values an empty space can contain. We will begin by creating four functions, one of which applies a rule to all of the spaces on the board, and the remaining define the rules for getting spaces that are in the same row, column, or subsquare as a square. Here are the definitions of these functions:
getSquares :: ((Int, Int) > (Int, Int) > Bool) > (Int, Int) > (Squares > Squares)
getSquares f x = filter (\y > f x $ pos y)
byRow :: (Int, Int) > (Int, Int) > Bool
byRow x y = (fst x) == (fst y)
byColumn :: (Int, Int) > (Int, Int) > Bool
byColumn x y = (snd x) == (snd y)
bySubSquare :: (Int, Int) > (Int, Int) > Bool
bySubSquare x y =
(quot ((fst x)  1) 3) == (quot ((fst y)  1) 3)
&& (quot ((snd x)  1) 3) == (quot ((snd y)  1) 3)
getSquares takes one of the rules and the position we are looking at, and it returns a function that gets just the squares we want out of a list containing all the squares of the board. The three rules each define how to get the squares we want.
Now that we can get the squares that we want out of the board, we can determine what values an empty square can have. How I chose to do this is as follows:
1. Get all of the nonempty squares in the same row, column, and subsquare.
2. Get all of the numbers in these squares.
3. Get the unique numbers from the list in step 2.
4. Take the set difference of the list in step 3. and the list of numbers one through nine, [1..9].
In Haskell, the set difference operator is \\ . The function nub returns distinct values in a list. So we can define this process as:
(\\) [1..9] $ nub $ map value $ concat
[getSquares (byRow) (x,y) squares',
getSquares (byColumn) (x,y) squares',
getSquares (bySubSquare) (x,y) squares']
Now that we know what legal values an empty square can have, we can do this for every square. The following code creates a list of tuples. The first part of the tuple contains the position of the square, and the second part of the tuple holds a list of all possible values for that square.
inferences :: Squares > [((Int, Int), [Int])]
inferences squares' =
nub $ sortBy (comparing (length . snd))
[((x,y),
(\\) [1..9] $ nub $ map value $ concat
[getSquares (byRow) (x,y) squares',
getSquares (byColumn) (x,y) squares',
getSquares (bySubSquare) (x,y) squares'])
 x < [1..9], y < [1..9], not $ elem (x,y) filledPos]
where
filledPos = map pos squares'
The output of this function would look something like this for the example game at the beginning of this post:
[((5,6), [6]), ...]
Now, for each game board, we can determine what the valid numbers are that are possible for each empty square, based on the information provided in the board. To play the game, we can simply take the first tuple from the list of tuples returned by inferences . This tuple will give us a position to work on, and all possible numbers that can go in it. We can then create a new game board from each of these values being placed in this square, and continue on recursively. With the following function, we have emulated our solution algorithm from above.
inferSquares :: Squares > [Squares]
inferSquares squares =
concat
[[(Square val $ fst pos') : squares  val < snd $ pos']
 pos' < take 1 $ inferences squares]
where
inferences :: Squares > [((Int, Int), [Int])]
inferences squares' =
nub $ sortBy (comparing (length . snd))
[((x,y),
(\\) [1..9] $ nub $ map value $ concat
[getSquares (byRow) (x,y) squares',
getSquares (byColumn) (x,y) squares',
getSquares (bySubSquare) (x,y) squares'])
 x < [1..9], y < [1..9], not $ elem (x,y) filledPos]
where
filledPos = map pos squares'
inferSquares gives us a list of game boards with a single empty space filled in with each of its legal possibilities. We can now apply recursion to this function to solve a game. The solveSudoku function handles the recursion. It has three end cases: there is a board that has no more possibilities, which implies that it is unsolvable; the board is not valid, so do not continue trying; or that we have 81 filled spaces, a solution.
solveSudoku :: Squares > [Squares]
solveSudoku [] = []
solveSudoku squares
 81 == (length squares)
= [squares]
 not $ verifyBoard squares
= []
 null possibilities
= []
 otherwise
= concat $ map (solveSudoku) possibilities
where
possibilities = inferSquares squares
Our example board from above has been solved by:
ghci> let exampleBoard =
[Square { value = 8, pos = (1,4) },Square { value = 7, pos = (1,8) },
Square { value = 6, pos = (1,9) },Square { value = 3, pos = (2,1) },
Square { value = 5, pos = (2,3) },Square { value = 2, pos = (2,7) },
Square { value = 6, pos = (3,2) },Square { value = 8, pos = (3,3) },
Square { value = 5, pos = (3,4) },Square { value = 4, pos = (3,5) },
Square { value = 3, pos = (3,7) },Square { value = 9, pos = (3,9) },
Square { value = 7, pos = (4,3) },Square { value = 1, pos = (4,6) },
Square { value = 6, pos = (4,7) },Square { value = 1, pos = (5,2) },
Square { value = 2, pos = (5,4) },Square { value = 3, pos = (5,5) },
Square { value = 4, pos = (5,6) },Square { value = 9, pos = (5,8) },
Square { value = 9, pos = (6,3) },Square { value = 7, pos = (6,4) },
Square { value = 1, pos = (6,7) },Square { value = 9, pos = (7,1) },
Square { value = 3, pos = (7,3) },Square { value = 7, pos = (7,5) },
Square { value = 6, pos = (7,6) },Square { value = 4, pos = (7,7) },
Square { value = 5, pos = (7,8) },Square { value = 1, pos = (8,3) },
Square { value = 7, pos = (8,7) },Square { value = 8, pos = (8,9) },
Square { value = 4, pos = (9,1) },Square { value = 7, pos = (9,2) },
Square { value = 8, pos = (9,6) }]
in mapM (putStrLn) . map (printBoard) $ solveSudoku exampleBoard

1 2 4 8 9 3 5 7 6
3 9 5 6 1 7 2 8 4
7 6 8 5 4 2 3 1 9
2 3 7 9 8 1 6 4 5
5 1 6 2 3 4 8 9 7
8 4 9 7 6 5 1 2 3
9 8 3 1 7 6 4 5 2
6 5 1 4 2 9 7 3 8
4 7 2 3 5 8 9 6 1

You can find the entire source code at my WebSVN site.
