Vector as a choice in shiny::selectInput()

Question

Here is a working template:

require(data.table)
require(shiny)
require(ggplot2)

x <- data.table(v1 = sample(letters[1:5], 100, replace = T), 
                v2 = sample(letters[1:2], 100, replace = T),
                v3 = runif(100, 0, 1))

ui <- fluidPage(
  sidebarPanel(
    selectInput("in1", "Choice v1", selected = "All", choices = c("All" = list(letters[1:5]))),
    selectInput("in2", "Choice v2", selected = "a", choices = letters[1:2])
  ),
  mainPanel(
    plotOutput("out1")
  )
)

server <- function(input, output){
  output$out1 <- renderPlot({
    ggplot(x[v1 %in% input$in1 & v2 %in% input$in2], aes(x = v3)) +
      geom_density(fill = "dodgerblue4", alpha = .7) +
      theme_light()
  })
}

runApp(shinyApp(ui, server))

Issue here is that I'd like to allow for selection of subset of values within variable. Line selectInput("in1", "Choice v1", selected = "All", choices = c("All" = list(letters[1:5]))) was intended to pass letters[1:5] to input$in1 effectively selecting all values and performing no subsetting of data on v1 .

Same applies to any other subset of values eg choice "a_b_c" = c("a", "b", "c") , or "All" = x[,unique(v1)] and so on. What shiny does, is break up list to all values included in it, basically achieving opposite of desired result. I know there is selectizeInput() to select multiple values. However, this is not viable if I want selected = "All" for all variables as initial state.

Answer 1

Would something like this work?

#rm(list=ls())
require(data.table)
require(shiny)
require(ggplot2)

x <- data.table(v1 = sample(letters[1:5], 100, replace = T), 
                v2 = sample(letters[1:2], 100, replace = T),
                v3 = runif(100, 0, 1))

ui <- fluidPage(
  sidebarPanel(
    selectInput("in1", "Choice v1", selected = "All", choices = c("All",letters[1:5])),
    selectInput("in2", "Choice v2", selected = "a", choices = letters[1:2])
  ),
  mainPanel(
    plotOutput("out1")
  )
)

server <- function(input, output){
  output$out1 <- renderPlot({
    value <- input$in1
    if(value == "All"){
      value <- letters[1:5]
    }
    ggplot(x[v1 %in% value & v2 %in% input$in2], aes(x = v3)) +
      geom_density(fill = "dodgerblue4", alpha = .7) +
      theme_light()
  })
}

runApp(shinyApp(ui, server))

Answer 2

shiny supports selection of multiple values in selectInput . You need to set multiple = TRUE and selectize = FALSE . I think this will provide you the functionality you desire.

You then make the choices and selected variables the same to preselect all of the variables. If you need to use an "all" feature, you'll need to add an action button to run updateSelectInput . Combining those two features could be done by writing a module.

require(data.table)
require(shiny)
require(ggplot2)

x <- data.table(v1 = sample(letters[1:5], 100, replace = T), 
                v2 = sample(letters[1:2], 100, replace = T),
                v3 = runif(100, 0, 1))

ui <- fluidPage(
  sidebarPanel(
    selectInput("in1", "Choice v1", 
                selected = letters[1:5], 
                choices = letters[1:5],
                multiple = TRUE,
                selectize = FALSE),
    selectInput("in2", "Choice v2", 
                selected = letters[1:2], 
                choices = letters[1:2],
                multiple = TRUE,
                selectize = FALSE)
  ),
  mainPanel(
    plotOutput("out1")
  )
)

server <- function(input, output){
  output$out1 <- renderPlot({
    ggplot(x[v1 %in% input$in1 & v2 %in% input$in2], aes(x = v3)) +
      geom_density(fill = "dodgerblue4", alpha = .7) +
      theme_light()
  })
}

runApp(shinyApp(ui, server))

Answer 3

While reading other answers and wondering about possible clean and compact workaround, here's what I came up with. It was crucial to have clean approach to adding new variables.

require(data.table)
require(shiny)
require(ggplot2)

x <- data.table(v1 = sample(letters[1:5], 100, replace = T), 
                v2 = sample(letters[1:2], 100, replace = T),
                v3 = runif(100, 0, 1))

map.dt <- function(x, variables){
  map.out <- data.table(name = character(), variable = character(), value = character())
  for(i in variables){
    map.out <- rbind(map.out,
                     data.table(name = x[,sort(as.character(na.omit(unique(get(i)))))],
                                variable = i,
                                value = x[,sort(as.character(na.omit(unique(get(i)))))]),
                     data.table(name = "All",
                                variable = i,
                                value = x[,sort(as.character(na.omit(unique(get(i)))))]))
  }
  return(map.out)
}

y <- map.dt(x, c("v1", "v2"))

ui <- fluidPage(
  sidebarPanel(
    selectInput("in1", "Choice v1", selected = "All", choices = c("All", letters[1:5])),
    selectInput("in2", "Choice v2", selected = "All", choices = c("All", letters[1:2]))
  ),
  mainPanel(
    plotOutput("out1")
  )
)

server <- function(input, output){
  output$out1 <- renderPlot({
    ggplot(x[v1 %in%  y[variable == "v1" & name == input$in1, value] & 
               v2 %in% y[variable == "v2" & name == input$in2, value]], 
             aes(x = v3)) +
      geom_density(fill = "dodgerblue4", alpha = .7) +
      theme_light()
  })
}

runApp(shinyApp(ui, server))

Basically, it's adding an intermediate mapping table which is generated via function.