Search code examples
rshiny

Is there a way to make multiple Shiny picker inputs where the selections must be disjoint?


I'm looking to make some picker inputs in Shiny for each of the 50 states, but I'd like to separate them into three different groups such that no group has the same state. I was just wondering if there was a way to ensure that the three picker inputs didn't both select the same state or if there was perhaps a better way of doing this in R that I was not aware of.


Solution

  • It takes a bit of work to set up, but you can accomplish that by updating the available choices for other inputs when one changes. If you only have two or three inputs that should be linked like this, it may be tempting to just write out the observers and be done with it. But really, this is a generalizable pattern, so I think it makes sense to use a helper function instead. That way, you can link however many inputs you need, and also re-use the logic in different apps.

    All that the helper function needs to know is the IDs of the participating inputs, and the set of shared choices. It’s not strictly necessary here, but also making the choices reactive lets them dynamically change.

    selectPool <- function(inputIds, choices = reactive(NULL)) {
      stopifnot(is.reactive(choices))
      session <- getDefaultReactiveDomain()
      input <- session$input
      
      # Keep track of all selected values in the pool
      alreadySelected <- reactive({
        Reduce(union, lapply(inputIds, \(id) input[[id]]))
      })
      
      # ... and based on that, what's left to select from.
      remainingChoices <- reactive({
        setdiff(choices(), alreadySelected())
      })
      
      # When an input changes, update remaining choices for others
      lapply(inputIds, \(id) {
        observe({
          lapply(setdiff(inputIds, id), \(otherId) {
            otherSelected <- input[[otherId]]
            updateSelectInput(
              session = session,
              inputId = otherId,
              # Anything already selected must remain a choice
              choices = c(remainingChoices(), otherSelected),
              selected = otherSelected
            )
          })
        }) |> bindEvent(input[[id]], ignoreNULL = FALSE)
      })
    }
    

    Once we’ve taken the time to do that, it’s very straightforward to use in an app:

    library(shiny)
    
    ui <- fluidPage(
      titlePanel("Star Wars Alliance Builder"),
      selectInput("alliance1", "Alliance 1", NULL, multiple = TRUE),
      selectInput("alliance2", "Alliance 2", NULL, multiple = TRUE),
      selectInput("alliance3", "Alliance 3", NULL, multiple = TRUE),
    )
    
    server <- function(input, output, session) {
      selectPool(
        inputIds = c("alliance1", "alliance2", "alliance3"),
        choices = reactive(unique(dplyr::starwars$species))
      )
    }
    
    shinyApp(ui, server)