Matching the colors and order of inflow and outflow in a sankeyNetwork diagram

Question

I would like to rearrange the inflow and outflow in the Sankey diagram according to each source. For example, among the 2-year survivors in the localized OP group, some continue to survive into the third year while others are censored. Instead of having all the censored cases grouped together, I want the Sankey diagram to split the inflow based on the source. In other words, I want the inflow from survivors to split into survivors and censored cases, with the colors representing different categories (e.g., red, yellow, green) being consistent within their respective groups.

Here is my data;

library(networkD3)

# Define the node data 
nodes2 <- data.frame( 
No = 0:16, 
label = c( "Localized OP", "Localized CRT", "Localized NoTX", "Regional OP", "Regional CRT", "Regional NoTX", "Distant OP", "Distant CRT", "Distant NoTX", "Survived 2 yr", "Censored 2 yr", "Survived 3 yr", "Censored 3 yr", "Survived 4 yr", "Censored 4 yr", "Survived 5 yr", "Censored 5 yr" ) 
) 

# Define the links data 
links2 <- data.frame( 
Source = c( 0, 0, 9, 9, 11, 11, 13, 13, 1, 1, 9, 9, 11, 11, 13, 13, 2, 2, 9, 9, 11, 11, 13, 13, 3, 3, 9, 9, 11, 11, 13, 13, 4, 4, 9, 9, 11, 11, 13, 13, 5, 5, 9, 9, 11, 11, 13, 13, 6, 6, 9, 9, 11, 11, 13, 13, 7, 7, 9, 9, 11, 11, 13, 13, 8, 8, 9, 9, 11, 11, 13, 13 ), 
Target = c( 9, 10, 11, 12, 13, 14, 15, 16, 9, 10, 11, 12, 13, 14, 15, 16, 9, 10, 11, 12, 13, 14, 15, 16, 9, 10, 11, 12, 13, 14, 15, 16, 9, 10, 11, 12, 13, 14, 15, 16, 9, 10, 11, 12, 13, 14, 15, 16, 9, 10, 11, 12, 13, 14, 15, 16, 9, 10, 11, 12, 13, 14, 15, 16, 9, 10, 11, 12, 13, 14, 15, 16 ), 
Value = c( 4686, 340, 4069, 617, 3599, 470, 3134, 465, 43, 56, 21, 22, 15, 6, 12, 3, 487, 495, 340, 147, 263, 77, 208, 55, 6147, 1431, 4506, 1641, 3479, 1027, 2821, 658, 336, 658, 99, 237, 46, 53, 34, 12, 571, 2277, 288, 283, 207, 81, 158, 49, 831, 971, 367, 464, 201, 166, 130, 71, 917, 2940, 201, 716, 85, 116, 51, 34, 466, 4993, 164, 302, 119, 45, 95, 24 ) 
) 

links2$group <- as.factor(c(rep("A", 24), rep("B", 24), rep("C", 24))) 
nodes2$group <- as.factor(c(rep("A",3), rep("B", 3), rep("C", 3), "b", "c","b", "c","b", "c","b", "c" ) ) 

my_color <- 'd3.scaleOrdinal() .domain(["A", "B", "C", "b", "c"]) .range(["#941e34", "#e5b560", "#455f54", "#dfdfdd", "#504e49"])' 

sankeyNetwork(
Links = links2, 
Nodes = nodes2, 
Source = "Source", 
Target = "Target", 
Value = "Value", 
NodeID = "label", 
sinksRight=FALSE, 
nodeWidth=40, 
fontSize=13, 
nodePadding=20, 
LinkGroup = "group", 
colourScale=my_color, 
iterations = 0)

Rplot

In fact, as follows, the Sankematic website offers the function that I want, but I cannot reproduce in R.

Sankematic website plot

Answer 1

You could override the link sorting by injecting custom JavaScript like so...

sn <-sankeyNetwork(
  Links = links2, 
  Nodes = nodes2, 
  Source = "Source", 
  Target = "Target", 
  Value = "Value", 
  NodeID = "label", 
  sinksRight=FALSE, 
  nodeWidth=40, 
  fontSize=13, 
  nodePadding=20, 
  LinkGroup = "group", 
  colourScale=my_color, 
  iterations = 0)

javascript_string <- 
  'function(el, x){
    var nodes = this.sankey.nodes();
    
    nodes.forEach(function(node) {
      node.sourceLinks.sort((a, b) => a.group.localeCompare(b.group) );
      node.targetLinks.sort((a, b) => a.group.localeCompare(b.group) );
    });
    
    nodes.forEach(function(node) {
      var sy = 0, ty = 0;
      node.sourceLinks.forEach(function(link) {
        link.sy = sy;
        sy += link.dy;
      });
      
      node.targetLinks.forEach(function(link) {
        link.ty = ty;
        ty += link.dy;
      });
    });
    
    d3.select(el).select("svg").selectAll(".link").attr("d", this.sankey.link());
  }'

htmlwidgets::onRender(
  x = sn, 
  jsCode = javascript_string
)
#> PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.