Комплекс условных групп в R

Question

Вот проблема, которую я пытаюсь решить. Я хочу перенести таблицу 1 в таблицу 2.

Таблица 1:

df
#       icustay_id           starttime             endtime vaso_rate vaso_amount
# 1          1 2019-09-10 13:20:00 2019-09-11 13:20:00         3    293.0896
# 2          1 2019-09-11 13:30:00 2019-09-12 01:20:00         9    602.9983
# 3          1 2019-09-14 16:40:00 2019-09-15 16:40:00         4    208.9360
# 4          2 2019-09-10 12:40:00 2019-09-13 13:20:00         2    864.1494
# 5          3 2019-09-10 01:20:00 2019-09-11 13:20:00         9    405.2939

Таблица 2:

df
#       icustay_id           starttime             endtime vaso_rate vaso_amount
# 1          1 2019-09-10 13:20:00 2019-09-12 01:20:00         3    293.0896
# 2          1 2019-09-14 16:40:00 2019-09-15 16:40:00         4    208.9360
# 3          2 2019-09-10 12:40:00 2019-09-13 13:20:00         2    864.1494
# 4          3 2019-09-10 01:20:00 2019-09-11 13:20:00         9    405.2939

Как вы заметили: я пытаюсь построитьфункция, которая будет:

1. Для каждого отдельного уникального пациента (уникальный icustay_id), groupby icustay_id, ТОЛЬКО если лекарство было остановлено менее чем на час.
2. Когда строка сливается: некоторые столбцы сохранят одно и то же значение (т. Е. Идентификаторы пациента). Некоторые столбцы необходимо изменить:
3. Сохранить более раннее время начала
4. Оставить последнее время окончания
5. Среднее значение вазо-ставки
6. Сумма вазо-суммы

Для этого я решил добавить еще один идентификатор столбца, который принимает значение 1, когдаусловие выполнено, и когда все строки проверены, groupby (icustay_id и этот новый столбец)

Мой код в том виде, в котором он написан, однако не присваивает соответствующий идентификатор в отношении условия.

Вот пример кода создания df:

set.seed(1)
df <- data.frame(   
  icustay_id = c(1, 1, 1, 2, 3),   
  starttime = as.POSIXct(c("2019-09-10 13:20", "2019-09-11 13:30",  "2019-09-14 16:40", "2019-09-10 12:40", "2019-09-10 01:20")),   
  endtime = as.POSIXct(c("2019-09-11 13:20", "2019-09-11 01:20", "2019-09-15 16:40", "2019-09-13 13:20", "2019-09-11 13:20")),   
  vaso_rate = sample(1:10, 5, replace = TRUE),   
  vaso_amount = runif(5, 0, 1000) 
)

Вот код функции, который у меня есть прямо сейчас:

merge_pressor_doses <- function(df){
  df %>% arrange(icustay_id,starttime)
  for (i in unique(df$icustay_id))
    {
    for (j in which(df$icustay_id==i))
      {
      start <- df$starttime[as.numeric(j)+1]
      end <- df$endtime[as.numeric(j)]
      stopduration <- as.numeric(difftime(start, end, units = 'mins'))
      bool <- stopduration < 60
      df <- df%>%mutate(
          group = case_when(
            bool = TRUE ~ 1,
            bool = FALSE ~ 0)
          )
      }
  } 
  return(df)
}

Это должно привести к:

df
#       icustay_id           starttime             endtime vaso_rate vaso_amount  group
# 1          1 2019-09-10 13:20:00 2019-09-11 13:20:00         3    293.0896      1
# 2          1 2019-09-11 13:30:00 2019-09-12 01:20:00         9    602.9983      1
# 3          1 2019-09-14 16:40:00 2019-09-15 16:40:00         4    208.9360      0
# 4          2 2019-09-10 12:40:00 2019-09-13 13:20:00         2    864.1494      1
# 5          3 2019-09-10 01:20:00 2019-09-11 13:20:00         9    405.2939      1

Но в моем случае 3-й строке присваивается значение 1 ...

Если мне удастся заставить эту часть кода работать, я мог бы перейти к этой части кода для достижения своей цели.

Возможный второй ркод будет такой:

group_by(group, icustay_id) %>% 
  summarise(
    starttime = min(starttime), 
    endtime = max(endtime),
    vaso_rate = mean(vaso_rate),
    sum_vaso_amount = sum(vaso_amount))

Заранее спасибо !!

Answer 1

Я бы создал новый столбец pause, в котором указано, сколько времени прошло с момента последнего приема лекарства. Затем, используя этот столбец, мы назначаем идентификаторы групп для лекарств: cumsum(pause >= 1) - начинаем с 0, затем, если пауза> = 1 часа, это другая группа.

set.seed(1)
df <- data.frame(   
  icustay_id = c(1, 1, 1, 2, 3),   
  starttime = as.POSIXct(c("2019-09-10 13:20", "2019-09-11 13:30",  "2019-09-14 16:40", "2019-09-10 12:40", "2019-09-10 01:20")),   
  endtime = as.POSIXct(c("2019-09-11 13:20", "2019-09-11 01:20", "2019-09-15 16:40", "2019-09-13 13:20", "2019-09-11 13:20")),   
  vaso_rate = sample(1:10, 5, replace = TRUE),   
  vaso_amount = runif(5, 0, 1000) 
)

library(dplyr)
library(tidyr)

df <-
  df %>% 
  group_by(icustay_id) %>% 
  mutate(pause = difftime(starttime, lag(endtime), units = "hours")) %>% 
  replace_na(list(pause = 0)) %>% 
  mutate(vaso_id = cumsum(pause >= 1))

# A tibble: 5 x 7
# Groups:   icustay_id [3]
# icustay_id starttime           endtime             vaso_rate vaso_amount pause            vaso_id
# <dbl> <dttm>              <dttm>                  <int>       <dbl> <drtn>             <int>
# 1          1 2019-09-10 13:20:00 2019-09-11 13:20:00         9       898.   0.0000000 hours       0
# 2          1 2019-09-11 13:30:00 2019-09-11 01:20:00         4       945.   0.1666667 hours       0
# 3          1 2019-09-14 16:40:00 2019-09-15 16:40:00         7       661.  87.3333333 hours       1
# 4          2 2019-09-10 12:40:00 2019-09-13 13:20:00         1       629.   0.0000000 hours       0
# 5          3 2019-09-10 01:20:00 2019-09-11 13:20:00         2        61.8  0.0000000 hours       0

Тогда мы можем использовать предоставленный вами код.

df %>% 
  group_by(icustay_id, vaso_id) %>% 
  summarise(
    starttime = min(starttime), 
    endtime = max(endtime),
    vaso_rate = mean(vaso_rate),
    sum_vaso_amount = sum(vaso_amount)
  )

# A tibble: 4 x 6
# Groups:   icustay_id [3]
# icustay_id vaso_id starttime           endtime             vaso_rate sum_vaso_amount
# <dbl>   <int> <dttm>              <dttm>                  <dbl>           <dbl>
# 1          1       0 2019-09-10 13:20:00 2019-09-11 13:20:00       6.5          1843. 
# 2          1       1 2019-09-14 16:40:00 2019-09-15 16:40:00       7             661. 
# 3          2       0 2019-09-10 12:40:00 2019-09-13 13:20:00       1             629. 
# 4          3       0 2019-09-10 01:20:00 2019-09-11 13:20:00       2              61.8