使用 dplyr、cumsum 和 lag 的陈旧库存计划

Question

这是我经过多年被动浏览后在 stackoverflow 上发表的第一篇文章。我被这个问题困扰了，这让我发疯！非常感谢您的帮助。

我有一个按年龄划分的库存供应和需求的数据框架。我已经收集了许多产品的不同时间的数据。一定年龄的库存需求可以通过相同年龄或更年轻的供应来满足。我正在尝试计算每个年龄段（从最年轻到最年长）的供应量可以满足多少需求。

数据框会很大（10^7 行），所以我尝试使用dplyr、mutate、lag和cumsum与循环来执行此操作，我怀疑这会很慢。

这是我的数据集中的一个示例组（省略了产品和日期分组）：

library(dplyr)

Inventory <- data.frame(
  Age = c(90, 120, 270, 365, Inf),
  Demand = c(0, 5000, 25, 5000, 10),
  Supply = c(4000, 50, 4000, 300, 0))

View(Inventory)

我期待的结果是：

Result <- Inventory
Result$Start = c(0, 4000, 0, 3975, 0)
Result$In = c(4000, 50, 4000, 300, 0)
Result$Out = c(0, 4050, 25, 4275, 0)
Result$End = c(4000, 0, 3975, 0, 0)
Result$Short = c(0, 950, 0, 725, 10)

View(Result)

我应用了上面的标准库存计算：

• 开始=结束
• 输入 = 供应
• 输出 = 分钟（需求，开始 + 输入）
• 结束 = 开始 + 输入 - 输出
• 空头 = 需求 - 出局

我没有运气使用 dplyr，但我认为有一个解决方案，使用 max、min、lag 和 cumsum 的巧妙组合。

Answer 1

如果速度成为大量行的问题，那么处理迭代计算的最快方法可能是通过Rcpp.

\n

您本质上需要一个累积总和但下限为零的函数，该函数将每天的供需结果添加到最后的总计中，如果结果为负，则将其归零。这是一个cumnominus试用函数，它提供了正确的表格并可用于dplyr：

\n

library(dplyr)\n\ncumnominus <- Rcpp::cppFunction("NumericVector cumnominus(NumericVector x) {\n  int n = x.size();\n  \n  NumericVector sumout(n);\n  \n  sumout[0] = (x[0] < 0) ? 0 : x[0];\n  \n  for(int i = 1; i < n; i++) {\n      \n      sumout[i] = (x[i] < 0) ? 0 : x[i] + sumout[i - 1];\n    \n    }\n  \n  return sumout;\n}")\n\nInventory |> \n  mutate(In = Supply,\n         End = cumnominus(Supply - Demand),\n         Start = lag(End, default = 0),\n         Short = pmax(0, Demand - (Start + Supply)),\n         Out = pmin(Demand, Start + In)) |> \n  select(Age, Demand, Supply, Start, In, Out, End, Short)\n\n#>   Age Demand Supply Start   In  Out  End Short\n#> 1  90      0   4000     0 4000    0 4000     0\n#> 2 120   5000     50  4000   50 4050    0   950\n#> 3 270     25   4000     0 4000   25 3975     0\n#> 4 365   5000    300  3975  300 4275    0   725\n#> 5 Inf     10      0     0    0    0    0    10\n\nResult\n#>   Age Demand Supply Start   In  Out  End Short\n#> 1  90      0   4000     0 4000    0 4000     0\n#> 2 120   5000     50  4000   50 4050    0   950\n#> 3 270     25   4000     0 4000   25 3975     0\n#> 4 365   5000    300  3975  300 4275    0   725\n#> 5 Inf     10      0     0    0    0    0    10\n

\n

作为对 5m 行数据帧上仅 R 循环的测试，与 8.5 秒的 R 循环相比，它大约需要 0.05 秒：

\n

cumnominus_r <- function(x) {\n  out_sum <- integer(length(x))\n  out_sum[1] <- max(0, x[1])\n  for (i in 2:length(x)) {\n    out_sum[i] <- ifelse(x[i] < 0, 0, out_sum[i - 1] + x[i])\n  }\n  \n  out_sum\n}\n\nbig_df <- tibble(\n  Demand = sample(seq(1000, 6000, 500), 5000000, replace = TRUE),\n  Supply = sample(seq(1000, 6000, 500), 5000000, replace = TRUE)\n) \n\n\nbench::mark(\n  Rcpp_fun = big_df |> \n    mutate(End = cumnominus(Supply - Demand)),\n  R_only_fun = big_df |> \n    mutate(End = cumnominus_r(Supply - Demand))\n)\n\n\n#> # A tibble: 3 \xc3\x97 6\n#>   expression       min   median `itr/sec` mem_alloc `gc/sec`\n#>   <bch:expr>  <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>\n#> 1 Rcpp_fun     43.15ms  52.95ms    16.1      77.7MB     8.94\n#> 2 R_only_fun     8.59s    8.59s     0.116    95.4MB    20.8 \n

\n