R Shiny中部署dataTableOutput及关联图表、优化表格与实现交互功能

你提出的两个需求都可以低成本实现，无需额外引入复杂依赖，具体实现方案如下：

• 空值样式统一：用DT包的formatStyle功能将空值单元格填充为浅灰色背景，同时将空值替换为-占位，避免大面积空白影响观感
• 无效内容过滤：服务器端预过滤全空的行/列，也可以在DT配置中开启列筛选功能，支持用户手动隐藏无数据的日期列
• 信息密度提升：可以给有值的单元格配置和数值大小匹配的背景色，做成类热图效果，直观展示数值差异的同时进一步减少空白感

核心基于DT包内置的单元格点击事件监听能力实现，逻辑非常简洁：

1. 渲染DT时配置selection = list(mode = 'single', target = 'cell')，开启单选单元格的交互模式
2. 服务端通过input$<你的DT输出ID>_cells_selected获取选中单元格的行、列索引，匹配到对应的小时、分组、日期字段
3. 用匹配到的字段过滤原始统计数据，重绘图表即可

library(shiny)
library(DT)
library(tidyverse)
library(lubridate)

# 模拟业务数据：包含日期、小时、分组、唯一ID统计值
set.seed(123)
sim_data <- crossing(
  date = seq(ymd("2024-06-01"), ymd("2024-06-07"), by = "1 day"),
  hour = 0:23,
  group = c("分组A", "分组B")
) %>% 
  mutate(unique_id_count = sample(c(rep(NA, 150), sample(1:50, 262, replace = T)))) %>% 
  drop_na(unique_id_count)

# UI定义
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      dateRangeInput("date_range", "选择日期范围",
                     start = min(sim_data$date), end = max(sim_data$date))
    ),
    mainPanel(
      DTOutput("schedule_table"),
      plotOutput("id_stat_chart")
    )
  )
)

# 服务端逻辑
server <- function(input, output) {
  # 生成宽格式日程表数据
  wide_table_data <- reactive({
    req(input$date_range)
    sim_data %>% 
      filter(date >= input$date_range[1], date <= input$date_range[2]) %>% 
      pivot_wider(names_from = date, values_from = unique_id_count, values_fill = NA) %>% 
      arrange(group, hour)
  })
  
  # 渲染优化后的表格
  output$schedule_table <- renderDT({
    req(wide_table_data())
    datatable(
      wide_table_data(),
      selection = list(mode = "single", target = "cell"),
      options = list(pageLength = 24, scrollX = TRUE, dom = "ft")
    ) %>% 
      # 空值样式优化：浅灰背景+短横线占位
      formatStyle(
        columns = 3:ncol(wide_table_data()),
        backgroundColor = styleEqual(NA, "#f5f5f5")
      ) %>% 
      formatString(
        columns = 3:ncol(wide_table_data()),
        na.string = "-"
      )
  })
  
  # 渲染图表：默认展示全量统计，选中单元格后展示对应细分数据
  output$id_stat_chart <- renderPlot({
    if (is.null(input$schedule_table_cells_selected)) {
      # 默认全量统计
      total_stat <- sim_data %>% 
        group_by(date, group) %>% 
        summarise(total_id = sum(unique_id_count), .groups = "drop")
      ggplot(total_stat, aes(x = date, y = total_id, color = group, group = group)) +
        geom_line(linewidth = 1) +
        geom_point(size = 2) +
        labs(title = "全量唯一ID每日统计", x = "日期", y = "唯一ID数量") +
        theme_minimal()
    } else {
      # 选中单元格后的细分统计
      selected_cell <- input$schedule_table_cells_selected
      selected_row <- wide_table_data()[selected_cell[1, 1], ]
      selected_date <- ymd(colnames(wide_table_data())[selected_cell[1, 2]])
      filtered_data <- sim_data %>% 
        filter(group == selected_row$group, hour == selected_row$hour, date == selected_date)
      
      ggplot(filtered_data, aes(x = group, y = unique_id_count, fill = group)) +
        geom_col(show.legend = FALSE) +
        labs(
          title = paste0("选中时段统计：", selected_date, " ", selected_row$hour, "时"),
          x = "分组", y = "唯一ID数量"
        ) +
        theme_minimal()
    }
  })
}

shinyApp(ui, server)

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