How to prevent inputs made using renderUI after resetting after hiding them and showing them again?

Question

A common scenario for many of my brilliant applications is to have a large list of potentially interesting filtering variables (often 10 to 20), but I want to not confuse the user with too many input widgets .

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

The problem is that any change to step 1 (by adding or removing a filter variable) eliminates all previously made options from step two. This means that all input widgets inadvertently reset to their default values . This prevents uninterrupted user experience. Any idea how to improve this?

Here you can see what happens:

And here is the code to reproduce this behavior:

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

, , , , , reset. , , . show hide shinyjs div selectInputs . x , xFilter, div, , div_x.

. , filtervarsChoices choices_list . , , , .

, - data.frame. , for input$filterVars, , .

, !

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)