
Sudoku
Posted
Friday, December 26th 2014 in
Programming 
Permalink
Update: an actual solution can be found here.
For my newest programming exercise, I decided to try writing a Sudoku solver in Haskell. Sudoku is a simple number game which can be quite difficult to solve.
I wrote the program in two basic parts. The first part is to create a list of guesses that contains all possible permutations of the game board containing the given starting hints. The second part determines if each of these guesses satisfies the rules of the game or not.
The first part of the code was relatively simple to get going. The Haskell library Data.List contains the permutations function, which gives a list of all permutations of a list. I began by using this directly, which lead to quicklyincreasing calculation complexity. For example, a 4×4 Sudoku board has
16! = 20,922,789,888,000
possible games. However, since each number is used more than once in a Sudoku board, these permutations will contain duplicates. After some research, I decided I need to do it a little smarter than just simply traversing all possible permutations. This included looking at games that didn’t even satisfy the starting hints, wasting a lot of time.
I first wrote some code that will determine which numbers we have left to guess with after considering the starting hints. Then we can start filling in boards using this reduced set of numbers. This did reduce the work a little, but not considerably. So the next idea was to try to reduce the redundant permutations that the permutation generator created. Luckily for me, I found some unattributed code online that did exactly this, saving me a lot of computation and programming time. This code is located in the UniquePerms module in the project. For example, using this function revealed that the number of actual unique 4×4 Sudoku boards is 2,018,016. This is a huge increase in efficiency!
The function that creates all permutations of the Sudoku board, with the given starting hints:
allPossibleBoards :: [Int] > [[Int]]
allPossibleBoards theBoard =
[fillZeroes theBoard x  x < uniquePerms remainingValues]
where
bw = boardWidth theBoard
remainingValues =
sort ((take (bw * bw) $ cycle [1..bw]) \\ (filter (\x > x /= 0) theBoard))
fillZeroes [] _ = []
fillZeroes (x:xs) values
 x == 0
= (head values) : (fillZeroes xs $ tail values)
 otherwise
= x : (fillZeroes xs values)
The Sudoku boards are specified by a simple flat list of integers. The allPossibleBoards function takes a board and returns all possible permutations of the remaining numbers that can be played in all open spaces. The code works by taking the list of all available numbers and reducing it by removing the starting numbers on the board. For example, a 4×4 Sudoku board has the following list of numbers that can be used to fill it in:
[1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4]
If we are trying to solve the following board,
[0,0,1,0,
2,0,0,3,
0,4,0,0,
0,0,2,0]
then we see we cannot play
[1,2,2,3,4]
This leaves us with the following values we can play:
[1,3,4,1,2,3,4,1,2,3,4]
We now can take all permutations of this, which includes
[4,4,4,4,3,3,3,3,2,2,2,2,1,1,1,1],
[4,4,4,4,3,3,3,3,2,2,2,1,2,1,1,1],
[4,4,4,4,3,3,3,3,2,2,2,1,1,2,1,1],
[4,4,4,4,3,3,3,3,2,2,2,1,1,1,2,1],
[4,4,4,4,3,3,3,3,2,2,2,1,1,1,1,2],
...
and start filling in the zeroes, or blanks spots, in our game board. This will then give us all possible, unique guesses for the solution for this game. The fillZeroes function takes each of these guess permutations and applies it to the game board.
Next, we want to see if each game board is a solution or not. We do this by applying the rules of the game to it. First, we check to see if every row in the game board only contains each number once. We do the same for the columns. Finally, we check to see if the sub quares of the game board contain only one occurrence of each playable number. If all of these conditions are satisfied, then the board is considered a solution.
The function that checks if the board is a solution is:
verifyBoard :: [Int] > Bool
verifyBoard theBoard =
and [verifyHorizontal, verifyVertical, verifySubSquare]
where
bw = boardWidth theBoard
 Check each row, and make sure only one of each valid int
 is there.
verifyHorizontal =
and
[[1..bw] == (sort $ take bw $ drop rowIndex theBoard)
 rowIndex < init [0, bw..bw * bw]]
 Check each column, and make sure only one of each valid int
 is there.
verifyVertical =
and
[[1..bw] == (sort $ [theBoard !! index
 index < init [colIndex,colIndex + bw..colIndex + (bw * bw)]])
 colIndex < init [0..bw]]
 Only boards with a perfect squaredimension can have subsquares.
verifySubSquare
 isPerfectSquare bw
= and
[[1..bw] == (sort $ [theBoard !! index  index < subSquare])
 subSquare < subSquareIndices bw]
 otherwise
= True
subSquareIndices bw =
[sort $ [x + (y * bw)
 x < sort $ init [subSquareIndex, subSquareIndex + 1..subSquareIndex + (intSqRt bw)],
y < sort $ init [0, 1..intSqRt bw]]
 subSquareIndex <
sort $ [x + (y * bw)
 x < init [0,intSqRt bw..bw],
y < init [0,intSqRt bw..bw]]]
You can see each of the checks in the where clause of the function.
When the program is run, you can enter you Sudoku board using Haskell list notation. The solutions are then presented to you:
% ./Main
Enter a board as an integer list:
[0,6,0,5,4,3,0,8,7,0,0,1,0,7,0,0,0,0,4,7,0,0,0,0,0,0,0,3,9,0,2,0,0,8,0,6,1,8,0,7,0,9,0,5,4,6,0,7,0,0,4,0,2,1,0,0,0,0,0,0,0,9,3,0,0,0,0,8,0,2,0,0,7,1,0,9,2,5,0,6,0]
You entered the board:

 _ 6 _  5 4 3  _ 8 7 
 _ _ 1  _ 7 _  _ _ _ 
 4 7 _  _ _ _  _ _ _ 

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

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

Solutions:
As you can tell, there is no solution here because the code did not finish running, even after running for over 150 hours. I had to give up at that point. Theoretically, it should have worked, though. :)
Back to the drawing board, I guess.
