如何在Shiny的renderPlot中实现多列数据筛选绘制直方图？

正在开发一个Shiny应用，用于展示特定地区在指定年份范围内开展的所有项目的直方图。但所用数据包含多列位置字段（location_1、location_2等）及多列作者字段，若将位置合并为单列会导致数据量激增，因此无法重构数据框。以下是简化版的数据、UI及Server代码：

数据 #

df  <- data.frame(
  title = c("Project 1", "Project 2", "Project 3"),
  year = c(2021, 2020, 2023),
  author_1 = c("Bob", "Jane", "Taylor"),
  author_2 = c("Alex", "Ann", NA),
  author_3 = c("Charlie", NA, NA),
  location_1 = c("London", "Berlin", "Paris"),
  location_2 = c("Beijing", "Delhi", NA),
  location_3 = c("New York City", NA, NA)
)

UI代码 #

library(shiny)
library(tidyverse)

ui <- fluidPage(sliderInput(inputId = "year", 
                            label = "Project Funding Year:",
                            min = min(df$year),
                            max = max(df$year),
                            value = c(min(df$year), max(df$year)),
                            sep = "",
                            step = 1),
                selectInput(inputId = "location",
                            label = "Location",
                            choices = list("London", "Berlin", "Paris", "Beijing", "Delhi", "New York City")),
                plotOutput(outputId = "histogram")
                
)

Server代码（原始版本） #

server <- function(input, output, session) {
  output$histogram <- renderPlot(
    df %>% filter(year == input$year,
                  location_1 == input$location) %>% 
      ggplot(aes(x = location_1))+
      geom_histogram(stat = "count")
    
  )
}

shinyApp(ui, server)

提问： 能否在renderPlot的输入筛选中，实现跨多列（如location_1、location_2等）的数据筛选？

可以实现跨多列位置筛选，无需重构数据框，以下是两种高效可行的方案：

方案1：使用dplyr::if_any（推荐） #

if_any可对指定列组的任意一列应用条件判断，只要某一行的任意location列匹配选中地点，就会被保留，适合批量处理同类型字段：

server <- function(input, output, session) {
  output$histogram <- renderPlot(
    df %>% 
      # 筛选年份在滑块范围，且任意location列匹配选中地点
      filter(year >= input$year[1], year <= input$year[2],
             if_any(starts_with("location"), ~ .x == input$location)) %>% 
      ggplot(aes(x = input$location))+
      geom_histogram(stat = "count", fill = "#2E86AB")+
      labs(x = "Location", y = "Number of Projects")+
      theme_minimal()
  )
}

关键说明： #

• starts_with("location")自动匹配所有以location_开头的列，无需手动罗列所有列名
• 修正年份筛选逻辑：原始代码中year == input$year错误，滑块返回的是长度为2的范围向量，需用>=和<=判断
• 直方图x轴固定为选中地点，确保展示该地点的项目数量

方案2：使用rowwise逐行判断 #

若需要更灵活的自定义逻辑，可通过rowwise逐行检查所有location列：

server <- function(input, output, session) {
  output$histogram <- renderPlot(
    df %>% 
      rowwise() %>% 
      filter(year >= input$year[1], year <= input$year[2],
             any(c(location_1, location_2, location_3) == input$location, na.rm = TRUE)) %>% 
      ungroup() %>% 
      ggplot(aes(x = input$location))+
      geom_histogram(stat = "count", fill = "#F24C4E")+
      labs(x = "Location", y = "Number of Projects")+
      theme_minimal()
  )
}

关键说明： #

• rowwise()让后续操作逐行执行
• any(..., na.rm = TRUE)忽略NA值，检查该行所有location列是否存在匹配值
• 用ungroup()取消逐行分组，避免影响后续操作

额外优化：动态生成地点选项 #

原始UI的地点选项为手动输入，易出错，可改为从数据中自动提取所有location列的唯一值：

# 在UI代码前生成动态选项
location_choices <- df %>% 
  select(starts_with("location")) %>% 
  pivot_longer(everything()) %>% 
  pull(value) %>% 
  na.omit() %>% 
  unique()

ui <- fluidPage(sliderInput(inputId = "year", 
                            label = "Project Funding Year:",
                            min = min(df$year),
                            max = max(df$year),
                            value = c(min(df$year), max(df$year)),
                            sep = "",
                            step = 1),
                selectInput(inputId = "location",
                            label = "Location",
                            choices = location_choices),
                plotOutput(outputId = "histogram")
)

此优化可确保下拉选项随数据自动更新，无需手动维护。

内容的提问来源于stack exchange，提问作者KNieder