Skip to content

Commit

Permalink
Updating intervention parameters
Browse files Browse the repository at this point in the history
  • Loading branch information
@derekmeyer37
derekmeyer37 committed May 13, 2024
1 parent 2d85353 commit d68ccff
Show file tree
Hide file tree
Showing 14 changed files with 138 additions and 82 deletions.
41 changes: 24 additions & 17 deletions R/functions-npi.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,20 +22,20 @@
#' @family npis
npi_add_vaccine <- function(
model, preval,
susceptibility_reduction = .9,
transmission_reduction = .5,
recovery_enhancer = .5,
death_reduction = .9
sus_red,
trans_red,
rec_enhan,
death_red
) {

if (preval > 0) {

tool_ <- epiworldR::tool(
name = "Vaccine",
susceptibility_reduction = susceptibility_reduction,
transmission_reduction = transmission_reduction,
recovery_enhancer = recovery_enhancer,
death_reduction = death_reduction
susceptibility_reduction = sus_red,
transmission_reduction = trans_red,
recovery_enhancer = rec_enhan,
death_reduction = death_red
)

epiworldR::add_tool(
Expand All @@ -62,14 +62,14 @@ npi_add_vaccine <- function(
#' npi_add_masking(model, preval = .8)
#' @export
#' @family npis
npi_add_masking <- function(model, preval) {
npi_add_masking <- function(model, preval, trans_red) {

if (preval > 0) {

tool_ <- epiworldR::tool(
name = "Masking",
susceptibility_reduction = 0,
transmission_reduction = 0.5,
transmission_reduction = trans_red,
recovery_enhancer = 0,
death_reduction = 0
)
Expand Down Expand Up @@ -100,15 +100,16 @@ npi_add_masking <- function(model, preval) {
#' npi_add_school_closure(model, preval = .8, day = 10)
#' @export
#' @family npis
npi_add_school_closure <- function(model, preval, day, reduction = 0.9) {
npi_add_school_closure <- function(model, preval, day,
trans_red) {

if (preval > 0) {

# Creating a tool
tool_ <- epiworldR::tool(
name = "School Closure",
susceptibility_reduction = 0,
transmission_reduction = reduction,
transmission_reduction = trans_red,
recovery_enhancer = 0,
death_reduction = 0
)
Expand Down Expand Up @@ -141,18 +142,24 @@ npi_add_all <- function(model, modelname, input) {

npi_add_vaccine(
model = model,
preval = input[[paste0(modelname, "_vaccine_prevalence")]]
preval = input[[paste0(modelname, "_vaccine_prevalence")]],
sus_red = input[[paste0(modelname, "_vaccine_susceptibility_reduction")]],
trans_red = input[[paste0(modelname, "_vaccine_transmission_reduction")]],
rec_enhan = input[[paste0(modelname, "_vaccine_recovery_enhancer")]],
death_red = input[[paste0(modelname, "_vaccine_death_reduction")]]
)

npi_add_masking(
model = model,
preval = input[[paste0(modelname, "_masking_prevalence")]]
preval = input[[paste0(modelname, "_masking_prevalence")]],
trans_red = input[[paste0(modelname, "_masking_transmission_reduction")]]
)

npi_add_school_closure(
model = model,
preval = input[[paste0(modelname, "_school_closure_prevalence")]],
day = input[[paste0(modelname, "_school_closure_day")]]
model = model,
preval = input[[paste0(modelname, "_school_closure_prevalence")]],
day = input[[paste0(modelname, "_school_closure_day")]],
trans_red = input[[paste0(modelname, "_school_closure_transmission_reduction")]]
)

}
60 changes: 58 additions & 2 deletions R/functions-ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -184,6 +184,7 @@ npis_input <- function(model_name) {
href = "https://uofuepibio.github.io/epiworldRShiny/reference/index.html"),
"."
),
shiny::headerPanel(shiny::h4("Vaccination")),
shiny::sliderInput(
inputId = paste0(model_name, "_vaccine_prevalence"),
label = "% of agents vaccinated",
Expand All @@ -193,6 +194,43 @@ npis_input <- function(model_name) {
step = 0.01,
ticks = FALSE
),
shiny::sliderInput(
inputId = paste0(model_name, "_vaccine_susceptibility_reduction"),
label = "probability reduction of susceptibility",
min = 0,
max = 1,
value = 0,
step = 0.01,
ticks = FALSE
),
shiny::sliderInput(
inputId = paste0(model_name, "_vaccine_transmission_reduction"),
label = "probability reduction of transmission",
min = 0,
max = 1,
value = 0,
step = 0.01,
ticks = FALSE
),
shiny::sliderInput(
inputId = paste0(model_name, "_vaccine_recovery_enhancer"),
label = "probability increase of recovery",
min = 0,
max = 1,
value = 0,
step = 0.01,
ticks = FALSE
),
shiny::sliderInput(
inputId = paste0(model_name, "_vaccine_death_reduction"),
label = "probability reduction of death",
min = 0,
max = 1,
value = 0,
step = 0.01,
ticks = FALSE
),
shiny::headerPanel(shiny::h4("Masking")),
shiny::sliderInput(
inputId = paste0(model_name, "_masking_prevalence"),
label = "% of agents using masks",
Expand All @@ -202,10 +240,19 @@ npis_input <- function(model_name) {
step = 0.01,
ticks = FALSE
),
shiny::sliderInput(
inputId = paste0(model_name, "_masking_transmission_reduction"),
label = "probability reduction of transmission",
value = "0",
min = 0,
max = 1,
step = 0.01,
ticks = FALSE
),
shiny::headerPanel(shiny::h4("School Closure")),
shiny::sliderInput(
inputId = paste0(model_name, "_school_closure_prevalence"),
label = "Prevalence",
label = "prevalence",
value = "0",
min = 0,
max = 1,
Expand All @@ -214,11 +261,20 @@ npis_input <- function(model_name) {
),
shiny::numericInput(
inputId = paste0(model_name, "_school_closure_day"),
label = "Implementation day",
label = "implementation day",
value = "0",
min = 0,
max = 100,
step = 1
),
shiny::sliderInput(
inputId = paste0(model_name, "_school_closure_transmission_reduction"),
label = "probability reduction of transmission",
value = "0",
min = 0,
max = 1,
step = 0.01,
ticks = FALSE
)
)
)
Expand Down
4 changes: 2 additions & 2 deletions inst/models/shiny_seir.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -94,8 +94,8 @@ seir_panel <- function(model_alt) {
),
numeric_input_ndays("seir"),
seed_input("seir"),
simulate_button("seir"),
network_input("seir"),
npis_input("seir")
npis_input("seir"),
simulate_button("seir")
)
}
4 changes: 2 additions & 2 deletions inst/models/shiny_seirconn.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -74,8 +74,8 @@ seirconn_panel <- function(model_alt) {
),
numeric_input_ndays("seirconn"),
seed_input("seirconn"),
simulate_button("seirconn"),
npis_input("seirconn")
npis_input("seirconn"),
simulate_button("seirconn")
)
}

4 changes: 2 additions & 2 deletions inst/models/shiny_seirconnequity.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -193,9 +193,9 @@ seirconnequity_panel <- function(model_alt) {
),
numeric_input_ndays("seirconnequity"),
seed_input("seirconnequity"),
simulate_button("seirconnequity"),
population_input("seirconnequity"),
npis_input("seirconnequity")
npis_input("seirconnequity"),
simulate_button("seirconnequity")
)

}
4 changes: 2 additions & 2 deletions inst/models/shiny_seird.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -88,8 +88,8 @@ seird_panel <- function(model_alt) {
),
numeric_input_ndays("seird"),
seed_input("seird"),
simulate_button("seird"),
network_input("seird"),
npis_input("seird")
npis_input("seird"),
simulate_button("seird")
)
}
4 changes: 2 additions & 2 deletions inst/models/shiny_sir.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -64,9 +64,9 @@ sir_panel <- function(model_alt) {
slider_input_rate("sir", "Recovery probability (daily)", "0.14", input_label = "recovery_rate"),
numeric_input_ndays("sir"),
seed_input("sir"),
simulate_button("sir"),
network_input("sir"),
npis_input("sir")
npis_input("sir"),
simulate_button("sir")
)

}
24 changes: 12 additions & 12 deletions inst/models/shiny_sirconn.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,32 +6,32 @@ shiny_sirconn <- function(input) {
prevalence = input$sirconn_prevalence,
transmission_rate = input$sirconn_transmission_rate,
recovery_rate = input$sirconn_recovery_rate,
contact_rate = input$sirconn_contact_rate,
contact_rate = input$sirconn_contact_rate,
n = input$sirconn_population_size
)

# NPIs -----------------------------------------------------------------------
npi_add_all(model_sirconn, "sirconn", input)

# Running and printing
epiworldR::verbose_off(model_sirconn)
epiworldR::run(model_sirconn, ndays = input$sirconn_n_days, seed = input$sirconn_seed)

# Plot, summary, and reproductive number
plot_sirconn <- function() plot_epi(model_sirconn)
summary_sirconn <- function() summary(model_sirconn)
reproductive_sirconn <- function() plot_reproductive_epi(model_sirconn)
# Table
# Table
table_sirconn <- function() {
df <- as.data.frame(epiworldR::get_hist_total(model_sirconn))
# Subset to only include "infection" state
infection_data <- df[df$state == "Infected", ]
# Row with the maximum count
max_infection_row <- infection_data[which.max(infection_data$count), ]
# Row number of the maximum count in the original data frame
max_row_number <- which(df$date == max_infection_row$date &
max_row_number <- which(df$date == max_infection_row$date &
df$state == "Infected")
df[max_row_number,] <- sprintf("<strong>%s</strong>",
df[max_row_number,] <- sprintf("<strong>%s</strong>",
df[max_row_number,])
df
}
Expand All @@ -57,16 +57,16 @@ sirconn_panel <- function(model_alt) {
shiny::sliderInput(
inputId = "sirconn_population_size",
label = "Population Size",
min = 0,
max = 100000,
value = 50000,
min = 0,
max = 100000,
value = 50000,
step = 1000,
ticks = FALSE
),
numeric_input_ndays("sirconn"),
seed_input("sirconn"),
simulate_button("sirconn"),
npis_input("sirconn")
npis_input("sirconn"),
simulate_button("sirconn")
)
}

16 changes: 8 additions & 8 deletions inst/models/shiny_sird.R
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
# alt-name: Network SIRD

shiny_sird <- function(input) {

# Creating model
model_sird <- epiworldR::ModelSIRD(
name = input$sird_disease_name,
Expand All @@ -18,8 +18,8 @@ shiny_sird <- function(input) {
k = input$sird_k,
d = as.logical(input$sird_directed),
p = input$sird_prob_rewiring
)
)

# NPIs -----------------------------------------------------------------------
npi_add_all(model_sird, "sird", input)

Expand All @@ -31,17 +31,17 @@ shiny_sird <- function(input) {
plot_sird <- function() plot_epi(model_sird)
summary_sird <- function() summary(model_sird)
reproductive_sird <- function() plot_reproductive_epi(model_sird)
# Table
# Table
table_sird <- function() {
df <- as.data.frame(epiworldR::get_hist_total(model_sird))
# Subset to only include "infection" state
infection_data <- df[df$state == "Infected", ]
# Row with the maximum count
max_infection_row <- infection_data[which.max(infection_data$count), ]
# Row number of the maximum count in the original data frame
max_row_number <- which(df$date == max_infection_row$date &
max_row_number <- which(df$date == max_infection_row$date &
df$state == "Infected")
df[max_row_number,] <- sprintf("<strong>%s</strong>",
df[max_row_number,] <- sprintf("<strong>%s</strong>",
df[max_row_number,])
df
}
Expand All @@ -67,9 +67,9 @@ sird_panel <- function(model_alt) {
slider_input_rate("sird", "Probability of death (daily)", 0.01, input_label = "death_rate"),
numeric_input_ndays("sird"),
seed_input("sird"),
simulate_button("sird"),
network_input("sird"),
npis_input("sird")
npis_input("sird"),
simulate_button("sird")
)

}
Expand Down
Loading

0 comments on commit d68ccff

Please sign in to comment.