R中通过JavaScript为networkD3的sankeyNetwork添加颜色图例

使用networkD3::sankeyNetwork()开发Shiny桑基图应用时，组件原生不支持LinkGroup配置对应的链接颜色图例，自行通过htmlwidgets::onRender()注入JavaScript代码添加图例时运行报错。

原有JavaScript部分存在3个核心问题，导致代码无法运行：

• d3选择器语法错误：类选择器需要给每个类名前加.，且不需要全局选择DOM，onRender函数可以直接拿到当前组件的DOM节点
• API调用逻辑错误：append()方法的参数必须是要创建的元素标签名，不能把整块变量声明、绘图逻辑直接塞到append()的参数里
• 位置硬编码问题：写死的图例坐标容易和桑基本身的节点、连线重叠，不会随图表尺寸自适应

library(networkD3)
library(dplyr)

MakeSankey <- function(){
  links <- data.frame(
    source=c("group_A","group_A", "group_B", "group_C", "group_C", "group_E"), 
    target=c("group_C","group_D", "group_E", "group_F", "group_G", "group_H"), 
    value=c(2,3, 2, 3, 1, 3),
    group=c("M","W","M","W","M","W")
  )
  
  nodes <- data.frame(
    name = unique(c(as.character(links$source), as.character(links$target))),
    group = "sources"
  )
  
  links$IDsource <- match(links$source, nodes$name)-1 
  links$IDtarget <- match(links$target, nodes$name)-1
  
  myColors <- 'd3.scaleOrdinal().domain(["M", "W", "sources"]).range(["#5485AB", "#BA4682", "#646363"])'
  
  p <- sankeyNetwork(
    Links = links, Nodes = nodes,
    Source = "IDsource", Target = "IDtarget",
    Value = "value", NodeID = "name", 
    colourScale= myColors, LinkGroup="group", NodeGroup="group", 
    sinksRight=FALSE, fontSize=14, nodeWidth = 20
  )
  
  # 修正后的JS图例代码
  js_code <- 'function(el) {
    var svg = d3.select(el).select("svg");
    // 获取svg实际宽度，把图例放到右上角避免遮挡图表
    var svgWidth = svg.node().getBoundingClientRect().width;
    var legendGroup = svg.append("g")
      .attr("class", "custom-legend")
      .attr("transform", "translate(" + (svgWidth - 120) + ", 20)");
    
    // 绘制M类图例
    legendGroup.append("circle")
      .attr("cx", 0).attr("cy", 0).attr("r", 6)
      .style("fill", "#5485AB");
    legendGroup.append("text")
      .attr("x", 15).attr("y", 0)
      .text("类别 M")
      .style("font-size", "14px")
      .attr("alignment-baseline", "middle");
    
    // 绘制W类图例
    legendGroup.append("circle")
      .attr("cx", 0).attr("cy", 25).attr("r", 6)
      .style("fill", "#BA4682");
    legendGroup.append("text")
      .attr("x", 15).attr("y", 25)
      .text("类别 W")
      .style("font-size", "14px")
      .attr("alignment-baseline", "middle");
  }'
  
  p <- htmlwidgets::onRender(p, js_code)
  return(p)
}

MakeSankey()

• 如果需要修改图例位置，直接调整transform属性里的偏移值即可：第一个参数是水平偏移，第二个是垂直偏移
• 如果图表右侧节点排布密集，可以把图例移到左上角，将水平偏移值改为20即可，比如translate(20, 20)
• 如果要新增图例项（比如节点对应的sources灰色分类），直接在legendGroup下追加圆形和文本元素即可，每新增一项把cy值累加25就能保持统一行间距
• 如果在Shiny中需要适配图表动态resize，可以在JS里加d3的resize事件监听，重新计算svg宽度后更新图例组的transform属性即可，静态展示场景下当前代码完全可用

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