d3.js R netWorkD 3 Sankey -通过js添加百分比不起作用

w80xi6nr  于 2022-11-12  发布在  其他
关注(0)|答案(1)|浏览(175)

我正在创建一个sankey图表在R与networkD3::sankeyNetwork()与下面的样本数据和脚本。我想显示百分比旁边的节点标签。
这个sankey有8层,我创建了一个完整数据集。2我只是在下面的代码中发布了一些数据。

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

a <- read.csv(header = TRUE, text = "
date,dataCenter,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)

# 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

现在我想在每个节点的标签和计数旁边显示百分比。我已经通过下面的脚本计算了百分比值,但是如何把它放在节点标签和计数后面呢?
我意识到下面计算每个节点的百分比的方法是不正确的,因为当按“源”列分组时,最后一层的节点被遗漏了,因为它们只作为“目标”节点工作。我在帖子中用一个新的图片更新了预期的结果,这张图片更清楚地显示了百分比。一般来说,百分比应该遵循能量守恒定律。有可能实现吗?

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

预期结果为

cgfeq70w

cgfeq70w1#

您可以在创建html小部件之后向nodes data.frame中添加变量(否则,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);}'

相关问题