Introduction to R Shiny II
Alex Alexiou, Chris Kypridemos
February 2024
1 What we have learned so far
Last week we went through the basics of the Shiny library, specifically we:
- Learned the basic structure of the Shiny app.
- Learned how to make a simple user interface, with side and main panels.
- Learned what about the different types of inputs (widgets) and outputs (text, plots).
- Make interactive apps that respond to user’s input with text and
plot outputs with the various
renderfunctions. - Talked about the basics of the SIR model and how we could built an application modelling disease spread.
2 Modelling disease spread using the SIR model
Consider again this scenario:
Suppose that you are health data scientist at the start of the COVID-19 pandemic. Assume that your task is to create a simple model and create an app that will show the model’s prediction on how SARS-CoV-2 will likely progress within the region based on user-specified model parameters.
We will use the basic SIR model to model the spread of the virus in
the population as time passes. We can use the
library(EpiDynamics) to calculate the model and we will
need to use the following parameters as input to the model:
Model parameters:
- Infectious period: Number of days being infectious.
- R naught: Basic reproduction number.
- Time period: The total number of days that we will run the model for.
The first two parameters capture the rate of flow from susceptible to infected, and infected to recovered (or dead - for simplicity, our model makes no distinction). The time period is a parameter that we need in order to specify the total time period of analysis within which we will calculate how the disease has progressed.
Furthermore, the model needs some initial conditions that describe the population we are trying to model:
- Total population : the total population of the region for which we carry out the analysis.
- Initially infected population : the number of initially infected at the start of the time period that start the pandemic (can be one person or more).
Let’s start by looking again at how the model can be calculated using
the EpiDynamics library. First let’s look at the output
table.
library(EpiDynamics)
infectious_period <- 7.0 # Days infectious
R0 <- 2.4 # Basic reproduction number in the absence of interventions
total_pop <- 496784 # Total population of e.g. Liverpool
init_infected <- 4 # Initially infected individuals that start the pandemic
time_period <- 120 # Total time that we will run the model for (in days)
# Calculations
parameters <- c(beta = R0/infectious_period, gamma = 1/infectious_period)
initials <- c(S = 1-(init_infected / total_pop), I = init_infected / total_pop, R = 0)
# Solve
sir <- SIR(pars = parameters, init = initials, time = 0:time_period)
# Extract the table results only
sir.results <- as.data.table(sir$results)
# Round up so they look prettier
sir.results[, 2:4 := lapply(.SD, function(x) round(x*total_pop)), .SDcols = 2:4]
# Table with results
sir.results## time S I R
## 1: 0 496780 4 0
## 2: 1 496778 5 1
## 3: 2 496777 6 1
## 4: 3 496774 7 2
## 5: 4 496772 9 4
## ---
## 117: 116 60703 949 435132
## 118: 117 60665 858 435261
## 119: 118 60631 775 435378
## 120: 119 60600 701 435483
## 121: 120 60572 633 435578# Plot
PlotMods(sir)
3 Interactive SIR model
See how we declared all of these parameters at the start of the code. The goal of this app will be to use widgets for the parameters, so that the user can easily adjust them, thus enabling them to evaluate different scenarios. Using what we learned so far, we will use a set of such input elements as parameter selectors, and output the model results.
For inputs, think about what would be best to use. Remember, some input elements are more suited than others depending on purpose. For example, a text box where one can type in the exact input will probably always work, however this approach is extremely prone to user error. It can make the app produce an error, or worst, crash, and the user losing all progress. A drop-down list (a.k.a. select box) with predefined values is less prone to error but it severely limits the user’s freedom.
For instance, if the input is numeric, does it need to be a real or integer value? Do value limits (min and max) matter? You should consider all these factors before selecting the appropriate inputs elements.
Before we proceed, we could discuss for a bit what kind of inputs you thought would work well in this scenario. The Shiny widget page listing all different kinds of basic inputs might be helpful here.
3.1 Inputs, outputs and error handling
In this case, infectious_period should be an integer
value, since it is measured in days. We can use a simple numeric input
(numericInput) for this. We can also use numeric inputs for
the time_period and the init_infected.
However, the numeric input increment by default is 1, which does not
seem well-suited for the total number of days - as these models are
usually run for several months. Perhaps we could adjust the increment
value (i.e. step) to 5 or 10 days for each click.
The R naught is a real number, with 1 digit precision in this case.
We could use a slider for the selection of R0
(sliderInput). Note however, we should limit the range of
values on the slider to avoid erroneous input - but also for practical
terms, since we do not want the bar to be too large and difficult to
navigate. Too large values of R0 are not found within real-world
applications. Let’s suppose the values on the slider will range from 0.1
to 5, with a step of 0.1.
With regards to outputs, lets start by simply plotting the SIR
curves. We can use the plotly library in order to produce a
better graph that what is plotted by the
EpiDynamics::PlotMods function. Remember from our previous
session, we explained how different types of outputs may need different
render output functions within the app. In this case we can use the
combination of the functions plotlyOutput and
renderPlotly to output a plotly graph directly
to the app.
3.2 Basic interactive SIR model
Considering what we’ve discussed previously, we will use the selected inputs to account for the model parameters in a side panel, and output the SIR graph in the main panel.
Briefly, in the UI:
- We make a fluid page with two panels (input and output).
- In the
fluidPagewe specify all the inputs that we will need, in order of appearence. - The names of inputs (IDs) are important; we decide how to call each
one, e.g.
inputId = "R0". - We select the output that we want and name it, e.g. we make a
plotly output with
plotlyOutput()and name itoutputId = "sir_plot".
In the server function:
- We can get the value selected by the user (a.k.a.
return the value) using
input$R0. We can get the time input by callinginput$time. Similarly, if we had a text box named"my_text"we could get that text string by callinginput$my_text. - We can make the output using
output$sir_plot. For any output we have specified in the UI (e.g."my_output"), we can reference it by usingoutput$my_output. The difference to inputs is that there is no value to get here; instead, we need to assign something to it:output$my_output <- my_plot. In this case we useoutput$sir_plot <- renderPlotly(). We calculate the plot within therenderPlotly()function using inputs as follows. - As a small detail, note that we define at the start
my_server <- function(input, output). If we changed that tomy_server <- function(new_input, new_output), we would need to call to each input and output withnew_input$R0,new_output$sir_plot, etc.
# It's good practice to specify any libraries needed and any
# global values (non-adjustable by the user) at the start of the script
library(EpiDynamics)
total_pop <- 496784 # a fixed value
my_ui <- fluidPage(
sidebarLayout(
sidebarPanel(
# Input: Slider for choosing R0
sliderInput(inputId = "R0", # internal ID name
label = "Select R0",
step = 0.1,
min = 0.1,
max = 5,
value = 2.4),
# Input: Numeric entry for latent period
numericInput(inputId = "infect",
label = "Infectious period (days)",
value = 7, min = 1, max = 24),
# Input: Numeric entry for time period
numericInput(inputId = "time",
label = "Time period (days)",
value = 120,
step = 5), # how much for each mouse click
# Input: Numeric entry for persons initially infected
numericInput(inputId = "init_pop",
label = "Individuals initially infected",
value = 4)),
mainPanel(
plotlyOutput(outputId = "sir_plot")) # We call the output "sir_plot"
)
)
# Define logic (functionality)
my_server <- function(input, output) {
output$sir_plot <- renderPlotly({
# Model calculations
parameters <- c(beta = input$R0 / input$infect, gamma = 1/input$infect)
initials <- c(S = 1-(input$init_pop / total_pop), I = input$init_pop / total_pop, R = 0)
sir <- SIR(pars = parameters, init = initials, time = 0:input$time)
# Prepare data for plotly
sir.results <- as.data.table(sir$results)
sir.results[, 2:4 := lapply(.SD, function(x) round(x*total_pop)), .SDcols = 2:4]
# Make the plot
plot_ly(data = sir.results, x = ~time, y = ~S,
type = "scatter", mode = "lines", name = "S") %>%
add_trace(y = ~I, name = "I") %>%
add_trace(y = ~R, name = "R") %>%
layout(title = "SIR Model", xaxis = list(title ="Time (days)"), yaxis = list(title ="Population"))
}
)
}
# Run the app
shinyApp(ui = my_ui, server = my_server)Exercise 1:
Let’s assume that you would need to: a) adjust the total population to include the wider region of Merseyside, with a total population of 1.38 million, b) rearrange the widgets and put the R0 slider at the bottom of the sidepanel, c) adjust the default R0 to 2.1 and its maximum to 6, d) adjust the title of the graph to “SIR Model for Merseyside”.
Exercise 2:
What if the user inputs a time period that is zero or negative? What about other parameters? How we can control for that faulty input? (HINT: use the help function (F1) to see what options are available for each input)
3.3 Adding expected hospitalisations
Assume that the scope of the app is extended to include the number of expected hospitalisations at any given point. Hospitalisation rate due to COVID-19 is dependent on a number of population characteristics, namely age, but for this application let’s assume a flat rate of 8%.
Let’s assume that, based on relevant research, the time period between admission to discharge was estimated between 4-8 days, so we we will use an average of 6 days stay for each person hospitalised.
We can also have a widget that adjusts the hospitalisation rate according to the user; we could also use a slider for that.
We will need to add another line to the plot showing the number of hospitalisations, but this needs to be calculated based on the number of infected persons per day. These individual will remain hospitalised for 6 days, so will need to make some further calculations before making the plot. We will need a cumulative sum for the last 6 days.
# It's good practice to specify any libraries needed and any
# global values (non-adjustable by the user) at the start of the script
library(EpiDynamics)
total_pop <- 496784
my_ui <- fluidPage(
sidebarLayout(
sidebarPanel(
# Input: Slider for choosing R0
sliderInput(inputId = "R0", # internal ID name
label = "Select R0",
step = 0.1,
min = 0.1,
max = 5,
value = 2.4),
# Input: Slider for choosing hosp. rate
sliderInput(inputId = "hosp_rate", # internal ID name
label = "Hospitalisation rate",
step = 0.1,
min = 0.1,
max = 24,
value = 8,
post = "%"),
# Input: Numeric entry for latent period
numericInput(inputId = "infect",
label = "Infectious period (days)",
value = 7),
# Input: Numeric entry for time period
numericInput(inputId = "time",
label = "Time period (days)",
value = 120,
step = 5),
# Input: Numeric entry for persons initially infected
numericInput(inputId = "init_pop",
label = "Individuals initially infected",
value = 4)),
mainPanel(
plotlyOutput(outputId = "sir_plot"))
)
)
# Define logic (functionality)
my_server <- function(input, output) {
output$sir_plot <- renderPlotly({
# Calculations
parameters <- c(beta = input$R0 / input$infect, gamma = 1/input$infect)
initials <- c(S = 1-(input$init_pop / total_pop), I = input$init_pop / total_pop, R = 0)
sir <- SIR(pars = parameters, init = initials, time = 0:input$time)
# Prepare data for plotly
sir.results <- as.data.table(sir$results)
sir.results[, 2:4 := lapply(.SD, function(x) round(x*total_pop)), .SDcols = 2:4]
# Round results so they look more pretty
sir.results <- round(sir.results, 0)
# Calculate admissions from hosp. rate
sir.results$ADM <- sir.results$I * (input$hosp_rate/100)
sir.results[, ADM2 := (shift(ADM, 1))]
sir.results[, ADM3 := (shift(ADM, 2))]
sir.results[, ADM4 := (shift(ADM, 3))]
sir.results[, ADM5 := (shift(ADM, 4))]
sir.results[, ADM6 := (shift(ADM, 5))]
sir.results[, HOSP_CUM := rowSums(.SD, na.rm=T), .SDcols=c("ADM2","ADM3","ADM4","ADM5","ADM6")]
# also round
sir.results$HOSP_CUM <- round(sir.results$HOSP_CUM, 0)
# Plot w/ total hospital admissions
plot_ly(data = sir.results, x = ~time, y = ~S,
type = "scatter", mode = "lines", name = "S") %>%
add_trace(y = ~I, name = "I") %>%
add_trace(y = ~R, name = "R") %>%
add_trace(y = ~HOSP_CUM, name = "Hospitalisations") %>%
layout(title = "SIR Model with expected Hospitalisations",
xaxis = list(title ="Time (days)"), yaxis = list(title ="Population"))
}
)
}
# Run the app
shinyApp(ui = my_ui, server = my_server)3.4 Adding multiple regions
Assume our app really impressed the local health authorities, and that we have been tasked to extend this to the greater region. Let’s say they need us to prepare individual models for all of the 5 Local Authorities (LAs) of Merseyside, i.e. Liverpool, Knowsley, St Helens, Sefton and Wirral.
Let’s assume the reason they have requested that would be that a) different areas have different population characteristics - which would translate to different R0 and hospitalisation rates and b) different health care capacity. They need to know at which point and under which scenario the health care system would be over capacity, and by how much. We would somehow need to show the maximum capacity in the plot, so the user can assess under which scenario the system would experience difficulties.
They have also provided us with the key data, showing total population and the maximum hospital capacity for each LA. Note that the total hospital capacity mentioned here is much higher than what would be considered normal, but for this example, let’s assume these are correct.
mersey.dt <- data.table(name = c("Liverpool", "Knowsley", "St Helens", "Sefton", "Wirral"),
pop = c(496784, 150862, 102629, 275899, 323266),
capacity = c(19000, 4000, 3500, 6500, 8000))
mersey.dt## name pop capacity
## 1: Liverpool 496784 19000
## 2: Knowsley 150862 4000
## 3: St Helens 102629 3500
## 4: Sefton 275899 6500
## 5: Wirral 323266 8000For the extended app, we can use a drop-down box that allows the user to select which LA they would like to consider. We should put this on top of the side panel.
We will also use the reactive function to switch between
areas, as we have already discussed in the previous practical.
# It's good practice to specify any libraries needed and any
# global values (non-adjustable by the user) at the start of the script
library(EpiDynamics)
mersey.dt <- data.table(name = c("Liverpool", "Knowsley", "St Helens", "Sefton", "Wirral"),
pop = c(496784, 150862, 102629, 275899, 323266),
capacity = c(19000, 4000, 3500, 6500, 8000))
my_ui <- fluidPage(
sidebarLayout(
sidebarPanel(
# Input: Selector for choosing area
selectInput(inputId = "areas", # internal ID name
label = "Choose an area:", # your label
choices = mersey.dt$name),
# Input: Numeric entry for latent period
numericInput(inputId = "infect",
label = "Infectious period (days)",
value = 7),
# Input: Slider for choosing R0
sliderInput(inputId = "R0", # internal ID name
label = "Select R0",
step = 0.1,
min = 0.1,
max = 5,
value = 2.4),
# Input: Slider for choosing hosp. rate
sliderInput(inputId = "hosp_rate", # internal ID name
label = "Hospitalisation rate",
step = 0.1,
min = 0.1,
max = 24,
value = 8,
post = "%"),
# Input: Numeric entry for time period
numericInput(inputId = "time",
label = "Time period (days)",
value = 120,
step = 5),
# Input: Numeric entry for persons initially infected
numericInput(inputId = "init_pop",
label = "Individuals initially infected",
value = 4)),
mainPanel(
plotlyOutput(outputId = "sir_plot"))
)
)
# Define logic (functionality)
my_server <- function(input, output) {
output$sir_plot <- renderPlotly({
# Return the requested area
area_pop <- reactive({
switch(input$areas,
"Liverpool" = mersey.dt$pop[1],
"Knowsley" = mersey.dt$pop[2],
"St Helens" = mersey.dt$pop[3],
"Sefton" = mersey.dt$pop[4],
"Wirral" = mersey.dt$pop[5])
})
area_capacity <- reactive({
switch(input$areas,
"Liverpool" = mersey.dt$capacity[1],
"Knowsley" = mersey.dt$capacity[2],
"St Helens" = mersey.dt$capacity[3],
"Sefton" = mersey.dt$capacity[4],
"Wirral" = mersey.dt$capacity[5])
})
# Calculations
tpop <- area_pop()
parameters <- c(beta = input$R0 / input$infect, gamma = 1/input$infect)
initials <- c(S = 1-(input$init_pop / tpop ), I = input$init_pop / tpop, R = 0)
sir <- SIR(pars = parameters, init = initials, time = 0:input$time)
# Prepare data for plotly
sir.results <- as.data.table(sir$results)
sir.results[, 2:4 := lapply(.SD, function(x) round(x*tpop)), .SDcols = 2:4]
# Round results so they look more pretty
sir.results <- round(sir.results, 0)
# Calculate admissions from hosp. rate
sir.results$ADM <- sir.results$I * (input$hosp_rate/100)
sir.results[, ADM2 := (shift(ADM, 1))]
sir.results[, ADM3 := (shift(ADM, 2))]
sir.results[, ADM4 := (shift(ADM, 3))]
sir.results[, ADM5 := (shift(ADM, 4))]
sir.results[, ADM6 := (shift(ADM, 5))]
sir.results[, HOSP_CUM := rowSums(.SD, na.rm=T), .SDcols=c("ADM2","ADM3","ADM4","ADM5","ADM6")]
# also round
sir.results$HOSP_CUM <- round(sir.results$HOSP_CUM, 0)
# add a flat capacity to the table
sir.results$Capacity <- area_capacity()
# Plot w/ total hospital admissions
plot_ly(data = sir.results, x = ~time, y = ~S,
type = "scatter", mode = "lines", name = "S") %>%
add_trace(y = ~I, name = "I") %>%
add_trace(y = ~R, name = "R") %>%
add_trace(y = ~HOSP_CUM, name = "Hospitalisations") %>%
add_trace(y = ~Capacity, name = "Capacity", line = list(color = "grey", dash="dot")) %>%
layout(title = "SIR Model with expected Hospitalisations",
xaxis = list(title ="Time (days)"), yaxis = list(title ="Population"))
}
)
}
# Run the app
shinyApp(ui = my_ui, server = my_server)3.5 Adding tabs for table view
It would be useful if we added the actual table with the model
results as an output, so users can check the exact values than just
relying on the graph. We can do that by adding tabs, called
tabsets, to the main panel output. You can also check
runExample("06_tabsets") from the built-in examples for
another use case.
In this instance, we will add a tab with a table view of the SIR
model outputs. For this we will use the tabsetPanel()
function right after our mainPanel() function. We will use
the dataTableOutput() and renderDataTable()
functions to to plot the table sir.results.
# It's good practice to specify any libraries needed and any
# global values (non-adjustable by the user) at the start of the script
library(EpiDynamics)
mersey.dt <- data.table(name = c("Liverpool", "Knowsley", "St Helens", "Sefton", "Wirral"),
pop = c(496784, 150862, 102629, 275899, 323266),
capacity = c(19000, 4000, 3500, 6500, 8000))
irisdt <- as.data.table(iris)
my_ui <- fluidPage(
sidebarLayout(
sidebarPanel(
# Input: Selector for choosing area
selectInput(inputId = "areas", # internal ID name
label = "Choose an area:", # your label
choices = mersey.dt$name),
# Input: Numeric entry for latent period
numericInput(inputId = "infect",
label = "Infectious period (days)",
value = 7),
# Input: Slider for choosing R0
sliderInput(inputId = "R0", # internal ID name
label = "Select R0",
step = 0.1,
min = 0.1,
max = 5,
value = 2.4),
# Input: Slider for choosing hosp. rate
sliderInput(inputId = "hosp_rate", # internal ID name
label = "Hospitalisation rate",
step = 0.1,
min = 0.1,
max = 24,
value = 8,
post = "%"),
# Input: Numeric entry for time period
numericInput(inputId = "time",
label = "Time period (days)",
value = 120,
step = 5),
# Input: Numeric entry for persons initially infected
numericInput(inputId = "init_pop",
label = "Individuals initially infected",
value = 4)),
mainPanel(
# Output: Tabset w/ plot and table
tabsetPanel(type = "tabs",
tabPanel("Plot", plotlyOutput(outputId = "sir_plot")),
tabPanel("Table", dataTableOutput(outputId = "sir_table")))
)
)
)
# Define logic (functionality)
my_server <- function(input, output) {
output$sir_plot <- renderPlotly({
# Return the requested area
area_pop <- reactive({
switch(input$areas,
"Liverpool" = mersey.dt$pop[1],
"Knowsley" = mersey.dt$pop[2],
"St Helens" = mersey.dt$pop[3],
"Sefton" = mersey.dt$pop[4],
"Wirral" = mersey.dt$pop[5])
})
area_capacity <- reactive({
switch(input$areas,
"Liverpool" = mersey.dt$capacity[1],
"Knowsley" = mersey.dt$capacity[2],
"St Helens" = mersey.dt$capacity[3],
"Sefton" = mersey.dt$capacity[4],
"Wirral" = mersey.dt$capacity[5])
})
# Calculations
tpop <- area_pop()
parameters <- c(beta = input$R0 / input$infect, gamma = 1/input$infect)
initials <- c(S = 1-(input$init_pop / tpop ), I = input$init_pop / tpop, R = 0)
sir <- SIR(pars = parameters, init = initials, time = 0:input$time)
# Prepare data for plotly
sir.results <- as.data.table(sir$results)
sir.results[, 2:4 := lapply(.SD, function(x) round(x*tpop)), .SDcols = 2:4]
# Round results so they look more pretty
sir.results <- round(sir.results, 0)
# Calculate admissions from hosp. rate
sir.results$ADM <- sir.results$I * (input$hosp_rate/100)
sir.results[, ADM2 := (shift(ADM, 1))]
sir.results[, ADM3 := (shift(ADM, 2))]
sir.results[, ADM4 := (shift(ADM, 3))]
sir.results[, ADM5 := (shift(ADM, 4))]
sir.results[, ADM6 := (shift(ADM, 5))]
sir.results[, HOSP_CUM := rowSums(.SD, na.rm=T), .SDcols=c("ADM2","ADM3","ADM4","ADM5","ADM6")]
# also round
sir.results$HOSP_CUM <- round(sir.results$HOSP_CUM, 0)
# add a flat capacity to the table
sir.results$Capacity <- area_capacity()
# Plot w/ total hospital admissions
plot_ly(data = sir.results, x = ~time, y = ~S,
type = "scatter", mode = "lines", name = "S") %>%
add_trace(y = ~I, name = "I") %>%
add_trace(y = ~R, name = "R") %>%
add_trace(y = ~HOSP_CUM, name = "Hospitalisations") %>%
add_trace(y = ~Capacity, name = "Capacity", line = list(color = "grey", dash="dot")) %>%
layout(title = "SIR Model with expected Hospitalisations",
xaxis = list(title ="Time (days)"), yaxis = list(title ="Population"))
}
)
output$sir_table <- renderDataTable({
# Return the requested area
area_pop <- reactive({
switch(input$areas,
"Liverpool" = mersey.dt$pop[1],
"Knowsley" = mersey.dt$pop[2],
"St Helens" = mersey.dt$pop[3],
"Sefton" = mersey.dt$pop[4],
"Wirral" = mersey.dt$pop[5])
})
area_capacity <- reactive({
switch(input$areas,
"Liverpool" = mersey.dt$capacity[1],
"Knowsley" = mersey.dt$capacity[2],
"St Helens" = mersey.dt$capacity[3],
"Sefton" = mersey.dt$capacity[4],
"Wirral" = mersey.dt$capacity[5])
})
# Calculations
tpop <- area_pop()
parameters <- c(beta = input$R0 / input$infect, gamma = 1/input$infect)
initials <- c(S = 1-(input$init_pop / tpop ), I = input$init_pop / tpop, R = 0)
sir <- SIR(pars = parameters, init = initials, time = 0:input$time)
# Prepare data for plotly
sir.results <- as.data.table(sir$results)
sir.results[, 2:4 := lapply(.SD, function(x) round(x*tpop)), .SDcols = 2:4]
# Round results so they look more pretty
sir.results <- round(sir.results, 0)
# Calculate admissions from hosp. rate
sir.results$ADM <- sir.results$I * (input$hosp_rate/100)
sir.results[, ADM2 := (shift(ADM, 1))]
sir.results[, ADM3 := (shift(ADM, 2))]
sir.results[, ADM4 := (shift(ADM, 3))]
sir.results[, ADM5 := (shift(ADM, 4))]
sir.results[, ADM6 := (shift(ADM, 5))]
sir.results[, HOSP_CUM := rowSums(.SD, na.rm=T), .SDcols=c("ADM2","ADM3","ADM4","ADM5","ADM6")]
# also round
sir.results$HOSP_CUM <- round(sir.results$HOSP_CUM, 0)
# add a flat capacity to the table
sir.results$Capacity <- area_capacity()
# Output
sir.results[,c("time","S","I","R","ADM","HOSP_CUM")]
}
)
}
# Run the app
shinyApp(ui = my_ui, server = my_server)Note that we will have to copy-paste all the necessary calculations
again within the renderDataTable() function. That’s because
we would like the table to adjust automatically to user input, same as
the graph. There is probably a better way of doing this that doesn’t
require twice the amount of code, but for the sake of simplicity we
opted for this approach.
4 Discussion
This has been a more extensive example of a Shiny app in a health-related context, but there is still a lot more that could be done, particularly in terms of the model specification and app functionality. Let’s discuss how this app can be extended:
- How can we account for population characteristics that we currently do take into account? For instance, hospitalisation rate was 8% for all the population, but this varies by age. What other characteristics would be important?
- How could we add ICU bed capacity to the model? What further parameters would be needed?
- Are there any other types of outputs that you think are currently missing? What would they be?
5. Further reading
R shiny written tutorials (2020). RStudio Inc. Available at: https://shiny.rstudio.com/tutorial/written-tutorial/lesson1/.
Wickham, H. (2021). Mastering shiny. O’Reilly Media, Inc. Available at: https://mastering-shiny.org/.
Alexiou, A. Ashton, B., Barr, B. et al. Responding to COVID-19 in the Liverpool City Region: COVID-19: How Modelling is Contributing to the Merseyside Response. May 2020. Heseltine Institute for Public Policy, Practice and Place, Policy Briefing 003. University of Liverpool. Available at: https://www.liverpool.ac.uk/media/livacuk/publicpolicyamppractice/covid-19/Policy,Brief,003,How,Modelling,is,Contributing,to,the,Merseyside,Response.pdf.
Exercise answers:
Exercise 1:
library(EpiDynamics)
total_pop <- 1380000
my_ui <- fluidPage(
sidebarLayout(
sidebarPanel(
# Input: Slider for choosing R0
sliderInput(inputId = "R0", # internal ID name
label = "Select R0",
step = 0.1,
min = 0.1,
max = 6,
value = 2.1),
# Input: Numeric entry for latent period
numericInput(inputId = "infect",
label = "Infectious period (days)",
value = 7),
# Input: Numeric entry for time period
numericInput(inputId = "time",
label = "Time period (days)",
value = 120,
step = 5),
# Input: Numeric entry for persons initially infected
numericInput(inputId = "init_pop",
label = "Individuals initially infected",
value = 4)),
mainPanel(
plotlyOutput(outputId = "sir_plot"))
)
)
# Define logic (functionality)
my_server <- function(input, output) {
output$sir_plot <- renderPlotly({
# Calculations
parameters <- c(beta = input$R0 / input$infect, gamma = 1/input$infect)
initials <- c(S = 1-(input$init_pop / total_pop), I = input$init_pop / total_pop, R = 0)
sir <- SIR(pars = parameters, init = initials, time = 0:input$time)
# Prepare data for plotly
sir.results <- as.data.table(sir$results)
sir.results[, 2:4 := lapply(.SD, function(x) round(x*total_pop)), .SDcols = 2:4]
plot_ly(data = sir.results, x = ~time, y = ~S,
type = "scatter", mode = "lines", name = "S") %>%
add_trace(y = ~I, name = "I") %>%
add_trace(y = ~R, name = "R") %>%
layout(title = "SIR Model for Merseyside", xaxis = list(title ="Time (days)"), yaxis = list(title ="Population"))
}
)
}
# Run the app
shinyApp(ui = my_ui, server = my_server)Exercise 2:
Generally, we could add a number of tests before calculating the model in order to notify the user that they have selected erroneous inputs. Another useful thing to note is that for numeric inputs, we would also specify min and max values, so values do not become negative, e.g.:
numericInput(inputId = "time",
label = "Time period (days)",
value = 120,
step = 5,
min = 5,
max = 1000),