## 1. size <- function(mat) { return(attr(mat, "size")) } `size<-` <- function(x, value) { attributes(x)$size <- value return(x) } ## 2. sudoku <- function(mat, n=NULL, m=NULL) { attributes(mat)$class <- "sudoku" if (!is.matrix(mat)) { stopifnot("If mat is not a matrix, at n and m have to be specified" = !is.null(n) && !is.null(m)) mat <- matrix(mat, nrow=n*m) } else if (is.null(n)) { n <- nrow(mat) / m } else if (is.null(m)) { m <- nrow(mat) / n } size(mat) <- c(n, m) return(mat) } ## 3. is_sudoku <- function(s) { if (is.null(size(s))) { return(FALSE) } n <- size(s)[1] m <- size(s)[2] checks <- c(nrow(s) == ncol(s), nrow(s) == n*m, attr(s, "class") == "sudoku", s %in% c(NA, (1:(n*m)))) return(all(checks)) } ## 4. is_sub_valid <- function(x) { dups <- any(duplicated(x)) in_range <- all(x %in% c(NA, (1:length(x)))) return(in_range && !dups) } ## 5. partition_index <- function(n, m) { m1 <- matrix(rep(1:(n*m), each=n), nrow=n*m) m2 <- m1[, rep(1:n, each=m)] return(m2) } partition_index(3,2) ## 6. is_valid <- function(s) { stopifnot("s is not a sudoku!" = is_sudoku(s)) n <- size(s)[1] m <- size(s)[2] rows_valid <- sapply(1:(n*m), function(r) is_sub_valid(s[r,])) cols_valid <- sapply(1:(n*m), function(c) is_sub_valid(s[,c])) part <- partition_index(n, m) fields_valid <- sapply(1:(n*m), function(i) is_sub_valid(s[part == i])) return(all(c(fields_valid, cols_valid, fields_valid))) } is_filled_in <- function(s) { return(!any(is.na(s))) } is_solved <-function(s) { return(is_valid(s) && is_filled_in(s)) } ## 7. is_solution_of <- function(s, s_star) { return(is_solved(s_star) && all(s == s_star, na.rm=TRUE)) } ## 8. print_non_valid <- function(s, print_missing=T) { stopifnot("s is not a sudoku!" = is_sudoku(s)) s <- "" if (print_missing) { missing_fields <- which(is.na(s), arr.ind=T) if (nrow(missing_fields) > 0) sapply(1:nrow(missing_fields), function(r) cat("missing value at ", missing_fields[r,1], ",", missing_fields[r,2], "\n", sep="")) } n <- size(s)[1] m <- size(s)[2] rows_invalid <- which(sapply(1:(n*m), function(r) !is_sub_valid(s[r,]))) sapply(rows_invalid, function(x) cat("row ", x, " is invalid\n", sep="")) cols_invalid <- which(sapply(1:(n*m), function(c) !is_sub_valid(s[,c]))) sapply(cols_invalid, function(x) cat("column ", x, " is invalid\n", sep="")) part <- partition_index(n, m) fields <- matrix(1:(n*m), nrow=m) fields_invalid <- which(apply(fields, c(1,2), function(i) !is_sub_valid(s[part == i])), arr.ind=T) if (length(fields_invalid) > 0) { sapply(1:nrow(fields_invalid), function(r) cat("field ", fields_invalid[r,1], ",", fields_invalid[r,2], " is invalid\n", sep="")) } return(NULL) } ## TEST x <- matrix( c(5,2,6,4,3,1,6,1,3,2,5,4,3,4,1,5,2,6,2,6,4,3,1,5,1,3,5,6,4,2,4,5,2,1,6,3), ncol = 6) is_sudoku(x) s <- sudoku(x, 3, 2) s size(s) is_sudoku(s) is_filled_in(s) is_valid(s) is_solved(s) print_non_valid(s) size(s) <- c(2, 3) is_sudoku(s) is_filled_in(s) is_valid(s) is_solved(s) s_na <- s s_na[sample(36, 18)] <- NA s_na is_sudoku(s_na) is_filled_in(s_na) is_valid(s_na) is_solved(s_na) print_non_valid(s_na) s_not <- sudoku(sample(1:6, 36, replace=T), 2, 3) s_not[sample(36, 18)] <- NA s_not is_sudoku(s_not) is_filled_in(s_not) is_valid(s_not) is_solved(s_not) print_non_valid(s_not, print_missing=FALSE)