多组累计百分比分析：月度患者到访占比R代码异常排查

云上老周

2026-6-19

问题背景

某医院诊所拥有10年的每日患者到访数据（并非每日都有患者到访记录），示例数据通过R语言生成如下：

library(dplyr)

set.seed(123)

start_date <- as.Date("2010-01-01")
end_date <- as.Date("2019-12-31")
all_dates <- seq.Date(start_date, end_date, by="day")

num_visits <- sample(1:length(all_dates), size = 3000, replace = FALSE)
visit_dates <- all_dates[num_visits]

num_patients <- sample(1:100, size = length(visit_dates), replace = TRUE)

clinic_data <- data.frame(date = visit_dates, num_patients = num_patients)

hospital_data <- clinic_data %>% arrange(date)

       date num_patients
 2010-01-01           90
 2010-01-02           96
 2010-01-04           65
 2010-01-05           80
 2010-01-06           15
 2010-01-07           87

需求：计算任意月份中，截至第y天，累计到访患者占当月总患者的平均百分比（例如：已知某月总到访900人，求截至第19天的累计占比）。

原始代码问题分析

最初实现的R代码生成的累计百分比绘图不符合预期，核心问题如下：

统计维度错误：原始代码按年份计算累计占比，而需求是按月份统计，分母误用年度总患者数而非月度总患者数，完全偏离需求目标。
分组逻辑错误：通过by(hospital_data, hospital_data$year)按年份分组计算累计，未针对每个月份单独计算当月累计患者数及占比，无法得到月度维度的有效累计占比数据。
缺失日期处理不当：原始数据存在日期间断（并非每日都有记录），代码直接对现有日期的患者数做累加，导致后续日期的平均累计占比可能出现不合理的波动（比如占比下降）。

原始代码如下：

library(ggplot2)

hospital_data$year <- as.numeric(format(as.Date(hospital_data$date), "%Y"))
hospital_data$month <- as.numeric(format(as.Date(hospital_data$date), "%m"))
hospital_data$day <- as.numeric(format(as.Date(hospital_data$date), "%d"))

hospital_data <- hospital_data[order(hospital_data$date), ]

yearly_totals <- aggregate(num_patients ~ year, data = hospital_data, FUN = sum)
names(yearly_totals)[2] <- "yearly_total"

hospital_data <- merge(hospital_data, yearly_totals, by = "year")

results <- by(hospital_data, hospital_data$year, function(df) {
    df$cumulative_patients <- cumsum(df$num_patients)
    df$cumulative_percentage <- df$cumulative_patients / df$yearly_total * 100
    return(df)
})
results <- do.call(rbind, results)

avg_results <- aggregate(cumulative_percentage ~ day, data = results, FUN = mean, na.rm = TRUE)

avg_results <- avg_results[order(avg_results$day), ]

ggplot(avg_results, aes(x = day, y = cumulative_percentage)) +
    geom_line() +
    geom_point() +
    scale_x_continuous(breaks = seq(1, 31, by = 5)) +
    scale_y_continuous(limits = c(0, 100)) +
    labs(title = "Average Cumulative Percentage of Yearly Patients by Day",
         x = "Day of Month",
         y = "Average Cumulative Percentage of Patients") +
    theme_minimal() +
    theme(panel.grid.minor = element_blank())

修正后的代码及说明

修正后的代码针对原始问题进行了如下优化：

按月份分组，计算每个月的总患者数以及截至每日的累计占比；
对每个日期（1-31日）计算所有月份中该日期累计占比的平均值；
使用cummax处理日期间断导致的平均占比波动，确保累计百分比随日期递增（符合实际逻辑，累计占比不会下降）。

修正代码如下：

library(tidyverse)

result <- hospital_data %>%
  mutate(month = floor_date(date, "month"),
         day = day(date)) %>%
  group_by(month) %>%
  arrange(month, day) %>%
  mutate(month_total = sum(num_patients),
         cuml = cumsum(num_patients),
         cuml_pct = cuml / month_total) %>%
  ungroup() %>%
  group_by(day) %>%
  summarize(avg_cuml_pct = mean(cuml_pct, na.rm = TRUE)) %>%
  arrange(day)

result <- result %>%
  mutate(avg_cuml_pct = cummax(avg_cuml_pct))

ggplot(result, aes(day, avg_cuml_pct)) +
  geom_line() +
  scale_y_continuous(labels = scales::percent_format(), limits = c(0, 1)) +
  scale_x_continuous(breaks = seq(0, 31, by = 5)) +
  labs(x = "Day of Month", 
       y = "Average Cumulative Percentage of Monthly Patients",
       title = "Average Cumulative Patient Percentage by Day of Month") +
  theme_minimal()

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