如何有条件地将 R 中的数据帧合并/加入到动态时间间隔

Question

在 R 中，我有两个代表 covid-19 患者的数据框，我想将它们合并到一个表中以便能够执行所需的分析。

df1 包含每次住院的元数据

df2 包含每次入住期间不同时间点的观察数据，通常每天一个，但有些每天不止一个

有些情况有多个停留，我发现很难合并这些数据集，以便将观察数据从相应的停留分配给其相应的元数据，其中没有变量来指示观察数据属于哪个停留而不是日期

可以使用此代码生成示例数据

df1 <- data.frame(id=c(1,2,3,3,3,4,4,5), in_date=c("2020-03-09", "2020-02-15" , "2020-04-16" , "2020-04-19", "2020-04-24", "2020-03-01" , "2020-03-15" , "2020-05-05") , location=c("a", "a" , "a", "b" , "b" , "a", "a" ,"a" ) )
df2 <- data.frame(id=c(1,1,1,2,2,2,3,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,5,5,5) , obs_time=c(
    "2020-03-09 01:00" , "2020-03-09 10:00" , "2020-03-10 05:00", 
    "2020-02-15 08:00" , "2020-02-16 09:00" , "2020-02-17 08:00", 
    "2020-04-16 14:30",  "2020-04-16 07:30" , "2020-04-17 15:00" , "2020-04-25 07:20" ,
    "2020-04-18 10:00" , "2020-04-19 10:30",  "2020-04-20 12:00", "2020-04-21 12:00" , 
    "2020-04-22 09:30" , "2020-04-24 23:00", "2020-04-23 17:30",
    "2020-03-01 08:00" , "2020-03-02 08:00" , "2020-03-03 08:00" ,  "2020-03-15 16:45" ,
     "2020-03-16 08:00" ,  "2020-05-05 13:45" , "2020-05-06 08:00" , "2020-05-07 11:00") ,
    temp_celsius=runif(25, min=35.8, max=42.0)      )

lubridate ymd_hm 和 ymd 函数用于将带日期的因子转换为 POSIX 日期变量。

请注意，数据未完全排序，案例 ID 3 有 3 次停留，但它们都是连续的，中间没有天数，并且在第一天有 2 次观察。案例 4 有两次停留，但中间有几天。

合并两个数据框时，我需要将不同的观察结果分配给不同的停留时间，以便我可以绘制具有起点（时间为零）的图，即它们在实际停留时进入的时间。在示例中，按第一个 obs_time 时间为零的位置组绘制所有案例沿 x 轴的温度变化。

虽然我发现其他相关的线程不一样。

想要的输出应该是这样的：

   id         obs_time temp_celsius stay_id stay_day location
1   1 2020-03-09 01:00     40.53805       1        1        a
2   1 2020-03-09 10:00     37.54832       1        1        a
3   1 2020-03-10 05:00     38.78600       1        2        a
4   2 2020-02-15 08:00     36.19048       1        1        a
5   2 2020-02-16 09:00     37.74323       1        2        a
6   2 2020-02-17 08:00     41.83050       1        3        a
7   3 2020-04-16 14:30     39.82978       1        1        a
8   3 2020-04-16 07:30     39.84554       1        1        a
9   3 2020-04-17 15:00     38.31164       1        2        a
10  3 2020-04-25 07:20     36.37992       3        2        b
11  3 2020-04-18 10:00     38.65261       1        3        a
12  3 2020-04-19 10:30     38.94991       2        1        b
13  3 2020-04-20 12:00     36.84384       2        2        b
14  3 2020-04-21 12:00     35.81786       2        3        b
15  3 2020-04-22 09:30     39.20979       2        4        b
16  3 2020-04-24 23:00     41.39876       3        1        b
17  3 2020-04-23 17:30     37.68251       2        5        b
18  4 2020-03-01 08:00     41.55690       1        1        a
19  4 2020-03-02 08:00     38.53060       1        2        a
20  4 2020-03-03 08:00     39.99385       1        3        a
21  4 2020-03-15 16:45     38.29500       2        1        a
22  4 2020-03-16 08:00     41.20947       2        2        a
23  5 2020-05-05 13:45     36.43556       1        1        a
24  5 2020-05-06 08:00     41.06712       1        2        a
25  5 2020-05-07 11:00     36.76612       1        3        a

希望有人能帮我解决这个问题

Answer 1

我认为这几乎涵盖了它。来自data.table 的滚动连接和一些操作应该可以让您到达那里。

set.seed(1)

library(data.table)

df1 <- data.frame(id=c(1,2,3,3,3,4,4,5),
                  in_date=c("2020-03-09", "2020-02-15" , "2020-04-16" , "2020-04-19", "2020-04-24", "2020-03-01" , "2020-03-15" , "2020-05-05") ,
                  location=c("a", "a" , "a", "b" , "b" , "a", "a" ,"a" ) )
df2 <- data.frame(id=c(1,1,1,2,2,2,3,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,5,5,5) , obs_time=c(
  "2020-03-09 01:00" , "2020-03-09 10:00" , "2020-03-10 05:00", 
  "2020-02-15 08:00" , "2020-02-16 09:00" , "2020-02-17 08:00", 
  "2020-04-16 14:30",  "2020-04-16 07:30" , "2020-04-17 15:00" , "2020-04-25 07:20" ,
  "2020-04-18 10:00" , "2020-04-19 10:30",  "2020-04-20 12:00", "2020-04-21 12:00" , 
  "2020-04-22 09:30" , "2020-04-24 23:00", "2020-04-23 17:30",
  "2020-03-01 08:00" , "2020-03-02 08:00" , "2020-03-03 08:00" ,  "2020-03-15 16:45" ,
  "2020-03-16 08:00" ,  "2020-05-05 13:45" , "2020-05-06 08:00" , "2020-05-07 11:00") ,
  temp_celsius=runif(25, min=35.8, max=42.0))

setDT(df1)
setDT(df2)

df1[, c('in_date') := .(lubridate::ymd(in_date))]
df1[, stay_id := 1:.N, by = id]
df2[, obs_time := lubridate::ymd_hm(obs_time)]
df2[, obs_date := as.Date(obs_time)]

df1[df2, .(id, in_date, obs_time, temp_celsius, stay_id, location), on = c('id', 'in_date' = 'obs_date'), roll = Inf][
  , stay_day := as.numeric(difftime(as.Date(obs_time), min(as.Date(in_date)), units = 'day')) + 1, by = .(id, stay_id)][, in_date := NULL][]
#>     id            obs_time temp_celsius stay_id location stay_day
#>  1:  1 2020-03-09 01:00:00     37.44615       1        a        1
#>  2:  1 2020-03-09 10:00:00     38.10717       1        a        1
#>  3:  1 2020-03-10 05:00:00     39.35169       1        a        2
#>  4:  2 2020-02-15 08:00:00     41.43089       1        a        1
#>  5:  2 2020-02-16 09:00:00     37.05043       1        a        2
#>  6:  2 2020-02-17 08:00:00     41.37002       1        a        3
#>  7:  3 2020-04-16 14:30:00     41.65699       1        a        1
#>  8:  3 2020-04-16 07:30:00     39.89695       1        a        1
#>  9:  3 2020-04-17 15:00:00     39.70051       1        a        2
#> 10:  3 2020-04-25 07:20:00     36.18307       3        b        2
#> 11:  3 2020-04-18 10:00:00     37.07704       1        a        3
#> 12:  3 2020-04-19 10:30:00     36.89465       2        b        1
#> 13:  3 2020-04-20 12:00:00     40.05954       2        b        2
#> 14:  3 2020-04-21 12:00:00     38.18144       2        b        3
#> 15:  3 2020-04-22 09:30:00     40.57302       2        b        4
#> 16:  3 2020-04-24 23:00:00     38.88574       3        b        1
#> 17:  3 2020-04-23 17:30:00     40.24923       2        b        5
#> 18:  4 2020-03-01 08:00:00     41.94982       1        a        1
#> 19:  4 2020-03-02 08:00:00     38.15622       1        a        2
#> 20:  4 2020-03-03 08:00:00     40.62016       1        a        3
#> 21:  4 2020-03-15 16:45:00     41.59517       2        a        1
#> 22:  4 2020-03-16 08:00:00     37.11528       2        a        2
#> 23:  5 2020-05-05 13:45:00     39.84038       1        a        1
#> 24:  5 2020-05-06 08:00:00     36.57844       1        a        2
#> 25:  5 2020-05-07 11:00:00     37.45677       1        a        3
#>     id            obs_time temp_celsius stay_id location stay_day

^{由reprex package (v0.3.0) 于 2020 年 7 月 16 日创建}