如何使用 R networkD3 值和每个节点下方的百分比绘制桑基图
How to plot Sankey Graph with R networkD3 values and percentage below each node
下午好,
从下面的代码中,我能够生成一个图表,但它不显示基础值。
我试图调整此 thread 中的代码,但我并不高兴。我从没用过 Java.
我需要的是一个图表,其中还包含每个节点下的值和百分比,如下图所示。
谢谢
library(dplyr)
library(networkD3)
library(tidyverse)
library(readxl)
library(RColorBrewer)
df = data.frame(Source = c("ABC","CDE","MNB","PCI","UCD"),
Destination = c("Me","You","Him","Her","Her"),
Value = c(200,350,456,450,100))
## Reshape dataframe to long
df2 = pivot_longer(df, c(Destination, Source))
## make unique list for destination and source
dest = unique(as.character(df$Destination))
sources = unique(as.character(df$Source))
## Assign nodes number to each element of the chart
nodes2 = data.frame(node = append(dest,sources), nodeid = c(0:8))
res = merge(df,nodes2, by.x="Source", by.y = "node")
res = merge(res,nodes2, by.x="Destination", by.y = "node")
## Make links
links2 = res[, c("nodeid.x","nodeid.y","Value")]
colnames(links2) <- c("source", "target", "value")
## Add a 'group' column to each connection:
links2$group = as.factor(c("type_a","type_b","type_c","type_d","type_e"))
## defining nodes
nodes2["groups"] = nodes2$node
nodes2$groups = as.factor(nodes2$groups)
# Give a color for each group:
my_color <- 'd3.scaleOrdinal() .domain(["type_a","type_b","type_c","type_d","type_e","Me","You","Him","Her","Her"]) .range(["rgb(165,0,38,0.4)", "rgb(215,48,39, 0.4)", "rgb(244,109,67,0.4)", "rgb(253,174,97,0.4)", "rgb(254,224,139,0.4)",
"rgb(255,255,191,0.4)", "rgb(217,239,139,0.4)", "rgb(166,217,106,0.4)",
"rgb(102,189,99,0.4)","rgb(26,152,80,0.4)"])'
# plot graph
networkD3::sankeyNetwork(Links = links2, Nodes = nodes2,
Source = 'source',
Target = 'target',
Value = 'value',
NodeID = 'node',
units = 'Amount',
colourScale=my_color,
LinkGroup="group",
NodeGroup="groups",
fontFamily = "arial",
fontSize = 8,
nodeWidth = 8)
Update below original content; it is a fully developed solution to your original request.
我仍在努力用多行(而不是一行)渲染字符串。然而,事实证明它作为 SVG 文本非常困难。但是,这里有一种方法,您可以将所有需要的信息添加到您的图表中,即使它的样式与您希望的不完全一样。
首先我创建了要添加到图中的数据。这必须在 创建 之后添加到小部件中。 (如果您尝试事先添加它,它只会被剥离。)
这会创建之前和之后的百分比以及合计总和(需要时)。
# for this tiny data frame some of this grouping is redundant---
# however, this method could be used on a much larger scale
df3 <- df %>%
group_by(Source) %>%
mutate(sPerc = paste0(round(sum(Value) / sum(df$Value) * 100, 2), "%")) %>%
group_by(Destination) %>%
mutate(dPerc = paste0(round(sum(Value) / sum(df$Value) * 100, 2), "%")) %>%
pivot_longer(c(Destination, Source)) %>%
mutate(Perc = ifelse(name == "Destination",
dPerc, sPerc)) %>% # determine which % to retain
select(Value, value, Perc) %>% # only fields to add to widget
group_by(value, Perc) %>%
summarise(Value = sum(Value)) # get the sum for 'Her'
我用对象名plt
保存了桑基图。下一部分将新数据添加到小部件 plt
.
plt$x$nodes <- right_join(plt$x$nodes, df3, by = c("name" = "value"))
最后一个元素将值和百分比添加到源节点标签和目标节点标签。
htmlwidgets::onRender(plt, '
function(el, x) {
d3.select(el).selectAll(".node text")
.text(d => d.name + " " + d.Perc + " " + d.Value)
}')
更新:Multi-line 个标签
我想我只是需要在上面睡觉。此更新将为您提供 multi-line 文本。
您还询问了有关您将如何自己做这件事的资源。这里有一些东西在起作用:Javascript、SVG 文本、D3 和包 htmlwidgets
。当您使用 onRender
时,了解将包 R 代码连接到包 htmlwidgets
的脚本文件很重要。我建议从学习 htmlwidgets
开始。例如,如何创建自己的。
好的——回到回答最初的问题。这将使用我最初提供的所有内容附加新值,但对 onRender
.
的调用除外
htmlwidgets::onRender(plt, '
function(el, x) {
d3.select(el).selectAll(".node text").each(function(d){
var arr, val, anc
arr = " " + d.Perc + " " + d.Value;
arr = arr.split(" ");
val = d3.select(this).attr("x");
anc = d3.select(this).attr("text-anchor");
for(i = 0; i < arr.length; i++) {
d3.select(this).append("tspan")
.text(arr[i])
.attr("dy", i ? "1.2em" : 0)
.attr("x", val)
.attr("text-anchor", anc)
.attr("class", "tspan" + i);
}
})
}')
下午好, 从下面的代码中,我能够生成一个图表,但它不显示基础值。 我试图调整此 thread 中的代码,但我并不高兴。我从没用过 Java.
我需要的是一个图表,其中还包含每个节点下的值和百分比,如下图所示。
谢谢
library(dplyr)
library(networkD3)
library(tidyverse)
library(readxl)
library(RColorBrewer)
df = data.frame(Source = c("ABC","CDE","MNB","PCI","UCD"),
Destination = c("Me","You","Him","Her","Her"),
Value = c(200,350,456,450,100))
## Reshape dataframe to long
df2 = pivot_longer(df, c(Destination, Source))
## make unique list for destination and source
dest = unique(as.character(df$Destination))
sources = unique(as.character(df$Source))
## Assign nodes number to each element of the chart
nodes2 = data.frame(node = append(dest,sources), nodeid = c(0:8))
res = merge(df,nodes2, by.x="Source", by.y = "node")
res = merge(res,nodes2, by.x="Destination", by.y = "node")
## Make links
links2 = res[, c("nodeid.x","nodeid.y","Value")]
colnames(links2) <- c("source", "target", "value")
## Add a 'group' column to each connection:
links2$group = as.factor(c("type_a","type_b","type_c","type_d","type_e"))
## defining nodes
nodes2["groups"] = nodes2$node
nodes2$groups = as.factor(nodes2$groups)
# Give a color for each group:
my_color <- 'd3.scaleOrdinal() .domain(["type_a","type_b","type_c","type_d","type_e","Me","You","Him","Her","Her"]) .range(["rgb(165,0,38,0.4)", "rgb(215,48,39, 0.4)", "rgb(244,109,67,0.4)", "rgb(253,174,97,0.4)", "rgb(254,224,139,0.4)",
"rgb(255,255,191,0.4)", "rgb(217,239,139,0.4)", "rgb(166,217,106,0.4)",
"rgb(102,189,99,0.4)","rgb(26,152,80,0.4)"])'
# plot graph
networkD3::sankeyNetwork(Links = links2, Nodes = nodes2,
Source = 'source',
Target = 'target',
Value = 'value',
NodeID = 'node',
units = 'Amount',
colourScale=my_color,
LinkGroup="group",
NodeGroup="groups",
fontFamily = "arial",
fontSize = 8,
nodeWidth = 8)
Update below original content; it is a fully developed solution to your original request.
我仍在努力用多行(而不是一行)渲染字符串。然而,事实证明它作为 SVG 文本非常困难。但是,这里有一种方法,您可以将所有需要的信息添加到您的图表中,即使它的样式与您希望的不完全一样。
首先我创建了要添加到图中的数据。这必须在 创建 之后添加到小部件中。 (如果您尝试事先添加它,它只会被剥离。)
这会创建之前和之后的百分比以及合计总和(需要时)。
# for this tiny data frame some of this grouping is redundant---
# however, this method could be used on a much larger scale
df3 <- df %>%
group_by(Source) %>%
mutate(sPerc = paste0(round(sum(Value) / sum(df$Value) * 100, 2), "%")) %>%
group_by(Destination) %>%
mutate(dPerc = paste0(round(sum(Value) / sum(df$Value) * 100, 2), "%")) %>%
pivot_longer(c(Destination, Source)) %>%
mutate(Perc = ifelse(name == "Destination",
dPerc, sPerc)) %>% # determine which % to retain
select(Value, value, Perc) %>% # only fields to add to widget
group_by(value, Perc) %>%
summarise(Value = sum(Value)) # get the sum for 'Her'
我用对象名plt
保存了桑基图。下一部分将新数据添加到小部件 plt
.
plt$x$nodes <- right_join(plt$x$nodes, df3, by = c("name" = "value"))
最后一个元素将值和百分比添加到源节点标签和目标节点标签。
htmlwidgets::onRender(plt, '
function(el, x) {
d3.select(el).selectAll(".node text")
.text(d => d.name + " " + d.Perc + " " + d.Value)
}')
更新:Multi-line 个标签
我想我只是需要在上面睡觉。此更新将为您提供 multi-line 文本。
您还询问了有关您将如何自己做这件事的资源。这里有一些东西在起作用:Javascript、SVG 文本、D3 和包 htmlwidgets
。当您使用 onRender
时,了解将包 R 代码连接到包 htmlwidgets
的脚本文件很重要。我建议从学习 htmlwidgets
开始。例如,如何创建自己的。
好的——回到回答最初的问题。这将使用我最初提供的所有内容附加新值,但对 onRender
.
htmlwidgets::onRender(plt, '
function(el, x) {
d3.select(el).selectAll(".node text").each(function(d){
var arr, val, anc
arr = " " + d.Perc + " " + d.Value;
arr = arr.split(" ");
val = d3.select(this).attr("x");
anc = d3.select(this).attr("text-anchor");
for(i = 0; i < arr.length; i++) {
d3.select(this).append("tspan")
.text(arr[i])
.attr("dy", i ? "1.2em" : 0)
.attr("x", val)
.attr("text-anchor", anc)
.attr("class", "tspan" + i);
}
})
}')