仅使用tidyverse计算平均占用率

时间:2018-12-20 21:23:22

标签: r tidyverse lubridate

我仅使用tidyverse计算一天中各个小时的平均到达人数和平均占用率。

但是,上面的示例实际上并没有计算平均入住率,而是计算特定时间的人数。

但是,如果我要来一个人,可以说在医院急诊室,于2018年12月10日上午10时到达,并于第二天7:45离开。这意味着从上午10点一直到第二天早上7点(不包括上午8点和上午9点)治疗的1.00位患者的病历。并将两个日期的平均占用率相乘,这意味着从患者到达日期的上午10点到患者出院的第二天的上午7点(不包括上午8点和上午9点)(均值为0),所有时段的占用率为0.5 。对于“到来”来说是相同的,不同之处在于它仅针对患者到达的时间而不是针对他们整个停留的时间计算。这是“入住人数”与“到达人数”之间的差异,尽管我已请求“平均入住率”,但似乎我以前的帮助请求中给出的所有答案都解决了“到达人数”平均值而不是“入住率”。

这是我过去尝试解决的一个例子。

join

我会复制下面的内容。

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 :(得分:0)

这里是使用tidyverse的一种方法。首先,我使用gather转换为长格式,然后创建一个“更改”列,该列对于入场为+1,对于出院为-1。

然后我按小时进行汇总(如果需要,可以更细化,例如“ 5分钟”),并使用padr:pad加上所有未提及的小时数(我还会在背面加上额外的小时数,使其成为全套48小时)。

占用率是更改的总和。通过在两天内按小时分组,我们可以得出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