在R中合并预算数据集并按原计划比例调整修订金额

问题背景 #

现有两个预算数据集：

• Dataset1：包含支出项目（spending_line）的COFOG功能分类、经济分类，以及原计划（Original）和修订后（Revised）的支出金额
• Dataset2：记录了修订金额的变动原因，仅包含修订阶段的数据

核心需求是合并数据集后，按COFOG功能分析排除会计调整和内部预算中性转移的支出变化。但直接使用left_join()以spending_line为键合并时，会因行复制导致修订金额被重复累加，最终汇总值失真。需要基于原计划中各COFOG功能的支出权重，将修订金额按比例分配到对应行，且适配每个spending_line对应不同数量COFOG分类的场景。

原始数据构建 #

library(tidyverse)

# 构建Dataset1：包含支出项目、COFOG功能分类、经济分类、预算阶段及金额
df1 <- tibble(
  spending_line = c("Programme A","Programme A", "Programme A", "Programme A", 
                    "Programme B", "Programme B", "Programme B", "Programme B"),
  spending_function_COFOG = c("7. Health", "7. Health", "7. Health", "7. Health", 
                              "10. Social Protection", "10. Social Protection", "10. Social Protection", "10. Social Protection"),
  original_revised = c("Original", "Original", "Revised", "Revised", 
                       "Original", "Original", "Revised", "Revised"),
  economic_category = c("Staff pay", "Purchase of goods and services", "Staff pay", "Purchase of goods and services",
                        "Grants to individuals", "Staff pay", "Grants to individuals", "Staff pay"),
  amount = c(7900, 2000, 8500, 2100,
             5000, 2500, 3000, 2500)
)

# 按支出项目和预算阶段汇总Dataset1，验证原计划与修订金额
df1 %>% 
  group_by(spending_line, original_revised) %>% 
  summarise(amount = sum(amount), .groups = "drop") %>% 
  pivot_wider(names_from = original_revised, values_from = amount)

# 构建Dataset2：包含支出项目、预算阶段、修订原因及对应金额
df2 <- tibble(
  spending_line = c("Programme A","Programme A", "Programme A", "Programme A", 
                    "Programme B", "Programme B", "Programme B", "Programme B"),
  original_revised = c("Revised", "Revised", "Revised", "Revised", 
                       "Revised", "Revised", "Revised", "Revised"),
  revision_reason = c("Baseline spending", "Internal budget-neutral transfer between spending lines", "Accounting adjustments", "Budget non-neutral increase / decrease",
                      "Baseline spending", "Internal budget-neutral transfer between spending lines", "Accounting adjustments", "Budget non-neutral increase / decrease"),
  amount = c(8100, 1000, -500, 2000,
             7000, -1000, -300, -200)
)

# 汇总Dataset2，验证与Dataset1的修订金额一致
df2 %>% 
  group_by(spending_line, original_revised) %>% 
  summarise(amount = sum(amount), .groups = "drop") %>% 
  pivot_wider(names_from = original_revised, values_from = amount)

直接合并的问题演示 #

直接通过spending_line和original_revised合并后，修订阶段的金额会因行复制被重复累加，导致汇总值翻倍：

# 直接合并两个数据集
joint_df <- left_join(x = df1, y = df2, by = c("spending_line", "original_revised"))

# 填充原计划阶段的金额并查看汇总结果
joint_df %>% 
  mutate(amount.y = case_when(original_revised == "Original" ~ amount.x, TRUE ~ amount.y)) %>% 
  select(-amount.x) %>% 
  rename(amount = amount.y) %>%
  group_by(spending_line, original_revised) %>% 
  summarise(amount = sum(amount), .groups = "drop") %>% 
  pivot_wider(names_from = original_revised, values_from = amount)

通用解决方案实现 #

思路 #

1. 从Dataset1提取原计划阶段每个spending_line下各COFOG分类的支出权重（占该项目原计划总金额的比例）
2. 对Dataset2按spending_line和revision_reason汇总金额，避免重复行
3. 将汇总后的修订原因数据与权重表关联，按权重比例分配每个原因对应的金额到各COFOG分类行
4. 合并回Dataset1的完整结构，确保最终汇总值准确

代码实现 #

# 1. 计算原计划阶段各spending_line下COFOG分类的支出权重
original_weights <- df1 %>%
  filter(original_revised == "Original") %>%
  group_by(spending_line, spending_function_COFOG) %>%
  summarise(original_amount = sum(amount), .groups = "drop") %>%
  group_by(spending_line) %>%
  mutate(weight = original_amount / sum(original_amount)) %>%
  ungroup()

# 2. 汇总Dataset2的修订原因金额（去除重复行）
df2_summary <- df2 %>%
  group_by(spending_line, original_revised, revision_reason) %>%
  summarise(revision_amount = sum(amount), .groups = "drop")

# 3. 按权重分配修订金额到各COFOG分类
revised_allocated <- df2_summary %>%
  left_join(original_weights, by = "spending_line") %>%
  mutate(allocated_amount = revision_amount * weight) %>%
  select(spending_line, spending_function_COFOG, original_revised, revision_reason, allocated_amount)

# 4. 合并回Dataset1，并处理原计划阶段数据
final_df <- df1 %>%
  left_join(revised_allocated, by = c("spending_line", "spending_function_COFOG", "original_revised")) %>%
  # 原计划阶段无修订原因，保留原金额；修订阶段使用分配后的金额
  mutate(final_amount = case_when(
    original_revised == "Original" ~ amount,
    TRUE ~ allocated_amount
  ))

# 验证汇总结果（与原数据一致）
final_df %>%
  group_by(spending_line, original_revised) %>%
  summarise(total_amount = sum(final_amount, na.rm = TRUE), .groups = "drop") %>%
  pivot_wider(names_from = original_revised, values_from = total_amount)

# 按COFOG功能分析排除指定原因后的支出变化
final_df %>%
  filter(original_revised == "Revised") %>%
  filter(!revision_reason %in% c("Internal budget-neutral transfer between spending lines", "Accounting adjustments")) %>%
  group_by(spending_function_COFOG) %>%
  summarise(adjusted_revised_amount = sum(final_amount, na.rm = TRUE), .groups = "drop")

方案优势 #

• 适配每个spending_line对应多个COFOG分类的场景，权重计算自动适配不同分类数量
• 彻底解决合并后金额重复累加的问题，确保汇总值准确
• 可灵活过滤指定修订原因，满足按COFOG功能分析的需求

内容的提问来源于stack exchange，提问作者Xavier Villà Aguilar