Skip to content

Commit 8a31743

Browse files
amyheatheramyheather
committed
feat(occupancy): add calculation of occupancy statistics
1 parent f04e310 commit 8a31743

4 files changed

Lines changed: 139 additions & 12 deletions

File tree

‎R/get_occupancy_stats.R‎

Lines changed: 65 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,65 @@
1+
#' Calculate occupancy statistics
2+
#'
3+
#' For each resource in the data, this function computes how often each
4+
#' occupancy level was observed. It then calculates:
5+
#' \itemize{
6+
#' \item The frequency of each occupancy level
7+
#' \item The proportion (percentage) of time at each occupancy
8+
#' \item The cumulative proportion (cumulative percentage) up to each
9+
#' occupancy
10+
#' \item The probability of delay (probability that occupancy is at or above
11+
#' a given level)
12+
#' \item The "1 in every n" patients delayed (inverse of probability of delay)
13+
#' }
14+
#'
15+
#' @param occupancy DataFrame with three columns: \code{resource}, \code{time},
16+
#' and \code{occupancy}.
17+
#'
18+
#' @return A list of data frames, one per resource, each containing occupancy
19+
#' statistics.
20+
21+
get_occupancy_stats <- function(occupancy) {
22+
23+
results <- list()
24+
25+
# Split by resource
26+
for (resource_name in unique(occupancy[["resource"]])) {
27+
occ <- filter(occupancy, .data[["resource"]] == resource_name)
28+
29+
# Get frequency of each occupancy value
30+
freq_table <- table(occ[["occupancy"]])
31+
32+
# Get the full range of occupancy values (fill in gaps)
33+
min_occ <- min(occ[["occupancy"]])
34+
max_occ <- max(occ[["occupancy"]])
35+
all_occupancy <- min_occ:max_occ
36+
37+
# Create a complete frequency vector (fill missing with 0)
38+
complete_freq <- vapply(
39+
all_occupancy,
40+
function(x) {
41+
if (x %in% names(freq_table)) freq_table[as.character(x)] else 0L
42+
},
43+
FUN.VALUE = integer(1L)
44+
)
45+
46+
# Build the summary dataframe
47+
occ_stats <- data.frame(
48+
beds = all_occupancy,
49+
freq = as.integer(complete_freq)
50+
)
51+
52+
# Calculate proportion and cumulative proportion (percentage if *100)
53+
occ_stats[["pct"]] <- occ_stats[["freq"]] / sum(occ_stats[["freq"]])
54+
occ_stats[["c_pct"]] <- cumsum(occ_stats[["pct"]])
55+
56+
# Calculate probability of delay
57+
occ_stats[["prob_delay"]] <- occ_stats[["pct"]] / occ_stats[["c_pct"]]
58+
59+
# Calculate 1 in every n patients delayed
60+
occ_stats[["1_in_n_delay"]] <- round(1L / occ_stats[["prob_delay"]])
61+
62+
results[[resource_name]] <- occ_stats
63+
}
64+
results
65+
}

‎man/get_occupancy_stats.Rd‎

Lines changed: 29 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎rmarkdown/analysis.Rmd‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -26,3 +26,7 @@ param <- create_parameters(log_to_console = TRUE)
2626
result <- model(run_number = 1L, param = param, set_seed = TRUE)
2727
result
2828
```
29+
30+
```{r}
31+
get_occupancy_stats(result[["occupancy"]])
32+
```

‎rmarkdown/analysis.md‎

Lines changed: 41 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -228,18 +228,18 @@ result
228228
## 29 asu_stroke18 19.8417499 NA NA asu_bed 1
229229
## 30 asu_stroke16 18.3422720 NA NA asu_bed 1
230230
## 31 asu_stroke15 18.1849052 NA NA asu_bed 1
231-
## 32 asu_stroke11 13.8532754 NA NA asu_bed 1
232-
## 33 asu_neuro4 13.5331919 NA NA asu_bed 1
233-
## 34 asu_neuro4 16.7128499 NA NA rehab_bed 1
234-
## 35 asu_stroke8 10.0363922 NA NA asu_bed 1
235-
## 36 asu_stroke14 17.1432238 NA NA asu_bed 1
236-
## 37 asu_neuro2 6.7174941 NA NA asu_bed 1
237-
## 38 asu_neuro2 8.3881898 NA NA rehab_bed 1
238-
## 39 asu_other7 19.7390660 NA NA asu_bed 1
239-
## 40 rehab_stroke0 9.5062960 NA NA rehab_bed 1
240-
## 41 asu_stroke17 18.8504573 NA NA asu_bed 1
241-
## 42 asu_neuro6 16.6529204 NA NA asu_bed 1
242-
## 43 rehab_stroke1 14.0813875 NA NA rehab_bed 1
231+
## 32 asu_stroke17 18.8504573 NA NA asu_bed 1
232+
## 33 asu_stroke14 17.1432238 NA NA asu_bed 1
233+
## 34 asu_other7 19.7390660 NA NA asu_bed 1
234+
## 35 asu_neuro4 13.5331919 NA NA asu_bed 1
235+
## 36 asu_neuro4 16.7128499 NA NA rehab_bed 1
236+
## 37 asu_stroke8 10.0363922 NA NA asu_bed 1
237+
## 38 rehab_stroke1 14.0813875 NA NA rehab_bed 1
238+
## 39 asu_neuro2 6.7174941 NA NA asu_bed 1
239+
## 40 asu_neuro2 8.3881898 NA NA rehab_bed 1
240+
## 41 asu_stroke11 13.8532754 NA NA asu_bed 1
241+
## 42 rehab_stroke0 9.5062960 NA NA rehab_bed 1
242+
## 43 asu_neuro6 16.6529204 NA NA asu_bed 1
243243
##
244244
## $occupancy
245245
## # A tibble: 42 × 3
@@ -256,3 +256,32 @@ result
256256
## 9 asu_bed 4 6
257257
## 10 rehab_bed 4 0
258258
## # ℹ 32 more rows
259+
260+
``` r
261+
get_occupancy_stats(result[["occupancy"]])
262+
```
263+
264+
## $asu_bed
265+
## beds freq pct c_pct prob_delay 1_in_n_delay
266+
## 1 0 1 0.04761905 0.04761905 1.00000000 1
267+
## 2 1 0 0.00000000 0.04761905 0.00000000 Inf
268+
## 3 2 0 0.00000000 0.04761905 0.00000000 Inf
269+
## 4 3 1 0.04761905 0.09523810 0.50000000 2
270+
## 5 4 1 0.04761905 0.14285714 0.33333333 3
271+
## 6 5 3 0.14285714 0.28571429 0.50000000 2
272+
## 7 6 6 0.28571429 0.57142857 0.50000000 2
273+
## 8 7 5 0.23809524 0.80952381 0.29411765 3
274+
## 9 8 0 0.00000000 0.80952381 0.00000000 Inf
275+
## 10 9 2 0.09523810 0.90476190 0.10526316 10
276+
## 11 10 1 0.04761905 0.95238095 0.05000000 20
277+
## 12 11 0 0.00000000 0.95238095 0.00000000 Inf
278+
## 13 12 1 0.04761905 1.00000000 0.04761905 21
279+
##
280+
## $rehab_bed
281+
## beds freq pct c_pct prob_delay 1_in_n_delay
282+
## 1 0 9 0.42857143 0.4285714 1.00000000 1
283+
## 2 1 1 0.04761905 0.4761905 0.10000000 10
284+
## 3 2 4 0.19047619 0.6666667 0.28571429 4
285+
## 4 3 1 0.04761905 0.7142857 0.06666667 15
286+
## 5 4 4 0.19047619 0.9047619 0.21052632 5
287+
## 6 5 2 0.09523810 1.0000000 0.09523810 10

0 commit comments

Comments
 (0)