Sankey NetworkD3：在整个流程中设置链接颜色

如何解决Sankey NetworkD3：在整个流程中设置链接颜色

我一直在关注堆栈示例，以使用 NetworkD3 包创建 Sankey 图表。我想设置特定于列变量 event 的链接的颜色。我拥有的数据有多列：

structure(list(names = c("bell","john","andrew","sam","bell","andrew"),event = c("Event 1","Event 2","Event 3","Event 1","Event 4","Event 1"),response = c("Yes","Yes","No","No")),class = "data.frame",row.names = c(NA,-7L))

> d
   names   event response
1   bell Event 1      Yes
2   john Event 2      Yes
3 andrew Event 3       No
4    sam Event 1      Yes
5   bell Event 2       No
6   bell Event 4      Yes
7 andrew Event 1       No

按照 CJ Yetman 的例子（如果你读过这个，非常感谢你提供的非常可遵循的例子！）here，创建了链接和节点的数据框：

links <- d %>% 
  mutate(row = row_number()) %>% 
  gather('column','source',-row) %>% 
  mutate(column = match(column,names(d))) %>%  
  group_by(row) %>% 
  arrange(column) %>% 
  mutate(target = lead(source)) %>% 
  ungroup %>% 
  filter(!is.na(target)) %>% 
  #index
  mutate(source = paste0(source,'_',column)) %>%
  mutate(target = paste0(target,column + 1)) %>%
  select(source,target)

nodes <- data.frame(
  name=c(as.character(links$source),as.character(links$target)) %>% 
    unique()
)

然后我将 nodes 数据框中的索引与 source 数据框中的 target 和 links 列进行匹配。在这种情况下，我改变了新列而不是覆盖它，因为它更容易阅读：

link <- links %>% 
  mutate(IDsource = match(links$source,nodes$name)-1) %>% 
  mutate(IDtarget = match(links$target,nodes$name)-1) %>% 
  mutate(value = 1) %>% 
  #remove index 
  mutate(source = sub('_[0-9]+$','',source)) %>% 
  mutate(target = sub('_[0-9]+$',target))

#
nodes$name <- sub('_[0-9]+$',nodes$name)

如前所述，我想通过 event 设置桑基图整个流程中链接的颜色。 Here 指定在 links 和 nodes 中创建新列以匹配 d3.scaleOrdinal() 函数中指定的色阶。

#New column to set colour for nodes  
nodes$node.col <- as.factor(c("nod.col")) #set nodes to one colour only

#New column for links 
col.index <- d %>% 
  select(event) %>% unique(); col.index #get events from original dataframe 

#mutate new column to set colours for links 
links$links.col <- col.index$event[match(links$source,col.index$event)]
links$links.col[is.na(links$links.col)] <- col.index$event[match(links$target[is.na(links$links.col)],col.index$event)]
links$links.col <- as.factor(links$links.col) #change to factors 

#d3.scaleOrdinal()
my_color <- 'd3.scaleOrdinal() .domain(["Event 1","nod.col"]) .range(["red","blue","red","yellow","gray"])'

但是，当每个事件都应该有自己的颜色（在整个流程中）时，链接都是红色的。

sankeyNetwork(Links = links,Nodes = nodes,Source = 'IDsource',Target = 'IDtarget',Value = 'value',NodeID = 'name',colourScale=my_color,LinkGroup="links.col",NodeGroup="node.col")

谁能解释一下我做错了什么？我遇到的另一个问题是手动设置 d3.scaleOrdinal() 中每个事件的颜色。如果有一种有效的方法可以做到这一点，我需要为多达 30 个或更多事件设置颜色？

解决方法

要获得正确的颜色，请在颜色分配中使用干净的名称，例如将列 links.col 中的空格和 domain 的 d3.scaleOrdinal 替换为例如下划线。不幸的是，我只有 D3 和 JS 的基本知识。所以我不能告诉你到底是什么问题。但它有效，并且是您的代码与 R Graph Gallery 中的示例代码之间的唯一区别：

library(tidyr)
library(dplyr)
library(networkD3)

# Make clean names
links$links.col <- as.factor(gsub(" ","_",links$links.col)) #change to factors 

my_color <- 'd3.scaleOrdinal() .domain(["Event_1","Event_2","Event_3","Event_4","nod.col"]) .range(["red","blue","red","yellow","grey"])'

sankeyNetwork(Links = links,Nodes = nodes,Source = 'IDsource',Target = 'IDtarget',Value = 'value',NodeID = 'name',colourScale=my_color,LinkGroup="links.col",NodeGroup="node.col")
#> Links is a tbl_df. Converting to a plain data frame.

EDIT 关于您问题的第二部分。如果您想要为事件自定义颜色，那么恐怕需要一些手动工作来定义为事件分配颜色的调色板。但是，使这更“有效”的一种选择是首先创建一个查找表，然后通过像这样连接字符串来创建 JS 代码：

# Make a look up table of events and colors
cols <- data.frame(
  domain = c("Event_1","Event_4"),color = c("red","yellow")
)
cols$domain <- sprintf('"%s"',cols$domain)
cols$color <- sprintf('"%s"',cols$color)

# Make the JS code by glueing strings
my_color <- c('d3.scaleOrdinal().domain([',paste(c(cols$domain,'"nod.col"'),collapse = ","),"]) .range([",paste(c(cols$color,'"grey"'),"])")
my_color <- paste(my_color,collapse = "")