首页 文章

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

提问于
浏览 次
5

我的许多闪亮应用程序的一个常见场景是，有一个很大的潜在有趣的过滤器变量列表（通常是10到20），但我想 avoid confusing the user with too many input widgets .

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

问题是第一步中的任何更改（通过添加或删除过滤器变量）都会消除第二步中所有先前做出的选择 . 这意味着 all input widgets are unintentionally reset to their default values . 这会妨碍顺畅的用户体验 . 知道怎么改进这个吗？

在这里你可以看到会发生什么：

Example of unintentional widget reset

以下是重现此行为的代码：

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)
r shiny

1 回答

  • 5

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

    下面是一个工作示例 . 我试图使代码尽可能通用，这样你只需要在 filtervarsChoices 和 choices_list 中提供额外的元素以扩展其他过滤器 . 我还修改了输出的表，以显示过滤器正常工作 .

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

    我希望这有帮助！

    enter image description here

    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)
    回复于

相关问题