First sixty days of Haskell.

In a nutshell sudoku puzzle consists on a $9 \times 9$ grid of cells. Some cells contain numbers between 1 and 9 but most of them are empty. The player's mission, shall he choose to accept it, is to complete the empty cells with numbers between 1 and 9 such that: Every row contains every digit; same for columns and $3 \times 3$ box. A complete description of the Sudoku puzzle can be found here.

To represent the progress of the game I will use moves. A move is writing a digit into a cell. For example: write "1" in the column "2" of row "3". Here is the haskell definition:

data Move = Move
  { moveRow :: Int
  , moveCol :: Int
  , moveNumer :: Int } deriving Show

So Move 1 2 3 represents: "in the square at column 2 and row 1 write 3".

An empty sudoku, one with all of its cells empty, is a sudoku where all moves are possible. Filling one of the cells eliminates several possible moves. For example, writing a "1" in a row eliminates the possibility of writing a "1" in other cells of the same row.

So instead of representing the state of the puzzle by the moves I've already made. I'll represent it by all possible remaining moves.

base :: Int
base = 3

size :: Int
size = base*base --*

allMoves :: [Move]
allMoves = Move <$> [1..size] <*> [1..size] <*> [1..size]

Using this representation the solved sudoku is one where there no more moves left to perform. However, having no more legals moves to perform doesn't mean that there are not empty cells left. Solving the puzzle is extracting moves from the list in such a way that when there are no more moves left all the cells are filled.

Performing a move means taking a move from the current state and eliminating all those moves that have are now illegal.

makeMove :: Move -> [Move]  -> [Move]
makeMove m =
  enforceRowRule m . enforceColRule m . enforceAreaRule m . enforceOneValuePerCell m

Each rule can be enforced in its own function for example this is the function for "only one value per cell:"

enforceOneValuePerCell :: Move -> [Move] -> [Move]
enforceOneValuePerCell (Move cx cy _) = 
  filter select 
  where
  select (Move x y _) = not (x==cx && y==cy)

Let's see how this works for the case of performing Move 1 1 1:

*Main> take 2 allMoves 
[Move {moveRow = 1, moveCol = 1, moveNumer = 1},Move {moveRow = 1, moveCol = 1, moveNumer = 2}]
*Main> take 2 $ makeMove (Move 1 1 1) allMoves 
[Move {moveRow = 1, moveCol = 2, moveNumer = 2},Move {moveRow = 1, moveCol = 2, moveNumer = 3}]

There is still the issue of whether the move to be performed is a valid move in the current state of the puzzle. But it is easy to create a function that performs that check before performing the move:

secure :: (Move -> [Move] -> [Move]) -> Move -> [Move] -> Maybe [Move]
secure rule move state
  | move `elem` state = Just $ rule move state
  | otherwise = Nothing

Here is the result of attempting an invalid move(write two "1" next to each other):

*Main> secure makeMove (Move 1 1 1) allMoves >>= secure makeMove (Move 1 2 1)
Nothing

Now onto how to obtain a solution. The basic idea behind this solution is depth first search DFS. DFS is a way searching a graph where you go through the edges a deep as deep as you can and then backtrack to try other paths. In terms of solving the sudoku puzzle, this means completing the as many cells as you can before running out of possible moves.

If there are no more moves and all cells have a digit then the puzzle is solved.

There are two customizations to be made to vanilla DFS for this puzzle. The first is that, when choosing the cell to fill next, it will choose the cell with possible completions available. This allows the algorithm to find dead ends sooner. The second customization is that it will start backtracking the moment there is at least a cell with no possible completions.

solve :: [Move] -> Maybe [Move]
solve moves =
  makeMoves moves >>= solution
  where
  solution = go moves (size*size-length moves) 
  go mvs 0 [] = Just mvs 
  go _ _ [] = Nothing 
  go mvs missing (m:ms) =
    if solvable
      then case next of
        Just n -> Just n
        Nothing ->
        go mvs missing (sortByOptions ms)
      else
        Nothing
    where
    next = go (m:mvs) (missing-1) (sortByOptions (makeMove m ms))
    solvable = all hasOptions allPositions
    hasOptions (a,b) =
      or $ (\(Move c d _) -> (a==c) && (b==d)) <$> (m:mvs ++ ms)
    allPositions = (,) <$> [1..size] <*> [1..size]

The solve function returns the list of moves that solve the puzzle when there is such a list. Its argument is a list of all the moves provided as clues.

Final remarks

Representing a sudoku puzzle by all the available moves (in a list [Move]). Led to represent the application of "sudoku laws" as functions [Move] -> [Move] labeled by a selected move.

This, in turn, showed how the possible solutions could be seen as nodes in a graph where the edges relating two nodes is "performing a move" on the source node.

Once this interpretation is clear, searching for the solution using a DFS seems natural.

I consider now that the essence of the problem is graph search, but I find the consequences of the choose of the representation of the nodes ([Move] in this case) rather interesting.

In my code, I ask for a list of moves that leads to a solved sudoku. The intermediate results, the nodes, also contain the possible moves onwards. I considered representing this intermediate states as $9 \times 9$ matrices. That would have been grounded on the fact that the end result, after I find all the moves, is constructing such a representation.

Transforming from the [Move] representation to a $9 \times 9$ matrix representation is easier than transforming from $9 \times 9$ matrix to [Move]. Even more so, when you only do it at once at the end.

Using the $9 \times 9$ would have implied, for every step of DFS, to make the transformation to [Move], choose a move and then move to the next node rebuilding a $9 \times 9$ representation by adding a number in the correct cell.

Knowing how thinks work out using [Move], it is clear that this representation switching is unnecessary and consist on undoing what was just done before. But if I wouldn't have known about [Move] then I would probably not have noticed the problem.

Appendix I

To understand the allMoves definition you can use GHCi to inspect the types:

*Main> :t  (<$>)
(<$>) :: Functor f => (a -> b) -> f a -> f b
*Main> :t  (<*>)
(<*>) :: Applicative f => f (a -> b) -> f a -> f b
*Main> :t Move
Move :: Int -> Int -> Int -> Move
*Main> :t (Move <$> [1..size])
(Move <$> [1..size]) :: [Int -> Int -> Move]
*Main> :t (Move <$> [1..size] <*> [1..size]) 
(Move <$> [1..size] <*> [1..size]) :: [Int -> Move]
*Main> :t (Move <$> [1..size] <*> [1..size] <*> [1..size]) 
(Move <$> [1..size] <*> [1..size] <*> [1..size]) :: [Move]
*Main>