使用一個數據集上的一列中的日期設置一年范圍（向前），以查找與 R 中的 id 匹配的不同數據集上的日期

Question

我有兩個數據集，（dt1）一個具有“開始”日期，每個單獨的 ID 最多兩個條目（因為這些是 L 或 R 眼中的手術條目）和一個（dt2）第二個數據庫，前后有多個日期開始日期。 這些不僅限於眼科手術，還包括任何其他醫療保健訪問。 我想在我的數據集中的所有 id 中查找手術 L 和 R 開始日期后一年內的事件。 如果他們有結果，我想通過橫向匹配他們。 如果他們沒有，那么在一年內的最后一次訪問中沒有偏側匹配（lat）。 先前的結果只是開始日期之前的結果或“事件”的數量，即先前結果的總和。

id   lat year status       date
1    le   18      1 2018-07-06
1    re   11      1 2011-04-12
2    le   15      0 2015-01-10
2    re   11      0 2011-07-20
3    NA   10      1 2010-02-18
3 bilat   13      1 2013-09-26



    id   lat outcome       date year
 1:  1    NA       0 2015-07-06   15
 2:  1    le       0 2019-04-03   19
 3:  1    le       1 2019-04-30   19
 4:  1    re       1 2011-07-14   11
 5:  1    re       1 2015-09-10   15
 6:  1    re       1 2008-07-14    8
 7:  2    NA       0 2015-11-10   15
 8:  2    re       0 2012-04-23   12
 9:  2    NA       0 2015-02-18   15
10:  2    57       0 2008-12-01    8
11:  3    57       0 2014-01-15   14
12:  3    NA       0 2014-02-21   14
13:  3 bilat       1 2014-02-28   14

我希望決賽桌看起來像這樣

id lat year status       date outcome   end_date prior_outcome
1  le   18      1 2018-07-06       1 2019-04-30             3
1  re   11      1 2011-04-12       1 2011-07-14             1
2  le   15      0 2015-01-10       0 2015-11-10             0
2  re   11      0 2011-07-20       0 2012-04-23             0
3  NA   10      1 2010-02-18       0       <NA>             0
3 bilat 13      1 2013-09-26       1 2014-02-28             0

這是數據集的代碼

 dates <- as.Date(c("2018-07-06","2011-04-12",
                   "2015-01-10","2011-07-20",
                   "2010-02-18","2013-09-26"))
dt1 <- data.table(id=c(1,1,2,2,3,3),
                  lat=c("le","re","le","re","NA", "bilat"),
                  year= c(18, 11,15,11,10,13),
                  status=status <- c(1,1,0,0,1,1),
                  date= dates)

dates2 <- as.Date(c('2015-07-06',
                    '2019-04-03',
                    '2019-04-30',
                    '2011-07-14',
                    '2015-09-10',
                    '2008-07-14',
                    '2015-11-10',
                    '2012-04-23',
                    '2015-02-18',
                    '2008-12-01',
                    '2014-01-15',
                    '2014-02-21',
                    '2014-02-28' ))
dt2 <- data.table(id=c(1,1,1,1,1,1,2,2,2,2,3,3,3),
                  lat=c("NA","le","le","re","re","re","NA","re","NA","57", "57", "NA","bilat"),
                  outcome = c(0,0,1,1,1,1,0,0,0,0,0,0,1),
                          date= dates2, year= c(15,19,19,11,15,08,15,12,15,08,14,14,14))
                          

我嘗試了類似的方法，但它在原始集合中不起作用，因為我在開始日期之前得到了結果，所以我假設代碼可能在這個小數據集中工作，但實際上，它在某種程度上是不正確的。

#left join dt1 and dt2
dt1_dt2 <- left_join( dt2,dt1, by= "id", suffix=c("2event","1op"))

#filter does with outcome after date1 
dt1_dt2$tdiff = difftime(dt1_dt2$date2event,dt1_dt2$date1op, units= "days")
dt1_dt2 = dt1_dt2 %>% filter(outcome== 1) %>% 
  filter(tdiff <= 365, tdiff >= 0)
         

#then match on the closest date since farthest was not supported 
setDT(dt1)
setDT(dt1_dt2)
setkey(dt1, id, lat) #key set to match
dt3 <- dt1_dt2[, date2, by =.(id, lat2), roll ="nearest"] #how can I keep all variables?
dt3 = unique(dt3, by = c("id", "date2","lat2"))

Answer 1

更新的答案

# construct complete data
da <- merge(dt1,dt2,by=c("id","lat"),all.x = TRUE,suffixes = c("_start","_end"))
# select desired columns => add tdiff ==> replace outcome == NA with 0
da2 <- da[,.(id,lat,year_start,status,date_start,outcome,date_end)][
  , tdiff := as.numeric( difftime(date_end, date_start, units= "days"))][, outcome:=fifelse(is.na(outcome),0,outcome)]

# add flag to show whether the part of da2 (id,lat) also appears in dt2
setkey(da2,id,lat)
setkey(dt2,id,lat)
da2[,flag:=FALSE][dt2,flag:=TRUE]

# get desired result
dt_desired <- da2[0 <= tdiff & tdiff <= 365 | lat == "NA" | is.na(date_end)]
rows <- dt_desired[flag==FALSE & outcome == 0]
# fill with last event's date_end within one year
dt_desired[flag==FALSE & outcome == 0]$date_end <- dt2[,.SD,keyby=.(id,date)][,.SD[.N],by=id][rows,date]
dt_desired[as.numeric( difftime(date_end, date_start, units= "days")) > 365]$date_end <- NA

結果：

   id lat year_start status date_start outcome   date_end tdiff  flag
1:  1  le         18      1 2018-07-06       1 2019-04-03   271  TRUE
2:  1  re         11      1 2011-04-12       1 2011-07-14    93  TRUE
3:  2  le         15      0 2015-01-10       0 2015-11-10    NA FALSE
4:  2  re         11      0 2011-07-20       0 2012-04-23   278  TRUE
5:  3  57         13      0 2013-09-26       1 2014-01-15   111  TRUE
6:  3  NA         10      1 2010-02-18       0       <NA>    NA FALSE

原始答案

根據您的代碼，我得到的結果接近您想要的結果。 請檢查是否正確。

dt1_dt2 <- left_join( dt2,dt1, by= "id", suffix=c("2event","1op"))
# add column tdiff, equal to your method
dt1_dt2[, tdiff := as.numeric( difftime(date2event, date1op, units= "days") )]

# select desired columns
dt1_dt2[0 <= tdiff & tdiff <= 365, 
        .(id,lat1op,year1op,status,date1op,outcome,date2event)]

我的結果與您的結果之間的差異位於第 5 行。 根據您提供的數據，我找不到任何帶有NA的end_date 。 至於prior_outcome ，您沒有展示如何計算它。 我認為這不是主要問題。

Answer 2

這是使用非 equi 連接的選項：

cols <- c("outcome", "end_date") 

dt1[, oneyr := date + 365L] #or in case of leap year, dt1[, oneyr := as.Date(sapply(date, function(d) seq(d, by="1 year", length.out=2L)[[2L]]), origin="1970-01-01")]

dt1[, (cols) := 
    dt2[.SD, on=.(id, lat, date>=date, date<=oneyr), mult="first", .(x.outcome, x.date)]
]

dt1[is.na(outcome), (cols) := 
    dt2[.SD, on=.(id, date>=date, date<=oneyr), mult="first", .(x.outcome, x.date)]
]

dt1[is.na(outcome), outcome := 0L]

output：

   id lat year status       date      oneyr outcome   end_date
1:  1  le   18      1 2018-07-06 2019-07-06       1 2019-04-03
2:  1  re   11      1 2011-04-12 2012-04-11       1 2011-07-14
3:  2  le   15      0 2015-01-10 2016-01-10       0 2015-11-10
4:  2  re   11      0 2011-07-20 2012-07-19       0 2012-04-23
5:  3  NA   10      1 2010-02-18 2011-02-18       0       <NA>
6:  3  57   13      0 2013-09-26 2014-09-26       1 2014-01-15

---

qn 更新后編輯。 不清楚新的所需 output 是什么，您可以嘗試以下操作：

dt1[, oneyr := date + 365L] 

cols <- paste0("i.", names(dt1))
a1 <- dt2[dt1, on=.(id, lat, date>=date, date<=oneyr), c(mget(cols), 
    .(outcome=outcome, end_date=x.date))]
setnames(a1, names(a1), gsub("^i.","",names(a1)))

a2 <- dt2[a1[is.na(outcome)], on=.(id, date>=date, date<=oneyr), c(mget(cols), 
    .(outcome=outcome, end_date=x.date))]
setnames(a2, names(a2), gsub("^i.","",names(a2)))
    
setorder(rbindlist(list(a1[!is.na(outcome)], a2), use.names=TRUE), id, date)[]

output：

   id lat year status       date      oneyr outcome   end_date
1:  1  re   11      1 2011-04-12 2012-04-11       1 2011-07-14
2:  1  le   18      1 2018-07-06 2019-07-06       0 2019-04-03
3:  1  le   18      1 2018-07-06 2019-07-06       1 2019-04-30
4:  2  re   11      0 2011-07-20 2012-07-19       0 2012-04-23
5:  2  le   15      0 2015-01-10 2016-01-10       0 2015-11-10
6:  2  le   15      0 2015-01-10 2016-01-10       0 2015-02-18
7:  3  NA   10      1 2010-02-18 2011-02-18      NA       <NA>
8:  3  57   13      0 2013-09-26 2014-09-26       0 2014-01-15

---

在所需的 output 更新后編輯：

cols <- c("outcome", "end_date") 

dt1[, oneyr := date + 365L] #or in case of leap year, dt1[, oneyr := as.Date(sapply(date, function(d) seq(d, by="1 year", length.out=2L)[[2L]]), origin="1970-01-01")]

dt1[, (cols) := 
    dt2[.SD, on=.(id, lat, date>=date, date<=oneyr), by=.EACHI, {
        w <- which(outcome==1L)
        if (length(w) > 0L) {
            .(outcome=outcome[w[1L]], x.date[w[1L]])
        } else {
            .(outcome=outcome[1L], x.date[1L])
        }
    }][, (1L:4L) := NULL]
]

dt1[is.na(outcome), (cols) := 
    dt2[.SD, on=.(id, date>=date, date<=oneyr), by=.EACHI, {
        w <- which(outcome==1L)
        if (length(w) > 0L) {
            .(outcome=outcome[w[1L]], x.date[w[1L]])
        } else {
            .(outcome=outcome[1L], x.date[1L])
        }
    }][, (1L:3L) := NULL]
]

dt1[is.na(outcome), outcome := 0L][]

output：

   id   lat year status       date      oneyr outcome   end_date
1:  1    le   18      1 2018-07-06 2019-07-06       1 2019-04-30
2:  1    re   11      1 2011-04-12 2012-04-11       1 2011-07-14
3:  2    le   15      0 2015-01-10 2016-01-10       0 2015-02-18
4:  2    re   11      0 2011-07-20 2012-07-19       0 2012-04-23
5:  3    NA   10      1 2010-02-18 2011-02-18       0       <NA>
6:  3 bilat   13      1 2013-09-26 2014-09-26       1 2014-02-28