ralgorithmmatrixbacktrackingsudoku

Solving a Sudoku by Hand


Suppose I have the following sudoku:

problem <- matrix(c(
    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
), nrow = 9)

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

I am trying to manually write a procedure (e.g. backtracking) to solve this sudoku.

Currently, I thought of the two following ideas that could be useful:

1) For a given row or a given column - what numbers are valid choices?

The following code looks at what possible numbers are valid choices in the first column:

y = 1:9
setdiff(y, problem[1,])
[1] 1 2 3 9

2) At any point, does a given row or column result in a violation? (i.e. same number more than once - excluding 0)

#TRUE = no violation, FALSE = violation
check_vector <- function(v) {
  for (i in 1:9) {
    if (sum(v == i) > 1) {
      return(FALSE)
    }
  }
  return(TRUE)
}

# no violation
    v1 = c(5, 3, 0, 0, 7, 0, 0, 0, 0)

# violation (3,3)
    v2 = c(5, 3, 3, 0, 7, 0, 0, 0, 0)

> check_vector(v1)
[1] TRUE
> check_vector(v2)
[1] FALSE

My Question: I am not sure how I can use these functions together to backtrack through the sudoku and fill out all numbers. Can someone please show me how to do this?

Thanks!

Note: If possible, I would like the final answer to use the code I already wrote


Solution

  • If you want to solve it without using additional packages, you can try the code below, which is sort of using the "backtracking" idea (but not exactly the same).

    Code

    Note that the code below is just one implementation for example, not optimized enough. You may find some hints there and further optimize it according to your flavor.

    sudoku <- function(m) {
        # check valid values to fill in the given position of matrix
        checker <- function(mat, i, j) {
            iblk <- 3 * (ceiling(i / 3) - 1) + (1:3)
            jblk <- 3 * (ceiling(j / 3) - 1) + (1:3)
            u <- unique(c(mat[i, ], mat[, j], mat[iblk, jblk]))
            setdiff(1:9, u)
        }
    
        # help to generate all possible matrices
        helper <- function(m, idx) {
            i <- (idx - 1) %/% 9 + 1
            j <- (idx - 1) %% 9 + 1
            if (m[i, j] == 0) {
                u <- checker(m, i, j)
                lapply(u, \(x) {
                    m[i, j] <- x
                    m
                })
            } else {
                list(m)
            }
        }
    
        # initial value
        lst <- list(m)
        cnt <- 1
        repeat {
            lst <- unlist(
                lapply(
                    lst,
                    helper,
                    idx = cnt
                ),
                recursive = FALSE
            )
            if (cnt == length(m)) {
                return(lst[[1]])
            }
            cnt <- cnt + 1
        }
    }
    

    Output

    > (solution <- sudoku(problem))
          [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
     [1,]    5    6    1    8    4    7    9    2    3
     [2,]    3    7    9    5    2    1    6    8    4
     [3,]    4    2    8    9    6    3    1    7    5
     [4,]    6    1    3    7    8    9    5    4    2
     [5,]    7    9    4    6    5    2    3    1    8
     [6,]    8    5    2    1    3    4    7    9    6
     [7,]    9    3    5    4    7    8    2    6    1
     [8,]    1    4    6    2    9    5    8    3    7
     [9,]    2    8    7    3    1    6    4    5    9