298 lines
11 KiB
Plaintext
298 lines
11 KiB
Plaintext
|
|
---
|
|
layout: post
|
|
title: "Sudoku and Haskell: A Sudoku Solver"
|
|
date: 2013-03-09 23:35
|
|
comments: true
|
|
categories: programming haskell sudoku
|
|
published: false
|
|
---
|
|
|
|
Sudoku a popular number placement puzzle. It is played on a 9 by 9 grid where the objective is to
|
|
fill each cell in the grid with digits from 1 to 9 such that each column, each row and each 3 by 3
|
|
sub-grids (called blocks) have every digit from 1 to 9. The puzzle starts with some cells pre-filled
|
|
and the player has to fill the rest to reach the solution. Since each unit (column, row or block) has
|
|
9 cells and has to be filled with all 9 digits - 1 to 9 - there cannot be any duplicates in a unit.
|
|
|
|
{% img https://upload.wikimedia.org/wikipedia/commons/thumb/f/ff/Sudoku-by-L2G-20050714.svg/250px-Sudoku-by-L2G-20050714.svg.png 200 A typical Sudoku puzzle %}
|
|
{% img https://upload.wikimedia.org/wikipedia/commons/thumb/3/31/Sudoku-by-L2G-20050714_solution.svg/250px-Sudoku-by-L2G-20050714_solution.svg.png 200 The same puzzle with solution numbers marked in red %}
|
|
|
|
In this post we look at how to solve a Sudoku with Haskell.
|
|
|
|
<!-- more -->
|
|
|
|
The code in this post has dependencies on the [`split`][1] package from Hackage.
|
|
|
|
> {-# LANGUAGE BangPatterns, RecordWildCards #-}
|
|
>
|
|
> module Sudoku where
|
|
>
|
|
> import qualified Data.Set as S
|
|
> import qualified Data.Map as M
|
|
> import Data.Char (digitToInt, intToDigit)
|
|
> import Data.List (foldl', intersperse, intercalate)
|
|
> import Data.List.Split (chunksOf)
|
|
> import Data.Map ((!))
|
|
> import Control.Monad (foldM, guard)
|
|
|
|
|
|
Basic setup
|
|
-----------
|
|
|
|
Now that the imports are out of the way let's setup the basic functionalities.
|
|
|
|
> data Digit = ONE | TWO | TRE | FOR | FIV | SIX | SVN | EGT | NIN
|
|
> deriving (Eq, Ord, Enum)
|
|
>
|
|
> instance Show Digit where
|
|
> show digit = show $ fromEnum digit + 1
|
|
>
|
|
> allDigits = S.fromList [ONE .. NIN]
|
|
>
|
|
> data Cell = Cell { cellIdx :: Int, cellVals :: S.Set Digit }
|
|
> deriving (Eq)
|
|
>
|
|
> instance Show Cell where
|
|
> show Cell{..} = "<" ++ show cellIdx ++ " " ++ show (S.toList cellVals) ++">"
|
|
>
|
|
> type Board = M.Map Int Cell
|
|
>
|
|
> emptyBoard :: Board
|
|
> emptyBoard = foldl' (\m i -> M.insert i (Cell i allDigits) m)
|
|
> M.empty [0 .. 80]
|
|
|
|
A `Digit` is just one of the nine possible values. It derives `Eq`, `Ord` and `Enum`. We use the
|
|
fact the `Digit` is enumerable to create a custom `Show` instance which is just the `Digit`'s ordinal
|
|
plus one so that `show ONE` gives "1".
|
|
|
|
A `Cell` has an index `cellIdx` and a set of possible digit values `cellVals`. The cell index is a
|
|
number between 0 to 80 inclusive. The cell values denote the possible values the cell holds
|
|
without violating the rules of Sudoku. If a cell is filled, it holds only one value. We create a
|
|
custom `Show` instance of `Cell` to pretty print it.
|
|
|
|
A `Board` is just a map from the cell index to the corresponding cell for faster lookups than a
|
|
simple list of `Cell`s.
|
|
|
|
`emptyBoard` creates an empty board, with all the cells, unfilled by folding over all the
|
|
index list and inserting a cell with all possible digits in the map corresponding to each index.
|
|
|
|
Reading and printing the Sudoku
|
|
-------------------------------
|
|
|
|
Next let's write some functions to read a Sudoku board from a string and to print a board so that we
|
|
can start playing with the actual examples. The board is represented as a single line with one
|
|
digit for each cell if it is filled otherwise a dot `.`. The cells are read row first, left to
|
|
right column. An example:
|
|
|
|
<pre>
|
|
6..3.2....4.....1..........7.26............543.........8.15........4.2........7..
|
|
</pre>
|
|
|
|
> readBoard :: String -> Maybe Board
|
|
> readBoard str = do
|
|
> guard $ length str == 81
|
|
> foldM (\board (i, chr) -> do
|
|
> guard $ chr == '.' || (chr `S.member` S.fromList ['1' .. '9'])
|
|
> let cellVals = if chr == '.'
|
|
> then allDigits
|
|
> else S.singleton $ toEnum $ digitToInt chr - 1
|
|
> return $ M.insert i (Cell i cellVals) board)
|
|
> emptyBoard
|
|
> $ zip [0 .. 80 ] str
|
|
|
|
`readBoard` converts a string to a `Board`. It returns `Just Board` if the string represents a valid
|
|
Sudoku board, otherwise it returns `Nothing`. We use the `Monad` nature of `Maybe` to guard against the
|
|
possible failures. The guards fail if the string length is not exactly 81 or if it contains characters
|
|
other than 1 to 9 and `.`. The cells in the board returned have exactly one cell value if the
|
|
string contained a digit at the cell index else they have all the digits as cell values.
|
|
|
|
> showBoard :: Board -> String
|
|
> showBoard =
|
|
> map (\Cell{..} ->
|
|
> if S.size cellVals == 1
|
|
> then intToDigit . (+ 1) . fromEnum . head . S.toList $ cellVals
|
|
> else '.')
|
|
> . M.elems
|
|
>
|
|
> asciiShowBoard :: Board -> String
|
|
> asciiShowBoard =
|
|
> (\t -> border ++ "\n" ++ t ++ border ++ "\n")
|
|
> . unlines . intercalate [border] . chunksOf 3
|
|
> . map ((\r -> "| " ++ r ++ " |")
|
|
> . intercalate " | " . map (intersperse ' ') . chunksOf 3)
|
|
> . chunksOf 9
|
|
> . showBoard
|
|
> where border = "+-------+-------+-------+"
|
|
|
|
`showBoard` does the reverse of `readBoard`. It takes a board and creates a valid string
|
|
representation of it. It does so by mapping over each cell of the board in the order of their index
|
|
and outputting the digit if the cell is filled else `.`.
|
|
|
|
`asciiShowBoard` converts a board to an ASCII graphic Sudoku board like we are used to see. It does
|
|
so by taking the output of `showBoard`, breaking it into chunks corresponding to rows and blocks,
|
|
inserting spaces and `|` at appropriate places and then joining them with the borders made of `-`.
|
|
|
|
Here is an example run in _ghci_:
|
|
|
|
<pre>
|
|
*Sudoku> let boardStr = "6..3.2....4.....1..........7.26............543.........8.15........4.2........7.."
|
|
*Sudoku> let (Just board) = readBoard boardStr
|
|
*Sudoku> showBoard board
|
|
"6..3.2....4.....1..........7.26............543.........8.15........4.2........7.."
|
|
*Sudoku> putStr (asciiShowBoard board)
|
|
+-------+-------+-------+
|
|
| 6 . . | 3 . 2 | . . . |
|
|
| . 4 . | . . . | . 1 . |
|
|
| . . . | . . . | . . . |
|
|
+-------+-------+-------+
|
|
| 7 . 2 | 6 . . | . . . |
|
|
| . . . | . . . | . 5 4 |
|
|
| 3 . . | . . . | . . . |
|
|
+-------+-------+-------+
|
|
| . 8 . | 1 5 . | . . . |
|
|
| . . . | . 4 . | 2 . . |
|
|
| . . . | . . . | 7 . . |
|
|
+-------+-------+-------+
|
|
</pre>
|
|
|
|
Is it solved yet?
|
|
--------------------
|
|
|
|
Before we proceed to write a full-fledged Sudoku solver, it is good to have a function which tells us
|
|
whether a board is filled completely and whether that solution is a valid one.
|
|
|
|
> data BoardState = SOLVED | INCOMPLETE | INVALID
|
|
> deriving (Eq, Show)
|
|
>
|
|
> boardState :: Board -> BoardState
|
|
> boardState board
|
|
> | any (\Cell{..} -> S.size cellVals /= 1) $ M.elems board = INCOMPLETE
|
|
> | any isUnitInvalid units = INVALID
|
|
> | otherwise = SOLVED
|
|
> where
|
|
> isUnitInvalid unitCells =
|
|
> (S.fromList . map (head . S.toList . cellVals) $ unitCells) /= allDigits
|
|
>
|
|
> units = map (map (board !)) unitIxs
|
|
>
|
|
> unitIxs = rowIxs ++ columnIxs ++ blockIxs
|
|
> rowIxs = map (\i -> [i * 9 .. i * 9 + 8]) [0..8]
|
|
> columnIxs = map (\i -> take 9 [i, i + 9 ..]) [0..8]
|
|
> blockIxs =
|
|
> concatMap (\(row1:row2:row3:_) ->
|
|
> zipWith3 (\blockRow1 blockRow2 blockRow3 ->
|
|
> blockRow1 ++ blockRow2 ++ blockRow3)
|
|
> row1 row2 row3)
|
|
> . chunksOf 3 . map (chunksOf 3) $ rowIxs
|
|
|
|
We start by defining the board state as an enumeration of three value corresponding to the solved,
|
|
incomplete and invalid states. The `boardState` function takes a board and gives its current state.
|
|
It does so by checking three conditions:
|
|
|
|
1. if any cell in the board does not have only one possible value then the board is incomplete
|
|
2. if any unit of the board is invalid then the solution is invalid
|
|
3. else the board is solved
|
|
|
|
To find if an unit is invalid, we take all the cells of the unit and check if they have all the digits
|
|
in between them as per the rules of Sudoku.
|
|
|
|
Units are found just by looking up the indexes from the board for each unit. Unit indexes are all the
|
|
row, column and block indexes taken together. Row and column indexes can be obtained from the simple
|
|
mathematical formulas. Block indexes are a little trickier to get. It involves taking the row indexes,
|
|
splitting each row into chunks of three columns, then taking three rows at a time and mapping and
|
|
concatenating them with a function which zips three rows at a time creating the block indexes.
|
|
|
|
A run in _ghci_ shows the indexes to be correct:
|
|
|
|
<pre>
|
|
*Sudoku> mapM_ print rowIxs
|
|
[0,1,2,3,4,5,6,7,8]
|
|
[9,10,11,12,13,14,15,16,17]
|
|
[18,19,20,21,22,23,24,25,26]
|
|
[27,28,29,30,31,32,33,34,35]
|
|
[36,37,38,39,40,41,42,43,44]
|
|
[45,46,47,48,49,50,51,52,53]
|
|
[54,55,56,57,58,59,60,61,62]
|
|
[63,64,65,66,67,68,69,70,71]
|
|
[72,73,74,75,76,77,78,79,80]
|
|
|
|
*Sudoku> mapM_ print columnIxs
|
|
[0,9,18,27,36,45,54,63,72]
|
|
[1,10,19,28,37,46,55,64,73]
|
|
[2,11,20,29,38,47,56,65,74]
|
|
[3,12,21,30,39,48,57,66,75]
|
|
[4,13,22,31,40,49,58,67,76]
|
|
[5,14,23,32,41,50,59,68,77]
|
|
[6,15,24,33,42,51,60,69,78]
|
|
[7,16,25,34,43,52,61,70,79]
|
|
[8,17,26,35,44,53,62,71,80]
|
|
|
|
*Sudoku> mapM_ print blockIxs
|
|
[0,1,2,9,10,11,18,19,20]
|
|
[3,4,5,12,13,14,21,22,23]
|
|
[6,7,8,15,16,17,24,25,26]
|
|
[27,28,29,36,37,38,45,46,47]
|
|
[30,31,32,39,40,41,48,49,50]
|
|
[33,34,35,42,43,44,51,52,53]
|
|
[54,55,56,63,64,65,72,73,74]
|
|
[57,58,59,66,67,68,75,76,77]
|
|
[60,61,62,69,70,71,78,79,80]
|
|
</pre>
|
|
|
|
See how the row indexes follow the grid indexes as we have taken our grid indexes to be rows first,
|
|
left to right. If we take row indexes column-wise we get the column indexes. If we take the row
|
|
indexes block-wise we get the block indexes.
|
|
|
|
Let's do a few sample runs of `boardState` in _ghci_:
|
|
|
|
<pre>
|
|
*Sudoku> let (Just board) = readBoard "483921657967345821251876493548132976729564138136798245372689514814253769695417382"
|
|
*Sudoku> putStr (asciiShowBoard board)
|
|
+-------+-------+-------+
|
|
| 4 8 3 | 9 2 1 | 6 5 7 |
|
|
| 9 6 7 | 3 4 5 | 8 2 1 |
|
|
| 2 5 1 | 8 7 6 | 4 9 3 |
|
|
+-------+-------+-------+
|
|
| 5 4 8 | 1 3 2 | 9 7 6 |
|
|
| 7 2 9 | 5 6 4 | 1 3 8 |
|
|
| 1 3 6 | 7 9 8 | 2 4 5 |
|
|
+-------+-------+-------+
|
|
| 3 7 2 | 6 8 9 | 5 1 4 |
|
|
| 8 1 4 | 2 5 3 | 7 6 9 |
|
|
| 6 9 5 | 4 1 7 | 3 8 2 |
|
|
+-------+-------+-------+
|
|
*Sudoku> boardState board
|
|
SOLVED
|
|
*Sudoku> let (Just board) = readBoard "48392165796734582125187649354813297672956413.136798245372689514814253769695417382"
|
|
*Sudoku> boardState board
|
|
INCOMPLETE
|
|
*Sudoku> let (Just board) = readBoard "183921657967345821251876493548132976729564138136798245372689514814253769695417382"
|
|
*Sudoku> boardState board
|
|
INVALID
|
|
</pre>
|
|
|
|
That seems to be working. Now let's move on to actually solving the Sudoku!
|
|
|
|
Backtracking search
|
|
-------------------
|
|
|
|
Constraint propagation
|
|
----------------------
|
|
|
|
The finale
|
|
----------
|
|
|
|
What's next
|
|
-----------
|
|
|
|
Get the code
|
|
------------
|
|
|
|
This post can be downloaded as a compilable Literate Haskell file [here][2]. The Haskell code in the
|
|
post can be downloaded [here][3] or can be forked [here][4].
|
|
|
|
[1]: http://hackage.haskell.org/package/split
|
|
[2]: /downloads/code/sudoku1.lhs
|
|
[3]: /downloads/code/sudoku1.hs
|
|
[4]: https://github.com/abhin4v/abhin4v.github.com/blob/source/source/downloads/code/sudoku1.hs
|