# Haskell Sudoku solver using bactracking

This solves Sudoku by using backtracking. Accepts one grid where 0 represents a missing number. Here are some examples: http://norvig.com/easy50.txt

The program is quite slow. Input is stdin.

import Data.Char (isDigit)
import Data.List (intersperse, delete)

printGrid [] = []
printGrid x = (intersperse ' ' $take 9 x) ++ "\n" ++ (printGrid$ drop 9 x)

solve x = if isSolved x then x
else
firstSolved cands
where
firstSolved [] = []
firstSolved (c:cs) = if isSolved trial then trial else firstSolved cs
where
trial = solve c
cands = candidates x

isSolved x = (length x == 81) && (not $elem '0' x) && (isValidCandidate x) candidates x = filter isValidCandidate [(takeWhile (/='0') x) ++ z ++ (tail$ dropWhile (/='0') x) | z <- map show [1..9]]

isValidCandidate x = not $any (isInvalidCand x) [0..80] isInvalidCand x i = (x !! i /= '0') && any (elem ic) [row, col, unit] where ix = mod i 9 iy = quot i 9 ic = x !! i row = [x !! a | a <- [9*iy..(9*iy + 8)], a /= i] col = [x !! a | a <- [ix, (ix + 9)..(ix + 72)], a /= i] icx = (quot ix 3) * 3 icy = (quot iy 3) * 3 si = (9*icy) + icx unit = map (x !!) (delete i [si, si + 1, si + 2, si + 9, si + 10, si + 11, si + 18, si + 19, si + 20]) main :: IO () main = interact$ printGrid . solve . filter isDigit

• Have you seen this Sudoku in Haskell functional pearl by Graham Hutton? It's a thing of beauty. Apr 26, 2015 at 6:12
• It is nice, but I already saw the idea in Norvig's article on constraint propagation. I was hoping to get an improvement in my code style.
– ssh
Apr 26, 2015 at 13:14

Since you said you were looking for suggestions for coding style I will focus on that.

-- | Pretty prints a Sudoku board encoded as a list.
printGrid :: [Char]
printGrid [] = ...

• All top level symbols should have type signatures. Types in Haskell are super expressive and often convey as much meaning or more than variable names.

• Line wrap your code at 80 or 100 characters (80 seems to be more popular). Not everybody has as wide a monitor as you, and limiting the length of your lines forces you to break up code into logical units.

• Haskell programs tend to have lots of short variable names. This makes sense for general functions like map where you can't really be specific about the values even if you wanted to:

map f (x:xs) = f x : map f xs


However, the more specific your code gets the less applicable (and more confusing) short variable names get. For example, the argument to all of your functions is x. This a missed opportunity to give the reader more information on what the parameter of this function actual is.

• You are using a String to represent your Sudoku board. This is fine, but it makes your type signatures unhelpful. You can fix this by defining an alias for your board type:

-- | An entry in a Sudoku board is either the number as a
-- character, or '0' to indicate an unknown value.
type Entry = Char

-- | A Sudoku board is a list of Sudoku entries read from
-- left to right, top to bottom.
type Board = [Entry]

• You have several take n/drop n and takeWhile/dropWhile pairs in your code. You can combine these into a single statement with splitAt and span.

front = take 9 x
back  = drop 9 x
(front, back) = splitAt 9 x

front = takeWhile (/= '0') x
back  = dropWhile (/= '0') x
(front, back) = span (/= '0') x

• You have a lot of if-then-else blocks in your code. Often times these can be more succinctly expressed with pattern guards. For example, you can simplify your solve function as follows:

-- | Takes a board with possibly unknown entries and returns
-- Just a board with all of the entries containing valid numbers,
-- or Nothing if there is no solution.
solve :: Board -> Maybe Board
solve board | isSolved board = Just board
| otherwise      = listToMaybe solutions
where solutions = filter isSolved \$ map solve (candidates board)


Also, your solve method returns the empty list if no solution can be found. This is confusing because the empty list is also a valid board. When your function has the possibility of failing, it is best to wrap the result in a Maybe or another type that is capable of representing an error.

• Your candidates function is doing a lot of list traversals with your use of ++ and takeWhile and dropWhile. You can get rid of most of these traversals by using recursion to find the first element of the list and replacing it inline.

-- | Generate a list of possible solutions to a Sudoku board by
-- replacing the first unknown entry with all possible values.
candidates board = filter isValidCandidate [ replaceFirst guess board
| guess <- ['1'..'9']]

-- | Replace the first unknown entry in a Sudoku board with
-- the given entry.
replaceFirst :: Entry -> Board -> Board
replaceFirst _ []       = []
replaceFirst a ('0':xs) = a : xs
replaceFirst a (x:xs)   = x : replaceFirst a xs


Another note about candidates, you can incorporate the filter as part of the comprehension you are already doing:

candidates board = [ candidate | guess <- ['1'..'9']
, candidate <- [replace guess board]
, isValidCandidate candidate]

• I stared at the isInvalidCand function for a while and I'm still having trouble groking all that is happening. Some comments and some better naming would go a long way in improving the readability this function.

• Thank you! I'm not sure about your partition (\= 0) since I'm only trying to split at the first 0. In isInvalidCand I'm extracting column, row and box to see if the value has already been placed.
– ssh
May 4, 2015 at 11:36
• Ah my bad, your right that should be span instead of partition. May 4, 2015 at 14:51