Блестящий: обновить выбор 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

Следующее решение просто обновляет весь объект через renderUI и перерисовывает его, а не передает обновление через updateSelectizeInput ().Это позволяет полностью управлять выбором на стороне сервера.Недостатком является то, что он запускается с каждым событием изменения, что означает, что 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()

Answer 3

Вам нужно , чтобы использовать выборку на стороне сервера?Если нет, то ваш код будет работать как есть, просто удалив эту часть.

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