Sudoku: one step at a time

sudoku.md

Prelude

In order to run your program and get some meaningful statistics:

• download this list of Sudoku puzzles
• set up a simple main that will run your sudoku against each line of the file:

main = do
  matrices <- lines <$> getContents
  traverse go matrices
  where go line = let matrix = groupn 9 line in 
                  case sudoku matrix of
                    [] -> putStrLn "No solution"
                    s:_ -> putStrLn (showMatrix s)

showMatrix :: Grid -> String
showMatrix = unlines 
           . intercalate ["---------------------"] 
           . group 
           . map (intersperse ' ' . intercalate "|" . group)

showChoices :: Matrix Choices -> String
showChoices = unlines . map (unwords . map showChoice)
  where showChoice cs = '[' : map showDigit digits ++ "]"
          where showDigit d = if d `elem` cs then d else ' '

• compile your code as follows: ghc --make -O2 Sudoku.hs
• run your code: head -n100 sudoku17.txt | time ./Sudoku

With the optimisations described in these exercises, my version runs in ~70s.

Exercises

Remember our sudoku solver looks like this at this moment:

sudoku :: Grid -> [Grid]
sudoku = filter valid . expand . prune . choices

Its observed behaviour is correct, but it is ridiculously expensive. In these exercises we study the implementation of the following strategy: if we pick one cell with multiple choices and install each choice as a possible matrix of choices, we can then prune each of these matrices, expand another cell, prune, etc. Just realise that prune is not really a safe method: (1) it can filter out all the elements in a cell and produce [], which of course would result in an empty cartesian product; or (2) it can create a singleton list in a row for a digit that already exists in the corresponding column/box. In both cases, the matrix should be thrown away at once. It turns out there are loads of these matrices in the search space, so it will definitely improve the runtime.

In this exercise, you will write:

expand1 :: Matrix [Digit] -> [Matrix [Digit]]

To guide our reasoning, we need an assurance that this function will not change the observed behaviour of sudoku. We can express it with a law:

expand = concat . map expand . expand1

Exercise 1

Let's start with codifying the rules to identify an matrix that cannot make progress. From points 1 and 2 above, we can detect invalid grids with

invalid :: Matrix [Digit] -> Bool

• write a function hasempty that determines whether the grid contains an empty cell
• write a function alluniq that determines whether all singletons are unique within their respective row/col/box
• write invalid

Exercise 2

We move on to finding our candidate cell and installing each choice it contains. Our candidate, let's call it cs will be somewhere in the matrix stuck in a column inside a row which we can express as follows:

g :: Matrix [Digit]
g = rows1 ++ [ cols1 ++ cs:cols2 ] ++ rows2

Say cs = [c0, c1, ..., cn], the result of expand1 will be

[ rows1 ++ [ cols1 ++ [c0]:cols2 ] ++ rows2
, rows1 ++ [ cols1 ++ [c1]:cols2 ] ++ rows2
, ...
, rows1 ++ [ cols1 ++ [cn]:cols2 ] ++ rows2
]

How do you find cs? Obviously, we can't pick an empty list of choices, nor can we pick a singleton! We need to find an cell with at least two choices! Even more than that: we want to limit the amount of work, so that list must be as short as it can be! Got it? So, with that in mind, your exercise it to complete the definition of expand1:

expand1 g = [ rows1 ++ [ cols1 ++ [c]:cols2 ] ++ rows2 | c <- cs ]
  where ???

Exercise 3

With the law defined at the beginning, we derive

filter valid . expand
= { law }
filter valid . concat . map expand . expand1
= { law: filter p . concat = concat . map (filter p) }
concat . map (filter valid . expand) . expand1
= { law: filter valid . expand = filter valid . expand . prune }
concat . map (filter valid . expand . prune) . expand1

Alias filter valid . expand as search, we get

search = concat . map (search . prune) . expand1

👆 this is not a complete definition though! For one, we do not test whether the result is invalid or not. Second, we do not identify the stop condition. How do we know if we have found a solution? Think about that and write the functions

done :: Matrix [Digit] -> Bool
search :: Matrix [Digit] -> [Matrix [Digit]]

So that we can finally update our algorithm to:

sudoku = map (map (map head)) . search . prune . choices

Read the line above multiple times, you should understand what it means before doing this exercise.

A really cool side-effect of this change is that we don't need cp anymore 🎉