## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
## ----eval = FALSE-------------------------------------------------------------
# devtools::install_github("epiverse-trace/epidemics")
# devtools::install_github("nicholasdavies/overshiny")
## ----eval=FALSE---------------------------------------------------------------
# library(epidemics)
# library(ggplot2)
#
# # Model run function
# run_model <- function()
# {
# # Build parameters
# I0 <- 0.001
# pop_size <- 1000000
#
# # Build population
# pop <- population(
# name = "Utopia",
# contact_matrix = matrix(1),
# demography_vector = 1000000,
# initial_conditions = matrix(c(1 - I0, 0, I0, 0, 0), nrow = 1)
# )
#
# # Run model
# results <- model_default(pop)
#
# return (results)
# }
#
## ----eval=FALSE---------------------------------------------------------------
# results <- run_model()
# results <- results[results$compartment == "infectious", ]
# ggplot(results) +
# geom_line(aes(x = time, y = value)) +
# labs(x = NULL, y = "Infection prevalence")
## ----eval=FALSE---------------------------------------------------------------
# input <- list(
# # Start and end dates of the epidemic
# date_range = as.Date(c("2025-01-01", "2025-12-31")),
# # Population size in millions
# pop_size = 59
# # Percentage (not proportion) of the population initially infected
# init_infec = 0.1,
# # Duration of latent period in days
# latent_pd = 2,
# # Duration of infectious period in days
# infec_pd = 7,
# # Basic reproduction number
# R0 = 1.3,
# )
## ----eval=FALSE---------------------------------------------------------------
# # Model run function
# run_model <- function(input)
# {
# # Transform parameters
# I0 <- input$init_infec / 100; # Percent to proportion
# duration <- as.numeric(input$date_range[2] - input$date_range[1]) # Dates to duration
# infec_rate <- 1 / input$latent_pd # Latent period to infectiousness rate
# recov_rate <- 1 / input$infec_pd # Infectious period to recovery rate
# trans_rate <- input$R0 * recov_rate # R0 to transmission rate (R_0 = beta / gamma)
#
# # Build population
# pop <- population(
# name = "Utopia",
# contact_matrix = matrix(1),
# demography_vector = input$pop_size * 1000000, # Population size in millions
# initial_conditions = matrix(c(1 - I0, 0, I0, 0, 0), nrow = 1)
# )
#
# # Run model
# results <- model_default(pop, transmission_rate = trans_rate,
# infectiousness_rate = infec_rate, recovery_rate = recov_rate,
# time_end = duration)
#
# return (results)
# }
## ----eval = FALSE-------------------------------------------------------------
# library(epidemics)
# library(shiny)
#
# # --- User interface ---
# ui <- fluidPage(
# titlePanel("SEIRV model with interventions"),
#
# # 3 columns of inputs
# fluidRow(
# column(4,
# # Basic epidemic settings
# h3("Epidemic")
# ),
#
# column(4,
# # Pathogen settings
# h3("Pathogen")
# ),
#
# column(4,
# # Intervention settings
# h3("Interventions")
# )
# )
# )
#
# # --- App logic ---
# server <- function(input, output)
# {
# }
#
# # --- Run app ---
# shinyApp(ui, server)
## ----eval = FALSE-------------------------------------------------------------
# # --- User interface ---
# ui <- fluidPage(
# ...
# )
## ----eval = FALSE-------------------------------------------------------------
# fluidRow(
# column(4, "part one"),
# column(4, "part two"),
# column(4, "part three")
# )
## ----eval = FALSE-------------------------------------------------------------
# # --- User interface ---
# ui <- fluidPage(
# titlePanel("SEIRV model with interventions"),
#
# # 3 columns of inputs
# fluidRow(
# column(4,
# # Basic epidemic settings
# h3("Epidemic")
# ),
#
# column(4,
# # Pathogen settings
# h3("Pathogen")
# ),
#
# column(4,
# # Intervention settings
# h3("Interventions")
# )
# )
# )
## ----eval = FALSE-------------------------------------------------------------
# library(epidemics)
# library(shiny)
#
# # --- User interface ---
# ui <- fluidPage(
# titlePanel("SEIRV model with interventions"),
#
# # 3 columns of inputs
# fluidRow(
# column(4,
# # Basic epidemic settings
# h3("Epidemic"),
# dateRangeInput("date_range", "Date range", start = "2025-01-01", end = "2025-12-31"),
# numericInput("pop_size", "Population size (millions)", value = 59, min = 1),
# sliderInput("init_infec", "Initial proportion infectious (%)", value = 0.1, min = 0, max = 1, step = 0.01)
# ),
#
# column(4,
# # Pathogen settings
# h3("Pathogen"),
# sliderInput("R0", HTML("Basic reproduction number, R0"),
# value = 1.3, min = 0, max = 5, step = 0.05),
# sliderInput("latent_pd", "Latent period (days)", value = 2, min = 1, max = 7, step = 0.1),
# sliderInput("infec_pd", "Infectious period (days)", value = 7, min = 1, max = 10, step = 0.1)
# ),
#
# column(4,
# # Overlay controls: tokens that can be dragged onto the plot
# h3("Interventions")
# )
# )
# )
#
# # --- App logic ---
# server <- function(input, output)
# {
# }
#
# # --- Run app ---
# shinyApp(ui, server)
## ----eval = FALSE-------------------------------------------------------------
# library(shiny)
# library(ggplot2)
# library(epidemics)
#
# # Model run function
# run_model <- function(input)
# {
# # Transform parameters
# I0 <- input$init_infec / 100; # Percent to proportion
# duration <- as.numeric(input$date_range[2] - input$date_range[1]) # Dates to duration
# infec_rate <- 1 / input$latent_pd # Latent period to infectiousness rate
# recov_rate <- 1 / input$infec_pd # Infectious period to recovery rate
# trans_rate <- input$R0 * recov_rate # R0 to transmission rate (R_0 = beta / gamma)
#
# # Build population
# pop <- population(
# name = "Utopia",
# contact_matrix = matrix(1),
# demography_vector = input$pop_size * 1000000, # Population size in millions
# initial_conditions = matrix(c(1 - I0, 0, I0, 0, 0), nrow = 1)
# )
#
# # Run model
# results <- model_default(pop, transmission_rate = trans_rate,
# infectiousness_rate = infec_rate, recovery_rate = recov_rate,
# time_end = duration)
#
# return (results)
# }
## ----eval = FALSE-------------------------------------------------------------
# # --- User interface ---
# ui <- fluidPage(
# titlePanel("SEIRV model with interventions"),
#
# # NEW PART IS HERE:
# # Main plot
# plotOutput("display", width = "100%", height = 400),
# # END OF NEW PART
#
# # 3 columns of inputs
# fluidRow(
# column(4,
# # Basic epidemic settings
# h3("Epidemic"),
# dateRangeInput("date_range", "Date range", start = "2025-01-01", end = "2025-12-31"),
# numericInput("pop_size", "Population size (millions)", value = 59, min = 1),
# sliderInput("init_infec", "Initial proportion infectious (%)", value = 0.1, min = 0, max = 1, step = 0.01)
# ),
#
# column(4,
# # Pathogen settings
# h3("Pathogen"),
# sliderInput("R0", HTML("Basic reproduction number, R0"),
# value = 1.3, min = 0, max = 5, step = 0.05),
# sliderInput("latent_pd", "Latent period (days)", value = 2, min = 1, max = 7, step = 0.1),
# sliderInput("infec_pd", "Infectious period (days)", value = 7, min = 1, max = 10, step = 0.1)
# ),
#
# column(4,
# # Overlay controls: tokens that can be dragged onto the plot
# h3("Interventions")
# )
# )
# )
## ----eval=FALSE---------------------------------------------------------------
# # --- App logic ---
# server <- function(input, output)
# {
# output$display <- renderPlot({
# results <- run_model(input)
# results <- results[results$compartment == "infectious", ]
# ggplot(results) +
# geom_line(aes(x = time, y = value)) +
# labs(x = NULL, y = "Infection prevalence") +
# ylim(0, NA)
# })
# }
#
# # --- Run app ---
# shinyApp(ui, server)
## ----eval=FALSE---------------------------------------------------------------
# plotOutput("marmite", width = "100%", height = 400),
## ----eval=FALSE---------------------------------------------------------------
# ggplot(results) +
# geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
# labs(x = NULL, y = "Infection prevalence (thousands)") +
# ylim(0, NA)
## ----eval=FALSE---------------------------------------------------------------
# library(shiny)
# library(ggplot2)
# library(epidemics)
#
# # Model run function
# run_model <- function(input)
# {
# # Transform parameters
# I0 <- input$init_infec / 100; # Percent to proportion
# duration <- as.numeric(input$date_range[2] - input$date_range[1]) # Dates to duration
# infec_rate <- 1 / input$latent_pd # Latent period to infectiousness rate
# recov_rate <- 1 / input$infec_pd # Infectious period to recovery rate
# trans_rate <- input$R0 * recov_rate # R0 to transmission rate (R_0 = beta / gamma)
#
# # Build population
# pop <- population(
# name = "Utopia",
# contact_matrix = matrix(1),
# demography_vector = input$pop_size * 1000000, # Population size in millions
# initial_conditions = matrix(c(1 - I0, 0, I0, 0, 0), nrow = 1)
# )
#
# # Run model
# results <- model_default(pop, transmission_rate = trans_rate,
# infectiousness_rate = infec_rate, recovery_rate = recov_rate,
# time_end = duration)
#
# return (results)
# }
#
# # --- User interface ---
# ui <- fluidPage(
# titlePanel("SEIRV model with interventions"),
#
# # NEW PART IS HERE:
# # Main plot
# plotOutput("display", width = "100%", height = 400),
# # END OF NEW PART
#
# # 3 columns of inputs
# fluidRow(
# column(4,
# # Basic epidemic settings
# h3("Epidemic"),
# dateRangeInput("date_range", "Date range", start = "2025-01-01", end = "2025-12-31"),
# numericInput("pop_size", "Population size (millions)", value = 59, min = 1),
# sliderInput("init_infec", "Initial proportion infectious (%)", value = 0.1, min = 0, max = 1, step = 0.01)
# ),
#
# column(4,
# # Pathogen settings
# h3("Pathogen"),
# sliderInput("R0", HTML("Basic reproduction number, R0"),
# value = 1.3, min = 0, max = 5, step = 0.05),
# sliderInput("latent_pd", "Latent period (days)", value = 2, min = 1, max = 7, step = 0.1),
# sliderInput("infec_pd", "Infectious period (days)", value = 7, min = 1, max = 10, step = 0.1)
# ),
#
# column(4,
# # Overlay controls: tokens that can be dragged onto the plot
# h3("Interventions")
# )
# )
# )
#
# # --- App logic ---
# server <- function(input, output)
# {
# output$display <- renderPlot({
# results <- run_model(input)
# results <- results[results$compartment == "infectious", ]
# ggplot(results) +
# geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
# labs(x = NULL, y = "Infection prevalence (thousands)") +
# ylim(0, NA)
# })
# }
#
# # --- Run app ---
# shinyApp(ui, server)
## ----eval = FALSE-------------------------------------------------------------
# library(overshiny)
## ----eval = FALSE-------------------------------------------------------------
# # Main plot
# overlayPlotOutput("display", width = "100%", height = 400),
## ----eval = FALSE-------------------------------------------------------------
# column(4,
# # Overlay controls: tokens that can be dragged onto the plot
# h3("Interventions"),
# overlayToken("vx", "Vaccination"),
# overlayToken("tx", "Transmission")
# )
## ----eval = FALSE-------------------------------------------------------------
# # --- App logic ---
# server <- function(input, output)
# {
# # --- OVERLAY SETUP ---
#
# # Initialise 8 draggable/resizable overlays
# ov <- overlayServer("display", 8)
#
# # rest of code follows as normal...
## ----eval = FALSE-------------------------------------------------------------
# output$display <- renderPlot({
# results <- run_model(input)
# results <- results[results$compartment == "infectious", ]
# ggplot(results) +
# geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
# labs(x = NULL, y = "Infection prevalence (thousands)") +
# ylim(0, NA)
# })
#
## ----eval = FALSE-------------------------------------------------------------
# output$display <- renderPlot({
# results <- run_model(input)
# results <- results[results$compartment == "infectious", ]
# plot <- ggplot(results) +
# geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
# labs(x = NULL, y = "Infection prevalence (thousands)") +
# ylim(0, NA)
#
# overlayBounds(ov, plot, xlim = c(input$date_range), ylim = c(0, NA))
# })
## ----eval = FALSE-------------------------------------------------------------
# library(shiny)
# library(ggplot2)
# library(epidemics)
# library(overshiny)
#
# # Model run function
# run_model <- function(input)
# {
# # Transform parameters
# I0 <- input$init_infec / 100; # Percent to proportion
# duration <- as.numeric(input$date_range[2] - input$date_range[1]) # Dates to duration
# infec_rate <- 1 / input$latent_pd # Latent period to infectiousness rate
# recov_rate <- 1 / input$infec_pd # Infectious period to recovery rate
# trans_rate <- input$R0 * recov_rate # R0 to transmission rate (R_0 = beta / gamma)
#
# # Build population
# pop <- population(
# name = "Utopia",
# contact_matrix = matrix(1),
# demography_vector = input$pop_size * 1000000, # Population size in millions
# initial_conditions = matrix(c(1 - I0, 0, I0, 0, 0), nrow = 1)
# )
#
# # Run model
# results <- model_default(pop, transmission_rate = trans_rate,
# infectiousness_rate = infec_rate, recovery_rate = recov_rate,
# time_end = duration)
#
# return (results)
# }
#
# # --- User interface ---
# ui <- fluidPage(
# titlePanel("SEIRV model with interventions"),
#
# # NEW PART IS HERE:
# # Main plot
# overlayPlotOutput("display", width = "100%", height = 400),
# # END OF NEW PART
#
# # 3 columns of inputs
# fluidRow(
# column(4,
# # Basic epidemic settings
# h3("Epidemic"),
# dateRangeInput("date_range", "Date range", start = "2025-01-01", end = "2025-12-31"),
# numericInput("pop_size", "Population size (millions)", value = 59, min = 1),
# sliderInput("init_infec", "Initial proportion infectious (%)", value = 0.1, min = 0, max = 1, step = 0.01)
# ),
#
# column(4,
# # Pathogen settings
# h3("Pathogen"),
# sliderInput("R0", HTML("Basic reproduction number, R0"),
# value = 1.3, min = 0, max = 5, step = 0.05),
# sliderInput("latent_pd", "Latent period (days)", value = 2, min = 1, max = 7, step = 0.1),
# sliderInput("infec_pd", "Infectious period (days)", value = 7, min = 1, max = 10, step = 0.1)
# ),
#
# column(4,
# # Overlay controls: tokens that can be dragged onto the plot
# h3("Interventions"),
# overlayToken("vx", "Vaccination"),
# overlayToken("tx", "Transmission")
# )
# )
# )
#
# # --- App logic ---
# server <- function(input, output)
# {
# # --- OVERLAY SETUP ---
#
# # Initialise 8 draggable/resizable overlays
# ov <- overlayServer("display", 8)
#
# # --- RENDERING OF EPI CURVES ---
#
# output$display <- renderPlot({
# results <- run_model(input)
# results <- results[results$compartment == "infectious", ]
# plot <- ggplot(results) +
# geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
# labs(x = NULL, y = "Infection prevalence (thousands)") +
# ylim(0, NA)
#
# overlayBounds(ov, plot, xlim = c(input$date_range), ylim = c(0, NA))
# })
# }
#
# # --- Run app ---
# shinyApp(ui, server)
## ----eval = FALSE-------------------------------------------------------------
# # Model run function
# run_model <- function(input, ...) # <-- FIRST CHANGE HERE
## ----eval = FALSE-------------------------------------------------------------
# # Run model
# results <- model_default(pop, transmission_rate = trans_rate,
# infectiousness_rate = infec_rate, recovery_rate = recov_rate,
# time_end = duration, ...) # <-- SECOND CHANGE HERE
#
# return (results)
## ----eval = FALSE-------------------------------------------------------------
# output$display <- renderPlot({
# # Create interventions
# tx_int <- list()
# vax <- NULL
#
# # Apply overlays as interventions
# for (i in which(ov$active)) {
# begin <- ov$cx0[i] - as.numeric(input$date_range[1])
# end <- ov$cx1[i] - as.numeric(input$date_range[1])
# if (ov$label[i] == "Vaccination") {
# nu <- 0.01 # proportion of population vaccinated per day
# if (is.null(vax)) {
# vax <- vaccination(name = as.character(i), nu = matrix(nu),
# time_begin = matrix(begin), time_end = matrix(end))
# } else {
# ov$active[i] <- FALSE
# }
# } else if (ov$label[i] == "Transmission") {
# reduc <- 0.5 # reduction in transmission
# tx_int[[length(tx_int) + 1]] <- intervention(name = as.character(i),
# type = "rate", time_begin = matrix(begin), time_end = matrix(end),
# reduction = reduc)
# }
# }
#
# # Put interventions in the right format
# int <- list()
# if (length(tx_int)) {
# int[["transmission_rate"]] <- do.call(c, tx_int)
# }
#
# # Run model
# results <- run_model(input,
# vaccination = vax,
# intervention = if (length(int)) int else NULL)
#
# # Process results (this is the same as before)
# results <- results[results$compartment == "infectious", ]
# plot <- ggplot(results) +
# geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
# labs(x = NULL, y = "Infection prevalence (thousands)") +
# ylim(0, NA)
#
# overlayBounds(ov, plot, xlim = c(input$date_range), ylim = c(0, NA))
# })
## ----eval = FALSE-------------------------------------------------------------
# library(shiny)
# library(ggplot2)
# library(epidemics)
# library(overshiny)
#
# # Model run function
# run_model <- function(input, ...)
# {
# # Transform parameters
# I0 <- input$init_infec / 100; # Percent to proportion
# duration <- as.numeric(input$date_range[2] - input$date_range[1]) # Dates to duration
# infec_rate <- 1 / input$latent_pd # Latent period to infectiousness rate
# recov_rate <- 1 / input$infec_pd # Infectious period to recovery rate
# trans_rate <- input$R0 * recov_rate # R0 to transmission rate (R_0 = beta / gamma)
#
# # Build population
# pop <- population(
# name = "Utopia",
# contact_matrix = matrix(1),
# demography_vector = input$pop_size * 1000000, # Population size in millions
# initial_conditions = matrix(c(1 - I0, 0, I0, 0, 0), nrow = 1)
# )
#
# # Run model
# results <- model_default(pop, transmission_rate = trans_rate,
# infectiousness_rate = infec_rate, recovery_rate = recov_rate,
# time_end = duration, ...)
#
# return (results)
# }
#
# # --- User interface ---
# ui <- fluidPage(
# titlePanel("SEIRV model with interventions"),
#
# # NEW PART IS HERE:
# # Main plot
# overlayPlotOutput("display", width = "100%", height = 400),
# # END OF NEW PART
#
# # 3 columns of inputs
# fluidRow(
# column(4,
# # Basic epidemic settings
# h3("Epidemic"),
# dateRangeInput("date_range", "Date range", start = "2025-01-01", end = "2025-12-31"),
# numericInput("pop_size", "Population size (millions)", value = 59, min = 1),
# sliderInput("init_infec", "Initial proportion infectious (%)", value = 0.1, min = 0, max = 1, step = 0.01)
# ),
#
# column(4,
# # Pathogen settings
# h3("Pathogen"),
# sliderInput("R0", HTML("Basic reproduction number, R0"),
# value = 1.3, min = 0, max = 5, step = 0.05),
# sliderInput("latent_pd", "Latent period (days)", value = 2, min = 1, max = 7, step = 0.1),
# sliderInput("infec_pd", "Infectious period (days)", value = 7, min = 1, max = 10, step = 0.1)
# ),
#
# column(4,
# # Overlay controls: tokens that can be dragged onto the plot
# h3("Interventions"),
# overlayToken("vx", "Vaccination"),
# overlayToken("tx", "Transmission")
# )
# )
# )
#
# # --- App logic ---
# server <- function(input, output)
# {
# # --- OVERLAY SETUP ---
#
# # Initialise 8 draggable/resizable overlays
# ov <- overlayServer("display", 8)
#
# # --- RENDERING OF EPI CURVES ---
#
# output$display <- renderPlot({
# # Create interventions
# tx_int <- list()
# vax <- NULL
#
# # Apply overlays as interventions
# for (i in which(ov$active)) {
# begin <- ov$cx0[i] - as.numeric(input$date_range[1])
# end <- ov$cx1[i] - as.numeric(input$date_range[1])
# if (ov$label[i] == "Vaccination") {
# nu <- 0.01 # proportion of population vaccinated per day
# if (is.null(vax)) {
# vax <- vaccination(name = as.character(i), nu = matrix(nu),
# time_begin = matrix(begin), time_end = matrix(end))
# } else {
# ov$active[i] <- FALSE
# }
# } else if (ov$label[i] == "Transmission") {
# reduc <- 0.5 # reduction in transmission
# tx_int[[length(tx_int) + 1]] <- intervention(name = as.character(i),
# type = "rate", time_begin = matrix(begin), time_end = matrix(end),
# reduction = reduc)
# }
# }
#
# # Put interventions in the right format
# int <- list()
# if (length(tx_int)) {
# int[["transmission_rate"]] <- do.call(c, tx_int)
# }
#
# # Run model
# results <- run_model(input,
# vaccination = vax,
# intervention = if (length(int)) int else NULL)
#
# # Process results (this is the same as before)
# results <- results[results$compartment == "infectious", ]
# plot <- ggplot(results) +
# geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
# labs(x = NULL, y = "Infection prevalence (thousands)") +
# ylim(0, NA)
#
# overlayBounds(ov, plot, xlim = c(input$date_range), ylim = c(0, NA))
# })
# }
#
# # --- Run app ---
# shinyApp(ui, server)
## ----eval = FALSE-------------------------------------------------------------
# output$display <- renderPlot({
# results <- run_model(input)
# results <- results[results$compartment == "infectious", ]
# plot <- ggplot(results) +
# geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
# labs(x = NULL, y = "Infection prevalence (thousands)") +
# ylim(0, NA)
#
# overlayBounds(ov, plot, xlim = c(input$date_range), ylim = c(0, NA))
# })
## ----eval = FALSE-------------------------------------------------------------
# # Create interventions
# tx_int <- list()
# vax <- NULL
## ----eval = FALSE-------------------------------------------------------------
# # Apply overlays as interventions
# for (i in which(ov$active)) {
# begin <- ov$cx0[i] - as.numeric(input$date_range[1])
# end <- ov$cx1[i] - as.numeric(input$date_range[1])
# if (ov$label[i] == "Vaccination") {
# nu <- 0.01 # proportion of population vaccinated per day
# if (is.null(vax)) {
# vax <- vaccination(name = as.character(i), nu = matrix(nu),
# time_begin = matrix(begin), time_end = matrix(end))
# } else {
# ov$active[i] <- FALSE
# }
# } else if (ov$label[i] == "Transmission") {
# reduc <- 0.5 # reduction in transmission
# tx_int[[length(tx_int) + 1]] <- intervention(name = as.character(i),
# type = "rate", time_begin = matrix(begin), time_end = matrix(end),
# reduction = reduc)
# }
# }
## ----eval = FALSE-------------------------------------------------------------
# # Put interventions in the right format
# int <- list()
# if (length(tx_int)) {
# int[["transmission_rate"]] <- do.call(c, tx_int)
# }
#
# # Run model
# results <- run_model(input,
# vaccination = vax,
# intervention = if (length(int)) int else NULL)
## ----eval = FALSE-------------------------------------------------------------
# library(epidemics)
# library(shiny)
# library(overshiny)
# library(ggplot2)
#
# # --- User interface ---
# ui <- fluidPage(
# titlePanel("SEIRV model with interventions"),
#
# # Main plot with support for overlays
# overlayPlotOutput("display", width = "100%", height = 400),
#
# # 3 columns of inputs
# fluidRow(
# column(4,
# # Basic epidemic settings
# h3("Epidemic"),
# dateRangeInput("date_range", "Date range", start = "2025-01-01", end = "2025-12-31"),
# numericInput("pop_size", "Population size (millions)", value = 59, min = 1),
# sliderInput("init_infec", "Initial proportion infectious (%)", value = 0.1, min = 0, max = 1, step = 0.01)
# ),
#
# column(4,
# # Pathogen settings
# h3("Pathogen"),
# sliderInput("R0", HTML("Basic reproduction number, R0"),
# value = 1.3, min = 0, max = 5, step = 0.05),
# sliderInput("latent_pd", "Latent period (days)", value = 2, min = 1, max = 7, step = 0.1),
# sliderInput("infec_pd", "Infectious period (days)", value = 7, min = 1, max = 10, step = 0.1)
# ),
#
# column(4,
# # Overlay controls: tokens that can be dragged onto the plot
# h3("Interventions"),
# overlayToken("vx", "Vaccination"),
# overlayToken("tx", "Transmission")
# )
# )
# )
#
# # --- App logic ---
# server <- function(input, output)
# {
# # --- OVERLAY SETUP ---
#
# # Dropdown menu for overlays
# menu <- function(ov, i) {
# if (ov$label[i] == "Vaccination") {
# numericInput("display_vac_rate", "Vaccines per day (thousands)",
# value = ov$data$vac_rate[i], min = 0, max = 10000)
# } else if (ov$label[i] == "Transmission") {
# sliderInput("display_int_strength", "Transmission reduction (%)",
# value = ov$data$int_strength[i], min = 0, max = 100)
# }
# }
#
# # Initialise 8 draggable/resizable overlays
# ov <- overlayServer("display", 8, width = 56, # 56 days = 8 weeks default width
# data = list(vac_rate = 10, int_strength = 20),
# snap = snapGrid(),
# heading = dateHeading("%b %e"),
# select = TRUE,
# menu = menu)
#
# # --- EPIDEMIC MODEL RUNS BASED ON OVERLAY POSITIONS ---
#
# # Model run function
# run_model <- function(...)
# {
# # Transform parameters
# I0 <- input$init_infec / 100;
# duration <- as.numeric(input$date_range[2] - input$date_range[1])
# infec_rate <- 1 / input$latent_pd
# recov_rate <- 1 / input$infec_pd
# trans_rate <- input$R0 * recov_rate
#
# # Build population
# pop <- population(
# name = "Utopia",
# contact_matrix = matrix(1),
# demography_vector = input$pop_size * 1000000,
# initial_conditions = matrix(c(1 - I0, 0, I0, 0, 0), nrow = 1)
# )
#
# # Run model (with additional parameters from ...)
# results <- model_default(pop, transmission_rate = trans_rate,
# infectiousness_rate = infec_rate, recovery_rate = recov_rate,
# time_end = duration, ...)
#
# # Transform results -- construct date and only return infection prevalence
# results$date <- results$time + input$date_range[1]
# results <- results[results$compartment == "infectious", ]
# return (results)
# }
#
# # Unmitigated epidemic
# epi_unmitigated <- reactive({
# run_model()
# })
#
# # Mitigated epidemic
# epi_mitigated <- reactive({
# # Create interventions
# tx_int <- list()
# vax <- NULL
# for (i in which(ov$active)) {
# begin <- ov$cx0[i] - as.numeric(input$date_range[1])
# end <- ov$cx1[i] - as.numeric(input$date_range[1])
# if (ov$label[i] == "Vaccination") {
# nu <- ov$data$vac_rate[i] * 1000 / (input$pop_size * 1000000)
# if (is.null(vax)) {
# vax <- vaccination(name = as.character(i), nu = matrix(nu),
# time_begin = matrix(begin), time_end = matrix(end))
# } else {
# ov$active[i] <- FALSE
# }
# } else if (ov$label[i] == "Transmission") {
# reduc <- ov$data$int_strength[i] / 100
# tx_int[[length(tx_int) + 1]] <- intervention(name = as.character(i),
# type = "rate", time_begin = matrix(begin), time_end = matrix(end),
# reduction = reduc)
# }
# }
#
# # Get mitigated model results
# int <- list()
# if (length(tx_int)) {
# int[["transmission_rate"]] <- do.call(c, tx_int)
# }
# run_model(vaccination = vax,
# intervention = if (length(int)) int else NULL)
# })
#
# # --- RENDERING OF EPI CURVES ---
#
# # Render plot and align overlays to current axis limits
# output$display <- renderPlot({
# plot <- ggplot() +
# geom_line(data = epi_unmitigated(),
# aes(x = date, y = value/1000), alpha = 0.5) +
# geom_line(data = epi_mitigated(),
# aes(x = date, y = value/1000)) +
# labs(x = NULL, y = "Infection prevalence (thousands)") +
# ylim(0, NA)
#
# overlayBounds(ov, plot, xlim = c(input$date_range), ylim = c(0, NA))
# })
# }
#
# # --- Run app ---
# shinyApp(ui, server)