在R中计算变量对总量增长的贡献及可视化实现求助

1. 公式说明 #

时间段T-T'内，某专科actes数量（变量X）对所有专科actes总量（变量Y）增长的贡献公式：

(Xt/Yt) * ((Xt' - Xt)/Xt) * 100

可简化为：

((Xt' - Xt)/Yt) * 100

（注：Xt为基期T的专科actes数，Xt'为报告期T'的专科actes数，Yt为基期T的所有专科actes总量）

2. 数据预处理 #

你提供的数据集存在语法错误（如向量长度不匹配、多余逗号），先提取核心数据并修正格式，转换为长格式方便后续计算：

# 加载所需工具包
library(dplyr)
library(tidyr)
library(ggplot2)

# 修正并整理核心数据
df <- structure(list(
  regroupement = c("Aut", "Ort", "Div", "Ac", "Obst", "IVG", "Néo", "Séan", 
                   "Rachis", "Chirurgie digestive", "Ophtalmo", "Uro-néphro", "Gynéco", 
                   "Autre1", "Autre2", "Autre3"),
  actes_2019 = c(10, 29520, 395, 14618, 5589, 6515, 4150, 866, 3458, 2137, 449, 0, 575, 2180, 9179, 36079),
  actes_2020 = c(8, 25451, 308, 12845, 4167, 7376, 2994, 337, 2206, 2107, 437, 4, 575, 1477, 7933, 36079),
  actes_2021 = c(18, 24055, 106, 13735, 5505, 8196, 3376, 352, 3035, 2571, 511, 8, 689, 1134, 6504, 42333)
), class = "data.frame", row.names = 1:16)

# 转换为长格式，便于按年份分组计算
df_long <- df %>%
  pivot_longer(cols = starts_with("actes_"), 
               names_to = "year", 
               values_to = "actes",
               names_prefix = "actes_") %>%
  mutate(year = as.integer(year))

3. 计算贡献值 #

3.1 计算各年份的actes总量 #

# 统计每年所有专科的actes总量
year_totals <- df_long %>%
  group_by(year) %>%
  summarise(total_actes = sum(actes)) %>%
  ungroup()

# 将总量合并到原始数据中
df_with_total <- df_long %>%
  left_join(year_totals, by = "year")

3.2 计算两个时间段的贡献值 #

# 计算2020-2021年的贡献
contrib_2020_2021 <- df_with_total %>%
  filter(year %in% c(2020, 2021)) %>%
  pivot_wider(names_from = year, values_from = c(actes, total_actes)) %>%
  mutate(
    contribution = ((actes_2021 - actes_2020)/total_actes_2020)*100,
    period = "2020-2021"
  ) %>%
  select(regroupement, period, contribution)

# 计算2019-2021年的贡献
contrib_2019_2021 <- df_with_total %>%
  filter(year %in% c(2019, 2021)) %>%
  pivot_wider(names_from = year, values_from = c(actes, total_actes)) %>%
  mutate(
    contribution = ((actes_2021 - actes_2019)/total_actes_2019)*100,
    period = "2019-2021"
  ) %>%
  select(regroupement, period, contribution)

# 合并两个时间段的结果
final_contrib <- bind_rows(contrib_2020_2021, contrib_2019_2021)

4. 绘制非堆叠条形图 #

使用ggplot2绘制分组条形图（非堆叠），对比不同时间段的贡献：

ggplot(final_contrib, aes(x = regroupement, y = contribution, fill = period)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.7) +
  labs(
    title = "各专科actes变化对总量增长的贡献",
    x = "专科",
    y = "贡献值 (%)",
    fill = "时间段"
  ) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) # 旋转x轴标签避免重叠

补充说明 #

• 无需使用for循环，用dplyr和tidyr的向量化操作更高效且易读
• 贡献值为负时，表示该专科actes数量下降，拉低了总量增长
• 若原始数据格式与示例不同，可调整pivot_longer/pivot_wider的参数适配

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