如何将自定义工具提示添加到 R Shiny 仪表板中的 ggplot 条形图？

Question

我为 R Shiny 仪表板制作了一系列条形图。当用户将鼠标悬停在条形上时，我希望年份（x 轴）和成本金额（y 轴）显示在条形上方。

我在整合这个时遇到困难。我一直在尝试使用plotly 包。看来许多实现工具提示的常见方法与 ggplot 不兼容。我想继续使用 ggplot，因为我在此仪表板上实现的大部分内容都使用它。这是其中一个图的工作版本：

  output$costs_plot <- renderPlot({
    # Subset data based on number of years to display
    data_subset <- costShortfallDf()[1:input$num_years, ]
    
    # Create a new column to store the color based on the sign of the cost
    data_subset$color <- ifelse(data_subset$cost >= 0, "#d5e8d5", "#f8cdcc")
    
    # Check if both positive and negative values exist
    show_dotted_line <- any(data_subset$cost < 0) && any(data_subset$cost > 0)
    
    ggplot(data_subset, aes(x = Year, y = cost, fill = color,  text = paste("Year:", Year, "<br>Cost:", cost))) +
      labs(title = "Financial Outlook by Year", x = "Year", y = "Revenue (Costs)") +
      scale_x_continuous(breaks = seq(min(data_subset$Year), max(data_subset$Year), by = 1)) + 
      scale_y_continuous(
        labels = function(x) paste0(ifelse(x < 0, "-$", "$"), scales::comma_format(scale = 1e-9)(abs(x)), " B")
      ) +
      theme(
        panel.background = element_blank(),
        panel.grid = element_blank(),
        legend.position = "none",
        plot.title = element_text(color = "#0D2F4F", size = 24, hjust = 0.5),
        axis.title = element_text(size = 16),
        axis.text = element_text(size = 16),
        axis.line = element_line(color = "black", linewidth = 1)
      ) +
      geom_bar(stat = "identity") +
      scale_fill_identity() +
      if (show_dotted_line) {
        geom_hline(yintercept = 0, color = "black", linetype = "dashed", alpha = 0.5)
      }
  })

text

属性根本不显示工具提示。

Answer 1

ggplot2

创建静态图（如 png/jpeg 文件）。这些不允许用户交互或动态可视化。

plotly

有一个名为

ggplotly()

的函数，它将任何

ggplot

转换为动态

plotly

图，以维护 ggplot 光学。

library(shiny)
library(plotly)

data <- 
  data.frame(
    cost = sample(40:400, 20),
    year = 1994:2013
  )

ggplot(data, aes(year, cost)) +
  geom_bar(stat = "identity")

ggplotly()

要在

shiny

应用程序中使用该功能，您只需使用

plotly::renderPlotly()

代替

shiny::renderPlot()

，使用

plotly::plotlyOutput()

代替

shiny::plotOutput()

。

library(shiny)
library(plotly)

data <- 
  data.frame(
    cost = sample(40:400, 20),
    year = 1994:2013
  )

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

server <- function(input, output) {
    output$distPlot <- renderPlotly({
        ggplot(data, aes(year, cost)) +
        geom_bar(stat = "identity")
    })
}

shinyApp(ui = ui, server = server)