Dynamically update a list used in multiple Select Inputs in Shiny

Question

I have the following problem related to this relatively simple code that doesn't work:

server.R

library(shiny)


server <- function(input, output) {

  list_of_stuff=c("Car","Cat","Dog","Hat","Baby","Tractor")
  reactive_stuff_list <- eventReactive({list(input$select_1,input$select_2,input$select_3)},{

    selection_1=input$select_1
    selection_2=input$select_2
    selection_3=input$select_3

    list_of_stuff=list_of_stuff[! list_of_stuff %in% selection_1]
    list_of_stuff=list_of_stuff[! list_of_stuff %in% selection_2]
    list_of_stuff=list_of_stuff[! list_of_stuff %in% selection_3]
    return(list_of_stuff)
  })

  output$select1 <- renderUI({
    selectInput(inputId = "select_1", label = "Select some stuff",
              choices=reactive_stuff_list(), selected = NULL, multiple = TRUE)
  })

  output$select2 <- renderUI({
    selectInput(inputId = "select_2", label = "Select some stuff",
                choices=reactive_stuff_list(), selected = NULL, multiple = TRUE)
  })

  output$select3 <- renderUI({
    selectInput(inputId = "select_3", label = "Select some stuff",
                choices=reactive_stuff_list(), selected = NULL, multiple = TRUE)
  })



}

ui.R

ui <- mainPanel(
  uiOutput('select1'),
  uiOutput('select2'),
  uiOutput('select3')
)

WHAT I WOULD LIKE IT TO DO: I start with some list of elements. Then as soon as I select some elements in one of the "selectInputs" (say number 1) the initial list gets updated in the other ones as well so I can't select the ones I selected in number 1 in number 2/3.

Sadly I have no idea how to achieve this; tried some stuff but didn't get anything usable.

Basically I want them to be kind of linked so they are seperate but work together.

If I'm not clear, I can try to explain it differently. Any guidance would be very much appreciated

Answer 1

The problem with your code is that the way it's written, all of your selectInput elements get re-rendered every time any of their inputs change (ie when your reactive_stuff_list() changes). The re-rendering changes the selection back to NULL , since that's the value you set in the selectInput calls in your renderUI s.

Below is an implementation that works around that issue by retaining the current input when updating the available choices.

library(shiny)

server <- function(input, output) {

  # Stuff lists

  LIST_OF_STUFF = c("Car", "Cat", "Dog", "Hat", "Baby", "Tractor")

  # Update available choices

  other_select <- function(inputId) {

    # Return a reactive list of input values from all 'select_#' input elements,
    # except for the input element given as the inputId argument.  This allows
    # updating a 'select_#' input element whenever any other 'select_#' input
    # element changes.

    reactive({
      select_ids <- grep("^select_\\d+$", names(input), value = T)
      other_select_ids <- setdiff(select_ids, inputId)

      # Single bracket indexing doesn't work for reactive lists: can't simply
      # select inputs based on character vector.  Work around by iterating with
      # double bracket indexing.

      purrr::map(other_select_ids, purrr::partial(`[[`, input))
    })

  }

  render_select <- function(i, label = "Select some stuff") {

    # A selectInput named 'select_<i>' that re-renders whenever _other_
    # selectInputs named 'select_#' change.  Removes choices that have been made
    # in the other selectInputs named 'select_#', while preserving the existing
    # selections.

    renderUI({

      # Save current input; isolated so that changing own input won't cause the
      # object to re-render.

      this_id <- paste0("select_", i)
      this_input <- isolate(input[[this_id]])

      # Update choices based on selections made in other 'select_#' elements.

      selected_elsewhere <- unlist(other_select(this_id)())
      available_choices <- setdiff(LIST_OF_STUFF, selected_elsewhere)

      selectInput(inputId = this_id, label = label, choices = available_choices, 
        selected = this_input, multiple = TRUE)
    })
  }

  output$select_1 <- render_select(1)
  output$select_2 <- render_select(2)
  output$select_3 <- render_select(3)

}

ui <- mainPanel(uiOutput("select_1"), uiOutput("select_2"), uiOutput("select_3"))

shinyApp(ui, server)

Answer 2

?updateSelectInput is your friend here... a simple example:

stack.shiny <- function(){
  dat_set <- mtcars

  all_cars <- row.names(dat_set)

  car_brands <- unique(stri_extract_first_words(all_cars))



  server <- function(input, output, session) {

    output$car_brands <- renderUI({
      selectInput(inputId = 'select1', label = 'choose brand',
                  choices = car_brands)
    })

    output$cars <- renderUI({
      selectInput(inputId = 'select2', label = 'choose car',
                  choices = all_cars)
    })

    observeEvent(input$select1, {
      x <- input$select1
      find_pat <- sprintf('^%s', x)
      these_cars <- all_cars[grepl(find_pat, all_cars, perl = TRUE)]
      # Can also set the label and select items
      updateSelectInput(session, "select2",
                        choices = these_cars,
                        selected = NULL)
    })
  }

  ui <- fluidPage(
    uiOutput('car_brands'),
    uiOutput('cars')
  )

  shinyApp(ui, server)

}