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") > > x <- matrix(1:27, ncol = 3) > > # To check names attribute > dimnames <- list(letters[1:9], LETTERS[1:3]) > > rowCollapse_R <- function(x, idxs, ..., useNames = NA) { + res <- x[, idxs] + # Preserve names attribute? + if (is.na(useNames) || !useNames) names(res) <- NULL + res + } > > idxs <- 1L > # 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)) { + y_truth <- rowCollapse_R(x, idxs, useNames = useNames) + y <- rowCollapse(x, idxs, useNames = useNames) + stopifnot(identical(y, y_truth)) + y2 <- colCollapse(t(x), idxs, useNames = useNames) + stopifnot(identical(y2, y)) + } + } > > idxs <- 2L > # 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)) { + y_truth <- rowCollapse_R(x, idxs, useNames = useNames) + y <- rowCollapse(x, idxs, useNames = useNames) + stopifnot(identical(y, y_truth)) + y2 <- colCollapse(t(x), idxs, useNames = useNames) + stopifnot(identical(y2, y)) + } + } > > > rowCollapse_R <- function(x, idxs, ..., useNames = NA) { + res <- c(x[1:5, 1], x[6:9, 3]) + # Preserve names attribute? + if (is.na(useNames) || !useNames) names(res) <- NULL + res + } > > idxs <- c(1, 1, 1, 1, 1, 3, 3, 3, 3) > # 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)) { + y_truth <- rowCollapse_R(x, idxs, useNames = useNames) + y <- rowCollapse(x, idxs, useNames = useNames) + stopifnot(identical(y, y_truth)) + y2 <- colCollapse(t(x), idxs, useNames = useNames) + stopifnot(identical(y2, y)) + } + } > > > rowCollapse_R <- function(x, idxs, ..., useNames = NA) { + res <- c(x[1, 1], x[2, 2], x[3, 3], x[4, 1], x[5, 2], + x[6, 3], x[7, 1], x[8, 2], x[9, 3]) + # Preserve names attribute? + if (isTRUE(useNames)) { + names <- rownames(x) + if (!is.null(names)) names(res) <- names + } + res + } > > idxs <- 1:3 > # 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)) { + y_truth <- rowCollapse_R(x, idxs, useNames = useNames) + y <- rowCollapse(x, idxs, useNames = useNames) + stopifnot(identical(y, y_truth)) + y2 <- colCollapse(t(x), idxs, useNames = useNames) + stopifnot(identical(y2, y)) + } + } > > proc.time() user system elapsed 0.21 0.01 0.21