对矩阵的每一行应用一个函数，而不在R中使用lappy函数

我有一个多行的输入数据框。对于每一行，我想应用一个函数。输入数据帧有1000000多行。如何使用lapply加速零件？我希望避免使用中的apply函数族，因为在我的例子中，这些方法似乎比较慢

以下是一个具有简单功能的可复制示例：

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

---

这似乎是一个很好的机会来重构并在矢量化计算中实现这一点，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)

这大约快1000倍。当n=1E6、a=41、b=5、c=1时，我的2012年笔记本电脑上的OP解决方案耗时154秒，而上面的quick_test2耗时0.23秒，结果相同

---

小附录，如果c==0，您可以添加一个测试来设置b=1，然后您已经考虑了if-else条件。

根据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)

---

看起来有些已经很快了。另一个慢速选项是循环的标准

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

n=1e6

---

我建议查找tidyverse，在本例中特别是dplyr一个tidyverse子包。tidyverse是一个有用的、整洁的、快速的操作的巨大集合。一旦你变得整洁，你就再也不会回去了

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

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

如果您不相信我，请将这三行内容粘贴到您的领事馆中，直到您发现错误值，或者直到您相信我

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创建了一个名为c的新列，并将其设置为1。这是因为dplyr不喜欢使用对环境变量进行逻辑检查的if_else语句，如果该变量始终为1，那么我们首先为什么要对其进行编码？。因此，我假设您计划使用一个有时可以是1，有时可以是0的c，我在这里建议您将该数据放在我们可以参考的列中。

@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秒。

马上就会想到该函数不使用X2和Y2。此外，如果coord是data.frame，那么.vectorcoord[1]和coord[[1]]是相同的，则无需调用函数。事实上，真正的函数是复杂的，我已经简化了它。它使用X1、Y1、X2和Y2。此外，函数参数在每个时间步都会发生变化，但为了简化，我已经随时间删除了循环。因此选项卡的值不一样。另一个需要修改的点是splittab，1:nrowtab。这将df拆分为n个df，每个df只包含一行。最好调用applytab，1，func。在我的系统中，单是拆分就花费了很长时间。我修改了代码，以便函数使用X2和Y2。现在，坐标值是不一样的。一旦你去整理，你就再也不会回去了。下一步：data.table；使用包dplyr，是否可以通过保持相同的函数，将Nell示例中的函数func应用于行？也许使用包purrr中的map？

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()

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()