setting a one year range (forward) using dates in one column on one dataset to find dates on a different dataset matching by id in R

user_14347361 0
Viewed 143

I have two data sets, (dt1) one with a "start" date, up to two entries per individual id (since these are entries for surgery in L or R eye) and a (dt2) second database with multiples dates before and after the start date. These are not restricted to eye surgeries but include any other healthcare visit. I want to look for an event within one year of the start date for both surgeries L and R for all the ids in my dataset. If they had the outcome, I would like to match them by laterality. If they didn't, then on the last visit within one year without laterality matched (lat). Prior outcome is just the number of outcomes or "events" before the start date, sum of previous outcomes.

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

I would like the final table to look like this

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

Here are the codes for the data sets

 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))

I tried something like this, but it is not working in the original set, as I'm getting outcomes before the start date, so I assumed that the code might work in this small dataset, but in reality, it is incorrect somehow.

#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"))
longitudinal survival-analysis data.table r date
2 Answers

updated answer

# 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

results:

   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

original answer

Based on your code, I get the result close to your desired result. Please check if it is right.

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)]

The difference between my result with yours locates in the 5th row. From the data you provided, I can't find any end_date with NA. As to prior_outcome, you didn't show how to calculate it. I think it's not the major problem.

enter image description here

user_75227640

Here is an option to use non-equi joins:

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

Edit after qn update. Not clear what the new desired output is, you can try something like:

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

edit after desired output update:

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
user_19894800
Related