Created
May 4, 2020 08:43
-
-
Save mikkelkrogsholm/8d80727eb0e3ffa687a1c2263d58522f to your computer and use it in GitHub Desktop.
This is the code used to create my prediction of COVID 19 hospitalisation needs in Denmark
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library(tidyverse) | |
options(scipen = 999) | |
# http://epirecip.es/epicookbook/chapters/sir/r_desolve | |
# Load deSolve library | |
library(deSolve) | |
################################################################################ | |
url <- "https://api.covid19data.dk/ssi_hospitalized" | |
hosp_raw <- jsonlite::fromJSON(url) | |
hosp <- hosp_raw %>% | |
mutate(timestamp = timestamp %>% lubridate::ymd_hm(), | |
date = timestamp %>% as.Date()) | |
summed_data <- hosp %>% | |
group_by(date) %>% | |
summarise_at(c("hospitalized", "critical", "respirator"), sum, na.rm = TRUE) | |
## Time-Dependent R_0 ########################################################## | |
# Define the model function | |
sir_ode <- function(times, init, parms){ | |
with(as.list(c(parms, init)), { | |
# ODEs | |
dSdt = -beta(times) * S * I / N | |
dIdt = beta(times) * S * I / N - gamma * I | |
dRdt = gamma * I | |
list(c(dSdt, dIdt, dRdt)) | |
}) | |
} | |
L = 31 | |
N = 5.8 * 10 ^ 6 | |
D = 7 # infections lasts x days | |
gamma = 1.0 / D | |
R_0 <- function(t){ifelse(t < L, .8, .9)} | |
beta <- function(t){R_0(t) * gamma} | |
# initial conditions: one exposed | |
S0 = N - 535; I0 = 535 ; R0 = 0 | |
# Setup the model inputs | |
parms <- c(N = N, beta = beta, gamma = gamma) | |
init <- c(S = S0, I = I0, R = R0) | |
times <- 1:100 | |
# Run the model | |
sir_out <- ode(init, times, sir_ode, parms) | |
# Plot model | |
sir_out_df <- sir_out %>% as.data.frame() %>% as_tibble() | |
sir_out_df$time <- (sir_out_df$time - 1) + as.Date("2020-04-01") | |
pd <- sir_out_df %>% filter(time > "2020-04-15", time < "2020-05-15") | |
hosp_pd <- summed_data %>% filter(date >= "2020-04-01", date <= "2020-04-15") | |
hosp_pd_pred <- summed_data %>% filter(date > "2020-04-15") | |
pp <- ggplot() + | |
geom_line(data = pd, aes(x = time, y = I), linetype = "dashed", color = "blue") + | |
geom_line(data = pd, aes(x = time, y = I * .25), linetype = "dashed", color = "red") + | |
geom_point(data = hosp_pd, aes(date, hospitalized), color = "blue") + | |
geom_point(data = hosp_pd, aes(date, critical), color = "red") + | |
geom_point(data = hosp_pd_pred, aes(date, hospitalized), color = "blue", shape = 1) + | |
geom_point(data = hosp_pd_pred, aes(date, critical), color = "red", shape = 1) + | |
theme_minimal() + | |
labs(y = "", x = "") + | |
scale_x_date(date_breaks = "1 week", date_labels = "%d/%m") + | |
annotate(geom = "text", x = as.Date("2020-04-15") + .5, y = 362, label = "362 indlagte i alt", color = "blue", hjust = 0) + | |
annotate(geom = "text", x = as.Date("2020-04-15"), y = 89, label = "89 indlagte på intensiv", color = "red", vjust = -1, hjust = .05) + | |
annotate(geom = "text", x = as.Date("2020-05-01 "), y = 227, label = "227", color = "blue", vjust = 2) + | |
annotate(geom = "text", x = as.Date("2020-05-01 "), y = 57 , label = "57", color = "red", vjust = -1) + | |
annotate(geom = "text", x = as.Date("2020-05-14"), y = 185, label = "185", color = "blue", vjust = 2) + | |
annotate(geom = "text", x = as.Date("2020-05-14"), y = 46, label = "46", color = "red", vjust = -1) + | |
theme(panel.grid = element_blank()) | |
pp |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment