R, Как накапливать значения в столбце списка на основе нескольких критериев
У меня есть набор данных о пациентах, получающих лечение в различных больницах (только стационарных), в которых некоторый анализ выявил несколько несоответствий. Одним из них было то, что программное обеспечение позволяло пациентам поступать в больницу без закрытия их ранее открытых case_id.
Чтобы лучше понять это, давайте рассмотрим пример набора данных
Пример данных
dput(df)
df <- structure(list(case_id = 1:22, patient_id = c(1L, 1L, 1L, 1L,
1L, 1L, 1L, 2L, 2L, 2L, 1L, 3L, 3L, 3L, 4L, 4L, 5L, 5L, 6L, 7L,
8L, 8L), pack_id = c(12L, 62L, 59L, 68L, 77L, 86L, 20L, 55L,
86L, 72L, 7L, 54L, 75L, 26L, 21L, 12L, 49L, 35L, 51L, 31L, 10L,
54L), hosp_id = c(1L, 1L, 2L, 2L, 1L, 1L, 2L, 3L, 3L, 4L, 2L,
3L, 3L, 3L, 4L, 5L, 6L, 6L, 7L, 7L, 8L, 8L), admn_date = structure(c(18262,
18264, 18265, 18266, 18277, 18279, 18283, 18262, 18264, 18277,
18287, 18275, 18301, 18291, 18366, 18374, 18309, 18319, 18364,
18303, 18328, 18341), class = "Date"), discharge_date = structure(c(18275,
18276, 18271, 18275, 18288, 18280, 18286, 18275, 18276, 18288,
18291, 18283, 18309, 18297, 18375, 18381, 18347, 18328, 18367,
18309, 18341, 18344), class = "Date")), row.names = c(NA, -22L
), class = "data.frame")
> df
case_id patient_id pack_id hosp_id admn_date discharge_date
1 1 1 12 1 2020-01-01 2020-01-14
2 2 1 62 1 2020-01-03 2020-01-15
3 3 1 59 2 2020-01-04 2020-01-10
4 4 1 68 2 2020-01-05 2020-01-14
5 5 1 77 1 2020-01-16 2020-01-27
6 6 1 86 1 2020-01-18 2020-01-19
7 7 1 20 2 2020-01-22 2020-01-25
8 8 2 55 3 2020-01-01 2020-01-14
9 9 2 86 3 2020-01-03 2020-01-15
10 10 2 72 4 2020-01-16 2020-01-27
11 11 1 7 2 2020-01-26 2020-01-30
12 12 3 54 3 2020-01-14 2020-01-22
13 13 3 75 3 2020-02-09 2020-02-17
14 14 3 26 3 2020-01-30 2020-02-05
15 15 4 21 4 2020-04-14 2020-04-23
16 16 4 12 5 2020-04-22 2020-04-29
17 17 5 49 6 2020-02-17 2020-03-26
18 18 5 35 6 2020-02-27 2020-03-07
19 19 6 51 7 2020-04-12 2020-04-15
20 20 7 31 7 2020-02-11 2020-02-17
21 21 8 10 8 2020-03-07 2020-03-20
22 22 8 54 8 2020-03-20 2020-03-23
Если мы видим в приведенных выше данных, пациент с идентификатором 1 поступил в больницу_1 (строка-1) 1 января и выписался 14 января. Перед этой выпиской пациент снова поступил в ту же больницу (ряд-2); и в больнице_2 снова два раза (строки 3 и 4), прежде чем, наконец, все эти четыре записи были закрыты 15 января (строка 2).
Я уже отфильтровал такие записи, в которых пациенты были госпитализированы в несколько больниц/в одну и ту же больницу несколько раз; по следующему коду
Код попробовал
df_2 <- df %>% arrange(patient_id, admn_date, discharge_date) %>%
mutate(sort_key = row_number()) %>%
pivot_longer(c(admn_date, discharge_date), names_to = "activity",
values_to = "date", names_pattern = "(.*)_date") %>%
mutate(activity = factor(activity, ordered = T,
levels = c("admn", "discharge")),
admitted = ifelse(activity == "admn", 1, -1)) %>%
group_by(patient_id) %>%
arrange(date, sort_key, activity, .by_group = TRUE) %>%
mutate (admitted = cumsum(admitted)) %>%
ungroup()
> df_2
# A tibble: 44 x 8
case_id patient_id pack_id hosp_id sort_key activity date admitted
<int> <int> <int> <int> <int> <ord> <date> <dbl>
1 1 1 12 1 1 admn 2020-01-01 1
2 2 1 62 1 2 admn 2020-01-03 2
3 3 1 59 2 3 admn 2020-01-04 3
4 4 1 68 2 4 admn 2020-01-05 4
5 3 1 59 2 3 discharge 2020-01-10 3
6 1 1 12 1 1 discharge 2020-01-14 2
7 4 1 68 2 4 discharge 2020-01-14 1
8 2 1 62 1 2 discharge 2020-01-15 0
9 5 1 77 1 5 admn 2020-01-16 1
10 6 1 86 1 6 admn 2020-01-18 2
# ... with 34 more rows
Тем не менее, я хочу включить/сгенерировать один list column, где бы ни открывалась новая запись/case_id без закрытия какой-либо предыдущей, где hsopital_ids накапливаются всякий раз, когда activity == 'admn', а Hospital_id удаляется из существующих записей всякий раз, когда activity == 'discharge'. Итак, в основном мой желаемый результат для df_2 будет примерно таким:
Желаемый ВЫВОД
# A tibble: 44 x 8
case_id patient_id pack_id hosp_id sort_key activity date admitted open_records
<int> <int> <int> <int> <int> <ord> <date> <dbl> <list>
1 1 1 12 1 1 admn 2020-01-01 1 1
2 2 1 62 1 2 admn 2020-01-03 2 1, 1
3 3 1 59 2 3 admn 2020-01-04 3 1, 1, 2
4 4 1 68 2 4 admn 2020-01-05 4 1, 1, 2, 2
5 3 1 59 2 3 discharge 2020-01-10 3 1, 1, 2
6 1 1 12 1 1 discharge 2020-01-14 2 1, 2
7 4 1 68 2 4 discharge 2020-01-14 1 1,
8 2 1 62 1 2 discharge 2020-01-15 0 <NULL>
9 5 1 77 1 5 admn 2020-01-16 1 1
10 6 1 86 1 6 admn 2020-01-18 2 1, 1
# ... with 34 more rows
ПРИМЕЧАНИЕ. Я знаю, что столбец списка не будет отображаться в tibble/data.frame, как тот, который я показал только для пояснения. Однако, если есть какой-либо метод, с помощью которого это можно напечатать, я хотел бы знать об этом наверняка.
Более того, если есть какая-либо лучшая стратегия для хранения идентификаторов больниц в столбце вместо создания столбца списка, я также хотел бы знать об этом наверняка.
Ответы 2
Если вы не возражаете против использования цикла
library(stringi)
df3 <- df2
df3$open_records <- NA
df3$hosp_id <- as.character(df3$hosp_id) #makes pasting easier
for(i in 1:nrow(df3)){
#if re-admn
if (df3$activity[i] == "admn"){
df3$open_records[i] <- paste(lag(df3$open_records, default = "")[i],
df3$hosp_id[i],
sep = ",")
#we'll handle pretty commas later
}
#if discharge
if (df3$activity[i] == "discharge"){
df3$open_records[i] <- sub(df3$hosp_id[i], "",
stri_reverse(df3$open_records[i-1]))
#sub out one hospital if discharge
#we reverse the string before removing to get the last hosp_id
}
#if admitted == 0
if (df3$admitted[i] == 0) df3$open_records[i] <- NA
#if just starting the group
if (df3$activity[i] == "admn" & df3$admitted[i] == 1){
df3$open_records[i] <- df3$hosp_id[i]
}
}
#comma clean
df3$open_records <- gsub("^,*|(?<=,),|,*$", "", df3$open_records, perl=T)
df3$open_records <- gsub(",", ", ", df3$open_records)
Если ваш набор данных действительно велик, это может быть неоптимальным. Возможно, стоит также добавить команды next() к каждому оператору if (если вы сделаете это, я думаю, имеет смысл переместить оператор if начальной группы в начало цикла).
(чистый источник запятых: Удаление нескольких запятых и завершающих запятых с помощью gsub)
РЕДАКТИРОВАТЬ, исходя из необходимости не использовать цикл
library(tidyverse)
paste3 <- function(out, input, activity, sep = ",") {
if (activity == "admn") {
paste(out, input, sep = sep)
} else
if (activity == "discharge") {
sub(input, "", out)
}
}
df4 <- df2 %>%
mutate(temp_act = lead(activity)) %>%
mutate(open_records = accumulate2(hosp_id, head(temp_act, -1), paste3)
) %>%
select(-temp_act)
df4$open_records <- gsub("^,*|(?<=,),|,*$", "", df4$open_records, perl=T)
df4$open_records <- gsub(",", ", ", df4$open_records)
Я заметил, что пациенты могут быть госпитализированы в одну и ту же больницу более одного раза одновременно. Одна вещь, которую вы, возможно, захотите рассмотреть, — это объединение case_id и hosp_id, чтобы вместо удаления первого совпадения hosp_id при разряде вы могли удалить тот, который соответствует правильному case_id. (Замените hosp_id в коде вашей новой переменной.)
Этого нет в вашем образце кода, но если у кого-то есть open_records 2, 1, 2, 1, 2 и его выписывают из третьего допуска, мой код вернет 1, 2, 1, 2, когда вы, возможно, захотите 2, 1, 1, 2.
Я изучил accumulate. Получается в 2-5 раз быстрее.
Вот достойное tidyverse решение для этого:
library(dplyr)
library(purrr)
df_2 %>%
group_by(patient_id) %>%
mutate(open_records = accumulate(2:n(), .init = paste0(hosp_id[1], ","),
~ if (activity[.y] == "admn") {
paste0(.x, hosp_id[.y], ",")
} else {
sub(paste0(hosp_id[.y], ","), "", .x)
}),
open_records = gsub("([d,]*)\\,$", "", open_records))
# A tibble: 44 x 9
# Groups: patient_id [8]
case_id patient_id pack_id hosp_id sort_key activity date admitted open_records
<int> <int> <int> <int> <int> <ord> <date> <dbl> <chr>
1 1 1 12 1 1 admn 2020-01-01 1 "1"
2 2 1 62 1 2 admn 2020-01-03 2 "1,1"
3 3 1 59 2 3 admn 2020-01-04 3 "1,1,2"
4 4 1 68 2 4 admn 2020-01-05 4 "1,1,2,2"
5 3 1 59 2 3 discharge 2020-01-10 3 "1,1,2"
6 1 1 12 1 1 discharge 2020-01-14 2 "1,2"
7 4 1 68 2 4 discharge 2020-01-14 1 "1"
8 2 1 62 1 2 discharge 2020-01-15 0 ""
9 5 1 77 1 5 admn 2020-01-16 1 "1"
10 6 1 86 1 6 admn 2020-01-18 2 "1,1"
# ... with 34 more rows
У меня действительно огромный набор данных, скажем, около миллиарда записей. Хотя за ваш ответ проголосовали, я действительно ищу способ сделать это без промежуточного использования циклов. Спасибо за ваши добрые усилия. :)