R Under development (unstable) (2024-09-02 r87090 ucrt) -- "Unsuffered Consequences" Copyright (C) 2024 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") > > ## Create isFALSE() if running on an old version of R > if (!exists("isFALSE", mode="function")) { + isFALSE <- function(x) is.logical(x) && length(x) == 1L && !is.na(x) && !x + } > > rowQuantiles_R <- function(x, probs = c(0, 0.25, 0.50, 0.75, 1), na.rm = FALSE, drop = TRUE, type = 7L, ..., useNames = NA) { + q <- apply(x, MARGIN = 1L, FUN = function(x, probs, na.rm) { + if (!na.rm && any(is.na(x))) { + na_value <- NA_real_ + if (type != 7L) storage.mode(na_value) <- storage.mode(x) + rep(na_value, times = length(probs)) + } else { + as.vector(quantile(x, probs = probs, na.rm = na.rm, type = type, names = FALSE, ...)) + } + }, probs = probs, na.rm = na.rm) + + if (!is.null(dim(q))) q <- t(q) + else dim(q) <- c(nrow(x), length(probs)) + + colnames(q) <- matrixStats:::quantile_probs_names(probs) + rownames(q) <- rownames(x) + if (isFALSE(useNames)) dimnames(q) <- NULL + + if (drop) q <- drop(q) + q + } > > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # Test with multiple quantiles > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - > for (mode in c("logical", "integer", "double")) { + cat("mode: ", mode, "\n", sep = "") + x <- matrix(1:40 + 0.1, nrow = 8, ncol = 5) + storage.mode(x) <- mode + dimnames <- lapply(dim(x), FUN = function(n) letters[seq_len(n)]) + str(x) + + probs <- c(0, 0.5, 1) + # Test with and without dimnames on x + for (setDimnames in c(TRUE, FALSE)) { + if (setDimnames) dimnames(x) <- dimnames + else dimnames(x) <- NULL + # Check names attribute + for (useNames in c(if (!matrixStats:::isUseNamesNADefunct()) NA, TRUE, FALSE)) { + q0 <- rowQuantiles_R(x, probs = probs, useNames = useNames) + print(q0) + q1 <- rowQuantiles(x, probs = probs, useNames = useNames) + print(q1) + ## FIXME: Workaround for R (< 3.0.0) + if (getRversion() < "3.0.0" && mode == "logical") storage.mode(q1) <- storage.mode(q0) + stopifnot(all.equal(q1, q0)) + q2 <- colQuantiles(t(x), probs = probs, useNames = useNames) + ## FIXME: Workaround for R (< 3.0.0) + if (getRversion() < "3.0.0" && mode == "logical") storage.mode(q2) <- storage.mode(q0) + stopifnot(all.equal(q2, q0)) + } + } + } # for (mode ...) mode: logical logi [1:8, 1:5] TRUE TRUE TRUE TRUE TRUE TRUE ... 0% 50% 100% a 1 1 1 b 1 1 1 c 1 1 1 d 1 1 1 e 1 1 1 f 1 1 1 g 1 1 1 h 1 1 1 0% 50% 100% a 1 1 1 b 1 1 1 c 1 1 1 d 1 1 1 e 1 1 1 f 1 1 1 g 1 1 1 h 1 1 1 [,1] [,2] [,3] [1,] 1 1 1 [2,] 1 1 1 [3,] 1 1 1 [4,] 1 1 1 [5,] 1 1 1 [6,] 1 1 1 [7,] 1 1 1 [8,] 1 1 1 [,1] [,2] [,3] [1,] 1 1 1 [2,] 1 1 1 [3,] 1 1 1 [4,] 1 1 1 [5,] 1 1 1 [6,] 1 1 1 [7,] 1 1 1 [8,] 1 1 1 0% 50% 100% [1,] 1 1 1 [2,] 1 1 1 [3,] 1 1 1 [4,] 1 1 1 [5,] 1 1 1 [6,] 1 1 1 [7,] 1 1 1 [8,] 1 1 1 0% 50% 100% [1,] 1 1 1 [2,] 1 1 1 [3,] 1 1 1 [4,] 1 1 1 [5,] 1 1 1 [6,] 1 1 1 [7,] 1 1 1 [8,] 1 1 1 [,1] [,2] [,3] [1,] 1 1 1 [2,] 1 1 1 [3,] 1 1 1 [4,] 1 1 1 [5,] 1 1 1 [6,] 1 1 1 [7,] 1 1 1 [8,] 1 1 1 [,1] [,2] [,3] [1,] 1 1 1 [2,] 1 1 1 [3,] 1 1 1 [4,] 1 1 1 [5,] 1 1 1 [6,] 1 1 1 [7,] 1 1 1 [8,] 1 1 1 mode: integer int [1:8, 1:5] 1 2 3 4 5 6 7 8 9 10 ... 0% 50% 100% a 1 17 33 b 2 18 34 c 3 19 35 d 4 20 36 e 5 21 37 f 6 22 38 g 7 23 39 h 8 24 40 0% 50% 100% a 1 17 33 b 2 18 34 c 3 19 35 d 4 20 36 e 5 21 37 f 6 22 38 g 7 23 39 h 8 24 40 [,1] [,2] [,3] [1,] 1 17 33 [2,] 2 18 34 [3,] 3 19 35 [4,] 4 20 36 [5,] 5 21 37 [6,] 6 22 38 [7,] 7 23 39 [8,] 8 24 40 [,1] [,2] [,3] [1,] 1 17 33 [2,] 2 18 34 [3,] 3 19 35 [4,] 4 20 36 [5,] 5 21 37 [6,] 6 22 38 [7,] 7 23 39 [8,] 8 24 40 0% 50% 100% [1,] 1 17 33 [2,] 2 18 34 [3,] 3 19 35 [4,] 4 20 36 [5,] 5 21 37 [6,] 6 22 38 [7,] 7 23 39 [8,] 8 24 40 0% 50% 100% [1,] 1 17 33 [2,] 2 18 34 [3,] 3 19 35 [4,] 4 20 36 [5,] 5 21 37 [6,] 6 22 38 [7,] 7 23 39 [8,] 8 24 40 [,1] [,2] [,3] [1,] 1 17 33 [2,] 2 18 34 [3,] 3 19 35 [4,] 4 20 36 [5,] 5 21 37 [6,] 6 22 38 [7,] 7 23 39 [8,] 8 24 40 [,1] [,2] [,3] [1,] 1 17 33 [2,] 2 18 34 [3,] 3 19 35 [4,] 4 20 36 [5,] 5 21 37 [6,] 6 22 38 [7,] 7 23 39 [8,] 8 24 40 mode: double num [1:8, 1:5] 1.1 2.1 3.1 4.1 5.1 6.1 7.1 8.1 9.1 10.1 ... 0% 50% 100% a 1.1 17.1 33.1 b 2.1 18.1 34.1 c 3.1 19.1 35.1 d 4.1 20.1 36.1 e 5.1 21.1 37.1 f 6.1 22.1 38.1 g 7.1 23.1 39.1 h 8.1 24.1 40.1 0% 50% 100% a 1.1 17.1 33.1 b 2.1 18.1 34.1 c 3.1 19.1 35.1 d 4.1 20.1 36.1 e 5.1 21.1 37.1 f 6.1 22.1 38.1 g 7.1 23.1 39.1 h 8.1 24.1 40.1 [,1] [,2] [,3] [1,] 1.1 17.1 33.1 [2,] 2.1 18.1 34.1 [3,] 3.1 19.1 35.1 [4,] 4.1 20.1 36.1 [5,] 5.1 21.1 37.1 [6,] 6.1 22.1 38.1 [7,] 7.1 23.1 39.1 [8,] 8.1 24.1 40.1 [,1] [,2] [,3] [1,] 1.1 17.1 33.1 [2,] 2.1 18.1 34.1 [3,] 3.1 19.1 35.1 [4,] 4.1 20.1 36.1 [5,] 5.1 21.1 37.1 [6,] 6.1 22.1 38.1 [7,] 7.1 23.1 39.1 [8,] 8.1 24.1 40.1 0% 50% 100% [1,] 1.1 17.1 33.1 [2,] 2.1 18.1 34.1 [3,] 3.1 19.1 35.1 [4,] 4.1 20.1 36.1 [5,] 5.1 21.1 37.1 [6,] 6.1 22.1 38.1 [7,] 7.1 23.1 39.1 [8,] 8.1 24.1 40.1 0% 50% 100% [1,] 1.1 17.1 33.1 [2,] 2.1 18.1 34.1 [3,] 3.1 19.1 35.1 [4,] 4.1 20.1 36.1 [5,] 5.1 21.1 37.1 [6,] 6.1 22.1 38.1 [7,] 7.1 23.1 39.1 [8,] 8.1 24.1 40.1 [,1] [,2] [,3] [1,] 1.1 17.1 33.1 [2,] 2.1 18.1 34.1 [3,] 3.1 19.1 35.1 [4,] 4.1 20.1 36.1 [5,] 5.1 21.1 37.1 [6,] 6.1 22.1 38.1 [7,] 7.1 23.1 39.1 [8,] 8.1 24.1 40.1 [,1] [,2] [,3] [1,] 1.1 17.1 33.1 [2,] 2.1 18.1 34.1 [3,] 3.1 19.1 35.1 [4,] 4.1 20.1 36.1 [5,] 5.1 21.1 37.1 [6,] 6.1 22.1 38.1 [7,] 7.1 23.1 39.1 [8,] 8.1 24.1 40.1 > > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # Test with a single quantile > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - > for (mode in c("logical", "integer", "double")) { + cat("mode: ", mode, "\n", sep = "") + x <- matrix(1:40, nrow = 8, ncol = 5) + storage.mode(x) <- mode + dimnames <- lapply(dim(x), FUN = function(n) letters[seq_len(n)]) + str(x) + + probs <- c(0.5) + # Test with and without dimnames on x + for (setDimnames in c(TRUE, FALSE)) { + if (setDimnames) dimnames(x) <- dimnames + else dimnames(x) <- NULL + # Check names attribute + for (useNames in c(if (!matrixStats:::isUseNamesNADefunct()) NA, TRUE, FALSE)) { + q0 <- rowQuantiles_R(x, probs = probs, useNames = useNames) + print(q0) + q1 <- rowQuantiles(x, probs = probs, useNames = useNames) + ## FIXME: Workaround for R (< 3.0.0) + if (getRversion() < "3.0.0" && mode == "logical") storage.mode(q1) <- storage.mode(q0) + print(q1) + stopifnot(all.equal(q1, q0)) + q2 <- colQuantiles(t(x), probs = probs, useNames = useNames) + ## FIXME: Workaround for R (< 3.0.0) + if (getRversion() < "3.0.0" && mode == "logical") storage.mode(q2) <- storage.mode(q0) + stopifnot(all.equal(q2, q0)) + } + } + } # for (mode ...) mode: logical logi [1:8, 1:5] TRUE TRUE TRUE TRUE TRUE TRUE ... a b c d e f g h 1 1 1 1 1 1 1 1 a b c d e f g h 1 1 1 1 1 1 1 1 [1] 1 1 1 1 1 1 1 1 [1] 1 1 1 1 1 1 1 1 [1] 1 1 1 1 1 1 1 1 [1] 1 1 1 1 1 1 1 1 [1] 1 1 1 1 1 1 1 1 [1] 1 1 1 1 1 1 1 1 mode: integer int [1:8, 1:5] 1 2 3 4 5 6 7 8 9 10 ... a b c d e f g h 17 18 19 20 21 22 23 24 a b c d e f g h 17 18 19 20 21 22 23 24 [1] 17 18 19 20 21 22 23 24 [1] 17 18 19 20 21 22 23 24 [1] 17 18 19 20 21 22 23 24 [1] 17 18 19 20 21 22 23 24 [1] 17 18 19 20 21 22 23 24 [1] 17 18 19 20 21 22 23 24 mode: double num [1:8, 1:5] 1 2 3 4 5 6 7 8 9 10 ... a b c d e f g h 17 18 19 20 21 22 23 24 a b c d e f g h 17 18 19 20 21 22 23 24 [1] 17 18 19 20 21 22 23 24 [1] 17 18 19 20 21 22 23 24 [1] 17 18 19 20 21 22 23 24 [1] 17 18 19 20 21 22 23 24 [1] 17 18 19 20 21 22 23 24 [1] 17 18 19 20 21 22 23 24 > > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # Consistency checks > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - > set.seed(1) > > probs <- seq(from = 0, to = 1, by = 0.25) > > cat("Consistency checks:\n") Consistency checks: > n_sims <- if (Sys.getenv("_R_CHECK_USE_VALGRIND_") != "") 6L else 24L > for (kk in seq_len(n_sims)) { + cat("Random test #", kk, "\n", sep = "") + + # Simulate data in a matrix of any shape + dim <- sample(20:60, size = 2L) + n <- prod(dim) + x <- rnorm(n, sd = 100) + dim(x) <- dim + dimnames <- lapply(dim(x), FUN = function(n) rep(letters, length.out = n)) + + # Add NAs? + has_na <- ((kk %% 2) == 0L) + if (has_na) { + cat("Adding NAs\n") + nna <- sample(n, size = 1) + na_values <- c(NA_real_, NaN) + t <- sample(na_values, size = nna, replace = TRUE) + x[sample(length(x), size = nna)] <- t + } + + # Logical, integer, or double? + mode <- "numeric" + if ((kk %% 6) %in% 1:2) { + cat("Coercing to logical\n") + mode <- "logical" + } else if ((kk %% 6) %in% 3:4) { + cat("Coercing to integers\n") + mode <- "integer" + } + storage.mode(x) <- mode + + str(x) + + # rowQuantiles(): + for (type in 1:9) { + cat(sprintf("type=%d, has_na=%s:\n", type, has_na)) + # Test with and without dimnames on x + for (setDimnames in c(TRUE, FALSE)) { + if (setDimnames) dimnames(x) <- dimnames + else dimnames(x) <- NULL + # Check names attribute + for (useNames in c(if (!matrixStats:::isUseNamesNADefunct()) NA, TRUE, FALSE)) { + q0 <- rowQuantiles_R(x, probs = probs, na.rm = has_na, type = type, useNames = useNames) + q1 <- rowQuantiles(x, probs = probs, na.rm = has_na, type = type, useNames = useNames) + ## FIXME: Workaround for R (< 3.0.0) + if (getRversion() < "3.0.0" && mode == "logical" && !has_na && type == 7L) storage.mode(q1) <- storage.mode(q0) + stopifnot(all.equal(q1, q0)) + q2 <- colQuantiles(t(x), probs = probs, na.rm = has_na, type = type, useNames = useNames) + ## FIXME: Workaround for R (< 3.0.0) + if (getRversion() < "3.0.0" && mode == "logical" && !has_na && type == 7L) storage.mode(q2) <- storage.mode(q0) + stopifnot(all.equal(q2, q0)) + } + } + } + } # for (kk ...) Random test #1 Coercing to logical logi [1:23, 1:58] TRUE TRUE TRUE TRUE TRUE TRUE ... type=1, has_na=FALSE: type=2, has_na=FALSE: type=3, has_na=FALSE: type=4, has_na=FALSE: type=5, has_na=FALSE: type=6, has_na=FALSE: type=7, has_na=FALSE: type=8, has_na=FALSE: type=9, has_na=FALSE: Random test #2 Adding NAs Coercing to logical logi [1:58, 1:33] TRUE TRUE TRUE TRUE TRUE NA ... type=1, has_na=TRUE: type=2, has_na=TRUE: type=3, has_na=TRUE: type=4, has_na=TRUE: type=5, has_na=TRUE: type=6, has_na=TRUE: type=7, has_na=TRUE: type=8, has_na=TRUE: type=9, has_na=TRUE: Random test #3 Coercing to integers int [1:28, 1:60] 119 -164 115 -129 209 -175 2 -32 120 -28 ... type=1, has_na=FALSE: type=2, has_na=FALSE: type=3, has_na=FALSE: type=4, has_na=FALSE: type=5, has_na=FALSE: type=6, has_na=FALSE: type=7, has_na=FALSE: type=8, has_na=FALSE: type=9, has_na=FALSE: Random test #4 Adding NAs Coercing to integers int [1:54, 1:35] 147 11 116 -50 NA -69 132 NA 114 NA ... type=1, has_na=TRUE: type=2, has_na=TRUE: type=3, has_na=TRUE: type=4, has_na=TRUE: type=5, has_na=TRUE: type=6, has_na=TRUE: type=7, has_na=TRUE: type=8, has_na=TRUE: type=9, has_na=TRUE: Random test #5 num [1:39, 1:53] 5.94 -27.16 -30.78 173 126.05 ... type=1, has_na=FALSE: type=2, has_na=FALSE: type=3, has_na=FALSE: type=4, has_na=FALSE: type=5, has_na=FALSE: type=6, has_na=FALSE: type=7, has_na=FALSE: type=8, has_na=FALSE: type=9, has_na=FALSE: Random test #6 Adding NAs num [1:46, 1:22] 197 -107 15 148 -110 ... type=1, has_na=TRUE: type=2, has_na=TRUE: type=3, has_na=TRUE: type=4, has_na=TRUE: type=5, has_na=TRUE: type=6, has_na=TRUE: type=7, has_na=TRUE: type=8, has_na=TRUE: type=9, has_na=TRUE: Random test #7 Coercing to logical logi [1:21, 1:51] TRUE TRUE TRUE TRUE TRUE TRUE ... type=1, has_na=FALSE: type=2, has_na=FALSE: type=3, has_na=FALSE: type=4, has_na=FALSE: type=5, has_na=FALSE: type=6, has_na=FALSE: type=7, has_na=FALSE: type=8, has_na=FALSE: type=9, has_na=FALSE: Random test #8 Adding NAs Coercing to logical logi [1:33, 1:53] NA NA TRUE TRUE TRUE TRUE ... type=1, has_na=TRUE: type=2, has_na=TRUE: type=3, has_na=TRUE: type=4, has_na=TRUE: type=5, has_na=TRUE: type=6, has_na=TRUE: type=7, has_na=TRUE: type=8, has_na=TRUE: type=9, has_na=TRUE: Random test #9 Coercing to integers int [1:53, 1:24] -73 10 -73 -5 44 -107 -100 95 58 -50 ... type=1, has_na=FALSE: type=2, has_na=FALSE: type=3, has_na=FALSE: type=4, has_na=FALSE: type=5, has_na=FALSE: type=6, has_na=FALSE: type=7, has_na=FALSE: type=8, has_na=FALSE: type=9, has_na=FALSE: Random test #10 Adding NAs Coercing to integers int [1:44, 1:20] NA -140 NA -57 -252 NA NA 20 NA NA ... type=1, has_na=TRUE: type=2, has_na=TRUE: type=3, has_na=TRUE: type=4, has_na=TRUE: type=5, has_na=TRUE: type=6, has_na=TRUE: type=7, has_na=TRUE: type=8, has_na=TRUE: type=9, has_na=TRUE: Random test #11 num [1:54, 1:23] -160.87 74.13 196.08 7.27 4.92 ... type=1, has_na=FALSE: type=2, has_na=FALSE: type=3, has_na=FALSE: type=4, has_na=FALSE: type=5, has_na=FALSE: type=6, has_na=FALSE: type=7, has_na=FALSE: type=8, has_na=FALSE: type=9, has_na=FALSE: Random test #12 Adding NAs num [1:59, 1:27] -139.2 -86.3 NA -40.7 NA ... type=1, has_na=TRUE: type=2, has_na=TRUE: type=3, has_na=TRUE: type=4, has_na=TRUE: type=5, has_na=TRUE: type=6, has_na=TRUE: type=7, has_na=TRUE: type=8, has_na=TRUE: type=9, has_na=TRUE: Random test #13 Coercing to logical logi [1:53, 1:60] TRUE TRUE TRUE TRUE TRUE TRUE ... type=1, has_na=FALSE: type=2, has_na=FALSE: type=3, has_na=FALSE: type=4, has_na=FALSE: type=5, has_na=FALSE: type=6, has_na=FALSE: type=7, has_na=FALSE: type=8, has_na=FALSE: type=9, has_na=FALSE: Random test #14 Adding NAs Coercing to logical logi [1:22, 1:57] TRUE TRUE TRUE TRUE TRUE TRUE ... type=1, has_na=TRUE: type=2, has_na=TRUE: type=3, has_na=TRUE: type=4, has_na=TRUE: type=5, has_na=TRUE: type=6, has_na=TRUE: type=7, has_na=TRUE: type=8, has_na=TRUE: type=9, has_na=TRUE: Random test #15 Coercing to integers int [1:20, 1:34] 78 -41 183 190 -71 37 0 -4 -86 27 ... type=1, has_na=FALSE: type=2, has_na=FALSE: type=3, has_na=FALSE: type=4, has_na=FALSE: type=5, has_na=FALSE: type=6, has_na=FALSE: type=7, has_na=FALSE: type=8, has_na=FALSE: type=9, has_na=FALSE: Random test #16 Adding NAs Coercing to integers int [1:42, 1:37] NA 12 -15 41 -28 17 NA -74 NA NA ... type=1, has_na=TRUE: type=2, has_na=TRUE: type=3, has_na=TRUE: type=4, has_na=TRUE: type=5, has_na=TRUE: type=6, has_na=TRUE: type=7, has_na=TRUE: type=8, has_na=TRUE: type=9, has_na=TRUE: Random test #17 num [1:42, 1:29] -50.51 -6.51 -117.59 135.58 226.87 ... type=1, has_na=FALSE: type=2, has_na=FALSE: type=3, has_na=FALSE: type=4, has_na=FALSE: type=5, has_na=FALSE: type=6, has_na=FALSE: type=7, has_na=FALSE: type=8, has_na=FALSE: type=9, has_na=FALSE: Random test #18 Adding NAs num [1:57, 1:39] 223 156.8 -44.6 -127.5 -147.7 ... type=1, has_na=TRUE: type=2, has_na=TRUE: type=3, has_na=TRUE: type=4, has_na=TRUE: type=5, has_na=TRUE: type=6, has_na=TRUE: type=7, has_na=TRUE: type=8, has_na=TRUE: type=9, has_na=TRUE: Random test #19 Coercing to logical logi [1:52, 1:57] TRUE TRUE TRUE TRUE TRUE TRUE ... type=1, has_na=FALSE: type=2, has_na=FALSE: type=3, has_na=FALSE: type=4, has_na=FALSE: type=5, has_na=FALSE: type=6, has_na=FALSE: type=7, has_na=FALSE: type=8, has_na=FALSE: type=9, has_na=FALSE: Random test #20 Adding NAs Coercing to logical logi [1:25, 1:48] NA TRUE NA NA NA NA ... type=1, has_na=TRUE: type=2, has_na=TRUE: type=3, has_na=TRUE: type=4, has_na=TRUE: type=5, has_na=TRUE: type=6, has_na=TRUE: type=7, has_na=TRUE: type=8, has_na=TRUE: type=9, has_na=TRUE: Random test #21 Coercing to integers int [1:53, 1:27] 3 -30 203 -49 19 -45 -138 28 46 -44 ... type=1, has_na=FALSE: type=2, has_na=FALSE: type=3, has_na=FALSE: type=4, has_na=FALSE: type=5, has_na=FALSE: type=6, has_na=FALSE: type=7, has_na=FALSE: type=8, has_na=FALSE: type=9, has_na=FALSE: Random test #22 Adding NAs Coercing to integers int [1:48, 1:36] -131 NA NA -201 45 -17 NA 57 NA NA ... type=1, has_na=TRUE: type=2, has_na=TRUE: type=3, has_na=TRUE: type=4, has_na=TRUE: type=5, has_na=TRUE: type=6, has_na=TRUE: type=7, has_na=TRUE: type=8, has_na=TRUE: type=9, has_na=TRUE: Random test #23 num [1:23, 1:43] -99.2 -68.8 -86.7 -104.2 48 ... type=1, has_na=FALSE: type=2, has_na=FALSE: type=3, has_na=FALSE: type=4, has_na=FALSE: type=5, has_na=FALSE: type=6, has_na=FALSE: type=7, has_na=FALSE: type=8, has_na=FALSE: type=9, has_na=FALSE: Random test #24 Adding NAs num [1:53, 1:29] NaN -67.6 10.8 -88.4 130.1 ... type=1, has_na=TRUE: type=2, has_na=TRUE: type=3, has_na=TRUE: type=4, has_na=TRUE: type=5, has_na=TRUE: type=6, has_na=TRUE: type=7, has_na=TRUE: type=8, has_na=TRUE: type=9, has_na=TRUE: > > > > for (mode in c("logical", "integer", "double")) { + naValue <- NA_real_ + storage.mode(naValue) <- mode + + someValue <- 1 + storage.mode(someValue) <- mode + + for (type in 1:9) { + # - - - - - - - - - - - - - - - - - - - - - - - - - - - - + # All NA + # - - - - - - - - - - - - - - - - - - - - - - - - - - - - + x <- matrix(naValue, nrow = 3L, ncol = 4L) + dimnames <- lapply(dim(x), FUN = function(n) letters[seq_len(n)]) + # Test with and without dimnames on x + for (setDimnames in c(TRUE, FALSE)) { + if (setDimnames) dimnames(x) <- dimnames + else dimnames(x) <- NULL + # Check names attribute + for (useNames in c(if (!matrixStats:::isUseNamesNADefunct()) NA, TRUE, FALSE)) { + qr0 <- rowQuantiles_R(x, type = type, useNames = useNames) + + qr <- rowQuantiles(x, type = type, useNames = useNames) + stopifnot(identical(qr, qr0)) + + # x <- matrix(naValue, nrow = 4L, ncol = 3L) + qc <- colQuantiles(t(x), type = type, useNames = useNames) + + stopifnot(identical(qc, qr)) + } + } + + + # - - - - - - - - - - - - - - - - - - - - - - - - - - - - + # Empty matrices + # - - - - - - - - - - - - - - - - - - - - - - - - - - - - + probs <- c(0, 0.25, 0.75, 1) + x <- matrix(naValue, nrow = 0L, ncol = 0L) + dimnames(x) <- lapply(dim(x), FUN = function(n) letters[seq_len(n)]) + q <- rowQuantiles(x, probs = probs, type = type, useNames = TRUE) + stopifnot(identical(dim(q), c(nrow(x), length(probs)))) + q <- colQuantiles(x, probs = probs, type = type, useNames = TRUE) + stopifnot(identical(dim(q), c(ncol(x), length(probs)))) + + x <- matrix(naValue, nrow = 2L, ncol = 0L) + dimnames(x) <- lapply(dim(x), FUN = function(n) letters[seq_len(n)]) + q <- rowQuantiles(x, probs = probs, type = type, useNames = TRUE) + stopifnot(identical(dim(q), c(nrow(x), length(probs)))) + + x <- matrix(naValue, nrow = 0L, ncol = 2L) + dimnames(x) <- lapply(dim(x), FUN = function(n) letters[seq_len(n)]) + q <- colQuantiles(x, probs = probs, type = type, useNames = TRUE) + stopifnot(identical(dim(q), c(ncol(x), length(probs)))) + + + # - - - - - - - - - - - - - - - - - - - - - - - - - - - - + # Single column matrices + # - - - - - - - - - - - - - - - - - - - - - - - - - - - - + probs <- c(0, 0.25, 0.75, 1) + x <- matrix(someValue, nrow = 2L, ncol = 1L) + dimnames(x) <- lapply(dim(x), FUN = function(n) letters[seq_len(n)]) + qr <- rowQuantiles(x, probs = probs, type = type, useNames = TRUE) + print(qr) + + x <- matrix(someValue, nrow = 1L, ncol = 2L) + dimnames(x) <- lapply(dim(x), FUN = function(n) letters[seq_len(n)]) + qc <- colQuantiles(x, probs = probs, type = type, useNames = TRUE) + print(qc) + + stopifnot(identical(qc, qr)) + } + } 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 0% 25% 75% 100% a 1 1 1 1 b 1 1 1 1 > > proc.time() user system elapsed 13.87 0.28 14.10