在R Shiny仪表盘实现悬停垂直线及自定义交互效果

完全可以不用掌握CSS/JS等R以外的语言实现需求，以下是几个可行方案，均基于你熟悉的ggplot2或适配Shiny的交互式绘图包，支持自定义垂直线样式与悬停细节：

方案1：使用plotly包（无缝衔接ggplot2） #

plotly可直接将ggplot2静态图转为交互式对象，内置鼠标悬停触发的垂直线与自定义提示框功能，全程用R代码配置：

library(shiny)
library(ggplot2)
library(plotly)

ui <- fluidPage(
  plotlyOutput("inflation_plot")
)

server <- function(input, output) {
  # 模拟通胀数据
  set.seed(123)
  df <- data.frame(
    date = seq.Date(as.Date("2010-01-01"), as.Date("2023-12-01"), by = "month"),
    value = rnorm(168, mean = 2, sd = 1.5)
  )
  
  output$inflation_plot <- renderPlotly({
    # 基础ggplot折线图
    p <- ggplot(df, aes(x = date, y = value)) +
      geom_line(color = "#2c3e50", linewidth = 1) +
      # 根据鼠标悬停位置动态添加垂直线
      geom_vline(
        xintercept = event_data("plotly_hover")$x,
        color = "#e74c3c", linewidth = 0.8, opacity = 0.7
      ) +
      labs(x = "日期", y = "通胀率") +
      theme_minimal()
    
    # 转为plotly并配置交互细节
    ggplotly(p, tooltip = c("x", "y")) %>%
      layout(hovermode = "x") %>% # 鼠标悬停时锁定x轴位置
      config(displayModeBar = FALSE) %>% # 隐藏plotly工具栏
      style(hoverlabel = list(
        bgcolor = "#34495e",   # 提示框背景色
        bordercolor = "#ffffff",# 提示框边框色
        font = list(color = "#ffffff", size = 12) # 提示框字体
      ))
  })
}

shinyApp(ui, server)

方案2：使用ggiraph包（纯ggplot生态的交互式扩展） #

ggiraph专为ggplot2设计交互式功能，通过*_interactive系列几何对象实现悬停事件，无需额外前端知识：

library(shiny)
library(ggplot2)
library(ggiraph)

ui <- fluidPage(
  girafeOutput("inflation_plot")
)

server <- function(input, output) {
  set.seed(123)
  df <- data.frame(
    date = seq.Date(as.Date("2010-01-01"), as.Date("2023-12-01"), by = "month"),
    value = rnorm(168, mean = 2, sd = 1.5),
    # 自定义悬停提示内容
    tooltip = sprintf("日期: %s<br>通胀率: %.2f", 
                      format(date, "%Y-%m"), value)
  )
  
  output$inflation_plot <- renderGirafe({
    p <- ggplot(df, aes(x = date, y = value)) +
      geom_line_interactive(color = "#2c3e50", linewidth = 1) +
      # 绑定悬停提示（透明点触发事件，不影响原图）
      geom_point_interactive(aes(tooltip = tooltip), size = 0.5, alpha = 0) +
      # 动态垂直线（通过鼠标悬停位置更新）
      geom_vline_interactive(
        xintercept = input$inflation_plot_hover$x,
        color = "#e74c3c", linewidth = 0.8, opacity = 0.7
      ) +
      labs(x = "日期", y = "通胀率") +
      theme_minimal()
    
    # 配置悬停样式
    girafe(ggobj = p) %>%
      opts_hover(css = "background-color: #34495e; color: white; padding: 5px; border-radius: 3px;") %>%
      opts_toolbar(position = "none")
  })
}

shinyApp(ui, server)

方案3：dygraph包的自定义悬停优化 #

若你仍想使用dygraph，可通过内置参数自定义悬停样式，仅需复制预设代码片段（无需理解JS）：

library(shiny)
library(dygraphs)
library(xts)

ui <- fluidPage(
  dygraphOutput("inflation_plot")
)

server <- function(input, output) {
  set.seed(123)
  df <- data.frame(
    date = seq.Date(as.Date("2010-01-01"), as.Date("2023-12-01"), by = "month"),
    value = rnorm(168, mean = 2, sd = 1.5)
  )
  ts_df <- xts(df$value, order.by = df$date)
  
  output$inflation_plot <- renderDygraph({
    dygraph(ts_df) %>%
      dyOptions(
        strokeWidth = 2,
        colors = "#2c3e50",
        # 自定义悬停提示框样式
        drawHighlightPointCallback = "function(x, y, seriesName, pointIndex, series) {
          return '<div style=\"background-color: #34495e; color: white; padding: 5px; border-radius: 3px;\">' +
                 '<span>日期: ' + series.dates[pointIndex] + '</span><br>' +
                 '<span>通胀率: ' + series.values[pointIndex].toFixed(2) + '</span>' +
                 '</div>';
        }"
      ) %>%
      dyHighlight(highlightSeriesOpts = list(strokeWidth = 3)) # 悬停时高亮线条
  })
}

shinyApp(ui, server)

以上方案均支持自定义垂直线的颜色、宽度、透明度，以及悬停提示的内容、字体、背景色等细节，无需编写或理解前端代码。

内容的提问来源于stack exchange，提问作者r-newbie