How to speed up index based assignment? - r

Question

I have a problem where the idea is to find unique elements of an extremely large matrix, apply some function (in this example, it is a sine function, but it can be an arbitrary function, even a trained neural net) to each unique element, and then replace it back in the original matrix.
I have the following R code snippet:
nrows <- 28000
ncols <- 3000
x <- matrix(round(runif(nrows*ncols, 1, 5), 5), nrow=nrows, ncol=ncols)
u <- unique(as.vector(x))
uindex <- seq(from=1, to=length(u), by=1)
ut <- sin(u)
for (hh in uindex) {
x[x == u[hh]] <- ut[hh]
}
In the above, code-snippet, the portion
for (hh in uindex) {
x[x == u[hh]] <- ut[hh]
}
takes forever to finish for the matrix dimension of order 1e4x1e3. How can I optimize the for loop?
Please note that this is just a minimal working example for Stackoverflow only. Hence, please refrain from telling me that I can do x = sin(x). My point is the for loop.

Answer 1

To expand on my comment regarding avoiding the for loop entirely...
As OP knows, using loops in R is generally slow and if there's an alternative, it's likely to be faster. One answer that avoids the for loop has already been provided. Here is another, with benchmarking.
To start, turn the OP's code into a function.
withForLoop <- function(nrows=28000, ncols=3000) {
x <- matrix(round(runif(nrows*ncols, 1, 5), 5), nrow=nrows, ncol=ncols)
u <- unique(as.vector(x))
uindex <- seq(from=1, to=length(u), by=1)
ut <- sin(u)
for (hh in uindex) {
x[x == u[hh]] <- ut[hh]
}
}
and benchmark it
library(microbenchmark)
microbenchmark(withForLoop, times=100)
Unit: nanoseconds
expr min lq mean median uq max neval
withForLoop 47 49 83.46 49 55 3226 100
So we are trying to beat a median time of 49 nanoseconds. (You could, of course, pick any other summary statistic as your target metric.)
Now rewrite the code using the tidyverse. OP's code starts with a matrix, converts it to a vector and then manipulates the vector. It's not clear if the matrix needs to be recovered. Assume it does, so provide the means to recover it, but - for consistency with OP's code - don't do the recovery.
library(tidyverse)
withTidyverse <- function(nrows=28000, ncols=3000) {
x <- tibble() %>%
expand(
Row=1:nrows,
Col=1:ncols
) %>%
mutate(
Random=round(runif(nrow(.), 1, 5), 5),
Sin=sin(Random)
)
}
microbenchmark(withTidyverse, times=100)
Unit: nanoseconds
expr min lq mean median uq max neval
withTidyverse1 41 42 52.21 42.5 43 964 100
So that's reduced the median execution time to 42.5 nanoseconds on my machine. That's a saving of just over 13%.
Because sin is a relatively quick function I've not bothered to search for unique values and replace each unique value in a batch. I've just taken a blunderbuss approach and recalculated each value in the vector as it arises. Here's a way of taking the more sophisticated, "replace unique values in batches" approach:
withTidyverse2 <- function(nrows=28000, ncols=3000) {
x <- tibble() %>%
expand(
Row=1:nrows,
Col=1:ncols
) %>%
mutate(
Random=round(runif(nrow(.), 1, 5), 5)
)
y <- x %>%
distinct(Random) %>%
mutate(Sin=sin(Random))
x <- x %>%
left_join(y, by="Random")
}
microbenchmark(withTidyverse2, times=100)
Unit: nanoseconds
expr min lq mean median uq max neval
withTidyverse2 44 45 82.31 45.5 51 2543 100
So, in this specific case, the overhead of extracting the unique values and updating in batches is not worthwhile, although it is still quicker than the for loop. OP will have to investigate their actual use case.
There are, of course, lots of other ways to address the actual problem. Which one is optimal is impossible to say based on the information provided.

Answer 2

Here is a data.table based solution:
nrows <- 28000
ncols <- 3000
x <- round(runif(nrows*ncols, 1, 5), 5)
u <- unique(as.vector(x))
uindex = seq(from = 1, to = length(u), by = 1)
dt.x <- data.table(x)
dt.u <- data.table(u)
dt.u[, ut := sin(u)]
dt.res <- merge(dt.x, dt.u, by.x = "x", by.y = "u", all.x = TRUE)
ut <- dt.res[, ut]
output <- matrix(ut, nrow=nrows, ncol=ncols)
Main idea here, is to work with the vectors and tables. I think you can convert to the matrix at the very end.

Answer 3

You could use match:
nrows <- 28000
ncols <- 3000
x <- matrix(round(runif(nrows*ncols, 1, 5), 5), nrow=nrows, ncol=ncols)
u <- unique(as.vector(x))
ut <- sin(u)
i <- match(x, u)
ut[i]