uni/sose2021/r/w03/P03-3.R

# Josua Kugler, Christian Merten

## 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))
    if (print_missing) {
        apply(which(is.na(s), arr.ind=T), 1, function(x) cat("missing value at ", x[1], ",", x[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=""))
    }
    invisible(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)