r语言 - 具有过滤计算和数据导出的嵌套循环的替代方法

Question

我有一个大型数据文件(1100 万次观察)，并且有 ID、年、月、时间段(以及变量，如我感兴趣的速度)列。我想对其中的每一个执行计算，并在新的 CSV 中汇总结果，以便我为每个唯一 ID/年/月/小时的结果和行格式化。

我能够通过一系列嵌套循环来实现这一点，当文件较小(几千次观察)时，这些循环工作正常。 我一直在尝试找到一种更好的应用函数方法，但无法获得相同的结构。 我正在使用 groupby 在循环之前创建一些新列，它运行速度很快，但没有给我摘要输出 csv。

results = NULL
data.calc = NULL
tmp = NULL
PERIOD = 5:9
YEAR = 2014:2017
LINK = 1:5
MONTH = 1:12
for(link in LINK,
for (year in YEAR){
for (month in MONTH){
for (period in PERIOD){
data.calc = filter(data, 
LinkID_Int == link,
Year==year, 
MONTH==month,
Period==period
)
#Speed
spd.5 = quantile(data.calc$speed, 0.05)
spd.20 = quantile(data.calc$speed, 0.20)
spd.50 = quantile(data.calc$speed, 0.50)
spd.85 = quantile(data.calc$speed, 0.85)
spd.SD = sd(data.calc$speed)
tmp = tibble(link, 
year, 
month,
period, 
spd.5, spd.20, spd.50, spd.85, 
spd.SD, 
)
results = rbind(results, tmp)
}
}
}
}
write.csv(results, file="C:/Users/...", row.names = FALSE)

此代码有效，但运行数小时，结果很少。我喜欢 for 循环的逻辑，这意味着我很容易阅读和理解正在发生的事情，但我看到很多帖子说有更快的方法来解决这个问题。 我在循环中运行了大约 30 个实际计算，涉及几个不同的变量。

我非常感谢对此的任何指导。

Answer 1

我认为你的很多减速是因为你反复filter你的数据(11M 行很耗时)。由于您已经在使用dplyr(用于::filter)，我建议采用"整洁"的方式来执行此操作。由于我们没有您的数据，我将演示mtcars：

library(dplyr)
mtcars %>%
group_by(gear, vs, am) %>%
summarize_at(vars(disp), .funs = list(~n(), ~mean(.), ~sd(.), q50 = ~quantile(.,0.5)))
# # A tibble: 7 x 7
# # Groups:   gear, vs [6]
#    gear    vs    am     n  mean    sd   q50
#   <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
# 1     3     0     0    12 358.   71.8 355  
# 2     3     1     0     3 201.   72.0 225  
# 3     4     0     1     2 160     0   160  
# 4     4     1     0     4 156.   14.0 157. 
# 5     4     1     1     6  88.9  20.4  78.8
# 6     5     0     1     4 229.  114.  223  
# 7     5     1     1     1  95.1 NaN    95.1

您可以看到某些列是如何自动为函数命名的，而我覆盖了一个列。这是可以导出(例如，到 CSV)的"另一个帧"。

如果您有多个变量想要汇总统计信息，只需将它们包含在对vars的调用中，列名就会适当地分解：

mtcars %>%
group_by(gear, vs, am) %>%
summarize_at(vars(mpg, disp), .funs = list(~n(), ~mean(.), ~sd(.), q50 = ~quantile(.,0.5)))
# # A tibble: 7 x 11
# # Groups:   gear, vs [6]
#    gear    vs    am mpg_n disp_n mpg_mean disp_mean mpg_sd disp_sd mpg_q50 disp_q50
#   <dbl> <dbl> <dbl> <int>  <int>    <dbl>     <dbl>  <dbl>   <dbl>   <dbl>    <dbl>
# 1     3     0     0    12     12     15.0     358.    2.77    71.8    15.2    355  
# 2     3     1     0     3      3     20.3     201.    1.93    72.0    21.4    225  
# 3     4     0     1     2      2     21       160     0        0      21      160  
# 4     4     1     0     4      4     21.0     156.    3.07    14.0    21      157. 
# 5     4     1     1     6      6     28.0      88.9   5.12    20.4    28.8     78.8
# 6     5     0     1     4      4     19.1     229.    5.02   114.     17.8    223  
# 7     5     1     1     1      1     30.4      95.1 NaN      NaN      30.4     95.1

---

还有一个"顺便说一句"：使用rbind(results, tmp)迭代构建结果对于几次迭代来说效果很好，但它变得非常慢。因为：每次rbind时，它都会完整复制两者中的所有数据。如果在调用rbind之前results是 1M 行，则在行绑定进行时，一次内存中(至少)有 2M 行(1M 行，两个副本)。虽然这样做一两次通常不是问题，但您可以看到这样做数百或数千次(取决于您拥有的因素数量)可能会有问题。

更好的做法包括：

• 使用如下内容预先分配输出list：

  out <- vector("list", prod(length(LINK), length(YEAR), length(MONTH), length(PERIOD))
  ind <- 0L
  for (...) {
  for (...) {
  for (...) {
  for (...) {
  tmp <- (do-stuff-here)
  ind <- ind + 1L
  out[[ind]] <- tmp
  }
  }
  }
  }
  out <- do.call(rbind, out)
  

• 在lapply内完成并将输出分配给out，尽管将四个嵌套for炮制成一个lapply有点困难

我仍然认为，尝试执行嵌套for并在每次传递时过滤数据是一个糟糕的起点。即使您可以使用迭代rbind消除每次复制数据的低效率，您仍然会有不必要的过滤开销。

但是，如果必须，请考虑按for过滤：

out <- vector("list", prod(...)) # as above
ind <- 0L
for (lk in LINK) {
dat_l <- mydat[LinkID_Int == lk,,drop=FALSE]
for (yr in YEAR) {
dat_y <- dat_l[Year == yr,,drop=FALSE]
for (mh in MONTH) {
dat_m <- dat_y[Month == mh,,drop=FALSE]
for (pd in PERIOD) {
data.calc <- dat_m[Period == pd,,drop=FALSE]
tmp <- {do-stuff-here}
ind <- ind + 1L
out[[ ind ]] <- tmp
}
}
}
}

在这种情况下，至少每个内部循环过滤的数据要少得多。这仍然效率低下，但效率略低。

(我仍然认为上面的dplyr解决方案更具可读性，可能更快，更易于维护且更具可扩展性。

Answer 2

始终避免在循环中运行rbind，因为这会导致内存中过多的复制。参见帕特里克·伯恩斯(Patrick Burns)的圈子2，"生长的对象"，R Inferno。

由于您需要内联分组聚合，请考虑基本 R 的ave，它返回与输入向量相同的长度，因此可以分配给新列。

results <- transform(data, 
spd.5 = ave(speed, LinkID_Int, Year, MONTH, Period, FUN=function(x) quantile(x, 0.05)),
spd.20 = ave(speed, LinkID_Int, Year, MONTH, Period, FUN=function(x) quantile(x, 0.2)),
spd.50 = ave(speed, LinkID_Int, Year, MONTH, Period, FUN=function(x) quantile(x, 0.5)),
spd.85 = ave(speed, LinkID_Int, Year, MONTH, Period, FUN=function(x) quantile(x, 0.85)),
spd.SD = ave(speed, LinkID_Int, Year, MONTH, Period, FUN=sd)
)

对于数据的完整分组聚合，请考虑基本 R 的aggregate：

agg_raw <- aggregate(speed ~ Year + MONTH + Period, 
function(x) c(spd.5 = unname(quantile(x, 0.05)),
spd.20 = unname(quantile(x, 0.2)),
spd.50 = unname(quantile(x, 0.5)),
spd.85 = unname(quantile(x, 0.85)),
spd.SD = sd(x))
)
results <- do.call(data.frame, agg_raw)
colnames(results) <- gsub("speed.", "", colnames(results))