按R中列表中的行高效填充2D矩阵

我有一个2D矩阵列表。使用函数

fillmatries

填充每个矩阵。此函数用于向矩阵中的每天0添加多个个体，并更新列

a_M

、

b_M

和

c_M

。个体数量来自初始矩阵

ind

。该代码可以工作，但当列表中的矩阵数量很大时，它会很慢。例如，当n=10000时：

user  system elapsed 
3.73    0.83    4.55

---

如果可能的话，我想减少花费的时间，以制作一个3D数组，而不是2D矩阵列表，这样您就有了更多的选择

library(ff)
library(dplyr)
set.seed(12345)

## Define the number of individuals
n <- 10000L
n_row <- 3650L

#array way:
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)

arr1 <- ff(-999L, dim = c(n_row, length(col_mat), n), dimnames = list(NULL, col_mat, NULL))

## Fill the first row of each matrix slice
arr1[1, , ] <- c(1L, 1L, 1L, NA, 0L, rep(0L, length(v_date)))
arr1[1, 4, ] <- seq_len(n)-1L

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

##fill the matrix
indexTime <- 1L
dt_t <- fillMatrices(dt_t_1 = t(arr1[1, ,]), species = c("a_M", "b_M", "c_M"), maxDuration = 5, matrixColumns = col_mat)

## reassign
system.time(
  arr1[indexTime + 1, ,] <- dt_t
)

   user  system elapsed 
   0.05    0.70    0.7

# for comparison

#> system.time(for(i in 1:n){
#+   list_matrices[[i]][indexTime + 1,] <- dt_t[,i]
#+ })
#   user  system elapsed 
#   4.75    1.08    5.90 

库（ff）
图书馆（dplyr）
种子集（12345）
##定义个人数量
N
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)

} 

library(ff)
library(dplyr)
set.seed(12345)

## Define the number of individuals
n <- 10000L
n_row <- 3650L

#array way:
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)

arr1 <- ff(-999L, dim = c(n_row, length(col_mat), n), dimnames = list(NULL, col_mat, NULL))

## Fill the first row of each matrix slice
arr1[1, , ] <- c(1L, 1L, 1L, NA, 0L, rep(0L, length(v_date)))
arr1[1, 4, ] <- seq_len(n)-1L

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

##fill the matrix
indexTime <- 1L
dt_t <- fillMatrices(dt_t_1 = t(arr1[1, ,]), species = c("a_M", "b_M", "c_M"), maxDuration = 5, matrixColumns = col_mat)

## reassign
system.time(
  arr1[indexTime + 1, ,] <- dt_t
)

   user  system elapsed 
   0.05    0.70    0.7

# for comparison

#> system.time(for(i in 1:n){
#+   list_matrices[[i]][indexTime + 1,] <- dt_t[,i]
#+ })
#   user  system elapsed 
#   4.75    1.08    5.90