跨午夜时段的概率关联配对分块解决方案（R语言reclin2）

问题背景 #

• 使用R的reclin2包关联两个各含3万+案例的医疗数据集，部分案例无配对
• 核心需求：基于时间区间匹配（X的单时间点落在Y的时间区间内），但reclin2::pair_blocking()不支持%within%操作
• 额外限制：存在跨午夜的时间区间，无法仅用日期匹配；数据质量差，无性别、年龄等其他有效匹配字段；需CPU高效的方案

示例数据集 #

library(lubridate)
# Dataset X
case.x <- c(1,2,3,4) 
Event_time <- c("1/2/23 14:56:00", "4/5/23 23:56:00", "7/6/23 00:42:00", "2/5/23 05:06:00")
Location <- c("A", "B", "A", "B")
X <- data.frame(case.x, Event_time, Location)
X$Event_time <- dmy_hms(Event_time)

# Dataset Y
case.y <- c(1,2,3,4) 
event_range_start <- c("1/2/23 13:56:00", "4/5/23 22:56:00", "6/6/23 23:42:00", "2/5/23 04:06:00")
event_range_end <- c("1/2/23 15:56:00", "5/5/23 00:56:00", "7/6/23 01:42:00", "2/5/23 06:06:00")
Location <- c("A", "B", "A", "B")
Y <- data.frame(case.y, event_range_start, event_range_end, Location)
Y$event_range <- interval(dmy_hms(Y$event_range_start), dmy_hms(Y$event_range_end))

解决方案 #

方法1：reclin2框架下的高效配对 #

步骤1：按Location粗分块（减少无效计算）

先通过pair_blocking()按Location分组，过滤掉不同地点的无效组合，大幅缩小后续计算范围：

library(reclin2)

# 按Location生成候选配对
pairs <- pair_blocking(X, Y, blocking_var = "Location")

步骤2：筛选时间区间匹配的组合

通过compare_pairs()添加时间匹配判断，再过滤出符合条件的配对。为提升效率，将时间转换为Unix时间戳用数值比较替代%within%：

# 转换时间为Unix时间戳（秒级，计算更快）
X$event_unix <- as.numeric(X$Event_time)
Y$range_start_unix <- as.numeric(dmy_hms(Y$event_range_start))
Y$range_end_unix <- as.numeric(dmy_hms(Y$event_range_end))

# 在候选配对中添加时间匹配判断
pairs <- compare_pairs(pairs, on = c("event_unix", "range_start_unix", "range_end_unix"),
                       compare_fun = function(x, y_start, y_end) {
                         x >= y_start & x <= y_end
                       },
                       var = "time_match")

# 提取有效配对并关联原始数据
matched_pairs <- pairs[pairs$time_match, ]
result <- merge(matched_pairs, X, by.x = ".id.x", by.y = "row.names")
result <- merge(result, Y, by.x = ".id.y", by.y = "row.names")

方法2：data.table高效替代方案 #

如果reclin2的速度仍不满足，用data.table的非等值连接，这是处理大数据集区间匹配的最优选择之一：

library(data.table)

# 转换为data.table格式
setDT(X)
setDT(Y)

# 添加Unix时间戳
X[, event_unix := as.numeric(Event_time)]
Y[, `:=`(range_start_unix = as.numeric(dmy_hms(event_range_start)),
         range_end_unix = as.numeric(dmy_hms(event_range_end)))]

# 非等值连接：同Location + X时间落在Y区间内
matched_result <- Y[X, on = .(Location, 
                              range_start_unix <= event_unix, 
                              range_end_unix >= event_unix),
                   .(case.x = i.case.x, case.y = case.y, 
                     Event_time = i.Event_time, 
                     event_range_start, event_range_end, Location)]

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