Shiny：根据选择更新 selectizeInput 选择

Posted 2023-03-24

【中文标题】Shiny：根据选择更新 selectizeInput 选择

【英文标题】：Shiny: update selectizeInput choices based on selected

【发布时间】：2019-07-31 09:05:11

【问题描述】：

我正在尝试根据当前的selected 选择更新selectizeInput 的choices。这是我的尝试（导致循环）：

library(shiny)
run_ui <- function() 

  ui <- selectizeInput('words', 'Search words:', choices = NULL, selected = NULL, multiple = TRUE, options = NULL)

  server <- function(input, output, session) 

    # change 'Search words' ----
    observeEvent(input$words, 

      # handle no words (reset everything)
      if (is.null(input$words)) 
        cowords <- letters

       else 
        # update cowords (choices for selectizeInput)
        cowords <- unique(c(input$words, sample(letters, 5)))
      

      # update UI
      print('updating')
      updateSelectizeInput(session, 'words', choices = cowords, selected = input$words, server = TRUE)

    , ignoreNULL = FALSE)
  
  runGadget(shinyApp(ui, server), viewer = browserViewer())


run_ui()

我怎样才能做到这一点？

【参考方案1】：

如果你想坚持server = TRUE，这可能不是一个小问题。

一种可能的解决方法是 debounce 您正在观察的输入，然后检查并仅在有变化时更新。这可能如下所示 - 我添加了一些 print 语句，以便您可以更好地了解正在发生的事情。

library(shiny)

run_ui <- function() 

  ui <- selectizeInput('words', 'Search words:', choices = NULL, selected = NULL, multiple = TRUE, options = NULL)

  server <- function(input, output, session) 

    val <- "a"
    pasteCollPlus <- function(...) 
      paste(..., collapse = "+")
    

    wordSelect <- debounce(reactive(input$words), millis = 50)

    # change 'Search words' ----
    observeEvent(wordSelect(), 

      # handle no words (reset everything)
      if (is.null(input$words)) 
        cowords <- letters
       else 
        # update cowords (choices for selectizeInput)
        cowords <- unique(c(input$words, sample(letters, 5)))
      

      if (isTRUE(pasteCollPlus(val) == pasteCollPlus(input$words))) 
        print(paste("No update - val is", pasteCollPlus(val)))
       else 
        # update UI
        print(paste("updating selection to", pasteCollPlus(input$words)))
        print(paste("val is", pasteCollPlus(val)))
        val <<- input$words
        updateSelectizeInput(session, 'words', choices = cowords, selected = input$words, server = TRUE)
      

    , ignoreNULL = FALSE)

  
  runGadget(shinyApp(ui, server), viewer = browserViewer())


run_ui()

---

编辑

另一种解决方法是明确处理弹跳模式，以阻止它。这可能更不优雅，但对于更多涉及/复杂的案例（应用程序）可能更健壮。一个例子如下：

library(shiny)
run_ui <- function() 

  ui <- selectizeInput('words', 'Search words:', choices = NULL, selected = NULL, multiple = TRUE, options = NULL)

  server <- function(input, output, session) 

    val <- "a"
    newVal <- NULL
    pasteCollPlus <- function(...) 
      paste(..., collapse = "+")
    

    # change 'Search words' ----
    observeEvent(input$words, 

      # handle no words (reset everything)
      if (is.null(input$words)) 
        cowords <- letters
       else 
        # update cowords (choices for selectizeInput)
        cowords <- unique(c(input$words, sample(letters, 5)))
      

      if (isTRUE(pasteCollPlus(val) == pasteCollPlus(input$words))) 
        print(paste("No update - val is", pasteCollPlus(val)))
        val <<- newVal
       else 
        # update UI
        print(paste("updating selection to", pasteCollPlus(input$words)))
        print(paste("val is", pasteCollPlus(val)))
        print(paste("newVal is", pasteCollPlus(newVal)))

        val <<- NULL
        newVal <<- input$words

        updateSelectizeInput(session, 'words', choices = cowords, selected = input$words, server = TRUE)
      

    , ignoreNULL = FALSE)

  
  runGadget(shinyApp(ui, server), viewer = browserViewer())


run_ui()

【讨论】：

谢谢罗兰。这可行，但似乎有点脆弱 - 实际应用程序的更新计算时间会有所不同。我必须为debounce 制作millis = 3000，我猜如果在功能较弱的计算机上运行它必须更高？

长时间的去抖动也会不必要地减慢快速更新。

是的，我同意，它很可能不适合您的实际生产设置。我编辑了答案给你一个替代方案。希望有帮助

感谢 Roland，尽管我不遵循逻辑，但我已经设法让编辑后的解决方案正常工作。

【参考方案2】：

您需要使用服务器端选择吗？如果没有，那么您的代码只需删除该部分即可正常工作。

library(shiny)
run_ui <- function() 

  ui <- selectizeInput('words', 'Search words:', choices = NULL, selected = NULL, multiple = TRUE, options = NULL)

  server <- function(input, output, session) 

    # change 'Search words' ----
    observeEvent(input$words, 

      # handle no words (reset everything)
      if (is.null(input$words)) 
        cowords <- letters

       else 
        # update cowords (choices for selectizeInput)
        cowords <- unique(c(input$words, sample(letters, 5)))
      

      # update UI
      print('updating')
      updateSelectizeInput(session, 'words', choices = cowords, selected = input$words)

    , ignoreNULL = FALSE)
  
  runGadget(shinyApp(ui, server), viewer = browserViewer())


run_ui()

【讨论】：

是的——在真正的应用程序中，cowords 非常大。

【参考方案3】：

以下解决方案只是通过 renderUI 更新整个对象并重新绘制它，而不是通过 updateSelectizeInput() 传回更新。这确实允许在服务器端完全管理选择。缺点是它会随着每个更改事件触发，这意味着 multiple=TRUE 没有实际意义，因为每次更改都会重绘对象。如果倍数很关键，我认为updateSelectizeInput() 方法或任何其他更新onChange 的解决方案都会遇到同样的问题。要允许多个选择，事件需要移动到 onBlur 或 mouseout 事件。否则，事件触发器不知道用户是否打算只选择一个选项并触发；或者等待用户做出多项选择后再触发。但是，从用户的角度来看，blur 或 mouseout 可能会使其行为异常。强制更新操作的按钮将解决此问题。根据第一次选择保持更新，解决方法如下：

library(shiny)
run_ui <- function() 

  ui <- uiOutput(outputId="select_words")      
  server <- function(input, output, session) 

    # change 'Search words' ----
    output$select_words <- renderUI(    
      cowords <- letters
      if (!is.null(input$words)) cowords <- unique(c(input$words, sample(letters, 5)))
      print(paste("Updating words: ",paste0(cowords,collapse=",")))

      return (tagList(selectizeInput('words', 'Search words:', choices = cowords, selected = input$words, multiple = TRUE, options = NULL)))
    )
  
  runGadget(shinyApp(ui, server), viewer = browserViewer())


run_ui()

【讨论】：

谢谢索伦。尝试实现这一点并没有像updateSelectizeInput 那样扩展。为了使其更具可比性，cowords <- sample(letters, 348000, replace=TRUE)

这意味着一个包含 348,000 个项目的下拉列表——无论是使用 updateSelectizeInput() 还是任何其他解决方案，都存在从服务器到客户端的数据问题？我认为，缩放比技术发送更多的数据。同样，您的下拉列表是否会向用户展示 300,000 多个项目；使用起来似乎很麻烦。如果您从这个庞大的列表中抽取一个子集，那么子集服务器端应该非常快。

此外，在使用letters 的示例中，请注意html 下拉菜单将仅显示唯一项目。因此，将 348,000 个冗余项传递到下拉菜单将仅生成 26 个唯一字母的列表。我知道这只是一个示例，但是如果您的应用程序列表中有多余的项目，那么这个问题也会在那里出现。

是的，这 348,000 件商品都是独一无二的。我不确定selectizeInput 是否显示所有项目，但是将它们全部设置为choices 会使它们都可搜索。我尝试实施您的解决方案，因为它比 RolandASc 的答案（呈现没有问题）更复杂，但搜索输入没有在几分钟内呈现。我只是给出了字母示例来重现我所经历的滞后。