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
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).
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
}
}
> (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