使用日期时间回溯期记录事件是否发生在 r

Question

我想改造这个 dataframe：

library(tidyverse)
library(lubridate)
EVENT <- c("HR", "RR", "HR, "CREATITINE", "HR")
DATETIME <- c("2019-08-01 00:00:01", "2019-08-01 00:30:00", "2019-08-01 01:30:00", "2019-08-01 02:00:00", "2019-08-01 05:00:00")         
LOOK_BACK_HOURS <- c(1,1,1,3,1)     
df <- data.frame(EVENT, DATETIME, LOOK_BACK_HOURS) 
df <- df %>% 
  mutate(DATETIME = ymd_hms(DATETIME))

事件	约会时间	LOOK_BACK_HOURS
人力资源	2019-08-01 00:00:01	1
RR	2019-08-01 00:35:00	1
人力资源	2019-08-01 01:30:00	1
肌酐	2019-08-01 02:00:00	3
人力资源	2019-08-01 05:00:00	1

进入如下所示的 dataframe：

事件	约会时间	LOOK_BACK_HOURS	HR_FLAG	RR_FLAG	CREATININE_FLAG
人力资源	2019-08-01 00:00:01	1	1	0	0
RR	2019-08-01 00:35:00	1	1	1	0
人力资源	2019-08-01 01:30:00	1	1	1	0
肌酐	2019-08-01 02:00:00	3	1	1	1
人力资源	2019-08-01 05:00:00	1	1	0	0

该标志将指示在回溯期间是否存在该类型的事件。 不需要计算特定类型的事件发生的次数，只要它发生与否即可。

理想情况下，我想要一个 dplyr 解决方案，但鉴于我的实际数据集将包含 9 种事件类型和几百万行医学观察结果，高性能解决方案将大大加快在新数据集出现时运行它的速度。

谢谢

Answer 1

您可以像这样创建 function 并可以使用purrr::map来获取所需的数据帧。

为了找出时间范围，我根据LOOK_BACK_HOURS创建了一个新列。 有了这个，我会检查不同事件的给定时间是否在这个范围内，如果是这样，我会添加一个标志。

library(tidyverse)
library(lubridate)
#> 
#> Attaching package: 'lubridate'
#> The following objects are masked from 'package:base':
#> 
#>     date, intersect, setdiff, union
EVENT <- c("HR", "RR", "HR", "CREATITINE", "HR")
DATETIME <- c("2019-08-01 00:00:01", "2019-08-01 00:30:00", "2019-08-01 01:30:00", "2019-08-01 02:00:00", "2019-08-01 05:00:00")         
LOOK_BACK_HOURS <- c(1,1,1,3,1)     
df <- data.frame(EVENT, DATETIME, LOOK_BACK_HOURS) 
df <- df %>% 
  mutate(DATETIME = ymd_hms(DATETIME))

flag <- function(start, end, event, dff = df){
  
  dff %>% 
    filter(EVENT == event) %>% 
    pull(DATETIME) -> times
  
  ifelse(times >= start & times <= end, 1, 0) %>% 
    sum() -> flag_count
  
  ifelse(flag_count > 0, 1, 0)

}

df %>% 
  mutate(look_back_time = DATETIME - (LOOK_BACK_HOURS*60*60),
         HR_FLAG = pmap_dbl(list(look_back_time, DATETIME, "HR"), flag),
         RR_FLAG = pmap_dbl(list(look_back_time, DATETIME, "RR"), flag),
         CREATITINE_FLAG = pmap_dbl(list(look_back_time, DATETIME, "CREATITINE"), flag)) %>% 
  select(-look_back_time)
#>        EVENT            DATETIME LOOK_BACK_HOURS HR_FLAG RR_FLAG
#> 1         HR 2019-08-01 00:00:01               1       1       0
#> 2         RR 2019-08-01 00:30:00               1       1       1
#> 3         HR 2019-08-01 01:30:00               1       1       1
#> 4 CREATITINE 2019-08-01 02:00:00               3       1       1
#> 5         HR 2019-08-01 05:00:00               1       1       0
#>   CREATITINE_FLAG
#> 1               0
#> 2               0
#> 3               0
#> 4               1
#> 5               0

^{由reprex package (v0.3.0) 于 2021 年 2 月 18 日创建}