Skip to content
Snippets Groups Projects
Commit 1a7f35af authored by pqiao29's avatar pqiao29
Browse files

Merge branch 'master' of https://gitlab.svi.edu.au/biocellgen-private/sirplus

parents 7353bd03 72145883
No related branches found
No related tags found
No related merge requests found
Pipeline #3281 passed
Stage: deploy
Hide whitespace changes
Inline Side-by-side
R/FIN_plot.R
+ 47
− 18
View file @ 1a7f35af
......@@ -17,8 +17,8 @@
#' @param start_date Date for day 0. Default: ymd("2020-03-21"),
#' @param show_start_date First date to show in plots. Use ymd format. If FALSE,
#' shows from step 1. Default: FALSE
#' @param x_axis Title for x-axis. Default: 'Days since beginning of epidemic'
#' @param plot_title Title for whole plot. Default: 'SEIQHRF plot'
#' @param x_axis Title for x-axis. Default: 'Date (MM-DD)'
#' @param plot_title Title for whole plot. Default: ''
#' @param market.share between 0 and 1, percentage of local hospital beds in
#' the simulated unit (e.g. state)
#' @param icu_percent between 0 and 1, percentage of patients that should go to
......@@ -45,8 +45,8 @@ plot.seiqhrf <- function(x, method = NULL,
known = NULL,
start_date = ymd("2020-03-21"),
show_start_date = FALSE,
x_axis = 'Days since beginning of epidemic',
plot_title = 'SEIQHRF',
x_axis = 'Date (MM-DD)',
plot_title = '',
return_df = TRUE,
market.share = .04,
icu_percent = .1,
......@@ -61,7 +61,8 @@ plot.seiqhrf <- function(x, method = NULL,
known = known,
start_date = start_date,
x_axis = x_axis,
plot_title = plot_title)
plot_title = plot_title,
total_population = total_population)
}else if(method == "times"){
......@@ -97,8 +98,11 @@ plot.seiqhrf <- function(x, method = NULL,
#' @param known Dataframe with known compartment numbers to plot alongside
#' projections
#' @param start_date Date for day 0. Default: ymd("2020-03-21"),
#' @param x_axis Title for x-axis. Default: 'Days since beginning of epidemic'
#' @param plot_title Title for whole plot. Default: 'SEIQHRF plot'
#' @param x_axis Title for x-axis. Default: 'Date (MM-DD)'
#' @param plot_title Title for whole plot. Default: ''
#' @param total_population True population size, needed only if simulation size
#' is smaller than the true population size due to computational cost
#' etc.
#' @param ... Additional parameters
#'
#' @importFrom tidyr pivot_longer
......@@ -116,8 +120,9 @@ plot.list <- function(x, comp_remove = "none",
trans = FALSE,
known = NULL,
start_date = ymd("2020-03-21"),
x_axis = 'Days since beginning of epidemic',
plot_title = 'SEIQHRF', ...){
x_axis = 'Date (MM-DD)',
plot_title = '',
total_population = NULL, ...){
plot_sirplus(x, comp_remove = comp_remove,
time_limit = time_limit,
......@@ -127,7 +132,8 @@ plot.list <- function(x, comp_remove = "none",
known = known,
start_date = start_date,
x_axis = x_axis,
plot_title = plot_title)
plot_title = plot_title,
total_population = total_population)
}
......@@ -151,8 +157,10 @@ plot.list <- function(x, comp_remove = "none",
#' @param known Dataframe with known compartment numbers to plot alongside
#' projections
#' @param start_date Date for day 0. Default: ymd("2020-03-21"),
#' @param x_axis Title for x-axis. Default: 'Days since beginning of epidemic'
#' @param plot_title Title for whole plot. Default: 'SEIQHRF plot'
#' @param x_axis Title for x-axis. Default: 'Date (MM-DD)'
#' @param plot_title Title for whole plot. Default: ''
#' @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
#'
#' @return ggplot2 object
......@@ -172,7 +180,8 @@ plot_sirplus <- function(x, comp_remove,
known,
start_date,
x_axis,
plot_title, ...){
plot_title,
total_population,...){
# Convert from seiqhrf object to dataframe
plot_df <- format_sims(x, time_limit = time_limit, start_date = start_date)
......@@ -183,6 +192,23 @@ plot_sirplus <- function(x, comp_remove,
plot_df <- get_ci(x, plot_df)
}
# 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)
stop("total population should be larger than simulated size")
scale_factor <- total_population/max_sim_pop
plot_df <- plot_df %>% mutate(count = count * scale_factor)
if(ci){
plot_df <- plot_df %>% mutate(CI.1 = count * scale_factor,
CI.2 = CI.2 * scale_factor,
qntCI.1 = qntCI.1 * scale_factor,
qntCI.2 = qntCI.2 * scale_factor)
}
}
# Add known compartment counts
if(is.data.frame(known)){
plot_df <- add_known(plot_df, known = known, start_date = start_date)
......@@ -198,11 +224,13 @@ plot_sirplus <- function(x, comp_remove,
h.num = "H: Hospitalized", r.num = "R: Recovered",
f.num = "F: Case Fatalities")
# Filter compartments
comp_plot <- setdiff(comps, comp_remove)
plot_df <- plot_df %>% filter(compartment %in% c(comp_plot)) %>%
filter(time <= time_limit)
# Plot with options
p <- ggplot(plot_df, aes(x = Date, y = count, colour = compartment,
linetype = sim)) +
......@@ -380,10 +408,11 @@ get_weekly_local <- function(sim,
pivot_wider(names_from = metric, values_from = val)
p <- ggplot(hosp.wk2, aes(x = yr_wk, y = num, color = type)) +
geom_point() + theme_bw() +
labs(y="Weekly Cumulative Count", x = "Week (Monday)") +
geom_errorbar(aes(ymin=ci5, ymax=ci95),size=0.5, width=.25) +
scale_fill_discrete(name = "Type", labels = c("General", "ICU"))
geom_point() +
labs(y="Weekly Cumulative Count", x = "Week Start (Monday: YYYY-MM-DD)") +
geom_errorbar(aes(ymin=ci5, ymax=ci95), size=0.5, width=.25) +
scale_color_discrete(name = "Type", labels = c("General", "ICU")) +
theme_bw() + theme(axis.text.x = element_text(angle = 90))
return(list("plot" = p, "result" = hosp.wk))
......
man/plot.list.Rd
+ 9
− 4
View file @ 1a7f35af
......@@ -13,8 +13,9 @@
trans = FALSE,
known = NULL,
start_date = ymd("2020-03-21"),
x_axis = "Days since beginning of epidemic",
plot_title = "SEIQHRF",
x_axis = "Date (MM-DD)",
plot_title = "",
total_population = NULL,
...
)
}
......@@ -37,9 +38,13 @@ projections}
\item{start_date}{Date for day 0. Default: ymd("2020-03-21"),}
\item{x_axis}{Title for x-axis. Default: 'Days since beginning of epidemic'}
\item{x_axis}{Title for x-axis. Default: 'Date (MM-DD)'}
\item{plot_title}{Title for whole plot. Default: 'SEIQHRF plot'}
\item{plot_title}{Title for whole plot. Default: ''}
\item{total_population}{True population size, needed only if simulation size
is smaller than the true population size due to computational cost
etc.}
\item{...}{Additional parameters}
}
......
man/plot.seiqhrf.Rd
+ 4
− 4
View file @ 1a7f35af
......@@ -15,8 +15,8 @@
known = NULL,
start_date = ymd("2020-03-21"),
show_start_date = FALSE,
x_axis = "Days since beginning of epidemic",
plot_title = "SEIQHRF",
x_axis = "Date (MM-DD)",
plot_title = "",
return_df = TRUE,
market.share = 0.04,
icu_percent = 0.1,
......@@ -50,9 +50,9 @@ projections}
\item{show_start_date}{First date to show in plots. Use ymd format. If FALSE,
shows from step 1. Default: FALSE}
\item{x_axis}{Title for x-axis. Default: 'Days since beginning of epidemic'}
\item{x_axis}{Title for x-axis. Default: 'Date (MM-DD)'}
\item{plot_title}{Title for whole plot. Default: 'SEIQHRF plot'}
\item{plot_title}{Title for whole plot. Default: ''}
\item{return_df}{In effect only when method == "weekly", if TRUE returns
also the dataframe used for plotting as well as the ggplot object.}
......
man/plot_sirplus.Rd
+ 6
− 2
View file @ 1a7f35af
......@@ -15,6 +15,7 @@ plot_sirplus(
start_date,
x_axis,
plot_title,
total_population,
...
)
}
......@@ -38,9 +39,12 @@ projections}
\item{start_date}{Date for day 0. Default: ymd("2020-03-21"),}
\item{x_axis}{Title for x-axis. Default: 'Days since beginning of epidemic'}
\item{x_axis}{Title for x-axis. Default: 'Date (MM-DD)'}
\item{plot_title}{Title for whole plot. Default: 'SEIQHRF plot'}
\item{plot_title}{Title for whole plot. Default: ''}
\item{total_population}{True population size, needed only if simulation size
is smaller than the true population size due to computational cost}
\item{...}{Additional parameters}
}
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment