Sudoku Solver in SML with Backtracking

Question

I'm working on creating a Sudoku Solver with SML/NJ. I've got all of the functions in place to actually manipulate the input data (check for legality of rows, forcing the empty spaces, etc) but I'm having trouble with the backtracking part.

I came across this question but I'm confused on how to implement it in SML.

Note that a board is input as a list of lists that represent the numbers in each row, 0 for an unknown spot

[[0,0,0, 2,6,0, 7,0,1],
[6,8,0, 0,7,0, 0,9,0],
[1,9,0, 0,0,4, 5,0,0],

[8,2,0, 1,0,0, 0,4,0],
[0,0,4, 6,0,2, 9,0,0],
[0,5,0, 0,0,3, 0,2,8],

[0,0,9, 3,0,0, 0,7,4],
[0,4,0, 0,5,0, 0,3,6],
[7,0,3, 0,1,8, 0,0,0]]

Here is my (edited) solve function.

exception Sudoku;
fun solve board =
  let fun solve' board k =
    (* k is the row we are working on, so if it's 9, we SHOULD be done *)
    if k = 9 then board else
    let
      (* get row k from the board *)
      val row = (List.nth (board, k));

      fun trySpot number col =
        (* if number >= 10, raise an exception to backtrack *)
        if number > (length row) then raise Sudoku
        (* if col = 9, raise an exception to backtrack *)
        else if col = 9 then raise Sudoku
        (* if row[col] is not a zero, move to next col *)
        else if not (List.nth(row, col) = 0) then trySpot number (col + 1)
        (* row doesn't contain this num already *)
        else if length (List.filter (fn x => x = number) row) = 0 then
          let
            (* build the new row and board and check if legal (this works fine) *)
            val newRow = delete(col + 1, (insertAtPos row number col));
            val newBoard = delete(k + 1, (insertAtPos board newRow k));
            val isLegal = checkLegal newBoard;
          in
            (* if legal, keep solving with new board as base *)
            if isLegal then
              solve' (force newBoard) 0
              handle Sudoku => solve' (force board) (k + 1)
            (* not legal, try with next num *)
            else trySpot (number + 1) col
          end
        (* row already has this number, skipping *)
        else trySpot (number + 1) col
    in
      (* if board is complete and legal we're done *)
      if completedBoard board andalso checkLegal board then board
      (* if row has a zero then try a spot *)
      else if (zeroInList row) then trySpot 1 0
      (* otherwise move to next row *)
      else solve' (force board) (k + 1)
    end
  in
    (* initial solve *)
    solve' (force board) 0
  end; 

Calling solve on the sample data above returns the following lists

[[4,3,5,2,6,9,7,8,1],
[6,8,2,5,7,1,4,9,3],
[1,9,7,8,3,4,5,6,2],

[8,2,6,1,9,5,3,4,7],
[3,1,4,6,8,2,9,0,0],
[0,5,0,0,0,3,0,2,8],

[0,0,9,3,0,0,0,7,4],
[2,4,0,0,5,0,0,3,6],
[7,0,3,0,1,8,0,0,0]]

Now this is partially correct. The first four rows look to be fully correct based on an online sudoku solver I used to check, but it gets messed up on the 5th row. I presume it's because it's not able to backtrack all the way.

The only place it "backs up" is on this line

handle Sudoku => solve' (force board) (k + 1)

This tells it to just try solving the old board (without the new number) but this is preventing it from backtracking more than one step (I think). How could this be accomplished?

If anyone is curious to see the full code, you can find it here.

Thanks in advance!

Answer 1

I seem to have gotten my solve function to work with all of the cases I've tried. The trick was to keep track of a list of illegal numbers for the spot we were working on. The solver will now skip over these numbers, and backtrack if it can't find a path forward.

exception Sudoku;
(* solves a soduku board input that gives a list of lists representing the rows of a board (0 for unknown spaces) *)
fun solve board = 
  let fun solve' board row illegalNums = 
    (* if we are on row 9 and board is complete/legal, we are done *)
    if row = 9 andalso completedBoard board andalso checkLegal board then board else
    (* if we are on row 9 but the board is not complete/legal, throw an exception to backtrack *)
    if row = 9 then raise Sudoku else 
    let
      (* get the current row we are working on *)
      val cRow = (List.nth (board, row));

      (* trys a row[col] on the board with a certain number *)
      fun trySpot num cRow col =
        (* if number >= 10, raise an exception to backtrack *)
        if num > 9 then raise Sudoku
        (* if row[col] is not a 0, try next col *)
        else if not (List.nth (cRow, col) = 0) then trySpot num cRow (col + 1)
        (* if we know that the number we are on isn't allowed, skip to next number *)
        else if length (List.filter (fn x=> x = num) illegalNums) > 0 then trySpot (num + 1) cRow col
        (* if row already has this number, skip to next number *)
        else if length (List.filter (fn x=> x = num) cRow) > 0 then trySpot (num + 1) cRow col
        (* if col already has this number, skip to next number *)
        else if length (List.filter (fn x=> x = num) (List.nth((rowsToCols board), col))) > 0 then trySpot (num + 1) cRow col
        else 
          let
            (* make our new row and board *)
            val newRow = delete(col + 1, (insertAtPos cRow num col));
            val newBoard = delete(row + 1, (insertAtPos board newRow row));
          in
            (* if new board is legal, continue solving *)
            if checkLegal newBoard then
              solve' (force newBoard) 0 []
              (* handle any exceptions by adding the number to our list of illegal numbers, thereby backtracking *)
              handle Sudoku => solve' (force board) row (illegalNums@[num])
            (* if new board is not legal, try next number *)
            else trySpot (num + 1) cRow col
          end
    in
      (* if board is completed and legal, return board *)
      if completedBoard board andalso checkLegal board then board
      (* if current row has at least one 0, try a number in that row (beginning at col 1) *)
      else if (zeroInList cRow) then trySpot 1 cRow 0
      (* else, skip to next row and solve *)
      else solve' (force board) (row + 1) []
    end
  in
    (* initial solve *)
    solve' (force board) 0 []
  end;

The harder boards can take quite a while to fully solve, but every one I've tested eventually gets there. I'm sure there are a ton of optimizations I can do in my code, so I'm open to suggestions.