Nothing
library("matrixStats")
nrow <- 6L
ncol <- 5L
data <- matrix(0:4, nrow = nrow, ncol = ncol)
# To check names attribute
dimnames <- list(letters[1:6], LETTERS[1:5])
modes <- c("integer", "logical", "raw")
for (mode in modes) {
cat(sprintf("Mode: %s...\n", mode))
x <- data
if (mode == "logical") x <- x - 2L
if (mode != "raw") x[c(2,5,7)] <- NA_integer_
storage.mode(x) <- mode
print(x)
unique_values <- unique(as.vector(x))
nbr_of_unique_values <- length(unique_values)
y <- rowTabulates(x)
print(y)
stopifnot(
identical(dim(y), c(nrow, nbr_of_unique_values)),
all(y >= 0)
)
if (mode != "raw") {
y0 <- t(table(x, row(x), useNA = "always")[, seq_len(nrow(x))])
stopifnot(all(y == y0))
}
# Check names attribute
dimnames(x) <- dimnames
y1 <- rowTabulates(x, useNames = FALSE)
stopifnot(all.equal(y1, y))
if (!matrixStats:::isUseNamesNADefunct()) {
y2 <- rowTabulates(x, useNames = NA)
stopifnot(all.equal(y2, y))
}
y <- rowTabulates(x, useNames = TRUE)
stopifnot(identical(rownames(y), rownames(x)))
dimnames(x) <- NULL
y <- colTabulates(x)
print(y)
stopifnot(
identical(dim(y), c(ncol, nbr_of_unique_values)),
all(y >= 0)
)
if (mode != "raw") {
y0 <- t(table(x, col(x), useNA = "always")[, seq_len(ncol(x))])
stopifnot(all(y == y0))
}
# Check names attribute
dimnames(x) <- dimnames
y1 <- colTabulates(x, useNames = FALSE)
stopifnot(all.equal(y1, y))
if (!matrixStats:::isUseNamesNADefunct()) {
y2 <- colTabulates(x, useNames = NA)
stopifnot(all.equal(y2, y))
}
y <- colTabulates(x, useNames = TRUE)
stopifnot(identical(rownames(y), colnames(x)))
dimnames(x) <- NULL
# Count only certain values
if (mode == "integer") {
subset <- c(0:2, NA_integer_)
} else if (mode == "logical") {
subset <- c(TRUE, FALSE, NA)
} else {
subset <- c(0:2)
}
y <- rowTabulates(x, values = subset)
print(y)
stopifnot(identical(dim(y), c(nrow, length(subset))))
# Check names attribute
dimnames(x) <- dimnames
y1 <- rowTabulates(x, values = subset, useNames = FALSE)
stopifnot(all.equal(y1, y))
if (!matrixStats:::isUseNamesNADefunct()) {
y2 <- rowTabulates(x, values = subset, useNames = NA)
stopifnot(all.equal(y2, y))
}
y <- rowTabulates(x, values = subset, useNames = TRUE)
stopifnot(identical(rownames(y), rownames(x)))
dimnames(x) <- NULL
y <- colTabulates(x, values = subset)
print(y)
stopifnot(identical(dim(y), c(ncol, length(subset))))
# Check names attribute
dimnames(x) <- dimnames
y1 <- colTabulates(x, values = subset, useNames = FALSE)
stopifnot(all.equal(y1, y))
if (!matrixStats:::isUseNamesNADefunct()) {
y2 <- colTabulates(x, values = subset, useNames = NA)
stopifnot(all.equal(y2, y))
}
y <- colTabulates(x, values = subset, useNames = TRUE)
stopifnot(identical(rownames(y), colnames(x)))
dimnames(x) <- NULL
# Raw
if (mode %in% c("integer", "raw")) {
subset <- c(0:2)
y <- rowTabulates(x, values = as.raw(subset))
print(y)
stopifnot(identical(dim(y), c(nrow, length(subset))))
# Check names attribute
dimnames(x) <- dimnames
y1 <- rowTabulates(x, values = as.raw(subset), useNames = FALSE)
stopifnot(all.equal(y1, y))
if (!matrixStats:::isUseNamesNADefunct()) {
y2 <- rowTabulates(x, values = as.raw(subset), useNames = NA)
stopifnot(all.equal(y2, y))
}
y3 <- rowTabulates(x, values = as.raw(subset), useNames = TRUE)
stopifnot(identical(rownames(y3), rownames(x)))
dimnames(x) <- NULL
y2 <- colTabulates(t(x), values = as.raw(subset))
print(y2)
stopifnot(
identical(dim(y2), c(nrow, length(subset))),
identical(y2, y)
)
# Check names attribute
dimnames(x) <- dimnames
y1 <- colTabulates(t(x), values = as.raw(subset), useNames = FALSE)
stopifnot(all.equal(y1, y))
if (!matrixStats:::isUseNamesNADefunct()) {
y2 <- colTabulates(t(x), values = as.raw(subset), useNames = NA)
stopifnot(all.equal(y2, y))
}
y <- colTabulates(t(x), values = as.raw(subset), useNames = TRUE)
stopifnot(identical(rownames(y), colnames(t(x))))
dimnames(x) <- NULL
}
cat(sprintf("Mode: %s...done\n", mode))
} # for (mode ...)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.