My original plan for this post was to try to prove rigorously the correctness of the sorts I wrote. I decided to change gears though and attempt to write something slightly non-trivial in Haskell: a Sudoku solver.
I think I play Sudoku pretty much the same way most amateurs do. I scan the board. In each square I write down that square’s possible values, then I look for any totally constrained squares and fill them in. If there aren’t squares that are totally constrained, I guess at one of the squares and try to play the board with that constraint in place. If I paint myself into a corner I restore the board to the configuration before I guessed and try again.
Fundamentally, this is a backtracking search. The work you do is proportional to the number of bad guesses you make, so it pays to make as few bad guesses as possible. With that in mind, when you guess you should guess on the square that has the fewest possibilities since that maximizes the probability that you guess correctly.
Onto Haskell code. I modeled the board as a list of Squares
data Square = Square { pos :: (Int,Int),
val :: Char,
possibles :: [Char] } deriving (Eq,Show)
instance Ord Square where
compare a b | val a /= '.' && val b /= '.' = EQ
compare a _ | val a /= '.' = GT
compare _ b | val b /= '.' = LT
compare a b = compare (length $ possibles a) (length $ possibles b)
type Board = [Square]
So each square knows its position on the board, its current value ‘1..9’ with ‘.’ filling in as a blank, and (assuming it’s currently blank) its possible values. I defined the Ord instance for Square so that squares with no set values are ordered by the number of possible values. That way minimum Board returns the blank square with the fewest possible values. I don’t really need the first compare definition, but it makes Square totally ordered which is a stated prerequisite for declaring an instance of Ord.
A lot of the rest of this is easy helper functions.
sudokuAdj :: (Int,Int) -> (Int, Int) -> Bool
constrain :: Square -> Square -> Square
conflict :: Square -> Square -> Bool
The function sudokuAdj takes two position tuples and returns True if those two squares share a row or column or block. The function constrain checks if the first argument imposes a constraint on the second and if so returns the second with the appropriate value removed from its possibilities. The function conflict checks if two squares have the same filled in value and are sudokuAdj, that is these two squares indicate an inconsistent board.
A board is read in as a single string where the entries are read in row-major order. On input each entry is initialized so that each square’s list of possibilities is [‘1’..’9′].
readBoard :: String -> Board
readBoard str = [Square (x,y) z ['1'..'9'] |
((x,y),z) <- zip [(x,y) | x <- [0..8], y <- [0..8]] str]
The zip takes each element and zips it with its position tuple, this list then gets fed to the Square constructor to build the board.
Once the board is read you need to fill in the constraints. I thought I had a pretty clever way of doing this. I map the constrain function over each board element creating a list of [Square -> Square]. Each of these functions takes a square and imposes the constraints on it. Now, to constrain a particular square, I need to apply each function in this list, in turn, and return the final fully constrained square. This is accomplished with a fold. Lastly I need to do this whole procedure for each board element, which is accomplished by mapping this fold over the board.
constrainBoard :: [Square] -> [Square]
constrainBoard board = map (\c ->
foldl (\val fun -> fun val)
c (map constrain board)) board
I’m sure this kind of thing is old hat to seasoned Haskell programmers, but I really got a kick out of it. I wasn’t crazy about the lambda inside the fold (\val fun -> fun val). There HAS to be a more concise way of writing that but I don’t know it yet, and didn’t feel like looking it up.
Two more helpers boardFinished and boardInvalid help out in the final routine.
boardFinished :: [Square] -> Bool
boardFinished = not . any (\sq -> val sq == '.')
boardInvalid :: [Square] -> Bool
boardInvalid board = (or [conflict x y | x <- board, y pos x])
|| any (\x -> val x == '.' && possibles x == []) board
Now, for the meat. Given a board, Sudoku board checks if the board is invalid or finished. In either case it returns it. If it’s neither of those things, it finds the most constrained square and pops the head of its possibilities list and puts it as its value. It then recursively tries to play Sudoku with that new board. If that succeeds, we’re done, otherwise we reset the value of that square to ‘.’ and proceed to try the next possible value for that square.
sudoku :: [Square] -> [Square]
sudoku board
| boardFinished board || boardInvalid board = board
| otherwise = let y = minimum board
z = head $ possibles y
tryWithConstraint =
sudoku $
(Square (pos y) z (tail $ possibles y)):(filter (/=y) board)
in
if (boardFinished $ constrainBoard $ tryWithConstraint) &&
(not $ boardInvalid $ constrainBoard $ tryWithConstraint)
then tryWithConstraint
else sudoku $ constrainBoard $
(Square (pos y) (val y) (tail $ possibles y)):(filter (/=y) board)
The full code is posted here. Here’s a trial run from an “evil” Sudoku.
_@Tycho ~/workspace/Haskell $ echo "...6.....96...1824..1...6.3.1..56..8.........5..42..1.2.6...3..3849...75.....7..." | ./sudoku
["842693751","963571824","751284693","419756238","628319547","537428916","276145389","384962175","195837462"]
It returns more or less instantaneously for the problems I’ve tried it on. So that’s cool.
Observations
I wrote this last night, and had a good time doing it. I thought about it today though and wasn’t entirely thrilled. The main Sudoku function feels very procedural and hammy. I thought there had to be some higher level way of thinking about the problem.
Specifically, today I was thinking about how to parallelize this. Each branch of the search should be able to execute in parallel. Then I realized that fundamentally what’s going on at each level of the tree is a map over the set of possibilities for the chosen square. This could be configured to return a list of [Maybe Board] with Nothings corresponding to fruitless searches. At time of writing I started to try to write this but I couldn’t get the types to shake out right. I’m sure there’s a much more elegant solution somewhere down that road though. It also sounds like a good excuse to get into parallel programming with Haskell.
Teaching myself Haskell 