如何在ggplot散点图中为职位点添加相似职位交互关联？

以下是修改后的完整代码，实现点击职位节点时高亮相似职位并显示关联线条的功能：

library(ggplot2)
library(plotly)
library(jsonlite)

# 读取数据
data <- read.csv("data.csv")
experience <- read.csv("experience.csv")
jobType <- read.csv("JobType.csv")

# 筛选相似度≥0.9的关联数据
filtered_data <- subset(data, Full.Transferability >= 0.9)

# 保留同时存在于experience和jobType中的职位
valid_occupations <- intersect(experience$Occupation, jobType$Occupation)
filtered_data <- filtered_data[filtered_data$Occ1 %in% valid_occupations & filtered_data$Occ2 %in% valid_occupations, ]

# 创建节点数据框：包含职位名称、分类轴信息及固定抖动坐标
nodes <- data.frame(
  name = valid_occupations,
  x = jobType$Job_type[match(valid_occupations, jobType$Occupation)],
  y = experience$Strata.Level[match(valid_occupations, experience$Occupation)]
)

# 添加固定抖动坐标（保证每次渲染位置一致）
set.seed(123)
nodes$x_jitter <- as.numeric(factor(nodes$x)) + runif(nrow(nodes), -0.2, 0.2)
nodes$y_jitter <- as.numeric(factor(nodes$y)) + runif(nrow(nodes), -0.2, 0.2)

# 创建关联线条数据框
edges <- data.frame()
for (i in 1:nrow(filtered_data)) {
  from_row <- nodes[nodes$name == filtered_data$Occ1[i], ]
  to_row <- nodes[nodes$name == filtered_data$Occ2[i], ]
  if (nrow(from_row) > 0 && nrow(to_row) > 0) {
    edges <- rbind(edges, data.frame(
      x = from_row$x_jitter,
      y = from_row$y_jitter,
      xend = to_row$x_jitter,
      yend = to_row$y_jitter,
      from_name = from_row$name,
      to_name = to_row$name
    ))
  }
}

# 生成相似职位映射的JSON对象（供JavaScript调用）
similar_jobs <- lapply(nodes$name, function(job) {
  c(filtered_data$Occ2[filtered_data$Occ1 == job], filtered_data$Occ1[filtered_data$Occ2 == job]) %>%
    unique() %>%
    .[. %in% nodes$name]
})
names(similar_jobs) <- nodes$name
similar_jobs_json <- toJSON(similar_jobs, auto_unbox = TRUE)

# 构建可视化图层
gg <- ggplot() +
  # 关联线条（初始隐藏）
  geom_segment(data = edges, 
               aes(x = x, y = y, xend = xend, yend = yend, 
                   from_name = from_name, to_name = to_name),
               color = "gray", alpha = 0, linewidth = 0.5) +
  # 职位节点
  geom_point(data = nodes, 
             aes(x = x_jitter, y = y_jitter, text = name, customdata = name),
             size = 1, color = "steelblue") +
  # 坐标轴设置
  labs(x = "职位类型", y = "经验等级") +
  scale_x_continuous(breaks = 1:length(unique(nodes$x)), 
                     labels = unique(nodes$x)) +
  scale_y_continuous(breaks = 1:length(unique(nodes$y)), 
                     labels = unique(nodes$y)) +
  theme_minimal() +
  theme(panel.grid = element_blank(),
        axis.text.x = element_text(angle = 45, hjust = 1)) +
  coord_cartesian(clip = "off") +
  theme(plot.margin = margin(20, 20, 20, 20))

# 转换为plotly交互对象
p <- ggplotly(gg, tooltip = "text") %>%
  event_register("plotly_click")

# JavaScript点击事件处理逻辑
js <- sprintf("
  var similarJobs = %s;
  
  function handleClick(eventData) {
    if (!eventData.points.length) return;
    
    var plot = document.getElementById('%s');
    var selectedJob = eventData.points[0].customdata;
    
    // 获取图层轨迹：线条为trace0，节点为trace1
    var pointsTrace = plot.data[1];
    var edgesTrace = plot.data[0];
    
    // 重置所有节点和线条的默认样式
    pointsTrace.marker.color = 'steelblue';
    pointsTrace.marker.size = 1;
    edgesTrace.opacity = Array(edgesTrace.x.length).fill(0);
    
    // 高亮选中的职位节点
    var selectedIndex = pointsTrace.customdata.indexOf(selectedJob);
    if (selectedIndex !== -1) {
      pointsTrace.marker.color[selectedIndex] = '#ff3333';
      pointsTrace.marker.size[selectedIndex] = 3;
    }
    
    // 高亮相似职位并显示关联线条
    var similar = similarJobs[selectedJob] || [];
    similar.forEach(function(job) {
      var idx = pointsTrace.customdata.indexOf(job);
      if (idx !== -1) {
        pointsTrace.marker.color[idx] = '#ff9933';
        pointsTrace.marker.size[idx] = 2;
      }
      
      // 显示选中职位与相似职位的关联线条
      for (var i = 0; i < edgesTrace.from_name.length; i++) {
        if ((edgesTrace.from_name[i] === selectedJob && edgesTrace.to_name[i] === job) ||
            (edgesTrace.from_name[i] === job && edgesTrace.to_name[i] === selectedJob)) {
          edgesTrace.opacity[i] = 1;
        }
      }
    });
    
    // 更新图表
    Plotly.update(plot.id, plot.data, plot.layout);
  }
  
  // 绑定点击事件
  document.getElementById('%s').on('plotly_click', handleClick);
", similar_jobs_json, p$elementId, p$elementId)

# 将JavaScript脚本添加到图表中
p <- htmlwidgets::prependContent(p, htmltools::tags$script(js))

# 显示交互图表
p

关键修改说明 #

1. 固定节点位置：用预计算的抖动坐标替代geom_jitter，确保节点位置稳定，便于绘制关联线条
2. 预构建关联线条：提前生成所有职位间的关联线条，初始状态隐藏
3. 相似职位映射：生成职位与相似职位的JSON映射，供JavaScript快速查找
4. 交互逻辑实现：
   • 点击职位时重置所有元素样式
   • 高亮选中职位（红色，放大）
   • 高亮相似职位（橙色，放大）
   • 显示选中职位与相似职位的关联线条

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