如何用R语言基于DataFrame标识符高效查询90天内既往入院记录？

我有两个DataFrame：

• sample：包含患者入院详情及微生物检测结果，每行字段包括患者ID（hid）、入院ID（SpellID）、标本ID（SpecID）、入院时间（AdmDateTime）、出院时间（DisDateTime）和标本采集日期（dc）；
• wmward_long：包含患者的全部入院记录。

需求：为sample新增Adm_Prior_90d列，标记该患者在标本采集日（dc）前90天是否存在其他入院记录（无论该记录是否关联微生物检测）。

我尝试用自定义函数结合mapply逐行处理，但运行极慢甚至冻结，原代码如下：

# 注：原代码中sample的hid列存在输入错误，已修正为独立患者ID以保证逻辑通顺
sample <- data.frame(
"hid" = c("a123", "B456", "c567", "d890"),
"SpellID" = c(12783, 54462, 92369, 73682), 
"AdmDateTime" = c("2021-04-04 06:17:00","2021-04-04 06:20:00","2021-04-04 06:33:00", "2021-04-04 06:56:00"),
"DisDateTime" = c("2021-04-14 06:17:00","2021-04-24 06:20:00","2021-05-05 06:33:00", "2022-04-04 06:56:00"),
"SpecID" = c("c1893", "c6790", "c8370", "c7908"), 
"dc" = c("2021-04-05 06:17:00","2021-04-06 06:20:00","2021-04-05 06:33:00", "2021-04-06 06:56:00"))

wmward_long <- data.frame(
"hid" = c("a123", "B456", "c567", "d890", "a123", "B456"),
"SpellID" = c(12783, 54462, 92369, 73682, 89097, 54444), 
"AdmDateTime" = c("2021-04-04 06:17:00","2021-04-04 06:20:00","2021-04-04 06:33:00", "2021-04-04 06:56:00", "2021-03-04 06:17:00","2021-02-04 06:20:00"),
"DisDateTime" = c("2021-04-14 06:17:00","2021-04-24 06:20:00","2021-05-05 06:33:00", "2022-04-04 06:56:00", "2021-03-20 06:17:00","2021-02-27 06:20:00"))

adm_prior_90d <- function(culture_date, hospital_ID, spell_ID) {
recent_admissions <- filter(wmward_long,
hid == hospital_ID &
SpellID != spell_ID &
DisDateTime < culture_date & DisDateTime >= culture_date - 90)
return(nrow(recent_admissions) > 0)
}

sample <- sample %>%
mutate(AdmPrior90d = mapply(adm_prior_90d, dc, hid, SpellID))

请问有没有更高效的实现方式？

逐行循环（如mapply/apply）的效率极低，尤其是数据量大时，因为每次循环都要重新过滤整个数据集。推荐用向量化操作或分组连接的方式，以下是两种高效实现：

方法1：使用dplyr（tidyverse生态） #

library(dplyr)
library(lubridate)

# 第一步：转换日期类型（原代码中日期为字符型，必须转为时间格式才能正确计算）
sample <- sample %>%
  mutate(across(c(AdmDateTime, DisDateTime, dc), as.POSIXct))

wmward_long <- wmward_long %>%
  mutate(across(c(AdmDateTime, DisDateTime), as.POSIXct))

# 第二步：连接+分组判断，替代逐行循环
sample <- sample %>%
  # 按患者ID连接所有入院记录
  left_join(wmward_long %>% select(hid, SpellID_other = SpellID, DisDateTime_other = DisDateTime), 
            by = "hid") %>%
  # 筛选符合条件的记录：非当前入院、出院日期在标本采集日前90天内
  mutate(valid = (SpellID_other != SpellID) & 
           (DisDateTime_other < dc) & 
           (DisDateTime_other >= dc - days(90))) %>%
  # 按原sample的行分组，判断是否存在有效记录
  group_by(hid, SpellID, SpecID, AdmDateTime, DisDateTime, dc) %>%
  summarise(Adm_Prior_90d = any(valid, na.rm = TRUE), .groups = "drop")

方法2：使用data.table（适合超大数据集） #

data.table的连接和分组操作效率更高，尤其当数据量达到百万级以上时：

library(data.table)

# 转换为data.table并处理日期类型
setDT(sample)[, c("AdmDateTime", "DisDateTime", "dc") := lapply(.SD, as.POSIXct), .SDcols = c("AdmDateTime", "DisDateTime", "dc")]
setDT(wmward_long)[, c("AdmDateTime", "DisDateTime") := lapply(.SD, as.POSIXct), .SDcols = c("AdmDateTime", "DisDateTime")]

# 连接后筛选条件，再分组聚合判断
sample <- wmward_long[sample, on = "hid", allow.cartesian = TRUE][
  SpellID != i.SpellID & DisDateTime < i.dc & DisDateTime >= i.dc - 86400*90, # 86400为一天的秒数
  .(Adm_Prior_90d = .N > 0), 
  by = .(hid, SpellID = i.SpellID, SpecID = i.SpecID, AdmDateTime = i.AdmDateTime, DisDateTime = i.DisDateTime, dc = i.dc)
]

# 补全无匹配记录的行，标记为FALSE
sample <- sample[unique(sample[, .(hid, SpellID, SpecID, AdmDateTime, DisDateTime, dc)]), on = names(sample)[1:6]]
sample[is.na(Adm_Prior_90d), Adm_Prior_90d := FALSE]

关键优化点 #

• 避免逐行循环：向量化操作一次性处理整个数据集，效率远高于逐行过滤；
• 预处理日期类型：确保日期计算正确，同时避免重复转换；
• 分组聚合替代逐行判断：通过连接后分组统计，减少重复计算。

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