多列跨数据源损伤时间匹配：生成医院损伤关联标识列

云原生阿岚

2026-6-29

问题描述

我正在分析一份损伤数据集，数据来自4个数据源（hospital、gp、self report、death），每个数据源记录了损伤发生的时间（以年为单位的连续变量）。同一患者的损伤可能在单个或多个数据源中被记录。需要判断医院数据源记录的损伤是否在其他数据源中也有记录（时间差在0.25年内视为同一损伤）。

具体需求：

为每个医院列（Hospital_1至Hospital_4）生成对应的Hospital_elsewhere_(i)列
若Hospital_i列存在时间值，则Hospital_elsewhere_i先标记为"Hospital"
若其他非医院数据源的任意列中存在与该时间差在0.25年内的时间值，则追加对应的数据源名称，用|分隔（例如：Hospital|GP|self_report）

示例数据集：

library(tibble)
set.seed(123)

example_data <- tibble(
  id = 1:30,
  Hospital_1 = sample(c(NA, round(runif(25, 1, 80), 2)), 30, replace = TRUE),
  Hospital_2 = sample(c(NA, round(runif(25, 1, 80), 2)), 30, replace = TRUE),
  Hospital_3 = sample(c(NA, round(runif(25, 1, 80), 2)), 30, replace = TRUE),
  Hospital_4 = sample(c(NA, round(runif(25, 1, 80), 2)), 30, replace = TRUE),
  GP_1 = sample(c(NA, round(runif(25, 1, 80), 2)), 30, replace = TRUE),
  GP_2 = sample(c(NA, round(runif(25, 1, 80), 2)), 30, replace = TRUE),
  GP_3 = sample(c(NA, round(runif(25, 1, 80), 2)), 30, replace = TRUE),
  GP_4 = sample(c(NA, round(runif(25, 1, 80), 2)), 30, replace = TRUE),
  GP_5 = sample(c(NA, round(runif(25, 1, 80), 2)), 30, replace = TRUE),
  GP_6 = sample(c(NA, round(runif(25, 1, 80), 2)), 30, replace = TRUE),
  GP_7 = sample(c(NA, round(runif(25, 1, 80), 2)), 30, replace = TRUE),
  GP_8 = sample(c(NA, round(runif(25, 1, 80), 2)), 30, replace = TRUE),
  GP_9 = sample(c(NA, round(runif(25, 1, 80), 2)), 30, replace = TRUE),
  GP_10 = sample(c(NA, round(runif(25, 1, 80), 2)), 30, replace = TRUE),
  self_report_1 = sample(c(NA, round(runif(15, 1, 80), 2)), 30, replace = TRUE),
  self_report_2 = sample(c(NA, round(runif(15, 1, 80), 2)), 30, replace = TRUE),
  self_report_3 = sample(c(NA, round(runif(15, 1, 80), 2)), 30, replace = TRUE),
  self_report_4 = sample(c(NA, round(runif(15, 1, 80), 2)), 30, replace = TRUE),
  death_1 = sample(c(NA, round(runif(25, 1, 80), 2)), 30, replace = TRUE)
)

for (i in 1:10) {
  index <- sample(1:30, 1)  
  gp_value <- round(runif(1, 1, 80), 2)  
  example_data[index, paste0("GP_", 1:4)] <- gp_value 
  example_data[index, paste0("Hospital_", 1:4)] <- gp_value + runif(1, -0.25, 0.25)
}

解决方案

使用dplyr和purrr工具包批量处理所有医院列，步骤如下：

加载依赖包：

library(dplyr)
library(purrr)

定义处理单个医院列的函数：
该函数接收医院列名，检查对应时间值在其他数据源中是否有匹配（时间差≤0.25），并生成目标列：

create_elsewhere_col <- function(hosp_col, data) {
  # 获取当前医院列的时间值
  hosp_time <- data[[hosp_col]]
  
  # 按数据源分组整理非医院列
  other_sources <- list(
    GP = starts_with("GP_", vars = colnames(data)),
    self_report = starts_with("self_report_", vars = colnames(data)),
    death = starts_with("death_", vars = colnames(data))
  )
  
  # 初始化结果向量
  result <- ifelse(is.na(hosp_time), NA, "Hospital")
  
  # 遍历每个非医院数据源，检查是否有匹配的时间
  for (source_name in names(other_sources)) {
    source_cols <- other_sources[[source_name]]
    # 对每行检查该数据源下是否有任意列时间差≤0.25
    has_match <- pmap_lgl(data[source_cols], function(...) {
      if (is.na(hosp_time[cur_row()])) return(FALSE)
      any(abs(c(...) - hosp_time[cur_row()]) <= 0.25, na.rm = TRUE)
    })
    # 追加数据源名称到结果
    result <- ifelse(has_match, paste0(result, "|", source_name), result)
  }
  
  result
}

批量生成所有目标列：

# 获取所有医院列名
hosp_cols <- colnames(example_data)[starts_with("Hospital_", vars = colnames(example_data))]

# 为每个医院列生成对应的Hospital_elsewhere列
example_data <- example_data %>%
  mutate(
    across(all_of(hosp_cols), 
           ~create_elsewhere_col(cur_column(), example_data),
           .names = "Hospital_elsewhere_{gsub('Hospital_', '', .col)}")
  )

查看结果：
通过select函数查看目标列和对应的医院列：

example_data %>%
  select(id, starts_with("Hospital_")) %>%
  head()

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