如何在Shiny应用中绘制员工上班到达时间并实现多交通模式筛选？

我看了你的代码和需求，这里有几个关键问题需要修正，同时优化实现逻辑，让你的Shiny应用能够正确支持多交通模式筛选（包括全选），并准确展示每个Id对应的唯一到达时间分布：

原代码的核心问题 #

• renderPlot中嵌套observe是错误写法，会触发不必要的反应式逻辑
• 筛选逻辑有误：多选模式时不能用==，应该用%in%；同时要过滤出Answer == "Yes"的行（你的长格式数据里，Answer字段表示用户是否选择了该交通模式）
• 未处理全选场景，当用户选择所有模式时需要展示全部有效数据
• 存在重复加载包的情况（比如dplyr加载了两次），do包看起来没有用到，可以移除

修正后的完整代码 #

library(shiny)
library(ggplot2)
library(dplyr)
library(tidyverse)
library(readxl)
library(shinyWidgets)

# 1. 读取数据（这里用你提供的dput示例数据，实际使用时替换为你的Excel路径）
Data <- structure(list(Id = c(1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4), 
                       `Arrival time` = structure(c(3L, 6L, 4L, 5L, 3L, 6L, 4L, 5L, 3L, 6L, 4L, 5L), 
                                                 .Label = c("before 7h00", "7h00 - 7h30", "7h30 - 8h00", 
                                                            "8h00 - 8h30", "8h30 - 9h00", "9h00 - 9h30", "after 9h30"), 
                                                 class = c("ordered", "factor")), 
                       Mode = c("On foot", "On foot", "On foot", "On foot", 
                                "Scooter (trotinette)", "Scooter (trotinette)", 
                                "Scooter (trotinette)", "Scooter (trotinette)", 
                                "Carpool", "Carpool", "Carpool", "Carpool"), 
                       Answer = c("Yes", "No", "No", "No", "No", "No", "No", "No", "No", "No", "No", "No")), 
                  row.names = c(1L, 2L, 3L, 4L, 9157L, 9158L, 9159L, 9160L, 18313L, 18314L, 18315L, 18316L), 
                  class = "data.frame")

# 2. 预处理：只保留选择了该模式的行，同时去重每个Id的到达时间（确保每个Id对应唯一Arrival time）
clean_data <- Data %>%
  filter(Answer == "Yes") %>%
  distinct(Id, `Arrival time`, .keep_all = TRUE)

# 3. 生成模式选择列表
mode_choices <- unique(clean_data$Mode)

# 4. Shiny UI配置
ui <- fluidPage(
  titlePanel("员工到达时间分布"),
  sidebarLayout(
    position = "right",
    sidebarPanel(
      h3("筛选条件"),
      pickerInput(
        inputId = "selected_mode",
        label = "选择交通模式",
        choices = mode_choices,
        options = list(`actions-box` = TRUE, `select-all-text` = "全选", `deselect-all-text` = "取消全选"),
        multiple = TRUE,
        selected = mode_choices  # 默认全选模式
      ),
      br()
    ),
    mainPanel(
      plotOutput("arrival_plot")
    )
  )
)

# 5. Shiny Server逻辑
server <- function(input, output) {
  # 用reactive表达式处理数据筛选，提升性能
  filtered_data <- reactive({
    if (is.null(input$selected_mode) || length(input$selected_mode) == 0) {
      # 无选择时返回空数据，也可改为返回全部数据，按需调整
      return(clean_data[0, ])
    } else {
      clean_data %>%
        filter(Mode %in% input$selected_mode)
    }
  })
  
  # 绘制图表
  output$arrival_plot <- renderPlot({
    filtered_data() %>%
      ggplot(aes(x = `Arrival time`)) +
      geom_histogram(stat = "count", fill = "#2c3e50", color = "white") +
      labs(
        x = "到达时间",
        y = "员工数量",
        title = "不同交通模式下的员工到达时间分布"
      ) +
      theme_minimal() +
      theme(axis.text.x = element_text(angle = 45, hjust = 1))
  })
}

# 运行应用
shinyApp(ui = ui, server = server)

关键优化点解释 #

1. 数据预处理：

   • 先过滤出Answer == "Yes"的行，只保留用户实际选择的交通模式数据
   • 用distinct(Id, Arrival time, .keep_all = TRUE)确保每个Id只保留一条到达时间记录，完全匹配你"每个Id对应唯一Arrival time"的需求

2. 筛选逻辑优化：

   • 使用reactive表达式封装数据筛选逻辑，避免重复计算，提升应用运行效率
   • 处理了空选择的边界情况
   • 用%in%替代==，完美支持多模式同时筛选

3. UI体验优化：

   • 给pickerInput添加了全选/取消全选的文本提示，让操作更直观
   • 默认设置为全选模式，符合用户常见使用习惯
   • 优化了图表样式，添加清晰的坐标轴标签和标题，旋转X轴标签避免重叠

4. 代码整洁性：

   • 移除了未使用的包，删除了重复加载的包
   • 重命名了变量（比如selected_mode代替原Mode），让代码可读性更强

内容的提问来源于stack exchange，提问作者Simen Fjælberg