慢功能，如何在 R 中从中删除 for 循环答案

【问题标题】：Slow function, how can I remove the for loop from it in R慢功能，如何在 R 中从中删除 for 循环
【发布时间】：2015-06-23 17:06:34
【问题描述】：

我在 R 中有一个函数，它将较小的向量与较大的向量进行比较，然后找到匹配的位置并使用该信息从较大的数据帧中提取数据。

compare_masses <- function(mass_lst){
  for (i in seq_along(mass_lst)) {
    positions <- which(abs(AB_massLst_numeric - mass_lst[i]) < 0.02)
    rows <- AB_lst[positions,]
    match_df <- rbind(match_df, rows)
   }
}

其中mass_lst 是复合质量列表：

例如：mass_lst <- c(315, 243, 484, 121)

AB_massLst_numeric 是较大的群众列表：

例如：AB_massLst_numeric <- c(323, 474, 812, 375, 999, 271, 676, 232)

AB_lst 是一个更大的数据框，我使用位置向量从中提取数据。

match_df 是一个空的数据框我做rbind 的数据。

问题是这个函数里面有一个for循环，即使我使用也需要很长时间

test <- sapply(mass_lst, compare_masses)

所以我的问题是如何使这个函数更快并有可能删除 for 循环？我的数据在现实生活中比我提供的示例要大得多。我想不出一种不迭代来使这个函数工作的方法。

【问题讨论】：

你的向量/数据有多大

标签： r performance for-loop sapply

【解决方案1】：

使用 R 的向量回收功能。首先构造长度为 N*m 的 positions 向量，其中 N 是 AB_lst 中的行数，m 是 length(mass_lst)。然后使用此向量从数据框中选择行。

请参阅下面的完整可运行示例。

positions <- c()
compare_masses <- function(mass_lst){
  for (i in seq_along(mass_lst)) {
    positions <- c(positions, which(abs(AB_massLst_numeric - mass_lst[i]) < 0.02))
   }
   return(AB_lst[positions,])
}

mass_lst <- c(375, 243, 676, 121)
AB_massLst_numeric <- c(323, 474, 812, 375, 999, 271, 676, 232, 676)

AB_lst <- data.frame(x=1,y=AB_massLst_numeric)
match_df <- AB_lst[c(),]

compare_masses(mass_lst)

【讨论】：

感谢您的回答，但您能否解释一下为什么 position() 向量使代码更快？例如positions
c(positions, ...) 在每次循环迭代时将新元素附加到位置向量。那里没有太多需要优化的地方——你想在一定距离容差的情况下执行元素搜索。缓慢的部分是从数据帧中选择行并迭代增长结果帧。所以它被从循环中取出来一次性完成。

【解决方案2】：

尝试将其全部封装在一个调用中并使用do.call，这样它就可以同时处理所有rbind 调用，而不是一次调用一个。

match_df <- do.call(rbind.data.frame, lapply(
    mass_lst, function(x)
        AB_lst[abs(AB_lst_numeric - x) < 0.02,]))

为了响应 cmets 关于 do.call 与 dplyr::bind_rows 相比的速度，我创建了一个 AB_lst_numeric，其 1k 值介于 0 和 1000 之间，对应的 AB_lst data.frame 以及 mass_lst 向量与 100元素。以下是使用rbenchmark 的测试结果，您可以看到do.call 和bind_rows 调用非常相似（与原始解决方案相比，bind_rows 的效率提高了 36%，而效率提高了 110%）。

benchmark(
  match_df <- compare_masses(mass_lst),
  match_df <- do.call(rbind.data.frame, lapply(
    mass_lst, function(x)
    AB_lst[abs(AB_lst_numeric - x) < 0.02,])),
  match_df <- bind_rows(lapply(
    mass_lst, function(x)
    AB_lst[abs(AB_lst_numeric - x) < 0.02,])))

    ## 3   match_df <- bind_rows(lapply(mass_lst, function(x) AB_lst[abs(AB_lst_numeric - x) < 0.02, ]))
    ## 1   match_df <- compare_masses(mass_lst)
    ## 2   match_df <- do.call(rbind.data.frame, lapply(mass_lst, function(x) AB_lst[abs(AB_lst_numeric - x) < 0.02, ]))
    ##     replications elapsed relative user.self sys.self user.child sys.child
    ## 3   100          1.453   1.000    1.387     0.059    0          0
    ## 1   100          3.050   2.099    2.983     0.051    0          0
    ## 2   100          1.974   1.359    1.905     0.060    0          0

【讨论】：

如果这仍然很慢，dplyr::bind_rows 可能会替换 do.call 以显着加快速度。
您需要在您的abs(AB_lst_numeric - x) < 0.02 周围添加一个which，否则元素回收将导致意外行被子集化。 length(abs(AB_lst_numeric - x) < 0.02) < nrow(AB_lst)
@Vlo，这不是真的（至少对于 3.2.1）。无论有没有which 函数调用，结果data.frame 将有NA 的行，用于从AB_lst 的行索引之后选择的任何行。我认为假设这些是对应结构而不是现阶段的严格检查是可以接受的。如果我们愿意，我们将不得不这样做：AB_lst[intersect(which(abs(AB_lst_numeric - x) < 0.02), 1:nrow(AB_lst)),]。
你是在告诉我，R 3.2.1 已经修补了从一开始就存在的矢量回收行为？当前的 R 文档中甚至还有一个部分：cran.r-project.org/doc/manuals/r-patched/… 使用长度小于 data.frame/matrix 的逻辑向量对行进行子集肯定不会为我返回 NA。
对不起。尽管您说列表在另一个方向上不匹配并且向量更长。这确实是可能的，但我认为对相应数据结构的信任在这里显然是可以接受的。

【解决方案3】：

这应该是一个矢量化的解决方案。使用发布的 compare_masses 函数。它比这里的其他解决方案要快得多。

编写一个匿名函数来向量化。在循环中进行相同的比较。

pos = Vectorize(FUN = function(y) {abs(AB_massLst_numeric-y) < 0.02}, vectorize.args = "y")

找到要子集的索引，这一步替换了do.call(rbind,...) 或bind_rows。这一步应该很快，因为它只是对大小为length(AB_massLst_numeric) x length(mass_lst) 的矩阵进行逻辑比较。需要这一步，因为我无法让vectorize 函数与which 很好地配合使用。

i = unlist(apply(X = matrix(sample(c(T,F), 100, r = T), nrow = 10), MARGIN = 2, FUN = which))

子集和存储

AB_lst[i,]

编辑：使用发布的 compare_masses 函数。它比这里的其他解决方案要快得多。

Unit: microseconds
           expr      min       lq      mean   median       uq      max neval  cld
      Vectorize  318.595  327.280  358.9813  355.112  386.892  413.739    10  b  
        do.call 1418.473 1510.853 1569.7161 1578.954 1635.606 1744.173    10    d
      bind_rows  744.570  801.420  813.9346  815.435  836.161  871.297    10   c 
 compare_masses  135.808  138.176  158.0344  158.508  169.365  197.395    10 a

更大的测试数据集

Unit: nanoseconds
           expr      min       lq         mean   median       uq       max neval cld
      Vectorize   239242   292341   342314.079   324714   359455   3480844  1000 a  
 compare_masses      395     1975     3674.669     3554     4738     19346  1000 a  
        do.call 16570424 18223007 21092022.254 20921183 22194176 159718470  1000   c
      bind_rows 13423572 14869680 17027330.356 17008639 18061341 116983885  1000  b

【讨论】：

【解决方案4】：

您可以循环查找所需的行索引，然后根据该数据选择行：

set.seed(1)
DF <- data.frame(x=runif(1e2), y=sample(letters, 1e2, rep=T))
LIST <- list(0, 0.2, 0.4, 0.5)
DF[unlist(lapply(LIST, function(y) which(abs(DF$x - y) < .02))), ]

对于我们的虚拟数据，这会产生：

            x y
24 0.01017122 b
70 0.01065314 d
5  0.19193779 e
40 0.21181133 l
65 0.21488963 q
80 0.20122201 q
16 0.39572663 e
23 0.41434742 x
30 0.41330587 t
67 0.40899105 p
73 0.40808877 x
78 0.49894035 o
79 0.49745918 o

注意我们选择的值确实在目标的 0.02 范围内。

【讨论】：