How to make one action button work for multiple inputs in shiny app

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. :pray:

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.
Shiny applications not supported in static R Markdown documents

Created on 2021-04-10 by the reprex package (v2.0.0)

I would try wrapping this in an eventReactive triggered by input$button and using that in the render

1 Like

In the server, I tried wrapping input$metricInput in an eventReactive as you suggested:

 trial <- eventReactive(input$metricInput, {
    input$metricInput
  })
  
  # 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 = trial, col = "country", 
                           size = "population_in_millions")) +
      geom_point(alpha = 0.8)
    
    p %>% ggplotly()

When I run the app with these changes, I get this error message:
"Error: Unknown input: reactive.event"

aes_string(x = "year", y = trial(), col = "country", 

P.S. you got rid of input button or?

1 Like

Try...



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
      )
  })
  
  trial <- eventReactive(input$button, {
    input$metricInput
  })
  
  
  
  
  # Create reactive output for coolplot
  observeEvent(input$button, {
    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 = trial(), col = "country", 
                             size = "population_in_millions")) +
        geom_point(alpha = 0.8)
      
      p %>% ggplotly()
    })
  })
  
}

This should work

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.