Shiny: update selectizeInput choices based on selected - r

Question

I am trying to update the choices of a selectizeInput based on the current selected choices. Here is my attempt (causes loop):
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()
How can I achieve this?

Answer 1

If you want to stick to server = TRUE, it's maybe not a trivial problem.
One possible work-around could be to debounce the input that you are observing, and then check and only update in case there is a change. This could look as follows - I added some print statements such that you can better follow what's happening.
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()
Edit
Another work-around would be to handle the bouncing pattern explicitly, in order to block it. This is maybe even less elegant, but could be more robust for more involved / complex cases (apps). An example for this follows:
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

Do you need to use server-side selectize? If not, then your code would work fine as-is by simply removing that part.
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

The following solution simply updates the entire object through renderUI and re-draws it, rather than passing back an update via updateSelectizeInput(). This does allow choices to be fully managed on the server-side. A downside is that it fires with each change event, which means that the multiple=TRUE is moot since the object redraws with each change. If multiples are critical, I think the updateSelectizeInput() approach or any other solution that updates onChange, would run into the same issue. To allow multiple choices, the event would need to move to onBlur or a mouseout event. Otherwise, the event trigger doesn't know if a user intends to select only one choice and fire; or wait for the user to make multiple choices before firing. However, blur or mouseout might make it behave strangely from the user's perspective. A button forcing the update action would resolve this. Keeping the update based on the first select, solution as follows:
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()