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())
Este aplicativo usa uma categoria de modelos epidemiológicos chamados modelos compartimentalizados. Esse tipo de modelo é desenhado para simular o alastramento de doenças contagiosas em populações compostas de indivíduos em diferentes compartimentos: indivíduos suscetíveis ao contágio, indivíduos expostos à doença, indivíduos recuperados, etc. Cada modelo específico inclui compartimentos diferentes, dependendo do tipo de população estudada e da dinâmica de infecção da doença. Para saber mais detalhes sobre modelos compartimentalizados veja a página sobre o tópico da Wikipédia ou leia este artigo.
Modelos que assumem transmissão denso-dependente {.tabset}
Todos os modelos abaixo assumem que indivíduos infectados se misturam homogeneamente entre os demais indivíduos de uma população e que as infecções ocorrem em proporção direta ao número de encontros entre indivíduos suscetíveis (S) e aqueles já infectados (I). Ou seja, a transmissão da doença é denso-dependente e ocorre a uma taxa $\beta SI$.
Populações abertas ou fechadas: Todos os modelos abaixo incluem taxas vitais (natalidade e mortalidade) típicas de populações abertas. Esses modelos assumem que o número de nascimentos é igual ao número de mortes não causadas pela doença. Se o curso da infecção é curto comparado ao tempo de vida dos indivíduos, essas taxas vitais podem ser ignoradas. Modelos que não incluem taxas vitais tratam de populações fechadas. Para rodar um modelo de população fechada neste aplicativo simplesmente zere a taxa de mortalidade ($m = 0$).
Modelo SIR
[
\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("Número de indivíduos suscetíveis à doença",
"Número de indivíduos infecciosos",
"Número de indivíduos recuperados",
"Taxa de natalidade/mortalidade",
"Taxa de infecção",
"Taxa de recuperação",
"Taxa de vacinação de recém-nascidos")
param_df <- data.frame(pars_vars, descriptions)
kable(x = param_df, format = "html",
col.names = c("Parâmetro/variável", "Descrição")) %>%
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 = "Taxa de natalidade/mortalidade:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta", label = "Taxa de infecção:",
min = 0, max = 1, value = .01, step = 0.01),
sliderInput("gamma", label = "Taxa de recuperação:",
min = 0, max = 1, value = .2, step = 0.01),
sliderInput("v", label = "Taxa de vacinação:",
min = 0, max = 1, value = 0, step = 0.1),
### Ask user for initial conditions ----
numericInput("S0", label = "Número inicial de indivíduos S",
min = 0, value = 100),
numericInput("I0", label = "Número inicial de indivíduos I",
min = 0, value = 1),
numericInput("R0", label = "Número inicial de indivíduos R",
min = 0, value = 0),
### Ask user for time to simulate ----
numericInput("time", label = "Tempo a ser projetado", 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)
})
Modelo SIS
[
\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("Número de indivíduos suscetíveis à doença",
"Número de indivíduos infecciosos",
"Taxa de natalidade/mortalidade",
"Taxa de infecção",
"Taxa de recuperação",
"Taxa de vacinação de recém-nascidos")
param_df <- data.frame(pars_vars, descriptions)
kable(x = param_df, format = "html",
col.names = c("Parâmetro/variável", "Descrição")) %>%
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 = "Taxa de natalidade/mortalidade:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta_sis", label = "Taxa de infecção:",
min = 0, max = 1, value = .01, step = 0.01),
sliderInput("gamma_sis", label = "Taxa de recuperação:",
min = 0, max = 1, value = .2, step = 0.01),
### Ask user for initial conditions ----
numericInput("S0_sis", label = "Número inicial de indivíduos S",
min = 0, value = 100),
numericInput("I0_sis", label = "Número inicial de indivíduos I",
min = 0, value = 1),
### Ask user for time to simulate ----
numericInput("time_sis", label = "Tempo a ser projetado", 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)
})
Modelo SEIR
[
\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("Número de indivíduos suscetíveis à doença",
"Número de indivíduos expostos, mas ainda não infecciosos",
"Número de indivíduos infecciosos",
"Número de indivíduos recuperados",
"Taxa de natalidade/mortalidade",
"Taxa de infecção",
"Inverso do período de incubação",
"Taxa de recuperação",
"Taxa de vacinação de recém-nascidos")
param_df <- data.frame(pars_vars, descriptions)
kable(x = param_df, format = "html",
col.names = c("Parâmetro/variável", "Descrição")) %>%
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 = "Taxa de natalidade/mortalidade:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta_seir", label = "Taxa de infecção:",
min = 0, max = 1, value = .01, step = 0.01),
sliderInput("a_seir", label = "Inverso do período de incubação:",
min = 0, max = 1, value = 0.05, step = 0.01),
sliderInput("gamma_seir", label = "Taxa de recuperação:",
min = 0, max = 1, value = .2, step = 0.01),
sliderInput("v_seir", label = "Taxa de vacinação:",
min = 0, max = 1, value = 0, step = 0.1),
### Ask user for initial conditions ----
numericInput("S0_seir", label = "Número inicial de indivíduos S",
min = 0, value = 100),
numericInput("E0_seir", label = "Número inicial de indivíduos E",
min = 0, value = 0),
numericInput("I0_seir", label = "Número inicial de indivíduos I",
min = 0, value = 1),
numericInput("R0_seir", label = "Número inicial de indivíduos R",
min = 0, value = 0),
### Ask user for time to simulate ----
numericInput("time_seir", label = "Tempo a ser projetado", 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)
})
Modelo SIRD
[
\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("Número de indivíduos suscetíveis à doença",
"Número de indivíduos infecciosos",
"Número de indivíduos recuperados",
"Número de indivíduos mortos pela doença",
"Taxa de natalidade/mortalidade",
"Taxa de infecção",
"Taxa de recuperação",
"Taxa de mortalidade pela infecção",
"Taxa de vacinação de recém-nascidos")
param_df <- data.frame(pars_vars, descriptions)
kable(x = param_df, format = "html",
col.names = c("Parâmetro/variável", "Descrição")) %>%
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 = "Taxa de natalidade/mortalidade:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta_sird", label = "Taxa de infecção:",
min = 0, max = 1, value = .01, step = 0.01),
sliderInput("gamma_sird", label = "Taxa de recuperação:",
min = 0, max = 1, value = .2, step = 0.01),
sliderInput("mu_sird", label = "Taxa de mortalidade pela infecção:",
min = 0, max = 1, value = 0.05, step = 0.01),
sliderInput("v_sird", label = "Taxa de vacinação:",
min = 0, max = 1, value = 0, step = 0.1),
### Ask user for initial conditions ----
numericInput("S0_sird", label = "Número inicial de indivíduos S",
min = 0, value = 100),
numericInput("I0_sird", label = "Número inicial de indivíduos I",
min = 0, value = 1),
numericInput("R0_sird", label = "Número inicial de indivíduos R",
min = 0, value = 0),
numericInput("D0_sird", label = "Número inicial de indivíduos D",
min = 0, value = 0),
### Ask user for time to simulate ----
numericInput("time_sird", label = "Tempo a ser projetado", 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)
})
Modelos que assumem transmissão dependente de frequência {.tabset}
Todos os modelos a seguir assumem que a transmissão da doença depende da frequência de indivíduos suscetíveis na população em vez do número total de indivíduos suscetíveis. A doença, portanto, é transmitida a uma taxa $\beta \frac{SI}{N}$ em vez de $\beta SI$.
Modelo SIR
[
\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("Número de indivíduos suscetíveis à doença",
"Número de indivíduos infecciosos",
"Número de indivíduos recuperados",
"Taxa de natalidade/mortalidade",
"Taxa de infecção",
"Taxa de recuperação",
"Taxa de vacinação de recém-nascidos")
param_df <- data.frame(pars_vars, descriptions)
kable(x = param_df, format = "html",
col.names = c("Parâmetro/variável", "Descrição")) %>%
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 = "Taxa de natalidade/mortalidade:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta_ft", label = "Taxa de infecção:",
min = 0, max = 1, value = .2, step = 0.01),
sliderInput("gamma_ft", label = "Taxa de recuperação:",
min = 0, max = 1, value = .1, step = 0.01),
sliderInput("v_ft", label = "Taxa de vacinação:",
min = 0, max = 1, value = 0, step = 0.1),
### Ask user for initial conditions ----
numericInput("S0_ft", label = "Número inicial de indivíduos S",
min = 0, value = 50),
numericInput("I0_ft", label = "Número inicial de indivíduos I",
min = 0, value = 20),
numericInput("R0_ft", label = "Número inicial de indivíduos R",
min = 0, value = 0),
### Ask user for time to simulate ----
numericInput("time_ft", label = "Tempo a ser projetado", 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)
})
Modelo SIS
[
\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("Número de indivíduos suscetíveis à doença",
"Número de indivíduos infecciosos",
"Taxa de natalidade/mortalidade",
"Taxa de infecção",
"Taxa de recuperação",
"Taxa de vacinação de recém-nascidos")
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 = "Taxa de natalidade/mortalidade:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta_sis_ft", label = "Taxa de infecção:",
min = 0, max = 1, value = .35, step = 0.01),
sliderInput("gamma_sis_ft", label = "Taxa de recuperação:",
min = 0, max = 1, value = .1, step = 0.01),
### Ask user for initial conditions ----
numericInput("S0_sis_ft", label = "Número inicial de indivíduos S",
min = 0, value = 50),
numericInput("I0_sis_ft", label = "Número inicial de indivíduos I",
min = 0, value = 20),
### Ask user for time to simulate ----
numericInput("time_sis_ft", label = "Tempo a ser projetado",
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)
})
Modelo SEIR
[
\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("Número de indivíduos suscetíveis à doença",
"Número de indivíduos expostos, mas ainda não infecciosos",
"Número de indivíduos infecciosos",
"Número de indivíduos recuperados",
"Taxa de natalidade/mortalidade",
"Taxa de infecção",
"Inverso do período de incubação",
"Taxa de recuperação",
"Taxa de vacinação de recém-nascidos")
param_df <- data.frame(pars_vars, descriptions)
kable(x = param_df, format = "html",
col.names = c("Parâmetro/variável", "Descrição")) %>%
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 = "Taxa de natalidade/mortalidade:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta_seir_ft", label = "Taxa de infecção:",
min = 0, max = 1, value = .35, step = 0.01),
sliderInput("a_seir_ft", label = "Inverso do período de incubação:",
min = 0, max = 1, value = 0.2, step = 0.01),
sliderInput("gamma_seir_ft", label = "Taxa de recuperação:",
min = 0, max = 1, value = .1, step = 0.01),
sliderInput("v_seir_ft", label = "Taxa de vacinação:",
min = 0, max = 1, value = 0, step = 0.1),
### Ask user for initial conditions ----
numericInput("S0_seir_ft", label = "Número inicial de indivíduos S",
min = 0, value = 50),
numericInput("E0_seir_ft", label = "Número inicial de indivíduos E",
min = 0, value = 0),
numericInput("I0_seir_ft", label = "Número inicial de indivíduos I",
min = 0, value = 20),
numericInput("R0_seir_ft", label = "Número inicial de indivíduos R",
min = 0, value = 0),
### Ask user for time to simulate ----
numericInput("time_seir_ft", label = "Tempo a ser projetado",
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)
})
Modelo SIRD
[
\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("Número de indivíduos suscetíveis à doença",
"Número de indivíduos infecciosos",
"Número de indivíduos recuperados",
"Número de indivíduos mortos pela doença",
"Taxa de natalidade/mortalidade",
"Taxa de infecção",
"Taxa de recuperação",
"Taxa de mortalidade pela infecção",
"Taxa de vacinação de recém-nascidos")
param_df <- data.frame(pars_vars, descriptions)
kable(x = param_df, format = "html",
col.names = c("Parâmetro/variável", "Descrição")) %>%
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 = "Taxa de natalidade/mortalidade:",
min = 0, max = 1, value = .1, step = 0.1),
sliderInput("beta_sird_ft", label = "Taxa de infecção:",
min = 0, max = 1, value = .35, step = 0.01),
sliderInput("gamma_sird_ft", label = "Taxa de recuperação:",
min = 0, max = 1, value = .1, step = 0.01),
sliderInput("mu_sird_ft", label = "Taxa de mortalidade pela infecção:",
min = 0, max = 1, value = 0.01, step = 0.01),
sliderInput("v_sird_ft", label = "Taxa de vacinação:",
min = 0, max = 1, value = 0, step = 0.1),
### Ask user for initial conditions ----
numericInput("S0_sird_ft", label = "Número inicial de indivíduos S",
min = 0, value = 50),
numericInput("I0_sird_ft", label = "Número inicial de indivíduos I",
min = 0, value = 20),
numericInput("R0_sird_ft", label = "Número inicial de indivíduos R",
min = 0, value = 0),
### Ask user for time to simulate ----
numericInput("time_sird_ft", label = "Tempo a ser projetado",
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(language = "pt"))
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())
Este aplicativo usa uma categoria de modelos epidemiológicos chamados modelos compartimentalizados. Esse tipo de modelo é desenhado para simular o alastramento de doenças contagiosas em populações compostas de indivíduos em diferentes compartimentos: indivíduos suscetíveis ao contágio, indivíduos expostos à doença, indivíduos recuperados, etc. Cada modelo específico inclui compartimentos diferentes, dependendo do tipo de população estudada e da dinâmica de infecção da doença. Para saber mais detalhes sobre modelos compartimentalizados veja a página sobre o tópico da Wikipédia ou leia este artigo.
Modelos que assumem transmissão denso-dependente {.tabset}
Todos os modelos abaixo assumem que indivíduos infectados se misturam homogeneamente entre os demais indivíduos de uma população e que as infecções ocorrem em proporção direta ao número de encontros entre indivíduos suscetíveis (S) e aqueles já infectados (I). Ou seja, a transmissão da doença é denso-dependente e ocorre a uma taxa $\beta SI$.
Populações abertas ou fechadas: Todos os modelos abaixo incluem taxas vitais (natalidade e mortalidade) típicas de populações abertas. Esses modelos assumem que o número de nascimentos é igual ao número de mortes não causadas pela doença. Se o curso da infecção é curto comparado ao tempo de vida dos indivíduos, essas taxas vitais podem ser ignoradas. Modelos que não incluem taxas vitais tratam de populações fechadas. Para rodar um modelo de população fechada neste aplicativo simplesmente zere a taxa de mortalidade ($m = 0$).
Modelo SIR
[ \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("Número de indivíduos suscetíveis à doença", "Número de indivíduos infecciosos", "Número de indivíduos recuperados", "Taxa de natalidade/mortalidade", "Taxa de infecção", "Taxa de recuperação", "Taxa de vacinação de recém-nascidos") param_df <- data.frame(pars_vars, descriptions) kable(x = param_df, format = "html", col.names = c("Parâmetro/variável", "Descrição")) %>% 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 = "Taxa de natalidade/mortalidade:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta", label = "Taxa de infecção:", min = 0, max = 1, value = .01, step = 0.01), sliderInput("gamma", label = "Taxa de recuperação:", min = 0, max = 1, value = .2, step = 0.01), sliderInput("v", label = "Taxa de vacinação:", min = 0, max = 1, value = 0, step = 0.1), ### Ask user for initial conditions ---- numericInput("S0", label = "Número inicial de indivíduos S", min = 0, value = 100), numericInput("I0", label = "Número inicial de indivíduos I", min = 0, value = 1), numericInput("R0", label = "Número inicial de indivíduos R", min = 0, value = 0), ### Ask user for time to simulate ---- numericInput("time", label = "Tempo a ser projetado", 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) })
Modelo SIS
[ \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("Número de indivíduos suscetíveis à doença", "Número de indivíduos infecciosos", "Taxa de natalidade/mortalidade", "Taxa de infecção", "Taxa de recuperação", "Taxa de vacinação de recém-nascidos") param_df <- data.frame(pars_vars, descriptions) kable(x = param_df, format = "html", col.names = c("Parâmetro/variável", "Descrição")) %>% 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 = "Taxa de natalidade/mortalidade:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta_sis", label = "Taxa de infecção:", min = 0, max = 1, value = .01, step = 0.01), sliderInput("gamma_sis", label = "Taxa de recuperação:", min = 0, max = 1, value = .2, step = 0.01), ### Ask user for initial conditions ---- numericInput("S0_sis", label = "Número inicial de indivíduos S", min = 0, value = 100), numericInput("I0_sis", label = "Número inicial de indivíduos I", min = 0, value = 1), ### Ask user for time to simulate ---- numericInput("time_sis", label = "Tempo a ser projetado", 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) })
Modelo SEIR
[ \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("Número de indivíduos suscetíveis à doença", "Número de indivíduos expostos, mas ainda não infecciosos", "Número de indivíduos infecciosos", "Número de indivíduos recuperados", "Taxa de natalidade/mortalidade", "Taxa de infecção", "Inverso do período de incubação", "Taxa de recuperação", "Taxa de vacinação de recém-nascidos") param_df <- data.frame(pars_vars, descriptions) kable(x = param_df, format = "html", col.names = c("Parâmetro/variável", "Descrição")) %>% 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 = "Taxa de natalidade/mortalidade:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta_seir", label = "Taxa de infecção:", min = 0, max = 1, value = .01, step = 0.01), sliderInput("a_seir", label = "Inverso do período de incubação:", min = 0, max = 1, value = 0.05, step = 0.01), sliderInput("gamma_seir", label = "Taxa de recuperação:", min = 0, max = 1, value = .2, step = 0.01), sliderInput("v_seir", label = "Taxa de vacinação:", min = 0, max = 1, value = 0, step = 0.1), ### Ask user for initial conditions ---- numericInput("S0_seir", label = "Número inicial de indivíduos S", min = 0, value = 100), numericInput("E0_seir", label = "Número inicial de indivíduos E", min = 0, value = 0), numericInput("I0_seir", label = "Número inicial de indivíduos I", min = 0, value = 1), numericInput("R0_seir", label = "Número inicial de indivíduos R", min = 0, value = 0), ### Ask user for time to simulate ---- numericInput("time_seir", label = "Tempo a ser projetado", 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) })
Modelo SIRD
[ \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("Número de indivíduos suscetíveis à doença", "Número de indivíduos infecciosos", "Número de indivíduos recuperados", "Número de indivíduos mortos pela doença", "Taxa de natalidade/mortalidade", "Taxa de infecção", "Taxa de recuperação", "Taxa de mortalidade pela infecção", "Taxa de vacinação de recém-nascidos") param_df <- data.frame(pars_vars, descriptions) kable(x = param_df, format = "html", col.names = c("Parâmetro/variável", "Descrição")) %>% 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 = "Taxa de natalidade/mortalidade:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta_sird", label = "Taxa de infecção:", min = 0, max = 1, value = .01, step = 0.01), sliderInput("gamma_sird", label = "Taxa de recuperação:", min = 0, max = 1, value = .2, step = 0.01), sliderInput("mu_sird", label = "Taxa de mortalidade pela infecção:", min = 0, max = 1, value = 0.05, step = 0.01), sliderInput("v_sird", label = "Taxa de vacinação:", min = 0, max = 1, value = 0, step = 0.1), ### Ask user for initial conditions ---- numericInput("S0_sird", label = "Número inicial de indivíduos S", min = 0, value = 100), numericInput("I0_sird", label = "Número inicial de indivíduos I", min = 0, value = 1), numericInput("R0_sird", label = "Número inicial de indivíduos R", min = 0, value = 0), numericInput("D0_sird", label = "Número inicial de indivíduos D", min = 0, value = 0), ### Ask user for time to simulate ---- numericInput("time_sird", label = "Tempo a ser projetado", 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) })
Modelos que assumem transmissão dependente de frequência {.tabset}
Todos os modelos a seguir assumem que a transmissão da doença depende da frequência de indivíduos suscetíveis na população em vez do número total de indivíduos suscetíveis. A doença, portanto, é transmitida a uma taxa $\beta \frac{SI}{N}$ em vez de $\beta SI$.
Modelo SIR
[ \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("Número de indivíduos suscetíveis à doença", "Número de indivíduos infecciosos", "Número de indivíduos recuperados", "Taxa de natalidade/mortalidade", "Taxa de infecção", "Taxa de recuperação", "Taxa de vacinação de recém-nascidos") param_df <- data.frame(pars_vars, descriptions) kable(x = param_df, format = "html", col.names = c("Parâmetro/variável", "Descrição")) %>% 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 = "Taxa de natalidade/mortalidade:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta_ft", label = "Taxa de infecção:", min = 0, max = 1, value = .2, step = 0.01), sliderInput("gamma_ft", label = "Taxa de recuperação:", min = 0, max = 1, value = .1, step = 0.01), sliderInput("v_ft", label = "Taxa de vacinação:", min = 0, max = 1, value = 0, step = 0.1), ### Ask user for initial conditions ---- numericInput("S0_ft", label = "Número inicial de indivíduos S", min = 0, value = 50), numericInput("I0_ft", label = "Número inicial de indivíduos I", min = 0, value = 20), numericInput("R0_ft", label = "Número inicial de indivíduos R", min = 0, value = 0), ### Ask user for time to simulate ---- numericInput("time_ft", label = "Tempo a ser projetado", 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) })
Modelo SIS
[ \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("Número de indivíduos suscetíveis à doença", "Número de indivíduos infecciosos", "Taxa de natalidade/mortalidade", "Taxa de infecção", "Taxa de recuperação", "Taxa de vacinação de recém-nascidos") 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 = "Taxa de natalidade/mortalidade:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta_sis_ft", label = "Taxa de infecção:", min = 0, max = 1, value = .35, step = 0.01), sliderInput("gamma_sis_ft", label = "Taxa de recuperação:", min = 0, max = 1, value = .1, step = 0.01), ### Ask user for initial conditions ---- numericInput("S0_sis_ft", label = "Número inicial de indivíduos S", min = 0, value = 50), numericInput("I0_sis_ft", label = "Número inicial de indivíduos I", min = 0, value = 20), ### Ask user for time to simulate ---- numericInput("time_sis_ft", label = "Tempo a ser projetado", 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) })
Modelo SEIR
[ \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("Número de indivíduos suscetíveis à doença", "Número de indivíduos expostos, mas ainda não infecciosos", "Número de indivíduos infecciosos", "Número de indivíduos recuperados", "Taxa de natalidade/mortalidade", "Taxa de infecção", "Inverso do período de incubação", "Taxa de recuperação", "Taxa de vacinação de recém-nascidos") param_df <- data.frame(pars_vars, descriptions) kable(x = param_df, format = "html", col.names = c("Parâmetro/variável", "Descrição")) %>% 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 = "Taxa de natalidade/mortalidade:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta_seir_ft", label = "Taxa de infecção:", min = 0, max = 1, value = .35, step = 0.01), sliderInput("a_seir_ft", label = "Inverso do período de incubação:", min = 0, max = 1, value = 0.2, step = 0.01), sliderInput("gamma_seir_ft", label = "Taxa de recuperação:", min = 0, max = 1, value = .1, step = 0.01), sliderInput("v_seir_ft", label = "Taxa de vacinação:", min = 0, max = 1, value = 0, step = 0.1), ### Ask user for initial conditions ---- numericInput("S0_seir_ft", label = "Número inicial de indivíduos S", min = 0, value = 50), numericInput("E0_seir_ft", label = "Número inicial de indivíduos E", min = 0, value = 0), numericInput("I0_seir_ft", label = "Número inicial de indivíduos I", min = 0, value = 20), numericInput("R0_seir_ft", label = "Número inicial de indivíduos R", min = 0, value = 0), ### Ask user for time to simulate ---- numericInput("time_seir_ft", label = "Tempo a ser projetado", 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) })
Modelo SIRD
[ \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("Número de indivíduos suscetíveis à doença", "Número de indivíduos infecciosos", "Número de indivíduos recuperados", "Número de indivíduos mortos pela doença", "Taxa de natalidade/mortalidade", "Taxa de infecção", "Taxa de recuperação", "Taxa de mortalidade pela infecção", "Taxa de vacinação de recém-nascidos") param_df <- data.frame(pars_vars, descriptions) kable(x = param_df, format = "html", col.names = c("Parâmetro/variável", "Descrição")) %>% 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 = "Taxa de natalidade/mortalidade:", min = 0, max = 1, value = .1, step = 0.1), sliderInput("beta_sird_ft", label = "Taxa de infecção:", min = 0, max = 1, value = .35, step = 0.01), sliderInput("gamma_sird_ft", label = "Taxa de recuperação:", min = 0, max = 1, value = .1, step = 0.01), sliderInput("mu_sird_ft", label = "Taxa de mortalidade pela infecção:", min = 0, max = 1, value = 0.01, step = 0.01), sliderInput("v_sird_ft", label = "Taxa de vacinação:", min = 0, max = 1, value = 0, step = 0.1), ### Ask user for initial conditions ---- numericInput("S0_sird_ft", label = "Número inicial de indivíduos S", min = 0, value = 50), numericInput("I0_sird_ft", label = "Número inicial de indivíduos I", min = 0, value = 20), numericInput("R0_sird_ft", label = "Número inicial de indivíduos R", min = 0, value = 0), ### Ask user for time to simulate ---- numericInput("time_sird_ft", label = "Tempo a ser projetado", 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(language = "pt"))
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.