Увеличивать, если условие выполнено более 48 часов

Question

У меня есть следующие данные о появлении определенного симптома у пациента («симптом»). Я должен посчитать количество эпизодов, в которых возникает этот симптом («симптом_эпизод»), и если симптом отсутствует в течение> 48 часов, мне нужно увеличить «восстановление» +1. Вот пример с желаемым выводом для 'симптома_эпизода' и для 'восстановления':

  dat=data.table(
  date=c("2015-01-01 06:00:00 UTC","2015-01-01 16:53:00 UTC","2015-01-02 05:15:00 UTC","2015-01-03 05:28:00 UTC","2015-01-04 05:13:00 UTC","2015-01-05 05:25:00 UTC","2015-01-06 05:11:00 UTC","2015-01-07 05:25:00 UTC","2015-01-08 05:20:00 UTC","2015-01-09 05:17:00 UTC","2015-01-09 15:25:00 UTC","2015-01-10 05:22:00 UTC","2015-01-11 05:19:00 UTC"),
  symptom=c(0,1,1,1,0,0,1,1,0,0,0,0,0),
  symptom_episode=c(0,1,1,1,0,0,2,2,0,0,0,0,0),
  recovery=c(0,0,0,0,0,0,0,0,1,1,1,1,1)
)

Моя проблема в том, что я понятия не имею о том, как подсчитать количество эпизодов симптомов или провести часть восстановления. Я полагаю, что часть восстановления должна быть возможна с помощью какого-то решения rollapply!?

Буду очень признателен за любую помощь или предложения!

Answer 1

Вот подход dplyr, не самый лаконичный, но, надеюсь, имеет смысл.

library(dplyr); library(lubridate)
output <- dat %>%
  mutate(date = ymd_hms(date)) %>%
  mutate(symptom_ep_calc = if_else(symptom > 0, cumsum(symptom > 0 & lag(symptom) == 0), 0L),
         region = cumsum(symptom_ep_calc != lag(symptom_ep_calc, default = 0)))

output %>%
  group_by(region, symptom_ep_calc) %>% summarize(end = max(date)) %>% ungroup() %>%
  mutate(time_recovered = (end - lag(end, default = min(output$date))) / dhours(1),
         recovery_calc = cumsum(time_recovered > 48 & symptom_ep_calc == 0)) %>%
  right_join(output) %>%
  select(date, symptom, symptom_ep_calc, recovery_calc)


# A tibble: 13 x 4
   date                symptom symptom_ep_calc recovery_calc
   <dttm>                <dbl>           <int>         <int>
 1 2015-01-01 06:00:00       0               0             0
 2 2015-01-01 16:53:00       1               1             0
 3 2015-01-02 05:15:00       1               1             0
 4 2015-01-03 05:28:00       1               1             0
 5 2015-01-04 05:13:00       0               0             0
 6 2015-01-05 05:25:00       0               0             0
 7 2015-01-06 05:11:00       1               2             0
 8 2015-01-07 05:25:00       1               2             0
 9 2015-01-08 05:20:00       0               0             1
10 2015-01-09 05:17:00       0               0             1
11 2015-01-09 15:25:00       0               0             1
12 2015-01-10 05:22:00       0               0             1
13 2015-01-11 05:19:00       0               0             1

Answer 2

Попробуй это. Я изменил последнее значение, чтобы проверить результат (должно быть 1, если симптом_эпизод = 0, а время <48 часов. </p>

> library(data.table)
> library(dplyr)
> dat=data.table(
+   date=c("2015-01-01 06:00:00 UTC","2015-01-01 16:53:00 UTC","2015-01-02 05:15:00 UTC","2015-01-03 05:28:00 UTC","2015-01-04 05:13:00 UTC","2015-01-05 05:25:00 UTC","2015-01-06 05:11:00 UTC","2015-01-07 05:25:00 UTC","2015-01-08 05:20:00 UTC","2015-01-09 05:17:00 UTC","2015-01-09 15:25:00 UTC","2015-01-10 05:22:00 UTC","2015-01-15 05:19:00 UTC"),
+   symptom=c(0,1,1,1,0,0,1,1,0,0,0,0,0),
+   symptom_episode=c(0,1,1,1,0,0,2,2,0,0,0,0,0),
+   recovery=c(0,0,0,0,0,0,0,0,0,0,0,0,0)
+ )
> 
> 
> dat$hours <- c(NA, difftime(dat$date[-1],
+                            dat$date[-nrow(dat)],
+                            units="hours"))
> 
> dat$recovery[dat$hours<48] <- 0
> 
> dat$recovery[dat$hours>48 & dat$symptom_episode==0]<-1
> 
> head(dat)
                      date symptom symptom_episode recovery    hours
1: 2015-01-01 06:00:00 UTC       0               0        0       NA
2: 2015-01-01 16:53:00 UTC       1               1        0 10.88333
3: 2015-01-02 05:15:00 UTC       1               1        0 12.36667
4: 2015-01-03 05:28:00 UTC       1               1        0 24.21667
5: 2015-01-04 05:13:00 UTC       0               0        0 23.75000
6: 2015-01-05 05:25:00 UTC       0               0        0 24.20000
...
head(dat[13,]
#correctly updates 'recovery' value to 1.

date symptom symptom_episode recovery  hours
1: 2015-01-15 05:19:00 UTC       0               0        1 119.95