########################################################### ### Analyse voor ___UITZONDERINGSGROND_2___, data tot 3 juli ### ### SEEIIR-model, SI = 4 dagen ### ### Met nieuwe NICE-analyses (veranderende kansen) ### ### en PIENTER-serologie, ### ### Leeftijdsmodel gescheiden in deel tot infecties ### ### via vatbaarheid/infectiviteit (SuscInf) en deel ### ### tot symptomen/ziekenhuisopname. Scheiding ### ### mogelijk door serologie ### ########################################################### library(tidyverse) library(lubridate) library(deSolve) ################################ ### eerst alle data-analyses ### ################################ analysisdate <- as.Date("2020-07-03") source("R/code4ode/Reportingdelays4ode.R") source("R/code4ode/NICEanalyses4ode_v4.R") source("R/code4ode/OSIRISanalyses4ode_v2.R") ################################ ### INPUT voor de simulaties ### ################################ ### population source("R/code4ode/populationdata4ode.R") ### infection to symptoms, contacts, relative infectivities, natural history and control source("R/code4ode/ContactsInfectivities4ode_v3.R") # possibility to add alternative matrices and infectivities ctrlmatslockdown <- readRDS("data/Contactmatrix_D3asEpiPose1_residualincreased_27mei2020.rds") ctrlmatsbatch1 <- readRDS("data/Contactmatrix_D3asEpiPose1_residualplus_batch1_29mei2020.rds") ctrlmatsbatch2 <- readRDS("data/Contactmatrix_D3asEpiPose1_residualplus_batch2_29mei2020.rds") ctrlmats <- c(readRDS("data/Contactmatrix_D3asEpiPose1_residualplus_batch1_29mei2020.rds"), readRDS("data/Contactmatrix_D3asEpiPose1_residualplus_batch2_29mei2020.rds"), readRDS("data/ContactmatricesD3praktijk_midpoint_24mrt2020.rds"), list(lockdown = Reduce(`+`, ctrlmatslockdown)/200, batch1 = Reduce(`+`, ctrlmatsbatch1)/200, batch2 = Reduce(`+`, ctrlmatsbatch2)/200) ) ctrlinfs <- list( `00` = 1, `99` = 0.946, IsoMild = 0.98, HQMild = 0.86 ) set.seed(filedate) devs <- runif(200, -1, 1) ctrlinfs <- c(as.list( rep(0.98 * (1 + 0.02 * devs), 4)), list( `00` = 1, `99` = 0.946, IsoMild = 0.98, HQMild = 0.86 )) rm(devs) ### downstream numbers: symptomatic, hospitalised, ICU, mortality source("R/code4ode/DelaysProbabilities4ode_v1.R") ### model code source("R/code4ode/modelcode4ode_v3.R") ### reporting delays repdelayICinc <- get_reportingdelay_NICE(end_date = analysisdate) disdelayICinc <- get_reportingdelay_NICE(discharge = T, end_date = analysisdate) repdelayhospinc <- get_reportingdelay_NICE(IC = F, end_date = analysisdate) disdelayhospinc <- get_reportingdelay_NICE(IC = F, discharge = T, end_date = analysisdate) observedICinc <- inc_nice_ic() ### Calibration with control up to "today" # parameters to change: seeding, fittedrelinfs, probdeath # endtimes: 32 = Sun 15 March, 44 = Fri 27 March (based on better fit than 23 March) logLikijk <- function(parms) { siminc <- covidcontrolsimple(contactcontrol = c("99", "lockdown", "lockdown", "batch1", "batch2"), infectivitycontrol = c("99", "IsoMild", "IsoMild", "IsoMild", "IsoMild"), endtimes = c(32, 50, as.numeric(as.Date("2020-05-10") - as.Date("2020-02-12")), # as.numeric(filedate - 31 - as.Date("2020-02-12")), as.numeric(as.Date("2020-06-01") - as.Date("2020-02-12")), as.numeric(filedate - as.Date("2020-02-12"))), seeding = exp(parms[1]), SI = 4, fittedrelinfs = exp(parms[c(2,3,4,4,4)])) %>% filter(time > 0 & time <= as.numeric(filedate - as.Date("2020-02-12"))) %>% pull(totincICU) # return(siminc) siminc[seq(to = length(siminc), length.out = 100)] <- siminc[seq(to = length(siminc), length.out = 100)] * rev(repdelayICinc) - sum(dpois(observedICinc, siminc, log = T)) } logLikijk_1 <- function(parms) { siminc <- covidcontrolsimple(contactcontrol = c("99", "lockdown", "lockdown", "batch1", "batch2"), infectivitycontrol = c("99", "IsoMild", "IsoMild", "IsoMild", "IsoMild"), endtimes = c(32, 52, as.numeric(filedate - as.Date("2020-02-12"))), seeding = exp(5.823), SI = 4, fittedrelinfs = exp(parms[c(1,2,3)])) %>% filter(time > 0 & time <= as.numeric(filedate - as.Date("2020-02-12"))) %>% pull(totincICU) siminc <- siminc * rev(repdelayICinc[1:length(siminc)]) - sum(dpois(observedICinc, siminc, log = T)) } optim(log(c(150,1,.5,1)), logLikijk) # fri = 23444 (32,52), minloglik = 309.95, ests = 4.88; relinf1=.076; relinf2 = -.321; relinf3=-.0955 optim(log(c(150,1,.5,1)), logLikijk) # fri = 23444 (32,50), minloglik = 309.78, ests = 4.73; relinf1=.092; relinf2 = -.343; relinf3=-.0998 optim(log(c(150,1,.5,1)), logLikijk) # fri = 23444 (32,48), minloglik = 310.11, ests = 4.68; relinf1=.099; relinf2 = -.366; relinf3=-.105 optim(c(4.73,.093,-.344,-.098,-.098), logLikijk) # fri = 23455 (32,50), minloglik = 309.70, ests = 4.76; relinf1=.089; relinf2 = -.348; relinf3=-.093; relinf4=-.110 optim(c(4.73,.093,-.344,-.098,-.098), logLikijk) # fri = 23445 (32,50), minloglik = 308.70, ests = 4.72; relinf1=.094; relinf2 = -.352; relinf3=-.088; relinf4=-.244 # 1000 samples met beste model: fri = 23444 (32,50) ijkres <- optim(c(5, 0, -.5, 0), logLikijk, hessian = T) # IsoMild, IsoMild, IsoMild library(mvtnorm) set.seed(filedate) rndpars <- rmvnorm(200, ijkres$par, solve(ijkres$hessian)) ### relinfectivity in de contactmatrices integreren fittedrelinfmatrix <- function(fri_ctrl, fri_base, ageprops, method = 1) { frivector <- (fri_ctrl / fri_base) * ageprops + 1 - ageprops frimatrix <- matrix(rep(frivector, 9), nrow = 9) if(method == 1) { ### both age classes contribute frimatrix <- sqrt(frimatrix) * sqrt(t(frimatrix)) } else if(method == 2) { ### active age class dominates frimatrix <- pmax(frimatrix, t(frimatrix)) } else { ### inactive age class dominates frimatrix <- pmin(frimatrix, t(frimatrix)) } return(frimatrix * fri_base) } ## nieuwe contactmatrices maken, ctrlmatslockdown <- readRDS("data/Contactmatrix_D3asEpiPose1_residualincreased_27mei2020.rds") ctrlmatsbatch1 <- readRDS("data/Contactmatrix_D3asEpiPose1_residualplus_batch1_29mei2020.rds") ctrlmatsbatch2 <- readRDS("data/Contactmatrix_D3asEpiPose1_residualplus_batch2_29mei2020.rds") ctrlmatsbatch3 <- readRDS("data/Contactmatrix_D3asEpiPose1_residualplus_batch3_25juni2020.rds") ctrlmats <- c(readRDS("data/Contactmatrix_D3asEpiPose1_residualincreased_27mei2020.rds"), readRDS("data/Contactmatrix_D3asEpiPose1_residualplus_batch1_29mei2020.rds"), readRDS("data/Contactmatrix_D3asEpiPose1_residualplus_batch2_29mei2020.rds"), readRDS("data/Contactmatrix_D3asEpiPose1_residualplus_batch3_25juni2020.rds"), readRDS("data/ContactmatricesD3praktijk_midpoint_24mrt2020.rds"), list(lockdown = Reduce(`+`, ctrlmatslockdown)/200, batch1 = Reduce(`+`, ctrlmatsbatch1)/200, batch2 = Reduce(`+`, ctrlmatsbatch2)/200, batch3 = Reduce(`+`, ctrlmatsbatch3)/200) ) for(i in 1:200) { for(j in 0) { ctrlmats[[i + 200 * j]] <- ctrlmats[[i + 200 * j]] * fittedrelinfmatrix(exp(rndpars[i, 4]), exp(rndpars[i, 2]), rep(1, 9)) } for(j in 1:3) { ctrlmats[[i + 200 * j]] <- ctrlmats[[i + 200 * j]] * fittedrelinfmatrix(exp(rndpars[i, 4]), exp(rndpars[i, 2]), rep(1, 9)) } } relbeta <- 1/eigen(t(contactmatrix() * agedist() * relsusceptibility()) * relinfectivity(), only.values = T)[[1]][1] eigen(t(ctrlmats[["99"]] * agedist() * relsusceptibility()) * relinfectivity(scenario = "99") * exp(ijkres$par[2]) * 2*parmsNatHist(SI = 4)$betaC/parmsNatHist(SI = 4)$gammaC, only.values = T)[[1]][1] * relbeta eigen(t(ctrlmats[["lockdown"]] * agedist() * relsusceptibility()) * relinfectivity(scenario = "IsoMild") * exp(ijkres$par[3]) * 2*parmsNatHist(SI = 4)$betaC/parmsNatHist(SI = 4)$gammaC, only.values = T)[[1]][1] * relbeta eigen(t(ctrlmats[["lockdown"]] * agedist() * relsusceptibility()) * relinfectivity(scenario = "IsoMild") * exp(ijkres$par[4]) * 2*parmsNatHist(SI = 4)$betaC/parmsNatHist(SI = 4)$gammaC, only.values = T)[[1]][1] * relbeta mean(sapply(1:200, function(x) eigen(t(ctrlmats[[x]] * agedist() * relsusceptibility()) * ctrlinfs[[x]] * relinfectivity(scenario = "IsoMild") * 2*parmsNatHist(SI = 4)$betaC/parmsNatHist(SI = 4)$gammaC, only.values = T)[[1]][1] * relbeta)) mean(sapply(201:400, function(x) eigen(t(ctrlmats[[x]] * agedist() * relsusceptibility()) * ctrlinfs[[x]] * relinfectivity(scenario = "IsoMild") * 2*parmsNatHist(SI = 4)$betaC/parmsNatHist(SI = 4)$gammaC, only.values = T)[[1]][1] * relbeta)) mean(sapply(401:600, function(x) eigen(t(ctrlmats[[x]] * agedist() * relsusceptibility()) * ctrlinfs[[x]] * relinfectivity(scenario = "IsoMild") * 2*parmsNatHist(SI = 4)$betaC/parmsNatHist(SI = 4)$gammaC, only.values = T)[[1]][1] * relbeta)) mean(sapply(601:800, function(x) eigen(t(ctrlmats[[x]] * agedist() * relsusceptibility()) * ctrlinfs[[x]] * relinfectivity(scenario = "IsoMild") * 2*parmsNatHist(SI = 4)$betaC/parmsNatHist(SI = 4)$gammaC, only.values = T)[[1]][1] * relbeta)) panels_rijen <- c(NA) panels_kolommen <- c(NA) panels_kleuren <- c("geen bestrijding", "huidige pakket")#, "lockdown", "thuisquarantaine") contactkeus <- function(rij = 1, kolom = 1, kleur = 1) { case_when( kleur == 1 ~ c("99", "99", "99", "99", "99", "99", "99"), kleur == 2 ~ c("99", "lockdown", "lockdown", "batch1", "batch2", "RND", "RND") ) } infectiviteitkeus <- function(rij = 1, kolom = 1, kleur = 1) { case_when( kleur == 1 ~ c("99", "99", "99", "99", "99", "99", "99"), kleur == 2 ~ c("99", "IsoMild", "IsoMild", "IsoMild", "IsoMild", "RND", "RND") ) } eindtijden <- function() c(32, 50, as.numeric(as.Date("2020-05-10") - as.Date("2020-02-12")), as.numeric(as.Date("2020-06-01") - as.Date("2020-02-12")), as.numeric(filedate - as.Date("2020-02-12")) - 14, as.numeric(as.Date("2020-07-06") - as.Date("2020-02-12")), 400) allfigdata <- list() for(repnr in 1:200) { allsimulresults <- list() for(i in 1:1) { for(j in 1:1) { for(k in 1:2) { simul <- covidcontrolsim(contactcontrol = contactkeus(kleur = k), infectivitycontrol = infectiviteitkeus(kleur = k), endtimes = eindtijden(), seeding = exp(rndpars[repnr, 1]), Rstart = 2.2, SI = 4, fittedrelinfs = list(exp(rndpars[repnr, c(2,2,2,2,2,2,2)]), c(exp(rndpars[repnr, c(2,3,4,4,4)]), 1, 1))[[k]], nr = c(repnr, repnr, repnr, repnr, repnr, repnr + 400, repnr + 600)) allsimulresults <- c(allsimulresults, list(simul %>% mutate(rij = panels_rijen[i], kolom = panels_kolommen[j], kleur = panels_kleuren[k])) ) } } } allfigdata <- c(allfigdata, list(do.call(rbind, allsimulresults) %>% mutate(tijd = as.Date("2020-02-12") + time) )) cat(repnr) } saveRDS(allfigdata, "results/allfigdata___UITZONDERINGSGROND_2____27062020") allfigdata <- readRDS("results/allfigdata___UITZONDERINGSGROND_2____27062020") allfigdata <- lapply(1:200, function(x) allfigdata[[x]] %>% mutate(repl = x)) figuredata <- do.call(rbind, allfigdata) # IC prevented figuredata %>% filter(tijd <= as.Date("2020-06-27")) %>% group_by(repl, kleur) %>% summarise(totICU = sum(incICU)) %>% group_by(repl) %>% mutate( zonder = totICU[kleur == "geen bestrijding"], met = totICU[kleur == "huidige pakket"], verschil = zonder - met ) %>% ungroup() %>% select(repl,zonder,met,verschil) %>% distinct() %>% select(-repl) %>% as.matrix() %>% apply(2, quantile, probs = c(.025,.5,.975)) # HOSP prevented figuredata %>% filter(tijd <= as.Date("2020-06-27")) %>% group_by(repl, kleur) %>% summarise(tothosp = sum(inchosp)) %>% group_by(repl) %>% mutate( zonder = tothosp[kleur == "geen bestrijding"], met = tothosp[kleur == "huidige pakket"], verschil = zonder - met ) %>% ungroup() %>% select(repl,zonder,met,verschil) %>% distinct() %>% select(-repl) %>% as.matrix() %>% apply(2, quantile, probs = c(.025,.5,.975)) # HOSP prevented figuredata %>% filter(tijd <= as.Date("2020-06-27")) %>% group_by(repl, kleur, ageclass) %>% summarise(tothosp = sum(incinfection)) %>% group_by(repl, ageclass) %>% mutate( zonder = tothosp[kleur == "geen bestrijding"], met = tothosp[kleur == "huidige pakket"], verschil = zonder - met ) %>% ungroup() %>% select(repl,zonder,met,verschil, ageclass) %>% distinct() %>% group_by(ageclass) %>% summarise(zonder = median(zonder), met = median(met), verschil = median(verschil)) select(-repl) %>% as.matrix() %>% apply(2, quantile, probs = c(.025,.5,.975)) # two weeks symptomatic incidence figuredata %>% filter(tijd >= as.Date("2020-06-13") & tijd <= as.Date("2020-06-27") & kleur == "huidige pakket") %>% group_by(repl, tijd) %>% summarise(totsymp = sum(incsymp)) %>% group_by(tijd) %>% summarise( lower = quantile(totsymp, .025), median = median(totsymp), upper = quantile(totsymp, .975) ) figuredata %>% filter(tijd <= as.Date("2020-06-27") & kleur == "huidige pakket") %>% mutate(weeknr = 7+floor((time+2)/7)) %>% group_by(repl, weeknr) %>% summarise(totsymp = sum(incsymp)) %>% group_by(weeknr) %>% summarise( lower = quantile(totsymp, .025), median = median(totsymp), upper = quantile(totsymp, .975) ) figuredata %>% filter(tijd <= as.Date("2020-06-27") & kleur == "huidige pakket") %>% group_by(repl, tijd) %>% summarise(totsymp = sum(incsymp)) %>% group_by(repl) %>% mutate(cumsymp = cumsum(totsymp)) %>% group_by(tijd) %>% summarise( lowerinc = round(quantile(totsymp, .025)), medianinc = round(median(totsymp)), upperinc = round(quantile(totsymp, .975)), lowercumul = round(quantile(cumsymp, .025)), mediancumul = round(median(cumsymp)), uppercumul = round(quantile(cumsymp, .975)) ) %>% write_csv("results/symptomaticcases27062020.csv") figuredata %>% filter(tijd <= as.Date("2020-06-27") & kleur == "huidige pakket") %>% group_by(repl, tijd) %>% summarise(totsymp = sum(incinfection)) %>% group_by(repl) %>% mutate(cumsymp = cumsum(totsymp)) %>% group_by(tijd) %>% summarise( lowerinc = round(quantile(totsymp, .025)), medianinc = round(median(totsymp)), upperinc = round(quantile(totsymp, .975)), lowercumul = round(quantile(cumsymp, .025)), mediancumul = round(median(cumsymp)), uppercumul = round(quantile(cumsymp, .975)) ) %>% write_csv("results/allcases27062020.csv") figuredata %>% filter(tijd > as.Date("2020-06-20") & tijd <= as.Date("2020-06-27") & kleur == "huidige pakket") %>% group_by(repl) %>% summarise(totsymp = sum(incsymp)) %>% mutate(totinf = totsymp)%>%# * 2^runif(200,1,3)) %>% summarise( lower = quantile(totinf, .025), median = median(totinf), upper = quantile(totinf, .975) ) figuredata %>% filter(tijd > as.Date("2020-06-20") & tijd <= as.Date("2020-06-27") & kleur == "huidige pakket") %>% group_by(repl) %>% summarise(totinf = sum(incinfection)) %>% summarise( lower = quantile(totinf, .025), median = median(totinf), upper = quantile(totinf, .975) ) figuredata %>% filter(kleur == "geen bestrijding") %>% group_by(repl) %>% summarise(totinf = sum(incinfection)) %>% ungroup() %>% summarise( lower = quantile(totinf, .025)/popsize(), median = median(totinf)/popsize(), upper = quantile(totinf, .975)/popsize() ) figuredata %>% filter(kleur == "geen bestrijding") %>% group_by(repl, tijd) %>% summarise(totinf = sum(incinfection)) %>% group_by(tijd) %>% summarise( lower = quantile(totinf, .025), median = median(totinf), upper = quantile(totinf, .975) ) %>% View() ############### ### figuren ### ############### ### IC-incidence obsdata <- tibble( tijd = seq(as.Date("2020-02-13"), filedate, 1), ICinc = inc_nice_ic() ) %>% bind_cols( as_tibble(inc_nice_ic(ages=T))) %>% pivot_longer(3:11, names_to = "ageclass", values_to = "observed") %>% group_by(ageclass) %>% mutate(ICcuminc = cumsum(ICinc), cumobserved = cumsum(observed)) %>% ungroup() figuredata %>% filter(time >= 25 & time < 185) %>% mutate(kleur = if_else(kleur == "huidige pakket", "met gevolgde\n maatregelen", kleur)) %>% group_by(tijd, kleur, repl) %>% summarise( totsimulated = sum(incICU) ) %>% group_by(tijd, kleur) %>% summarise( lowerbound = qpois(0.025, quantile(totsimulated, .025)), upperbound = qpois(0.975, quantile(totsimulated, .975)), midbound = median(totsimulated) ) %>% ungroup() %>% left_join(obsdata %>% select(tijd, ICinc) %>% distinct(), by = c("tijd")) %>% mutate(datapunten = "NICE IC-opnames") %>% ggplot(aes(x = tijd, y = midbound)) + geom_line(aes(color = kleur), size = 2) + geom_ribbon(aes(ymin = lowerbound, ymax = upperbound, fill = kleur, color = NULL), alpha = 0.3) + geom_point(mapping = aes(y = ICinc, shape = datapunten), size = 2) + theme_light() + labs(x = "Dag", y = "Dagelijks aantal IC-opnames") + labs(title = "Aantal IC-opnames per dag") + scale_color_discrete(name = "scenario") + scale_fill_discrete(name = "scenario") + scale_x_date(date_breaks = "1 month", date_labels = "1 %b") + coord_cartesian(ylim = c(0,150)) ggsave(paste0("results/sims_ICincallshort_ribbon_", today(), ".jpg"), units = "mm", width = 200, height = 120, dpi = 300) figuredata %>% filter(time >= 80 & time < 185) %>% mutate(kleur = if_else(kleur == "huidige pakket", "met gevolgde\n maatregelen", kleur)) %>% group_by(tijd, kleur, repl) %>% summarise( totsimulated = sum(incICU) ) %>% group_by(tijd, kleur) %>% summarise( lowerbound = qpois(0.025, quantile(totsimulated, .025)), upperbound = qpois(0.975, quantile(totsimulated, .975)), midbound = median(totsimulated) ) %>% ungroup() %>% left_join(obsdata %>% select(tijd, ICinc) %>% distinct(), by = c("tijd")) %>% mutate(datapunten = "NICE IC-opnames") %>% ggplot(aes(x = tijd, y = midbound)) + geom_line(aes(color = kleur), size = 2) + geom_ribbon(aes(ymin = lowerbound, ymax = upperbound, fill = kleur, color = NULL), alpha = 0.3) + geom_point(mapping = aes(y = ICinc, shape = datapunten), size = 2) + theme_light() + labs(x = "Dag", y = "Dagelijks aantal IC-opnames") + labs(title = "Aantal IC-opnames per dag") + scale_color_discrete(name = "scenario") + scale_fill_discrete(name = "scenario") + scale_x_date(date_breaks = "1 month", date_labels = "1 %b") + coord_cartesian(ylim = c(0,40)) ggsave(paste0("results/sims_ICincallnopeak_ribbon_", today(), ".jpg"), units = "mm", width = 200, height = 120, dpi = 300) figuredata %>% filter(time >= 25 & time < 155) %>% mutate(kleur = if_else(kleur == "huidige pakket", "met gevolgde\n maatregelen", kleur)) %>% group_by(tijd, kleur, repl) %>% summarise( totsimulated = sum(incICU_C) ) %>% group_by(tijd, kleur) %>% summarise( lowerbound = qpois(0.025, quantile(totsimulated, .025)), upperbound = qpois(0.975, quantile(totsimulated, .975)), midbound = median(totsimulated) ) %>% ungroup() %>% left_join(obsdata %>% select(tijd, ICinc) %>% distinct(), by = c("tijd")) %>% mutate(datapunten = "NICE IC-opnames") %>% ggplot(aes(x = tijd, y = midbound)) + geom_line(aes(color = kleur), size = 2) + geom_ribbon(aes(ymin = lowerbound, ymax = upperbound, fill = kleur, color = NULL), alpha = 0.3) + geom_point(mapping = aes(y = ICinc, shape = datapunten), size = 2) + theme_light() + labs(x = "Dag", y = "Dagelijks aantal IC-opnames") + labs(title = "Aantal IC-opnames per dag (hypothetisch: bij gelijkgebleven opnamebeleid)") + scale_color_discrete(name = "scenario") + scale_fill_discrete(name = "scenario") + scale_x_date(date_breaks = "1 month", date_labels = "1 %b") + coord_cartesian(ylim = c(0,200)) ggsave(paste0("results/sims_ICincallshort_counterfact_ribbon_", today(), ".jpg"), units = "mm", width = 200, height = 120, dpi = 300) figuredata %>% filter(time >= 25 & time < 150) %>% mutate(kleur = if_else(kleur == "huidige pakket", "met gevolgde\n maatregelen", kleur)) %>% group_by(kleur, ageclass, repl) %>% mutate( totsimulated = cumsum(incICU), totsimulated = if_else(kleur == "geen bestrijding", NA_real_, totsimulated) ) %>% group_by(tijd, kleur, ageclass) %>% summarise( lowerbound = qpois(0.025, quantile(totsimulated, .025, na.rm = T)), upperbound = qpois(0.975, quantile(totsimulated, .975, na.rm = T)), midbound = median(totsimulated, na.rm = T) ) %>% ungroup() %>% left_join(obsdata, by = c("tijd", "ageclass")) %>% mutate(datapunten = "NICE IC-opnames") %>% ggplot(aes(x = tijd, y = midbound)) + geom_line(aes(color = kleur), size = 1) + geom_ribbon(aes(ymin = lowerbound, ymax = upperbound, fill = kleur, color = NULL), alpha = 0.3) + geom_point(mapping = aes(y = cumobserved, shape = datapunten), size = 2) + theme_light() + labs(x = "Dag", y = "Cumulatief aantal IC-opnames") + facet_wrap(~ ageclass, scales = "free_y") + labs(title = "Cumulatief aantal IC-opnames per leeftijdsgroep") # ggsave(paste0("results/sims_ICinclft_", today(), ".jpg"), units = "mm", width = 180, height = 120, dpi = 300) # IC-prevalence obsdata <- tibble( tijd = seq(as.Date("2020-02-13"), filedate, 1), ICprev = prev_nice_ic() ) %>% bind_cols( as_tibble(prev_nice_ic(ages=T))) %>% pivot_longer(3:11, names_to = "ageclass", values_to = "observed") figuredata %>% filter(time >= 25 & time < 185) %>% mutate(kleur = if_else(kleur == "huidige pakket", "met gevolgde\n maatregelen", kleur)) %>% group_by(tijd, kleur, repl) %>% summarise( totsimulated = sum(prevICU) ) %>% group_by(tijd, kleur) %>% summarise( lowerbound = qpois(0.025, quantile(totsimulated, .025, na.rm = T)), upperbound = qpois(0.975, quantile(totsimulated, .975, na.rm = T)), midbound = median(totsimulated, na.rm = T) ) %>% ungroup() %>% left_join(obsdata %>% select(tijd, ICprev) %>% distinct(), by = c("tijd")) %>% mutate(datapunten = "NICE IC-bezetting") %>% ggplot(aes(x = tijd, y = midbound)) + geom_line(aes(color = kleur), size = 2) + geom_ribbon(aes(ymin = lowerbound, ymax = upperbound, fill = kleur, color = NULL), alpha = 0.3) + geom_point(mapping = aes(y = ICprev, shape = datapunten), size = 2) + theme_light() + labs(x = "Dag", y = "IC-bezetting") + labs(title = "Aantal bezette IC-bedden") + scale_color_discrete(name = "scenario") + scale_fill_discrete(name = "scenario") + scale_x_date(date_breaks = "1 month", date_labels = "1 %b") + coord_cartesian(ylim = c(0,1500)) + geom_hline(aes(yintercept = 1208), color = "grey30", linetype = "dashed") + annotate(geom = "text", x = as.Date("2020-06-15"), y = 1280, label = "Gewoonlijke Nederlandse IC-capaciteit", hjust = 1, size = 3, color = "grey30") # + # geom_hline(aes(yintercept = 2400), color = "black", linetype = "dashed") + # annotate(geom = "text", x = as.Date("2020-07-01"), y = 2470, # label = "Opgeschaalde Nederlandse IC-capaciteit", hjust = 1, size = 3) ggsave(paste0("results/sims_ICprevallshort_ribbon_", today(), ".jpg"), units = "mm", width = 200, height = 120, dpi = 300) figuredata %>% filter(time >= 80 & time < 185) %>% mutate(kleur = if_else(kleur == "huidige pakket", "met gevolgde\n maatregelen", kleur)) %>% group_by(tijd, kleur, repl) %>% summarise( totsimulated = sum(prevICU) ) %>% group_by(tijd, kleur) %>% summarise( lowerbound = qpois(0.025, quantile(totsimulated, .025, na.rm = T)), upperbound = qpois(0.975, quantile(totsimulated, .975, na.rm = T)), midbound = median(totsimulated, na.rm = T) ) %>% ungroup() %>% left_join(obsdata %>% select(tijd, ICprev) %>% distinct(), by = c("tijd")) %>% mutate(datapunten = "NICE IC-bezetting") %>% ggplot(aes(x = tijd, y = midbound)) + geom_line(aes(color = kleur), size = 2) + geom_ribbon(aes(ymin = lowerbound, ymax = upperbound, fill = kleur, color = NULL), alpha = 0.3) + geom_point(mapping = aes(y = ICprev, shape = datapunten), size = 2) + theme_light() + labs(x = "Dag", y = "IC-bezetting") + labs(title = "Aantal bezette IC-bedden") + scale_color_discrete(name = "scenario") + scale_fill_discrete(name = "scenario") + scale_x_date(date_breaks = "1 month", date_labels = "1 %b") + coord_cartesian(ylim = c(0,500)) + geom_hline(aes(yintercept = 1208), color = "grey30", linetype = "dashed") + annotate(geom = "text", x = as.Date("2020-06-15"), y = 1280, label = "Gewoonlijke Nederlandse IC-capaciteit", hjust = 1, size = 3, color = "grey30") # + # geom_hline(aes(yintercept = 2400), color = "black", linetype = "dashed") + # annotate(geom = "text", x = as.Date("2020-07-01"), y = 2470, # label = "Opgeschaalde Nederlandse IC-capaciteit", hjust = 1, size = 3) ggsave(paste0("results/sims_ICprevallnopeak_ribbon_", today(), ".jpg"), units = "mm", width = 200, height = 120, dpi = 300) figuredata %>% filter(time >= 25 & time < 155) %>% mutate(kleur = if_else(kleur == "huidige pakket", "met gevolgde\n maatregelen", kleur)) %>% group_by(tijd, kleur, repl) %>% summarise( totsimulated = sum(prevICU_C) ) %>% group_by(tijd, kleur) %>% summarise( lowerbound = qpois(0.025, quantile(totsimulated, .025, na.rm = T)), upperbound = qpois(0.975, quantile(totsimulated, .975, na.rm = T)), midbound = median(totsimulated, na.rm = T) ) %>% ungroup() %>% left_join(obsdata %>% select(tijd, ICprev) %>% distinct(), by = c("tijd")) %>% mutate(datapunten = "NICE IC-bezetting") %>% ggplot(aes(x = tijd, y = midbound)) + geom_line(aes(color = kleur), size = 2) + geom_ribbon(aes(ymin = lowerbound, ymax = upperbound, fill = kleur, color = NULL), alpha = 0.3) + geom_point(mapping = aes(y = ICprev, shape = datapunten), size = 2) + theme_light() + labs(x = "Dag", y = "IC-bezetting") + labs(title = "Aantal bezette IC-bedden (hypothetisch: bij gelijkgebleven opnamebeleid)") + scale_color_discrete(name = "scenario") + scale_fill_discrete(name = "scenario") + scale_x_date(date_breaks = "1 month", date_labels = "1 %b") + coord_cartesian(ylim = c(0,2000)) + geom_hline(aes(yintercept = 1208), color = "grey30", linetype = "dashed") + annotate(geom = "text", x = as.Date("2020-06-15"), y = 1280, label = "Gewoonlijke Nederlandse IC-capaciteit", hjust = 1, size = 3, color = "grey30") # + # geom_hline(aes(yintercept = 2400), color = "black", linetype = "dashed") + # annotate(geom = "text", x = as.Date("2020-07-01"), y = 2470, # label = "Opgeschaalde Nederlandse IC-capaciteit", hjust = 1, size = 3) ggsave(paste0("results/sims_ICprevallshort_counterfact_ribbon_", today(), ".jpg"), units = "mm", width = 200, height = 120, dpi = 300) # hospital incidence obsdata <- tibble( tijd = seq(as.Date("2020-02-13"), filedate, 1), hospincNICE = inc_nice_hosp(), hospincOSIRIS = inc_osiris_hosp() ) %>% bind_cols( as_tibble(inc_nice_hosp(ages=T))) %>% pivot_longer(4:12, names_to = "ageclass", values_to = "observed") %>% group_by(ageclass) %>% mutate(hospcumincNICE = cumsum(hospincNICE), hospcumincOSIRIS = cumsum(hospincOSIRIS), cumobserved = cumsum(observed)) %>% ungroup() figuredata %>% filter(time >= 25 & time < 185) %>% mutate(kleur = if_else(kleur == "huidige pakket", "met gevolgde\n maatregelen", kleur)) %>% group_by(tijd, kleur, repl) %>% summarise( totsimulated = sum(inchosp) ) %>% group_by(tijd, kleur) %>% summarise( lowerbound = qpois(0.025, quantile(totsimulated, .025, na.rm = T)), upperbound = qpois(0.975, quantile(totsimulated, .975, na.rm = T)), midbound = median(totsimulated, na.rm = T) ) %>% ungroup() %>% left_join(obsdata %>% select(tijd, hospincNICE, hospincOSIRIS) %>% distinct() %>% pivot_longer(2:3, names_to = "databron", values_to = "hospinc"), by = c("tijd")) %>% mutate(datapunten = "ziekenhuisopnames") %>% ggplot(aes(x = tijd, y = midbound)) + geom_line(aes(color = kleur), size = 2) + geom_ribbon(aes(ymin = lowerbound, ymax = upperbound, fill = kleur, color = NULL), alpha = 0.3) + geom_point(mapping = aes(y = hospinc, shape = databron), size = 2) + scale_shape_discrete(labels = c("NICE", "OSIRIS"), na.translate = F) + theme_light() + labs(x = "Dag", y = "Dagelijks aantal ziekenhuisopnames") + labs(title = "Aantal ziekenhuisopnames per dag") + scale_color_discrete(name = "scenario") + scale_fill_discrete(name = "scenario") + scale_x_date(date_breaks = "1 month", date_labels = "1 %b") + coord_cartesian(ylim = c(0,600)) ggsave(paste0("results/sims_hospincallshort_ribbon_", today(), ".jpg"), units = "mm", width = 200, height = 120, dpi = 300) figuredata %>% filter(time >= 80 & time < 185) %>% mutate(kleur = if_else(kleur == "huidige pakket", "met gevolgde\n maatregelen", kleur)) %>% group_by(tijd, kleur, repl) %>% summarise( totsimulated = sum(inchosp) ) %>% group_by(tijd, kleur) %>% summarise( lowerbound = qpois(0.025, quantile(totsimulated, .025, na.rm = T)), upperbound = qpois(0.975, quantile(totsimulated, .975, na.rm = T)), midbound = median(totsimulated, na.rm = T) ) %>% ungroup() %>% left_join(obsdata %>% select(tijd, hospincNICE, hospincOSIRIS) %>% distinct() %>% pivot_longer(2:3, names_to = "databron", values_to = "hospinc"), by = c("tijd")) %>% mutate(datapunten = "ziekenhuisopnames") %>% ggplot(aes(x = tijd, y = midbound)) + geom_line(aes(color = kleur), size = 2) + geom_ribbon(aes(ymin = lowerbound, ymax = upperbound, fill = kleur, color = NULL), alpha = 0.3) + geom_point(mapping = aes(y = hospinc, shape = databron), size = 2) + scale_shape_discrete(labels = c("NICE", "OSIRIS"), na.translate = F) + theme_light() + labs(x = "Dag", y = "Dagelijks aantal ziekenhuisopnames") + labs(title = "Aantal ziekenhuisopnames per dag") + scale_color_discrete(name = "scenario") + scale_fill_discrete(name = "scenario") + scale_x_date(date_breaks = "1 month", date_labels = "1 %b") + coord_cartesian(ylim = c(0,100)) ggsave(paste0("results/sims_hospincallnopeak_ribbon_", today(), ".jpg"), units = "mm", width = 200, height = 120, dpi = 300) # hospital prevalence obsdata <- tibble( tijd = seq(as.Date("2020-02-13"), filedate, 1), hospprev = prev_nice_hosp(maxligduur = 28) ) %>% bind_cols( as_tibble(prev_nice_hosp(ages=T))) %>% pivot_longer(3:11, names_to = "ageclass", values_to = "observed") figuredata %>% filter(time >= 25 & time < 185) %>% mutate(kleur = if_else(kleur == "huidige pakket", "met gevolgde\n maatregelen", kleur)) %>% group_by(tijd, kleur, repl) %>% summarise( totsimulated = sum(prevhosp + prevICU) ) %>% group_by(tijd, kleur) %>% summarise( lowerbound = qpois(0.025, quantile(totsimulated, .025, na.rm = T)), upperbound = qpois(0.975, quantile(totsimulated, .975, na.rm = T)), midbound = median(totsimulated, na.rm = T) ) %>% ungroup() %>% left_join(obsdata %>% select(tijd, hospprev) %>% distinct(), by = c("tijd")) %>% mutate(datapunten = "NICE ziekenhuisbezetting") %>% ggplot(aes(x = tijd, y = midbound)) + geom_line(aes(color = kleur), size = 2) + geom_ribbon(aes(ymin = lowerbound, ymax = upperbound, fill = kleur, color = NULL), alpha = 0.3) + geom_point(mapping = aes(y = hospprev, shape = datapunten), size = 2) + theme_light() + labs(x = "Dag", y = "ziekenhuisbezetting") + labs(title = "Aantal bezette ziekenhuisbedden (inclusief IC)") + scale_color_discrete(name = "scenario") + scale_fill_discrete(name = "scenario") + scale_x_date(date_breaks = "1 month", date_labels = "1 %b") + coord_cartesian(ylim = c(0,4500)) ggsave(paste0("results/sims_hospprevallshort_ribbon_", today(), ".jpg"), units = "mm", width = 200, height = 120, dpi = 300) figuredata %>% filter(time >= 25 & time < 150) %>% filter(kleur == "huidige pakket") %>% left_join(obsdata, by = c("tijd", "ageclass")) %>% mutate(datapunten = "NICE ziekenhuisbezetting") %>% ggplot(aes(x = tijd, y = prevhosp + prevICU)) + geom_line(size = 1) + geom_point(mapping = aes(y = observed, shape = datapunten), size = 2) + theme_light() + labs(x = "Dag", y = "Aantal ziekenhuisbedden") + facet_wrap(~ ageclass, scales = "free_y") + labs(title = "Bezette ziekenhuisbedden per leeftijdsgroep") ggsave(paste0("results/sims_hospprevlft_", today(), ".jpg"), units = "mm", width = 180, height = 120, dpi = 300) # mortaliteit obsdata <- tibble( tijd = seq(as.Date("2020-02-13"), filedate , 1), mort = inc_osiris_mort() ) %>% bind_cols( as_tibble(inc_osiris_mort(ages=T))) %>% pivot_longer(3:11, names_to = "ageclass", values_to = "observed") %>% group_by(ageclass) %>% mutate(cummort = cumsum(mort), cumobserved = cumsum(observed)) %>% ungroup() figuredata %>% filter(time >= 25 & time < 150) %>% filter(kleur == "huidige pakket") %>% group_by(tijd, kleur, repl) %>% summarise( totsimulated = sum(incmort)# + sum(incmorthosp)# + sum(incmortsevere) ) %>% group_by(tijd, kleur) %>% summarise( lowerbound = qpois(0.025, quantile(totsimulated, .025, na.rm = T)), upperbound = qpois(0.975, quantile(totsimulated, .975, na.rm = T)), midbound = median(totsimulated, na.rm = T) ) %>% pull(midbound) %>% sum() ungroup() %>% left_join(obsdata %>% select(tijd, mort) %>% distinct(), by = c("tijd")) %>% mutate(datapunten = "sterfte (OSIRIS)") %>% ggplot(aes(x = tijd, y = midbound)) + geom_line(size = 2) + geom_point(mapping = aes(y = mort, shape = datapunten), size = 2) + theme_light() + labs(x = "Dag", y = "Aantal sterfgevallen") + labs(title = "Sterfte per dag") ggsave(paste0("results/sims_mortall_", today(), ".jpg"), units = "mm", width = 180, height = 120, dpi = 300) figuredata %>% filter(time >= 25 & time < 150) %>% filter(kleur == "huidige pakket") %>% group_by(ageclass) %>% mutate(cumsimulated = cumsum(incmort)) %>% ungroup() %>% left_join(obsdata, by = c("tijd", "ageclass")) %>% mutate(datapunten = "sterfte (OSIRIS)") %>% ggplot(aes(x = tijd, y = cumsimulated)) + geom_line(size = 1) + geom_point(mapping = aes(y = cumobserved, shape = datapunten), size = 2) + theme_light() + labs(x = "Dag", y = "Cumulatief aantal sterfgevallen") + facet_wrap(~ ageclass, scales = "free_y") + labs(title = "Cumulatieve sterfte per leeftijdsgroep") ggsave(paste0("results/sims_mortlft_", today(), ".jpg"), units = "mm", width = 180, height = 120, dpi = 300) # immuniteit figuredata %>% filter(time >= 25 & time < 150) %>% filter(kleur == "huidige pakket") %>% ggplot(aes(x = tijd, y = 100 * immune)) + geom_line(size = 1) + theme_light() + labs(x = "Dag", y = "Percentage met doorgemaakte infectie") + facet_wrap(~ ageclass, scales = "free_y") + labs(title = "Percentage doorgemaakte infecties per leeftijdsgroep") ggsave(paste0("results/sims_immlft_", today(), ".jpg"), units = "mm", width = 180, height = 120, dpi = 300) figuredata %>% filter(kleur == "huidige pakket") %>% filter(time >= 25 & time < 150) %>% group_by(tijd) %>% summarise(totmort = sum(incmort)) %>% left_join(obsdata, by = "tijd") %>% mutate(datapunten = "OSIRIS mortaliteit") %>% ggplot(aes(x = tijd, y = totmort)) + geom_line(size = 2) + geom_point(mapping = aes(y = mort, shape = datapunten), size = 2) + theme_light() + labs(x = "Dag", y = "Dagelijkse mortaliteit") + # scale_x_date(date_labels = "%d-%m") + # scale_x_date(date_breaks = "1 week", date_labels = "%d-%m") + coord_cartesian(ylim = c(0,400)) figuredata %>% filter(kleur == "huidige pakket") %>% filter(time >= 25 & time < 150) %>% left_join(obsdata, by = c("tijd", "ageclass")) %>% mutate(datapunten = "OSIRIS mortaliteit") %>% ggplot(aes(x = tijd, y = incmort)) + geom_line(size = 1) + geom_point(mapping = aes(y = mortality, shape = datapunten), size = 2) + theme_light() + labs(x = "Dag", y = "Dagelijkse mortaliteit") + facet_wrap(~ ageclass, scales = "free_y") # scale_x_date(date_labels = "%d-%m") + # scale_x_date(date_breaks = "1 week", date_labels = "%d-%m") + coord_cartesian(ylim = c(0,200)) + scale_color_discrete(name = "scenario") + guides(color = guide_legend(override.aes = list(size = 1))) + # facet_wrap(~ maatregelen, ncol = 1) + geom_hline(aes(yintercept = 1208 * popsize()/popsize()), color = "black", linetype = "dashed") + annotate(geom = "text", x = as.Date("2020-03-07"), y = 1300 * popsize()/popsize(), label = "Nederlandse IC-capaciteit", hjust = 0, size = 4) ggsave(paste0("results/sims_fitted2_", today(), ".tiff"), units = "mm", width = 180, height = 120, dpi = 150) obsdata <- tibble( tijd = seq(as.Date("2020-02-13"), filedate , 1), ICobserved = prev_nice_ic(), ICinc = inc_nice_ic(), hosp = inc_osiris_hosp(), mort = inc_osiris_mort(), report = inc_osiris_report() ) %>% bind_cols( as_tibble(inc_osiris_mort(ages=T))) %>% pivot_longer(7:15, names_to = "ageclass", values_to = "mortality") figuredata %>% filter(time >= 25 & time < 150) %>% left_join(obsdata, by = "tijd") %>% mutate(datapunten = "NICE IC-opnames NL") %>% # filter(kleur == "geen bestrijding") %>% # group_by(tijd, kleur) %>% ggplot(aes(x = tijd, y = ICUopnames)) + geom_line(mapping = aes(color = kleur), size = 2) + geom_point(mapping = aes(y = ICinc, shape = datapunten), size = 2) + theme_light() + labs(x = "Dag", y = "Aantal nieuwe IC-opnames") + # scale_x_date(date_labels = "%d-%m") + # scale_x_date(date_breaks = "1 week", date_labels = "%d-%m") + coord_cartesian(ylim = c(0,250)) + scale_color_discrete(name = "scenario") + guides(color = guide_legend(override.aes = list(size = 1))) + # facet_wrap(~ maatregelen, ncol = 1) + geom_hline(aes(yintercept = 1208 * popsize()/popsize()), color = "black", linetype = "dashed") + annotate(geom = "text", x = as.Date("2020-03-07"), y = 1300 * popsize()/popsize(), label = "gem NL IC-capaciteit", hjust = 0, size = 4) ggsave(paste0("results/sims_fittedinc2_", today(), ".tiff"), units = "mm", width = 180, height = 120, dpi = 150) eigenvalues <- sapply(1:1000, function(x) eigen(t(ctrlmats[[x]] * agedist(...)) * 0.9525 * relinfectivity(F)/.946, only.values = T)[[1]][1]) figuredata %>% filter(time >= 25 & time < 250 & kleur == "huidige pakket") %>% mutate( R0 = Rstarts[repl], control = eigenvalues[repl], lambda = doublings[repl]) %>% # filter(kleur == "geen bestrijding") %>% # group_by(tijd, kleur) %>% ggplot(aes(x = tijd, y = ICUbezetting, group = repl, color = lambda)) + geom_line(size = 0.1) + theme_light() + labs(x = "Dag", y = "Aantal bezette IC-plaatsen") + # scale_x_date(date_labels = "%d-%m") + # scale_x_date(date_breaks = "1 week", date_labels = "%d-%m") + scale_y_continuous(limits = c(0,5000)) + scale_color_gradient2(name = "doubling\ntime", midpoint = 2.9, low = "red", high = "blue") + # guides(color = guide_legend(override.aes = list(size = 1))) + # facet_wrap(~ maatregelen, ncol = 1) + geom_hline(aes(yintercept = 1208), color = "black", linetype = "dashed") + annotate(geom = "text", x = as.Date("2020-03-07"), y = 1300, label = "Nederlandse IC-capaciteit", hjust = 0, size = 3) ggsave("results/sims_spaghettileisure70_ICU20_doubling.tiff", units = "mm", width = 180, height = 120, dpi = 150) figuredata %>% filter(time >= 25 & time < 250 & kleur == "huidige pakket") %>% mutate( R0 = Rstarts[repl], control = eigenvalues[repl], lambda = doublings[repl]) %>% # filter(kleur == "geen bestrijding") %>% # group_by(tijd, kleur) %>% ggplot(aes(x = tijd, y = ICUbezetting, group = repl, color = R0)) + geom_line(size = 0.1) + theme_light() + labs(x = "Dag", y = "Aantal bezette IC-plaatsen") + # scale_x_date(date_labels = "%d-%m") + # scale_x_date(date_breaks = "1 week", date_labels = "%d-%m") + scale_y_continuous(limits = c(0,5000)) + scale_color_gradient2(name = "Reproduction\nnumber", midpoint = 2.2, high = "red", low = "blue") + # guides(color = guide_legend(override.aes = list(size = 1))) + # facet_wrap(~ maatregelen, ncol = 1) + geom_hline(aes(yintercept = 1208), color = "black", linetype = "dashed") + annotate(geom = "text", x = as.Date("2020-03-07"), y = 1300, label = "Nederlandse IC-capaciteit", hjust = 0, size = 3) ggsave("results/sims_spaghettileisure70_ICU20_reprratio.tiff", units = "mm", width = 180, height = 120, dpi = 150) figuredata %>% filter(time >= 25 & time < 250 & kleur == "huidige pakket") %>% mutate( R0 = Rstarts[repl], control = eigenvalues[repl], lambda = doublings[repl]) %>% # filter(kleur == "geen bestrijding") %>% # group_by(tijd, kleur) %>% ggplot(aes(x = tijd, y = ICUbezetting, group = repl, color = control)) + geom_line(size = 0.1) + theme_light() + labs(x = "Dag", y = "Aantal bezette IC-plaatsen") + # scale_x_date(date_labels = "%d-%m") + # scale_x_date(date_breaks = "1 week", date_labels = "%d-%m") + scale_y_continuous(limits = c(0,5000)) + scale_color_gradient2(name = "Contact\nreduction", midpoint = 0.469, low = "blue", high = "red") + # guides(color = guide_legend(override.aes = list(size = 1))) + # facet_wrap(~ maatregelen, ncol = 1) + geom_hline(aes(yintercept = 1208), color = "black", linetype = "dashed") + annotate(geom = "text", x = as.Date("2020-03-07"), y = 1300, label = "Nederlandse IC-capaciteit", hjust = 0, size = 3) ggsave("results/sims_spaghettileisure70_ICU20_control.tiff", units = "mm", width = 180, height = 120, dpi = 150) median(eigenvalues) distsdata <- allsimulsummaries[[1]] distsdata %>% # filter(scenario %in% c("zonder bestrijding", "doorgaan met huidige pakket")) %>% ggplot(aes(x = agecat, y = immuniteit, fill = scenario)) + geom_col(position = position_dodge()) ggsave("results/sims_packhqlock_immunity.tiff", units = "mm", width = 180, height = 120, dpi = 150) distsdata %>% # filter(scenario %in% c("zonder bestrijding", "doorgaan met huidige pakket")) %>% ggplot(aes(x = agecat, y = ICopnames, fill = scenario)) + geom_col(position = position_dodge()) ggsave("results/sims_packhqlock_ICU.tiff", units = "mm", width = 180, height = 120, dpi = 150) figuredata %>% filter(time >= 25 & time < 250) %>% group_by(tijd, kleur) %>% summarise( lowerbound = quantile(ICUbezetting, .025), upperbound = quantile(ICUbezetting, .975), midbound = median(ICUbezetting) ) %>% ungroup() %>% ggplot(aes(x = tijd, y = midbound, color = kleur)) + geom_line(size = 2) + geom_ribbon(aes(ymin = lowerbound, ymax = upperbound, fill = kleur), alpha = 0.5) + theme_light() + labs(x = "Dag", y = "Aantal bezette IC-plaatsen") + # scale_x_date(date_labels = "%d-%m") + # scale_x_date(date_breaks = "1 week", date_labels = "%d-%m") + coord_cartesian(ylim = c(0,5000)) + # guides(color = guide_legend(override.aes = list(size = 1))) + # facet_wrap(~ maatregelen, ncol = 1) + geom_hline(aes(yintercept = 1208), color = "black", linetype = "dashed") + annotate(geom = "text", x = as.Date("2020-03-07"), y = 1300, label = "Nederlandse IC-capaciteit", hjust = 0, size = 3) figuredata %>% filter(time >= 25 & time < 250) %>% group_by(kleur, repl) %>% mutate(maxIC = max(ICUbezetting)) %>% group_by(tijd, kleur) %>% mutate(ICpct = dense_rank(maxIC)) %>% filter(ICpct %in% c(seq(50,950,50))) %>% ungroup() %>% mutate(repl = repl + 1000 * (kleur == "huidige pakket")) %>% ggplot(aes(x = tijd, y = ICUbezetting, color = kleur, group = repl)) + geom_line(size = 1) + theme_light() + labs(x = "Dag", y = "Aantal bezette IC-plaatsen") + # scale_x_date(date_labels = "%d-%m") + # scale_x_date(date_breaks = "1 week", date_labels = "%d-%m") + coord_cartesian(ylim = c(0,5000)) + # guides(color = guide_legend(override.aes = list(size = 1))) + # facet_wrap(~ maatregelen, ncol = 1) + geom_hline(aes(yintercept = 1208), color = "black", linetype = "dashed") + annotate(geom = "text", x = as.Date("2020-03-07"), y = 1300, label = "Nederlandse IC-capaciteit", hjust = 0, size = 3) figuredata %>% filter(time >= 25 & time < 250) %>% group_by(kleur, repl) %>% mutate(maxIC = max(ICUbezetting)) %>% group_by(tijd, kleur) %>% mutate(ICpct = dense_rank(maxIC)) %>% filter(ICpct %in% c(seq(50,950,50))) %>% filter(kleur == "huidige pakket") %>% ungroup() %>% select(ICpct, maxIC) %>% distinct() %>% arrange(ICpct)