如何用dplyr在R中基于另一列增长率外推缺失值？

需求说明 #

针对按**Product（产品）和Region（区域）**分组、**Year（年份）**排序的销售数据，实现以下目标：

• 利用World.growth列的增长率，外推每个分组中最后一个非缺失Sales值之后的所有缺失值（例如Product=1、Region=1的1973年值=1972年值×1973年World.growth）
• 了解如何通过自定义函数实现外推逻辑
• 掌握如何反向外推序列开头的缺失值

数据示例 #

library(openxlsx)
library(dplyr)

sales.data <- read.xlsx("\\Interpolate_sales.xlsx", sheet = 1)

print(sales.data)
#    Product Region Year      Sales World.growth Extrapolated.sales
# 1        1      1 1970         NA         0.88                 NA
# 2        1      1 1971 141.906913         0.72         141.906913
# 3        1      1 1972   9.605398         1.01           9.605398
# 4        1      1 1973         NA         1.18          11.334370
# 5        1      1 1974         NA         0.84           9.520871
# 6        1      2 1970  60.062486         0.88          60.062486
# 7        1      2 1971 124.904150         0.72         124.904150
# 8        1      2 1972         NA         1.01         126.153191
# 9        1      2 1973         NA         1.18         148.860765
# 10       1      2 1974         NA         0.84         125.043043
# 11       1      2 1975         NA         1.23         153.802943
# 12       1      3 1970  63.298780         0.88          63.298780
# 13       1      3 1971  90.219126         0.72          90.219126
# 14       1      3 1972 107.271043         1.01         107.271043
# 15       1      3 1973 129.122561         1.18         129.122561
# 16       1      3 1974         NA         0.84         108.462951

原有代码问题 #

用户尝试的dplyr代码仅能计算第一个缺失值，后续缺失值无法生成，原因是lag(Sales)仅调用原始Sales列的前一行值，而非已计算出的外推值：

sales.data.extrapolated <- sales.data %>%
  group_by(Product, Region) %>%
  arrange(Product, Region, Year) %>%
  mutate(Extrapolated.sales.manual = case_when(
    row_number() > max(which(!is.na(Sales))) ~ lag(Sales) * World.growth,
    TRUE ~ Sales
  ))

print(sales.data.extrapolated)

解决方案 #

一、正向外推（处理末尾缺失值） #

使用dplyr结合purrr::accumulate()实现累积计算，从最后一个非缺失值开始，依次乘以对应年份的增长率：

library(dplyr)
library(purrr)

sales.data <- sales.data %>%
  group_by(Product, Region) %>%
  arrange(Year, .by_group = TRUE) %>%
  mutate(
    # 标记需要外推的行：位于最后一个非缺失Sales之后
    extrapolate_flag = row_number() > max(which(!is.na(Sales))),
    # 累积计算外推值
    Extrapolated.sales = accumulate(
      seq_along(Sales),
      .init = Sales[max(which(!is.na(Sales)))],
      function(prev_val, i) {
        if (!extrapolate_flag[i]) Sales[i] else prev_val * World.growth[i]
      }
    )[-1]  # 移除初始值，匹配数据行数
  ) %>%
  ungroup()

二、自定义函数实现外推 #

将外推逻辑封装为自定义函数，逻辑直观且易于复用：

# 自定义正向外推函数
extrapolate_sales <- function(sales_vec, growth_vec) {
  last_non_na <- max(which(!is.na(sales_vec)))
  result <- sales_vec
  # 从最后一个非缺失值的下一行开始循环计算
  for (i in (last_non_na + 1):length(sales_vec)) {
    result[i] <- result[i - 1] * growth_vec[i]
  }
  return(result)
}

# 在分组数据中调用函数
sales.data <- sales.data %>%
  group_by(Product, Region) %>%
  arrange(Year, .by_group = TRUE) %>%
  mutate(Extrapolated.sales = extrapolate_sales(Sales, World.growth)) %>%
  ungroup()

三、反向外推（处理开头缺失值） #

若要外推序列开头的缺失值，需反向计算：用第一个非缺失值除以后续年份的增长率（例如1970年值=1971年值/1971年World.growth）：

# 自定义反向外推函数
back_extrapolate_sales <- function(sales_vec, growth_vec) {
  first_non_na <- min(which(!is.na(sales_vec)))
  result <- sales_vec
  # 从第一个非缺失值的上一行开始反向循环计算
  for (i in (first_non_na - 1):1) {
    result[i] <- result[i + 1] / growth_vec[i + 1]
  }
  return(result)
}

# 同时实现正向+反向外推
sales.data <- sales.data %>%
  group_by(Product, Region) %>%
  arrange(Year, .by_group = TRUE) %>%
  mutate(
    # 先处理末尾缺失值
    Extrapolated.sales = extrapolate_sales(Sales, World.growth),
    # 再处理开头缺失值
    Extrapolated.sales = back_extrapolate_sales(Extrapolated.sales, World.growth)
  ) %>%
  ungroup()

内容的提问来源于stack exchange，提问作者reytla