Shiny：根据选择更新 selectizeInput 选择

Question

我正在尝试根据当前的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()

我怎样才能做到这一点？

Answer 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()

Answer 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()

Answer 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()