# Lecture 21: NState Example: Sudoku

Recall the `Parser` monad, and our sense that it was a mashup of a `State String` monad and a `[]`. This intuition was ultimately rewarded by our discovery that we could define `Parser` as `StateT String []`, understanding parsing objects as non-deterministic state-based functions, realized via the type `String -> [(a,String)]`, and thereby gaining the automatic derivation of instances of the most important Haskell typeclasses for `Parser`. We can further exploit this observation by generalizing the `Parser` type by abstracting out its reliance on `String`:

``` type NState s = StateT s [] ```

With this, a great deal of functionality comes along for free, including the functions `put`, `get`, `state`, and `modify`. We add functions `nstate` and `branch` for building building non-deterministic state-based computations, and provide functions `runNState`, `evalNState` and `execNState` for running non-deterministic computations.

We'll provide an `nstate` function, analogous to `state`, which allows us to convert a non-deterministic state-based function realized as a function of type `s -> [(a,s)]` as `NState s` value, which simply puts the non-deterministic function into a `StateT` box:

``` nstate :: (s -> [(a,s)]) -> NState s a nstate = StateT ```

The `branch` function is interesting, both for what it does, and how it's implemented. The idea behind `branch` is that we'll provide a list, and the computation will non-deterministically select an item from that list:

``` branch :: [a] -> NState s a ```

A naïve implementation uses `nstate`:

``` branch as = nstate \$ \s -> [(a,s) | a <- as] ```

This works, but there is a more sophisticated, but in the end more natural approach. The type of `branch` is a function that takes a value of type `[a]`, i.e., the “inner monad” `[]` applied to a base type `a`, and “lifts” it a value in the transformed monad `StateT s [] a`. This is a very common thing to want to do. When possible, which is almost always, monad transformers belong to the `MonadTrans` type class (defined in `Control.Monad.Trans.Class`), and so define the corresponding `lift` function:

``` class MonadTrans t where lift :: Monad m => m a -> t m a ```

With this, we have a simplified implementation of `branch`:

``` branch :: [a] -> NState s a branch = lift ```

The other functions are just re-namings of the corresponding functions from `Control.Monad.State`, associating them with our specific type. This code, which I expect to reuse, was then packaged as a `cabal` project, installed in the usual way, and is available on github.com. Note the use of `-- ^` to document something after it appears in the source.

## Sudoku

Sudoku is a popular puzzle, based on filling in a 3x3 grid of 3x3 grids, partially filled with the numbers 1, 2,..., 9, e.g.,

 6 9 2 8 8 5 6 9 4 2 3 9 4 4 6 8 3 1 1 7 6 7 3 9 7

The rules to Sudoku are simple: each digit must appear exactly once in each row, column, and bold-edged 3x3 square. Solving Sudokus is not so simple, and writing a Sudoku solver is a common programming exercise, one that we'll do twice in this course, in very different ways, and to very different ends. The traditional approach involves building a data structure that contains a representation of the board, and then for making recursive calls to a solver function on each empty cell, trying every possible way to fill that cell in. That's the basic approach we're going to take here, but because this is Haskell, the punchline to the code is going to be unexpected and breathtakingly succinct.

We'll first define some basic types around which we'll organize the computation:

``` import Data.Map (Map,(!)) import qualified Data.Map as Map type Position = (Int,Int) type Board = Map Position Int type Solver = Board -> [Board] ```

A `Position` indexes a cell on a Sudoku board, in `(row,col)` form, with row and column indices in the range `[1..9]`. A `Board` represents a Sudoku puzzle. Remember that a `Map` is a finite partial function, and as such, we can and will represent a blank cell at a position `p` by not including `p` as a key in the `Map`. Finally, a `Solver` is an algorithm that tries to solve a Sudoku puzzle. Note that it returns a list of results, allowing for the possibility that the particular puzzle we're working on has 0, 1, or a multiplicity of solutions. This type is a good hint that we can approach the problem of solving a Sudoku via non-determinism.

We'll often need the list of valid `Position` values, and so define:

``` positions :: [Position] positions = [(row,col) | row <- [1..9], col <- [1..9]] ```

Of course, the code transformation fairy never sleeps, and realizes that this can be written in a way that eliminates the local variables `row` and `col` within the list comprehension.

``` positions = liftM2 (,) [1..9] [1..9] ```

or better still,

``` positions = (,) <\$> [1..9] <*> [1..9] ```

There are those who think the code transformation fairy needs to get a life. She'd tell you she has one.

The key function in our code is `extend`, a function that takes a position, and tries to non-deterministically extend its state, a `Board`, by defining it at that position:

``` extend :: Position -> NState Board () extend pos = do board <- get val <- branch \$ viable pos board put \$ Map.insert pos val board ```

The computational idea is very simple: we'll get the board (which is the underlying state), branch on the list of distinct ways we can assign value to the indicated cell without creating a conflict, and save the updated state. Note that if there are no `viable` assignments, this call fails in the sense that the returned value packs up the empty list of boards.

To calculate the conflicts, we'll first build `neighbors :: Map Position [Position]`, which will map a position on the board to all of the positions that aren't allowed to hold the same value. Looked at this way, a Sudoku problem amounts to extending a partial 9-coloring of a particular graph to a total 9-coloring.

``` neighbors = Map.fromList [(p,neighborf p) | p <- positions] where neighborf pos = delete pos . nub . concatMap (\$ pos) \$ [rowOf,colOf,blockOf] rowOf (row,col) = map ((,) row) [1..9] colOf (row,col) = map (flip (,) col) [1..9] blockOf (row,col) = [(trunc row + rx,trunc col + cx) | rx <- [1..3], cx <- [1..3]] trunc x = nx - nx `mod` 3 where nx = x-1 ```

The `neighbors` map memoizes the encapsulated function `neighborf`, which we do because even though there are only 81 positions on a Sudoku puzzle, we may need to determine the neighbors of various positions thousands of times as we try different alternatives, and the neighborhood calculation is just a bit intricate. Basically, we build the list of cells (including the argument) that are on the same row, column, and block, concatenating the results, using `nub` to prune duplicates, and `delete` to remove the argument from the resulting list of neighbors. The `nub` function is actually a bit problematic from a complexity-theoretic point of view, as it is quadratic in the length of the input list. In this case, it's going to be called on 27 element lists (3x9) 81 times, and this isn't really worth improving, especially as there are ongoing discussions in the Haskell community as to how to do `nub` better.

Next, we need to implement the `viable` functions that lists the values that we can assign to a particular cell:

``` viable :: Position -> Board -> [Int] viable pos board = candidates \\ conflicts where candidates = case Map.lookup pos board of Just x -> [x] Nothing -> [1..9] conflicts = mapMaybe (`Map.lookup` board) \$ neighbors pos ```

This is a bit tricky. The candidate values for a cell are going to be `[1..9]` if the cell is empty (in which case `Map.lookup pos board` returns `Nothing`), and `x` if the cell contains `x` (in which case `Map.lookup pos board` returns `Just x`). And the values that our cell conflicts with is determined by mapping `(`Map.lookup` board)` across the neighbor list, obtain a list of `Maybe Int`'s, which is then collapsed down via `catMaybes`. Except that `mapMaybe` collapses the calls to `map` and `catMaybes` down into a single call.

Finally, we're ready for the punchline. Our solver can now be written as:

``` backtrack :: Solver backtrack = execNState \$ mapM_ extend positions ```

Yup. We just build a list of `NState` objects each of which tries to extend the board at a single position, and `sequence` our way through that list.

There is a little more (actually more than a little more) code involved in parsing and formatting Sudoku boards, and the final version does a few encapsulations, but now if we have a Sudoku problem in a text file like this:

``` 6 . 9 . 2 . . . 8 . 8 . 5 . 6 . . 9 4 . . . . . . 2 . . . . . . 3 . . . 9 . . . . . . . 4 . . . 4 6 . 8 3 1 . . . . 1 . . 7 6 . . 7 . . . 3 9 . . . . . 7 . . . . ```

We can solve it using this program:

``` \$ ./sudoku < sudoku-1.txt problem: 6 . 9 . 2 . . . 8 . 8 . 5 . 6 . . 9 4 . . . . . . 2 . . . . . . 3 . . . 9 . . . . . . . 4 . . . 4 6 . 8 3 1 . . . . 1 . . 7 6 . . 7 . . . 3 9 . . . . . 7 . . . . solution: 6 3 9 7 2 4 5 1 8 2 8 1 5 3 6 7 4 9 4 7 5 8 9 1 6 2 3 8 1 4 2 5 3 9 6 7 9 6 3 1 8 7 2 5 4 7 5 2 4 6 9 8 3 1 5 9 8 3 1 2 4 7 6 1 2 7 6 4 8 3 9 5 3 4 6 9 7 5 1 8 2 \$ ```

The source for this program (modified so as to not require installing `Control.Monad.NState`), can be found in the following two files:

And here are some files containing Sudoku puzzles in the appropriate format for solution by our `sudoku` program.