R sankey networkD3 - 设置目标节点的颜色

问题描述 投票:0回答:1

我想创建一个桑基图,为源节点和目标节点设置不同的自定义颜色。 源节点(和链接)按预期着色。然而,目标没有呈现出所需的颜色。下面是我正在使用的代码:

# 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

我希望目标按照代码中声明的方式着色,但是,正如您从图片中看到的,结果不是所需的结果:Sankey

目标的颜色似乎分配不正确。例如,如果我更改第一个目标的颜色(不确定性),代码也会更改第二个目标的颜色(路径依赖)。 这是修改后的代码:

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',
         ]);
  "

这里是结果图:Sankey(更改第一个目标的颜色)。 同样,更改其他目标颜色会导致奇怪的结果(例如多个目标的颜色被修改,与被修改的位置不同的目标会改变颜色)。

我真的不明白为什么会发生这种情况。我怀疑节点的定义方式以及颜色的分配方式可能存在一些冲突,但到目前为止我还无法确定问题到底出在哪里。

有人能够发现我做错了什么吗?

提前致谢。

r colors target sankey-diagram networkd3
1个回答
0
投票

我认为您可能打算在

NodeGroup = "group"
中使用
NodeGroup = "name"
而不是
sankeyNetwork()
,但即使如此,您在 JavaScript 的
domain()
中列出的名称与
nodes$name
中的名称也不完全匹配
nodes$group

© www.soinside.com 2019 - 2024. All rights reserved.