时间戳

首页 > 解决方案 > 在应用函数时有条件地合并两个 data.tables 的最有效方法

r - 在应用函数时有条件地合并两个 data.tables 的最有效方法

问题描述

我有随时间cohort_D0_multvis变化的遇到日期（即 CONTACT_DATE对于每个CONTACT_DATE我想保留最接近但严格低于相遇日期的实验室测量值。我还想保留任何没有任何实验室数据或不符合上述句子逻辑的记录的记录。

我能够在调节时将随时间变化的遭遇日期cohort_D0_multvis的 data.table 与实验室数据的 data.tableA1c合并CONTACT_DATE>LAB_DATE，如下所示：

条件合并：

test <- cohort_D0_multvis[unique(A1c)
                          , on = .(ID, CONTACT_DATE > LAB_DATE)
                          , nomatch = 0
                          , .(ID, CONTACT_DATE = x.CONTACT_DATE, LAB_DATE, A1c)]

接下来，我创建了一个新列test[,date_diff:=as.numeric(CONTACT_DATE-LAB_DATE)，然后用于.SD[which.min(date_diff)]保留最接近相遇日期的实验室测量值。最后，我将剩余的记录合并回我的遭遇数据中，以引入任何可能由于上述条件逻辑而被删除的记录，如下所示：

中间步骤：

test[,date_diff:=as.numeric(CONTACT_DATE-LAB_DATE)]
test <- test[,.SD[which.min(date_diff)],by=.(ID,CONTACT_DATE)]
test <- merge(test,cohort_D0_multvis,by=c("ID","CONTACT_DATE"),all.y = TRUE)

最终数据集：

### This is exactly what I want
   ID CONTACT_DATE   LAB_DATE      A1c date_diff
 1:  A   2002-01-26 2000-09-30 4.938065       483
 2:  A   2004-10-26 2000-09-30 4.938065      1487
 3:  A   2006-09-01 2000-09-30 4.938065      2162
 4:  A   2014-05-23 2007-12-08 6.170197      2358
 5:  A   2017-01-28 2007-12-08 6.170197      3339
 6:  A   2020-04-16 2007-12-08 6.170197      4513
 7:  B   1998-03-02       <NA>       NA        NA
 8:  B   2003-05-08       <NA>       NA        NA
 9:  B   2004-09-27 2003-10-14 7.071354       349
10:  B   2008-11-05 2007-06-04 5.173654       520
11:  B   2015-11-24 2014-06-03 6.100639       539
12:  C   1993-08-30       <NA>       NA        NA
13:  C   1993-10-04       <NA>       NA        NA
14:  C   1996-07-01 1995-07-28 5.852059       339
15:  C   1996-11-08 1995-07-28 5.852059       469
16:  C   1999-02-19 1995-07-28 5.852059      1302
17:  C   2012-01-03 2005-03-16 6.640102      2484
18:  C   2020-05-17 2018-11-23 4.729267       541

但是，我正在使用的实际遭遇数据和实验室数据有超过 130 万条记录，上面的条件合并将导致输出具有重复的唯一遭遇，每个唯一的实验室记录按 ID（即，超过 nrow(x)+ nrow(i) 行）。我必须重复这个过程大约 10 次（即，将大约 10 个实验室数据集合并到遇到数据集），这将非常耗费时间和内存。

我的问题：

非常感谢任何建议或帮助。下面是重现我的输出的代码。

可重现的例子：

library(data.table)
library(lubridate)

### Create sample cohort with screening dates
set.seed(1992)
cohort_D0_multvis <- data.table(ID=c(rep("A",6),rep("B",5),rep("C",7)),
                                CONTACT_DATE=c(sample(seq(as_date('1992/01/01'), as_date('2021/06/04'), by="day"), 6),
                                               sample(seq(as_date('1992/01/01'), as_date('2021/06/04'), by="day"), 5),
                                               sample(seq(as_date('1992/01/01'), as_date('2021/06/04'), by="day"), 7)))

setkeyv(cohort_D0_multvis,c("ID","CONTACT_DATE"))
cohort_D0_multvis

### Create sample a1c data with lab dates
set.seed(304)
A1c <- data.table(ID=c(rep("A",6),rep("B",5),rep("C",7)),
                  LAB_DATE=c(sample(seq(as_date('1992/01/01'), as_date('2021/06/04'), by="day"), 6),
                             sample(seq(as_date('1992/01/01'), as_date('2021/06/04'), by="day"), 5),
                             sample(seq(as_date('1992/01/01'), as_date('2021/06/04'), by="day"), 7)),
                  A1c=rnorm(18,5.7,1))
setkeyv(A1c,c("ID","LAB_DATE"))
A1c

### For every CONTACT_DATE we want to retain the lab measurement that occurs closest to, but strictly lower, than the screening date
test <- cohort_D0_multvis[unique(A1c)
                          , on = .(ID, CONTACT_DATE > LAB_DATE)
                          , nomatch = 0
                          , .(ID, CONTACT_DATE = x.CONTACT_DATE, LAB_DATE, A1c)]

test[,date_diff:=as.numeric(CONTACT_DATE-LAB_DATE)]
test <- test[,.SD[which.min(date_diff)],by=.(ID,CONTACT_DATE)]
# Bring back patients w/o lab data
test <- merge(test,cohort_D0_multvis,by=c("ID","CONTACT_DATE"),all.y = TRUE)
test

标签： rmergedata.tablecartesian-productprocessing-efficiency

解决方案

推荐阅读