R语言networkD3 Sankey图：目标节点自定义颜色异常问题求助

问题 #

使用R的networkD3包创建Sankey图时，源节点及链接颜色符合预期，但目标节点无法应用指定颜色。修改第一个目标节点（Uncertainty）颜色时，第二个目标节点（Path dependence）颜色也随之改变，其他目标节点修改时也有类似异常。

以下是原代码：

# Install packages
if (!require("pacman")) install.packages("pacman")
pacman::p_load(dplyr, readxl, networkD3)

# Load libraries
library(readxl)
library(networkD3)
library(dplyr)

# Generate data
data <- data.frame(
  Recommendation = c("Participatory decision-making process", "Participatory decision-making process", "Participatory decision-making process", "Participatory decision-making process", "Participatory decision-making process", "Participatory decision-making process", "Participatory decision-making process", "Participatory decision-making process", "Participatory decision-making process", 
             "Involve wide range of experts", "Involve wide range of experts", "Involve wide range of experts", "Involve wide range of experts", "Involve wide range of experts", "Involve wide range of experts", "Involve wide range of experts", "Involve wide range of experts", "Involve wide range of experts", "Involve wide range of experts", "Involve wide range of experts", "Involve wide range of experts", 
             "Legal/regulatory framework to assist NbS", "Legal/regulatory framework to assist NbS", "Legal/regulatory framework to assist NbS", "Legal/regulatory framework to assist NbS", 
             "Include social justice", "Include social justice", "Include social justice", "Include social justice", 
             "Many future scenarios", 
             "Consider NbS as an option", "Consider NbS as an option", "Consider NbS as an option", 
             "Disincentivise myopia and internalise ES externalities", "Disincentivise myopia and internalise ES externalities", "Disincentivise myopia and internalise ES externalities", "Disincentivise myopia and internalise ES externalities", 
             "Move beyond monetary valuation", "Move beyond monetary valuation", "Move beyond monetary valuation", 
             "Multi-scalar valuation", "Multi-scalar valuation", "Multi-scalar valuation", 
             "Draw on pilots/past examples", "Draw on pilots/past examples", 
             "Improve awareness of NbS co-benefits", 
             "Multiple financing approaches", 
             "Early and continued monitoring/maintenance", "Early and continued monitoring/maintenance", 
             "Behavior/experience mapping", "Behavior/experience mapping", "Behavior/experience mapping"
             ),
  Barrier = c("Compartimentalisation", "Myopic decision-making", "Undervaluation of multifunctionality", "Disregard trade-offs", "Lack of public support", "Disregard justice", "Secure funding", "No long-term monitoring", "Economic growth paradigm", 
             "Uncertainty", "Path dependence", "Compartimentalisation", "Undervaluation of multifunctionality", "Limitations in evaluation methods", "Disregard trade-offs", "Lack of public support", "Disregard justice", "Secure funding", "No long-term monitoring", "Lack of supporting regulation", "Economic growth paradigm", 
             "Compartimentalisation", "Path dependence", "Myopic decision-making", "Lack of supporting regulation", 
             "Undervaluation of multifunctionality", "Disregard trade-offs", "Disregard justice", "Economic growth paradigm", 
             "Uncertainty", 
             "Compartimentalisation", "Path dependence", "Lack of supporting regulation", 
             "Compartimentalisation", "Path dependence", "Myopic decision-making", "Lack of supporting regulation", 
             "Undervaluation of multifunctionality", "Limitations in evaluation methods", "Disregard trade-offs", 
             "Undervaluation of multifunctionality", "Limitations in evaluation methods", "Undervaluation of multifunctionality", 
             "Uncertainty", "Secure funding", 
             "Lack of public support", 
             "Secure funding", 
             "Lack of supporting regulation", "No long-term monitoring", 
             "Context dependence", "Disregard trade-offs", "Lack of public support"),
  Value = 1
)

# Create links data
links <- 
  data %>% 
  rename(source = Recommendation, target = Barrier, value = Value)

# Create nodes data
ordered_barriers <- c('Uncertainty',
                      'Path dependence',
                      'Compartimentalisation',
                      'Myopic decision-making',
                      'Context dependence',
                      'Undervaluation of multifunctionality',
                      'Limitations in evaluation methods',
                      'Disregard trade-offs',
                      'Lack of public support',
                      'Disregard justice',
                      'Secure funding',
                      'No long-term monitoring',
                      'Lack of supporting regulation',
                      'Economic growth paradigm')
nodes <- data.frame(name = unique(c(data$Recommendation, ordered_barriers)))

links$source_id <- match(links$source, nodes$name) - 1
links$target_id <- match(links$target, nodes$name) - 1

nodes$group <- gsub(" ", "-", nodes$name)

color_scale <-
  "d3.scaleOrdinal()
     .domain(['Participatory decision-making process', 'Involve wide range of experts', 'Legal/regulatory framework to assist NbS', 'Include social justice',
         'Many future scenarios', 'Consider NbS as an option', 'Disincentivise myopia and internalise ES externalities',
         'Move beyond monetary valuation', 'Multi-scalar valuation', 'Draw on pilots/past examples',
         'Improve awareness of NbS co-benefits', 'Multiple financing approaches',
         'Early and continued monitoring/maintenance', 'Behavior/experience mapping',
         'Uncertainty', 'Path-dependence', 'Compartimentalisation', 'Myopic decision-making', 'Context dependence',
         'Undervaluation of multifunctionality', 'Limitations in evaluation methods', 'Disregard trade-offs',
         'Lack of public support', 'Disregard justice', 'Secure funding',
         'No long-term monitoring', 'Lack of supporting regulation', 'Economic growth paradigm'])
     .range(['#3182BDFF', '#6BAED6FF', '#9ECAE1FF', '#C6DBEFFF',
         '#74C476FF', '#A1D99BFF', '#C7E9C0FF',
         '#FD8D3CFF', '#FDAE6BFF', '#FDD0A2FF',
         '#BD9E39FF', '#E7BA52FF',
         '#D6616BFF', '#E7969CFF',
         '#31A354FF', '#31A354FF', '#31A354FF', '#31A354FF', '#31A354FF',
         '#E6550DFF', '#E6550DFF', '#E6550DFF',
         '#843C39FF', '#843C39FF', '#843C39FF',
         '#843C39FF', '#843C39FF', '#843C39FF',
         ]);
  "

# Create the Sankey diagram
sn <- sankeyNetwork(
  Links = links, 
  Nodes = nodes,
  Source = "source_id",
  Target = "target_id",
  Value = "value",
  NodeID = "name",
  LinkGroup = "source",
  fontSize = 10,
  NodeGroup = "name",
  colourScale = color_scale,
  iterations = 0
)

# Move labels outside of diagram
sn <- htmlwidgets::onRender(
  sn,
  paste0('
        function(el,x){
        d3.select(el)
        .selectAll(".node text")
        .filter(function(d) { return (["',paste0(links$source,collapse = '","'),'"].indexOf(d.name) > -1);})
        .attr("x", x.options.nodeWidth - 20)
        .attr("text-anchor", "end");
        d3.select(el)
        .selectAll(".node text")
        .filter(function(d) { return (["',paste0(links$target,collapse = '","'),'"].indexOf(d.name) > -1);})
        .attr("x", x.options.nodeWidth + 5)
        .attr("text-anchor", "start");
        }
        ')
)

# Display the diagram
sn

修改目标节点颜色的尝试代码：

color_scale <-
  "d3.scaleOrdinal()
     .domain(['Participatory decision-making process', 'Involve wide range of experts', 'Legal/regulatory framework to assist NbS', 'Include social justice',
         'Many future scenarios', 'Consider NbS as an option', 'Disincentivise myopia and internalise ES externalities',
         'Move beyond monetary valuation', 'Multi-scalar valuation', 'Draw on pilots/past examples',
         'Improve awareness of NbS co-benefits', 'Multiple financing approaches',
         'Early and continued monitoring/maintenance', 'Behavior/experience mapping',
         'Uncertainty', 'Path-dependence', 'Compartimentalisation', 'Myopic decision-making', 'Context dependence',
         'Undervaluation of multifunctionality', 'Limitations in evaluation methods', 'Disregard trade-offs',
         'Lack of public support', 'Disregard justice', 'Secure funding',
         'No long-term monitoring', 'Lack of supporting regulation', 'Economic growth paradigm'])
     .range(['#3182BDFF', '#6BAED6FF', '#9ECAE1FF', '#C6DBEFFF',
         '#74C476FF', '#A1D99BFF', '#C7E9C0FF',
         '#FD8D3CFF', '#FDAE6BFF', '#FDD0A2FF',
         '#BD9E39FF', '#E7BA52FF',
         '#D6616BFF', '#E7969CFF',
         '#1F77B4FF', '#31A354FF', '#31A354FF', '#31A354FF', '#31A354FF',
         '#E6550DFF', '#E6550DFF', '#E6550DFF',
         '#843C39FF', '#843C39FF', '#843C39FF',
         '#843C39FF', '#843C39FF', '#843C39FF',
         ]);
  "

错误原因与解决方案 #

核心错误 #

color_scale的domain中存在名称拼写不一致的问题：

• 节点实际名称是Path dependence（空格分隔），但domain中写成了Path-dependence（短横线分隔）
• d3的ordinal scale无法找到匹配的节点名称时，会按顺序自动分配后续的颜色值，导致修改一个节点颜色时，其他未匹配的节点颜色也会联动变化

修复步骤 #

1. 修正domain中的节点名称：确保所有domain中的名称与nodes$name完全一致，尤其是包含空格的名称（比如把Path-dependence改为Path dependence）
2. 验证domain与range长度匹配：确保domain的元素数量和range的颜色数量完全对应，避免颜色分配错位
3. 可选：动态生成domain：从nodes$name直接生成domain，避免手动输入的拼写错误

修正后的color_scale代码 #

color_scale <-
  "d3.scaleOrdinal()
     .domain(['Participatory decision-making process', 'Involve wide range of experts', 'Legal/regulatory framework to assist NbS', 'Include social justice',
         'Many future scenarios', 'Consider NbS as an option', 'Disincentivise myopia and internalise ES externalities',
         'Move beyond monetary valuation', 'Multi-scalar valuation', 'Draw on pilots/past examples',
         'Improve awareness of NbS co-benefits', 'Multiple financing approaches',
         'Early and continued monitoring/maintenance', 'Behavior/experience mapping',
         'Uncertainty', 'Path dependence', 'Compartimentalisation', 'Myopic decision-making', 'Context dependence',
         'Undervaluation of multifunctionality', 'Limitations in evaluation methods', 'Disregard trade-offs',
         'Lack of public support', 'Disregard justice', 'Secure funding',
         'No long-term monitoring', 'Lack of supporting regulation', 'Economic growth paradigm'])
     .range(['#3182BDFF', '#6BAED6FF', '#9ECAE1FF', '#C6DBEFFF',
         '#74C476FF', '#A1D99BFF', '#C7E9C0FF',
         '#FD8D3CFF', '#FDAE6BFF', '#FDD0A2FF',
         '#BD9E39FF', '#E7BA52FF',
         '#D6616BFF', '#E7969CFF',
         '#1F77B4FF', '#31A354FF', '#31A354FF', '#31A354FF', '#31A354FF',
         '#E6550DFF', '#E6550DFF', '#E6550DFF',
         '#843C39FF', '#843C39FF', '#843C39FF',
         '#843C39FF', '#843C39FF', '#843C39FF',
         ]);
  "

额外优化建议 #

可以通过R代码动态生成domain，避免手动输入错误：

# 从nodes$name生成domain字符串
domain_str <- paste0("['", paste(nodes$name, collapse = "', '"), "']")

# 动态构建color_scale
color_scale <- paste0(
  "d3.scaleOrdinal()
     .domain(", domain_str, ")
     .range(['#3182BDFF', '#6BAED6FF', '#9ECAE1FF', '#C6DBEFFF',
         '#74C476FF', '#A1D99BFF', '#C7E9C0FF',
         '#FD8D3CFF', '#FDAE6BFF', '#FDD0A2FF',
         '#BD9E39FF', '#E7BA52FF',
         '#D6616BFF', '#E7969CFF',
         '#1F77B4FF', '#31A354FF', '#31A354FF', '#31A354FF', '#31A354FF',
         '#E6550DFF', '#E6550DFF', '#E6550DFF',
         '#843C39FF', '#843C39FF', '#843C39FF',
         '#843C39FF', '#843C39FF', '#843C39FF',
         ]);
  "
)

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