Friday, December 26th 2014 in
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 quickly-increasing 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]
bw = boardWidth theBoard
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)
= 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:
If we are trying to solve the following board,
then we see we cannot play
This leaves us with the following values we can play:
We now can take all permutations of this, which includes
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]
bw = boardWidth theBoard
-- Check each row, and make sure only one of each valid int
-- is there.
[[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.
[[1..bw] == (sort $ [theBoard !! index
| index <- init [colIndex,colIndex + bw..colIndex + (bw * bw)]])
| colIndex <- init [0..bw]]
-- Only boards with a perfect square-dimension can have subsquares.
| isPerfectSquare bw
[[1..bw] == (sort $ [theBoard !! index | index <- subSquare])
| subSquare <- subSquareIndices bw]
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:
Enter a board as an integer list:
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 _ |
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.