After watching a recent computerphile video on building a very simple sudoku solver I tried to implement the same in Haskell. From this CR question I learned that it is probably a better idea to use Vectors instead of just lists to represent a grid of numbers that is gonna be mutated. (But it is supposedly still worse than using a sparse representation.) And from this one (and another question of mine) I learned about
Control.Lens, but I decided against using it to avoid using many different packages that I’m not familiar with.
Now the program I wrote is close to the original in python, but very slow. So I would like to get some feedback on how to speed it up without deviating form this very simple aproach too much.
The code defines a
Board that represents a (solved or unsolved) state, with zeros for the entries that area yet to be determined. It can be indexed using
Coordinates. Then there are a few setters and getters that probably could be replaced by using
Control.Lens – but I’d like to avoid that for now as I just want to focus on the performance. Then there is a
possible function which takes a
Coordinates and a candidate number an just reports whether it is possible to put the candidate at some given coordinates. Finally there is
solve that does the backtracking.
So far I tried to add a
take 1 $ or
take 1 $! to speed it up (but only returning at most a single solution), but without success.
--https://www.youtube.com/watch?v=G_UYXzGuqvM import qualified Data.Vector as V data Board = Board (V.Vector (V.Vector Integer)) type Coordinates = (Int, Int) instance Show Board where show (Board b)=unlines . V.toList $ V.map show b fromList :: [[Integer]] -> Board fromList l = Board $ V.fromList $ V.fromList <$> l -- a few setters and getters (!):: Board -> Coordinates -> Integer (Board b) ! (i,j) = (b V.! j)V.! i getColumn :: Board -> Coordinates -> [Integer] getColumn b (i, _) = [b ! (i, j) | j<-[0..8]] getRow :: Board -> (Int, Int) -> [Integer] getRow b (_, j) = [b ! (i, j) | i<-[0..8]] getSquare :: Board -> Coordinates -> [Integer] getSquare b (i, j) = [b ! (i'*3 + u, j'*3 + v) | u<-[0..2],v<-[0..2]] where i' = i `div` 3 j' = j `div` 3 insert :: Board -> Coordinates -> Integer -> Board insert (Board b) (i, j) k = Board b' where v = b V.! j v' = v V.// [(i, k)] b' = b V.// [(j, v')] -- check whether it is possible to insert candidate at given position possible :: Board -> Coordinates -> Integer -> Bool possible b coords@(i, j) k |i < 0 || i >= 9 || j < 0 || j >= 9 || k < 0 || k > 9 = undefined |b ! coords > 0 = False |k `elem` getRow b coords = False |k `elem` getColumn b coords = False |k `elem` getSquare b coords = False |otherwise = True -- check whether board is already full full :: Board -> Bool full b = 0 `notElem` [b ! (i,j) | i<-[0..8], j<-[0..8]] -- recursion to find all solutions to a given board solve :: Board -> [Board] solve b |full b = [b] |otherwise = concat[ solve $! (insert b (x, y) n)| x<-[0..8], y<-[0..8], n<-[1..9], possible b (x,y) n] main = print $ solve b -- normal sudoku b :: Board b = fromList [ [5,3,0,0,7,0,0,0,0], [6,0,0,1,9,5,0,0,0], [0,9,8,0,0,0,0,6,0], [8,0,0,0,6,0,0,0,3], [4,0,0,8,0,3,0,0,1], [7,0,0,0,2,0,0,0,6], [0,6,0,0,0,0,2,8,0], [0,0,0,4,1,9,0,0,5], [0,0,0,0,8,0,0,7,9] ] -- only one a few entries are missing c :: Board c = fromList [ [0,0,0,0,9,4,5,6,1], [9,2,1,5,3,6,8,7,4], [4,5,6,7,8,1,9,2,3], [1,4,7,3,5,9,2,8,6], [2,8,3,6,1,7,4,5,9], [5,6,9,8,4,2,3,1,7], [6,7,4,9,2,5,1,3,8], [8,9,2,1,7,3,6,4,5], [3,1,5,4,6,8,7,9,2]]
It turns out I made some crucial mistakes: The iteration in
solve can stop as soon we have tried all possibilities for one coordinate
(x,y) that is not set yet. If we iterate further over
(x,y) we get duplicate solutions which makes things blow up, so with following little modification we get results immediately:
isEmpty :: Board -> Coordinates -> Bool isEmpty b coords = b ! coords == 0 -- check whether board is already full full :: Board -> Bool full b = 0 `notElem` [b ! (i,j) | i<-[0..8], j<-[0..8]] -- recursion to find all solutions to a given board solve :: Board -> [Board] solve b |full b = [b] |otherwise = concat[ solve $! (insert b (x, y) n)| (x,y) <- take 1 empty, n <- [1..9], possible b (x,y) n] where empty = [(x,y) | x<-[0..8],y<-[0..8], isEmpty b (x, y)]