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") > > rowIQRs_R <- function(x, na.rm = FALSE, ..., useNames = NA) { + quantile_na <- function(x, ..., na.rm = FALSE) { + if (!na.rm && anyMissing(x)) + return(c(NA_real_, NA_real_)) + quantile(x, ..., na.rm = na.rm) + } + q <- apply(x, MARGIN = 1L, FUN = quantile_na, + probs = c(0.25, 0.75), na.rm = na.rm) + rownames(q) <- NULL # Not needed anymore + + # Preserve names attribute + dim(q) <- c(2L, nrow(x)) + colnames(q) <- if (isTRUE(useNames)) rownames(x) else NULL + + q[2L, , drop = TRUE] - q[1L, , drop = TRUE] + } > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # Test with multiple quantiles > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - > for (mode in c("integer", "double")) { + cat("mode: ", mode, "\n", sep = "") + x <- matrix(1:100 + 0.1, nrow = 10, ncol = 10) + storage.mode(x) <- mode + str(x) + + # To check names attribute + dimnames <- list(letters[1:10], LETTERS[1:10]) + + for (add_na in c(FALSE, TRUE)) { + if (add_na) { + x[3:5, 6:9] <- NA + } + # Test with and without dimnames on x + for (setDimnames in c(TRUE, FALSE)) { + if (setDimnames) dimnames(x) <- dimnames + else dimnames(x) <- NULL + for (na.rm in c(FALSE, TRUE)) { + # Check names attribute + for (useNames in c(if (!matrixStats:::isUseNamesNADefunct()) NA, TRUE, FALSE)) { + probs <- c(0, 0.5, 1) + q0 <- rowIQRs_R(x, na.rm = na.rm, useNames = useNames) + print(q0) + q1 <- rowIQRs(x, na.rm = na.rm, useNames = useNames) + print(q1) + stopifnot(all.equal(q1, q0)) + q2 <- colIQRs(t(x), na.rm = na.rm, useNames = useNames) + stopifnot(all.equal(q2, q0)) + + q <- iqr(x[3, ], na.rm = na.rm) + print(q) + } # for (useNames ...) + } # for (na.rm ...) + } # for (setDimnames ...) + } # for (add_na ...) + } # for (mode ...) mode: integer int [1:10, 1:10] 1 2 3 4 5 6 7 8 9 10 ... a b c d e f g h i j 45 45 45 45 45 45 45 45 45 45 a b c d e f g h i j 45 45 45 45 45 45 45 45 45 45 [1] 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 a b c d e f g h i j 45 45 45 45 45 45 45 45 45 45 a b c d e f g h i j 45 45 45 45 45 45 45 45 45 45 [1] 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 a b c d e f g h i j 45 45 NA NA NA 45 45 45 45 45 a b c d e f g h i j 45 45 NA NA NA 45 45 45 45 45 [1] NA [1] 45 45 NA NA NA 45 45 45 45 45 [1] 45 45 NA NA NA 45 45 45 45 45 [1] NA a b c d e f g h i j 45 45 25 25 25 45 45 45 45 45 a b c d e f g h i j 45 45 25 25 25 45 45 45 45 45 [1] 25 [1] 45 45 25 25 25 45 45 45 45 45 [1] 45 45 25 25 25 45 45 45 45 45 [1] 25 [1] 45 45 NA NA NA 45 45 45 45 45 [1] 45 45 NA NA NA 45 45 45 45 45 [1] NA [1] 45 45 NA NA NA 45 45 45 45 45 [1] 45 45 NA NA NA 45 45 45 45 45 [1] NA [1] 45 45 25 25 25 45 45 45 45 45 [1] 45 45 25 25 25 45 45 45 45 45 [1] 25 [1] 45 45 25 25 25 45 45 45 45 45 [1] 45 45 25 25 25 45 45 45 45 45 [1] 25 mode: double num [1:10, 1:10] 1.1 2.1 3.1 4.1 5.1 6.1 7.1 8.1 9.1 10.1 ... a b c d e f g h i j 45 45 45 45 45 45 45 45 45 45 a b c d e f g h i j 45 45 45 45 45 45 45 45 45 45 [1] 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 a b c d e f g h i j 45 45 45 45 45 45 45 45 45 45 a b c d e f g h i j 45 45 45 45 45 45 45 45 45 45 [1] 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 45 45 45 45 45 45 45 45 45 [1] 45 a b c d e f g h i j 45 45 NA NA NA 45 45 45 45 45 a b c d e f g h i j 45 45 NA NA NA 45 45 45 45 45 [1] NA [1] 45 45 NA NA NA 45 45 45 45 45 [1] 45 45 NA NA NA 45 45 45 45 45 [1] NA a b c d e f g h i j 45 45 25 25 25 45 45 45 45 45 a b c d e f g h i j 45 45 25 25 25 45 45 45 45 45 [1] 25 [1] 45 45 25 25 25 45 45 45 45 45 [1] 45 45 25 25 25 45 45 45 45 45 [1] 25 [1] 45 45 NA NA NA 45 45 45 45 45 [1] 45 45 NA NA NA 45 45 45 45 45 [1] NA [1] 45 45 NA NA NA 45 45 45 45 45 [1] 45 45 NA NA NA 45 45 45 45 45 [1] NA [1] 45 45 25 25 25 45 45 45 45 45 [1] 45 45 25 25 25 45 45 45 45 45 [1] 25 [1] 45 45 25 25 25 45 45 45 45 45 [1] 45 45 25 25 25 45 45 45 45 45 [1] 25 > > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # Test corner cases > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - > for (mode in c("integer", "double")) { + cat("mode: ", mode, "\n", sep = "") + # Empty vectors + x <- integer(0L) + storage.mode(x) <- mode + str(x) + q <- iqr(x) + print(q) + stopifnot(identical(q, NA_real_)) + + # Scalar + x <- 1L + storage.mode(x) <- mode + str(x) + q <- iqr(x) + str(q) + stopifnot(identical(q, 0)) + } mode: integer int(0) [1] NA int 1 num 0 mode: double num(0) [1] NA num 1 num 0 > > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # Single row matrices > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - > x <- matrix(1, nrow = 1L, ncol = 2L) > dimnames <- list("a", LETTERS[1:2]) > # 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 <- rowIQRs_R(x, useNames = useNames) + q1 <- rowIQRs(x, useNames = useNames) + q2 <- colIQRs(t(x), useNames = useNames) + stopifnot(all.equal(q0, q1)) + stopifnot(all.equal(q0, q2)) + } + } > > x <- matrix(1, nrow = 2L, ncol = 1L) > q <- colIQRs(x) > stopifnot(identical(q, 0)) > > proc.time() user system elapsed 0.37 0.09 0.46