R Shiny实现ggplot鼠标悬停高亮相邻数据点（无需Plotly）

下面是一套完全基于Shiny原生功能和ggplot2的实现方案，能复刻你需要的悬停高亮相邻数据点、显示x/y变量文本框的效果：

核心实现思路 #

• 利用plotOutput的hover参数捕捉鼠标位置
• 通过坐标映射找到最近的数据点，进而筛选出相邻的时间/数值点
• 动态修改ggplot图层样式，高亮目标点
• 用absolutePanel实现随鼠标移动的文本提示框

完整代码示例 #

library(shiny)
library(ggplot2)
library(dplyr)

# 构造模拟贸易数据（模仿原图表的时间序列结构）
set.seed(123)
trade_data <- tibble(
  date = seq.Date(as.Date("2018-01-01"), as.Date("2023-12-01"), by = "month"),
  goods_services = rnorm(72, mean = 200, sd = 15),
  trade_balance = rnorm(72, mean = 10, sd = 5)
)

ui <- fluidPage(
  # 主图表区域，开启hover捕捉
  plotOutput(
    "trade_plot",
    hover = hoverOpts(
      id = "plot_hover",
      delayType = "throttle",  # 节流减少计算压力
      delay = 100
    )
  ),
  # 悬浮文本框（初始隐藏）
  absolutePanel(
    id = "hover_text",
    class = "panel panel-default",
    style = "position:absolute; pointer-events:none; opacity:0; background:white; padding:5px; border:1px solid #ccc;",
    htmlOutput("hover_content")
  )
)

server <- function(input, output, session) {
  # 响应hover事件，找到最近的数据点及相邻点
  highlighted_points <- reactive({
    req(input$plot_hover)
    
    # 将鼠标坐标转换为数据中的x值（日期）
    hover_x <- as.Date(input$plot_hover$x, origin = "1970-01-01")
    # 找到最近的日期
    closest_date <- trade_data$date[which.min(abs(trade_data$date - hover_x))]
    # 获取相邻日期（前一个、当前、后一个）
    date_idx <- which(trade_data$date == closest_date)
    adjacent_idx <- c(max(1, date_idx - 1), date_idx, min(nrow(trade_data), date_idx + 1))
    
    trade_data %>%
      mutate(
        highlight = if_else(row_number() %in% adjacent_idx, TRUE, FALSE)
      )
  })
  
  # 渲染动态图表
  output$trade_plot <- renderPlot({
    plot_data <- highlighted_points()
    
    ggplot(plot_data, aes(x = date)) +
      # 基础线条和点（非高亮样式）
      geom_line(aes(y = goods_services), color = "#636363", linewidth = 0.8) +
      geom_line(aes(y = trade_balance), color = "#969696", linewidth = 0.8) +
      geom_point(aes(y = goods_services), color = "#636363", size = 1.5) +
      geom_point(aes(y = trade_balance), color = "#969696", size = 1.5) +
      # 高亮线条和点
      geom_line(data = filter(plot_data, highlight), aes(y = goods_services), color = "#3182bd", linewidth = 1.2) +
      geom_line(data = filter(plot_data, highlight), aes(y = trade_balance), color = "#e6550d", linewidth = 1.2) +
      geom_point(data = filter(plot_data, highlight), aes(y = goods_services), color = "#3182bd", size = 3) +
      geom_point(data = filter(plot_data, highlight), aes(y = trade_balance), color = "#e6550d", size = 3) +
      labs(x = "日期", y = "数值") +
      theme_minimal()
  })
  
  # 更新悬浮文本框的内容和位置
  observeEvent(input$plot_hover, {
    req(highlighted_points())
    
    plot_data <- highlighted_points()
    closest_row <- filter(plot_data, highlight & row_number() == which(plot_data$highlight)[2])  # 取中间的当前点
    
    # 更新文本内容
    output$hover_content <- renderUI({
      tagList(
        paste0("日期: ", format(closest_row$date, "%Y-%m")),
        br(),
        paste0("商品服务贸易: ", round(closest_row$goods_services, 1)),
        br(),
        paste0("贸易差额: ", round(closest_row$trade_balance, 1))
      )
    })
    
    # 更新文本框位置
    runjs(paste0(
      "$('#hover_text').css({",
      "top: '", input$plot_hover$coords_css$y + 10, "px',",
      "left: '", input$plot_hover$coords_css$x + 10, "px',",
      "opacity: 1",
      "});"
    ))
  })
  
  # 鼠标移出图表时隐藏文本框
  observeEvent(input$plot_hover$hover == FALSE, {
    runjs("$('#hover_text').css('opacity', 0);")
  })
}

shinyApp(ui, server)

关键细节说明 #

1. 相邻点筛选逻辑：这里以时间序列的前后一个日期作为相邻点，你可以根据实际需求调整（比如只高亮当前点，或同组的所有点）
2. 样式自定义：通过修改geom_line和geom_point的color、linewidth、size参数，完全匹配原图表的配色和样式
3. 文本框优化：用absolutePanel配合JavaScript动态调整位置，避免遮挡图表内容，同时设置pointer-events:none不干扰鼠标交互
4. 性能优化：使用throttle类型的hover延迟，减少频繁触发计算，提升流畅度

适配目标图表的调整建议 #

• 替换模拟数据为真实的“Goods and Services Trade”和“Trade balance”数据
• 调整颜色方案为原图表的配色（比如商品服务贸易用蓝色，贸易差额用红色）
• 如果原图表是单条线的贸易差额，只需移除对应goods_services的图层即可

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