我已经使用networkD3软件包制作了一个Sankey图，现在我想为Sankey图中节点之间的灰色连接添加一种颜色。

当前脚本

A small part of my dataframe:
sankey1 <- structure(list(pat_id = c(10037, 10264, 10302, 10302, 10302, 
10344, 10482, 10482, 10482, 10613, 10613, 10613, 10628, 10851, 
11052, 11203, 11214, 11214, 11566, 11684, 11821, 11945, 11945, 
11952, 11952, 12122, 12183, 12774, 13391, 13573, 13643, 14298, 
14556, 14556, 14648, 14862, 14935, 14935, 14999, 15514, 15811, 
16045, 16045, 16190, 16190, 16190, 16220, 16220, 16220, 16220
), contactnummer = c(1, 1, 1, 2, 3, 1, 1, 2, 3, 1, 2, 3, 1, 1, 
1, 1, 1, 2, 1, 1, 1, 1, 2, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 
1, 1, 2, 1, 1, 1, 1, 2, 1, 2, 3, 1, 2, 3, 99), Combo2 = c(1, 
1, 1, 1, 2, 1, 2, 1, 1, 1, 1, 1, 1, 1, 3, 1, 1, 1, 1, 1, 1, 1, 
2, 4, 4, 1, 5, 1, 1, 1, 1, 3, 3, 1, 5, 1, 1, 3, 1, 1, 1, 1, 1, 
3, 6, 3, 1, 1, 1, 1), treatment = c(99, 0, 0, 1, 1, 0, 99, 99, 
99, 99, 99, 1, 1, 0, 1, 99, 99, 99, 0, 99, 99, 0, 0, 0, 1, 99, 
99, 0, 0, 0, 0, 0, 1, 1, 1, 99, 99, 1, 0, 0, 1, 0, 0, 0, 1, 1, 
99, 99, 99, 99)), row.names = c(NA, 50L), class = c("data.table", 
"data.frame"))

df <-
  sankey1 %>%  
  # wide format to gives an order
  pivot_wider(id_cols = pat_id
              , names_from = contactnummer
              , values_from = c(Combo2,treatment)
              ,names_glue = "{contactnummer}_{.value}"
              ,names_sort=TRUE) %>%

  #df[3:4] <- NULL
  # put in a long format
  pivot_longer(!pat_id, names_to = 'variable', values_to = 'value') %>%
  # remove nas
  filter(!is.na(value)) #%>%
  
#delete rows for combo 2 -3:
  df <- subset(df, !(df$variable == "2_Combo2" | df$variable =="3_Combo2"))

# grouping and creating the source field by pat_id
  df <- df %>% 
    group_by(pat_id) %>% 
  mutate(source = paste(substr(variable,1,15),value, sep = '_')) %>% 
  # useful columns
  select(pat_id, source) %>% 
  # arrange 
  arrange(pat_id, source) %>% 
  # adding by group the target column
  mutate(target = c(source[2:length(source)],NA)) 

  # define source and target
links <- data.frame(source =df$source,
                    target   =df$target) %>% 
  filter(!is.na(target))

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

# now convert as character
links$source <- as.character(links$source)
links$target<- as.character(links$target)

# matching links and node, then indexing to 0
links$source <- match(links$source, nodes$name) - 1
links$target <- match(links$target, nodes$name) - 1

# group by (we are grouping by number of rows)
links <- links %>% group_by(source, target) %>% tally()

# pas de namen van de nodes aan
nodes$name[nodes$name == "1_treatment_0"] <- "Watchful waiting"
nodes$name[nodes$name == "1_treatment_1"] <- "Referral"
nodes$name[nodes$name == "1_treatment_99"] <- "Other"
nodes$name[nodes$name == "2_treatment_0"] <- "Watchful waiting"
nodes$name[nodes$name == "2_treatment_1"] <- "Referral"
nodes$name[nodes$name == "2_treatment_99"] <- "Other"
nodes$name[nodes$name == "3_treatment_0"] <- "Watchful waiting"
nodes$name[nodes$name == "3_treatment_1"] <- "Referral"
nodes$name[nodes$name == "3_treatment_99"] <- "Other"

# plot it!
      sankeyNetwork(Links = links
                    , Nodes = nodes
                    , Source = 'source'
                    , Target = 'target'
                    , Value = 'n'
                    , NodeID = 'name'
                    ,fontSize = 15
                    )

字符串

输出

我们的目标是给予灰色连接与它要连接的节点相同的颜色（或者稍微浅一点的颜色）。

addendum我试着给链接和节点添加组。但现在我只得到一个空白空间。

新增脚本：

# Add a 'group' column to each target/node:
links$group <- ifelse(links1$target == "1" |
                         links1$target == "12" |
                         links1$target == "16", "exp", 
                       ifelse(links1$target == "9" |
                                links1$target == "2" |
                                links1$target == "14", "ref", "other"))
links$group <- as.factor(links$group)
# Add a 'group' column to node:
nodes$group <- ifelse(nodes$name == "Watchful waiting", "exp",
                    
                       ifelse(nodes$name == "Referral", "ref",
                              ifelse(nodes$name == "Other", "other", "combo")))
nodes$group <- as.factor(nodes$group)

# Give a color for each group:
my_color <- 'd3.scaleOrdinal() .domain([ "exp", "ref", "other","combo]) .range(["steelblue", "orange", "#69b3a2",      
                                                          "grey")'

# plot it!
      sankeyNetwork(Links = links
                    , Nodes = nodes
                    , Source = 'source'
                    , Target = 'target'
                    , Value = 'n'
                    , NodeID = 'name'
                    , fontSize = 15
                    ,colourScale=my_color, LinkGroup="group", NodeGroup="group")

型