Question

我正在尝试根据当前的choices选择来更新selectizeInput的{{1}}。这是我的尝试（原因循环）：

selected

我该如何实现？

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或将其移出事件。否则，事件触发器将不知道用户是否仅打算选择一个选项并触发。或等待用户做出多项选择，然后再开除。但是，从用户的角度来看，模糊或鼠标移开可能会使它的行为异常。强制执行更新操作的按钮可以解决此问题。保持基于首选解决方案的更新，如下所示：

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

闪亮：根据选择的内容更新selectizeInput选择

3 个答案: