基于R求解两剂新冠疫苗接种时间序列的最优滞后间隔n

这个问题本质是单参数优化问题，核心目标是找到n使得估算第二剂接种量和实际值的误差最小，具体实现步骤如下：

步骤1：确定误差评估规则 #

我们选用最常用的均方误差（MSE）作为误差衡量指标，即实际值和估算值差值的平方的平均值，数值越小代表拟合效果越好。你原方案按2021-05-16拆分为两个时间段设置不同间隔，我们可以对两个时间段分别求解最优n，也可以直接全时段统一求解。

步骤2：实现代码 #

基于你已有的代码，补充优化逻辑如下：

library(tidyverse)
library(lubridate)
library(janitor)

# 读取和预处理数据（和原有逻辑一致）
vacc <- read_csv("https://api.covid19india.org/csv/latest/tested_numbers_icmr_data.csv")
vacc_df <- vacc %>% 
  clean_names() %>% 
  mutate(date = dmy(str_sub(update_time_stamp, 1, 10))) %>% 
  filter(date > "2021-01-16") %>% 
  select(date, first_dose_administered, second_dose_administered) %>% 
  relocate(date)

# 定义损失函数：输入n和时间段范围，返回对应MSE
calc_mse <- function(n, start_date, end_date) {
  df_sub <- vacc_df %>% 
    filter(date >= start_date, date <= end_date) %>% 
    mutate(est = lag(first_dose_administered, n)) %>% 
    drop_na(est, second_dose_administered)
  mean((df_sub$second_dose_administered - df_sub$est)^2, na.rm = TRUE)
}

# 设定n的搜索范围：符合疫苗接种间隔常识的14~120天，可根据当地政策调整
n_range <- 14:120

# 优化第一段：2021-05-16之前的最优n
mse_pre <- map_dbl(n_range, ~calc_mse(.x, start_date = "2021-01-16", end_date = "2021-05-15"))
best_n_pre <- n_range[which.min(mse_pre)]
# 优化第二段：2021-05-16之后的最优n
mse_post <- map_dbl(n_range, ~calc_mse(.x, start_date = "2021-05-16", end_date = max(vacc_df$date)))
best_n_post <- n_range[which.min(mse_post)]

# 输出最优n值
cat("2021-05-16前最优间隔：", best_n_pre, "天\n")
cat("2021-05-16后最优间隔：", best_n_post, "天\n")

# 用最优n重新计算估算值
vacc_df <- vacc_df %>% 
  mutate(est_second_dose = if_else(date < "2021-05-16", 
                                   lag(first_dose_administered, best_n_pre), 
                                   lag(first_dose_administered, best_n_post)))

# 绘图对比拟合效果
vacc_df %>% 
  pivot_longer(cols = -date) %>%
  ggplot(aes(x = date, y = value, color = name)) +
  geom_line() +
  scale_x_date(breaks = "1 month")+
  theme(legend.position = "bottom")

可选进阶优化 #

如果分段固定n的拟合效果仍不符合预期，可以尝试滚动窗口优化：每15/30天重新计算一次对应时段的最优间隔，适配接种政策变动、接种能力变化带来的间隔波动。

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