R Shiny应用中ggplotly悬停颜色修改及tooltip自定义方法

以下是满足需求的完整可运行代码，直接替换原代码对应部分即可生效：

library(shiny)
library(ggplot2)
library(plotly)
library(data.table)
library(shinythemes)
library(forcats)
require(stringi)
require(stringr)
library(scales)
library(ggthemes)
library(plyr)
library(dplyr)
library(readr)
library(tidyr)
library(ggthemes)
library(forcats)
library(xtable)
library(googledrive)
library(googlesheets4)
library(gridExtra)
library(lubridate)
library(DT)
library(vroom)
library(utf8)
library(tableHTML)
library(bslib)
library(devtools)
library(readr)
library(RColorBrewer)

ethnicity <- c("Hispanic", "Non-hispanic","Hispanic","Hispanic","Hispanic","Hispanic","White","White","White","White", 
               "White","Hispanic","Hispanic", "Hispanic","Hispanic","Hispanic","White","White","White","White")
filtered_data <- data.frame(ethnicity)

ui <- fluidPage(
    titlePanel("Example"),
        mainPanel(
            plotlyOutput("ethnicity_barplot")
        )
    )

server <- function(input, output) {
    output$ethnicity_barplot <- renderPlotly({
        ethnicity_barplot <-ggplot(data = filtered_data, aes(x = fct_infreq(ethnicity))) + 
            # 合并冗余的geom_bar配置，新增text参数定义悬停提示内容
            geom_bar(fill = "#327EC2", aes(text = paste("Count: ", after_stat(count)))) + 
            xlab("Ethnicity") + 
            ylab("Number of People") + 
            labs(title = "Ethnicity of Defendants in New York State Courts") + 
            theme(panel.background = element_rect(fill = 'white'))+
            theme(plot.background = element_rect(fill = 'white'))+
            theme(plot.title = element_text(hjust = 0.5))+
            theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
            geom_text(stat='count', aes(label=..count..), vjust = -.3)
        
        # 配置ggplotly交互规则
        ggplotly(ethnicity_barplot, tooltip = "text") %>%
          style(
            # 配置悬停高亮效果：浅蓝色填充+2px黑色外边框
            marker = list(
              hover = list(
                color = "lightblue",
                line = list(color = "black", width = 2)
              )
            ),
            # 关闭顶部计数文本的悬停触发，避免多余提示
            hoverinfo = "none",
            traces = 2
          )
    })
}

shinyApp(ui = ui, server = server)

核心改动说明 #

• 自定义悬停提示框：在geom_bar的美学映射中新增text参数，仅定义需要展示的计数值，同时在ggplotly函数中指定tooltip = "text"，即可屏蔽默认的x轴类别展示，仅输出计数内容。
• 悬停高亮效果：通过style函数对柱状图元素配置悬停状态属性，当前实现了悬停时柱子变为浅蓝色+添加黑色外边框的效果，可根据需要自行调整颜色、边框宽度参数。

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