Расчет средней занятости только с помощью tidyverse - PullRequest
0 голосов
/ 21 декабря 2018

Я рассчитываю среднее число прибывших и среднюю занятость по часам дня только с помощью tidyverse.

Тем не менее, приведенный выше пример на самом деле не рассчитывает среднюю занятость, а скорее количество людей в определенное время.

Тем не менее, если у меня есть человек, скажем, в больнице, в отделении неотложной помощи, который прибывает 10 декабря 2018 года в 10 часов утра и уезжает на второй день в 7:45.Это означает, что значение Occupancy составляет 1,00 пациента, которого лечат с 10 утра до 7 утра следующего дня (не включая 8 и 9 часов утра).При усреднении Заполняемости за две даты это означает, что Заполняемость составляет 0,5 за все часы с 10 часов утра, когда пациент прибыл, до 7 часов утра, когда пациент был выписан, на следующий день, исключая 8 часов утра и 9 часов утра (среднее значение равно 0).,То же самое относится и к прибытию, с той разницей, что оно рассчитывается только для времени прибытия пациента, а не для всех часов пребывания.В этом разница между занятостью и прибытием, которая, как представляется, во всех ответах, приведенных в моих предыдущих запросах о помощи, позволила решить средние числа поступлений, а не занятость, хотя я и запросил усредненную занятость.

Вот один пример, который я пытался раскрыть в прошлом.

Расчет занятости в больнице по датам со временем.

Который я воспроизвожу ниже,

df <- structure(list(ID = c(101, 102, 103, 104, 105, 106, 107), Adm = 
       structure(c(1326309720, 1326309900, 1328990700, 1328997240, 
                   1329000840, 1329004440, 1329004680), 
       class = c("POSIXct", "POSIXt"), tzone = ""), Disc = 
       structure(c(1326313800, 1326317340, 1326317460, 1326324660, 
                   1326328260, 1 326335460, 1326335460), 
       class = c("POSIXct", "POSIXt"), tzone = "")), 
       .Names = c("ID", "Adm", "Disc"),  
       row.names = c(NA, -7L), class = "data.frame")

library(tidyverse)

df %>%
  group_by(ID) %>%
  mutate(occupancy = ifelse(last(Disc) > first(Adm) + 60*60, 1, 0))

Вот минималистский пример, который является воспроизводимым типом данных, который у меня есть, для простоты.Тем не менее, не может раскрывать какие-либо данные из исходных данных в целях защиты данных.

df <- structure(list(ID = 101:103, 
                    `Admissions <- as.POSIXct(c("2018-12-10 09:30:00", 
                                     "2018-12-10 10:15:00", 
                                     "2018-12-11 08:05:00"), 
                                  tz =  "Europe/London")` = 
                    structure(c(1544434200, 1544436900, 1544519100), 
                    class = c("POSIXct", "POSIXt"), 
                    tzone = "Europe/London"), 
                    `Discharges <- as.POSIXct(c("2018-12-10 12:30:00", 
                                      "2018-12-11 07:45:00", 
                                      "2018-12-11 09:05-00"),             
                                   tz = "Europe/London")` = 
                   structure(c(1544445000, 1544514300, 1544519100), 
                   class = c("POSIXct", "POSIXt"), 
                   tzone = "Europe/London")), row.names = c(NA, -3L), 
                   class = c("tbl_df", "tbl", "data.frame"))

И ожидаемый результат:

output <- structure(list(
       Hour = 0:23, 
       Average_arrivals = c(0, 0, 0, 0, 0, 0, 0, 0, 0.5, 0.5, 0.5, 0, 0, 0, 
                            0, 0, 0, 0, 0, 0, 0, 0, 0, 0), 
       Average_occ = c(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0, 0.5, 1, 
                       1, 1, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 
                       0.5, 0.5)), 
       row.names = c(NA, -24L), class = c("tbl_df", "tbl", "data.frame"), 
       spec = structure(list(cols = list(X1 = 
       structure(list(), class = c("collector_integer", "collector")), 
       Hour = structure(list(), class =c("collector_integer","collector")),
       Average_arrivals = structure(list(), 
                          class = c("collector_double", "collector")), 
       Average_occ = structure(list(), class = c("collector_double", 
                                                 "collector"))), 
                     default = structure(list(), 
                     class = c("collector_guess","collector"))), 
                     class = "col_spec"))

1 Ответ

0 голосов
/ 21 декабря 2018

Вот подход с использованием Tidyverse.Сначала я конвертирую в длинный формат, используя gather, а затем создаю столбец «изменить», который равен +1 для приема и -1 для выписки.

Затем я суммирую это по часам (может быть более детальным, например, "5 минут", если необходимо) и добавляю все не упомянутые часы, используя padr:pad (я также добавляю дополнительные часы на спине, чтобы сделать этополный набор 48 часов).

Заполнение - это совокупная сумма изменений.Группируя по часам за 2 дня, мы можем получить Average_arrivals и Average_occ.

Данные

# Note, I could not load the sample data as provided, as the variable
#   names included the desired data as text.
df <- data.frame(ID = 101:103,
                 Admissions = as.POSIXct(c("2018-12-10 09:30:00", 
                    "2018-12-10 10:15:00", "2018-12-11 08:05:00")),
                 Discharges = as.POSIXct(c("2018-12-10 12:30:00", 
                    "2018-12-11 07:45:00", "2018-12-11 09:05:00")))

Решение

df_flat <- df %>%
  gather(status, time, Admissions:Discharges) %>%
  mutate(change = if_else(status == "Admissions", 1, -1)) %>%
  group_by(time_hr = lubridate::floor_date(time, "1 hour")) %>%
  summarize(arrivals = sum(status == "Admissions"),
            change = sum(change)) %>%
  # Here, adding add'l rows so all hours have 2 instances
  padr::pad(end_val = min(.$time_hr) + dhours(47)) %>% 
  replace_na(list(arrivals = 0, change = 0)) %>%
  mutate(occupancy = cumsum(change))

output <- df_flat %>%
  group_by(hour(time_hr)) %>%
  summarize(Average_arrivals = mean(arrivals),
            Average_occ = mean(occupancy))

Выход

output
# A tibble: 24 x 3
# hour Average_arrivals Average_occ
# <int>            <dbl>       <dbl>
# 1     0              0           0.5
# 2     1              0           0.5
# 3     2              0           0.5
# 4     3              0           0.5
# 5     4              0           0.5
# 6     5              0           0.5
# 7     6              0           0.5
# 8     7              0           0  
# 9     8              0.5         0.5
# 10    9              0.5         0.5
...