R Under development (unstable) (2023-11-06 r85483 ucrt) -- "Unsuffered Consequences" Copyright (C) 2023 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > 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 ...) Mode: integer... [,1] [,2] [,3] [,4] [,5] [1,] 0 NA 2 3 4 [2,] NA 2 3 4 0 [3,] 2 3 4 0 1 [4,] 3 4 0 1 2 [5,] NA 0 1 2 3 [6,] 0 1 2 3 4 0 1 2 3 4 [1,] 1 0 1 1 1 1 [2,] 1 0 1 1 1 1 [3,] 1 1 1 1 1 0 [4,] 1 1 1 1 1 0 [5,] 1 1 1 1 0 1 [6,] 1 1 1 1 1 0 0 1 2 3 4 [1,] 2 0 1 1 0 2 [2,] 1 1 1 1 1 1 [3,] 1 1 2 1 1 0 [4,] 1 1 1 2 1 0 [5,] 1 1 1 1 2 0 0 1 2 [1,] 1 0 1 1 [2,] 1 0 1 1 [3,] 1 1 1 0 [4,] 1 1 1 0 [5,] 1 1 1 1 [6,] 1 1 1 0 0 1 2 [1,] 2 0 1 2 [2,] 1 1 1 1 [3,] 1 1 2 0 [4,] 1 1 1 0 [5,] 1 1 1 0 0x0 0x1 0x2 [1,] 1 0 1 [2,] 1 0 1 [3,] 1 1 1 [4,] 1 1 1 [5,] 1 1 1 [6,] 1 1 1 0x0 0x1 0x2 [1,] 1 0 1 [2,] 1 0 1 [3,] 1 1 1 [4,] 1 1 1 [5,] 1 1 1 [6,] 1 1 1 Mode: integer...done Mode: logical... [,1] [,2] [,3] [,4] [,5] [1,] TRUE NA FALSE TRUE TRUE [2,] NA FALSE TRUE TRUE TRUE [3,] FALSE TRUE TRUE TRUE TRUE [4,] TRUE TRUE TRUE TRUE FALSE [5,] NA TRUE TRUE FALSE TRUE [6,] TRUE TRUE FALSE TRUE TRUE FALSE TRUE [1,] 1 3 1 [2,] 1 3 1 [3,] 1 4 0 [4,] 1 4 0 [5,] 1 3 1 [6,] 1 4 0 FALSE TRUE [1,] 1 3 2 [2,] 1 4 1 [3,] 2 4 0 [4,] 1 5 0 [5,] 1 5 0 TRUE FALSE [1,] 3 1 1 [2,] 3 1 1 [3,] 4 1 0 [4,] 4 1 0 [5,] 3 1 1 [6,] 4 1 0 TRUE FALSE [1,] 3 1 2 [2,] 4 1 1 [3,] 4 2 0 [4,] 5 1 0 [5,] 5 1 0 Mode: logical...done Mode: raw... [,1] [,2] [,3] [,4] [,5] [1,] 00 01 02 03 04 [2,] 01 02 03 04 00 [3,] 02 03 04 00 01 [4,] 03 04 00 01 02 [5,] 04 00 01 02 03 [6,] 00 01 02 03 04 0x0 0x1 0x2 0x3 0x4 [1,] 1 1 1 1 1 [2,] 1 1 1 1 1 [3,] 1 1 1 1 1 [4,] 1 1 1 1 1 [5,] 1 1 1 1 1 [6,] 1 1 1 1 1 0x0 0x1 0x2 0x3 0x4 [1,] 2 1 1 1 1 [2,] 1 2 1 1 1 [3,] 1 1 2 1 1 [4,] 1 1 1 2 1 [5,] 1 1 1 1 2 0 1 2 [1,] 1 1 1 [2,] 1 1 1 [3,] 1 1 1 [4,] 1 1 1 [5,] 1 1 1 [6,] 1 1 1 0 1 2 [1,] 2 1 1 [2,] 1 2 1 [3,] 1 1 2 [4,] 1 1 1 [5,] 1 1 1 0x0 0x1 0x2 [1,] 1 1 1 [2,] 1 1 1 [3,] 1 1 1 [4,] 1 1 1 [5,] 1 1 1 [6,] 1 1 1 0x0 0x1 0x2 [1,] 1 1 1 [2,] 1 1 1 [3,] 1 1 1 [4,] 1 1 1 [5,] 1 1 1 [6,] 1 1 1 Mode: raw...done > > proc.time() user system elapsed 0.21 0.09 0.29