r - 如何防止使用 renderUI 进行的输入在隐藏并再次显示后重置？

Question

对于我的许多 Shiny 应用程序来说，一个常见的情况是存在大量可能有趣的过滤器变量(通常是 10 到 20 个)，但我想避免过多的输入小部件让用户感到困惑.

因此，我的策略通常如下:1.用户可以选择过滤变量。 2. 如果至少选择了一个过滤器变量，则会触发一个 renderUI，其中每个所选变量包含一个输入小部件。 3.过滤条件应用于数据并生成一些输出。

问题在于，第一步中的任何更改(通过添加或删除过滤变量)都会消除先前在第二步中做出的所有选择。这意味着所有输入小部件都会无意中重置为其默认值。这会妨碍流畅的用户体验。知道如何改进吗？

在这里您可以看到发生了什么:

这是重现此行为的代码:

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

问题是每次选择 UI 元素时都会渲染它，因此其选定的选项会被重置。我们可以通过仅渲染元素一次并在适用时显示或隐藏它们来解决此问题。我们可以使用 shinyjs 包中的 show 和 hide 函数，并将 div 包裹在 selectInputs 周围来实现此目的当我们创造它们时。因此，每个过滤器 x 都会获得一个名为 xFilter 的相应输入，以及一个包裹在其周围的名为 div_x 的 div。

下面是一个工作示例。我尝试使代码尽可能通用，这样您只需在 filtervarsChoices 和 choices_list 中提供附加元素即可使用附加过滤器进行扩展。我还修改了输出的表格以显示过滤器正常工作。

请注意，在下面的示例中，隐藏过滤器仍应用于生成的 data.frame。为了仅应用可见过滤器，for 循环应在 input$filterVars 上运行，如下面的 Till n 注释所示。

希望这会有所帮助!

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)