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

Question

使用 networkD3::sankeyNetwork()...

创建桑基图的示例代码

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)

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) 的结果）。我在 Whosebug 上找到了这个 post，并尝试根据 post 中的答案模拟一些 JavaScript 代码，但我无法使其工作。

下面桑基图像中的预期结果。

Answer 1

htmlwidgets::onRender() 的 jsCode 参数是一个包含有效 JavaScript.

的 string/character 向量

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)

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

R networkD3 sankey - add value to node label

javascript

r

d3.js

networkd3

htmlwidgets