Haskell Sudoku Solver - List Monad

In this article we will write a Sudoku solver in Haskell using the expressive and powerful List Monad to enumerate the solutions trasparently. I assume that the reader has a general understanding of monads (if not read http://www.idryman.org/blog/2014/01/23/yet-another-monad-tutorial/)

Su Doku means literally  number place is the name of a popular puzzle game that a special case of the old Latin Square (invented by Leonard Euler). Latin Square force each symbol to appear once in each row and column. In addition to these contraint Sudoku force each symbol to apper one in each sub-matrix. In the general case Sudoku is NP-Complete (easy reduction to graph coloring), but certain schemeas can be solved by deduction and logic only (in this case the puzzle is said well constructed).

At high level a Sudoku can be viewed as a list of cell

data Board= Board [Square]
    deriving(Show)

and a Square must certanly carries information about its position and the digit it contains, or even better it could contain (according to the cells in same row, column and submatrix)

data Square= Square ColDigit RowDigit BoxDigit (Either [Digit] Digit)
    deriving (Show)

type RowDigit= Digit
type ColDigit= Digit
type BoxDigit= Digit
type Digit= Char

While solving the puzzle each square will contains either a list of possible digits that can be placed in the square OR (this is the Either logic) a fixed digit (i.e., the square was given by a clue or has been deduced).

The following Squares have respectively position and , both lie in submatrix and can contain the digit 1 OR 5 OR 7 OR 4 while is fixed to 6.

let s1=Square '4' '1' '4' (Left ['1','5','7','4'])
let s2=Square '4' '2' '4' (Right '6')

The solver works s.t. it return the list of possible solution for a schema (not well constructed Sudoku may have multiple solutions). In particular if no unresolved square are left (the one with the Left in the Ethier part) it means that the board is solved and does not need any further processing, otherwise we take the square with the minimum number of possible values and try solve the board trying, one at the time, all the values for it. This sort of backtracking is perfomed transparently by the List monad that is used to represent nondeterminism (i.e. multiple possibilities).

solveMany :: Board -> [Board]
solveMany brd =
	case getUnsolvedSquare brd of
		[] 	-> return brd --all squares correctly set up
		sqs -> do
		let selSquare@(Square c r b (Left ds)) : _ = sortBy (byLeftLenght) sqs
		sq <- [ Square c r b (Right d) | d <- ds ] -- Try all possible moves
		solveMany (setSquare sq brd)

Recall that do notation is just syntactic sugar for bind (>>=) operator and that for for list it is defined as following

(>>=) :: [a] -> (a->[b]) >[b]
xs >>= f = concat (map f xs)

It then applies f=solveMany (that takes a board) and produces [Board] for all the digits in the Left of selSquare.
Here the same function wrote with explicit bind operator application that makes much clear the monadiac operation that do the dirty job for us.

solveMany :: Board -> [Board]
solveMany brd =
	case getUnsolvedSquare brd of
		[] 	-> return brd --all squares correctly set up
		sqs ->
			let Square c r b (Left ds) : _ = sortBy (byLeftLenght) sqs
			in [ Square c r b (Right d) | d <- ds ] >>=(\b->solveMany (setSquare b brd))

getUnsolvedSquare :: Board -> [Square]
getUnsolvedSquare (Board sqs) = filter (isSolved) sqs
	where
		isSolved (Square _ _ _ (Left _)) = True
		isSolved _						  = False

The setSquare function is the one devoted to the constraint propagation and is defined as follow:

setSquare :: Square-> Board ->Board
setSquare sq@(Square scol srow sbox (Right d))(Board sqs) = Board (map set sqs)
	where
		set osq@(Square ocol orow obox ods)
			| scol==ocol && srow==orow  			 = sq
			| scol==ocol || srow==orow || sbox==obox = Square ocol orow obox (checkEither ods)
			| otherwise 							 = osq

		checkEither (Left  lds ) 			= Left (lds \\ [d])
		checkEither r@(Right d') | d==d'	= error "Already set this square"
		checkEither dd = dd
setSquare _ _ = error "Bad call to setSquare"

It places Square (with a Right Digit) on a Board and return the new Board taking care of removing the just inserted digit from the possible values for Squares of the same row, column and submatrix. This is how the constraint are propagated, cutting off the search space.

The complete source code is available here and on github.

Haskell Seminar at University of Calabria

During the last year I got much interest in functional programming and in particular in Haskell.
Very few people write and study Haskell at University of Calabria (one of them is the manteiner of gnome for NixOs) and so I decided to do a introductive lesson (a big thanks go to the guys of the ciotoflow). It was a great experience, and people were enthusiast and curious.
All the material i produced is available for download and use, and hopefully will be gradually updated and improved. All the files are available on github.

Introductive slides here