Sudoku solver in Haskell

Question

I tried to implement a naive brute-force Sudoku solver in Haskell (I know there are loads of good solutions already) and I'd like some reviews from you experts.

The solver is very simple and it uses the List monad to try all the possible combinations. It's not optimized at all, but it takes an awful lot of time to solve even the simplest grids. I'm trying to understand if there is a problem with the algorithm itself (too simple) or with my implementation.

Anyway, here is the code.

 module Main where
 import Data.List (nub, concat, findIndices)
 import Control.Monad (liftM2, forM, join, guard)
 import Data.Maybe (catMaybes, fromMaybe)
 import Debug.Trace
 type Board = String
 -- Some boards
 -- other examples: http://norvig.com/top95.txt
 boards :: [Board]
 boards = map parseBoard [
 "4.....8.5.3..........7......2.....6.....8.4......1.......6.3.7.5..2.....1.4......",
 "..3.2.6..9..3.5..1..18.64....81.29..7.......8..67.82....26.95..8..2.3..9..5.1.3..",
 "483921657967345821251876493548132976729564138136798245372689514814253769695417382",
 "483...6..967345....51....93548132976..95641381367982453..689514814253769695417..2",
 "..3.2.6..9..3.5..1..18.64....81.29..7.......8..67.82....26.95..8..2.3..9..5.1.3..",
 ".2.4.6..76..2.753...5.8.1.2.5..4.8.9.6159...34.28.3..1216...49.......31.9.8...2.."
 ]
 -- The idea is to try all the possibilities by substituting '.' with all
 -- possible chars and verifying the constraint at every step. When there are
 -- no more dots to try, backtrack.
 -- This is done in the List monad.
 solve :: Board -> [Board]
 -- solve board | trace (showBoard board) False = undefined
 solve board = go dotIdxs
 where dotIdxs = findIndices (== '.') board
 go :: [Int] -> [Board]
 go [] = do
 -- no dots to try: just check constraints
 guard $ not $ isObviouslyWrong board
 return board
 -- go dotIdxs | trace (show dotIdxs) False = undefined
 go dotIdxs = do
 -- in the List monad: try all the possibilities
 idx <- dotIdxs
 val <- ['1'..'9']
 let newBoard = set board idx val
 -- guard against invalid boards
 guard $ not $ isObviouslyWrong board
 -- carry on with the good ones
 solve newBoard
 -- Create a new board setting board[idx] = val
 set :: Board -> Int -> Char -> Board
 set board idx val = take idx board ++ [val] ++ drop (idx + 1) board
 safeHead :: [a] -> Maybe a
 safeHead [] = Nothing
 safeHead (x:_) = Just x
 -- Block of indices where to verify constraints
 blockIdxs :: [[Int]]
 blockIdxs = concat [
 [[r * 9 + c | c <- [0..8]] | r <- [0..8]] -- rows
 , [[r * 9 + c | r <- [0..8]] | c <- [0..8]] -- cols
 , [[r * 9 + c | r <- [rb..rb + 2], c <- [cb..cb + 2]] | rb <- [0,3..8], cb <- [0,3..8]] -- blocks
 ]
 -- Check if constrains hold on grid
 -- This means that block defined in blockIdxs does not contain duplicates, a
 -- part from '.'
 isObviouslyWrong :: Board -> Bool
 isObviouslyWrong board = any (isWrong board) blockIdxs
 where isWrong board blockIdx = nub blockNoDots /= blockNoDots
 where blockNoDots = filter (/= '.') block
 block = map (board !!) blockIdx
 -- Filter out spurious chars
 parseBoard :: Board -> Board
 parseBoard = filter (`elem` "123456789.")
 -- Pretty output
 showBoard :: Board -> String
 showBoard board = unlines $ map (showRow board) [0..8]
 where showRow board irow = show $ take 9 $ drop (irow * 9) board
 test :: Maybe Board
 test = safeHead . solve $ boards !! 2
 main :: IO ()
 main = interact $ showBoard . fromMaybe "Solution not found" . safeHead . solve . parseBoard

Answer 1

A large part of the inefficiency may stem from the decision to represent partially completed boards as full-blown 81-element lists, vs. a representation that's more easily mutated. For example, if a board were represented as a short list of only the (position,value) pairs selected so far, the selection of one more value could very inexpensively add another pair to the head of the existing list. This instead of "replacing a dummy '.' element" which typically involves expensive copying.

This will change the details of how you validate a board, but not by much -- you are just replacing "dense array" positional indexing and dummy '.' entries with "sparse array" key matching and skipped entries.

This change is also somewhat independent of the algorithm you use to decide which positions or values to try first, though different representations can influence this choice as they make it easier or harder to check for different patterns of likely/unlikely choices.

Answer 2

The set operation would be slightly faster using splitAt instead of take and drop. Other than that I don't see obvious problems (which doesn't mean much).

I guess other data structures could help a lot (e.g. I think some vector implementation would be much faster as board representation).

The biggest problem is the algorithm: You definitely want to fill the fields with the least possibilities first. So the best way would be to calculate all candidates for the open fields in the beginning, start backtracking from a field with just a few possibilities (often the choice will be unique) and update the candidates in the same row, column and square accordingly.