R中如何使用plotly的highlight()函数控制ggplot2图层交互显示

该需求可直接实现，无需复杂定制开发，调整图层渲染逻辑配合plotly事件回调即可完成。

你当前的代码会在初始渲染阶段直接绘制所有分组的回归线、相关系数标签，导致线层始终全局显示。要实现「仅选中分组才展示回归线」的效果，只需要做两处核心调整：

• 初始加载图表时隐藏所有回归线、相关系数标签，仅保留散点图层
• 绑定点击高亮事件时，仅将当前选中分组对应的回归线、相关系数标签切换为可见状态；双击取消选中时，再把所有线、标签切回隐藏状态

library(ggplot2)
library(plotly)
library(ggpubr)
library(crosstalk)

# 沿用原代码的分组绑定逻辑
d <- highlight_key(happy, ~Region)

# 先绘制仅含散点的基础图，初始不加载回归线、相关系数标签层
p <- ggplot( d, aes(x = Prevalence.of.current.tobacco.use....of.adults., 
                    y = Happiness.Score, 
                    group = Region, 
                    color = Region, 
                    text = Country)) + 
  labs(y= "Happiness Score", x = "Tobacco Use (%)", title = "Smoking and Happiness") + 
  geom_point(aes(size = Economy..GDP.per.Capita.)) +
  theme_bw() + 
  scale_color_manual(values = rainbow(10, alpha=0.6)) +
  scale_size_continuous(range = c(0, 10), name='')

# 转为plotly对象
gg <- ggplotly(p, tooltip = "text")

# 提前按分组预计算回归线数据、相关系数值，生成对应图层（默认隐藏）
region_list <- unique(happy$Region)
color_pal <- rainbow(10, alpha=0.6)
names(color_pal) <- region_list
add_trace_list <- list()

for(reg in region_list){
  sub_data <- happy[happy$Region == reg,]
  # 拟合线性模型生成回归线坐标
  lm_fit <- lm(Happiness.Score ~ Prevalence.of.current.tobacco.use....of.adults., data = sub_data)
  x_range <- range(sub_data$Prevalence.of.current.tobacco.use....of.adults., na.rm = T)
  x_pred <- seq(x_range[1], x_range[2], length.out = 50)
  y_pred <- predict(lm_fit, newdata = data.frame(Prevalence.of.current.tobacco.use....of.adults. = x_pred))
  # 加入回归线trace
  add_trace_list <- append(add_trace_list, list(list(
    x = x_pred, y = y_pred, type = "scatter", mode = "lines",
    line = list(color = color_pal[reg], width = 0.5),
    legendgroup = reg, name = paste0(reg, "_smooth"),
    hoverinfo = "none", visible = F, showlegend = F
  )))
  # 计算相关系数，加入标签trace
  r_val <- round(cor(sub_data$Prevalence.of.current.tobacco.use....of.adults., 
                     sub_data$Happiness.Score, use = "complete.obs"), 2)
  add_trace_list <- append(add_trace_list, list(list(
    x = mean(x_range), y = max(sub_data$Happiness.Score, na.rm = T),
    type = "scatter", mode = "text",
    text = paste0("R=", r_val), textfont = list(color = color_pal[reg]),
    legendgroup = reg, name = paste0(reg, "_cor"),
    hoverinfo = "none", visible = F, showlegend = F
  )))
}
# 将预生成的线、标签图层加入图表
gg <- add_traces(gg, add_trace_list)

# 配置高亮规则+事件回调，控制线和标签的显示隐藏
gg <- highlight(
  gg, 
  on = "plotly_click", 
  off = "plotly_doubleclick", 
  opacityDim = 0.05,
  js = "
    function(el){
      // 点击分组时，仅显示当前选中组的回归线和标签
      el.on('plotly_click', function(d){
        var selected = d.points[0].data.legendgroup;
        var vis_setting = el.data.map(t => {
          if(t.name.includes('_smooth') || t.name.includes('_cor')) return false;
          return true;
        });
        el.data.forEach((t,i) => {
          if(t.legendgroup == selected && (t.name.includes('_smooth') || t.name.includes('_cor'))){
            vis_setting[i] = true;
          }
        })
        Plotly.update(el, {visible: vis_setting});
      })
      // 双击取消选中时，隐藏所有回归线和标签
      el.on('plotly_doubleclick', function(){
        var vis_setting = el.data.map(t => {
          if(t.name.includes('_smooth') || t.name.includes('_cor')) return false;
          return true;
        });
        Plotly.update(el, {visible: vis_setting});
      })
    }
  "
)

# 输出图表
gg

• 图表初始加载时仅显示散点，无多余的线和标签，界面整洁
• 点击任意分组的散点后，对应分组散点保持高亮、其余散点透明度降到0.05，同时自动展示该分组的线性回归直线和相关系数标签
• 双击空白处取消选中时，所有回归线、标签自动隐藏，回到初始状态

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