当执行顺序很重要时，如何加快 for 循环？

Question

我有一个表格，其中包含不同产品的历史每日价格数据和未来价格的 NA。我有一列关于产品在给定未来日期的预期价格上涨。价格上涨是基于前一天的价格。

我已经构建了一个 for 循环来计算产品的预期价格，但是对于它正在循环的约 500,000 条记录，它的运行速度非常慢。

所有历史价格数据都在表中，而所有预测价格均为NA。

当前表（old_table）示例：

date        product        price        incr_amt
====================================================
...          ...            ...         ...
10/14/19     prod1          50          1.0
10/15/19     prod1          50          1.0
10/16/19     prod1          NA          1.0
...          ...            ...         ...
04/01/20     prod1          NA          1.05
04/02/20     prod1          NA          1.0
...          ...            ...         ...
...          ...            ...         ...
10/14/19     prod2          35          1.0
10/15/19     prod2          35          1.0
10/16/19     prod2          NA          1.0
...          ...            ...         ...
01/01/20     prod2          NA          1.02
01/02/20     prod2          NA          1.0
...          ...            ...         ...

我当前的代码按产品分组，如果价格为 NA，则将价格计算为滞后价格 * increase_amt。然后为下一次迭代重新计算 laagged_price。 循环直到表格中的所有行。

示例结果（new_table）：

date        product        price        incr_amt
====================================================
...          ...            ...         ...
10/14/19     prod1          50          1.0
10/15/19     prod1          50          1.0
10/16/19     prod1          50          1.0
...          ...            ...         ...
04/01/20     prod1          52.5        1.05
04/02/20     prod1          52.5        1.0
...          ...            ...         ...
...          ...            ...         ...
10/14/19     prod2          35          1.0
10/15/19     prod2          35          1.0
10/16/19     prod2          35          1.0
...          ...            ...         ...
01/01/20     prod2          35.7        1.02
01/02/20     prod2          35.7        1.0
...          ...            ...         ...

我当前的代码可以运行，但运行需要一个多小时。因为每次迭代都依赖于之前的迭代并且顺序很重要，所以我不知道是否有使用循环的解决方法。

当前代码：

library(tidyverse)

old_table <- tribble(
  ~date, ~product, ~price, ~incr_amt,
  "2019-10-14", "prod1", 50, 1.0,
  "2019-10-15", "prod1", 50, 1.0,
  "2019-10-16", "prod1", NA, 1.0,
  "2019-10-17", "prod1", NA, 1.0,
  "2019-10-18", "prod1", NA, 1.0,
  "2019-10-19", "prod1", NA, 1.05,
  "2019-10-20", "prod1", NA, 1.0,
  "2019-10-21", "prod1", NA, 1.0,
  "2019-10-14", "prod2", 35, 1.0,
  "2019-10-15", "prod2", 35, 1.0,
  "2019-10-16", "prod2", NA, 1.0,
  "2019-10-17", "prod2", NA, 1.0,
  "2019-10-18", "prod2", NA, 1.0,
  "2019-10-19", "prod2", NA, 1.0,
  "2019-10-20", "prod2", NA, 1.0,
  "2019-10-21", "prod2", NA, 1.02,
  "2019-10-22", "prod2", NA, 1.0
)

new_table <- old_table %>%
  group_by(product) %>%
  mutate(lag_price = lag(price))

for (i in 1:nrow(new_table)) {
  if (!is.na(new_table$price[[i]]))
    next
  if (is.na(new_table$price[[i]])) {
    new_table$price[[i]] = new_table$lag_price[[i]] * new_table$incr_amt[[i]]
    new_table$lag_price <- lag(new_table$price)
  }

}

代码运行，但需要一个多小时才能遍历约 500,000 条记录。我该如何改进这个过程？谢谢。

Answer 1

这是一个矢量化解决方案，我希望它会更快。 （我很好奇你的真实数据的速度有多快。）正如@aocall 所指出的，减慢代码速度的主要因素是 500,000 表修改。如果我们可以一次将相同的计算应用于整个表，它应该会快得多。在这里，我们计算每个产品中每个缺失部分的累积增长。 （我们还不必要地计算了非缺失部分的增长，但我认为开销将是最小的。）然后我们可以将该增长因子应用于最后一个可用数字以获得填充的数字。

library(dplyr)
new_table2 <- old_table %>%
  # Put together strings of missingness & track cumulative growth in them
  group_by(product) %>%
  mutate(missing_streak = cumsum(is.na(price) != is.na(lag(price)))) %>%

  # fill in NA with last value
  mutate(price_new = price) %>%
  tidyr::fill(price_new) %>%

  # gross up based on growth
  group_by(product, missing_streak) %>%
  mutate(cuml_growth = cumprod(incr_amt)) %>%
  mutate(price_new = if_else(is.na(price),
                             price_new * cuml_growth,
                             price)) %>%
  ungroup()

似乎对您的数据有效：

identical(new_table$price, new_table2$price_new)
[1] TRUE