javascript - R networkD3 sankey - 为节点标签添加值

Question

使用 networkD3::sankeyNetwork() 创建 Sankey 图表的示例代码...

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");
}

)

我想在节点标签旁边显示总数(每个节点的 sum(value) 结果)。我在 StackOverflow 上找到了这篇文章，并尝试根据该文章中的答案模拟一些 JavaScript 代码，但我无法使其工作。 Place text values to right of sankey diagram

Answer 1

jsCode htmlwidgets::onRender() 的参数是包含有效 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)