Question

我有一个包含多行的输入数据框。对于每一行，我想应用一个函数。输入数据帧具有1,000,000+行。如何使用lapply加速零件？我想避免像Efficient way to apply function to each row of data frame and return list of data frames中那样应用函数族，因为在我看来，这些方法似乎很慢。

这是一个具有简单功能的可重现示例：

library(tictoc)   # enable use of tic() and toc() to record time taken for test to compute

func <- function(coord, a, b, c){

  X1 <- as.vector(coord[1])
  Y1 <- as.vector(coord[2])
  X2 <- as.vector(coord[3])
  Y2 <- as.vector(coord[4])

  if(c == 0) {

    res1 <- mean(c((X1 - a) : (X1 - 1), (Y1 + 1) : (Y1 + 40)))
    res2 <- mean(c((X2 - a) : (X2 - 1), (Y2 + 1) : (Y2 + 40)))
    res <- matrix(c(res1, res2), ncol=2, nrow=1)

  } else {

    res1 <- mean(c((X1 - a) : (X1 - 1), (Y1 + 1) : (Y1 + 40)))*b
    res2 <- mean(c((X2 - a) : (X2 - 1), (Y2 + 1) : (Y2 + 40)))*b
    res <- matrix(c(res1, res2), ncol=2, nrow=1)

  }

  return(res)
}

## Apply the function
set.seed(1)
n = 10000000
tab <- as.matrix(data.frame(x1 = sample(1:100, n, replace = T), y1 = sample(1:100, n, replace = T), x2 = sample(1:100, n, replace = T), y2 = sample(1:100, n, replace = T)))


tic("test 1")
test <- do.call("rbind", lapply(split(tab, 1:nrow(tab)),
                                function(x) func(coord = x,
                                                 a = 40,
                                                 b = 5,
                                                 c = 1)))
toc()



 ## test 1: 453.76 sec elapsed

Answer 1

这似乎是重构和进行矢量化计算的好机会，R可以更快地求解。（TL； DR：这使速度提高了约1000倍。）

看起来这里的任务是取两个整数范围的加权平均值，其中范围的书挡按行变化（基于X1，X2，Y1和Y2），但是序列的长度相同在每一行中。这很有帮助，因为这意味着我们可以使用代数来简化计算。

对于简单的情况，即a = 40，第一个序列将从x1-40到x-1，从y + 1到y1 + 40。平均值将是这两项的总和除以80。总和将为40 * X1 + 40 * Y1 +（-40：-1）的总和（1:40）的总和，最后两项相抵消。因此，您可以简单地输出每对列的平均值乘以b。

library(dplyr)
b = 5
quick_test <- tab_tbl %>%
  as_data_frame() %>%
  mutate(V1 = (x1+y1)/2 * b,
         V2 = (x2+y2)/2 * b)

使用n = 1E6（OP的10％），OP功能需要73秒。上面的函数需要0.08秒的时间，并且具有相同的输出。

对于a != 40，需要更多的代数。 V1在这里作为加权平均值结束，在这里我们将序列(x1-a):(x1-1)和序列(y1+1):(y1+40)相加，并全部除以a+40（因为有{{1 a序列中的}}项和x1序列中的40项，我们实际上不需要将这个序列相加；我们可以使用代数将其转换为更短的计算：{{3} }

y1 = sum of (x1-a):(x1-1) = x1*a + sum of (-a:-1) = x1*a + a*(-a + -1)/2

这一切都意味着我们可以使用以下命令完全复制任何肯定的x1*a - (a*a + a)/2的代码：

这大约快1000倍。在n = 1E6，a = 41，b = 5，c = 1的情况下，OP解决方案在我的2012年笔记本电脑上耗时154秒，而上述a = 50 b = 5 tictoc::tic("test 2b") quick_test2 <- quick_test <- tab %>% as_data_frame() %>% mutate(V1 = (a*x1 - (a*a + a)/2 + 40*y1 + 820)/(a+40)*b, V2 = (a*x2 - (a*a + a)/2 + 40*y2 + 820)/(a+40)*b) tictoc::toc()耗时0.23秒，结果相同。

（小附录，如果c == 0，您可以添加一个测试来将b = 1设置为零，然后您要处理if-else条件。）

Answer 2

基于Jon Spring的答案，我们可以对基数R进行同样的操作：

test2 <- function(d, a, b, c) {
  if (c == 0) b <- 1
  X <- d[, c('x1', 'x2')]
  Y <- d[, c('y1', 'y2')]
  (a*X - (a*a + a)/2  + 40*Y + 820)/(a+40)*b
}

res2 <- test2(tab, 40, 5, 1)

Answer 3

看起来有些快速的选项。另一个较慢的选择是标准for-loop。

这比他们的速度慢得多，但仍然比lapply快3倍。

n = 1e6

tic("test 2")
test <- vector("list", nrow(tab))
for (i in 1:nrow(tab)) {test[[i]] <- func(coord = tab[i,], a = 40, b = 5, c = 1)
}
testout <- do.call(rbind, test)
toc()

> test 2: 3.85 sec elapsed

Answer 4

我建议查找tidyverse，在本例中为dplyr（tidyverse子包装）。 tidyverse是大量有用和“整洁”（又名FAST）操作的集合。一旦整理好，就再也不会回去。

首先，仅提供一些一般的数学建议。可以对序列取平均值，而无需实际生成整个序列。您只需要序列的开始和结束，因为第一个和最后一个数字的平均值与整个序列的平均值相同。如果您的真实数据是非序数的向量，请告诉我。以下三行代码证明了第一个和最后一个数字的均值与整个序列的均值相同：

seqstart <- sample(1:50, 1, replace = T)
seqend <- sample(51:100, 1, replace = T)
mean(c(seqstart, seqend)) == mean(seqstart:seqend)

如果您不相信我，则将这3行粘贴到领事中，直到找到FALSE值，或者直到您相信我。：）

library(tidyverse)
set.seed(1)
n = 10000000
tab <- data.frame(x1 = sample(1:100, n, replace = T), y1 = sample(1:100, n, 
replace = T), x2 = sample(1:100, n, replace = T), y2 = sample(1:100, n, replace = 
T))

注意，我还没有使用矩阵。您可以稍后重新创建矩阵。如果出于某种原因从矩阵开始，说实话，我会为此将其更改为普通表，这样我就可以更轻松地使用整洁的操作。也许一位上师可以教我们如何在矩阵上使用tidyverse运算，但我不知道该怎么做。解决方案：

tic("test 1")
a <- 40
b <- 5
test <- tab %>% mutate(c = 1) %>%
mutate(res1 = if_else(c==1,(((x1 - a)+(x1 - 1)+(y1 + 1)+(y1 + 40))/4)*b,(((x1 - a)+ 
(x1 - 1)+(y1 + 1)+(y1 + 40))/4))) %>%
mutate(res2 = if_else(c==1,(((x2 - a)+(x2 - 1)+(y2 + 1)+(y2 + 40))/4)*b,(((x2 - a)+ 
(x2 - 1)+(y2 + 1)+(y2 + 40))/4)))
test %>% select(res1,res2) -> test
toc()

测试1：经过8.91秒对我来说足够快。

请注意，我用mutate创建了一个新列，并将其设置为1。这是因为如果您使用对环境变量进行逻辑检查的if_else语句（并且该变量为始终为1，为什么我们要首先对此进行编码？）。因此，我假设您打算使用有时可以为1有时为0的“ c”，并且在这里建议您将这些数据放在我们可以引用的列中。

Answer 5

@Jon Spring在上面提供了一个很好的答案。

但是，我建议一种使用{data.table}的方法。

test2 <- data.table(copy(tab))
tic("test2")
a <- 40
b <- 5
c <- 1
test2[, Output1 := (x1*a - 0.5*(a + a^2) + 40 * y1 + 820)/ (a + 40) * b]
test2[, Output2 := (x2*a - 0.5*(a + a^2) + 40 * y2 + 820)/ (a + 40) * b]
toc()

当n = 1e7时，这种方法在笔记本电脑上花费的时间约为0.4到3.28秒。

对于n = 1e6，您发布的方法大约需要138秒，而我使用的方法大约需要0.3秒。

将函数应用于矩阵的每一行，而无需在R中使用lapply函数

5 个答案: