3
\$\begingroup\$

I have a list of 2D matrices. Each matrix is filled using the function “fillMatrices”. This function adds a number of individuals to each day 0 in a matrix and updates the columns “a_M”, “b_M” and “c_M”. The numbers of individuals come from an initial matrix “ind”. The code works but it is slow when the number of matrices within the list is large. For example with n = 10000:

user  system elapsed 
3.73    0.83    4.55

Here is the code:

rm(list=ls(all=TRUE))
library(ff)
library(dplyr)
set.seed(12345)

## Define the number of individuals
n <- 10000

###############################################
###############################################
## Section 1
## Build the list of 2D matrices
v_date <- as.vector(outer(c(paste(seq(0, 1, by = 1), "day", sep="_"), paste(seq(2, 5, by = 1), "days", sep="_")), c("a_M", "b_M", "c_M"), paste, sep="|"))
col_mat <- c("year", "day", "time", "ID", "died", v_date)
list_matrices <- list()
for(i in 1:n){
  print(i)
  list_matrices[[i]] <- ff(-999, dim=c(3650, length(col_mat)), dimnames=list(NULL, col_mat), vmode="double", overwrite = TRUE)
}
## test <- list_matrices[[1]]
## dim(list_matrices[[1]])

## Fill the first row of each matrix
for(i in 1:n){
  print(i)
  list_matrices[[i]][1,] <- c(1, 1, 1, i-1, 0, rep(0, length(v_date)))
}
## test <- list_matrices[[2]]

## Build the matrix "individual"
ind <- as.matrix(data.frame(year = rep(1, n), day = rep(1, n), time = rep(1, n), died = rep(0, n), ID = (seq(1, n, 1))- 1, a_M = sample(1:10, n, replace = T), b_M = sample(1:10, n, replace = T), c_M = sample(1:10, n, replace = T)))
## print(ind)

###############################################
###############################################
## Section 2
## Function to convert a data frame into a matrix
convertDFToMat <- function(x){
  mat <- as.matrix(x[,-1])
  ifelse(is(x[,1], "data.frame"), rownames(mat) <- pull(x[,1]), rownames(mat) <- x[,1])
  ## Convert character matrix into numeric matrix
  mat <- apply(mat, 2, as.numeric)

  return(mat)
}

## Define the function that is used to fill the matrices within the list
fillMatrices <- function(dt_t_1, species, maxDuration, matrixColumns){

  ## Format data
  dt <- as.data.frame(dt_t_1) %>% 
    reshape::melt(id = c("ID")) %>% 
    arrange(ID) %>%
    dplyr::mutate_all(as.character)
  ## summary(dt)

  ## Break out the variable "variable" into different columns, with one row for each individual-day
  dt_reshape_filter_1 <- dt %>%
    dplyr::filter(!variable %in% c("year", "day", "time", "ID", "died")) %>%
    dplyr::mutate(day = variable %>% gsub(pattern = "\\_.*", replacement = "", x = .), col  = variable %>% gsub(pattern = ".*\\|", replacement = "", x = .)) %>%
    dplyr::select(-variable) %>%
    tidyr::spread(col, value) %>%
    dplyr::mutate_all(as.numeric) %>%
    dplyr::arrange(ID, day)
  ## summary(dt_reshape_filter_1)

  ## Apply requested transformations and build the data frame
  dt_transform <- dt_reshape_filter_1 %>% 
    dplyr::rename_at(vars(species), ~ c("a", "b", "c")) %>%
    dplyr::mutate(day = day + 1) %>% 
    dplyr::filter(day < maxDuration + 1) %>% 
    dplyr::bind_rows(tibble(ID = ind[,c("ID")], day = 0, a = ind[,c("a_M")], b = ind[,c("b_M")])) %>%
    dplyr::mutate(c = a + b) %>%
    dplyr::rename_at(vars("a", "b", "c"), ~ species) %>%
    dplyr::arrange(ID, day)
  ## summary(dt_transform)

  ## Take different columns of the data frame and gather them into a single column
  dt_gather <- dt_transform %>% 
    tidyr::gather(variable, value, species) %>% 
    dplyr::mutate(day = if_else(day > 1, paste0(day, "_days"), paste0(day, "_day"))) %>% 
    tidyr::unite(variable, c("day", "variable"), sep = "|") %>%
    dplyr::rename(var2 = ID) %>%
    dplyr::mutate_all(as.character)
  ## summary(dt_gather)

  ## Add the other columns in the data frame and convert the resulting data frame into a matrix
  dt_reshape_filter_2 <- dt %>%
    dplyr::rename(var2 = ID) %>%
    dplyr::filter(variable %in% c("year", "day", "time", "ID", "died")) %>%
    tidyr::spread(variable, value) %>%
    dplyr::arrange(as.numeric(var2)) %>%
    dplyr::mutate(year = ind[,c("year")], 
                  day = ind[,c("day")], 
                  time = ind[,c("time")],
                  ID = ind[,c("ID")],
                  died = ind[,c("died")]) %>%
    tidyr::gather(variable, value, c(year, day, time, ID, died)) %>%
    dplyr::arrange(as.numeric(var2)) %>%
    dplyr::mutate_all(as.character)
  ## summary(dt_reshape_filter_2)

  ## Build the output matrix         
  dt_bind <- bind_rows(dt_reshape_filter_2, dt_gather) %>%
    tidyr::spread(var2, value) %>%
    dplyr::arrange(match(variable, matrixColumns)) %>%
    dplyr::select("variable", as.character(ind[,c("ID")]))
  ## summary(dt_bind)
  dt_mat <- convertDFToMat(dt_bind)
  ## summary(dt_mat)

  return(dt_mat)

} 

###############################################
###############################################
## Section 3
## Run the function "fillMatrices"
indexTime <- 1
dt_t_1 <- do.call(rbind, lapply(list_matrices, function(x) x[1,]))
dt_t <- fillMatrices(dt_t_1 = dt_t_1, species = c("a_M", "b_M", "c_M"), maxDuration = 5, matrixColumns = col_mat)

## Fill the matrices within the list
system.time(for(i in 1:n){
list_matrices[[i]][indexTime + 1,] <- dt_t[,i]
})

## test <- list_matrices[[1]]

If possible, I would like to reduce the elapsed time to <= 1 sec and increase the n to 720000 matrices. I think that the code is slow because I use different data structures (i.e., both matrices and data frames) at each time step (see the function "fillMatrices" in the section 2). In addition, the loop “for” is not efficient enough (see loop "for" in the section 3). I don’t look for way to optimize the section 1 in the code because this section is used only to initialize the matrices. In my example, the function is used to fill matrices for one species. In reality, the function is used for 3 species (i.e., is applied three times) by changing the argument “species = c("a_M", "b_M", "c_M")”. How can I speed up my code? Any advice would be much appreciated.

\$\endgroup\$
4
  • 2
    \$\begingroup\$ Preallocating the list should make this code faster without making any major changes list_matrices <- vector(mode = "list", length = n) \$\endgroup\$ Aug 1, 2019 at 10:47
  • \$\begingroup\$ Thank you very much for your answer. How can I fill the lists using list_matrices <- vector(mode = "list", length = n) ? \$\endgroup\$
    – Pierre
    Aug 9, 2019 at 21:41
  • \$\begingroup\$ could you confirm whether the preallocation sped this up? Maybe post some timings, please \$\endgroup\$
    – Russ Hyde
    Sep 6, 2019 at 14:08
  • \$\begingroup\$ I can confirm that the pre-allocation took 6120 to 5650 ms. \$\endgroup\$
    – Mossa
    Apr 6, 2021 at 14:22

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Browse other questions tagged or ask your own question.