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]]