I'm trying to create my first shiny app. I'm reproducing one of the apps build in the rstudio::global(2021) sessions ( R in Pharma: Intro to Shiny). The app works just fine. However, when I try to add an actionButton to it, it's not working quite as I expected. The actionButton works with the yearInput
and countryInput
. That is, I can update these inputs without displaying the plot ( until the "Plot!" button is clicked). However, updating the metricInput
updates the plot without the "Plot!" button being clicked. How do I make the actionButton work for all the inputs, so that one can update all inputs and only display the plot by clicking the "Plot!" button?
Any help is appreciated. Thank you.
Here's the code:
library(shiny)
library(dslabs)
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
library(tidyr) # just to use drop_na()
library(ggplot2)
library(plotly)
#>
#> Attaching package: 'plotly'
#> The following object is masked from 'package:ggplot2':
#>
#> last_plot
#> The following object is masked from 'package:stats':
#>
#> filter
#> The following object is masked from 'package:graphics':
#>
#> layout
library(shinythemes)
data("gapminder")
# Doing preprocessing before any Shiny-specific code
west <- c("Western Europe","Northern Europe","Southern Europe",
"Northern America","Australia and New Zealand")
gapminder <- gapminder %>%
mutate(region_group = case_when(
region %in% west ~ "The West",
region %in% c("Eastern Asia", "South-Eastern Asia") ~ "East Asia",
region %in% c("Caribbean", "Central America", "South America") ~ "Latin America",
continent == "Africa" & region != "Northern Africa" ~ "Sub-Saharan Africa",
TRUE ~ "Others")) %>%
# Simply dropping any NaNs
drop_na() %>%
mutate(gpd_per_capita = gdp/population) %>%
mutate(population_in_millions = population/10^6)
ui <- fluidPage(
theme = shinytheme("cerulean"),
titlePanel("World Health & Economic Data - Gapminder"),
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "yearInput", label = "Year",
min = min(gapminder$year), max = max(gapminder$year),
value = c(1970, 2011),
sep = ""
),
# Using selectizeInput for multiple = TRUE because of verstatile UI
selectizeInput(inputId = "countryInput", label = "Country",
choices = gapminder$country,
multiple=TRUE,
options = list(
'plugins' = list('remove_button'))
),
selectInput("metricInput", "Metric",
choices = c("infant_mortality", "life_expectancy", "gpd_per_capita")
),
actionButton("button", "Plot!")
),
mainPanel(
plotlyOutput("coolplot")
)
)
)
#> Warning: The select input "countryInput" contains a large number of options;
#> consider using server-side selectize for massively improved performance. See the
#> Details section of the ?selectizeInput help topic.
server <- function(input, output, session) {
# Defining filtered dataframe outside renders
filtered <- eventReactive(input$button,{
# To stop errors popping up in app if nothing is chosen by default
if (is.null(input$countryInput) || is.null(input$yearInput)) {
return(NULL)
}
gapminder %>%
# Filter based on the interactive input
filter(year >= input$yearInput[1],
year <= input$yearInput[2],
country %in% input$countryInput
)
})
# Create reactive output for coolplot
output$coolplot <- renderPlotly({
if (is.null(input$countryInput) || is.null(input$yearInput)) {
return(NULL)
}
p <- ggplot(filtered(),
# aes_string allows us to change the y-label based on reactive metricInput
aes_string(x = "year", y = input$metricInput, col = "country",
size = "population_in_millions")) +
geom_point(alpha = 0.8)
p %>% ggplotly()
})
}
shinyApp(ui, server)
#> PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.
Created on 2021-04-10 by the reprex package (v2.0.0)