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.
--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]]
-prof -fprof-auto -O<optimization-level>
via GHC. If you usestack
, there should be--profile
forstack
's build command. Afterwards, you have to tell the runtime to write a profile. On your application, use+RTS -p
. That's the quick gist. I believe some of my old answers here on CR contain examples on profiling. \$\endgroup\$vector
and probablyprimitive
) also with profiling enabled, which can take a while. \$\endgroup\$