In gauravsk/ecoevoapps: Simulate Dynamics of Ecology/Evolution Models
中文 | Español | English | português | Turkish
knitr::opts_chunk$set(echo = TRUE)
# library(tidyverse)
library(ggplot2)
library(tidyr)
library(purrr)
library(dplyr)
library(deSolve)
library(ecoevoapps)
library(patchwork)
library(kableExtra)
theme_set(ecoevoapps::theme_apps())
This app implements a category of models from epidemiology called Compartment models. These models are designed to model the spread of diseases through populations that are made of individuals in different compartments, like individuals who are susceptible to the disease, exposed individuals, infected individuals, recovered individuals, etc. Different models can include different compartments, based on the population being studied and the dynamics of the infection. For more details on compartment models, please refer to the Wikipedia page or refer to this paper.
Models Assuming Density-Dependent Transmission {.tabset}
All of the following disease models assume that infectious individuals mix homogeneously with other individuals in the population and that infections occur in direct proportion to the number of encounters between susceptible and infectious individuals (i.e., disease transmission is density-dependent and happens at rate $\beta SI$).
Open versus closed populations: All of the models here include vital rates (i.e., births/deaths), which is called an open population. They assume that the number of births = the number of non-disease-induced deaths. If the course of the infection is short relative to individual lifespan, the vital rates can be ignored. Models that do not include vital rates are said to model a closed population. To run a model in this app without vital rates, set $m = 0$.
SIR model
[
\begin{align}
\frac{dS}{dt} &= m(S + I + R)(1 - v) - mS - \beta SI\
\frac{dI}{dt} &= \beta SI - mI - \gamma I\
\frac{dR}{dt} &= \gamma I - mR + mv(S + I + R)
\end{align}
]
pars_vars <- c("$S$",
"$I$",
"$R$",
"$m$",
"$\\beta$",
"$\\gamma$",
"$v$")
descriptions <- c("Population size of susceptible individuals",
"Population size of infectious individuals",
"Population size of recovered individuals",
"Birth/death rate",
"Infection rate",
"Recovery rate",
"Newborn vaccination rate")
param_df <- data.frame(pars_vars, descriptions)
kable(x = param_df, format = "html",
col.names = c("Parameter/Variable", "Description")) %>%
kable_styling(full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
position = "center")
sidebarLayout(
sidebarPanel(
### Ask user for parameter values ----
# m - death/birth rate; beta - infection rate
# gamma - recovery rate; v - vaccination rate
sliderInput("m", label = "Birth/Death rate:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta", label = "Infection rate:",
min = 0, max = 1, value = .01, step = 0.01),
sliderInput("gamma", label = "Recovery rate:",
min = 0, max = 1, value = .2, step = 0.01),
sliderInput("v", label = "Vaccination rate:",
min = 0, max = 1, value = 0, step = 0.1),
### Ask user for initial conditions ----
numericInput("S0", label = "Initial population size of S",
min = 0, value = 100),
numericInput("I0", label = "Initial population size of I",
min = 0, value = 1),
numericInput("R0", label = "Initial population size of R",
min = 0, value = 0),
### Ask user for time to simulate ----
numericInput("time", label = "Time to simulate", min = 10, value = 100)
),
# Render plots -----------------
mainPanel(renderPlot({plots_to_render_SIR()}, width = 600, height = 800))
)
# Run the simulation -------------------
# Set the initial population sizes
init <- reactive({c(S = input$S0, I = input$I0, R = input$R0)})
# Set the parameter values
params <- reactive({c(m = input$m, beta = input$beta,
v = input$v, gamma = input$gamma)})
# Time over which to simulate model dynamics
time <- reactive({seq(0,input$time,by = .1)})
# Simulate model dynamics
out <- reactive({
data.frame(run_infectiousdisease_model(time = time(), params = params(),
init = init(), model_type = "SIR"))
})
# Reshape the data for plotting
# out_long <- reactive({
# pivot_longer(out(), c(S, I, R), "group") %>%
# mutate(group = factor(group, levels = c("S", "I", "R")))
# })
# use out to create dS, dI, dR, and the per capita changes in population
# pop_out <- reactive({
# pop_out <- out()
# pop_out$dS <- c(NA, diff(pop_out$S))
# pop_out$dI <- c(NA, diff(pop_out$I))
# pop_out$dR <- c(NA, diff(pop_out$R))
# # not using pgrs right now but could be useful to calculate
# pop_out <- pop_out %>% mutate(pgrS = dS/S, pgrI = dI/I, pgrR = dR/R)
# pop_out
# })
#
# pop_out_long <- reactive({
# pop_out() %>%
# select(time, dS, dI, dR) %>%
# pivot_longer(c(dS, dI, dR), "group") %>%
# mutate(group = factor(group, levels = c("dS", "dI", "dR")))
# })
# Make plots -------------------
# Plot abundance through time ----------
abund_plot_SIR <- reactive({
plot_infectiousdisease_time(out(), model_type = "SIR")
})
# # Plot dS, dI, dR over time
# dabund_plot_SIR <- reactive({ ggplot(pop_out_long()) +
# geom_line(aes(x = time, y = value, color = group), size = 2) +
# scale_color_brewer(palette = "Set1") +
# ylab("Change in population size")
# })
# Plot S vs I ---------
SIplot <- reactive({
plot_infectiousdisease_portrait(sim_df = out(), x_axis = "S", y_axis = "I")
})
# Plot I vs R --------------
RIplot <- reactive({
plot_infectiousdisease_portrait(sim_df = out(), x_axis = "R", y_axis = "I")
})
# Plot S vs R ------------
SRplot <- reactive({
plot_infectiousdisease_portrait(sim_df = out(), x_axis = "S", y_axis = "R")
})
# combine 2d plots -----
SIR_2d_plots <- reactive({
wrap_plots(SIplot(), RIplot(), SRplot(), ncol = 3)
})
# Make a list of plots and print out plots based on which ones were requested ----
plots_to_render_SIR <- reactive({
wrap_plots(abund_plot_SIR(),
# dabund_plot_SIR(),
SIR_2d_plots(), nrow = 2)
})
SIS model
[
\begin{align}
\frac{dS}{dt} &= m(S + I) - mS - \beta SI + \gamma I\
\frac{dI}{dt} &= \beta SI - mI - \gamma I\
\end{align}
]
pars_vars <- c("$S$",
"$I$",
"$m$",
"$\\beta$",
"$\\gamma$",
"$v$")
descriptions <- c("Population size of susceptible individuals",
"Population size of infectious individuals",
"Birth/death rate",
"Infection rate",
"Recovery rate",
"Newborn vaccination rate")
param_df <- data.frame(pars_vars, descriptions)
kable(x = param_df, format = "html",
col.names = c("Parameter/Variable", "Description")) %>%
kable_styling(full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
position = "center")
sidebarLayout(
sidebarPanel(
### Ask user for parameter values ----
# m - death/birth rate; beta - infection rate; gamma - recovery rate
sliderInput("m_sis", label = "Birth/Death rate:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta_sis", label = "Infection rate:",
min = 0, max = 1, value = .01, step = 0.01),
sliderInput("gamma_sis", label = "Recovery rate:",
min = 0, max = 1, value = .2, step = 0.01),
### Ask user for initial conditions ----
numericInput("S0_sis", label = "Initial population size of S",
min = 0, value = 100),
numericInput("I0_sis", label = "Initial population size of I",
min = 0, value = 1),
### Ask user for time to simulate ----
numericInput("time_sis", label = "Time to simulate", min = 10, value = 100)
),
# Render plots -----------------
mainPanel(renderPlot({plots_to_render_sis()}, width = 600, height = 800))
)
# Run the simulation -------------------
# Set the initial population sizes
init_sis <- reactive({c(S = input$S0_sis, I = input$I0_sis)})
# Set the parameter values
params_sis <- reactive({
c(m = input$m_sis, beta = input$beta_sis, gamma = input$gamma_sis)
})
# Time over which to simulate model dynamics
time_sis <- reactive({seq(0, input$time_sis, by = .1)})
# Simulate model dynamics
out_sis <- reactive({
data.frame(run_infectiousdisease_model(time = time_sis(), params = params_sis(),
init = init_sis(), model_type = "SIS"))
})
# Reshape the data so for plotting
# out_long_sis <- reactive({
# pivot_longer(out_sis(), c(S, I), "group") %>%
# mutate(group = factor(group, levels = c("S", "I")))
# })
# use out to create dS, dI, dR, and the per capita changes in population
# pop_out_sis <- reactive({
# pop_out <- out_sis()
# pop_out$dS <- c(NA, diff(pop_out$S))
# pop_out$dI <- c(NA, diff(pop_out$I))
# # not using pgrs right now but could be useful to calculate
# pop_out <- pop_out %>% mutate(pgrS = dS/S, pgrI = dI/I)
# pop_out
# })
#
# pop_out_long_sis <- reactive({
# pop_out_sis() %>%
# select(time, dS, dI) %>%
# pivot_longer(c(dS, dI), "group") %>%
# mutate(group = factor(group, levels = c("dS", "dI")))
# })
# Make plots --------------------
# Plot abundance through time
abund_plot_sis <- reactive({
plot_infectiousdisease_time(out_sis(), model_type = "SIS")
})
# Plot S vs I
SIplot_sis <- reactive({
plot_infectiousdisease_portrait(sim_df = out_sis(),
x_axis = "S", y_axis = "I")
})
# Make a list of plots and print out plots based on which ones were requested ----
plots_to_render_sis <- reactive({
wrap_plots(abund_plot_sis(),
# dabund_plot_sis(),
SIplot_sis(), nrow = 2)
})
SEIR model
[
\begin{align}
\frac{dS}{dt} &= m(S + E + I + R)(1 - v) - mS - \beta SI\
\frac{dE}{dt} &= \beta SI - aE - mE\
\frac{dI}{dt} &= aE - mI - \gamma I\
\frac{dR}{dt} &= \gamma I - mR + mv(S + E + I + R)
\end{align}
]
pars_vars <- c("$S$",
"$E$",
"$I$",
"$R$",
"$m$",
"$\\beta$",
"$a$",
"$\\gamma$",
"$v$")
descriptions <- c("Population size of susceptible individuals",
"Population size of exposed (not yet infectious) individuals",
"Population size of infectious individuals",
"Population size of recovered individuals",
"Birth/death rate",
"Infection rate",
"Inverse of incubation period",
"Recovery rate",
"Newborn vaccination rate")
param_df <- data.frame(pars_vars, descriptions)
kable(x = param_df, format = "html",
col.names = c("Parameter/Variable", "Description")) %>%
kable_styling(full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
position = "center")
sidebarLayout(
sidebarPanel(
### Ask user for parameter values ----
#m - death/birth rate; beta - infection rate; a - inverse of incubation period
#gamma - recovery rate; v - vaccination rate
sliderInput("m_seir", label = "Birth/Death rate:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta_seir", label = "Infection rate:",
min = 0, max = 1, value = .01, step = 0.01),
sliderInput("a_seir", label = "Inverse of incubation period:",
min = 0, max = 1, value = 0.05, step = 0.01),
sliderInput("gamma_seir", label = "Recovery rate:",
min = 0, max = 1, value = .2, step = 0.01),
sliderInput("v_seir", label = "Vaccination rate:",
min = 0, max = 1, value = 0, step = 0.1),
### Ask user for initial conditions ----
numericInput("S0_seir", label = "Initial population size of S",
min = 0, value = 100),
numericInput("E0_seir", label = "Initial population size of E",
min = 0, value = 0),
numericInput("I0_seir", label = "Initial population size of I",
min = 0, value = 1),
numericInput("R0_seir", label = "Initial population size of R",
min = 0, value = 0),
### Ask user for time to simulate ----
numericInput("time_seir", label = "Time to simulate", min = 10, value = 100)
),
# Render plots -----------------
mainPanel(renderPlot({plots_to_render_seir()}, width = 600, height = 800))
)
# Run the simulation -------------------
# Set the initial population sizes
init_seir <- reactive({
c(S = input$S0_seir, E = input$E0_seir,
I = input$I0_seir, R = input$R0_seir)
})
# Set the parameter values
params_seir <- reactive({
c(m = input$m_seir, beta = input$beta_seir, a = input$a_seir,
gamma = input$gamma_seir, v = input$v_seir)})
# Time over which to simulate model dynamics
time_seir <- reactive({seq(0, input$time_seir, by = .1)})
# Simulate model dynamics
out_seir <- reactive({
data.frame(run_infectiousdisease_model(time = time_seir(),
params = params_seir(),
init = init_seir(),
model_type = "SEIR"))
})
# Reshape the data for plotting
# out_long_seir <- reactive({
# pivot_longer(out_seir(), c(S, E, I, R), "group") %>%
# mutate(group = factor(group, levels = c("S", "E", "I", "R")))
# })
# use out to create dS, dE, dI, dR, and the per capita changes in population
# pop_out_seir <- reactive({
# pop_out <- out_seir()
# pop_out$dS <- c(NA, diff(pop_out$S))
# pop_out$dE <- c(NA, diff(pop_out$E))
# pop_out$dI <- c(NA, diff(pop_out$I))
# pop_out$dR <- c(NA, diff(pop_out$R))
# # not using pgrs right now but could be useful to calculate
# pop_out <- pop_out %>% mutate(pgrS = dS/S, pgrE = dE/E, pgrI = dI/I, pgrR = dR/R)
# pop_out
# })
#
# pop_out_long_seir <- reactive({
# pop_out_seir() %>%
# select(time, dS, dE, dI, dR) %>%
# pivot_longer(c(dS, dE, dI, dR), "group") %>%
# mutate(group = factor(group, levels = c("dS", "dE", "dI", "dR")))
# })
# Make plots --------------------
# Plot abundance through time ----------
abund_plot_seir <- reactive({
plot_infectiousdisease_time(out_seir(), model_type = "SEIR")
})
# # Plot dS, dE, dI, dR over time
# dabund_plot_seir <- reactive({ ggplot(pop_out_long_seir()) +
# geom_line(aes(x = time, y = value, color = group), size = 2) +
# scale_color_brewer(palette = "Set1") +
# ylab("Change in population size")
# })
# Plot S vs E ---------
SEplot_seir <- reactive({
plot_infectiousdisease_portrait(sim_df = out_seir(),
x_axis = "S", y_axis = "E")
})
# Plot S vs I ---------
SIplot_seir <- reactive({
plot_infectiousdisease_portrait(sim_df = out_seir(),
x_axis = "S", y_axis = "I")
})
# Plot S vs R ---------
SRplot_seir <- reactive({
plot_infectiousdisease_portrait(sim_df = out_seir(),
x_axis = "S", y_axis = "R")
})
# Plot E vs I ---------
EIplot_seir <- reactive({
plot_infectiousdisease_portrait(sim_df = out_seir(),
x_axis = "E", y_axis = "I")
})
# Plot E vs R ---------
ERplot_seir <- reactive({
plot_infectiousdisease_portrait(sim_df = out_seir(),
x_axis = "E", y_axis = "R")
})
# Plot R vs I ---------
RIplot_seir <- reactive({
plot_infectiousdisease_portrait(sim_df = out_seir(),
x_axis = "R", y_axis = "I")
})
# combine 2d plots -----
SEIR_2d_plots <- reactive({
wrap_plots(SEplot_seir(), SIplot_seir(), SRplot_seir(),
EIplot_seir(), ERplot_seir(), RIplot_seir(), ncol = 3)
})
# Make a list of plots and print out plots based on which ones were requested ----
plots_to_render_seir <- reactive({
wrap_plots(abund_plot_seir(),
# dabund_plot_seir(),
SEIR_2d_plots(), nrow = 2)
})
SIRD model
[
\begin{align}
\frac{dS}{dt} &= m(S + I + R)(1 - v) - mS - \beta SI\
\frac{dI}{dt} &= \beta SI - mI - \gamma I - \mu I\
\frac{dR}{dt} &= \gamma I - mR + mv(S + I + R)\
\frac{dD}{dt} &= \mu I\
\end{align}
]
pars_vars <- c("$S$",
"$I$",
"$R$",
"$D$",
"$m$",
"$\\beta$",
"$\\gamma$",
"$\\mu$",
"$v$")
descriptions <- c("Population size of susceptible individuals",
"Population size of infectious individuals",
"Population size of recovered individuals",
"Number of individuals who die due to infection",
"Birth/death rate",
"Infection rate",
"Recovery rate",
"Death rate from infection",
"Newborn vaccination rate")
param_df <- data.frame(pars_vars, descriptions)
kable(x = param_df, format = "html",
col.names = c("Parameter/Variable", "Description")) %>%
kable_styling(full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
position = "center")
sidebarLayout(
sidebarPanel(
### Ask user for parameter values ----
#m - death/birth rate; beta - infection rate; mu - death rate due to infection
#gamma - recovery rate; v - vaccination rate
sliderInput("m_sird", label = "Birth/Death rate:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta_sird", label = "Infection rate:",
min = 0, max = 1, value = .01, step = 0.01),
sliderInput("gamma_sird", label = "Recovery rate:",
min = 0, max = 1, value = .2, step = 0.01),
sliderInput("mu_sird", label = "Death rate due to infection:",
min = 0, max = 1, value = 0.05, step = 0.01),
sliderInput("v_sird", label = "Vaccination rate:",
min = 0, max = 1, value = 0, step = 0.1),
### Ask user for initial conditions ----
numericInput("S0_sird", label = "Initial population size of S",
min = 0, value = 100),
numericInput("I0_sird", label = "Initial population size of I",
min = 0, value = 1),
numericInput("R0_sird", label = "Initial population size of R",
min = 0, value = 0),
numericInput("D0_sird", label = "Initial population size of D",
min = 0, value = 0),
### Ask user for time to simulate ----
numericInput("time_sird", label = "Time to simulate", min = 10, value = 100)
),
# Render plots -----------------
mainPanel(renderPlot({plots_to_render_sird()}, width = 600, height = 800))
)
# Run the simulation -------------------
# Set the initial population sizes
init_sird <- reactive({
c(S = input$S0_sird, I = input$I0_sird, R = input$R0_sird, D = input$D0_sird)
})
# Set the parameter values
params_sird <- reactive({
c(m = input$m_sird, beta = input$beta_sird, mu = input$mu_sird,
gamma = input$gamma_sird, v = input$v_sird)
})
# Time over which to simulate model dynamics
time_sird <- reactive({seq(0, input$time_sird, by = .1)})
# Simulate model dynamics
out_sird <- reactive({
data.frame(run_infectiousdisease_model(time = time_sird(),
params = params_sird(),
init = init_sird(),
model_type = "SIRD"))
})
# Reshape the data for plotting
# out_long_sird <- reactive({
# pivot_longer(out_sird(), c(S, I, R, D), "group") %>%
# mutate(group = factor(group, levels = c("S", "I", "R", "D")))
# })
# use out to create dS, dD, dI, dR, and the per capita changes in population
# pop_out_sird <- reactive({
# pop_out <- out_sird()
# pop_out$dS <- c(NA, diff(pop_out$S))
# pop_out$dI <- c(NA, diff(pop_out$I))
# pop_out$dR <- c(NA, diff(pop_out$R))
# pop_out$dD <- c(NA, diff(pop_out$D))
# # not using pgrs right now but could be useful to calculate
# pop_out <- pop_out %>%
# mutate(pgrS = dS/S, pgrI = dI/I, pgrR = dR/R, pgrD = dD/D)
# pop_out
# })
# pop_out_long_sird <- reactive({
# pop_out_sird() %>%
# select(time, dS, dI, dR, dD) %>%
# pivot_longer(c(dS, dI, dR, dD), "group") %>%
# mutate(group = factor(group, levels = c("dS", "dI", "dR", "dD")))
# })
# Make plots --------------------
# Plot abundance through time ----------
abund_plot_sird <- reactive({
plot_infectiousdisease_time(out_sird(), model_type = "SIRD")
# ggplot(out_long_sird()) +
# geom_line(aes(x = time, y = value, color = group), size = 2) +
# scale_color_brewer(palette = "Set1") +
# ylab("Population size")
})
# Plot S vs D ---------
SDplot_sird <- reactive({
plot_infectiousdisease_portrait(sim_df = out_sird(),
x_axis = "S", y_axis = "D")
})
# Plot S vs I ---------
SIplot_sird <- reactive({
plot_infectiousdisease_portrait(sim_df = out_sird(),
x_axis = "S", y_axis = "I")
})
# Plot S vs R ---------
SRplot_sird <- reactive({
plot_infectiousdisease_portrait(sim_df = out_sird(),
x_axis = "S", y_axis = "R")
})
# Plot D vs I ---------
DIplot_sird <- reactive({
plot_infectiousdisease_portrait(sim_df = out_sird(),
x_axis = "D", y_axis = "I")
})
# Plot D vs R ---------
DRplot_sird <- reactive({
plot_infectiousdisease_portrait(sim_df = out_sird(),
x_axis = "D", y_axis = "R")
})
# Plot R vs I ---------
RIplot_sird <- reactive({
plot_infectiousdisease_portrait(sim_df = out_sird(),
x_axis = "R", y_axis = "I")
})
# combine 2d plots -----
SIRD_2d_plots <- reactive({
wrap_plots(SIplot_sird(), SRplot_sird(), SDplot_sird(),
RIplot_sird(), DIplot_sird(), DRplot_sird(), ncol = 3)
})
# Make a list of plots and print out plots based on which ones were requested ----
plots_to_render_sird <- reactive({
wrap_plots(abund_plot_sird(),
# dabund_plot_sird(),
SIRD_2d_plots(), nrow = 2)
})
Models Assuming Frequency-Dependent Transmission {.tabset}
All of the following disease models assume that disease transmission depends on the frequency of susceptible individuals in the population as opposed to the absolute number of susceptible individuals. Thus, the disease is transmitted at rate $\beta \frac{SI}{N}$ instead of $\beta SI$.
Open versus closed populations: All of the models here include vital rates (i.e., births/deaths), which is called an open population. They assume that the number of births = the number of non-disease-induced deaths. If the course of the infection is short relative to individual lifespan, the vital rates can be ignored. Models that do not include vital rates are said to model a closed population. To run a model in this app without vital rates, set $m = 0$.
SIR model
[
\begin{align}
\frac{dS}{dt} &= m(S + I + R)(1 - v) - mS - \beta \frac{SI}{N}\
\frac{dI}{dt} &= \beta \frac{SI}{N} - mI - \gamma I\
\frac{dR}{dt} &= \gamma I - mR + mv(S + I + R)
\end{align}
]
pars_vars <- c("$S$",
"$I$",
"$R$",
"$m$",
"$\\beta$",
"$\\gamma$",
"$v$")
descriptions <- c("Population size of susceptible individuals",
"Population size of infectious individuals",
"Population size of recovered individuals",
"Birth/death rate",
"Infection rate",
"Recovery rate",
"Newborn vaccination rate")
param_df <- data.frame(pars_vars, descriptions)
kable(x = param_df, format = "html",
col.names = c("Parameter/Variable", "Description")) %>%
kable_styling(full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
position = "center")
sidebarLayout(
sidebarPanel(
### Ask user for parameter values ----
#m - death/birth rate; beta - infection rate
#gamma - recovery rate; v - vaccination rate
sliderInput("m_ft", label = "Birth/Death rate:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta_ft", label = "Infection rate:",
min = 0, max = 1, value = .2, step = 0.01),
sliderInput("gamma_ft", label = "Recovery rate:",
min = 0, max = 1, value = .1, step = 0.01),
sliderInput("v_ft", label = "Vaccination rate:",
min = 0, max = 1, value = 0, step = 0.1),
### Ask user for initial conditions ----
numericInput("S0_ft", label = "Initial population size of S",
min = 0, value = 50),
numericInput("I0_ft", label = "Initial population size of I",
min = 0, value = 20),
numericInput("R0_ft", label = "Initial population size of R",
min = 0, value = 0),
### Ask user for time to simulate ----
numericInput("time_ft", label = "Time to simulate", min = 10, value = 100)
),
# Render plots -----------------
mainPanel(renderPlot({plots_to_render_SIR_ft()}, width = 600, height = 800))
)
# Run the simulation -------------------
# Set the initial population sizes
init_ft <- reactive({
c(S = input$S0_ft, I = input$I0_ft, R = input$R0_ft)
})
# Set the parameter values
params_ft <- reactive({
c(m = input$m_ft, beta = input$beta_ft, v = input$v_ft, gamma = input$gamma_ft)
})
# Time over which to simulate model dynamics
time_ft <- reactive({seq(0,input$time_ft,by = .1)})
# Simulate model dynamics
out_ft <- reactive({
data.frame(run_infectiousdisease_model(time = time_ft(),
params = params_ft(),
init = init_ft(),
model_type = "SIR_ft"))
})
# Reshape the data for plotting
# out_long_ft <- reactive({
# pivot_longer(out_ft(), c(S, I, R), "group") %>%
# mutate(group = factor(group, levels = c("S", "I", "R")))
# })
# use out to create dS, dI, dR, and the per capita changes in population
# pop_out_ft <- reactive({
# pop_out <- out_ft()
# pop_out$dS <- c(NA, diff(pop_out$S))
# pop_out$dI <- c(NA, diff(pop_out$I))
# pop_out$dR <- c(NA, diff(pop_out$R))
# # not using pgrs right now but could be useful to calculate
# pop_out <- pop_out %>%
# mutate(pgrS = dS/S, pgrI = dI/I, pgrR = dR/R)
# pop_out
# })
# pop_out_long_ft <- reactive({
# pop_out_ft() %>%
# select(time, dS, dI, dR) %>%
# pivot_longer(c(dS, dI, dR), "group") %>%
# mutate(group = factor(group, levels = c("dS", "dI", "dR")))
# })
# Make plots --------------------
# Plot abundance through time ----------
abund_plot_SIR_ft <- reactive({
plot_infectiousdisease_time(out_ft(), model_type = "SIR_ft")
})
# Plot S vs I ---------
SIplot_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_ft(),
x_axis = "S", y_axis = "I")
})
# Plot I vs R --------------
RIplot_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_ft(),
x_axis = "R", y_axis = "I")
})
# Plot S vs R ------------
SRplot_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_ft(),
x_axis = "S", y_axis = "R")
})
# combine 2d plots -----
SIR_2d_plots_ft <- reactive({
wrap_plots(SIplot_ft(), RIplot_ft(), SRplot_ft(), ncol = 3)
})
# Make a list of plots and print out plots based on which ones were requested ----
plots_to_render_SIR_ft <- reactive({
wrap_plots(abund_plot_SIR_ft(),
# dabund_plot_SIR(),
SIR_2d_plots_ft(), nrow = 2)
})
SIS model
[
\begin{align}
\frac{dS}{dt} &= m(S + I) - mS - \beta \frac{SI}{N} + \gamma I\
\frac{dI}{dt} &= \beta \frac{SI}{N} - mI - \gamma I\
\end{align}
]
pars_vars <- c("$S$",
"$I$",
"$m$",
"$\\beta$",
"$\\gamma$",
"$v$")
descriptions <- c("Population size of susceptible individuals",
"Population size of infectious individuals",
"Birth/death rate",
"Infection rate",
"Recovery rate",
"Newborn vaccination rate")
param_df <- data.frame(pars_vars, descriptions)
kable(x = param_df, format = "html",
col.names = c("Parameter/Variable", "Description")) %>%
kable_styling(full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
position = "center")
sidebarLayout(
sidebarPanel(
### Ask user for parameter values ----
#m - death/birth rate; beta - infection rate; gamma - recovery rate
sliderInput("m_sis_ft", label = "Birth/Death rate:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta_sis_ft", label = "Infection rate:",
min = 0, max = 1, value = .35, step = 0.01),
sliderInput("gamma_sis_ft", label = "Recovery rate:",
min = 0, max = 1, value = .1, step = 0.01),
### Ask user for initial conditions ----
numericInput("S0_sis_ft", label = "Initial population size of S",
min = 0, value = 50),
numericInput("I0_sis_ft", label = "Initial population size of I",
min = 0, value = 20),
### Ask user for time to simulate ----
numericInput("time_sis_ft", label = "Time to simulate",
min = 10, value = 100)
),
# Render plots -----------------
mainPanel(renderPlot({plots_to_render_sis_ft()}, width = 600, height = 800))
)
# Run the simulation -------------------
# Set the initial population sizes
init_sis_ft <- reactive({c(S = input$S0_sis_ft, I = input$I0_sis_ft)})
# Set the parameter values
params_sis_ft <- reactive({
c(m = input$m_sis_ft, beta = input$beta_sis_ft, gamma = input$gamma_sis_ft)
})
# Time over which to simulate model dynamics
time_sis_ft <- reactive({seq(0, input$time_sis_ft, by = .1)})
# Simulate model dynamics
out_sis_ft <- reactive({
data.frame(run_infectiousdisease_model(time = time_sis_ft(),
params = params_sis_ft(),
init = init_sis_ft(),
model_type = "SIS_ft"))
})
# Reshape the data so for plotting
# out_long_sis_ft <- reactive({
# pivot_longer(out_sis_ft(), c(S, I), "group") %>%
# mutate(group = factor(group, levels = c("S", "I")))
# })
# use out to create dS, dI, dR, and the per capita changes in population
# pop_out_sis_ft <- reactive({
# pop_out <- out_sis_ft()
# pop_out$dS <- c(NA, diff(pop_out$S))
# pop_out$dI <- c(NA, diff(pop_out$I))
# # not using pgrs right now but could be useful to calculate
# pop_out <- pop_out %>% mutate(pgrS = dS/S, pgrI = dI/I)
# pop_out
# })
#
# pop_out_long_sis_ft <- reactive({
# pop_out_sis_ft() %>%
# select(time, dS, dI) %>%
# pivot_longer(c(dS, dI), "group") %>%
# mutate(group = factor(group, levels = c("dS", "dI")))
# })
# Make plots --------------------
# Plot abundance through time ----------
abund_plot_sis_ft <- reactive({
plot_infectiousdisease_time(out_sis_ft(), model_type = "SIS_ft")
# ggplot(out_long_sis_ft()) +
# geom_line(aes(x = time, y = value, color = group), size = 2) +
# scale_color_brewer(palette = "Set1") +
# ylab("Population size")
})
# Plot S vs I ---------
SIplot_sis_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_sis_ft(),
x_axis = "S", y_axis = "I")
})
# Make a list of plots and print out plots based on which ones were requested ----
plots_to_render_sis_ft <- reactive({
wrap_plots(abund_plot_sis_ft(),
# dabund_plot_sis(),
SIplot_sis_ft(), nrow = 2)
})
SEIR model
[
\begin{align}
\frac{dS}{dt} &= m(S + E + I + R)(1 - v) - mS - \beta \frac{SI}{N}\
\frac{dE}{dt} &= \beta \frac{SI}{N} - aE - mE\
\frac{dI}{dt} &= aE - mI - \gamma I\
\frac{dR}{dt} &= \gamma I - mR + mv(S + E + I + R)
\end{align}
]
pars_vars <- c("$S$",
"$E$",
"$I$",
"$R$",
"$m$",
"$\\beta$",
"$a$",
"$\\gamma$",
"$v$")
descriptions <- c("Population size of susceptible individuals",
"Population size of exposed (not yet infectious) individuals",
"Population size of infectious individuals",
"Population size of recovered individuals",
"Birth/death rate",
"Infection rate",
"Inverse of incubation period",
"Recovery rate",
"Newborn vaccination rate")
param_df <- data.frame(pars_vars, descriptions)
kable(x = param_df, format = "html",
col.names = c("Parameter/Variable", "Description")) %>%
kable_styling(full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
position = "center")
sidebarLayout(
sidebarPanel(
### Ask user for parameter values ----
#m - death/birth rate
#beta - infection rate
#a - inverse of incubation period
#gamma - recovery rate
#v - vaccination rate
sliderInput("m_seir_ft", label = "Birth/Death rate:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta_seir_ft", label = "Infection rate:",
min = 0, max = 1, value = .35, step = 0.01),
sliderInput("a_seir_ft", label = "Inverse of incubation period:",
min = 0, max = 1, value = 0.2, step = 0.01),
sliderInput("gamma_seir_ft", label = "Recovery rate:",
min = 0, max = 1, value = .1, step = 0.01),
sliderInput("v_seir_ft", label = "Vaccination rate:",
min = 0, max = 1, value = 0, step = 0.1),
### Ask user for initial conditions ----
numericInput("S0_seir_ft", label = "Initial population size of S",
min = 0, value = 50),
numericInput("E0_seir_ft", label = "Initial population size of E",
min = 0, value = 0),
numericInput("I0_seir_ft", label = "Initial population size of I",
min = 0, value = 20),
numericInput("R0_seir_ft", label = "Initial population size of R",
min = 0, value = 0),
### Ask user for time to simulate ----
numericInput("time_seir_ft", label = "Time to simulate",
min = 10, value = 100)
),
# Render plots -----------------
mainPanel(renderPlot({plots_to_render_seir_ft()}, width = 600, height = 800))
)
# Run the simulation -------------------
# Set the initial population sizes
init_seir_ft <- reactive({
c(S = input$S0_seir_ft, E = input$E0_seir_ft,
I = input$I0_seir_ft, R = input$R0_seir_ft)
})
# Set the parameter values
params_seir_ft <- reactive({
c(m = input$m_seir_ft, beta = input$beta_seir_ft,
a = input$a_seir_ft, gamma = input$gamma_seir_ft, v = input$v_seir_ft)
})
# Time over which to simulate model dynamics
time_seir_ft <- reactive({seq(0, input$time_seir_ft, by = .1)})
# Simulate model dynamics
out_seir_ft <- reactive({
data.frame(run_infectiousdisease_model(time = time_seir_ft(),
params = params_seir_ft(),
init = init_seir_ft(),
model_type = "SEIR_ft"))
})
# Reshape the data so that population sizes of both
# species are in one column, and an extra column to define
# species name. This helps with the plotting...
# out_long_seir_ft <- reactive({
# pivot_longer(out_seir_ft(), c(S, E, I, R), "group") %>%
# mutate(group = factor(group, levels = c("S", "E", "I", "R")))
# })
# use out to create dS, dE, dI, dR, and the per capita changes in population
# pop_out_seir_ft <- reactive({
# pop_out <- out_seir_ft()
# pop_out$dS <- c(NA, diff(pop_out$S))
# pop_out$dE <- c(NA, diff(pop_out$E))
# pop_out$dI <- c(NA, diff(pop_out$I))
# pop_out$dR <- c(NA, diff(pop_out$R))
# # not using pgrs right now but could be useful to calculate
# pop_out <- pop_out %>%
# mutate(pgrS = dS/S, pgrE = dE/E, pgrI = dI/I, pgrR = dR/R)
# pop_out
# })
# pop_out_long_seir_ft <- reactive({
# pop_out_seir_ft() %>%
# select(time, dS, dE, dI, dR) %>%
# pivot_longer(c(dS, dE, dI, dR), "group") %>%
# mutate(group = factor(group, levels = c("dS", "dE", "dI", "dR")))
# })
# Make plots --------------------
# Plot abundance through time ----------
abund_plot_seir_ft <- reactive({
plot_infectiousdisease_time(out_seir_ft(), model_type = "SEIR_ft")
})
# Plot S vs E ---------
SEplot_seir_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_seir_ft(),
x_axis = "S", y_axis = "E")
})
# Plot S vs I ---------
SIplot_seir_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_seir_ft(),
x_axis = "S", y_axis = "I")
})
# Plot S vs R ---------
SRplot_seir_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_seir_ft(),
x_axis = "S", y_axis = "R")
})
# Plot E vs I ---------
EIplot_seir_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_seir_ft(),
x_axis = "E", y_axis = "I")
})
# Plot E vs R ---------
ERplot_seir_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_seir_ft(),
x_axis = "E", y_axis = "R")
})
# Plot R vs I ---------
RIplot_seir_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_seir_ft(),
x_axis = "R", y_axis = "I")
})
# combine 2d plots -----
SEIR_2d_plots_ft <- reactive({
wrap_plots(SEplot_seir_ft(), SIplot_seir_ft(), SRplot_seir_ft(),
EIplot_seir_ft(), ERplot_seir_ft(), RIplot_seir_ft(), ncol = 3)
})
# Make a list of plots and print out plots based on which ones were requested ----
plots_to_render_seir_ft <- reactive({
wrap_plots(abund_plot_seir_ft(),
# dabund_plot_seir(),
SEIR_2d_plots_ft(), nrow = 2)
})
SIRD model
[
\begin{align}
\frac{dS}{dt} &= m(S + I + R)(1 - v) - mS - \beta \frac{SI}{N}\
\frac{dI}{dt} &= \beta \frac{SI}{N} - mI - \gamma I - \mu I\
\frac{dR}{dt} &= \gamma I - mR + mv(S + I + R)\
\frac{dD}{dt} &= \mu I\
\end{align}
]
pars_vars <- c("$S$",
"$I$",
"$R$",
"$D$",
"$m$",
"$\\beta$",
"$\\gamma$",
"$\\mu$",
"$v$")
descriptions <- c("Population size of susceptible individuals",
"Population size of infectious individuals",
"Population size of recovered individuals",
"Number of individuals who die due to infection",
"Birth/death rate",
"Infection rate",
"Recovery rate",
"Death rate from infection",
"Newborn vaccination rate")
param_df <- data.frame(pars_vars, descriptions)
kable(x = param_df, format = "html",
col.names = c("Parameter/Variable", "Description")) %>%
kable_styling(full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
position = "center")
sidebarLayout(
sidebarPanel(
### Ask user for parameter values ----
#m - death/birth rate
#beta - infection rate
#mu - death rate due to infection
#gamma - recovery rate
#v - vaccination rate
sliderInput("m_sird_ft", label = "Birth/Death rate:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta_sird_ft", label = "Infection rate:",
min = 0, max = 1, value = .35, step = 0.01),
sliderInput("gamma_sird_ft", label = "Recovery rate:",
min = 0, max = 1, value = .1, step = 0.01),
sliderInput("mu_sird_ft", label = "Death rate due to infection:",
min = 0, max = 1, value = 0.01, step = 0.01),
sliderInput("v_sird_ft", label = "Vaccination rate:",
min = 0, max = 1, value = 0, step = 0.1),
### Ask user for initial conditions ----
numericInput("S0_sird_ft", label = "Initial population size of S",
min = 0, value = 50),
numericInput("I0_sird_ft", label = "Initial population size of I",
min = 0, value = 20),
numericInput("R0_sird_ft", label = "Initial population size of R",
min = 0, value = 0),
### Ask user for time to simulate ----
numericInput("time_sird_ft", label = "Time to simulate",
min = 10, value = 100)
),
# Render plots -----------------
mainPanel(renderPlot({plots_to_render_sird_ft()}, width = 600, height = 800))
)
# Run the simulation -------------------
# Set the initial population sizes
init_sird_ft <- reactive({
c(S = input$S0_sird_ft, I = input$I0_sird_ft, R = input$R0_sird_ft, D = 0)
})
# Set the parameter values
params_sird_ft <- reactive({
c(m = input$m_sird_ft, beta = input$beta_sird_ft,
mu = input$mu_sird_ft, gamma = input$gamma_sird_ft, v = input$v_sird_ft)
})
# Time over which to simulate model dynamics
time_sird_ft <- reactive({seq(0, input$time_sird_ft, by = .1)})
# Simulate model dynamics
out_sird_ft <- reactive({
data.frame(run_infectiousdisease_model(time = time_sird_ft(),
params = params_sird_ft(),
init = init_sird_ft(),
model_type = "SIRD_ft"))
})
# Reshape the data for plotting
# out_long_sird_ft <- reactive({
# pivot_longer(out_sird_ft(), c(S, I, R, D), "group") %>%
# mutate(group = factor(group, levels = c("S", "I", "R", "D")))
# })
# use out to create dS, dD, dI, dR, and the per capita changes in population
# pop_out_sird_ft <- reactive({
# pop_out <- out_sird_ft()
# pop_out$dS <- c(NA, diff(pop_out$S))
# pop_out$dI <- c(NA, diff(pop_out$I))
# pop_out$dR <- c(NA, diff(pop_out$R))
# pop_out$dD <- c(NA, diff(pop_out$D))
# # not using pgrs right now but could be useful to calculate
# pop_out <- pop_out %>%
# mutate(pgrS = dS/S, pgrI = dI/I, pgrR = dR/R, pgrD = dD/D)
# pop_out
# })
# pop_out_long_sird_ft <- reactive({
# pop_out_sird_ft() %>%
# select(time, dS, dI, dR, dD) %>%
# pivot_longer(c(dS, dI, dR, dD), "group") %>%
# mutate(group = factor(group, levels = c("dS", "dI", "dR", "dD")))
# })
# Make plots --------------------
# Plot abundance through time ----------
abund_plot_sird_ft <- reactive({
plot_infectiousdisease_time(out_sird_ft(), model_type = "SIRD_ft")
})
# Plot S vs D ---------
SDplot_sird_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_sird_ft(),
x_axis = "S", y_axis = "D")
})
# Plot S vs I ---------
SIplot_sird_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_sird_ft(),
x_axis = "S", y_axis = "I")
})
# Plot S vs R ---------
SRplot_sird_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_sird_ft(),
x_axis = "S", y_axis = "R")
})
# Plot D vs I ---------
DIplot_sird_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_sird_ft(),
x_axis = "D", y_axis = "I")
})
# Plot D vs R ---------
DRplot_sird_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_sird_ft(),
x_axis = "D", y_axis = "R")
})
# Plot R vs I ---------
RIplot_sird_ft <- reactive({
plot_infectiousdisease_portrait(sim_df = out_sird_ft(),
x_axis = "R", y_axis = "I")
})
# combine 2d plots -----
SIRD_2d_plots_ft <- reactive({
wrap_plots(SIplot_sird_ft(), SRplot_sird_ft(), SDplot_sird_ft(),
RIplot_sird_ft(), DIplot_sird_ft(), DRplot_sird_ft(), ncol = 3)
})
# Make a list of plots and print out plots based on which ones were requested ----
plots_to_render_sird_ft <- reactive({
wrap_plots(abund_plot_sird_ft(),
# dabund_plot_sird(),
SIRD_2d_plots_ft(), nrow = 2)
})
suppressWarnings(ecoevoapps::print_app_footer())
gauravsk/ecoevoapps documentation built on July 9, 2024, 9:37 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
中文 | Español | English | português | Turkish
knitr::opts_chunk$set(echo = TRUE) # library(tidyverse) library(ggplot2) library(tidyr) library(purrr) library(dplyr) library(deSolve) library(ecoevoapps) library(patchwork) library(kableExtra) theme_set(ecoevoapps::theme_apps())
This app implements a category of models from epidemiology called Compartment models. These models are designed to model the spread of diseases through populations that are made of individuals in different compartments, like individuals who are susceptible to the disease, exposed individuals, infected individuals, recovered individuals, etc. Different models can include different compartments, based on the population being studied and the dynamics of the infection. For more details on compartment models, please refer to the Wikipedia page or refer to this paper.
Models Assuming Density-Dependent Transmission {.tabset}
All of the following disease models assume that infectious individuals mix homogeneously with other individuals in the population and that infections occur in direct proportion to the number of encounters between susceptible and infectious individuals (i.e., disease transmission is density-dependent and happens at rate $\beta SI$).
Open versus closed populations: All of the models here include vital rates (i.e., births/deaths), which is called an open population. They assume that the number of births = the number of non-disease-induced deaths. If the course of the infection is short relative to individual lifespan, the vital rates can be ignored. Models that do not include vital rates are said to model a closed population. To run a model in this app without vital rates, set $m = 0$.
SIR model
[ \begin{align} \frac{dS}{dt} &= m(S + I + R)(1 - v) - mS - \beta SI\ \frac{dI}{dt} &= \beta SI - mI - \gamma I\ \frac{dR}{dt} &= \gamma I - mR + mv(S + I + R) \end{align} ]
pars_vars <- c("$S$", "$I$", "$R$", "$m$", "$\\beta$", "$\\gamma$", "$v$") descriptions <- c("Population size of susceptible individuals", "Population size of infectious individuals", "Population size of recovered individuals", "Birth/death rate", "Infection rate", "Recovery rate", "Newborn vaccination rate") param_df <- data.frame(pars_vars, descriptions) kable(x = param_df, format = "html", col.names = c("Parameter/Variable", "Description")) %>% kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed"), position = "center")
sidebarLayout( sidebarPanel( ### Ask user for parameter values ---- # m - death/birth rate; beta - infection rate # gamma - recovery rate; v - vaccination rate sliderInput("m", label = "Birth/Death rate:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta", label = "Infection rate:", min = 0, max = 1, value = .01, step = 0.01), sliderInput("gamma", label = "Recovery rate:", min = 0, max = 1, value = .2, step = 0.01), sliderInput("v", label = "Vaccination rate:", min = 0, max = 1, value = 0, step = 0.1), ### Ask user for initial conditions ---- numericInput("S0", label = "Initial population size of S", min = 0, value = 100), numericInput("I0", label = "Initial population size of I", min = 0, value = 1), numericInput("R0", label = "Initial population size of R", min = 0, value = 0), ### Ask user for time to simulate ---- numericInput("time", label = "Time to simulate", min = 10, value = 100) ), # Render plots ----------------- mainPanel(renderPlot({plots_to_render_SIR()}, width = 600, height = 800)) ) # Run the simulation ------------------- # Set the initial population sizes init <- reactive({c(S = input$S0, I = input$I0, R = input$R0)}) # Set the parameter values params <- reactive({c(m = input$m, beta = input$beta, v = input$v, gamma = input$gamma)}) # Time over which to simulate model dynamics time <- reactive({seq(0,input$time,by = .1)}) # Simulate model dynamics out <- reactive({ data.frame(run_infectiousdisease_model(time = time(), params = params(), init = init(), model_type = "SIR")) }) # Reshape the data for plotting # out_long <- reactive({ # pivot_longer(out(), c(S, I, R), "group") %>% # mutate(group = factor(group, levels = c("S", "I", "R"))) # }) # use out to create dS, dI, dR, and the per capita changes in population # pop_out <- reactive({ # pop_out <- out() # pop_out$dS <- c(NA, diff(pop_out$S)) # pop_out$dI <- c(NA, diff(pop_out$I)) # pop_out$dR <- c(NA, diff(pop_out$R)) # # not using pgrs right now but could be useful to calculate # pop_out <- pop_out %>% mutate(pgrS = dS/S, pgrI = dI/I, pgrR = dR/R) # pop_out # }) # # pop_out_long <- reactive({ # pop_out() %>% # select(time, dS, dI, dR) %>% # pivot_longer(c(dS, dI, dR), "group") %>% # mutate(group = factor(group, levels = c("dS", "dI", "dR"))) # }) # Make plots ------------------- # Plot abundance through time ---------- abund_plot_SIR <- reactive({ plot_infectiousdisease_time(out(), model_type = "SIR") }) # # Plot dS, dI, dR over time # dabund_plot_SIR <- reactive({ ggplot(pop_out_long()) + # geom_line(aes(x = time, y = value, color = group), size = 2) + # scale_color_brewer(palette = "Set1") + # ylab("Change in population size") # }) # Plot S vs I --------- SIplot <- reactive({ plot_infectiousdisease_portrait(sim_df = out(), x_axis = "S", y_axis = "I") }) # Plot I vs R -------------- RIplot <- reactive({ plot_infectiousdisease_portrait(sim_df = out(), x_axis = "R", y_axis = "I") }) # Plot S vs R ------------ SRplot <- reactive({ plot_infectiousdisease_portrait(sim_df = out(), x_axis = "S", y_axis = "R") }) # combine 2d plots ----- SIR_2d_plots <- reactive({ wrap_plots(SIplot(), RIplot(), SRplot(), ncol = 3) }) # Make a list of plots and print out plots based on which ones were requested ---- plots_to_render_SIR <- reactive({ wrap_plots(abund_plot_SIR(), # dabund_plot_SIR(), SIR_2d_plots(), nrow = 2) })
SIS model
[ \begin{align} \frac{dS}{dt} &= m(S + I) - mS - \beta SI + \gamma I\ \frac{dI}{dt} &= \beta SI - mI - \gamma I\ \end{align} ]
pars_vars <- c("$S$", "$I$", "$m$", "$\\beta$", "$\\gamma$", "$v$") descriptions <- c("Population size of susceptible individuals", "Population size of infectious individuals", "Birth/death rate", "Infection rate", "Recovery rate", "Newborn vaccination rate") param_df <- data.frame(pars_vars, descriptions) kable(x = param_df, format = "html", col.names = c("Parameter/Variable", "Description")) %>% kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed"), position = "center")
sidebarLayout( sidebarPanel( ### Ask user for parameter values ---- # m - death/birth rate; beta - infection rate; gamma - recovery rate sliderInput("m_sis", label = "Birth/Death rate:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta_sis", label = "Infection rate:", min = 0, max = 1, value = .01, step = 0.01), sliderInput("gamma_sis", label = "Recovery rate:", min = 0, max = 1, value = .2, step = 0.01), ### Ask user for initial conditions ---- numericInput("S0_sis", label = "Initial population size of S", min = 0, value = 100), numericInput("I0_sis", label = "Initial population size of I", min = 0, value = 1), ### Ask user for time to simulate ---- numericInput("time_sis", label = "Time to simulate", min = 10, value = 100) ), # Render plots ----------------- mainPanel(renderPlot({plots_to_render_sis()}, width = 600, height = 800)) ) # Run the simulation ------------------- # Set the initial population sizes init_sis <- reactive({c(S = input$S0_sis, I = input$I0_sis)}) # Set the parameter values params_sis <- reactive({ c(m = input$m_sis, beta = input$beta_sis, gamma = input$gamma_sis) }) # Time over which to simulate model dynamics time_sis <- reactive({seq(0, input$time_sis, by = .1)}) # Simulate model dynamics out_sis <- reactive({ data.frame(run_infectiousdisease_model(time = time_sis(), params = params_sis(), init = init_sis(), model_type = "SIS")) }) # Reshape the data so for plotting # out_long_sis <- reactive({ # pivot_longer(out_sis(), c(S, I), "group") %>% # mutate(group = factor(group, levels = c("S", "I"))) # }) # use out to create dS, dI, dR, and the per capita changes in population # pop_out_sis <- reactive({ # pop_out <- out_sis() # pop_out$dS <- c(NA, diff(pop_out$S)) # pop_out$dI <- c(NA, diff(pop_out$I)) # # not using pgrs right now but could be useful to calculate # pop_out <- pop_out %>% mutate(pgrS = dS/S, pgrI = dI/I) # pop_out # }) # # pop_out_long_sis <- reactive({ # pop_out_sis() %>% # select(time, dS, dI) %>% # pivot_longer(c(dS, dI), "group") %>% # mutate(group = factor(group, levels = c("dS", "dI"))) # }) # Make plots -------------------- # Plot abundance through time abund_plot_sis <- reactive({ plot_infectiousdisease_time(out_sis(), model_type = "SIS") }) # Plot S vs I SIplot_sis <- reactive({ plot_infectiousdisease_portrait(sim_df = out_sis(), x_axis = "S", y_axis = "I") }) # Make a list of plots and print out plots based on which ones were requested ---- plots_to_render_sis <- reactive({ wrap_plots(abund_plot_sis(), # dabund_plot_sis(), SIplot_sis(), nrow = 2) })
SEIR model
[ \begin{align} \frac{dS}{dt} &= m(S + E + I + R)(1 - v) - mS - \beta SI\ \frac{dE}{dt} &= \beta SI - aE - mE\ \frac{dI}{dt} &= aE - mI - \gamma I\ \frac{dR}{dt} &= \gamma I - mR + mv(S + E + I + R) \end{align} ]
pars_vars <- c("$S$", "$E$", "$I$", "$R$", "$m$", "$\\beta$", "$a$", "$\\gamma$", "$v$") descriptions <- c("Population size of susceptible individuals", "Population size of exposed (not yet infectious) individuals", "Population size of infectious individuals", "Population size of recovered individuals", "Birth/death rate", "Infection rate", "Inverse of incubation period", "Recovery rate", "Newborn vaccination rate") param_df <- data.frame(pars_vars, descriptions) kable(x = param_df, format = "html", col.names = c("Parameter/Variable", "Description")) %>% kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed"), position = "center")
sidebarLayout( sidebarPanel( ### Ask user for parameter values ---- #m - death/birth rate; beta - infection rate; a - inverse of incubation period #gamma - recovery rate; v - vaccination rate sliderInput("m_seir", label = "Birth/Death rate:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta_seir", label = "Infection rate:", min = 0, max = 1, value = .01, step = 0.01), sliderInput("a_seir", label = "Inverse of incubation period:", min = 0, max = 1, value = 0.05, step = 0.01), sliderInput("gamma_seir", label = "Recovery rate:", min = 0, max = 1, value = .2, step = 0.01), sliderInput("v_seir", label = "Vaccination rate:", min = 0, max = 1, value = 0, step = 0.1), ### Ask user for initial conditions ---- numericInput("S0_seir", label = "Initial population size of S", min = 0, value = 100), numericInput("E0_seir", label = "Initial population size of E", min = 0, value = 0), numericInput("I0_seir", label = "Initial population size of I", min = 0, value = 1), numericInput("R0_seir", label = "Initial population size of R", min = 0, value = 0), ### Ask user for time to simulate ---- numericInput("time_seir", label = "Time to simulate", min = 10, value = 100) ), # Render plots ----------------- mainPanel(renderPlot({plots_to_render_seir()}, width = 600, height = 800)) ) # Run the simulation ------------------- # Set the initial population sizes init_seir <- reactive({ c(S = input$S0_seir, E = input$E0_seir, I = input$I0_seir, R = input$R0_seir) }) # Set the parameter values params_seir <- reactive({ c(m = input$m_seir, beta = input$beta_seir, a = input$a_seir, gamma = input$gamma_seir, v = input$v_seir)}) # Time over which to simulate model dynamics time_seir <- reactive({seq(0, input$time_seir, by = .1)}) # Simulate model dynamics out_seir <- reactive({ data.frame(run_infectiousdisease_model(time = time_seir(), params = params_seir(), init = init_seir(), model_type = "SEIR")) }) # Reshape the data for plotting # out_long_seir <- reactive({ # pivot_longer(out_seir(), c(S, E, I, R), "group") %>% # mutate(group = factor(group, levels = c("S", "E", "I", "R"))) # }) # use out to create dS, dE, dI, dR, and the per capita changes in population # pop_out_seir <- reactive({ # pop_out <- out_seir() # pop_out$dS <- c(NA, diff(pop_out$S)) # pop_out$dE <- c(NA, diff(pop_out$E)) # pop_out$dI <- c(NA, diff(pop_out$I)) # pop_out$dR <- c(NA, diff(pop_out$R)) # # not using pgrs right now but could be useful to calculate # pop_out <- pop_out %>% mutate(pgrS = dS/S, pgrE = dE/E, pgrI = dI/I, pgrR = dR/R) # pop_out # }) # # pop_out_long_seir <- reactive({ # pop_out_seir() %>% # select(time, dS, dE, dI, dR) %>% # pivot_longer(c(dS, dE, dI, dR), "group") %>% # mutate(group = factor(group, levels = c("dS", "dE", "dI", "dR"))) # }) # Make plots -------------------- # Plot abundance through time ---------- abund_plot_seir <- reactive({ plot_infectiousdisease_time(out_seir(), model_type = "SEIR") }) # # Plot dS, dE, dI, dR over time # dabund_plot_seir <- reactive({ ggplot(pop_out_long_seir()) + # geom_line(aes(x = time, y = value, color = group), size = 2) + # scale_color_brewer(palette = "Set1") + # ylab("Change in population size") # }) # Plot S vs E --------- SEplot_seir <- reactive({ plot_infectiousdisease_portrait(sim_df = out_seir(), x_axis = "S", y_axis = "E") }) # Plot S vs I --------- SIplot_seir <- reactive({ plot_infectiousdisease_portrait(sim_df = out_seir(), x_axis = "S", y_axis = "I") }) # Plot S vs R --------- SRplot_seir <- reactive({ plot_infectiousdisease_portrait(sim_df = out_seir(), x_axis = "S", y_axis = "R") }) # Plot E vs I --------- EIplot_seir <- reactive({ plot_infectiousdisease_portrait(sim_df = out_seir(), x_axis = "E", y_axis = "I") }) # Plot E vs R --------- ERplot_seir <- reactive({ plot_infectiousdisease_portrait(sim_df = out_seir(), x_axis = "E", y_axis = "R") }) # Plot R vs I --------- RIplot_seir <- reactive({ plot_infectiousdisease_portrait(sim_df = out_seir(), x_axis = "R", y_axis = "I") }) # combine 2d plots ----- SEIR_2d_plots <- reactive({ wrap_plots(SEplot_seir(), SIplot_seir(), SRplot_seir(), EIplot_seir(), ERplot_seir(), RIplot_seir(), ncol = 3) }) # Make a list of plots and print out plots based on which ones were requested ---- plots_to_render_seir <- reactive({ wrap_plots(abund_plot_seir(), # dabund_plot_seir(), SEIR_2d_plots(), nrow = 2) })
SIRD model
[ \begin{align} \frac{dS}{dt} &= m(S + I + R)(1 - v) - mS - \beta SI\ \frac{dI}{dt} &= \beta SI - mI - \gamma I - \mu I\ \frac{dR}{dt} &= \gamma I - mR + mv(S + I + R)\ \frac{dD}{dt} &= \mu I\ \end{align} ]
pars_vars <- c("$S$", "$I$", "$R$", "$D$", "$m$", "$\\beta$", "$\\gamma$", "$\\mu$", "$v$") descriptions <- c("Population size of susceptible individuals", "Population size of infectious individuals", "Population size of recovered individuals", "Number of individuals who die due to infection", "Birth/death rate", "Infection rate", "Recovery rate", "Death rate from infection", "Newborn vaccination rate") param_df <- data.frame(pars_vars, descriptions) kable(x = param_df, format = "html", col.names = c("Parameter/Variable", "Description")) %>% kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed"), position = "center")
sidebarLayout( sidebarPanel( ### Ask user for parameter values ---- #m - death/birth rate; beta - infection rate; mu - death rate due to infection #gamma - recovery rate; v - vaccination rate sliderInput("m_sird", label = "Birth/Death rate:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta_sird", label = "Infection rate:", min = 0, max = 1, value = .01, step = 0.01), sliderInput("gamma_sird", label = "Recovery rate:", min = 0, max = 1, value = .2, step = 0.01), sliderInput("mu_sird", label = "Death rate due to infection:", min = 0, max = 1, value = 0.05, step = 0.01), sliderInput("v_sird", label = "Vaccination rate:", min = 0, max = 1, value = 0, step = 0.1), ### Ask user for initial conditions ---- numericInput("S0_sird", label = "Initial population size of S", min = 0, value = 100), numericInput("I0_sird", label = "Initial population size of I", min = 0, value = 1), numericInput("R0_sird", label = "Initial population size of R", min = 0, value = 0), numericInput("D0_sird", label = "Initial population size of D", min = 0, value = 0), ### Ask user for time to simulate ---- numericInput("time_sird", label = "Time to simulate", min = 10, value = 100) ), # Render plots ----------------- mainPanel(renderPlot({plots_to_render_sird()}, width = 600, height = 800)) ) # Run the simulation ------------------- # Set the initial population sizes init_sird <- reactive({ c(S = input$S0_sird, I = input$I0_sird, R = input$R0_sird, D = input$D0_sird) }) # Set the parameter values params_sird <- reactive({ c(m = input$m_sird, beta = input$beta_sird, mu = input$mu_sird, gamma = input$gamma_sird, v = input$v_sird) }) # Time over which to simulate model dynamics time_sird <- reactive({seq(0, input$time_sird, by = .1)}) # Simulate model dynamics out_sird <- reactive({ data.frame(run_infectiousdisease_model(time = time_sird(), params = params_sird(), init = init_sird(), model_type = "SIRD")) }) # Reshape the data for plotting # out_long_sird <- reactive({ # pivot_longer(out_sird(), c(S, I, R, D), "group") %>% # mutate(group = factor(group, levels = c("S", "I", "R", "D"))) # }) # use out to create dS, dD, dI, dR, and the per capita changes in population # pop_out_sird <- reactive({ # pop_out <- out_sird() # pop_out$dS <- c(NA, diff(pop_out$S)) # pop_out$dI <- c(NA, diff(pop_out$I)) # pop_out$dR <- c(NA, diff(pop_out$R)) # pop_out$dD <- c(NA, diff(pop_out$D)) # # not using pgrs right now but could be useful to calculate # pop_out <- pop_out %>% # mutate(pgrS = dS/S, pgrI = dI/I, pgrR = dR/R, pgrD = dD/D) # pop_out # }) # pop_out_long_sird <- reactive({ # pop_out_sird() %>% # select(time, dS, dI, dR, dD) %>% # pivot_longer(c(dS, dI, dR, dD), "group") %>% # mutate(group = factor(group, levels = c("dS", "dI", "dR", "dD"))) # }) # Make plots -------------------- # Plot abundance through time ---------- abund_plot_sird <- reactive({ plot_infectiousdisease_time(out_sird(), model_type = "SIRD") # ggplot(out_long_sird()) + # geom_line(aes(x = time, y = value, color = group), size = 2) + # scale_color_brewer(palette = "Set1") + # ylab("Population size") }) # Plot S vs D --------- SDplot_sird <- reactive({ plot_infectiousdisease_portrait(sim_df = out_sird(), x_axis = "S", y_axis = "D") }) # Plot S vs I --------- SIplot_sird <- reactive({ plot_infectiousdisease_portrait(sim_df = out_sird(), x_axis = "S", y_axis = "I") }) # Plot S vs R --------- SRplot_sird <- reactive({ plot_infectiousdisease_portrait(sim_df = out_sird(), x_axis = "S", y_axis = "R") }) # Plot D vs I --------- DIplot_sird <- reactive({ plot_infectiousdisease_portrait(sim_df = out_sird(), x_axis = "D", y_axis = "I") }) # Plot D vs R --------- DRplot_sird <- reactive({ plot_infectiousdisease_portrait(sim_df = out_sird(), x_axis = "D", y_axis = "R") }) # Plot R vs I --------- RIplot_sird <- reactive({ plot_infectiousdisease_portrait(sim_df = out_sird(), x_axis = "R", y_axis = "I") }) # combine 2d plots ----- SIRD_2d_plots <- reactive({ wrap_plots(SIplot_sird(), SRplot_sird(), SDplot_sird(), RIplot_sird(), DIplot_sird(), DRplot_sird(), ncol = 3) }) # Make a list of plots and print out plots based on which ones were requested ---- plots_to_render_sird <- reactive({ wrap_plots(abund_plot_sird(), # dabund_plot_sird(), SIRD_2d_plots(), nrow = 2) })
Models Assuming Frequency-Dependent Transmission {.tabset}
All of the following disease models assume that disease transmission depends on the frequency of susceptible individuals in the population as opposed to the absolute number of susceptible individuals. Thus, the disease is transmitted at rate $\beta \frac{SI}{N}$ instead of $\beta SI$.
Open versus closed populations: All of the models here include vital rates (i.e., births/deaths), which is called an open population. They assume that the number of births = the number of non-disease-induced deaths. If the course of the infection is short relative to individual lifespan, the vital rates can be ignored. Models that do not include vital rates are said to model a closed population. To run a model in this app without vital rates, set $m = 0$.
SIR model
[ \begin{align} \frac{dS}{dt} &= m(S + I + R)(1 - v) - mS - \beta \frac{SI}{N}\ \frac{dI}{dt} &= \beta \frac{SI}{N} - mI - \gamma I\ \frac{dR}{dt} &= \gamma I - mR + mv(S + I + R) \end{align} ]
pars_vars <- c("$S$", "$I$", "$R$", "$m$", "$\\beta$", "$\\gamma$", "$v$") descriptions <- c("Population size of susceptible individuals", "Population size of infectious individuals", "Population size of recovered individuals", "Birth/death rate", "Infection rate", "Recovery rate", "Newborn vaccination rate") param_df <- data.frame(pars_vars, descriptions) kable(x = param_df, format = "html", col.names = c("Parameter/Variable", "Description")) %>% kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed"), position = "center")
sidebarLayout( sidebarPanel( ### Ask user for parameter values ---- #m - death/birth rate; beta - infection rate #gamma - recovery rate; v - vaccination rate sliderInput("m_ft", label = "Birth/Death rate:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta_ft", label = "Infection rate:", min = 0, max = 1, value = .2, step = 0.01), sliderInput("gamma_ft", label = "Recovery rate:", min = 0, max = 1, value = .1, step = 0.01), sliderInput("v_ft", label = "Vaccination rate:", min = 0, max = 1, value = 0, step = 0.1), ### Ask user for initial conditions ---- numericInput("S0_ft", label = "Initial population size of S", min = 0, value = 50), numericInput("I0_ft", label = "Initial population size of I", min = 0, value = 20), numericInput("R0_ft", label = "Initial population size of R", min = 0, value = 0), ### Ask user for time to simulate ---- numericInput("time_ft", label = "Time to simulate", min = 10, value = 100) ), # Render plots ----------------- mainPanel(renderPlot({plots_to_render_SIR_ft()}, width = 600, height = 800)) ) # Run the simulation ------------------- # Set the initial population sizes init_ft <- reactive({ c(S = input$S0_ft, I = input$I0_ft, R = input$R0_ft) }) # Set the parameter values params_ft <- reactive({ c(m = input$m_ft, beta = input$beta_ft, v = input$v_ft, gamma = input$gamma_ft) }) # Time over which to simulate model dynamics time_ft <- reactive({seq(0,input$time_ft,by = .1)}) # Simulate model dynamics out_ft <- reactive({ data.frame(run_infectiousdisease_model(time = time_ft(), params = params_ft(), init = init_ft(), model_type = "SIR_ft")) }) # Reshape the data for plotting # out_long_ft <- reactive({ # pivot_longer(out_ft(), c(S, I, R), "group") %>% # mutate(group = factor(group, levels = c("S", "I", "R"))) # }) # use out to create dS, dI, dR, and the per capita changes in population # pop_out_ft <- reactive({ # pop_out <- out_ft() # pop_out$dS <- c(NA, diff(pop_out$S)) # pop_out$dI <- c(NA, diff(pop_out$I)) # pop_out$dR <- c(NA, diff(pop_out$R)) # # not using pgrs right now but could be useful to calculate # pop_out <- pop_out %>% # mutate(pgrS = dS/S, pgrI = dI/I, pgrR = dR/R) # pop_out # }) # pop_out_long_ft <- reactive({ # pop_out_ft() %>% # select(time, dS, dI, dR) %>% # pivot_longer(c(dS, dI, dR), "group") %>% # mutate(group = factor(group, levels = c("dS", "dI", "dR"))) # }) # Make plots -------------------- # Plot abundance through time ---------- abund_plot_SIR_ft <- reactive({ plot_infectiousdisease_time(out_ft(), model_type = "SIR_ft") }) # Plot S vs I --------- SIplot_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_ft(), x_axis = "S", y_axis = "I") }) # Plot I vs R -------------- RIplot_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_ft(), x_axis = "R", y_axis = "I") }) # Plot S vs R ------------ SRplot_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_ft(), x_axis = "S", y_axis = "R") }) # combine 2d plots ----- SIR_2d_plots_ft <- reactive({ wrap_plots(SIplot_ft(), RIplot_ft(), SRplot_ft(), ncol = 3) }) # Make a list of plots and print out plots based on which ones were requested ---- plots_to_render_SIR_ft <- reactive({ wrap_plots(abund_plot_SIR_ft(), # dabund_plot_SIR(), SIR_2d_plots_ft(), nrow = 2) })
SIS model
[ \begin{align} \frac{dS}{dt} &= m(S + I) - mS - \beta \frac{SI}{N} + \gamma I\ \frac{dI}{dt} &= \beta \frac{SI}{N} - mI - \gamma I\ \end{align} ]
pars_vars <- c("$S$", "$I$", "$m$", "$\\beta$", "$\\gamma$", "$v$") descriptions <- c("Population size of susceptible individuals", "Population size of infectious individuals", "Birth/death rate", "Infection rate", "Recovery rate", "Newborn vaccination rate") param_df <- data.frame(pars_vars, descriptions) kable(x = param_df, format = "html", col.names = c("Parameter/Variable", "Description")) %>% kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed"), position = "center")
sidebarLayout( sidebarPanel( ### Ask user for parameter values ---- #m - death/birth rate; beta - infection rate; gamma - recovery rate sliderInput("m_sis_ft", label = "Birth/Death rate:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta_sis_ft", label = "Infection rate:", min = 0, max = 1, value = .35, step = 0.01), sliderInput("gamma_sis_ft", label = "Recovery rate:", min = 0, max = 1, value = .1, step = 0.01), ### Ask user for initial conditions ---- numericInput("S0_sis_ft", label = "Initial population size of S", min = 0, value = 50), numericInput("I0_sis_ft", label = "Initial population size of I", min = 0, value = 20), ### Ask user for time to simulate ---- numericInput("time_sis_ft", label = "Time to simulate", min = 10, value = 100) ), # Render plots ----------------- mainPanel(renderPlot({plots_to_render_sis_ft()}, width = 600, height = 800)) ) # Run the simulation ------------------- # Set the initial population sizes init_sis_ft <- reactive({c(S = input$S0_sis_ft, I = input$I0_sis_ft)}) # Set the parameter values params_sis_ft <- reactive({ c(m = input$m_sis_ft, beta = input$beta_sis_ft, gamma = input$gamma_sis_ft) }) # Time over which to simulate model dynamics time_sis_ft <- reactive({seq(0, input$time_sis_ft, by = .1)}) # Simulate model dynamics out_sis_ft <- reactive({ data.frame(run_infectiousdisease_model(time = time_sis_ft(), params = params_sis_ft(), init = init_sis_ft(), model_type = "SIS_ft")) }) # Reshape the data so for plotting # out_long_sis_ft <- reactive({ # pivot_longer(out_sis_ft(), c(S, I), "group") %>% # mutate(group = factor(group, levels = c("S", "I"))) # }) # use out to create dS, dI, dR, and the per capita changes in population # pop_out_sis_ft <- reactive({ # pop_out <- out_sis_ft() # pop_out$dS <- c(NA, diff(pop_out$S)) # pop_out$dI <- c(NA, diff(pop_out$I)) # # not using pgrs right now but could be useful to calculate # pop_out <- pop_out %>% mutate(pgrS = dS/S, pgrI = dI/I) # pop_out # }) # # pop_out_long_sis_ft <- reactive({ # pop_out_sis_ft() %>% # select(time, dS, dI) %>% # pivot_longer(c(dS, dI), "group") %>% # mutate(group = factor(group, levels = c("dS", "dI"))) # }) # Make plots -------------------- # Plot abundance through time ---------- abund_plot_sis_ft <- reactive({ plot_infectiousdisease_time(out_sis_ft(), model_type = "SIS_ft") # ggplot(out_long_sis_ft()) + # geom_line(aes(x = time, y = value, color = group), size = 2) + # scale_color_brewer(palette = "Set1") + # ylab("Population size") }) # Plot S vs I --------- SIplot_sis_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_sis_ft(), x_axis = "S", y_axis = "I") }) # Make a list of plots and print out plots based on which ones were requested ---- plots_to_render_sis_ft <- reactive({ wrap_plots(abund_plot_sis_ft(), # dabund_plot_sis(), SIplot_sis_ft(), nrow = 2) })
SEIR model
[ \begin{align} \frac{dS}{dt} &= m(S + E + I + R)(1 - v) - mS - \beta \frac{SI}{N}\ \frac{dE}{dt} &= \beta \frac{SI}{N} - aE - mE\ \frac{dI}{dt} &= aE - mI - \gamma I\ \frac{dR}{dt} &= \gamma I - mR + mv(S + E + I + R) \end{align} ]
pars_vars <- c("$S$", "$E$", "$I$", "$R$", "$m$", "$\\beta$", "$a$", "$\\gamma$", "$v$") descriptions <- c("Population size of susceptible individuals", "Population size of exposed (not yet infectious) individuals", "Population size of infectious individuals", "Population size of recovered individuals", "Birth/death rate", "Infection rate", "Inverse of incubation period", "Recovery rate", "Newborn vaccination rate") param_df <- data.frame(pars_vars, descriptions) kable(x = param_df, format = "html", col.names = c("Parameter/Variable", "Description")) %>% kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed"), position = "center")
sidebarLayout( sidebarPanel( ### Ask user for parameter values ---- #m - death/birth rate #beta - infection rate #a - inverse of incubation period #gamma - recovery rate #v - vaccination rate sliderInput("m_seir_ft", label = "Birth/Death rate:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta_seir_ft", label = "Infection rate:", min = 0, max = 1, value = .35, step = 0.01), sliderInput("a_seir_ft", label = "Inverse of incubation period:", min = 0, max = 1, value = 0.2, step = 0.01), sliderInput("gamma_seir_ft", label = "Recovery rate:", min = 0, max = 1, value = .1, step = 0.01), sliderInput("v_seir_ft", label = "Vaccination rate:", min = 0, max = 1, value = 0, step = 0.1), ### Ask user for initial conditions ---- numericInput("S0_seir_ft", label = "Initial population size of S", min = 0, value = 50), numericInput("E0_seir_ft", label = "Initial population size of E", min = 0, value = 0), numericInput("I0_seir_ft", label = "Initial population size of I", min = 0, value = 20), numericInput("R0_seir_ft", label = "Initial population size of R", min = 0, value = 0), ### Ask user for time to simulate ---- numericInput("time_seir_ft", label = "Time to simulate", min = 10, value = 100) ), # Render plots ----------------- mainPanel(renderPlot({plots_to_render_seir_ft()}, width = 600, height = 800)) ) # Run the simulation ------------------- # Set the initial population sizes init_seir_ft <- reactive({ c(S = input$S0_seir_ft, E = input$E0_seir_ft, I = input$I0_seir_ft, R = input$R0_seir_ft) }) # Set the parameter values params_seir_ft <- reactive({ c(m = input$m_seir_ft, beta = input$beta_seir_ft, a = input$a_seir_ft, gamma = input$gamma_seir_ft, v = input$v_seir_ft) }) # Time over which to simulate model dynamics time_seir_ft <- reactive({seq(0, input$time_seir_ft, by = .1)}) # Simulate model dynamics out_seir_ft <- reactive({ data.frame(run_infectiousdisease_model(time = time_seir_ft(), params = params_seir_ft(), init = init_seir_ft(), model_type = "SEIR_ft")) }) # Reshape the data so that population sizes of both # species are in one column, and an extra column to define # species name. This helps with the plotting... # out_long_seir_ft <- reactive({ # pivot_longer(out_seir_ft(), c(S, E, I, R), "group") %>% # mutate(group = factor(group, levels = c("S", "E", "I", "R"))) # }) # use out to create dS, dE, dI, dR, and the per capita changes in population # pop_out_seir_ft <- reactive({ # pop_out <- out_seir_ft() # pop_out$dS <- c(NA, diff(pop_out$S)) # pop_out$dE <- c(NA, diff(pop_out$E)) # pop_out$dI <- c(NA, diff(pop_out$I)) # pop_out$dR <- c(NA, diff(pop_out$R)) # # not using pgrs right now but could be useful to calculate # pop_out <- pop_out %>% # mutate(pgrS = dS/S, pgrE = dE/E, pgrI = dI/I, pgrR = dR/R) # pop_out # }) # pop_out_long_seir_ft <- reactive({ # pop_out_seir_ft() %>% # select(time, dS, dE, dI, dR) %>% # pivot_longer(c(dS, dE, dI, dR), "group") %>% # mutate(group = factor(group, levels = c("dS", "dE", "dI", "dR"))) # }) # Make plots -------------------- # Plot abundance through time ---------- abund_plot_seir_ft <- reactive({ plot_infectiousdisease_time(out_seir_ft(), model_type = "SEIR_ft") }) # Plot S vs E --------- SEplot_seir_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_seir_ft(), x_axis = "S", y_axis = "E") }) # Plot S vs I --------- SIplot_seir_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_seir_ft(), x_axis = "S", y_axis = "I") }) # Plot S vs R --------- SRplot_seir_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_seir_ft(), x_axis = "S", y_axis = "R") }) # Plot E vs I --------- EIplot_seir_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_seir_ft(), x_axis = "E", y_axis = "I") }) # Plot E vs R --------- ERplot_seir_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_seir_ft(), x_axis = "E", y_axis = "R") }) # Plot R vs I --------- RIplot_seir_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_seir_ft(), x_axis = "R", y_axis = "I") }) # combine 2d plots ----- SEIR_2d_plots_ft <- reactive({ wrap_plots(SEplot_seir_ft(), SIplot_seir_ft(), SRplot_seir_ft(), EIplot_seir_ft(), ERplot_seir_ft(), RIplot_seir_ft(), ncol = 3) }) # Make a list of plots and print out plots based on which ones were requested ---- plots_to_render_seir_ft <- reactive({ wrap_plots(abund_plot_seir_ft(), # dabund_plot_seir(), SEIR_2d_plots_ft(), nrow = 2) })
SIRD model
[ \begin{align} \frac{dS}{dt} &= m(S + I + R)(1 - v) - mS - \beta \frac{SI}{N}\ \frac{dI}{dt} &= \beta \frac{SI}{N} - mI - \gamma I - \mu I\ \frac{dR}{dt} &= \gamma I - mR + mv(S + I + R)\ \frac{dD}{dt} &= \mu I\ \end{align} ]
pars_vars <- c("$S$", "$I$", "$R$", "$D$", "$m$", "$\\beta$", "$\\gamma$", "$\\mu$", "$v$") descriptions <- c("Population size of susceptible individuals", "Population size of infectious individuals", "Population size of recovered individuals", "Number of individuals who die due to infection", "Birth/death rate", "Infection rate", "Recovery rate", "Death rate from infection", "Newborn vaccination rate") param_df <- data.frame(pars_vars, descriptions) kable(x = param_df, format = "html", col.names = c("Parameter/Variable", "Description")) %>% kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed"), position = "center")
sidebarLayout( sidebarPanel( ### Ask user for parameter values ---- #m - death/birth rate #beta - infection rate #mu - death rate due to infection #gamma - recovery rate #v - vaccination rate sliderInput("m_sird_ft", label = "Birth/Death rate:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta_sird_ft", label = "Infection rate:", min = 0, max = 1, value = .35, step = 0.01), sliderInput("gamma_sird_ft", label = "Recovery rate:", min = 0, max = 1, value = .1, step = 0.01), sliderInput("mu_sird_ft", label = "Death rate due to infection:", min = 0, max = 1, value = 0.01, step = 0.01), sliderInput("v_sird_ft", label = "Vaccination rate:", min = 0, max = 1, value = 0, step = 0.1), ### Ask user for initial conditions ---- numericInput("S0_sird_ft", label = "Initial population size of S", min = 0, value = 50), numericInput("I0_sird_ft", label = "Initial population size of I", min = 0, value = 20), numericInput("R0_sird_ft", label = "Initial population size of R", min = 0, value = 0), ### Ask user for time to simulate ---- numericInput("time_sird_ft", label = "Time to simulate", min = 10, value = 100) ), # Render plots ----------------- mainPanel(renderPlot({plots_to_render_sird_ft()}, width = 600, height = 800)) ) # Run the simulation ------------------- # Set the initial population sizes init_sird_ft <- reactive({ c(S = input$S0_sird_ft, I = input$I0_sird_ft, R = input$R0_sird_ft, D = 0) }) # Set the parameter values params_sird_ft <- reactive({ c(m = input$m_sird_ft, beta = input$beta_sird_ft, mu = input$mu_sird_ft, gamma = input$gamma_sird_ft, v = input$v_sird_ft) }) # Time over which to simulate model dynamics time_sird_ft <- reactive({seq(0, input$time_sird_ft, by = .1)}) # Simulate model dynamics out_sird_ft <- reactive({ data.frame(run_infectiousdisease_model(time = time_sird_ft(), params = params_sird_ft(), init = init_sird_ft(), model_type = "SIRD_ft")) }) # Reshape the data for plotting # out_long_sird_ft <- reactive({ # pivot_longer(out_sird_ft(), c(S, I, R, D), "group") %>% # mutate(group = factor(group, levels = c("S", "I", "R", "D"))) # }) # use out to create dS, dD, dI, dR, and the per capita changes in population # pop_out_sird_ft <- reactive({ # pop_out <- out_sird_ft() # pop_out$dS <- c(NA, diff(pop_out$S)) # pop_out$dI <- c(NA, diff(pop_out$I)) # pop_out$dR <- c(NA, diff(pop_out$R)) # pop_out$dD <- c(NA, diff(pop_out$D)) # # not using pgrs right now but could be useful to calculate # pop_out <- pop_out %>% # mutate(pgrS = dS/S, pgrI = dI/I, pgrR = dR/R, pgrD = dD/D) # pop_out # }) # pop_out_long_sird_ft <- reactive({ # pop_out_sird_ft() %>% # select(time, dS, dI, dR, dD) %>% # pivot_longer(c(dS, dI, dR, dD), "group") %>% # mutate(group = factor(group, levels = c("dS", "dI", "dR", "dD"))) # }) # Make plots -------------------- # Plot abundance through time ---------- abund_plot_sird_ft <- reactive({ plot_infectiousdisease_time(out_sird_ft(), model_type = "SIRD_ft") }) # Plot S vs D --------- SDplot_sird_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_sird_ft(), x_axis = "S", y_axis = "D") }) # Plot S vs I --------- SIplot_sird_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_sird_ft(), x_axis = "S", y_axis = "I") }) # Plot S vs R --------- SRplot_sird_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_sird_ft(), x_axis = "S", y_axis = "R") }) # Plot D vs I --------- DIplot_sird_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_sird_ft(), x_axis = "D", y_axis = "I") }) # Plot D vs R --------- DRplot_sird_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_sird_ft(), x_axis = "D", y_axis = "R") }) # Plot R vs I --------- RIplot_sird_ft <- reactive({ plot_infectiousdisease_portrait(sim_df = out_sird_ft(), x_axis = "R", y_axis = "I") }) # combine 2d plots ----- SIRD_2d_plots_ft <- reactive({ wrap_plots(SIplot_sird_ft(), SRplot_sird_ft(), SDplot_sird_ft(), RIplot_sird_ft(), DIplot_sird_ft(), DRplot_sird_ft(), ncol = 3) }) # Make a list of plots and print out plots based on which ones were requested ---- plots_to_render_sird_ft <- reactive({ wrap_plots(abund_plot_sird_ft(), # dabund_plot_sird(), SIRD_2d_plots_ft(), nrow = 2) })
suppressWarnings(ecoevoapps::print_app_footer())
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.