diff --git a/R/server-functions.R b/R/server-functions.R
index 6e4a93d..9fb8e92 100644
--- a/R/server-functions.R
+++ b/R/server-functions.R
@@ -210,3 +210,29 @@ plot_epi <- function(model, mark_max) {
)
return(plot)
}
+
+#' plot_reproductive_epi Function
+#'
+#' This function generates a plot of the reproductive number over time
+#' @param model The model object
+#'
+#' @return A plot displaying the reproductive number for the model over the
+#' course of the simulation
+#'
+#' @export
+plot_reproductive_epi <- function (model) {
+ # Calculating average rep. number for each unique source_exposure_date
+ rep_num <- get_reproductive_number(model)
+ average_rt <- aggregate(rt ~ source_exposure_date, data = rep_num,
+ FUN = mean)
+ # Plotting
+ reproductive_plot <- plot_ly(data = average_rt, x = ~source_exposure_date,
+ y = ~rt, type = 'scatter',
+ mode = 'lines+markers')
+ reproductive_plot <-
+ reproductive_plot |>
+ plotly::layout(title = "Reproductive Number",
+ xaxis = list(title = 'Day (step)'),
+ yaxis = list(title = 'Average Rep. Number'))
+ return(reproductive_plot)
+}
\ No newline at end of file
diff --git a/models/shiny_seir.R b/models/shiny_seir.R
index 4bfddcb..699762b 100644
--- a/models/shiny_seir.R
+++ b/models/shiny_seir.R
@@ -31,12 +31,7 @@ shiny_seir <- function(input) {
# Summary
summary_seir <- function() summary(model_seir)
# Reproductive Number
- reproductive_seir <- function()
- plot_reproductive_number(
- model_seir,
- main = "SEIR Model Reproductive Number"
- )
-
+ reproductive_seir <- function() plot_reproductive_epi(model_seir)
# Table
table_seir <- function() {
diff --git a/models/shiny_seirconn.R b/models/shiny_seirconn.R
index ee81fa4..6df440d 100644
--- a/models/shiny_seirconn.R
+++ b/models/shiny_seirconn.R
@@ -21,15 +21,8 @@ shiny_seirconn <- function(input) {
# Plot, summary, and reproductive number
plot_seirconn <- function() plot_epi(model_seirconn)
-
summary_seirconn <- function() summary(model_seirconn)
-
- reproductive_seirconn <- function()
- plot_reproductive_number(
- model_seirconn,
- main = "SEIRCONNECTED Model Reproductive Number"
- )
-
+ reproductive_seirconn <- function() plot_reproductive_epi(model_seirconn)
# Table
table_seirconn <- function() {
df <- as.data.frame(get_hist_total(model_seirconn))
diff --git a/models/shiny_seirconnequity.R b/models/shiny_seirconnequity.R
index 0a4b1d7..37fcd41 100644
--- a/models/shiny_seirconnequity.R
+++ b/models/shiny_seirconnequity.R
@@ -139,13 +139,9 @@ shiny_seirconnequity <- function(input) {
}
summary_seirconnequity <- function() summary(model_seirconnequity)
+ reproductive_seirconnequity <-
+ function() plot_reproductive_epi(model_seirconnequity)
- reproductive_seirconnequity <- function()
- plot_reproductive_number(
- model_seirconnequity,
- main = "SEIRCONNECTED Model Reproductive Number"
- )
-
# Table
table_seirconnequity <- function() {
df <- as.data.frame(get_hist_total(model_seirconnequity))
diff --git a/models/shiny_seird.R b/models/shiny_seird.R
index 8be8fa2..c49a262 100644
--- a/models/shiny_seird.R
+++ b/models/shiny_seird.R
@@ -32,45 +32,31 @@ shiny_seird <- function(input) {
# Summary
summary_seird <- function() summary(model_seird)
# Reproductive Number
- reproductive_seird <- function()
- plot_reproductive_number(
- model_seird,
- main = "SEIRD Model Reproductive Number"
- )
-
+ reproductive_seird <- function() plot_reproductive_epi(model_seird)
# Table
table_seird <- function() {
-
df <- as.data.frame(get_hist_total(model_seird))
-
# Subset to only include "infection" state
infection_data <- df[df$state == "Infected", ]
-
# Row with the maximum count
max_infection_row <- infection_data[which.max(infection_data$counts), ]
-
# Row number of the maximum count in the original data frame
max_row_number <- which(
df$date == max_infection_row$date & df$state == "Infected"
)
-
df[max_row_number,"counts"] <- sprintf(
"%s",
df[max_row_number, "counts"]
)
-
# Making sure factor variables are ordered
df$state <- factor(
x = df$state,
levels = c("Susceptible", "Exposed", "Infected", "Removed")
)
-
# Reshaping the data to wide format
df <- reshape(df, idvar = "date", timevar = "state", direction = "wide")
-
colnames(df) <- gsub(colnames(df), pattern = "counts.", replacement = "")
df
-
}
# Output list
diff --git a/models/shiny_sir.R b/models/shiny_sir.R
index 3b84592..e76abbe 100644
--- a/models/shiny_sir.R
+++ b/models/shiny_sir.R
@@ -29,12 +29,7 @@ shiny_sir <- function(input) {
# Plot, summary and repnum
plot_sir <- function() plot_epi(model_sir)
summary_sir <- function() summary(model_sir)
- reproductive_sir <- function()
- plot_reproductive_number(
- model_sir,
- main = "SIR Model Reproductive Number"
- )
-
+ reproductive_sir <- function() plot_reproductive_epi(model_sir)
# Table
table_sir <- function() {
df <- as.data.frame(get_hist_total(model_sir))
diff --git a/models/shiny_sirconn.R b/models/shiny_sirconn.R
index 70cd361..c8806e3 100644
--- a/models/shiny_sirconn.R
+++ b/models/shiny_sirconn.R
@@ -19,15 +19,8 @@ shiny_sirconn <- function(input) {
# Plot, summary, and reproductive number
plot_sirconn <- function() plot_epi(model_sirconn)
-
summary_sirconn <- function() summary(model_sirconn)
-
- reproductive_sirconn <- function()
- plot_reproductive_number(
- model_sirconn,
- main = "SIRCONNECTED Model Reproductive Number"
- )
-
+ reproductive_sirconn <- function() plot_reproductive_epi(model_sirconn)
# Table
table_sirconn <- function() {
df <- as.data.frame(get_hist_total(model_sirconn))
diff --git a/models/shiny_sird.R b/models/shiny_sird.R
index 751b80f..0a2cba7 100644
--- a/models/shiny_sird.R
+++ b/models/shiny_sird.R
@@ -30,12 +30,7 @@ shiny_sird <- function(input) {
# Plot, summary, and repnum
plot_sird <- function() plot_epi(model_sird)
summary_sird <- function() summary(model_sird)
- reproductive_sird <- function()
- plot_reproductive_number(
- model_sird,
- main = "SIRD Model Reproductive Number"
- )
-
+ reproductive_sird <- function() plot_reproductive_epi(model_sird)
# Table
table_sird <- function() {
df <- as.data.frame(get_hist_total(model_sird))
diff --git a/models/shiny_sis.R b/models/shiny_sis.R
index 2af15cb..91157f2 100644
--- a/models/shiny_sis.R
+++ b/models/shiny_sis.R
@@ -28,15 +28,8 @@ shiny_sis <- function(input) {
# Plot, summary, and reproductive number
plot_sis <- function() plot_epi(model_sis)
-
summary_sis <- function() summary(model_sis)
-
- reproductive_sis <- function()
- plot_reproductive_number(
- model_sis,
- main = "SIS Model Reproductive Number"
- )
-
+ reproductive_sis <- function() plot_reproductive_epi(model_sis)
# Table
table_sis <- function() {
df <- as.data.frame(get_hist_total(model_sis))
diff --git a/models/shiny_sisd.R b/models/shiny_sisd.R
index a767530..73fcb2a 100644
--- a/models/shiny_sisd.R
+++ b/models/shiny_sisd.R
@@ -30,12 +30,7 @@ shiny_sisd <- function(input) {
# Plot, summary, and repnum
plot_sisd <- function() plot_epi(model_sisd)
summary_sisd <- function() summary(model_sisd)
- reproductive_sisd <- function()
- plot_reproductive_number(
- model_sisd,
- main = "SISD Model Reproductive Number"
- )
-
+ reproductive_sisd <- function() plot_reproductive_epi(model_sisd)
# Table
table_sisd <- function() {
df <- as.data.frame(get_hist_total(model_sisd))
diff --git a/server.R b/server.R
index 85faae5..655403d 100644
--- a/server.R
+++ b/server.R
@@ -45,7 +45,7 @@ function(input, output) {
output$model_plot <- renderPlotly({
model_output()$epicurves_plot()
})
- output$model_reproductive_plot <- renderPlot({
+ output$model_reproductive_plot <- renderPlotly({
model_output()$reproductive_plot()
})
output$model_summary <- renderPrint({
diff --git a/ui.R b/ui.R
index 1c23e0f..1c00eec 100644
--- a/ui.R
+++ b/ui.R
@@ -99,7 +99,7 @@ body <- dashboardBody(
),
fluidRow(
column(6, plotlyOutput("model_plot") %>% withSpinner(color="#009bff")),
- column(6, plotOutput("model_reproductive_plot") %>% withSpinner(color="#009bff"))
+ column(6, plotlyOutput("model_reproductive_plot") %>% withSpinner(color="#009bff"))
),
HTML("
"),
fluidRow(