限制从闪亮的几个下拉列表中选择的选项数量

Question

我正在创建一个时间趋势图，用户可以在其中选择不同类型（例如国家/地区）的不同地理位置，每种类型都有自己的下拉框。我想将他们可以选择的地理位置数量限制为4个。我知道如何对一个下拉列表（options = list(maxOptions = 4)）进行操作，但是当您从多个下拉列表中进行选择时，我无法弄清楚如何对其进行限制。对于这些地区中的每个地区，都有大量选项，因此将它们组合到一个下拉列表中是不可行的。任何帮助，将不胜感激！

我准备了一个小例子来说明我的意思：

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)

Answer 1

一种方法是根据updateSelectizeInput剩余的选择数量更新您的选择输入：

library(shiny)

ui <- fluidPage(
  selectizeInput("cities", "City", choices = sprintf("City %d", 1:5), multiple = TRUE, options = list(maxItems = 4L)),
  selectizeInput("regions", "Region", choices = sprintf("Region %d", 1:3), multiple = TRUE, options = list(maxItems = 4L)),
  selectizeInput("countries", "Country", choices = sprintf("Countries %d", 1:4), multiple = TRUE, options = list(maxItems = 4L))
)

server <- function(session, input, output) {

  observe({
    updateSelectizeInput(session, "cities", selected = isolate(input$cities), options = list(maxItems = 4L - (length(input$regions) + length(input$countries))))
  })

  observe({
    updateSelectizeInput(session, "regions", selected = isolate(input$regions), options = list(maxItems = 4L - (length(input$cities) + length(input$countries))))
  })

  observe({
    updateSelectizeInput(session, "countries", selected = isolate(input$countries), options = list(maxItems = 4L - (length(input$regions) + length(input$cities))))
  })

}

shinyApp(ui = ui, server = server)

一旦达到 4 个选项的限制，您必须手动删除一个选项才能再次选择

Answer 2

我认为shinyWidgets包裹有您需要的。它具有pickerInput其选项，您可以声明用户可以选择多少个项目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)

编辑 您可以使用的其他功能，pickerInput并将所有内容包装到一个下拉列表中，并且将限制设置为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("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)