This tutorial covers the fairly advanced topic of designing controls for your shiny app that either:
Our example app makes use of two data packages:
library(gapminder)
: provides socioeconomic data on 142 countries from the www.gapminder.org projectlibrary(rnaturalearthhires)
: provides high resolution country borders for mapping, note that this package is not available on CRAN and must be installed using devtools::install_github("ropenscilabs/rnaturalearthhires")
.Users of the app are able to view the country and country details by first selecting a continent and then a country, so both controls are dependent on the datasets and the first control subsets the number of available options for the second.
The code for this Shiny app is on the Github repo and the app is embedded into this page using a simple iframe, see here for more details.
This tutorial does not walk you through building the app, instead follow these instructions:
The updateSelectInput
function allows the server.R
function to re-write the contents of a selectInput
using information from both the input
and output
objects. Let’s look at both instances of the updateSelectInput
function in our template app:
observe({
updateSelectInput(
session,
"selected_continent",
choices = unique(gapminder_countries$continent)
)
})
Here the selectInput
with the inputID = "selected_continent"
is updated with the unique values from gapminder_countries$continent
. The function has been wrapped in observe
but in this instance its kind of unnecessary, as the expression is only ever going to be evaluated once (when the app loads).
observe({
updateSelectInput(
session,
"selected_country",
choices = gapminder_countries %>%
filter(continent == input$selected_continent) %>%
select(name) %>%
.[[1]]
)
})
Here the observe
is necessary as the selectInput
with the inputId = "selected_country"
needs to be updated whenever the input$selected_continent
variable is changed. The observe
function is tickled by any input$
variable inside of it, and so the list of available countries will be updated when the selected continent changes.
When a Shiny app first loads everything from the ui.R
file is displayed on screen and then the server.R
function is called with all default input values. This means for a very short amount of time the selectInputs
have the values assigned in the ui.R
file, which are as follows:
fluidPage(
...,
selectInput("serverside_continent",
"Selected continent:",
choices = ""),
...
selectInput("selected_country",
"Selected country:",
choices = ""),
...
)
To prevent renderLeaflet
from briefly displaying an error because of input$selected_country == ""
we add the following line to our server.R
file:
if (input$selected_country == "") {
return()
}
The steps followed above allow for the country list to be modified by the continent selector, and for the country list to be dependent on the gapminder
dataset. So in theory, if additional countries were added to the package in the future our app would update nicely.
However, there’s still something we could do to improve our app. At the moment, each time input$selected_country
is changed the entire map is regenerated - the “base map” is reloaded. This is often inefficient if your map contains multiple datasets and only one is changing. Fortunately, it is possible to update the output$selected_country_map
object via the leafletProxy
function.
The code below could be substituted for the current implementation of output$selected_country_map
. For this toy app it doesn’t massively improve the experience for the end user, but this gives you a taste of how to design more complicated apps.
output$selected_country_map <- renderLeaflet({
if (input$selected_country == "") {
return()
}
leaflet() %>%
addTiles()
})
observeEvent(input$selected_country,
{
if (input$selected_country == "") {
return()
}
country_sf <- gapminder_countries %>%
filter(name == input$selected_country)
country_bbox <- gapminder_countries %>%
filter(name == input$selected_country) %>%
st_bbox() %>%
as.list()
leafletProxy("selected_country_map") %>%
clearShapes() %>%
addPolygons(
data = country_sf,
label = ~ name,
popup = ~ paste("Country:", name,
"<br>",
"Population:", pop)
) %>%
fitBounds(country_bbox$xmin,
country_bbox$ymin,
country_bbox$xmax,
country_bbox$ymax)
})