R Shiny应用中如何修改GGPLOTLY图表的悬停交互效果

实现逻辑 #

• 悬停提示框自定义：在geom_bar的美学映射中新增text参数，仅定义要展示的计数值内容，调用ggplotly时指定tooltip = "text"即可屏蔽默认生成的X轴维度信息
• 悬停高亮效果：通过plotly的style方法配置柱子悬停状态，可自定义悬停时的填充色、边框样式，同时屏蔽柱子上方计数文本的悬停触发逻辑，避免提示框异常弹出

完整可运行代码 #

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(aes(text = paste0("count: ", ..count..)), fill = "#327EC2") + 
            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(ethnicity_barplot, tooltip = "text") %>%
          style(
            # 配置柱子悬停效果：填充变为浅蓝色，加2px黑色外边框
            marker = list(
              hover = list(
                fill = "#add8e6",
                line = list(color = "#000000", width = 2)
              )
            ),
            # 屏蔽计数文本的悬停触发
            hoverinfo = "skip",
            traces = 2
          )
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

参数调整说明 #

如果不需要修改悬停时的填充色，仅保留黑色外边框，删除style方法中hover配置下的fill = "#add8e6"即可，也可自行修改色号调整高亮效果。

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