#' Convert a matrix, vector, or string to a sudoku. Strings should be in the form "2..4.." etc, and have 81 characters
#'
#' @param x object to be converted to a sudoku
#' @param ... additional arguments.
#' @export
as.sudoku <- function(x, ...) UseMethod("as.sudoku")
#' @export
as.sudoku.matrix <- function(x, ...) {
if(nrow(x) != 9 | ncol(x) != 9) stop('matrix must be 9x9 to convert to sudoku')
x[is.na(x)] <- 0
structure(x, class = c('sudoku', 'matrix'))
}
as_sudoku_chr <- function(x, ...) {
s <- strsplit(x, "")[[1]]
s[s == "."] <- 0
s[is.na(s)] <- 0
s <- as.integer(s)
if(length(s) != 81) stop('sudoku must contain 81 elements')
as.sudoku(matrix(s, nrow = 9))
}
#' @export
as.sudoku.default <- function(x, ...) {
tryCatch({
if(is.vector(x)) {
if(is.character(x)) {
as_sudoku_chr(x)
} else if(is.numeric(x)) {
as.sudoku(matrix(x, nrow = 9))
}
}
}, error = function(e) print(e))
}
#' @export
as.matrix.sudoku <- function(x, ...) {
x[x == 0] <- NA
matrix(x, nrow = 9, ncol = 9)
}
#' Print a sudoku puzzle
#'
#' @param x an object of class sudoku.
#' @param ... additional arguments.
#' @export
print_sudoku <- function(x, ...) {
sdf <- cbind(x, cbind(matrix(rep(rep(NA, 9), 4), ncol = 4)))[,c(10,1:3,11,4:6,12,7:9,13)]
sdf <- rbind(sdf, rbind(matrix(rep(rep(NA, 13), 4), nrow = 4)))[c(10,1:3,11,4:6,12,7:9,13),]
sdf <- apply(sdf, 2, function(x) ifelse(is.na(x) | x == 0, '', x))
out <- matrix('', 13, 13)
for(i in 1:13) {
for(j in 1:13) {
if(i %in% c(1, 5, 9, 13) & j %in% c(1, 5, 9, 13)) {
out[i, j] <- '+'
} else if(i %in% c(1, 5, 9, 13)) {
out[i, j] <- '-'
} else if(j %in% c(1, 5, 9, 13)) {
out[i, j] <- '|'
} else {
out[i, j] <- sdf[i, j]
}
}
}
dimnames(out) <- list(rep('', 13), rep('', 13))
print(out, quote = F)
}
#' @export
print.sudoku <- function(x, ...) print_sudoku(x, ...)
#' Summarize a sudoku puzzle
#'
#' @param object an object of class sudoku.
#' @param ... additional arguments.
#' @export
summary.sudoku <- function(object, ...) analyze_sudoku(object, ...)
#' Solve a sudoku.
#'
#' @param a an object of class sudoku.
#' @param ... additional arguments.
#' @export
solve.sudoku <- function(a, ...) solve_sudoku(a, ...)
#' Verify that a sudoku is a sudoku.
#'
#' @param x an object of class sudoku.
#' @param ... additional arguments.
#' @export
is.sudoku <- function(x) inherits(x, "sudoku")
#' Plot a sudoku puzzle.
#' @importFrom graphics abline par plot text
#' @param x an object of class sudoku.
#' @param ... additional arguments.
#' @export
plot_sudoku <- function(x, ...) {
locations <- data.frame(xcoord = rep(seq(8.5, 0.5, -1), each = 9),
ycoord = rep(seq(0.5, 8.5, 1), 9),
answer = rev(c(x)))
par(mar = c(2, 2, 2, 2))
plot(0:9, 0:9, col = 'white', xaxt = 'n', yaxt = 'n', yaxs = 'i', xaxs = 'i')
abline(h = 0:9, v = 0:9, col = 'grey')
abline(h = c(0, 3, 6, 9), v = c(0, 3, 6, 9), lwd = 2)
text(locations$xcoord, locations$ycoord, locations$answer, cex = 2)
par(mar = c(5.1, 4.1, 4.1, 2.1))
}
#' @export
plot.sudoku <- function(x, ...) plot_sudoku(x, ...)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.