Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Limiting number of options selected from several dropdowns in shiny

Tags:

r

shiny

I am working creating a time trend plot where an user can select different geographies of different types (e.g. country, province), each type having its own dropdown box. I want to limit the number of geographies they can select to 4. I know how to do it for one dropdown (options = list(maxOptions = 4)), but I cannot figure out how to limit it when your selections come from several dropdowns. For each one of these geographies there is a large number of options so it is not feasible to group them in one dropdown. Any help with this would be very appreciated!

I have prepared a little example of what I mean:

library(plotly)
library(dplyr)

# Global variables
cities <- c("City A", "City B", "City C", "City D", "City E")
regions <- c("Region M", "Region N", "Region O")
countries <- c("Country Z", "Country X", "Country Y", "Country W")
geography_all <- as.factor(c(cities, regions, countries))
year <- as.factor(2011:2014)

df <- expand.grid(geography = geography_all, year = year)
df$value <- runif(48)

trend_pal <-  c('red','blue', 'yellow', 'green') #Palette


# UI
ui <- fluidPage(
  selectInput("cities", "City", choices = cities,
              multiple=TRUE, selectize=TRUE, selected = ""),
  selectInput("regions", "Region", choices = regions,
              multiple=TRUE, selectize=TRUE, selected = ""),
  selectInput("countries", "Country", choices = countries,
              multiple=TRUE, selectize=TRUE, selected = ""),
  plotlyOutput('plot')
)


# Server code
server <- function(input, output) {
  output$plot <- renderPlotly({
    #Filtering data based on user input
    trend <- df %>% 
      filter(geography %in% input$cities |
               geography %in% input$regions |
               geography %in% input$countries ) %>% 
      arrange(year) %>% 
      droplevels()

    #Plot
    plot_ly(data=trend, x=~year,  y = ~value, 
            type = 'scatter', mode = 'lines',
            color = ~geography , colors = trend_pal)

  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)
like image 891
jvilla Avatar asked Feb 20 '18 10:02

jvilla


1 Answers

I think shinyWidgets package has what you need. It has pickerInput and within its options you can declare how many items a user can select options = list(max-options = 4)

library(plotly)
library(dplyr)
library(shiny)
library(shinyWidgets)

# Global variables
cities <- c("City A", "City B", "City C", "City D", "City E")
regions <- c("Region M", "Region N", "Region O")
countries <- c("Country Z", "Country X", "Country Y", "Country W")
geography_all <- as.factor(c(cities, regions, countries))
year <- as.factor(2011:2014)

df <- expand.grid(geography = geography_all, year = year)
df$value <- runif(48)

trend_pal <-  c('red','blue', 'yellow', 'green') #Palette


# UI
ui <- fluidPage(

  pickerInput("cities", "City", choices = cities, multiple = TRUE,options = list(`max-options` = 4)),
  pickerInput("regions", "Region", choices = regions, multiple = TRUE,options = list(`max-options` = 4)),
  pickerInput("countries", "Country", choices = countries, multiple = TRUE,options = list(`max-options` = 4)),
  plotlyOutput('plot')
)


# Server code
server <- function(input, output) {
  output$plot <- renderPlotly({
    #Filtering data based on user input
    trend <- df %>% 
      filter(geography %in% input$cities |
               geography %in% input$regions |
               geography %in% input$countries ) %>% 
      arrange(year) %>% 
      droplevels()

    #Plot
    plot_ly(data=trend, x=~year,  y = ~value, 
            type = 'scatter', mode = 'lines',
            color = ~geography , colors = trend_pal)

  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)

enter image description here

Edit You can use other features of pickerInput and wrap everything into one dropdown with limits set to 4 items such as:

library(plotly)
library(dplyr)
library(shiny)
library(shinyWidgets)

# Global variables
cities <- c("City A", "City B", "City C", "City D", "City E")
regions <- c("Region M", "Region N", "Region O")
countries <- c("Country Z", "Country X", "Country Y", "Country W")
geography_all <- as.factor(c(cities, regions, countries))
year <- as.factor(2011:2014)

df <- expand.grid(geography = geography_all, year = year)
df$value <- runif(48)

trend_pal <-  c('red','blue', 'yellow', 'green') #Palette


# UI
ui <- fluidPage(
  pickerInput("All", "Choose", multiple = T,choices = list(City = cities, Region = regions, Country = countries),options = list(`max-options` = 4,size = 10)),
  plotlyOutput('plot')
)


# Server code
server <- function(input, output) {
  output$plot <- renderPlotly({
    #Filtering data based on user input
    trend <- df %>% 
      filter(geography %in% input$All) %>% 
      arrange(year) %>% 
      droplevels()

    #Plot
    plot_ly(data=trend, x=~year,  y = ~value, 
            type = 'scatter', mode = 'lines',
            color = ~geography , colors = trend_pal)

  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)

enter image description here

like image 140
Pork Chop Avatar answered Sep 27 '22 00:09

Pork Chop