Предположим, есть больничная клиника, в которой есть список пациентов, посещающих больницу каждый день. У меня есть данные за 10 лет – но пациенты не посещают клинику каждый день. Для примера: данные выглядят так (в R):
library(dplyr)
set.seed(123)
start_date <- as.Date("2010-01-01")
end_date <- as.Date("2019-12-31")
all_dates <- seq.Date(start_date, end_date, by = "day")
num_visits <- sample(1:length(all_dates), size = 3000, replace = FALSE)
visit_dates <- all_dates[num_visits]
num_patients <- sample(1:100, size = length(visit_dates), replace = TRUE)
clinic_data <- data.frame(date = visit_dates, num_patients = num_patients)
hospital_data <- clinic_data %>% arrange(date)
date num_patients
2010-01-01 90
2010-01-02 96
2010-01-04 65
2010-01-05 80
2010-01-06 15
2010-01-07 87
Я хочу попытаться ответить на следующий вопрос: В среднем за любой месяц какой процент всех пациентов в этом месяце посетят клинику к дню $y$? Например, предположим, что в каком-то месяце я знаю, что 900 человек посетили больницу - я хочу знать, что к 19-му числу, какой процент (в совокупности) из этих 900, вероятно, посетил больницу К ТОМ, исходя из предыдущих тенденций?
Я попытался сделать это, вручную определив различные логические шаги:
library(ggplot2)
hospital_data$year <- as.numeric(format(as.Date(hospital_data$date), "%Y"))
hospital_data$month <- as.numeric(format(as.Date(hospital_data$date), "%m"))
hospital_data$day <- as.numeric(format(as.Date(hospital_data$date), "%d"))
hospital_data <- hospital_data[order(hospital_data$date), ]
yearly_totals <- aggregate(num_patients ~ year, data = hospital_data, FUN = sum)
names(yearly_totals)[2] <- "yearly_total"
hospital_data <- merge(hospital_data, yearly_totals, by = "year")
results <- by(hospital_data, hospital_data$year, function(df) {
df$cumulative_patients <- cumsum(df$num_patients)
df$cumulative_percentage <- df$cumulative_patients / df$yearly_total * 100
return(df)
})
results <- do.call(rbind, results)
avg_results <- aggregate(cumulative_percentage ~ day, data = results, FUN = mean, na.rm = TRUE)
avg_results <- avg_results[order(avg_results$day), ]
ggplot(avg_results, aes(x = day, y = cumulative_percentage)) +
geom_line() +
geom_point() +
scale_x_continuous(breaks = seq(1, 31, by = 5)) +
scale_y_continuous(limits = c(0, 100)) +
labs(title = "Average Cumulative Percentage of Yearly Patients by Day",
x = "Day of Month",
y = "Average Cumulative Percentage of Patients") +
theme_minimal() +
theme(panel.grid.minor = element_blank())
Но мой график не отображает этот совокупный процент:
Есть ли у кого-нибудь идеи, где я это испортил?
Обновлено:
library(tidyverse)
result <- hospital_data %>%
mutate(month = floor_date(date, "month"),
day = day(date)) %>%
group_by(month) %>%
arrange(month, day) %>%
mutate(month_total = sum(num_patients),
cuml = cumsum(num_patients),
cuml_pct = cuml / month_total) %>%
ungroup() %>%
group_by(day) %>%
summarize(avg_cuml_pct = mean(cuml_pct, na.rm = TRUE)) %>%
arrange(day)
result <- result %>%
mutate(avg_cuml_pct = cummax(avg_cuml_pct))
ggplot(result, aes(day, avg_cuml_pct)) +
geom_line() +
scale_y_continuous(labels = scales::percent_format(), limits = c(0, 1)) +
scale_x_continuous(breaks = seq(0, 31, by = 5)) +
labs(x = "Day of Month",
y = "Average Cumulative Percentage of Monthly Patients",
title = "Average Cumulative Patient Percentage by Day of Month") +
theme_minimal()
Возможно, что-то вроде этого? Каждая из светло-серых линий представляет собой совокупный процент пациентов за каждый месяц по дням. Темная линия представляет собой невзвешенное среднее этих средних значений. Возможно, вам понадобится средневзвешенное значение, но здесь нет большой разницы, учитывая, что многие месяцы имеют аналогичный масштаб.
library(tidyverse)
hospital_data |>
mutate(month = floor_date(date, "month"),
day = day(date)) |>
mutate(cuml = cumsum(num_patients),
cuml_pct = cuml / sum(num_patients), .by = month) |>
ggplot(aes(day, cuml_pct)) +
geom_line(aes(group = month), alpha = 0.1) +
geom_line(data = ~summarize(., cuml_pct = mean(cuml_pct), .by = day))
Или мы могли бы сделать то же самое на взвешенной основе, но учтите, что, поскольку в некоторых месяцах 31 день, это означает, что нам нужно до 31-го числа любого месяца (даже тех, в которых 28/29/30 дней), чтобы достичь 100%.
hospital_data |>
mutate(day = day(date)) |>
count(day, wt = num_patients) |> # = summarize(n = sum(num_patients), .by = day)
arrange(day) |>
mutate(cuml_pct = cumsum(n)/sum(n)) |>
ggplot(aes(day, cuml_pct)) +
geom_line()
спасибо, Джон Спринг! Это действительно круто! Дело в том, что окончательный график должен иметь только одну линию, которая представляет собой (совокупное общее количество населения в день x) / (население сегодня за все дни). Возможно ли это?
Конечно, просто закомментируйте предпоследнюю строку, чтобы получить невзвешенную версию. Я могу отредактировать, чтобы добавить взвешенную версию. Обратите внимание, что, например, при различной продолжительности месяцев тест предполагает, что для достижения 100% требуется 31-е число, даже если во многих месяцах не так много дней.
Я думаю, ваша цель не ясна. Вы говорите, что хотите получить совокупные проценты по месяцам, но затем рассчитываете итоговые суммы за год. Возможно, вы могли бы указать ожидаемый результат за первый месяц. И, пожалуйста, прочтите минимальный воспроизводимый пример, обратив внимание на слово минимальный.