Question

我的许多闪亮应用程序的一个常见场景是，有一大堆潜在有趣的过滤器变量（通常是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元素，因此会重置其选定的选项。我们可以通过仅渲染元素一次，并在适用时显示或隐藏它们来解决这个问题。我们可以使用show包中的hide和shinyjs函数执行此操作，并在创建它们时将div包围在selectInputs周围。因此，每个过滤器x都会获得一个名为xFilter的相应输入，以及一个名为div_x的div。

以下是一个工作示例。我尝试使代码尽可能通用，这样您只需在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)

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

1 个答案: