Как создать уникальный идентификатор для каждой группы на основе относительного интервала дат в R с помощью dplyr? - PullRequest
Новая
       14

Как создать уникальный идентификатор для каждой группы на основе относительного интервала дат в R с помощью dplyr?

0 голосов
/ 28 января 2019

У меня есть когорта данных с посещениями нескольких человек, и я хочу сгруппировать посещения с общим идентификатором на основе номера лица и времени посещения.Условие состоит в том, что если запуск происходит в течение 24 часов после предыдущего выхода, то я хочу, чтобы у них был такой же идентификатор.

Пример того, как выглядят данные: 

dat <- data.frame(
Person_ID = c(1,1,1,2,3,3,3,4,4),
Admit_Date_Time = as.POSIXct(c("2017-02-07 15:26:00","2017-04-21 10:20:00", 
"2017-04-22 12:12:00", "2017-10-16 01:31:00","2017-01-24 02:41:00","2017-    01-24 05:31:00", "2017-01-28 04:26:00", "2017-12-01 01:31:00","2017-12-01 
01:31:00"), format = "%Y-%m-%d %H:%M"),
Discharge_Date_Time  = as.POSIXct(c("2017-03-01 11:42:00","2017-04-22 
05:56:00",
"2017-04-26 21:01:00",
"2017-10-18 20:11:00",
"2017-01-27 22:15:00",
"2017-01-26 15:35:00",
"2017-01-28 09:25:00",
"2017-12-05 18:33:00",
"2017-12-04 16:41:00"),format = "%Y-%m-%d %H:%M" ),
Visit_ID = c(1:9))

Это то, что я пытался запустить: 

dat1 <- 
dat %>%
arrange(Person_ID, Admit_Date_Time) %>%
group_by(Person_ID) %>%
mutate(Previous_Visit_Interval = difftime(lag(Discharge_Date_Time, 
1),Admit_Date_Time, units = "hours")) %>%
mutate(start = c(1,Previous_Visit_Interval[-1] < hours(-24)), run = 
cumsum(start))

dat1$ID = as.numeric(as.factor(paste0(dat1$Person_ID,dat1$run)))

Что почти верно, за исключением того, что не даетправильный ID для посещения 7 (человек № 3).Поскольку существует три посещения, и второе посещение полностью в течение первого, а третье начинается в течение 24 часов после первого, но не второго.

Ответы [ 2 ]

0 голосов
/ 29 января 2019

Вот подход data.table, использующий соединение с перекрытием 

library( data.table )
library( lubridate )
setDT( dat )
setorder( dat, Person_ID, Admit_Date_Time )
#create a 1-day extension after each discharge
dt2 <- dat[, discharge_24h := Discharge_Date_Time %m+% days(1)][]
#now create id
setkey( dat, Admit_Date_Time, discharge_24h )
#create data-table with overlap-join, create groups based on overlapping ranges
dt2 <- setorder( 
  foverlaps( dat, 
             dat, 
             mult = "first", 
             type = "any", 
             nomatch = 0L 
             ), 
  Visit_ID )[, list( Visit_ID = i.Visit_ID, 
                     Hosp_ID = .GRP ), 
             by = .( Visit_ID )][, Visit_ID := NULL]

#reorder the result
setorder( dt2[ dat, on = "Visit_ID" ][, discharge_24h := NULL], Visit_ID )[]

#    Visit_ID Hosp_ID Person_ID     Admit_Date_Time Discharge_Date_Time
# 1:        1       1         1 2017-02-07 15:26:00 2017-03-01 11:42:00
# 2:        2       2         1 2017-04-21 10:20:00 2017-04-22 05:56:00
# 3:        3       2         1 2017-04-22 12:12:00 2017-04-26 21:01:00
# 4:        4       3         2 2017-10-16 01:31:00 2017-10-18 20:11:00
# 5:        5       4         3 2017-01-24 02:41:00 2017-01-27 22:15:00
# 6:        6       4         3 2017-01-24 05:31:00 2017-01-26 15:35:00
# 7:        7       4         3 2017-01-28 04:26:00 2017-01-28 09:25:00
# 8:        8       5         4 2017-12-01 01:31:00 2017-12-05 18:33:00
# 9:        9       5         4 2017-12-01 01:31:00 2017-12-04 16:41:00
0 голосов
/ 29 января 2019

Возможно, есть способ сократить это, но вот подход, использующий tidyr::gather и spread.Собирая в длинный формат, мы можем отслеживать совокупное количество посещений в каждом посещении.Новое посещение записывается всякий раз, когда есть новое Person_ID или когда Person_ID завершило посещение (кумулятивное число обращений упало до нуля) по крайней мере за 24 часа. 

library(tidyr)
dat1 <- dat %>%
  # Gather into long format with event type in one column, timestamp in another
  gather(event, time, Admit_Date_Time:Discharge_Date_Time) %>%

  # I want discharges to have an effect up to 24 hours later. Sort using that.
  mutate(time_adj = if_else(event == "Discharge_Date_Time", 
                            time + ddays(1), 
                            time)) %>%
  arrange(Person_ID, time_adj) %>%

  # For each Person_ID, track cumulative admissions. 0 means a visit has completed. 
  #   (b/c we sorted by time_adj, these reflect the 24hr period after discharges.)
  group_by(Person_ID) %>%
  mutate(admissions = if_else(event == "Admit_Date_Time", 1, -1)) %>%
  mutate(admissions_count = cumsum(admissions)) %>%
  ungroup() %>%

  # Record a new Hosp_ID when either (a) a new Person, or (b) preceded by a 
  #   completed visit (ie admissions_count was zero).
  mutate(Hosp_ID_chg = 1 * 
           (Person_ID != lag(Person_ID, default = 1) |   # (a)
            lag(admissions_count, default = 1) == 0),    # (b)
         Hosp_ID = cumsum(Hosp_ID_chg)) %>%

  # Spread back into original format
  select(-time_adj, -admissions, -admissions_count, -Hosp_ID_chg) %>%
  spread(event, time)

Результаты 

> dat1
# A tibble: 9 x 5
  Person_ID Visit_ID Hosp_ID Admit_Date_Time     Discharge_Date_Time
      <dbl>    <int>   <dbl> <dttm>              <dttm>             
1         1        1       1 2017-02-07 15:26:00 2017-03-01 11:42:00
2         1        2       2 2017-04-21 10:20:00 2017-04-22 05:56:00
3         1        3       2 2017-04-22 12:12:00 2017-04-26 21:01:00
4         2        4       3 2017-10-16 01:31:00 2017-10-18 20:11:00
5         3        5       4 2017-01-24 02:41:00 2017-01-27 22:15:00
6         3        6       4 2017-01-24 05:31:00 2017-01-26 15:35:00
7         3        7       4 2017-01-28 04:26:00 2017-01-28 09:25:00
8         4        8       5 2017-12-01 01:31:00 2017-12-05 18:33:00
9         4        9       5 2017-12-01 01:31:00 2017-12-04 16:41:00
...