diff --git a/sass/base/_typography.scss b/sass/base/_typography.scss
index 72218a3..f91ee0a 100644
--- a/sass/base/_typography.scss
+++ b/sass/base/_typography.scss
@@ -78,7 +78,7 @@ strong { font-weight: bold; }
em { font-style: italic; }
-sup, sub { font-size: 0.8em; position: relative; display: inline-block; }
+sup, sub { font-size: 0.7em; position: relative; display: inline-block; }
sup { top: -.5em; }
sub { bottom: -.5em; }
diff --git a/source/_posts/2013-03-11-sudoku-and-haskell-a-sudoku-solver.markdown b/source/_posts/2013-03-11-sudoku-and-haskell-a-sudoku-solver.markdown
index 9567154..562a659 100644
--- a/source/_posts/2013-03-11-sudoku-and-haskell-a-sudoku-solver.markdown
+++ b/source/_posts/2013-03-11-sudoku-and-haskell-a-sudoku-solver.markdown
@@ -22,6 +22,9 @@ In this post we look at how to solve a Sudoku with Haskell.
The code in this post has dependencies on the [`split`][1] package from Hackage.
+Basic setup
+-----------
+
```haskell
{-# LANGUAGE BangPatterns, RecordWildCards #-}
@@ -30,15 +33,13 @@ module Sudoku where
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Char (digitToInt, intToDigit)
-import Data.List (foldl', intersperse, intercalate)
+import Data.List (foldl', intersperse, intercalate, sortBy, nub)
import Data.List.Split (chunksOf)
-import Data.Map ((!))
+import Data.Maybe (fromJust)
+import Data.Ord (comparing)
import Control.Monad (foldM, guard)
```
-
-
-Basic setup
------------
+>
Now that the imports are out of the way let's setup the basic functionalities.
@@ -52,17 +53,28 @@ instance Show Digit where
allDigits = S.fromList [ONE .. NIN]
data Cell = Cell { cellIdx :: Int, cellVals :: S.Set Digit }
- deriving (Eq)
+ deriving (Eq, Ord)
instance Show Cell where
show Cell{..} = "<" ++ show cellIdx ++ " " ++ show (S.toList cellVals) ++">"
-type Board = M.Map Int Cell
+newtype Board = Board (M.Map Int Cell)
+ deriving (Eq, Ord)
+
+boardCells :: Board -> [Cell]
+boardCells (Board ixMap) = M.elems ixMap
+
+cellAt :: Board -> Int -> Maybe Cell
+cellAt (Board ixMap) idx = M.lookup idx ixMap
+
+updateBoard :: Board -> Cell -> Board
+updateBoard (Board ixMap) cell@Cell{..} = Board (M.insert cellIdx cell ixMap)
emptyBoard :: Board
-emptyBoard = foldl' (\m i -> M.insert i (Cell i allDigits) m)
- M.empty [0 .. 80]
+emptyBoard =
+ Board $ foldl' (\m i -> M.insert i (Cell i allDigits) m) M.empty [0 .. 80]
```
+>
A `Digit` is just one of the nine possible values. It derives `Eq`, `Ord` and `Enum`. We use the
fact the `Digit` is enumerable to create a custom `Show` instance which is just the `Digit`'s ordinal
@@ -73,8 +85,12 @@ number between 0 to 80 inclusive. The cell values denote the possible values the
without violating the rules of Sudoku. If a cell is filled, it holds only one value. We create a
custom `Show` instance of `Cell` to pretty print it.
-A `Board` is just a map from the cell index to the corresponding cell for faster lookups than a
-simple list of `Cell`s.
+A `Board` is just a wrapper over a map from the cell index to the corresponding cell. We use a map
+instead of a simple list of `Cell`s for faster lookups.
+
+`boardCells`, `cellAt` and `updateBoard` are some convenience functions to manipulate a board.
+`boardCells` returns a list of all the cells in a board, `cellAt` returns a cell in a board at
+a given index and `updateBoard` update a given cell in a board.
`emptyBoard` creates an empty board, with all the cells, unfilled by folding over all the
index list and inserting a cell with all possible digits in the map corresponding to each index.
@@ -87,9 +103,9 @@ can start playing with the actual examples. The board is represented as a single
digit for each cell if it is filled otherwise a dot `.`. The cells are read row first, left to
right column. An example:
-
+```
6..3.2....4.....1..........7.26............543.........8.15........4.2........7..
-
+```
```haskell
readBoard :: String -> Maybe Board
@@ -100,10 +116,11 @@ readBoard str = do
let cellVals = if chr == '.'
then allDigits
else S.singleton $ toEnum $ digitToInt chr - 1
- return $ M.insert i (Cell i cellVals) board)
+ return $ updateBoard board (Cell i cellVals))
emptyBoard
$ zip [0 .. 80 ] str
```
+>
`readBoard` converts a string to a `Board`. It returns `Just Board` if the string represents a valid
Sudoku board, otherwise it returns `Nothing`. We use the `Monad` nature of `Maybe` to guard against the
@@ -118,7 +135,7 @@ showBoard =
if S.size cellVals == 1
then intToDigit . (+ 1) . fromEnum . head . S.toList $ cellVals
else '.')
- . M.elems
+ . boardCells
asciiShowBoard :: Board -> String
asciiShowBoard =
@@ -129,7 +146,11 @@ asciiShowBoard =
. chunksOf 9
. showBoard
where border = "+-------+-------+-------+"
+
+instance Show Board where
+ show = showBoard
```
+>
`showBoard` does the reverse of `readBoard`. It takes a board and creates a valid string
representation of it. It does so by mapping over each cell of the board in the order of their index
@@ -139,9 +160,11 @@ and outputting the digit if the cell is filled else `.`.
so by taking the output of `showBoard`, breaking it into chunks corresponding to rows and blocks,
inserting spaces and `|` at appropriate places and then joining them with the borders made of `-`.
+Lastly, we add a `Show` instance of `Board` using `showBoard`.
+
Here is an example run in _ghci_:
-
+```haskell
*Sudoku> let boardStr = "6..3.2....4.....1..........7.26............543.........8.15........4.2........7.."
*Sudoku> let (Just board) = readBoard boardStr
*Sudoku> showBoard board
@@ -160,7 +183,7 @@ Here is an example run in _ghci_:
| . . . | . 4 . | 2 . . |
| . . . | . . . | 7 . . |
+-------+-------+-------+
-
+```
Is it solved yet?
--------------------
@@ -174,14 +197,14 @@ data BoardState = SOLVED | INCOMPLETE | INVALID
boardState :: Board -> BoardState
boardState board
- | any (\Cell{..} -> S.size cellVals /= 1) $ M.elems board = INCOMPLETE
+ | any (\Cell{..} -> S.size cellVals /= 1) $ boardCells board = INCOMPLETE
| any isUnitInvalid units = INVALID
| otherwise = SOLVED
where
isUnitInvalid unitCells =
(S.fromList . map (head . S.toList . cellVals) $ unitCells) /= allDigits
- units = map (map (board !)) unitIxs
+ units = map (map (fromJust . cellAt board)) unitIxs
unitIxs = rowIxs ++ columnIxs ++ blockIxs
rowIxs = map (\i -> [i * 9 .. i * 9 + 8]) [0..8]
@@ -193,6 +216,7 @@ blockIxs =
row1 row2 row3)
. chunksOf 3 . map (chunksOf 3) $ rowIxs
```
+>
We start by defining the board state as an enumeration of three value corresponding to the solved,
incomplete and invalid states. The `boardState` function takes a board and gives its current state.
@@ -213,7 +237,7 @@ concatenating them with a function which zips three rows at a time creating the
A run in _ghci_ shows the indexes to be correct:
-
+```haskell
*Sudoku> mapM_ print rowIxs
[0,1,2,3,4,5,6,7,8]
[9,10,11,12,13,14,15,16,17]
@@ -246,7 +270,7 @@ A run in _ghci_ shows the indexes to be correct:
[54,55,56,63,64,65,72,73,74]
[57,58,59,66,67,68,75,76,77]
[60,61,62,69,70,71,78,79,80]
-
+```
See how the row indexes follow the grid indexes as we have taken our grid indexes to be rows first,
left to right. If we take row indexes column-wise we get the column indexes. If we take the row
@@ -254,7 +278,7 @@ indexes block-wise we get the block indexes.
Let's do a few sample runs of `boardState` in _ghci_:
-
+```haskell
*Sudoku> let (Just board) = readBoard "483921657967345821251876493548132976729564138136798245372689514814253769695417382"
*Sudoku> putStr (asciiShowBoard board)
+-------+-------+-------+
@@ -278,13 +302,73 @@ INCOMPLETE
*Sudoku> let (Just board) = readBoard "183921657967345821251876493548132976729564138136798245372689514814253769695417382"
*Sudoku> boardState board
INVALID
-
+```
That seems to be working. Now let's move on to actually solving the Sudoku!
-Backtracking search
+Depth first search
-------------------
+One way to solve Sudoku is to think of it as a graph search problem. Each board configuration becomes
+a node in the search graph with the moves linking them as edges. A move is filling a particular cell
+with a digit. So now we can solve the board just by finding a path from the given board configuration
+to a configuration where all cells are filled.
+
+We can use [Depth first Search][5] (DSF) algorithm to accomplish this. DFS is a brute force
+technique and in worst case it may visit all the nodes in the search graph. In case of Sudoku, this
+search graph is very large (approximately 6.67×1021) so this is not a very efficient way
+of solving Sudoku. For now, we'll add one optimization in DFS: while listing the next possible
+configurations for a particular configuration, we start with the cell with smallest number of cell
+values. This does not help us in the worst case but it will generally speed up things a little.
+We can write this in two parts: a general DFS function and a solver which uses it to solve a Sudoku.
+
+```haskell
+dfs :: Ord a => a -> (a -> [a]) -> (a -> Bool) -> [a]
+dfs start getNext isGoal = go start S.empty
+ where
+ go node visited
+ | isGoal node = [node]
+ | S.member node visited = []
+ | otherwise = concatMap (\nextNode ->
+ go nextNode (S.insert node visited))
+ (getNext node)
+
+dfsSolver :: Board -> [Board]
+dfsSolver board = dfs board nextBoards ((== SOLVED) . boardState)
+ where
+ nextBoards board =
+ map (updateBoard board)
+ . concatMap (\Cell{..} -> map (Cell cellIdx . S.singleton) . S.toList $ cellVals)
+ . sortBy (comparing (S.size . cellVals))
+ . filter ((/= 1) . S.size . cellVals)
+ . boardCells
+ $ board
+
+```
+
+Let's try this out in _ghci_ now:
+
+```haskell
+*Sudoku> let boardStr = ".839216579.734582125187649354813297672956413813679824537268951481425376969541738."
+*Sudoku> let (Just board) = readBoard boardStr
+*Sudoku> :set +s
+*Sudoku> (mapM_ print . nub . dfsSolver) board
+483921657967345821251876493548132976729564138136798245372689514814253769695417382
+(1.75 secs, 356010984 bytes)
+```
+
+```haskell
+*Sudoku> let boardStr = ".839216579.734582125187.49354813297672956413813679824537268951481425376969541738."
+*Sudoku> let (Just board) = readBoard boardStr
+*Sudoku> :set +s
+*Sudoku> (mapM_ print . nub . dfsSolver) board
+483921657967345821251876493548132976729564138136798245372689514814253769695417382
+(66.64 secs, 13136374896 bytes)
+*Sudoku> (print . head . dfsSolver) board
+483921657967345821251876493548132976729564138136798245372689514814253769695417382
+(7.32 secs, 1322834576 bytes)
+```
+
Constraint propagation
----------------------
@@ -304,3 +388,4 @@ post can be downloaded [here][3] or can be forked [here][4].
[2]: /downloads/code/sudoku1.lhs
[3]: /downloads/code/sudoku1.hs
[4]: https://github.com/abhin4v/abhin4v.github.com/blob/source/source/downloads/code/sudoku1.hs
+[5]: http://en.wikipedia.org/wiki/Depth_first_search
diff --git a/source/downloads/code/sudoku1.hs b/source/downloads/code/sudoku1.hs
index e39e585..3d3fe89 100644
--- a/source/downloads/code/sudoku1.hs
+++ b/source/downloads/code/sudoku1.hs
@@ -5,9 +5,10 @@ module Sudoku where
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Char (digitToInt, intToDigit)
-import Data.List (foldl', intersperse, intercalate)
+import Data.List (foldl', intersperse, intercalate, sortBy, nub)
import Data.List.Split (chunksOf)
-import Data.Map ((!))
+import Data.Maybe (fromJust)
+import Data.Ord (comparing)
import Control.Monad (foldM, guard)
data Digit = ONE | TWO | TRE | FOR | FIV | SIX | SVN | EGT | NIN
deriving (Eq, Ord, Enum)
@@ -18,16 +19,26 @@ instance Show Digit where
allDigits = S.fromList [ONE .. NIN]
data Cell = Cell { cellIdx :: Int, cellVals :: S.Set Digit }
- deriving (Eq)
+ deriving (Eq, Ord)
instance Show Cell where
show Cell{..} = "<" ++ show cellIdx ++ " " ++ show (S.toList cellVals) ++">"
-type Board = M.Map Int Cell
+newtype Board = Board (M.Map Int Cell)
+ deriving (Eq, Ord)
+
+boardCells :: Board -> [Cell]
+boardCells (Board ixMap) = M.elems ixMap
+
+cellAt :: Board -> Int -> Maybe Cell
+cellAt (Board ixMap) idx = M.lookup idx ixMap
+
+updateBoard :: Board -> Cell -> Board
+updateBoard (Board ixMap) cell@Cell{..} = Board (M.insert cellIdx cell ixMap)
emptyBoard :: Board
-emptyBoard = foldl' (\m i -> M.insert i (Cell i allDigits) m)
- M.empty [0 .. 80]
+emptyBoard =
+ Board $ foldl' (\m i -> M.insert i (Cell i allDigits) m) M.empty [0 .. 80]
readBoard :: String -> Maybe Board
readBoard str = do
guard $ length str == 81
@@ -36,7 +47,7 @@ readBoard str = do
let cellVals = if chr == '.'
then allDigits
else S.singleton $ toEnum $ digitToInt chr - 1
- return $ M.insert i (Cell i cellVals) board)
+ return $ updateBoard board (Cell i cellVals))
emptyBoard
$ zip [0 .. 80 ] str
showBoard :: Board -> String
@@ -45,7 +56,7 @@ showBoard =
if S.size cellVals == 1
then intToDigit . (+ 1) . fromEnum . head . S.toList $ cellVals
else '.')
- . M.elems
+ . boardCells
asciiShowBoard :: Board -> String
asciiShowBoard =
@@ -56,19 +67,22 @@ asciiShowBoard =
. chunksOf 9
. showBoard
where border = "+-------+-------+-------+"
+
+instance Show Board where
+ show = showBoard
data BoardState = SOLVED | INCOMPLETE | INVALID
deriving (Eq, Show)
boardState :: Board -> BoardState
boardState board
- | any (\Cell{..} -> S.size cellVals /= 1) $ M.elems board = INCOMPLETE
+ | any (\Cell{..} -> S.size cellVals /= 1) $ boardCells board = INCOMPLETE
| any isUnitInvalid units = INVALID
| otherwise = SOLVED
where
isUnitInvalid unitCells =
(S.fromList . map (head . S.toList . cellVals) $ unitCells) /= allDigits
- units = map (map (board !)) unitIxs
+ units = map (map (fromJust . cellAt board)) unitIxs
unitIxs = rowIxs ++ columnIxs ++ blockIxs
rowIxs = map (\i -> [i * 9 .. i * 9 + 8]) [0..8]
@@ -79,3 +93,24 @@ blockIxs =
blockRow1 ++ blockRow2 ++ blockRow3)
row1 row2 row3)
. chunksOf 3 . map (chunksOf 3) $ rowIxs
+dfs :: Ord a => a -> (a -> [a]) -> (a -> Bool) -> [a]
+dfs start getNext isGoal = go start S.empty
+ where
+ go node visited
+ | isGoal node = [node]
+ | S.member node visited = []
+ | otherwise = concatMap (\nextNode ->
+ go nextNode (S.insert node visited))
+ (getNext node)
+
+dfsSolver :: Board -> [Board]
+dfsSolver board = dfs board nextBoards ((== SOLVED) . boardState)
+ where
+ nextBoards board =
+ map (updateBoard board)
+ . concatMap (\Cell{..} -> map (Cell cellIdx . S.singleton) . S.toList $ cellVals)
+ . sortBy (comparing (S.size . cellVals))
+ . filter ((/= 1) . S.size . cellVals)
+ . boardCells
+ $ board
+
diff --git a/source/downloads/code/sudoku1.lhs b/source/downloads/code/sudoku1.lhs
index 2cf2b18..1c1088c 100644
--- a/source/downloads/code/sudoku1.lhs
+++ b/source/downloads/code/sudoku1.lhs
@@ -23,6 +23,9 @@ In this post we look at how to solve a Sudoku with Haskell.
The code in this post has dependencies on the [`split`][1] package from Hackage.
+Basic setup
+-----------
+
> {-# LANGUAGE BangPatterns, RecordWildCards #-}
>
> module Sudoku where
@@ -30,14 +33,12 @@ The code in this post has dependencies on the [`split`][1] package from Hackage.
> import qualified Data.Set as S
> import qualified Data.Map as M
> import Data.Char (digitToInt, intToDigit)
-> import Data.List (foldl', intersperse, intercalate)
+> import Data.List (foldl', intersperse, intercalate, sortBy, nub)
> import Data.List.Split (chunksOf)
-> import Data.Map ((!))
+> import Data.Maybe (fromJust)
+> import Data.Ord (comparing)
> import Control.Monad (foldM, guard)
-
-
-Basic setup
------------
+>
Now that the imports are out of the way let's setup the basic functionalities.
@@ -50,16 +51,27 @@ Now that the imports are out of the way let's setup the basic functionalities.
> allDigits = S.fromList [ONE .. NIN]
>
> data Cell = Cell { cellIdx :: Int, cellVals :: S.Set Digit }
-> deriving (Eq)
+> deriving (Eq, Ord)
>
> instance Show Cell where
> show Cell{..} = "<" ++ show cellIdx ++ " " ++ show (S.toList cellVals) ++">"
>
-> type Board = M.Map Int Cell
+> newtype Board = Board (M.Map Int Cell)
+> deriving (Eq, Ord)
+>
+> boardCells :: Board -> [Cell]
+> boardCells (Board ixMap) = M.elems ixMap
+>
+> cellAt :: Board -> Int -> Maybe Cell
+> cellAt (Board ixMap) idx = M.lookup idx ixMap
+>
+> updateBoard :: Board -> Cell -> Board
+> updateBoard (Board ixMap) cell@Cell{..} = Board (M.insert cellIdx cell ixMap)
>
> emptyBoard :: Board
-> emptyBoard = foldl' (\m i -> M.insert i (Cell i allDigits) m)
-> M.empty [0 .. 80]
+> emptyBoard =
+> Board $ foldl' (\m i -> M.insert i (Cell i allDigits) m) M.empty [0 .. 80]
+>
A `Digit` is just one of the nine possible values. It derives `Eq`, `Ord` and `Enum`. We use the
fact the `Digit` is enumerable to create a custom `Show` instance which is just the `Digit`'s ordinal
@@ -70,8 +82,12 @@ number between 0 to 80 inclusive. The cell values denote the possible values the
without violating the rules of Sudoku. If a cell is filled, it holds only one value. We create a
custom `Show` instance of `Cell` to pretty print it.
-A `Board` is just a map from the cell index to the corresponding cell for faster lookups than a
-simple list of `Cell`s.
+A `Board` is just a wrapper over a map from the cell index to the corresponding cell. We use a map
+instead of a simple list of `Cell`s for faster lookups.
+
+`boardCells`, `cellAt` and `updateBoard` are some convenience functions to manipulate a board.
+`boardCells` returns a list of all the cells in a board, `cellAt` returns a cell in a board at
+a given index and `updateBoard` update a given cell in a board.
`emptyBoard` creates an empty board, with all the cells, unfilled by folding over all the
index list and inserting a cell with all possible digits in the map corresponding to each index.
@@ -96,9 +112,10 @@ right column. An example:
> let cellVals = if chr == '.'
> then allDigits
> else S.singleton $ toEnum $ digitToInt chr - 1
-> return $ M.insert i (Cell i cellVals) board)
+> return $ updateBoard board (Cell i cellVals))
> emptyBoard
> $ zip [0 .. 80 ] str
+>
`readBoard` converts a string to a `Board`. It returns `Just Board` if the string represents a valid
Sudoku board, otherwise it returns `Nothing`. We use the `Monad` nature of `Maybe` to guard against the
@@ -112,7 +129,7 @@ string contained a digit at the cell index else they have all the digits as cell
> if S.size cellVals == 1
> then intToDigit . (+ 1) . fromEnum . head . S.toList $ cellVals
> else '.')
-> . M.elems
+> . boardCells
>
> asciiShowBoard :: Board -> String
> asciiShowBoard =
@@ -123,6 +140,10 @@ string contained a digit at the cell index else they have all the digits as cell
> . chunksOf 9
> . showBoard
> where border = "+-------+-------+-------+"
+>
+> instance Show Board where
+> show = showBoard
+>
`showBoard` does the reverse of `readBoard`. It takes a board and creates a valid string
representation of it. It does so by mapping over each cell of the board in the order of their index
@@ -132,9 +153,11 @@ and outputting the digit if the cell is filled else `.`.
so by taking the output of `showBoard`, breaking it into chunks corresponding to rows and blocks,
inserting spaces and `|` at appropriate places and then joining them with the borders made of `-`.
+Lastly, we add a `Show` instance of `Board` using `showBoard`.
+
Here is an example run in _ghci_:
-
+haskell
*Sudoku> let boardStr = "6..3.2....4.....1..........7.26............543.........8.15........4.2........7.."
*Sudoku> let (Just board) = readBoard boardStr
*Sudoku> showBoard board
@@ -166,14 +189,14 @@ whether a board is filled completely and whether that solution is a valid one.
>
> boardState :: Board -> BoardState
> boardState board
-> | any (\Cell{..} -> S.size cellVals /= 1) $ M.elems board = INCOMPLETE
+> | any (\Cell{..} -> S.size cellVals /= 1) $ boardCells board = INCOMPLETE
> | any isUnitInvalid units = INVALID
> | otherwise = SOLVED
> where
> isUnitInvalid unitCells =
> (S.fromList . map (head . S.toList . cellVals) $ unitCells) /= allDigits
>
-> units = map (map (board !)) unitIxs
+> units = map (map (fromJust . cellAt board)) unitIxs
>
> unitIxs = rowIxs ++ columnIxs ++ blockIxs
> rowIxs = map (\i -> [i * 9 .. i * 9 + 8]) [0..8]
@@ -184,6 +207,7 @@ whether a board is filled completely and whether that solution is a valid one.
> blockRow1 ++ blockRow2 ++ blockRow3)
> row1 row2 row3)
> . chunksOf 3 . map (chunksOf 3) $ rowIxs
+>
We start by defining the board state as an enumeration of three value corresponding to the solved,
incomplete and invalid states. The `boardState` function takes a board and gives its current state.
@@ -204,7 +228,7 @@ concatenating them with a function which zips three rows at a time creating the
A run in _ghci_ shows the indexes to be correct:
-
+haskell
*Sudoku> mapM_ print rowIxs
[0,1,2,3,4,5,6,7,8]
[9,10,11,12,13,14,15,16,17]
@@ -245,7 +269,7 @@ indexes block-wise we get the block indexes.
Let's do a few sample runs of `boardState` in _ghci_:
-
+haskell
*Sudoku> let (Just board) = readBoard "483921657967345821251876493548132976729564138136798245372689514814253769695417382"
*Sudoku> putStr (asciiShowBoard board)
+-------+-------+-------+
@@ -273,9 +297,67 @@ INVALID
That seems to be working. Now let's move on to actually solving the Sudoku!
-Backtracking search
+Depth first search
-------------------
+One way to solve Sudoku is to think of it as a graph search problem. Each board configuration becomes
+a node in the search graph with the moves linking them as edges. A move is filling a particular cell
+with a digit. So now we can solve the board just by finding a path from the given board configuration
+to a configuration where all cells are filled.
+
+We can use [Depth first Search][5] (DSF) algorithm to accomplish this. DFS is a brute force
+technique and in worst case it may visit all the nodes in the search graph. In case of Sudoku, this
+search graph is very large (approximately 6.67×1021) so this is not a very efficient way
+of solving Sudoku. For now, we'll add one optimization in DFS: while listing the next possible
+configurations for a particular configuration, we start with the cell with smallest number of cell
+values. This does not help us in the worst case but it will generally speed up things a little.
+We can write this in two parts: a general DFS function and a solver which uses it to solve a Sudoku.
+
+> dfs :: Ord a => a -> (a -> [a]) -> (a -> Bool) -> [a]
+> dfs start getNext isGoal = go start S.empty
+> where
+> go node visited
+> | isGoal node = [node]
+> | S.member node visited = []
+> | otherwise = concatMap (\nextNode ->
+> go nextNode (S.insert node visited))
+> (getNext node)
+>
+> dfsSolver :: Board -> [Board]
+> dfsSolver board = dfs board nextBoards ((== SOLVED) . boardState)
+> where
+> nextBoards board =
+> map (updateBoard board)
+> . concatMap (\Cell{..} -> map (Cell cellIdx . S.singleton) . S.toList $ cellVals)
+> . sortBy (comparing (S.size . cellVals))
+> . filter ((/= 1) . S.size . cellVals)
+> . boardCells
+> $ board
+>
+
+Let's try this out in _ghci_ now:
+
+haskell
+*Sudoku> let boardStr = ".839216579.734582125187649354813297672956413813679824537268951481425376969541738."
+*Sudoku> let (Just board) = readBoard boardStr
+*Sudoku> :set +s
+*Sudoku> (mapM_ print . nub . dfsSolver) board
+483921657967345821251876493548132976729564138136798245372689514814253769695417382
+(1.75 secs, 356010984 bytes)
+
+
+haskell
+*Sudoku> let boardStr = ".839216579.734582125187.49354813297672956413813679824537268951481425376969541738."
+*Sudoku> let (Just board) = readBoard boardStr
+*Sudoku> :set +s
+*Sudoku> (mapM_ print . nub . dfsSolver) board
+483921657967345821251876493548132976729564138136798245372689514814253769695417382
+(66.64 secs, 13136374896 bytes)
+*Sudoku> (print . head . dfsSolver) board
+483921657967345821251876493548132976729564138136798245372689514814253769695417382
+(7.32 secs, 1322834576 bytes)
+
+
Constraint propagation
----------------------
@@ -295,3 +377,4 @@ post can be downloaded [here][3] or can be forked [here][4].
[2]: /downloads/code/sudoku1.lhs
[3]: /downloads/code/sudoku1.hs
[4]: https://github.com/abhin4v/abhin4v.github.com/blob/source/source/downloads/code/sudoku1.hs
+[5]: http://en.wikipedia.org/wiki/Depth_first_search