Show grouping from selectInput with list

Question

In the code below, the output of the selectInput is just the choice, but not the grouping variable too. I'd like to be able to say what grouping it came from as well. Example You Chose Gender - Female . How can pull the grouping variable out of this?

if (interactive()) {

  # basic example


  # demoing optgroup support in the `choices` arg
  shinyApp(
    ui = fluidPage(
      selectInput("state", "Choose a state:",
                  list(`State` = c("NY", "NJ", "CT"),
                       `Gender` = c("Female","Male"),
                       `Region` = c("North", "West", "East"))
      ),
      textOutput("result")
    ),
    server = function(input, output) {
      output$result <- renderText({
        paste("You chose", input$state)
      })
    }
  )
}

Answer 1

You can implement it like this:

library(purrr) # install.packages('purrr')
library(shiny)

choices <- list(
  `State` = c("NY", "NJ", "CT"),
  `Gender` = c("Female","Male"),
  `Region` = c("North", "West", "East")
)

shinyApp(
  ui = fluidPage(
    selectInput(
      "state",
      "Choose a state:",
      choices <- choices
    ),
    textOutput("result")
  ),
  server = function(input, output) {
    output$result <- renderText({
      paste(
        "You chose",
        input$state,
        "from",
        names(choices)[choices %>% map_lgl(~input$state %in% .)]
      )
    })
  }
)

There is a potential issue when having duplicate options under different categories though. This can be addressed by using name and value(unique across the whole list) pairs as list elements. See below.

# 'Region' and 'Direction' both have an option 'North' but can be distinguished by the value. Note you should use values in your app logic.

library(purrr) # install.packages('purrr')
library(shiny)
choices <- list(
  State = c("NY", "NJ", "CT"),
  Gender = c("Female", "Male"),
  Region = c("North" = "reg_north", "West" = "reg_west", "East" = "reg_east"),
  Direction = c("North" = "dir_north", "South" = "dir_south")
)

shinyApp(
  ui = fluidPage(
    selectInput(
      "state", "Choose a state:",
      choices <- choices
    ),
    textOutput("result")
  ),
  server = function(input, output) {
    output$result <- renderText({
      paste(
        "You chose",
        input$state,
        "from",
        names(choices)[choices %>% map_lgl(~input$state %in% .)]
      )
    })
  }
)