R netWorkD3 Sankey - 通过 js 添加百分比不起作用

Question

我正在使用 networkD3::sankeyNetwork() 使用以下示例数据和脚本在 R 中创建桑基图。我想在节点标签之外显示百分比。

我创建的具有完整数据集的 sankey 有 8 层。我只是 post 下面代码中的数据。

library("networkD3")
library("htmlwidgets")
library("dplyr")

a <- read.csv(header = TRUE, text = "
date,dataCenter,customer,companyID,source,target,value
2021/11/3,dc1,customer1,companyID1,view_page_modulepicker_1,view_manage_opportunities_2,1
2021/11/3,dc1,customer1,companyID1,view_manage_opportunities_2,scroll_down_3,4
2021/11/3,dc1,customer1,companyID1,scroll_down_3,show_more_4,6
2021/12/6,dc1,customer1,companyID1,view_page_capabilityportfolio_1,view_card_detail_assignment_2,1
2021/12/7,dc2,customer2,companyID2,view_page_modulepicker_1,view_manage_opportunities_2,1
2021/12/8,dc3,customer3,companyID3,view_page_actionsearch_1,view_manage_opportunities_2,1
2021/12/9,dc2,customer1,companyID1,view_page_modulepicker_1,view_card_detail_assignment_2,1
2021/12/9,dc1,customer1,companyID1,view_page_modulepicker_1,view_card_detail_role_2,
2021/12/9,dc1,customer1,companyID1,view_page_modulepicker_1,view_detail_assignment_2,
2021/12/2,dc1,customer1,companyID1,view_page_homepage_1,view_card_detail_role_2,1
2021/12/2,dc1,customer1,companyID1,view_page_actionsource_1,view_detail_role_2,1
2021/12/2,dc2,customer2,companyID2,view_page_actionsource_1,bounce,22
")

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)

# group by source and calculate the percentage of each node
g <- a %>%
  group_by(source) %>%
  summarize(cnt = n()) %>%
  mutate(freq = round(cnt / sum(cnt) * 100, 2)) %>%
  arrange(desc(freq))


nodes$name <- sub('(.*)_\d+', '\1', nodes$name)
links$linkgroup <- "linkgrp"
colourScale <- 
  'd3.scaleOrdinal()
     .domain(["linkgrp"])
     .range(["gainsboro"].concat(d3.schemeCategory20))'

p <- sankeyNetwork(Links = links, Nodes = nodes, Source = "source",
              Target = "target", Value = "value", NodeID = "name",
              fontSize = 9,
              fontFamily = "sans-serif", nodePadding=10,
              margin = list(t=100),
              sinksRight = FALSE, iterations = 0,
              LinkGroup = "linkgroup", 
              colourScale = colourScale)

showLabel_string <- 
  'function(el, x){
    d3.select(el).selectAll(".node text")
      .text(d => d.name + " (" + d.value + ")");}'

addTitle_string <-
  'function(el) { 
    var cols_x = this.sankey.nodes().map(d => d.x+15).filter((v, i, a) => a.indexOf(v) === i).sort(function(a, b){return a - b});
    cols_x.forEach((d, i) => {
    d3.select(el)
    .select("svg")
    .append("text")
    .attr("x", d)
    .attr("y", 0).text("step" + (i + 1))
    .style("font-size", "12px")
    .style("font-family", "sans-serif")
    .style("text-orientation", "upright");})
  }'

p <- htmlwidgets::onRender(x = p, jsCode = showLabel_string)
p <- htmlwidgets::onRender(x = p, jsCode = addTitle_string)
p <- htmlwidgets::prependContent(p, htmltools::tags$h3("Opportunity Marketing User Behavior Monitor"))
p

现在我想在每个节点标签和计数旁边显示百分比。我已经通过下面的脚本计算了百分比值，但是如何将它放在节点标签和计数之后？

我意识到下面计算每个节点百分比的方法是不正确的，因为当按 'source' 列分组时，最后一层的节点被遗漏了，因为它们仅作为 'target' 节点工作.我在 post 中用一张新图片更新了预期结果，该图片更清楚地显示了百分比。一般来说，百分比应该遵循能量守恒。有可能实现吗？

g <- a %>%
  group_by(source) %>%
  summarize(cnt = n()) %>%
  mutate(freq = round(cnt / sum(cnt) * 100, 2)) %>%
  arrange(desc(freq))

预期结果是

Answer 1

您可以在 nodes data.frame 创建 htmlwidget 之后添加变量（否则，sankeyNetwork() 将只保留所需的列).然后您可以编辑节点标签文本的自定义代码以包括百分比...

p$x$nodes <- g %>% mutate(name = sub("_[0-9]", "", source)) %>% select(name, freq) %>% right_join(p$x$nodes, by = "name") %>% mutate(freq = ifelse(is.na(freq), "", paste0(freq, "%"))) showLabel_string <- 'function(el, x){ d3.select(el).selectAll(".node text") .text(d => d.name + " (" + d.value + ") " + d.freq);}'

R netWorkD3 Sankey - 通过 js 添加百分比不起作用

R netWorkD3 Sankey - add percentage by js doesn't work

javascript

r

d3.js

sankey-diagram

networkd3