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

我认为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)

Answer 2

一种方法是使用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)根据剩余选项的数量更新您的选择输入：

var url = 'http://example.net/hi-how-are-you';
var pos = url.lastIndexOf('/');
url = url.substring(0,pos)+'//'+url.substring(pos+1);
console.log(url);

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

限制从闪亮

2 个答案: