Shiny应用中Donor ID条件着色箱线图功能崩溃问题排查

问题背景 #

用户的Shiny应用包含一个selectizeInput用于选择单个/多个Donor ID，需求是：

• 未选中任何ID时，箱线图散点按x轴变量（Gender/AgeGroup）用自定义颜色着色
• 选中ID时，散点按选中状态着色（选中点红色，未选中黑色）

添加条件逻辑后应用崩溃，原代码存在语法和反应式环境的问题。

崩溃原因分析 #

1. ggplot图层添加方式错误：直接在+后使用if/else返回多个图层（geom_jitter+scale_color_manual）不符合ggplot语法，+运算符需要逐个处理图层元素
2. 全局数据修改风险：直接修改全局df的selection列，会引发Shiny反应式环境的冲突
3. 冗余的数据传递：geom_jitter中重复传递df参数，与ggplot主数据指定重复，易引发数据上下文混乱

修复后的完整代码 #

数据与自定义函数 #

df <- data.frame(
  ID = c("ID0001", "ID0002", "ID0003", "ID0004", "ID0005"),
  Gender = c("Female", "Male", "Female", "Female", "Female"),
  AgeGroup = c("30yr_39yr", "40yr_49yr", "40yr_49yr", "30yr_39yr", "30yr_39yr"),
  variable1 = c(10, 12, 8, 15, 11),
  variable2 = c(5, 3, 7, 9, 6),
  variable3 = c(20, 18, 22, 17, 19)
)

color_code <- function(x) {
  switch(x,
         Gender = c("#ff0000", "#4472c4"),
         AgeGroup = c("20yr_29yr" = "#c5e0b4", 
                      "30yr_39yr" = "#b4c7e7", 
                      "40yr_49yr" = "#f8cbad", 
                      "50yr_59yr" = "#c55a11", 
                      "60yr_69yr" = "#bf9000", 
                      "70yr_80yr" = "#7030a0"
         ),
         NULL
  )
}

UI部分（ui.R） #

library(shiny)

ui <- fluidPage(
  selectizeInput("donor", label = "Enter Donor ID:", 
                 choices = as.list(unique(df$ID)), 
                 multiple = TRUE,
                 options = list(),
                 selected = NULL),
  selectInput("x_var2", "X轴变量", choices = c("Gender", "AgeGroup")),
  selectInput("y_var2", "Y轴变量", choices = c("variable1", "variable2", "variable3")),
  plotOutput("plot2", brush = brushOpts(id = "plot2_brush")),
  tableOutput("brush_info2")
)

Server部分（server.R） #

library(shiny)
library(ggplot2)
library(rlang)

server <- function(input, output) {
  
  output$plot2 <- renderPlot({
    # 创建局部数据框，避免修改全局df
    local_df <- df
    local_df$selection <- ifelse(local_df$ID %in% input$donor, "selected", "unselected")
    
    # 初始化基础ggplot对象
    p <- ggplot(local_df, aes(x = !!sym(input$x_var2), y = !!sym(input$y_var2))) +
      theme_bw() +
      geom_boxplot(color = "black", fill = "white", width = 0.5, size = 1.0, outlier.shape = NA, coef = 1.5)
    
    # 条件添加图层和颜色映射
    if (!is.null(input$donor)) {
      p <- p + geom_jitter(aes(color = selection), width = 0.1, alpha = 0.5) +
        scale_color_manual(values = c("unselected" = "black", "selected" = "red"))
    } else {
      p <- p + geom_jitter(aes(color = !!sym(input$x_var2)), width = 0.1, alpha = 0.5) +
        scale_color_manual(values = color_code(input$x_var2))
    }
    
    p
  })
  
  output$brush_info2 <- renderTable({
    brushedPoints(df, input$plot2_brush)
  })
  
}

shinyApp(ui, server)

关键修复点说明 #

• 使用局部数据框：创建local_df处理selection列，避免修改全局数据引发的反应式冲突
• 分步构建ggplot对象：先初始化基础图层，再通过条件语句逐个添加geom_jitter和scale_color_manual，符合ggplot语法规则
• 移除冗余参数：删除geom_jitter中的df参数，让图层继承ggplot主数据上下文
• 明确反应式变量传递：确保input$x_var2、input$y_var2等变量在反应式环境中正确解析

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