How to prevent inputs made with renderUI from resetting after they are hidden and displayed again?

Question

A common scenario for many of my shiny apps is that there is a large list of potentially interesting filter variables (often 10 to 20), but I want to avoid confusing the user with too many input widgets.

Therefore, my strategy is usually as follows: 1. Users may select filter variables. 2. If at least one filter variable is selected, a renderUI is triggered, which contains one input widget per selected variable. 3. The filter criteria are applied to the data and some output is generated.

The problem is that any change in step one (by adding or deleting a filter variable) eliminates all previously made choices from step two. This means that all input widgets are unintentionally reset to their default values. This prevents a smooth user experience. Any idea how to improve on this?

Here you can see what happens:

And here is the code to reproduce this behaviour:

library("shiny")
library("dplyr")
library("nycflights13")

df <- flights
filtervarsChoices <- c("origin","carrier")
originChoices <- unique(df$origin)
carrierChoices <- unique(df$carrier)


ui <- fluidPage(
  h3("1. Select Filter variables"),
  selectInput("filterVars", "Filter variables", filtervarsChoices, multiple = TRUE),
  uiOutput("filterConditions"),
  h3("Result"),
  tableOutput("average")

)

server <- function(input, output, session) {
  output$filterConditions <- renderUI({
    req(input$filterVars)
    tagList(
      h3("2. Select Filter values"),
      if ("origin" %in% input$filterVars) {
        selectInput("originFilter", "Origin", originChoices, multiple = TRUE)
      },
      if ("carrier" %in% input$filterVars) {
        selectInput("carrierFilter", "Carrier", carrierChoices, multiple = TRUE)
      }
    )
  })

  output$average <- renderTable({
    if ("origin" %in% input$filterVars) {
      df <- df %>% filter(origin %in% input$originFilter)
    }
    if ("carrier" %in% input$filterVars) {
      df <- df %>% filter(carrier %in% input$carrierFilter)
    }
    df %>% 
      summarise(
        "Number of flights" = n(), 
        "Average delay" = mean(arr_delay, na.rm = TRUE)
      )
  })
}

shinyApp(ui = ui, server = server)

Answer 1

The problem is that you render the UI element every time it is selected, and thus its selected choices are reset. We can solve this by only rendering the elements a single time, and showing or hiding them when applicable. We can do this with the show and hide functions from the shinyjs package, and by wrapping div's around the selectInputs as we create them. So each filter x gets a corresponding input called xFilter and a div wrapped around it called div_x.

Below is a working example. I have tried to make the code as general as possible, so that you would only have to supply additional elements in filtervarsChoices and in choices_list to extend with additional filters. I also modified the table that is outputted to show that the filters are working correctly.

Note that in the example below, hidden filters are still applied to the resulting data.frame. In order to only apply visible filters, the for loop should run over input$filterVars as shown by Till n the comments below.

I hope this helps!

library("shiny")
library("dplyr")
library("nycflights13")
library(shinyjs)

df <- flights
filtervarsChoices <- c("origin","carrier")
originChoices <- unique(df$origin)
carrierChoices <- unique(df$carrier)
# Create a list with the choices for the selectInputs.
# So the selectInput for 'origin', will get the choices defined in originChoices.
choices_list <- list('origin' = originChoices,
                     'carrier' = carrierChoices)


ui <- fluidPage(
  column(width=3,
         h3("1. Select Filter variables"),
         selectInput("filterVars", "Filter variables", filtervarsChoices, multiple = TRUE),
         uiOutput("filterConditions"),
         h3("Result"),
         tableOutput("average"),
         useShinyjs()
  ),
  column(width=3,
         h3("Applied filters"),
         htmlOutput('appliedfilters')

  )
)

server <- function(input, output, session) {

  # Render all selectInput elements.
  output$filterConditions <- renderUI({
    lapply(filtervarsChoices, function(x){
      shinyjs::hidden(div(id=paste0('div_',x),
                          selectInput(paste0(x,"Filter"), x, choices_list[[x]], multiple = TRUE)
      ))})
  })

  # Show all divs that are selected, hide all divs that are not selected.
  observeEvent(input$filterVars, ignoreNULL = F,
               {
                 to_hide = setdiff(filtervarsChoices,input$filterVars)
                 for(x in to_hide)
                 {
                   shinyjs::hide(paste0('div_',x))
                 }
                 to_show = input$filterVars
                 for(x in to_show)
                 {
                   shinyjs::show(paste0('div_',x))
                 }
               })

  output$appliedfilters <- renderText({
    applied_filters <- c()
    for(x in filtervarsChoices)  # for(x in input$filterVars)
    {
      if(!is.null(input[[paste0(x,'Filter')]]))
      {
        applied_filters[length(applied_filters)+1] = paste0(x,': ', paste(input[[paste0(x,'Filter')]],collapse=", "))
      }
    }
    paste(applied_filters,collapse='<br>')
  })

  output$average <- renderTable({

    # For all variables, filter if the input is not NULL.
    # In the current implementation, all filters are applied, even if they are hidden again by the user.
    # To make sure only visible filters are applied, make the loop run over input$filterVars instead of filterVarsChoices
    for(x in filtervarsChoices)  # for(x in input$filterVars)
    {
      if(!is.null(input[[paste0(x,'Filter')]]))
      {
        df <- df %>% filter(get(x) %in% input[[paste0(x,'Filter')]])
      }
    }

    unique(df[,c('origin','carrier')])

  })

}

shinyApp(ui = ui, server = server)