为Plotly(Shiny环境)添加自定义模式栏按钮实现按颜色悬停

此前针对Plotly自定义悬停对比的两种方案在独立图表中可正常运行，但在Shiny应用中出现适配问题：

• HTML按钮方案：Shiny输入变更时会重复添加按钮，不符合需求
• Plotly按钮方案：切换悬停选项后，「按颜色悬停」功能固定在单一颜色，无法随鼠标移动

现通过替换hovermode = 'x'对应的自定义事件处理JS代码，实现通过模式栏按钮触发按颜色悬停的功能，完整实现如下：

数据准备 #

library(shiny)
library(tidyverse)
library(plotly)
library(bslib)
library(htmlwidgets)

dat <- data.frame(
  group1 = rep(letters[1:4], each=5), 
  group2 = rep(LETTERS[1:5], times=4),
  pct = c(rep(.2, times=5), 
          c(.1, .1, .1, .3, .4), 
          c(.2, .2, .2, .3, .1),
          c(.3, .1, .2, .2, .2))
)

自定义模式栏按钮 #

# 显示最近数据的悬停按钮
closest <- list(
  name = "显示最近数据悬停",
  icon = list(
    width = 1792,
    height = 1792,
    path = "M1203 544q0 13-10 23l-393 393 393 393q10 10 10 23t-10 23l-50 50q-10 10-23 10t-23-10l-466-466q-10-10-10-23t10-23l466-466q10-10 23-10t23 10l50 50q10 10 10 23z",
    transform = 'matrix(1 0 0 -1 0 1792)'
  ),
  click = htmlwidgets::JS(
    "function(gd) {
       // 移除颜色悬停监听，恢复默认最近点模式
       gd.removeEventListener('plotly_hover', window.colorHoverHandler);
       Plotly.relayout(gd, {hovermode: 'closest'});
    }"
  )
)

# 按颜色对比悬停按钮（核心修复）
colorcompare <- list(
  name = "按颜色对比悬停",
  icon = list(
    width = 1792,
    height = 1792,
    path = "M1011 1376q0 13-10 23l-50 50q-10 10-23 10t-23-10l-466-466q-10-10-10-23t10-23l466-466q10-10 23-10t23 10l50 50q10 10 10 23t-10 23l-393 393 393 393q10 10 10 23zm384 0q0 13-10 23l-50 50q-10 10-23 10t-23-10l-466-466q-10-10-10-23t10-23l466-466q10-10 23-10t23 10l50 50q10 10 10 23t-10 23l-393 393 393 393q10 10 10 23z",
    transform = 'matrix(1 0 0 -1 0 1792)'
  ),
  click = htmlwidgets::JS(
    "function(gd) {
      // 移除之前的hover事件监听，避免重复绑定
      gd.removeEventListener('plotly_hover', window.colorHoverHandler);
      // 定义按颜色匹配的悬停逻辑
      window.colorHoverHandler = function(event) {
        const targetGroup = event.points[0].customdata;
        // 先隐藏所有轨迹的悬停信息
        Plotly.restyle(gd, 'hoverinfo', ['skip']);
        // 只开启同颜色组轨迹的悬停
        gd.data.forEach((trace, idx) => {
          if(trace.customdata[0] === targetGroup) {
            Plotly.restyle(gd, 'hoverinfo', ['text'], [idx]);
          }
        });
        // 触发当前点的悬停显示
        Plotly.Fx.hover(gd, {points: event.points.map(p => ({curveNumber: p.curveNumber, pointNumber: p.pointNumber}))});
      };
      // 绑定新的hover事件
      gd.addEventListener('plotly_hover', window.colorHoverHandler);
      // 禁用默认hovermode，避免冲突
      Plotly.relayout(gd, {hovermode: false});
    }"
  )
)

# 按Y轴对比悬停按钮
ycompare <- list(
  name = "按Y轴数据对比悬停",
  icon = list(
    width = 1792,
    height = 1792,
    path = "M1395 864q0 13-10 23l-466 466q-10 10-23 10t-23-10l-466-466q-10-10-10-23t10-23l50-50q10-10 23-10t23 10l393 393 393-393q10-10 23-10t23 10l50 50q10 10 10 23zm0-384q0 13-10 23l-466 466q-10 10-23 10t-23-10l-466-466q-10-10-10-23t10-23l50-50q10-10 23-10t23 10l393 393 393-393q10-10 23-10t23 10l50 50q10 10 10 23z",
    transform = 'matrix(1 0 0 -1 0 1792)'
  ),
  click = htmlwidgets::JS(
    "function(gd) {
      // 移除颜色悬停监听，恢复默认Y轴对比模式
      gd.removeEventListener('plotly_hover', window.colorHoverHandler);
      Plotly.relayout(gd, {hovermode: 'y'});
    }"
  )
)

图表生成代码 #

plot <- dat %>%
  plot_ly() %>%
  add_bars(
    x = ~pct, 
    y = ~group1,  
    color = ~group2,
    split = ~group2, 
    customdata = ~group2,
    hovertemplate = paste0("%{x:.2f%}<br>", "<extra>%{customdata}</extra>")
  ) %>% 
  layout(
    yaxis = list(title = 'Group 1', autorange = 'reversed', categoryorder = 'trace'),
    xaxis = list(title = '百分比', tickformat = ".0%"),
    barmode = 'stack', 
    hovermode = 'y', 
    legend = list(traceorder = "normal")
  ) %>%
  config(
    displaylogo = FALSE, 
    modeBarButtonsToAdd = list(closest, colorcompare, ycompare),
    modeBarButtonsToRemove = list('hoverCompareCartesian','hoverClosestCartesian')
  ) 

# 在Shiny应用中使用时，将plot放入renderPlotly即可
# output$targetPlot <- renderPlotly({ plot })

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