Shiny中使用ggplot颜色映射时避免绘制多条拟合曲线

这个问题我之前也碰到过！原因很简单——当你把colour = Incident加到全局的ggplot() aes里时，ggplot会自动把数据按Incident字段分组，所以geom_smooth()也会跟着为每个分组生成一条拟合曲线，这就是同时勾选两个复选框时出现两条线的原因。

解决方案 #

核心思路是：把颜色映射只应用在geom_point()上，不要放到全局的aes()中。这样geom_smooth()就会基于整个数据集拟合，不受分组影响。另外还要修正数据过滤时的小错误（原代码少了逗号，会导致数据变成向量而非数据框）。

修改后的完整代码 #

library(ggplot2)
library(shiny)
library(shinyWidgets)

# 假设这里有你的data数据框，示例中先模拟一个
# data <- data.frame(
#   Date = seq.Date(as.Date("2024-01-01"), as.Date("2024-06-30"), by = "day"),
#   NUMBER_OF_TRANSFERS = rpois(181, 50),
#   day = weekdays(seq.Date(as.Date("2024-01-01"), as.Date("2024-06-30"), by = "day")),
#   month = months(seq.Date(as.Date("2024-01-01"), as.Date("2024-06-30"), by = "day")),
#   Incident = sample(c(TRUE, FALSE), 181, replace = TRUE)
# )

ui <- fluidPage(
  titlePanel("Transfers Analysis App"),
  sidebarLayout(
    sidebarPanel(
      pickerInput(inputId = "Day", label = "Days of Week", 
                  choices = c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"), 
                  selected = unique(data$day), 
                  options = list(`actions-box` = TRUE), multiple = T),
      pickerInput(inputId = "Month", label = "Months", 
                  choices = c("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"), 
                  selected = unique(data$month), 
                  options = list(`actions-box` = TRUE), multiple = T),
      checkboxInput("Outage", "Highlight Days when an Outage Occured", FALSE),
      checkboxInput("Curve", "Curve of Best Fit", FALSE)
    ),
    mainPanel(
      plotOutput("plot1", height = "600px", width = "100%", hover = hoverOpts(id = "plot_hover")),
      verbatimTextOutput("hover_info")
    )
  )
)

server <- function(input, output) {
  output$plot1 <- renderPlot({
    # 过滤数据，注意加上逗号保持数据框格式
    filtered_data <- data[data$day %in% input$Day, ]
    filtered_data <- filtered_data[filtered_data$month %in% input$Month, ]
    
    # 初始化ggplot，只设置全局的x和y aes
    g <- ggplot(filtered_data, aes(Date, NUMBER_OF_TRANSFERS))
    
    # 根据Outage复选框决定点的颜色映射
    if (input$Outage) {
      g <- g + geom_point(aes(colour = Incident)) + 
        scale_colour_manual(values = c("red", "black"))
    } else {
      g <- g + geom_point()
    }
    
    # 添加拟合曲线（始终基于整体数据）
    if (input$Curve) {
      g <- g + geom_smooth()
    }
    
    plot(g)
  })
}

shinyApp(ui, server)

关键修改点说明 #

1. 数据过滤修正：原代码中data <- data[data$day %in% input$Day]缺少逗号，会返回一个向量而非数据框，修改为filtered_data <- data[data$day %in% input$Day, ]确保保留数据框结构。
2. 颜色映射范围控制：把colour = Incident从全局aes()移到geom_point()内部，这样只有散点会按Incident分组上色，geom_smooth()依然使用整个过滤后的数据集拟合，只会生成一条曲线。
3. 代码可读性优化：把过滤后的数据存到filtered_data变量里，避免重复修改原数据框，逻辑更清晰。

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