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

Mikko Marttila · Accepted Answer · 2017-10-27 09:53:55Z

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 (i.e. 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 renderUIs.

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)

I accept this answer since this is what worked best for me. I adapted it into my code and it does great.

Carl Boneri · Accepted Answer · 2017-10-26 20:43:12Z

1

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

}

answered Oct 26, 2017 at 20:43

Carl Boneri

2,7321 gold badge16 silver badges16 bronze badges

2 Comments

Joel H Over a year ago

I tested your example and I'm not sure it does what I need it to do. I will play around with updateSelectinput some more though, thanks.

Yang Liu Over a year ago

Thank you. It is good advice, using observeEvent with updateSelectInput.

Collectives™ on Stack Overflow

Dynamically update a list used in multiple Select Inputs in Shiny

2 Answers 2

1 Comment

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related