R Shiny响应式DataFrame绘制月度分类交互热力图问题修复

代码失效有两个核心原因：

• 漏加载dplyr、ggplot2所属的tidyverse依赖包，代码本身就无法正常运行
• dplyr分组、ggplot映射默认走非标准求值逻辑，直接把input$Category返回的字符串塞进去，会被识别成固定常量，不是你要选的动态列，直接导致分组统计失败、x轴映射错误，出来的图完全不对。

• 动态引用Shiny传入的列名时，dplyr分组用across(all_of(输入列名))的写法，适配动态字符串列名
• ggplot做美学映射时，用.data[[输入列名]]的写法引用动态列，避免被识别成常量
• 删掉当前画热力图用不上的网络分析类依赖包，490万行数据场景下能减少不少加载和计算开销
• 补充热力图的配色、标签、坐标轴文字角度调整，输出效果和预期一致

library(shiny)
library(tidyverse)

# 读取本地数据
interaction <- readRDS("participant_interaction.rds")

# 前端UI定义
ui <- fluidPage(
  titlePanel("社交网络交互统计"),
  sidebarLayout(
    sidebarPanel(
      helpText("俄亥俄州人群全年社交网络交互分布可视化"),
      selectInput(
        inputId = "Category",
        label = "选择X轴分类维度",
        choices = c(
          "家庭规模" = "Household_Size",
          "是否有子女" = "Have_Kids",
          "教育水平" = "Education_Level",
          "兴趣小组" = "Interest_Group",
          "年龄组" = "Age_Group"
        ),
        selected = "Household_Size"
      )
    ),
    mainPanel(
      plotOutput("heatmapPlot", height = "600px")
    )
  )
)

# 后端服务逻辑
server <- function(input, output, session) {
  
  # 按选中维度动态聚合统计
  dataset <- reactive({
    interaction %>%
      group_by(Month, across(all_of(input$Category))) %>%
      summarise(InteractionCount = n(), .groups = "drop")
  })
  
  # 渲染热力图
  output$heatmapPlot <- renderPlot({
    ggplot(dataset(), aes(
        x = .data[[input$Category]],
        y = Month,
        fill = InteractionCount
      )) +
      geom_tile(color = "white", linewidth = 0.5) +
      scale_fill_gradient(low = "#f7fbff", high = "#2171b5", name = "交互次数") +
      theme_minimal() +
      labs(
        x = "分类取值",
        y = "月份"
      ) +
      theme(
        axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1),
        panel.grid = element_blank()
      )
  })
}

# 启动应用
shinyApp(ui = ui, server = server)

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