Question

我有一个自定义函数，我想在data.table中得到结果。我需要将此函数应用于另一个data.table的每一行中的一些变量。我有一个方法可以达到我想要的方式，但它很慢，我希望看看是否有一种方法可以加快它。

在下面的示例中，重要的结果是Column，它是在while循环中生成的，并且在给定输入数据和Column2的情况下长度不同。

我的方法是让函数将结果附加到现有的data.table，使用引用更新：=。为了正确实现这一点，我将Column和Column2的长度设置为已知最大值，将NAs替换为0，并简单地添加到现有data.table addTable中，如下所示：addTable [，First：= First + Column]

此方法适用于我如何使用mapply在源data.table的每一行上应用该函数。这样，我不必担心mapply调用的实际产品（某种矩阵）;它只是为sample_fun应用的每一行更新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]
}

如果我使用dt以50k行运行它，则需要约30秒：

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

似乎很长一段时间（我的真实数据/功能更长）。我原本以为这是由于while循环，因为在这些部分周围的R中显式循环警告。但是，在测试sample_fun而没有最后两行（更新data.table的地方）时，它会在1秒内超过50k行。

长话短说，如果通过引用更新速度很快，为什么这是最慢的部分？还有更好的方法吗？每次使sample_fun输出一个完整的data.table比我现在慢得多。

Answer 1

这里有几点说明：

就目前而言，使用data.table来满足您的需求可能是一种矫枉过正（尽管不一定），您可以避免它。
你正在循环中增长对象（Column <- c(Column, x)） - 不要这样做。在你的情况下，没有必要。只需创建一个空的零向量，就可以摆脱大部分功能。
完全没有必要创建Column2 - 它只是z - 因为R会自动回收它以使其适合正确的大小
无需按行重新计算nrow(addTable)，这可能只是一个额外的参数。
你最大的开销是每行调用data.table :::`[.data.table`-这是一个非常昂贵的功能。 :=函数在此处的开销很小。如果你只用addTable[, First := First + Column] ; addTable[, Second := Second + Column2]替换addTable$First + Column ; addTable$Second + Column2，则运行时间将从约35秒减少到约2秒。另一种说明这一点的方法是用set代替两行 - 例如set(addTable, j = "First", value = addTable[["First"]] + Column) ; set(addTable, j = "Second", value = addTable[["Second"]] + Column)基本上与:=共享源代码。这也运行~2秒
最后，最好减少每行的操作量。您可以尝试使用Reduce累积结果，而不是更新每行的实际数据集。

让我们看一些例子

您的原始功能时间

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

30秒很慢......

1-让我们尝试删除data.table :::`[。data.table` overhead

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

^速度要快得多，但没有更新实际的数据集。

2-现在让我们尝试将其替换为set，其效果与:=相同，但没有data.table :::`[.data.table` overhead

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

^嗯，这也比30秒快得多，并且效果与:=完全相同

3-让我们在不使用data.table的情况下尝试

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

^那更快

现在我们可以使用Reduce与accumulate = TRUE结合使用来创建这些向量

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

嗯，所有组合现在都不到2秒（而不是原始功能的30秒）。

4-进一步的改进可能是修复你的函数中的其他元素（如上所述），换句话说，你的函数可能只是

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

^速度提高两倍

现在，我们甚至没有打扰创建Column2，因为我们已经在dt$Z中创建了Map。我们还使用mapply代替Reduce，因为list使用matrix比使用system.time(addTable$First <- Reduce(`+`, res, accumulate = TRUE)[[nrow(dt)]]) # user system elapsed # 0.07 0.00 0.07更容易。

下一步与之前的步骤类似

Map

但我们可以进一步改善这一点。我们可以使用Reduce创建matrix，然后在其上运行mapply（在内部使用C ++编写），而不是使用matrixStats::rowCumsums / addTable$First计算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）

dt$Z

虽然最后一步只是总结system.time(addTable$Second <- sum(dt$Z)) # user system elapsed # 0 0 0

    STX = 0x02 bytes   //start text data.
    ETX = 0x03 bytes   // end text data.
    DLE = 0x04 bytes   //data link escape.

所以最终我们从大约30秒到不到一秒钟。

一些最后的笔记

由于看起来主要的开销仍然存在于函数本身，你也可以尝试使用Rcpp重写它，因为在这种情况下似乎循环是不可避免的（尽管开销并不是那么大）。

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

1 个答案: