如何填充R中数据框中的缺失值，其中填充缺失值的逻辑是百分比变化估计？

Question

我正在为一家零售商处理成本数据，我正在使用 gam 进行一些预测，如下所示（示例数据，自行生成）。GAM 适合中间的值，但在极端处有一些 NA。弹性计算为成本变化百分比与项目变化百分比之比。

df <- tibble(
  factor = seq(0.7,1.3, 0.1),
  items = c(7, 8, 9, 10, 11, 12, 13),
  cost = c(NA, NA, 70, 80, 90, NA, NA),
  elasticity = c(NA, NA, 0.5, 0.6, 0.7, NA, NA)
)

对弹性的一个简单估计是向上和向下扩展最后一个已知值。

df %>%
    fill(elasticity, .direction = 'updown') ->
    df

因素	项目	成本	弹性
0.7	7	不适用	0.5
0.8	8	不适用	0.5
0.9	9	70	0.5
1.0	10	80	0.6
1.1	11	90	0.7
1.2	12	不适用	0.7
1.3	13	不适用	0.7

我想计算成本，估计成本弹性。例如，对于系数 1.2，项目为 12，弹性为 0.7。项目变化百分比为 (12-11)/11 = 9.09%，因此成本变化百分比应为 0.7 * 9.09% = 6.36%。由于因子 1.1 的成本为 90，因此因子 1.2 的成本为 95.72。同样的情况也向下和向上传播。

我想不出办法做到这一点。有人可以建议如何在 R 中（最好是在 dplyr 中）完成此操作吗？

Answer 1

一种可能的解决方案使用dplyr和purrr：

\n

图书馆

\n

library(dplyr)\nlibrary(tidyr)\nlibrary(purrr) # used for pmap() in dbl_fill()\n

\n

数据

\n

<-注意，在命名列表元素、tibble 列等时应避免使用。

\n

df <- tibble(\n  factor = seq(0.7,1.3, 0.1),\n  items = c(7, 8, 9, 10, 11, 12, 13),\n  cost = c(NA, NA, 70, 80, 90, NA, NA),\n  elasticity = c(NA, NA, 0.5, 0.6, 0.7, NA, NA)\n)\n\ndf <- fill(df, elasticity, .direction = \'updown\')\n

\n

创造dbl_fill()

\n

我意识到在变异时df我需要根据缺失值的“深度”递归lag()或列。lead()我假设您的数据是示例数据，因此认为最好创建一个通用函数，将数值向量滞后/领先到最大可接受的深度（对于本例来说 2 就足够了）。

\n

dbl_fill <- function(x, lag_or_lead = c("lag", "lead"), max_fill = 2){\n\n  lag_or_lead <- match.arg(lag_or_lead)\n  if(lag_or_lead == "lag") fill_function <- lag\n  else fill_function <- lead\n  \n  n_list <- as.list(1:max_fill)\n  \n  fill_list <- lapply(n_list, function(y) fill_function(x, y))\n \n  vector_out <- pmap_dbl(fill_list, coalesce)\n  \n  return(vector_out)\n}\n

\n

执行各种突变

\n

我们可以对 执行大量突变df，然后删除select()我们不想保留的列。

\n

我df$items在这里落后/领先，因为我不想假设该列中的值在行之间递增 1。items - 1但如果是的话，那么做与 相对的事情就足够了lag(items)。例如，这些是等效的。

\n

df <- mutate(df,\n             ## calculate new costs from lagged values\n             pc_change_items = (items - lag(items)) / lag(items),\n             lagged_cost     = dbl_fill(cost, "lag", 2),\n             pc_change_cost  = pc_change_items * elasticity,\n             lag_cost        = lagged_cost * (1 + pc_change_cost),\n             \n             ## calculate new costs from lead\'ed values\n             pc_change_items = (lead(items) - items) / items,\n             leaded_cost     = dbl_fill(cost, "lead", 2),\n             pc_change_cost  = pc_change_items * elasticity,\n             lead_cost       = leaded_cost * (1 - pc_change_cost)\n             )\n

\n

删除中间列

\n

df <- select(df, factor, items, cost, elasticity, lag_cost, lead_cost)\ndf\n#> # A tibble: 7 \xc3\x97 6\n#>   factor items  cost elasticity lag_cost lead_cost\n#>    <dbl> <dbl> <dbl>      <dbl>    <dbl>     <dbl>\n#> 1    0.7     7    NA        0.5     NA        65  \n#> 2    0.8     8    NA        0.5     NA        65.6\n#> 3    0.9     9    70        0.5     NA        75.6\n#> 4    1      10    80        0.6     74.7      84.6\n#> 5    1.1    11    90        0.7     85.6      NA  \n#> 6    1.2    12    NA        0.7     95.7      NA  \n#> 7    1.3    13    NA        0.7     95.2      NA\n

\n

合并成本

\n

请注意，这里我优先考虑lag_costover lead_cost，但这完全是任意的，您可能想证明它的合理性。在两者都可用的情况下获取两者的平均值可能会更平衡，但这超出了这个答案的范围。

\n

mutate(df, cost = coalesce(cost, lag_cost, lead_cost)) |> \n  select(-lag_cost, -lead_cost)\n#> # A tibble: 7 \xc3\x97 4\n#>   factor items  cost elasticity\n#>    <dbl> <dbl> <dbl>      <dbl>\n#> 1    0.7     7  65          0.5\n#> 2    0.8     8  65.6        0.5\n#> 3    0.9     9  70          0.5\n#> 4    1      10  80          0.6\n#> 5    1.1    11  90          0.7\n#> 6    1.2    12  95.7        0.7\n#> 7    1.3    13  95.2        0.7\n

\n

^{创建于 2022 年 10 月 25 日，使用reprex v2.0.2}

\n