如何自定义ggplotly(plotly)条形图的hover悬浮提示窗口

数据框包含2个取值正负均有的数值变量、2个分类变量。绘图时为负向条形设置了白色填充+同模型色边框的样式，但转成ggplotly交互图后，鼠标悬浮在条形上的提示信息显示异常，需要自定义悬浮提示规则。

原始复现代码 #

df <- data.frame(model  = c("A","B","C","D","B","C"),
                  category = c("origin", "origin","origin","abroad","abroad","abroad"),
                 pos = c(40,50,45,100,105,80),
                 neg = c(-10,-5,-4,-16,-7,-2),
                 Colour = c("chocolate","deeppink4","yellow","steelblue3","deeppink4","yellow"))

Colour <- as.character(df$Colour)
Colour <- c(Colour,"white")
names(Colour) <- c(as.character(df$model),"white")

df <- df %>% pivot_longer(., cols=c('pos','neg'),
                           names_to = 'sign') %>% 
  mutate(Groups = paste(category, model),
         sign = factor(sign, levels = c("neg", "pos")))

plot <- ggplot() +
  # 绘制正向条形，填充、边框颜色按model映射
  geom_col(aes(value, tidytext::reorder_within(model, value, category),
               fill = model, color = model), 
           data = df[df$sign == "pos", ],
           position = "stack") +
  # 绘制负向条形，填充固定为白色，边框颜色按model映射
  geom_col(aes(value, tidytext::reorder_within(model, value, category),
               color = model), 
           data = df[df$sign == "neg", ], 
           fill = "white",
           position = "stack") +
  tidytext::scale_y_reordered() +
  labs(fill = "model") +
  facet_grid(category ~ ., switch = "y",scales = "free_y") +
  theme(axis.text.x = element_text(angle = 90),
        strip.background = element_rect(fill = "white"),
        strip.placement = "outside",
        strip.text.y.left = element_text(angle = 0),
        panel.spacing = unit(0, "lines")) + 
  theme(legend.position="none") + 
  labs( title = "BarPlot",
        subtitle = "changes",
        y = " ")

ggplotly(plot)

悬浮提示异常是因为分图层绘制正负条形时，负向条形的fill属性写在aes()映射外部，ggplotly无法自动对齐两个图层的美学字段，导致提示信息抓取错乱、缺失。

在两个geom_col的aes()内部通过text参数自定义需要展示的悬浮内容，最后调用ggplotly()时指定tooltip = "text"，仅渲染自定义的提示内容即可，同时补上预设的颜色映射规则，保证条形颜色和预期一致。

修改后代码 #

library(tidyverse)
library(tidytext)
library(plotly)

df <- data.frame(model  = c("A","B","C","D","B","C"),
                  category = c("origin", "origin","origin","abroad","abroad","abroad"),
                 pos = c(40,50,45,100,105,80),
                 neg = c(-10,-5,-4,-16,-7,-2),
                 Colour = c("chocolate","deeppink4","yellow","steelblue3","deeppink4","yellow"))

Colour <- as.character(df$Colour)
Colour <- c(Colour,"white")
names(Colour) <- c(as.character(df$model),"white")

df <- df %>% pivot_longer(., cols=c('pos','neg'),
                           names_to = 'sign') %>% 
  mutate(Groups = paste(category, model),
         sign = factor(sign, levels = c("neg", "pos")))

plot <- ggplot() +
  geom_col(aes(value, tidytext::reorder_within(model, value, category),
               fill = model, 
               color = model,
               # 自定义正向条形悬浮内容
               text = paste0("分类: ", category, "<br>模型: ", model, "<br>数值: ", value)), 
           data = df[df$sign == "pos", ],
           position = "stack") +
  geom_col(aes(value, tidytext::reorder_within(model, value, category),
               color = model,
               # 负向条形悬浮内容和正向保持一致
               text = paste0("分类: ", category, "<br>模型: ", model, "<br>数值: ", value)), 
           data = df[df$sign == "neg", ], 
           fill = "white",
           position = "stack") +
  # 加载预设的颜色映射
  scale_fill_manual(values = Colour) +
  scale_color_manual(values = Colour) +
  tidytext::scale_y_reordered() +
  labs(fill = "model") +
  facet_grid(category ~ ., switch = "y",scales = "free_y") +
  theme(axis.text.x = element_text(angle = 90),
        strip.background = element_rect(fill = "white"),
        strip.placement = "outside",
        strip.text.y.left = element_text(angle = 0),
        panel.spacing = unit(0, "lines")) + 
  theme(legend.position="none") + 
  labs( title = "BarPlot",
        subtitle = "changes",
        y = " ")

# 指定tooltip仅渲染自定义的text字段
ggplotly(plot, tooltip = "text")

效果说明 #

• 所有正负条形悬浮时正常展示自定义内容，无缺失、错乱问题
• 条形填充、边框颜色和预设规则完全一致
• 可自由调整提示内展示的字段，用<br>即可实现内容换行

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