閃亮：根據所選內容更新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()

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（）傳回更新。 這確實允許在服務器端完全管理選擇。 缺點是它會隨着每個更改事件觸發，這意味着multip multiple=TRUE沒有實際意義，因為每次更改時對象都會重繪。 如果倍數很關鍵，我認為updateSelectizeInput()方法或更新onChange任何其他解決方案都會遇到同樣的問題。 要允許多個選擇，事件需要移至onBlur或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()