Solving a Sudoku by Hand

Question

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

Aby

you may find this interesting :-) ams.org/notices/200904/rtx090400460p.pdf – Remscheid

also sudoku::solveSudoku(problem) – Remscheid

see Sudoku solving in c++ for some inspiration – Thrifty

I would say, your checker function check_vector is just a tiny part in a sudoku solver, and there is still a long way to go with it if you request others to use it anyway before finishing the solver, since you don't have your own roadmap for the solver so far. Also, the sudoku rules are not fully included in check_vector yet. – Petition

Answer 1

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

Petition

I regret to tell you that unfortunately some of the solutions are faulty (according to sudoku rules not fully listed by the OP though). All numbers must be unique in each of the nine 3x3 quadrants (problems[1:3, 1:3] or problems[4:6, 7:9] for instance). And solutions[[1]][1, 3] == solutions[[1]][3, 1]. The sample problem has only one valid solution. – Mercia

@Mercia aha, thanks for the reminder! I overlooked the quadrant constraint in my checker function. Now fixed! – Petition

Cool! +1. The advantage of your code is that it is capable to find >1 solutions should the problem have them. Cheers! – Mercia

Answer 2

I would suppopose the following solution:

repeat {
  possible <- rep(1:9, each = 9^2) |> 
    array(dim = c(9,9,9))
  
  for(j in 1:9) {
    for(i in 1:9) {
      if (!is.na(problem[i,j]) && problem[i,j] != 0) {
        possible[i,j,-problem[i,j]] <- NA
        possible[-i,j,problem[i,j]] <- NA
        possible[i,-j,problem[i,j]] <- NA
        possible[(floor((i-1)/3)*3 + 1):(floor((i-1)/3)*3 + 3),
                     (floor((j-1)/3)*3 + 1):(floor((j-1)/3)*3 + 3), 
                     problem[i,j]] <- NA
        possible[i,j,problem[i,j]] <- problem[i,j]  
      }
    }
  }
  
  collapsed_problem <- matrix(rep(NA, 81) |> as.numeric(), nrow = 9)
  
  for(j in 1:9) {
    for(i in 1:9) {
      if (table(possible[i, j, ]) |> length() == 1) {
        collapsed_problem[i, j] <- table(possible[i, j, ]) |> attr("dimnames") |> unlist() |> as.numeric()
      }
      for(k in 1:9) {
        if (table(possible[(floor((i-1)/3)*3+1):(floor((i-1)/3)*3+3),
                           (floor((j-1)/3)*3+1):(floor((j-1)/3)*3+3), 
                           k] ) == 1) { 
          offs <- which(
            possible[(floor((i-1)/3)*3+1):(floor((i-1)/3)*3+3),
                     (floor((j-1)/3)*3+1):(floor((j-1)/3)*3+3), 
                     k] == k,
            arr.ind = T)
          collapsed_problem[floor((i-1)/3)*3 + offs[1], floor((j-1)/3)*3 + offs[2]] <- k
        }
      }
    }
  }
  
  print(collapsed_problem)
  
  if (sum(problem, na.rm = T) == sum(collapsed_problem, na.rm = T) ||
      !any(is.na(collapsed_problem))
    ) { 
    problem <- collapsed_problem
    break
  }
  problem <- collapsed_problem
}

This code will iteratevely return the following results (I decided to use NA instead of 0 as NA supposes absence of value in a cell and 0 is a specific value):

      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
 [1,]    5    6   NA    8    4    7   NA   NA   NA
 [2,]    3   NA    9   NA   NA   NA    6    8   NA
 [3,]   NA   NA    8   NA    6    3   NA   NA   NA
 [4,]   NA    1   NA   NA    8   NA   NA    4   NA
 [5,]    7    9   NA    6    5    2   NA    1    8
 [6,]    8    5   NA   NA    3   NA    7    9   NA
 [7,]   NA   NA    5   NA   NA    8    2   NA    1
 [8,]   NA   NA    6   NA   NA   NA    8    3    7
 [9,]   NA   NA   NA    3    1    6    4    5    9
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
 [1,]    5    6   NA    8    4    7   NA    2   NA
 [2,]    3   NA    9   NA    2   NA    6    8   NA
 [3,]   NA   NA    8    9    6    3   NA    7   NA
 [4,]    6    1   NA    7    8    9   NA    4   NA
 [5,]    7    9   NA    6    5    2    3    1    8
 [6,]    8    5   NA   NA    3   NA    7    9   NA
 [7,]   NA    3    5   NA   NA    8    2    6    1
 [8,]    1   NA    6   NA   NA   NA    8    3    7
 [9,]    2    8   NA    3    1    6    4    5    9
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
 [1,]    5    6    1    8    4    7    9    2    3
 [2,]    3    7    9   NA    2   NA    6    8   NA
 [3,]    4    2    8    9    6    3   NA    7   NA
 [4,]    6    1    3    7    8    9    5    4   NA
 [5,]    7    9    4    6    5    2    3    1    8
 [6,]    8    5   NA   NA    3   NA    7    9    6
 [7,]    9    3    5    4    7    8    2    6    1
 [8,]    1    4    6    2    9   NA    8    3    7
 [9,]    2    8    7    3    1    6    4    5    9
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
 [1,]    5    6    1    8    4    7    9    2    3
 [2,]    3    7    9   NA    2   NA    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
      [,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

And finally solve the problem.

Mercia

Nice solution, +1! it is super efficient to get one solution, and also, a typical "backtracking" coding style, cheers! – Petition