Return to Revisions

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 Program

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 Board, 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.

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' + u, j' + 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
-- recursion to find all solutions to a given board
solve :: Board -> [Board]
solve b = 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
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]
 ]

Try it online!]TIO-k7iw2jpg