Haskell Sudoku Solver - List Monad
In this article we will write a Sudoku solver in Haskell using the expressive and powerful List Monad to enumerate the solutions trasparently. I assume that the reader has a general understanding of monads (if not read http://www.idryman.org/blog/2014/01/23/yet-another-monad-tutorial/)
Su Doku means literally number place is the name of a popular puzzle game that a special case of the old Latin Square (invented by Leonard Euler). Latin Square force each symbol to appear once in each row and column. In addition to these contraint Sudoku force each symbol to apper one in each sub-matrix. In the general case Sudoku is NP-Complete (easy reduction to graph coloring), but certain schemeas can be solved by deduction and logic only (in this case the puzzle is said well constructed).
At high level a Sudoku can be viewed as a list of cell
data Board= Board [Square] deriving(Show)
and a Square must certanly carries information about its position and the digit it contains, or even better it could contain (according to the cells in same row, column and submatrix)
data Square= Square ColDigit RowDigit BoxDigit (Either [Digit] Digit) deriving (Show) type RowDigit= Digit type ColDigit= Digit type BoxDigit= Digit type Digit= Char
While solving the puzzle each square will contains either a list of possible digits that can be placed in the square OR (this is the Either logic) a fixed digit (i.e., the square was given by a clue or has been deduced).
The following Squares have respectively position and
, both lie in submatrix
and
can contain the digit 1 OR 5 OR 7 OR 4 while
is fixed to 6.
let s1=Square '4' '1' '4' (Left ['1','5','7','4']) let s2=Square '4' '2' '4' (Right '6')
The solver works s.t. it return the list of possible solution for a schema (not well constructed Sudoku may have multiple solutions). In particular if no unresolved square are left (the one with the Left in the Ethier part) it means that the board is solved and does not need any further processing, otherwise we take the square with the minimum number of possible values and try solve the board trying, one at the time, all the values for it. This sort of backtracking is perfomed transparently by the List monad that is used to represent nondeterminism (i.e. multiple possibilities).
solveMany :: Board -> [Board] solveMany brd = case getUnsolvedSquare brd of [] -> return brd --all squares correctly set up sqs -> do let selSquare@(Square c r b (Left ds)) : _ = sortBy (byLeftLenght) sqs sq <- [ Square c r b (Right d) | d <- ds ] -- Try all possible moves solveMany (setSquare sq brd)
Recall that do notation is just syntactic sugar for bind (>>=) operator and that for for list it is defined as following
(>>=) :: [a] -> (a->[b]) >[b] xs >>= f = concat (map f xs)
It then applies f=solveMany (that takes a board) and produces [Board] for all the digits in the Left of selSquare.
Here the same function wrote with explicit bind operator application that makes much clear the monadiac operation that do the dirty job for us.
solveMany :: Board -> [Board] solveMany brd = case getUnsolvedSquare brd of [] -> return brd --all squares correctly set up sqs -> let Square c r b (Left ds) : _ = sortBy (byLeftLenght) sqs in [ Square c r b (Right d) | d <- ds ] >>=(\b->solveMany (setSquare b brd)) getUnsolvedSquare :: Board -> [Square] getUnsolvedSquare (Board sqs) = filter (isSolved) sqs where isSolved (Square _ _ _ (Left _)) = True isSolved _ = False
The setSquare function is the one devoted to the constraint propagation and is defined as follow:
setSquare :: Square-> Board ->Board setSquare sq@(Square scol srow sbox (Right d))(Board sqs) = Board (map set sqs) where set osq@(Square ocol orow obox ods) | scol==ocol && srow==orow = sq | scol==ocol || srow==orow || sbox==obox = Square ocol orow obox (checkEither ods) | otherwise = osq checkEither (Left lds ) = Left (lds \\ [d]) checkEither r@(Right d') | d==d' = error "Already set this square" checkEither dd = dd setSquare _ _ = error "Bad call to setSquare"
It places Square (with a Right Digit) on a Board and return the new Board taking care of removing the just inserted digit from the possible values for Squares of the same row, column and submatrix. This is how the constraint are propagated, cutting off the search space.
The complete source code is available here and on github.