R version 4.4.0 beta (2024-04-09 r86391 ucrt) -- "Puppy Cup" 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") > > rowDiffs_R <- function(x, lag = 1L, differences = 1L, ..., useNames = NA) { + ncol2 <- ncol(x) - lag * differences + if (ncol2 <= 0) { + y <- matrix(x[integer(0L)], nrow = nrow(x), ncol = 0L) + # Preserve names attribute + if (isTRUE(useNames) && !is.null(rownames(x))) rownames(y) <- rownames(x) + return(y) + } + suppressWarnings({ + y <- apply(x, MARGIN = 1L, FUN = diff, lag = lag, differences = differences) + }) + y <- t(y) + + # Preserve dimnames attribute + dim(y) <- c(nrow(x), ncol2) + if (isTRUE(useNames) && !is.null(dimnames(x))) { + colnames <- colnames(x) + if (!is.null(colnames)) { + len <- length(colnames) + colnames <- colnames[(len - ncol2 + 1):len] + } + dimnames(y) <- list(rownames(x), colnames) + } + else dimnames(y) <- NULL + + y + } > > > set.seed(0x42) > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # With and without some NAs > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > for (mode in c("integer", "double")) { + cat("mode: ", mode, "\n", sep = "") + + for (add_na in c(FALSE, TRUE)) { + cat("add_na = ", add_na, "\n", sep = "") + + x <- matrix(sample(10 * 8) + 0.1, nrow = 10L, ncol = 8L) + if (add_na) { + x[3:7, c(2, 4)] <- NA_real_ + } + storage.mode(x) <- mode + str(x) + + dimnames <- list(letters[1:10], LETTERS[1:8]) + + # Test with and without dimnames on x + for (setDimnames in c(TRUE, FALSE)) { + if (setDimnames) dimnames(x) <- dimnames + else dimnames(x) <- NULL + # Check dimnames attribute + for (useNames in c(if (!matrixStats:::isUseNamesNADefunct()) NA, TRUE, FALSE)) { + for (lag in 1:4) { + for (differences in 1:3) { + cat(sprintf("mode: %s, lag = %d, differences = %d\n", + mode, lag, differences)) + # Row/column ranges + r0 <- rowDiffs_R(x, lag = lag, differences = differences, useNames = useNames) + r1 <- rowDiffs(x, lag = lag, differences = differences, useNames = useNames) + r2 <- t(colDiffs(t(x), lag = lag, differences = differences, useNames = useNames)) + stopifnot(all.equal(r1, r0)) + stopifnot(all.equal(r2, r0)) + stopifnot(all.equal(r1, r2)) + } + } + } # for (useNames ...) + } # for (setDimnames ...) + } # for (add_na ...) + } # for (mode ...) mode: integer add_na = FALSE int [1:10, 1:8] 68 26 29 47 48 10 1 38 16 40 ... mode: integer, lag = 1, differences = 1 mode: integer, lag = 1, differences = 2 mode: integer, lag = 1, differences = 3 mode: integer, lag = 2, differences = 1 mode: integer, lag = 2, differences = 2 mode: integer, lag = 2, differences = 3 mode: integer, lag = 3, differences = 1 mode: integer, lag = 3, differences = 2 mode: integer, lag = 3, differences = 3 mode: integer, lag = 4, differences = 1 mode: integer, lag = 4, differences = 2 mode: integer, lag = 4, differences = 3 mode: integer, lag = 1, differences = 1 mode: integer, lag = 1, differences = 2 mode: integer, lag = 1, differences = 3 mode: integer, lag = 2, differences = 1 mode: integer, lag = 2, differences = 2 mode: integer, lag = 2, differences = 3 mode: integer, lag = 3, differences = 1 mode: integer, lag = 3, differences = 2 mode: integer, lag = 3, differences = 3 mode: integer, lag = 4, differences = 1 mode: integer, lag = 4, differences = 2 mode: integer, lag = 4, differences = 3 mode: integer, lag = 1, differences = 1 mode: integer, lag = 1, differences = 2 mode: integer, lag = 1, differences = 3 mode: integer, lag = 2, differences = 1 mode: integer, lag = 2, differences = 2 mode: integer, lag = 2, differences = 3 mode: integer, lag = 3, differences = 1 mode: integer, lag = 3, differences = 2 mode: integer, lag = 3, differences = 3 mode: integer, lag = 4, differences = 1 mode: integer, lag = 4, differences = 2 mode: integer, lag = 4, differences = 3 mode: integer, lag = 1, differences = 1 mode: integer, lag = 1, differences = 2 mode: integer, lag = 1, differences = 3 mode: integer, lag = 2, differences = 1 mode: integer, lag = 2, differences = 2 mode: integer, lag = 2, differences = 3 mode: integer, lag = 3, differences = 1 mode: integer, lag = 3, differences = 2 mode: integer, lag = 3, differences = 3 mode: integer, lag = 4, differences = 1 mode: integer, lag = 4, differences = 2 mode: integer, lag = 4, differences = 3 add_na = TRUE int [1:10, 1:8] 80 71 7 52 79 22 31 10 29 63 ... mode: integer, lag = 1, differences = 1 mode: integer, lag = 1, differences = 2 mode: integer, lag = 1, differences = 3 mode: integer, lag = 2, differences = 1 mode: integer, lag = 2, differences = 2 mode: integer, lag = 2, differences = 3 mode: integer, lag = 3, differences = 1 mode: integer, lag = 3, differences = 2 mode: integer, lag = 3, differences = 3 mode: integer, lag = 4, differences = 1 mode: integer, lag = 4, differences = 2 mode: integer, lag = 4, differences = 3 mode: integer, lag = 1, differences = 1 mode: integer, lag = 1, differences = 2 mode: integer, lag = 1, differences = 3 mode: integer, lag = 2, differences = 1 mode: integer, lag = 2, differences = 2 mode: integer, lag = 2, differences = 3 mode: integer, lag = 3, differences = 1 mode: integer, lag = 3, differences = 2 mode: integer, lag = 3, differences = 3 mode: integer, lag = 4, differences = 1 mode: integer, lag = 4, differences = 2 mode: integer, lag = 4, differences = 3 mode: integer, lag = 1, differences = 1 mode: integer, lag = 1, differences = 2 mode: integer, lag = 1, differences = 3 mode: integer, lag = 2, differences = 1 mode: integer, lag = 2, differences = 2 mode: integer, lag = 2, differences = 3 mode: integer, lag = 3, differences = 1 mode: integer, lag = 3, differences = 2 mode: integer, lag = 3, differences = 3 mode: integer, lag = 4, differences = 1 mode: integer, lag = 4, differences = 2 mode: integer, lag = 4, differences = 3 mode: integer, lag = 1, differences = 1 mode: integer, lag = 1, differences = 2 mode: integer, lag = 1, differences = 3 mode: integer, lag = 2, differences = 1 mode: integer, lag = 2, differences = 2 mode: integer, lag = 2, differences = 3 mode: integer, lag = 3, differences = 1 mode: integer, lag = 3, differences = 2 mode: integer, lag = 3, differences = 3 mode: integer, lag = 4, differences = 1 mode: integer, lag = 4, differences = 2 mode: integer, lag = 4, differences = 3 mode: double add_na = FALSE num [1:10, 1:8] 36.1 15.1 27.1 63.1 62.1 58.1 28.1 19.1 41.1 3.1 ... mode: double, lag = 1, differences = 1 mode: double, lag = 1, differences = 2 mode: double, lag = 1, differences = 3 mode: double, lag = 2, differences = 1 mode: double, lag = 2, differences = 2 mode: double, lag = 2, differences = 3 mode: double, lag = 3, differences = 1 mode: double, lag = 3, differences = 2 mode: double, lag = 3, differences = 3 mode: double, lag = 4, differences = 1 mode: double, lag = 4, differences = 2 mode: double, lag = 4, differences = 3 mode: double, lag = 1, differences = 1 mode: double, lag = 1, differences = 2 mode: double, lag = 1, differences = 3 mode: double, lag = 2, differences = 1 mode: double, lag = 2, differences = 2 mode: double, lag = 2, differences = 3 mode: double, lag = 3, differences = 1 mode: double, lag = 3, differences = 2 mode: double, lag = 3, differences = 3 mode: double, lag = 4, differences = 1 mode: double, lag = 4, differences = 2 mode: double, lag = 4, differences = 3 mode: double, lag = 1, differences = 1 mode: double, lag = 1, differences = 2 mode: double, lag = 1, differences = 3 mode: double, lag = 2, differences = 1 mode: double, lag = 2, differences = 2 mode: double, lag = 2, differences = 3 mode: double, lag = 3, differences = 1 mode: double, lag = 3, differences = 2 mode: double, lag = 3, differences = 3 mode: double, lag = 4, differences = 1 mode: double, lag = 4, differences = 2 mode: double, lag = 4, differences = 3 mode: double, lag = 1, differences = 1 mode: double, lag = 1, differences = 2 mode: double, lag = 1, differences = 3 mode: double, lag = 2, differences = 1 mode: double, lag = 2, differences = 2 mode: double, lag = 2, differences = 3 mode: double, lag = 3, differences = 1 mode: double, lag = 3, differences = 2 mode: double, lag = 3, differences = 3 mode: double, lag = 4, differences = 1 mode: double, lag = 4, differences = 2 mode: double, lag = 4, differences = 3 add_na = TRUE num [1:10, 1:8] 67.1 80.1 45.1 8.1 39.1 66.1 27.1 71.1 47.1 46.1 ... mode: double, lag = 1, differences = 1 mode: double, lag = 1, differences = 2 mode: double, lag = 1, differences = 3 mode: double, lag = 2, differences = 1 mode: double, lag = 2, differences = 2 mode: double, lag = 2, differences = 3 mode: double, lag = 3, differences = 1 mode: double, lag = 3, differences = 2 mode: double, lag = 3, differences = 3 mode: double, lag = 4, differences = 1 mode: double, lag = 4, differences = 2 mode: double, lag = 4, differences = 3 mode: double, lag = 1, differences = 1 mode: double, lag = 1, differences = 2 mode: double, lag = 1, differences = 3 mode: double, lag = 2, differences = 1 mode: double, lag = 2, differences = 2 mode: double, lag = 2, differences = 3 mode: double, lag = 3, differences = 1 mode: double, lag = 3, differences = 2 mode: double, lag = 3, differences = 3 mode: double, lag = 4, differences = 1 mode: double, lag = 4, differences = 2 mode: double, lag = 4, differences = 3 mode: double, lag = 1, differences = 1 mode: double, lag = 1, differences = 2 mode: double, lag = 1, differences = 3 mode: double, lag = 2, differences = 1 mode: double, lag = 2, differences = 2 mode: double, lag = 2, differences = 3 mode: double, lag = 3, differences = 1 mode: double, lag = 3, differences = 2 mode: double, lag = 3, differences = 3 mode: double, lag = 4, differences = 1 mode: double, lag = 4, differences = 2 mode: double, lag = 4, differences = 3 mode: double, lag = 1, differences = 1 mode: double, lag = 1, differences = 2 mode: double, lag = 1, differences = 3 mode: double, lag = 2, differences = 1 mode: double, lag = 2, differences = 2 mode: double, lag = 2, differences = 3 mode: double, lag = 3, differences = 1 mode: double, lag = 3, differences = 2 mode: double, lag = 3, differences = 3 mode: double, lag = 4, differences = 1 mode: double, lag = 4, differences = 2 mode: double, lag = 4, differences = 3 > > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # All NAs > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > for (mode in c("integer", "double")) { + cat("mode: ", mode, "\n", sep = "") + x <- matrix(NA_real_, nrow = 10L, ncol = 5L) + storage.mode(x) <- mode + str(x) + + 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 dimnames attribute + for (useNames in c(if (!matrixStats:::isUseNamesNADefunct()) NA, TRUE, FALSE)) { + r0 <- rowDiffs_R(x, useNames = useNames) + r1 <- rowDiffs(x, useNames = useNames) + r2 <- t(colDiffs(t(x), useNames = useNames)) + stopifnot(all.equal(r1, r0)) + stopifnot(all.equal(r2, r0)) + stopifnot(all.equal(r1, r2)) + } # for (useNames ...) + } # for (setDimnames ...) + } # for (mode ...) 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 > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > x <- matrix(0, nrow = 1L, ncol = 1L) > 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 dimnames attribute + for (useNames in c(if (!matrixStats:::isUseNamesNADefunct()) NA, TRUE, FALSE)) { + r0 <- rowDiffs_R(x, useNames = useNames) + r1 <- rowDiffs(x, useNames = useNames) + r2 <- t(colDiffs(t(x), useNames = useNames)) + stopifnot(all.equal(r1, r0)) + stopifnot(all.equal(r2, r0)) + stopifnot(all.equal(r1, r2)) + } # for (useNames ...) + } # for (setDimnames ...) > > proc.time() user system elapsed 0.37 0.03 0.34