library("matrixStats")
count_R <- function(x, value = TRUE, na.rm = FALSE, ...) {
if (is.na(value)) {
counts <- sum(is.na(x))
} else {
counts <- sum(x == value, na.rm = na.rm)
}
as.integer(counts)
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Data type: integer and numeric
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
for (mode in c("integer", "double")) {
x <- runif(20 * 5, min = -3, max = 3)
x[sample.int(length(x), size = 7)] <- 0
storage.mode(x) <- mode
for (na.rm in c(FALSE, TRUE)) {
# Count zeros
n0 <- count_R(x, value = 0, na.rm = na.rm)
n1 <- count(x, value = 0, na.rm = na.rm)
stopifnot(identical(n1, n0))
all <- allValue(x, value = 0, na.rm = na.rm)
any <- anyValue(x, value = 0, na.rm = na.rm)
# Count NAs
n0 <- count_R(x, value = NA, na.rm = na.rm)
n1 <- count(x, value = NA, na.rm = na.rm)
stopifnot(identical(n1, n0))
all <- allValue(x, value = NA, na.rm = na.rm)
any <- anyValue(x, value = NA, na.rm = na.rm)
if (mode == "integer") {
ux <- unique(as.vector(x))
n0 <- n1 <- integer(length(x))
for (value in ux) {
n0 <- n0 + count_R(x, value = value, na.rm = na.rm)
n1 <- n1 + count(x, value = value, na.rm = na.rm)
stopifnot(identical(n1, n0))
}
stopifnot(all(n0 == ncol(x)))
} # if (mode == "integer")
} # for (na.rm ...)
} # for (mode ...)
# All NAs
na_list <- list(NA_integer_, NA_real_, NaN)
for (na_value in na_list) {
x <- rep(na_value, times = 10L)
for (na.rm in c(FALSE, TRUE)) {
n0 <- count_R(x, na.rm = na.rm)
n1 <- count(x, na.rm = na.rm)
stopifnot(identical(n1, n0))
# Count NAs
n0 <- count_R(x, value = NA, na.rm = na.rm)
n1 <- count(x, value = NA, na.rm = na.rm)
stopifnot(identical(n1, n0))
any <- anyValue(x, value = NA, na.rm = na.rm)
all <- allValue(x, value = NA, na.rm = na.rm)
stopifnot(any)
stopifnot(all)
}
} # for (na_value ...)
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Data type: logical
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
x <- logical(length = 10L)
x[3:7] <- TRUE
# Row/column counts
for (na.rm in c(FALSE, TRUE)) {
n0 <- count_R(x, na.rm = na.rm)
n1 <- count(x, na.rm = na.rm)
stopifnot(identical(n1, n0))
n_true <- count(x, value = TRUE, na.rm = na.rm)
n_false <- count(x, value = FALSE, na.rm = na.rm)
stopifnot(n_true + n_false == ncol(x))
# Count NAs
n0 <- count_R(x, value = NA, na.rm = na.rm)
n1 <- count(x, value = NA, na.rm = na.rm)
stopifnot(identical(n1, n0))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.