使用过滤计算和数据导出替代嵌套循环

Question

我有一个大数据文件（1100 万个观测值），其中包含 ID、年、月、时间段（以及我感兴趣的变量，例如速度）的列。我想对其中的每一个进行计算，并将结果汇总到一个新的 CSV 中，这样我就可以为每个唯一的 ID/year/month/hour.

结果和行设置格式

我能够通过一系列嵌套循环来完成此操作，当文件较小（几千次观察）时，它工作正常。我一直在尝试使用 apply 函数找到更好的方法，但无法获得相同的结构。我正在使用 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 你的数据（耗时 1100 万行）。由于您已经在使用 dplyr（对于 ::filter），我建议使用 "tidy" 方法来执行此操作。由于我们没有您的数据，我将使用 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

您可以看到一些列是如何自动为该函数命名的，其中一列是我覆盖的。这是可以导出的 "just another frame"（例如，导出为 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

还有一个 "BTW"：使用 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 并在每次传递时过滤数据是一个糟糕的起点。即使您可以使用 iterative-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，因为它会导致内存中的过度复制。请参阅 R Inferno 的 Patrick Burns 的圈子 2，"Growing Objects"。

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

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

使用过滤计算和数据导出替代嵌套循环

Alternative to nested loops with filtered calculations and data export

r

nested-loops