javascriptrd3.jshtmlwidgetsnetworkd3

R networkD3 sankey - add value to node label


example code to create a Sankey chart with networkD3::sankeyNetwork()...

library("networkD3")

a = read.csv(header = TRUE, text = "
date,Data Center,Customer,companyID,source,target,value 
")

node_names <- unique(c(as.character(a$source), as.character(a$target)))
nodes <- data.frame(name = node_names)
links <- data.frame(source = match(a$source, node_names) - 1,
                    target = match(a$target, node_names) - 1,
                    value = a$value)

p <- sankeyNetwork(Links = links, Nodes = nodes, Source = "source",
              Target = "target", Value = "value", NodeID = "name",
              sinksRight = FALSE)

onRender(
  p,
function(el,x){
  // select all our node text
  var node_text = d3.select(el)
    .selectAll(".node text")
    .attr("x", 6 + x.options.nodeWidth)
    .attr("text-anchor", "start");
}

)

I want to show the total number ( the result of sum(value) per each node ) next to node label. I found this post on StackOverflow, and tried to simulate some JavaScript code according to the answer in the post, but I can't make it work. Place text values to right of sankey diagram


Solution

  • The jsCode argument of htmlwidgets::onRender() is a string/character vector that contains valid JavaScript.

    library(networkD3)
    
    a = read.csv(header = TRUE, text = "
    date,Data Center,Customer,companyID,source,target,value 
    6/1/2021,dcA,customer1,companyID1,open_list_view_1,open_card_2,1 
    6/1/2021,dcA,customer1,companyID1,open_card_2,edit_card_3,1
    6/1/2021,dcA,customer1,companyID1,edit_card_3,save_card_4,1 
    6/1/2021,dcA,customer1,companyID1,save_card_4,back_to_card_list_5,2 
    6/1/2021,dcA,customer1,companyID1,back_to_card_list_5,show_more_6,1
    6/1/2021,dcA,customer1,companyID1,show_more_6,view_introduction_7,1
    6/1/2021,dcA,customer1,companyID1,view_introduction_7,scroll_down_8,2
    6/2/2021,dcA,customer2,companyID2,open_list_view_1,open_card_2,3
    6/2/2021,dcA,customer2,companyID2,open_card_2,edit_card_3,1
    6/2/2021,dcA,customer2,companyID2,edit_card_3,save_card_4,4
    6/2/2021,dcA,customer2,companyID2,save_card_4,back_to_card_list_5,2 
    6/2/2021,dcA,customer2,companyID2,back_to_card_list_5,show_more_6,1
    6/2/2021,dcA,customer2,companyID2,show_more_6,view_introduction_7,1
    6/2/2021,dcA,customer2,companyID2,view_introduction_7,scroll_down_8,5
    ")
    
    node_names <- unique(c(as.character(a$source), as.character(a$target)))
    nodes <- data.frame(name = node_names)
    links <- data.frame(source = match(a$source, node_names) - 1,
                        target = match(a$target, node_names) - 1,
                        value = a$value)
    
    p <- sankeyNetwork(Links = links, Nodes = nodes, Source = "source",
                       Target = "target", Value = "value", NodeID = "name",
                       sinksRight = FALSE)
    
    javascript_string <- 
      'function(el, x){
        d3.select(el).selectAll(".node text")
          .text(d => d.name + " (" + d.value + ")");
      }'
    
    htmlwidgets::onRender(x = p, jsCode = javascript_string)
    

    enter image description here