使用ggplot2绘制按日期/周统计的疫苗接种频次或占比图求助

数据预处理 #

原始数据存在日期格式为字符型、空值冗余的问题，先做清洗处理：

# 加载依赖包
library(tidyverse)
library(lubridate)

# 原始数据
data <- data.frame(
  id=c(1,1,1,1,2,2,2,3,3,3,3),
  date=c("01/12/2020","02/12/2020","03/12/2020","04/12/2020",
         "01/31/2020","03/12/2020","04/05/2020","02/12/2020","04/12/2020","05/12/2020","01/12/2020"),
  vac_date=c("","02/02/2020","","04/02/2020","","","04/01/2020","","04/01/2020","05/01/2020",""),
  dose=c('',1,'',2,'','',1,'',1,2,'')
)

# 清洗转换
clean_data <- data %>%
  # 转换日期格式（适配月/日/年）
  mutate(
    date = mdy(date),
    vac_date = mdy(vac_date),
    # 处理剂次字段：空值转NA，再转为因子类型
    dose = as.factor(ifelse(dose == "", NA, dose))
  ) %>%
  # 过滤无接种记录的行
  filter(!is.na(vac_date), !is.na(dose))

1. 不区分剂次的接种频次/占比图 #

按日统计频次（折线图） #

# 统计每日接种数
daily_counts <- clean_data %>%
  count(vac_date, name = "inoculations")

# 绘图
ggplot(daily_counts, aes(x = vac_date, y = inoculations)) +
  geom_line(color = "#2E86AB", linewidth = 1) +
  geom_point(size = 2) +
  labs(title = "每日疫苗接种频次", x = "接种日期", y = "接种人数") +
  theme_minimal()

按周统计频次（柱状图） #

# 按周截断日期，统计每周接种数（week_start=1表示周一为周起始）
weekly_counts <- clean_data %>%
  mutate(week_start = floor_date(vac_date, unit = "week", week_start = 1)) %>%
  count(week_start, name = "inoculations")

# 绘图
ggplot(weekly_counts, aes(x = week_start, y = inoculations)) +
  geom_col(fill = "#2E86AB", alpha = 0.8) +
  labs(title = "每周疫苗接种频次", x = "周起始日期", y = "接种人数") +
  theme_minimal()

按周统计占比（面积图） #

# 计算每周接种数占总接种数的比例
weekly_proportion <- clean_data %>%
  mutate(week_start = floor_date(vac_date, unit = "week", week_start = 1)) %>%
  count(week_start, name = "inoculations") %>%
  mutate(proportion = inoculations / sum(inoculations))

# 绘图
ggplot(weekly_proportion, aes(x = week_start, y = proportion)) +
  geom_line(color = "#F24C4E", linewidth = 1) +
  geom_area(fill = "#F24C4E", alpha = 0.3) +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(title = "每周疫苗接种占比", x = "周起始日期", y = "占比") +
  theme_minimal()

2. 按剂次分层的接种频次/占比图 #

每周各剂次频次（堆积柱状图） #

# 按周和剂次分组统计
weekly_dose_counts <- clean_data %>%
  mutate(week_start = floor_date(vac_date, unit = "week", week_start = 1)) %>%
  count(week_start, dose, name = "inoculations")

# 绘图
ggplot(weekly_dose_counts, aes(x = week_start, y = inoculations, fill = dose)) +
  geom_col(position = "stack", alpha = 0.8) +
  scale_fill_brewer(palette = "Set2") +
  labs(title = "每周各剂次疫苗接种频次", x = "周起始日期", y = "接种人数", fill = "接种剂次") +
  theme_minimal()

每周各剂次占比（堆积面积图） #

# 计算每周各剂次接种数占当周总接种数的比例
weekly_dose_proportion <- clean_data %>%
  mutate(week_start = floor_date(vac_date, unit = "week", week_start = 1)) %>%
  count(week_start, dose, name = "inoculations") %>%
  group_by(week_start) %>%
  mutate(proportion = inoculations / sum(inoculations)) %>%
  ungroup()

# 绘图
ggplot(weekly_dose_proportion, aes(x = week_start, y = proportion, fill = dose)) +
  geom_area(position = "stack", alpha = 0.7) +
  scale_fill_brewer(palette = "Set2") +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(title = "每周各剂次疫苗接种占比", x = "周起始日期", y = "占比", fill = "接种剂次") +
  theme_minimal()

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