R 使用mapply速度问题更新data.table

我有一个自定义函数，它的结果要放在data.table中。我需要将这个函数应用于另一个data.table的每一行的一些变量。我有一个方法，我想它如何工作，但它是相当缓慢，我期待着看看是否有一种方法，将加快它

在我下面的示例中，重要的结果是列，它是在while循环中生成的，并且在给定输入数据的情况下长度会发生变化，以及列2

我的方法是让函数使用update by reference将结果追加到现有的data.table中，：=。为了正确地实现这一点，我将Column和Column2的长度设置为已知的最大值，将NAs替换为0，然后简单地添加到现有的data.table addTable中，就像这样：addTable[，First:=First+Column]

此方法适用于我如何使用mapply将函数应用于source data.table的每一行。这样，我就不必担心mapply调用的实际乘积（某种矩阵）；它只是为应用示例的每一行更新addTable

这是一个可复制的样品：

dt<-data.table(X= c(1:100), Y=c(.5, .7, .3, .4), Z=c(1:50000))    
addTable <- data.table(First=0, Second=0, Term=c(1:50))

sample_fun <- function(x, y, z) {
  Column <- NULL
  while(x>=1) {
    x <- x*y
    Column <- c(Column, x)
  }

  length(Column) <- nrow(addTable)
  Column[is.na(Column)] <- 0

  Column2 <- NULL
  Column2 <- rep(z, length(Column))

  addTable[, First := First + Column]
  addTable[, Second := Second + Column2]
}

似乎很长时间（我的真实数据/函数的时间更长）。我最初认为这是由于while循环，因为在R中围绕这些部分的显式循环经常出现警告。然而，在测试没有最后两行的示例_fun（其中data.table被更新）时，它在50k行上计时不到1秒

---

长话短说，如果引用更新很快，为什么这是最慢的部分？还有更好的方法吗？使示例输出成为一个完整的数据表每次都比我现在的慢得多。

这里有几个注释：

目前，根据您的需要使用

data.table

可能是一种过度使用（虽然不一定），您可能会避免这种情况

---

您正在循环中增长对象（

列我想通过引用更新表的速度很慢，因为您是按行进行的（
mapply
是每行
for
循环）。换句话说，它与
：=
运算符没有直接关系，而是与函数的求值频率和代价直接相关。与其完全删除最后一行，不如只删除
：=
运算符并测试
addTable[，First+Column]；addTable[，Second+Column]
-然后您会注意到
：=
开销并没有那么大。另外，调用
[.data.table
两次非常昂贵。您可以在每次迭代中一次更新两列。顺便说一句，计算列2

的目的是什么？您在任何地方都不使用它。最后，改进性能的一个非常快速的方法是，注释最后两行并将

返回（列）

代替它们。然后，运行

addTable[，First2:=Reduce（`+`，Map（sample_-fun，dt$X，dt$Y，dt$Z），accumulate=TRUE）[[nrow（dt）]]]]

。这将在50K行上花费不到1秒的时间。在函数中从

return（Column）

更改为

return（list（Column，Column2））

（res@DavidArenburg-请将您的观点作为答案发布。

system.time(mapply(sample_fun2, dt$X, dt$Y, dt$Z))

library(data.table)
dt <- data.table(X= c(1:100), Y=c(.5, .7, .3, .4), Z=c(1:50000))    
addTable <- data.table(First=0, Second=0, Term=c(1:50))

sample_fun <- function(x, y, z) {
  Column <- NULL
  while(x>=1) {
    x <- x*y
    Column <- c(Column, x)
  }

  length(Column) <- nrow(addTable)
  Column[is.na(Column)] <- 0

  Column2 <- NULL
  Column2 <- rep(z, length(Column))

  addTable[, First := First + Column]
  addTable[, Second := Second + Column2]
}

system.time(mapply(sample_fun, dt$X, dt$Y, dt$Z))
#  user  system elapsed 
# 30.71    0.00   30.78 

sample_fun <- function(x, y, z) {
  Column <- NULL
  while(x>=1) {
    x <- x*y
    Column <- c(Column, x)
  }

  length(Column) <- nrow(addTable)
  Column[is.na(Column)] <- 0

  Column2 <- NULL
  Column2 <- rep(z, length(Column))

  addTable$First + Column
  addTable$Second + Column2
}

system.time(mapply(sample_fun, dt$X, dt$Y, dt$Z))
# user  system elapsed 
# 2.25    0.00    2.26 

sample_fun <- function(x, y, z, n) {  
  Column <- NULL
  while(x>=1) {
    x <- x*y
    Column <- c(Column, x)
  }

  length(Column) <- nrow(addTable)
  Column[is.na(Column)] <- 0

  Column2 <- NULL
  Column2 <- rep(z, length(Column))

  set(addTable, j = "First", value = addTable[["First"]] + Column)
  set(addTable, j = "Second", value = addTable[["Second"]] + Column2)
}

system.time(mapply(sample_fun, dt$X, dt$Y, dt$Z))
# user  system elapsed 
# 2.96    0.00    2.96 

dt <- data.frame(X= c(1:100), Y=c(.5, .7, .3, .4), Z=c(1:50000))    
addTable <- data.frame(First=0, Second=0, Term=c(1:50))

sample_fun <- function(x, y, z) {
  Column <- NULL
  while(x>=1) {
    x <- x*y
    Column <- c(Column, x)
  }

  length(Column) <- nrow(addTable)
  Column[is.na(Column)] <- 0

  Column2 <- NULL
  Column2 <- rep(z, length(Column))

  return(list(Column, Column2))
}

system.time(res <- mapply(sample_fun, dt$X, dt$Y, dt$Z))
# user  system elapsed 
# 1.34    0.02    1.36 

system.time(addTable$First <- Reduce(`+`, res[1, ], accumulate = TRUE)[[nrow(dt)]])
# user  system elapsed 
# 0.07    0.00    0.06 
system.time(addTable$Second <- Reduce(`+`, res[2, ], accumulate = TRUE)[[nrow(dt)]])
# user  system elapsed 
# 0.07    0.00    0.06 

sample_fun <- function(x, y, n) {
  Column <- numeric(n)
  i <- 1L
  while(x >= 1) {
    x <- x * y
    Column[i] <- x
    i <- i + 1L
  }
  return(Column)
}

system.time(res <- Map(sample_fun, dt$X, dt$Y, nrow(addTable)))
# user  system elapsed 
# 0.72    0.00    0.72 

system.time(addTable$First <- Reduce(`+`, res, accumulate = TRUE)[[nrow(dt)]])
# user  system elapsed 
# 0.07    0.00    0.07 

system.time(res <- mapply(sample_fun, dt$X, dt$Y, nrow(addTable)))
# user  system elapsed 
# 0.76    0.00    0.76 
system.time(addTable$First2 <- matrixStats::rowCumsums(res)[, nrow(dt)])
# user  system elapsed 
#    0       0       0 

system.time(addTable$Second <- sum(dt$Z))
# user  system elapsed 
#    0       0       0