R Under development (unstable) (2023-12-09 r85665 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") > > rowCummins_R <- function(x, ..., useNames = NA) { + suppressWarnings({ + y <- t(apply(x, MARGIN = 1L, FUN = cummin)) + }) + + # Preserve dimnames attribute? + dim(y) <- dim(x) + dimnames(y) <- if (isTRUE(useNames)) dimnames(x) else NULL + y + } > > rowCummaxs_R <- function(x, ..., useNames = NA) { + mode <- storage.mode(x) + # Change mode because a bug is detected on cummax for integer in R-3.2.0 + storage.mode(x) <- "numeric" + suppressWarnings({ + y <- t(apply(x, MARGIN = 1L, FUN = cummax)) + }) + + # Preserve dimnames attribute? + dim(y) <- dim(x) + dimnames(y) <- if (isTRUE(useNames)) dimnames(x) else NULL + + y + } > > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # With and without some NAs > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > for (mode in c("logical", "integer", "double")) { + for (add_na in c(FALSE, TRUE)) { + cat("add_na = ", add_na, "\n", sep = "") + + x <- matrix(1:50, nrow = 10L, ncol = 5L) + diag(x) <- 0 + if (add_na) { + x[3:7, c(2, 4)] <- NA_real_ + } + cat("mode: ", mode, "\n", sep = "") + storage.mode(x) <- mode + str(x) + + # To check dimnames attribute + dimnames <- list(letters[1:10], LETTERS[1: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)) { + # Row/column ranges + r0 <- rowCummins_R(x, useNames = useNames) + r1 <- rowCummins(x, useNames = useNames) + r2 <- t(colCummins(t(x), useNames = useNames)) + stopifnot(all.equal(r1, r2)) + stopifnot(all.equal(r1, r0)) + stopifnot(all.equal(r2, r0)) + + r0 <- rowCummaxs_R(x, useNames = useNames) + r1 <- rowCummaxs(x, useNames = useNames) + r2 <- t(colCummaxs(t(x), useNames = useNames)) + stopifnot(all.equal(r1, r2)) + stopifnot(all.equal(r1, r0)) + stopifnot(all.equal(r2, r0)) + } # for (useNames ...) + } # for (setDimnames ...) + } # for (add_na ...) + } # for (mode ...) add_na = FALSE mode: logical logi [1:10, 1:5] FALSE TRUE TRUE TRUE TRUE TRUE ... add_na = TRUE mode: logical logi [1:10, 1:5] FALSE TRUE TRUE TRUE TRUE TRUE ... add_na = FALSE mode: integer int [1:10, 1:5] 0 2 3 4 5 6 7 8 9 10 ... add_na = TRUE mode: integer int [1:10, 1:5] 0 2 3 4 5 6 7 8 9 10 ... add_na = FALSE mode: double num [1:10, 1:5] 0 2 3 4 5 6 7 8 9 10 ... add_na = TRUE mode: double num [1:10, 1:5] 0 2 3 4 5 6 7 8 9 10 ... > > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # All NAs > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > for (mode in c("logical", "integer", "double")) { + x <- matrix(NA_real_, nrow = 10L, ncol = 5L) + cat("mode: ", mode, "\n", sep = "") + storage.mode(x) <- mode + str(x) + + # 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)) { + r0 <- rowCummins_R(x, useNames = useNames) + r1 <- rowCummins(x, useNames = useNames) + r2 <- t(colCummins(t(x), useNames = useNames)) + stopifnot(all.equal(r1, r2)) + stopifnot(all.equal(r1, r0)) + stopifnot(all.equal(r2, r0)) + + r0 <- rowCummaxs_R(x, useNames = useNames) + r1 <- rowCummaxs(x, useNames = useNames) + r2 <- t(colCummaxs(t(x), useNames = useNames)) + stopifnot(all.equal(r1, r2)) + stopifnot(all.equal(r1, r0)) + stopifnot(all.equal(r2, r0)) + } # for (useNames ...) + } # for (setDimnames ...) + } # for (mode ...) mode: logical logi [1:10, 1:5] NA NA NA NA NA NA ... mode: integer int [1:10, 1:5] NA NA NA NA NA NA NA NA NA NA ... mode: double num [1:10, 1:5] NA NA NA NA NA NA NA NA NA NA ... > > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # A 1x1 matrix > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > for (mode in c("logical", "integer", "double")) { + x <- matrix(0, nrow = 1L, ncol = 1L) + cat("mode: ", mode, "\n", sep = "") + storage.mode(x) <- mode + str(x) + + # To check dimnames attribute + dimnames <- list("a", "A") + + # 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)) { + r0 <- rowCummins_R(x, useNames = useNames) + r1 <- rowCummins(x, useNames = useNames) + r2 <- t(colCummins(t(x), useNames = useNames)) + stopifnot(all.equal(r1, r2)) + stopifnot(all.equal(r1, r0)) + stopifnot(all.equal(r2, r0)) + + r0 <- rowCummaxs_R(x, useNames = useNames) + r1 <- rowCummaxs(x, useNames = useNames) + r2 <- t(colCummaxs(t(x), useNames = useNames)) + stopifnot(all.equal(r1, r2)) + stopifnot(all.equal(r1, r0)) + stopifnot(all.equal(r2, r0)) + } # for (useNames ...) + } # for (setDimnames ...) + } # for (mode ...) mode: logical logi [1, 1] FALSE mode: integer int [1, 1] 0 mode: double num [1, 1] 0 > > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # Corner cases > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > for (mode in c("logical", "integer", "double")) { + cat("mode: ", mode, "\n", sep = "") + value <- 0 + storage.mode(value) <- mode + value0 <- if (mode == "logical") 0L else value + + # A 0x0 matrix + x <- matrix(value, nrow = 0L, ncol = 0L) + str(x) + r0 <- matrix(value0, nrow = nrow(x), ncol = ncol(x)) + r1 <- rowCummins(x) + r2 <- t(colCummins(t(x))) + stopifnot(all.equal(r1, r2)) + stopifnot(all.equal(r1, r0)) + stopifnot(all.equal(r2, r0)) + + # A 0xK matrix + x <- matrix(value, nrow = 0L, ncol = 5L) + str(x) + colnames <- LETTERS[1:5] + # Test with and without dimnames on x + for (setDimnames in c(TRUE, FALSE)) { + if (setDimnames) colnames(x) <- colnames + else dimnames(x) <- NULL + # Check names attribute + for (useNames in c(if (!matrixStats:::isUseNamesNADefunct()) NA, TRUE, FALSE)) { + r0 <- rowCummins_R(x, useNames = useNames) + r1 <- rowCummins(x, useNames = useNames) + r2 <- t(colCummins(t(x), useNames = useNames)) + stopifnot(all.equal(r1, r2)) + stopifnot(all.equal(r1, r0)) + stopifnot(all.equal(r2, r0)) + r0 <- rowCummaxs_R(x, useNames = useNames) + r1 <- rowCummaxs(x, useNames = useNames) + r2 <- t(colCummaxs(t(x), useNames = useNames)) + stopifnot(all.equal(r1, r2)) + stopifnot(all.equal(r1, r0)) + stopifnot(all.equal(r2, r0)) + } # for (useNames ...) + } # for (setDimnames ...) + + # A Nx0 matrix + x <- matrix(value, nrow = 5L, ncol = 0L) + str(x) + rownames <- LETTERS[1:5] + # Test with and without dimnames on x + for (setDimnames in c(TRUE, FALSE)) { + if (setDimnames) rownames(x) <- rownames + else dimnames(x) <- NULL + # Check names attribute + for (useNames in c(if (!matrixStats:::isUseNamesNADefunct()) NA, TRUE, FALSE)) { + r0 <- rowCummins_R(x, useNames = useNames) + r1 <- rowCummins(x, useNames = useNames) + r2 <- t(colCummins(t(x), useNames = useNames)) + stopifnot(all.equal(r1, r2)) + stopifnot(all.equal(r1, r0)) + stopifnot(all.equal(r2, r0)) + + r0 <- rowCummaxs_R(x, useNames = useNames) + r1 <- rowCummaxs(x, useNames = useNames) + r2 <- t(colCummaxs(t(x), useNames = useNames)) + stopifnot(all.equal(r1, r2)) + stopifnot(all.equal(r1, r0)) + stopifnot(all.equal(r2, r0)) + } # for (useNames ...) + } # for (setDimnames ...) + } # for (mode ...) mode: logical logi[0 , 0 ] logi[0 , 1:5] logi[1:5, 0 ] mode: integer int[0 , 0 ] int[0 , 1:5] int[1:5, 0 ] mode: double num[0 , 0 ] num[0 , 1:5] num[1:5, 0 ] > > proc.time() user system elapsed 0.35 0.01 0.35