A paper and pencil Sudoku algorithm … in Haskell

From pseudo-code to Haskell (Part 2)


Solving Sudoku with paper and pencil

A while back, the American Mathematical Society published a paper by J. F. Crook titled “A Pencil-and-Paper Algorithm for Solving Sudoku Puzzles” that claimed to provide a way to solve any Sudoku puzzle using only paper and pencil.

This is less impressive than it sounds, though, because people were already solving Sudoku puzzles just fine. It’s just that the hard ones would often require the uncomfortable step of taking a blind guess to make further progress. This paper formalizes a neat trick using a concept called the “preemptive set” to make guessing come up less frequently (though you still have to do it for the hardest puzzles).

First we’ll have to up some preliminaries and think about how to model the task of solving a Sudoku puzzle in Haskell. Then we’ll be able to see what this trick is all about. Along the way, we’ll see what it takes to provide for straightforward translations from pseudocode into Haskell.

Name all the things

Sudoku terms

It’ll be useful to first get specific about a few bits of terminology.

A Sudoku board is a 9-by-9 grid of cells, where some cells contain a number and others are left blank. The puzzle is solved when each row, column, and box contains the digits 1 through 9 and every cell contains exactly one digit.

Collectively, instead of saying “rows, columns, and boxes”, we’ll say ranges, so each range must contain the digits 1 through 9.

An important concept in solving these puzzles is that each cell will have a set of numbers that it can potentially contain. This is called the markup of the cell, and as we proceed in solving the puzzle, we will cross out numbers from the markup until every cell has only one number. That remaining number is the solution of that cell.

The board in Haskell

Now let’s think about the types that we can use to represent a Sudoku board. Each cell in the board is either solved with a single number or unsolved with a set of potential solutions. Simple enough:

data Cell = Unsolved !IntSet
          | Solved !Int
          deriving (Eq)

We will give each cell a unique index $(i,j)$, where $i$ is the row and $j$ is the column, and the board itself is a collection of 81 cells associated with their indices $(i,j)$. We’ll just use a Map type to represent this mapping from index to cell.

type Idx = (Int, Int)
newtype Board = Board (Map Idx Cell) deriving (Eq)

There are some very simple functions that we’ll need to implement on these types, but they’re not particularly interesting, so I’ll skip over those details here. You can find the full source code on GitHub.

Marking up the puzzle

The first thing we’ll want to do with our puzzle is to build the markup. That is, to go through the unsolved cells and cross out any numbers that cannot possibly belong in that cell. This is called constraint propagation, and you can actually implement a complete Sudoku solver by combining just this trick with some guessing.

But let’s just think about how we might compute the markup of a puzzle, in words.

Markup Algorithm

  1. Write the numbers 1 – 9 in every unsolved cell.
  2. Look at a solved cell. Let’s say we have the number 5 in cell $(1,1)$.
  3. Cross out 5 from its peer cells, which are all the other cells in its row, column, and box.
  4. Repeat from step 2 for every solved cell.

Sometimes we will create additional solved cells by this algorithm. We could be clever and keep track of the new solved cells so that we make sure to cross out their peers as well. But a simple alternative is to just iterate the markup algorithm a few times until the we run out of numbers to cross out.

This is maybe a completely obvious algorithm, but notice that it has a couple of important properties that we will want to model in Haskell:

  1. It’s stateful. That is, we write on the grid and therefore change it. It would be convoluted to try to write this algorithm without this implicit state.
  2. It can fail if we’re not given a proper Sudoku puzzle. For example, if there are two solved cells in a single column that are both 5, then following our algorithm would result in a cell with no possible numbers in it.

So we need some kind of way to represent a stateful calculation that can fail. This sounds like a job for…

The m-word

A monad! We will use the StateT monad to model stateful computation, and the Maybe monad for the possibility of failure. Let’s call this the BoardState monad. We’ll also need to implement readCell and writeCell inside this monad so that we can implement crossOut.

type BoardState a = StateT Board Maybe a -- Board -> Maybe (a, Board)
readCell :: Idx -> BoardState Cell
writeCell :: Idx -> Maybe Cell -> BoardState ()

Since the implementations of readCell and writeCell are immediate from their types, I’ll just leave the code for the GitHub appendix.

Now we have enough components to implement our first non-trivial function, crossOut, which takes a collection of cell indices and, for each of those cells, deletes some numbers from it, and writes back the updated cell. If you take the previous sentence and add some symbols here and there, you will get this definition:

crossOut ijs values = forM_ ijs $ \ij ->
    readCell ij >>= return . deleteCellValues values >>= writeCell ij

And now we’re ready to implement the markup algorithm:

markup board =
  flip execStateT board $
  forM_ (boardCells board) $ \(ij, cell) -> do
    when (cellIsSolved cell) $ do
      let Solved n = cell
      let peers = filter (/= ij) $ colOf ij ++ rowOf ij ++ boxOf ij
      crossOut peers (IntSet.singleton n)

We want users of markup to not worry (or even know) about the fact that the markup algorithm is expressed in a stateful way, so we will use execStateT inside the function to get the result out of the StateT monad.

Inside the stateful execution, markup looks quite like the algorithm that we stated in words earlier. Conveniently, it operates on an implicit board in the background, so we didn’t need to thread the board state through every function. That would have added a lot of unnecessary repetitiveness and would have obscured the simple core idea of the algorithm. And we didn’t need to make board a global variable to achieve this implicit statefulness.

We also didn’t need to explicitly handle every possible failure state. If at any point we get to an invalid board state by crossing out the last remaining value of a cell, we get a Nothing that just propagates out and the whole markup function will return Nothing.

Best of all, we got this all for free, just by selecting the right monads!

Next time

In the next post, we’ll finally talk about Crook’s neat trick – the preemptive set.

July 4, 2017