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

Question

我一直在跟踪堆栈上的示例，以使用 NetworkD3 包创建桑基图。我想设置特定于列变量event 的链接的颜色。我拥有的数据有多个列：

structure(list(names = c("bell", "john", "andrew", "sam", "bell", 
"bell", "andrew"), event = c("Event 1", "Event 2", "Event 3", 
"Event 1", "Event 2", "Event 4", "Event 1"), response = c("Yes", 
"Yes", "No", "Yes", "No", "Yes", "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 数据框中的索引与links 数据框中的source 和target 列进行匹配。在这种情况下，我改变了新列而不是覆盖它，因为它更容易阅读：

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", "Event 2", "Event 3", "Event 4", "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 个或更多事件设置颜色？

Answer 1

要获得正确的颜色，请在颜色分配中使用干净的名称，例如将links.col 列中的空格和d3.scaleOrdinal 的domain 替换为例如一个下划线。不幸的是，我只有 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.

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

# Make a look up table of events and colors
cols <- data.frame(
  domain = c("Event_1", "Event_2", "Event_3", "Event_4"),
  color = c("red", "blue", "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"'), collapse = ", "),
              "])")
my_color <- paste(my_color, collapse = "")