公共卫生流行病学：无需dplyr::rowwise()将自定义函数应用于日期列

问题背景 #

作为病毒性呼吸道监测的流行病学家，我们按监测季分析数据：监测季始于每年10月第一周的周日，次年重置（例如2023-2024季的时间范围是2023-10-01至2024-09-28）。

最初编写的test_func函数可处理单个日期，或配合dplyr::rowwise()逐行处理数据框，但直接将其应用于日期向量或数据框的日期列时，会触发「条件长度大于1」的报错，需要一个无需依赖rowwise()的向量化解决方案。

初始函数的问题 #

初始函数依赖普通if语句处理条件判断，但if仅支持长度为1的逻辑值。当传入日期向量时，wkday %in% 1:6、date < season_start这类条件会返回长度与输入向量一致的逻辑向量，导致报错。

初始函数代码：

test_func <- function(date){
  
  if(class(date)!="Date"){
    stop("Input not in date format.")
  }
  
  year = as.numeric(strftime(date, "%Y"))
  days = date - as.Date(sprintf("%s-10-01", year))
  
  oct_start = date - days
  
  #1 = monday, 7 = sunday
  
  wkday = as.numeric(strftime(oct_start, "%u"))
  
  #10/1/2022 saturday, starts 10/2/2022
  #10/1/2021 friday, starts 10/3/2021
  #10/1/2020 thursday, starts 10/4/2020
  
  if(wkday %in% 1:6){
    season_start = oct_start - wkday
  } else{
    season_start = oct_start
  }
  
  season_end = season_start + 364
  
  if(date < season_start){
    season_start = season_start - 364
    season_end = season_start + 364
  }
  
  year1 = as.numeric(strftime(season_start, "%Y"))
  year2 = as.numeric(strftime(season_end, "%Y"))
  
  return(paste(year1,year2, sep = "-"))
}

测试验证：

• 单个日期调用正常：test_func(as.Date("2024-09-28")) 返回正确结果 "2023-2024"
• 日期向量调用报错：test_func(seq.Date(from = as.Date("2023-10-01"), to = as.Date("2023-10-31"), by = 1)) 触发「条件长度大于1」错误

向量化解决方案（最终函数） #

通过完全向量化的逻辑重构，结合safe.ifelse解决日期类型丢失的问题，实现了支持向量输入的assign_season函数：

assign_season <- function(date){

  if(class(date)!="Date"){
    stop("Input not in date format.")
  }

  init_week_num = OCepi::to_mmwr_date(OCepi::week_ending_date(date), "week")

  adjust = ifelse(init_week_num %in% c(40:53), init_week_num - 40, 40 - init_week_num) * 7

  init_season_start = safe.ifelse(
    init_week_num %in% c(40:53),
    OCepi::week_ending_date(date - adjust) - 6,
    OCepi::week_ending_date(date + adjust) - 6
  )

  season_start = safe.ifelse(date < init_season_start, init_season_start - 364, init_season_start)

  season_end = season_start + 363

  year1 = as.numeric(strftime(season_start, "%Y"))
  year2 = as.numeric(strftime(season_end, "%Y"))

  return(paste(year1,substr(year2,3,4), sep = "-"))
}

关键改进点 #

1. 向量化条件判断：用ifelse和safe.ifelse替代普通if，支持对整个向量的元素级条件处理
2. 日期类型保留：safe.ifelse解决了普通ifelse会把Date类型转换为数值的问题，确保中间结果始终保持Date格式
3. 简化逻辑：借助OCepi包的MMWR日期工具，直接基于周数计算监测季起始日，避免了原函数中复杂的日期偏移计算
4. 批量处理支持：可直接传入日期向量或数据框的日期列，无需dplyr::rowwise()即可完成批量分配

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