构建ShinyApp+ggplot模块时check_aesthetics报错求助

开发ShinyApp子模块时，基于包含Date（产品发布日期）、Name（产品名称）、TW（产品价格）的数据集绘制分组折线图，图表初始渲染正常，但鼠标悬停时触发报错：

Warning: Error in check_aesthetics: Aesthetics must be either length 1 or the same as the data (9): y
  187: <Anonymous>

可复现代码 #

示例数据集 #

aggregated <- data.frame(Date = c("Day 1", "Day 1", "Day 1", "Day 2", "Day 2", "Day 2", "Day 3", "Day 3", "Day 3"), 
                         Name = c("Product A", "Product B", "Product C", "Product A", "Product B", "Product C", "Product A", "Product B", "Product C"), 
                         TW = c(84, 969, 6800, 84, 969, 6800, 84, 888, 6720))

模块UI代码 #

graph_UI <- function(id) {
  fluidRow(
    plotOutput(NS(id, "plot"), hover = NS(id, "plot_hover"))
  )
}

模块Server代码 #

graph_Server <- function(id, values) {
  moduleServer(id, function(input, output, session) {
    
    # Create (or import) the data frame 
    aggregated <- data.frame(Date = c("Day 1", "Day 1", "Day 1", "Day 2", "Day 2", "Day 2", "Day 3", "Day 3", "Day 3"), 
                             Name = c("Product A", "Product B", "Product C", "Product A", "Product B", "Product C", "Product A", "Product B", "Product C"), 
                             TW = c(84, 969, 6800, 84, 969, 6800, 84, 888, 6720))
                            
    # Plot plot_one which is Price (I called it TW here) against Date, grouped by Name
    plot_one <- ggplot(aggregated, aes(x = as.numeric(as.factor(Date)), y = TW, fill = Name)) +
      geom_line()
    
    # Render the plot
    output$plot <- renderPlot({plot_one})
    
    # Add a label when user hover on the plot
    observeEvent(input$plot_hover, {
      if (!is.null(input$plot_hover$x)) {
        x <- round(input$plot_hover$x, 0) # extract the x coordinate and round it
        
        output$plot <- renderPlot({
          plot_one + 
            geom_vline(xintercept = x, linetype = "longdash") + # if user hover, add a horizontal line to the nearest x closest to the hover's x-coordinate 
            geom_label(x = x + (0.01 * length(unique(aggregated$Date))), y = round(as.numeric(input$plot_hover$y), 0), label = "Some words here") 
           # similarly add a geom_label slightly to the right of the `x` point and at the `y` point by specifying my x and y in geom_label()
        })
      }
    })
  })
}

测试代码 #

# Test the app
graph_App <- function() {
  
  ui <- fluidPage(
    graph_UI("graph")
  )
  server <- function(input, output, session) {
    graph_Server("graph")
  }
  shinyApp(ui, server)  
}

graph_App()

错误原因分析 #

1. 全局美学映射继承冲突：plot_one在ggplot()中定义了全局美学映射fill = Name，后续添加的geom_label会默认继承这个映射。但geom_label仅绘制单个标签（长度为1），而fill = Name对应的数据长度是9，两者长度不匹配，触发美学映射错误。
2. geom_line美学参数误用：geom_line应该使用color而非fill来设置线条颜色，fill参数针对的是有填充区域的几何对象（如geom_bar），geom_line不会响应fill映射，这会导致折线图初始状态下也没有按产品分组着色。

解决方案 #

修改两处关键代码：

• 将ggplot()中的fill = Name改为color = Name，正确设置折线的分组颜色。
• 给geom_label添加inherit.aes = FALSE，禁止继承全局美学映射，避免fill参数的冲突。

修改后的模块Server代码如下：

graph_Server <- function(id, values) {
  moduleServer(id, function(input, output, session) {
    
    # Create (or import) the data frame 
    aggregated <- data.frame(Date = c("Day 1", "Day 1", "Day 1", "Day 2", "Day 2", "Day 2", "Day 3", "Day 3", "Day 3"), 
                             Name = c("Product A", "Product B", "Product C", "Product A", "Product B", "Product C", "Product A", "Product B", "Product C"), 
                             TW = c(84, 969, 6800, 84, 969, 6800, 84, 888, 6720))
                            
    # 修正：用color设置折线分组颜色，而非fill
    plot_one <- ggplot(aggregated, aes(x = as.numeric(as.factor(Date)), y = TW, color = Name)) +
      geom_line()
    
    # Render the plot
    output$plot <- renderPlot({plot_one})
    
    # Add a label when user hover on the plot
    observeEvent(input$plot_hover, {
      if (!is.null(input$plot_hover$x)) {
        x <- round(input$plot_hover$x, 0) # extract the x coordinate and round it
        
        output$plot <- renderPlot({
          plot_one + 
            geom_vline(xintercept = x, linetype = "longdash") + 
            # 修正：添加inherit.aes=FALSE，避免继承全局美学映射
            geom_label(x = x + (0.01 * length(unique(aggregated$Date))), 
                      y = round(as.numeric(input$plot_hover$y), 0), 
                      label = "Some words here",
                      inherit.aes = FALSE)
        })
      }
    })
  })
}

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