r - Shiny :根据选择更新 selectizeInput 选项

Question

我正在尝试更新 choices的 selectizeInput基于当前selected选择。这是我的尝试(导致循环):

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