Skip to content
Snippets Groups Projects
Commit ec216d8b authored by Christina Azodi's avatar Christina Azodi
Browse files

fix error with how pop_scaling is done in hosp plots

parent 3aba95b2
No related branches found
No related tags found
No related merge requests found
Pipeline #3286 passed
......@@ -23,6 +23,8 @@
#' the simulated unit (e.g. state)
#' @param icu_percent between 0 and 1, percentage of patients that should go to
#' ICU among the ones that need hospitalization
#' @param sim_population Size of population simulated. Only needed if providing
#' `total_population`.
#' @param total_population True population size, needed only if simulation size
#' is smaller than the true population size due to computational cost
#' etc.
......@@ -50,6 +52,7 @@ plot.seiqhrf <- function(x, method = NULL,
return_df = TRUE,
market.share = .04,
icu_percent = .1,
sim_population = 1000,
total_population = NULL, ...) {
if(is.null(method)){
......@@ -62,6 +65,7 @@ plot.seiqhrf <- function(x, method = NULL,
start_date = start_date,
x_axis = x_axis,
plot_title = plot_title,
sim_population = sim_population,
total_population = total_population)
}else if(method == "times"){
......@@ -77,6 +81,7 @@ plot.seiqhrf <- function(x, method = NULL,
start_date = start_date,
show_start_date = show_start_date,
time_limit = time_limit,
sim_population = sim_population,
total_population = total_population)
if(return_df){
return(ret)
......@@ -100,6 +105,9 @@ plot.seiqhrf <- function(x, method = NULL,
#' @param start_date Date for day 0. Default: ymd("2020-03-21"),
#' @param x_axis Title for x-axis. Default: 'Date (MM-DD)'
#' @param plot_title Title for whole plot. Default: ''
#' total_population
#' @param sim_population Size of population simulated. Only needed if providing
#' `total_population`.
#' @param total_population True population size, needed only if simulation size
#' is smaller than the true population size due to computational cost
#' etc.
......@@ -122,6 +130,7 @@ plot.list <- function(x, comp_remove = "none",
start_date = ymd("2020-03-21"),
x_axis = 'Date (MM-DD)',
plot_title = '',
sim_population = 1000,
total_population = NULL, ...){
plot_sirplus(x, comp_remove = comp_remove,
......@@ -133,6 +142,7 @@ plot.list <- function(x, comp_remove = "none",
start_date = start_date,
x_axis = x_axis,
plot_title = plot_title,
sim_population = sim_population,
total_population = total_population)
}
......@@ -159,6 +169,8 @@ plot.list <- function(x, comp_remove = "none",
#' @param start_date Date for day 0. Default: ymd("2020-03-21"),
#' @param x_axis Title for x-axis. Default: 'Date (MM-DD)'
#' @param plot_title Title for whole plot. Default: ''
#' @param sim_population Size of population simulated. Only needed if providing
#' `total_population`.
#' @param total_population True population size, needed only if simulation size
#' is smaller than the true population size due to computational cost
#' @param ... Additional parameters
......@@ -181,6 +193,7 @@ plot_sirplus <- function(x, comp_remove,
start_date,
x_axis,
plot_title,
sim_population,
total_population,...){
# Convert from seiqhrf object to dataframe
......@@ -194,11 +207,10 @@ plot_sirplus <- function(x, comp_remove,
# Scale up to full population size if needed
if(!is.null(total_population)){
max_sim_pop <- max(subset(plot_df, compartment == 's.num')$count)
if(total_population < max_sim_pop)
if(total_population < s.num)
stop("total population should be larger than simulated size")
scale_factor <- total_population/max_sim_pop
scale_factor <- total_population/s.num
plot_df <- plot_df %>% mutate(count = count * scale_factor)
if(ci){
......@@ -336,6 +348,8 @@ plot_times <- function(sim) {
#' @param show_start_date First date to show in plots. Use ymd format. If FALSE,
#' shows from step 1. Default: FALSE
#' @param time_limit Number of days to include. Default = 90.
#' @param sim_population Size of population simulated. Only needed if providing
#' `total_population`.
#' @param total_population True population size, needed only if simulation size
#' is smaller than the true population size due to computational cost
#' etc.
......@@ -361,6 +375,7 @@ get_weekly_local <- function(sim,
start_date = start_date,
show_start_date = show_start_date,
time_limit = time_limit,
sim_population = sim_population,
total_population = total_population){
# Get h.num and 95% quantile CIs
......@@ -378,10 +393,14 @@ get_weekly_local <- function(sim,
# Scale for population size and hospital market share if needed
if(!is.null(total_population)){
if(total_population < max(sim_mean$s.num))
if(total_population < sim_population)
stop("total Population should be larger than simulated size")
cat("Scalling w.r.t total population")
hosp <- hosp*total_population/max(sim_mean$s.num)
date_tmp <- hosp$date
hosp$date <- NULL
print(head(hosp))
hosp <- hosp*total_population/sim_population
hosp$date <- date_tmp
}
if(market.share < 0 || market.share > 1) stop("Market share has to be between
......
......@@ -11,6 +11,7 @@ get_weekly_local(
start_date = start_date,
show_start_date = show_start_date,
time_limit = time_limit,
sim_population = sim_population,
total_population = total_population
)
}
......@@ -32,6 +33,9 @@ shows from step 1. Default: FALSE}
\item{time_limit}{Number of days to include. Default = 90.}
\item{sim_population}{Size of population simulated. Only needed if providing
`total_population`.}
\item{total_population}{True population size, needed only if simulation size
is smaller than the true population size due to computational cost
etc.}
......
......@@ -15,6 +15,7 @@
start_date = ymd("2020-03-21"),
x_axis = "Date (MM-DD)",
plot_title = "",
sim_population = 1000,
total_population = NULL,
...
)
......@@ -40,7 +41,11 @@ projections}
\item{x_axis}{Title for x-axis. Default: 'Date (MM-DD)'}
\item{plot_title}{Title for whole plot. Default: ''}
\item{plot_title}{Title for whole plot. Default: ''
total_population}
\item{sim_population}{Size of population simulated. Only needed if providing
`total_population`.}
\item{total_population}{True population size, needed only if simulation size
is smaller than the true population size due to computational cost
......
......@@ -20,6 +20,7 @@
return_df = TRUE,
market.share = 0.04,
icu_percent = 0.1,
sim_population = 1000,
total_population = NULL,
...
)
......@@ -63,6 +64,9 @@ the simulated unit (e.g. state)}
\item{icu_percent}{between 0 and 1, percentage of patients that should go to
ICU among the ones that need hospitalization}
\item{sim_population}{Size of population simulated. Only needed if providing
`total_population`.}
\item{total_population}{True population size, needed only if simulation size
is smaller than the true population size due to computational cost
etc.}
......
......@@ -15,6 +15,7 @@ plot_sirplus(
start_date,
x_axis,
plot_title,
sim_population,
total_population,
...
)
......@@ -43,6 +44,9 @@ projections}
\item{plot_title}{Title for whole plot. Default: ''}
\item{sim_population}{Size of population simulated. Only needed if providing
`total_population`.}
\item{total_population}{True population size, needed only if simulation size
is smaller than the true population size due to computational cost}
......
......@@ -77,6 +77,7 @@ s.num <- 2000 # number susceptible
i.num <- 15 # number infected
q.num <- 5 # number in self-isolation
h.num <- 1 # number in the hospital
sim_population <- s.num + i.num + q.num + h.num
nsteps <- 90 # number of steps (e.g. days) to simulate
control <- control_seiqhrf(nsteps = nsteps)
......@@ -226,11 +227,15 @@ This function takes the following input:
- `total_population`: True population size. This parameter is only needed if
the simulation size (s.num) was smaller than the true population size (i.e.
scaled down) to reduce computational cost.
- `sim_population`: Size of simulation population. Only needed if providing
`total_population`.
```{r hospital visualization}
plot(baseline_sim, method = "weekly_local",
time_lim = 40,
start_date = ymd("2020-01-01"),
show_start_date = ymd("2020-01-06"),
total_population = 40000,
sim_population = sim_population,
return_df = TRUE)
```
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment