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") > > indexByRow_R1 <- function(dim, idxs = NULL, ...) { + n <- prod(dim) + x <- matrix(seq_len(n), nrow = dim[2L], ncol = dim[1L], byrow = TRUE) + if (!is.null(idxs)) + x <- x[idxs] + as.vector(x) + } > > > indexByRow_R2 <- function(dim, idxs = NULL, ...) { + n <- prod(dim) + if (is.null(idxs)) { + x <- matrix(seq_len(n), nrow = dim[2L], ncol = dim[1L], byrow = TRUE) + as.vector(x) + } else { + idxs <- idxs - 1L + cols <- idxs %/% dim[2L] + rows <- idxs %% dim[2L] + cols + dim[1L] * rows + 1L + } + } > > > dim <- c(5L, 4L) > x <- matrix(NA_integer_, nrow = dim[1L], ncol = dim[2L]) > y <- t(x) > idxs_by_cols <- seq_along(x) > > # Assign by columns > x[idxs_by_cols] <- idxs_by_cols > print(x) [,1] [,2] [,3] [,4] [1,] 1 6 11 16 [2,] 2 7 12 17 [3,] 3 8 13 18 [4,] 4 9 14 19 [5,] 5 10 15 20 > > # Truth > y0 <- t(x) > idxs_by_rows <- as.vector(y0) > > # Assert > idxs <- indexByRow(dim) > stopifnot(all.equal(idxs, idxs_by_rows)) > y <- x > y[idxs_by_rows] <- idxs > print(y) [,1] [,2] [,3] [,4] [1,] 1 6 11 16 [2,] 2 7 12 17 [3,] 3 8 13 18 [4,] 4 9 14 19 [5,] 5 10 15 20 > stopifnot(all(as.vector(y) == as.vector(x))) > > idxs_R1 <- indexByRow_R1(dim) > stopifnot(all.equal(idxs_R1, idxs_by_rows)) > > idxs_R2 <- indexByRow_R2(dim) > stopifnot(all.equal(idxs_R2, idxs_by_rows)) > > # Assert > idxs_by_cols <- seq(from = 1, to = length(x), by = 3L) > idxs_by_rows <- as.vector(t(x)[idxs_by_cols]) > > idxs <- indexByRow(dim, idxs = idxs_by_cols) > stopifnot(all(idxs == idxs_by_rows)) > > idxs_R1 <- indexByRow_R1(dim, idxs = idxs_by_cols) > stopifnot(all(idxs_R1 == idxs_by_rows)) > > idxs_R2 <- indexByRow_R2(dim, idxs = idxs_by_cols) > stopifnot(all(idxs_R2 == idxs_by_rows)) > > > ## DEFUNCT: Backward compatibility > res <- tryCatch({ + idxs1 <- indexByRow(x) + }, error = identity) > stopifnot(inherits(res, "error")) > > > ## Exceptions: > ## Too large matrices are not supported, which happens > ## when prod(dim) > .Machine$integer.max > dim_too_large <- c(.Machine$integer.max, 2L) > res <- tryCatch({ + idxs <- indexByRow(dim_too_large, idxs = 1L) + }, error = identity) > stopifnot(inherits(res, "error")) > > ## Non-positive indices are not supported > res <- tryCatch({ + idxs <- indexByRow(c(1,1), idxs = 0L) + }, error = identity) > stopifnot(inherits(res, "error")) > > res <- tryCatch({ + idxs <- indexByRow(c(1,1), idxs = -1L) + }, error = identity) > stopifnot(inherits(res, "error")) > > proc.time() user system elapsed 0.14 0.04 0.17