DiagrammeR：render_graph() 产生不准确的节点字体颜色
DiagrammeR: render_graph() produces inaccurate node font color
我一直在探索 R 中的 DiagrammeR 包制作流程图和图形的可能性。看起来很不错，但我 运行 遇到了一个奇怪的情况：render_graph() 函数在节点上产生了错误的字体颜色，我不明白为什么。
在下面的可重现示例中：
节点字体颜色默认设置为“gray50”（下方全局图形属性中的第 12 行），但使用 render_graph() 函数渲染时字体颜色为黑色（见下图 1） .
然而，当使用 generate_dot() |> grViz() 函数序列渲染时，它可以正确显示（见第二张图片）。
我还没有发现任何其他不准确之处，但我不能排除它们。
我想知道，这是错误还是功能？这是否意味着我不应该信任 render_graph()？有谁知道为什么会出现这种差异？
谢谢！
# Create a minimal graph with just 2 nodes and no edges
nodes <- DiagrammeR::create_node_df(2,label=c("a","b"))
graph <- DiagrammeR::create_graph(nodes_df=nodes,edges_df=NULL)
# Show its global attributes
graph |> DiagrammeR::get_global_graph_attr_info()
attr
value
attr_type
1
layout
neato
graph
2
outputorder
edgesfirst
graph
3
bgcolor
white
graph
4
fontname
Helvetica
node
5
fontsize
10
node
6
shape
circle
node
7
fixedsize
true
node
8
width
0.5
node
9
style
filled
node
10
fillcolor
aliceblue
node
11
color
gray70
node
12
fontcolor
gray50
node
13
fontname
Helvetica
edge
14
fontsize
8
edge
15
len
1.5
edge
16
color
gray80
edge
17
arrowsize
0.5
edge
# Render it with one method
graph |> DiagrammeR::render_graph()
Graph rendered with render_graph()
# Render it with another method
graph |> DiagrammeR::generate_dot() |> DiagrammeR::grViz()
Graph rendered with generate_dot() |> grViz()
如果没有明确说明，render_graph 尝试设置对比文本颜色。函数的相关部分是
# pseudocode
...
if (!("fontcolor" %in% colnames(graph$nodes_df)) &
"fillcolor" %in% colnames(graph$nodes_df)) {
graph$nodes_df$fontcolor <- tibble::tibble(value = graph$nodes_df$fillcolor) %>%
dplyr::mutate(value_x = DiagrammeR:::contrasting_text_color(background_color = value)) %>%
dplyr::pull(value_x)
}
...
要生成与 post 中替代方法相同的图表，您可以删除此部分，覆盖函数。使用 :::.
在需要的地方插入内部 DiagrammeR 函数
render_graph <- function (graph, layout = NULL, output = NULL, as_svg = FALSE,
title = NULL, width = NULL, height = NULL)
{
fcn_name <- DiagrammeR:::get_calling_fcn()
if (DiagrammeR:::graph_object_valid(graph) == FALSE) {
emit_error(fcn_name = fcn_name, reasons = "The graph object is not valid")
}
if (is.null(output)) {
output <- "graph"
}
if (output == "graph") {
if (!is.null(title)) {
graph <- DiagrammeR:::add_global_graph_attrs(graph, "label",
title, "graph")
graph <- DiagrammeR:::add_global_graph_attrs(graph, "labelloc",
"t", "graph")
graph <- DiagrammeR:::add_global_graph_attrs(graph, "labeljust",
"c", "graph")
graph <- DiagrammeR:::add_global_graph_attrs(graph, "fontname",
"Helvetica", "graph")
graph <- DiagrammeR:::add_global_graph_attrs(graph, "fontcolor",
"gray30", "graph")
}
if (nrow(graph$nodes_df) > 0) {
if (!("fillcolor" %in% colnames(graph$nodes_df))) {
if ("fillcolor" %in% graph$global_attrs$attr) {
graph$nodes_df$fillcolor <- graph$global_attrs %>%
dplyr::filter(attr == "fillcolor" &
attr_type == "node") %>% dplyr::select(value) %>%
purrr::flatten_chr()
}
else {
graph$nodes_df$fillcolor <- "white"
}
}
}
if (nrow(graph$nodes_df) > 0) {
if ("fillcolor" %in% colnames(graph$nodes_df)) {
if ("fillcolor" %in% graph$global_attrs$attr) {
graph$nodes_df$fillcolor[which(is.na(graph$nodes_df$fillcolor))] <- graph$global_attrs[which(graph$global_attrs$attr ==
"fillcolor"), 2]
}
}
}
if ("fillcolor" %in% colnames(graph$nodes_df)) {
graph$nodes_df <- graph$nodes_df %>% dplyr::left_join(x11_hex() %>%
dplyr::as_tibble() %>% dplyr::mutate(hex = toupper(hex)),
by = c(fillcolor = "x11_name")) %>% dplyr::mutate(new_fillcolor = dplyr::coalesce(hex,
fillcolor)) %>% dplyr::select(-fillcolor, -hex) %>%
dplyr::rename(fillcolor = new_fillcolor)
}
if (!is.null(layout)) {
if (layout %in% c("circle", "tree", "kk",
"fr", "nicely")) {
graph <- graph %>% add_global_graph_attrs(attr = "layout",
value = "neato", attr_type = "graph")
if ("x" %in% colnames(graph$nodes_df)) {
graph$nodes_df <- graph$nodes_df %>% dplyr::select(-x)
}
if ("y" %in% colnames(graph$nodes_df)) {
graph$nodes_df <- graph$nodes_df %>% dplyr::select(-y)
}
if (layout == "circle") {
coords <- graph %>% to_igraph() %>% igraph::layout_in_circle() %>%
dplyr::as_tibble() %>% dplyr::rename(x = V1,
y = V2) %>% dplyr::mutate(x = x * (((count_nodes(graph) +
(0.25 * count_nodes(graph))))/count_nodes(graph))) %>%
dplyr::mutate(y = y * (((count_nodes(graph) +
(0.25 * count_nodes(graph))))/count_nodes(graph)))
}
if (layout == "tree") {
coords <- (graph %>% to_igraph() %>% igraph::layout_with_sugiyama())[[2]] %>%
dplyr::as_tibble() %>% dplyr::rename(x = V1,
y = V2)
}
if (layout == "kk") {
coords <- graph %>% to_igraph() %>% igraph::layout_with_kk() %>%
dplyr::as_tibble() %>% dplyr::rename(x = V1,
y = V2)
}
if (layout == "fr") {
coords <- graph %>% to_igraph() %>% igraph::layout_with_fr() %>%
dplyr::as_tibble() %>% dplyr::rename(x = V1,
y = V2)
}
if (layout == "nicely") {
coords <- graph %>% to_igraph() %>% igraph::layout_nicely() %>%
dplyr::as_tibble() %>% dplyr::rename(x = V1,
y = V2)
}
graph$nodes_df <- graph$nodes_df %>% dplyr::bind_cols(coords)
}
}
if (("image" %in% colnames(graph %>% get_node_df()) ||
"fa_icon" %in% colnames(graph %>% get_node_df()) ||
as_svg) & requireNamespace("DiagrammeRsvg",
quietly = TRUE)) {
if (!("DiagrammeRsvg" %in% rownames(utils::installed.packages()))) {
emit_error(fcn_name = fcn_name, reasons = c("Cannot currently render the graph to an SVG",
"please install the `DiagrammeRsvg` package and retry",
"pkg installed using `install.packages('DiagrammeRsvg')`",
"otherwise, set `as_svg = FALSE`"))
}
dot_code <- generate_dot(graph)
svg_vec <- strsplit(DiagrammeRsvg::export_svg(grViz(diagram = dot_code)),
"\n") %>% unlist()
svg_tbl <- get_svg_tbl(svg_vec)
svg_lines <- "<svg display=\"block\" margin=\"0 auto\" position=\"absolute\" width=\"100%\" height=\"100%\""
svg_line_no <- svg_tbl %>% dplyr::filter(type ==
"svg") %>% dplyr::pull(index)
svg_vec[svg_line_no] <- svg_lines
if ("image" %in% colnames(graph %>% get_node_df())) {
node_id_images <- graph %>% get_node_df() %>%
dplyr::select(id, image) %>% dplyr::filter(image !=
"") %>% dplyr::pull(id)
filter_lines <- graph %>% get_node_df() %>% dplyr::select(id,
image) %>% dplyr::filter(image != "") %>%
dplyr::mutate(filter_lines = as.character(glue::glue("<filter id=\"{id}\" x=\"0%\" y=\"0%\" width=\"100%\" height=\"100%\"><feImage xlink:href=\"{image}\"/></filter>"))) %>%
dplyr::pull(filter_lines) %>% paste(collapse = "\n")
filter_shape_refs <- as.character(glue::glue(" filter=\"url(#{node_id_images})\" "))
svg_shape_nos <- svg_tbl %>% dplyr::filter(node_id %in%
node_id_images) %>% dplyr::filter(type == "node_block") %>%
dplyr::pull(index)
svg_shape_nos <- svg_shape_nos + 3
svg_text_nos <- svg_shape_nos + 1
for (i in seq(node_id_images)) {
svg_vec[svg_shape_nos[i]] <- sub(" ",
paste0(filter_shape_refs[i]), svg_vec[svg_shape_nos[i]])
svg_vec[svg_text_nos[i]] <- ""
}
svg_vec[svg_line_no + 1] <- paste0(svg_vec[svg_line_no +
1], "\n\n", filter_lines, "\n")
}
}
else {
dot_code <- generate_dot(graph)
grVizObject <- grViz(diagram = dot_code, width = width,
height = height)
display <- grVizObject
}
display
}
else if (output == "visNetwork") {
visnetwork(graph)
}
}
然后，两个函数给出相同的结果。
graph |> render_graph()
我一直在探索 R 中的 DiagrammeR 包制作流程图和图形的可能性。看起来很不错，但我 运行 遇到了一个奇怪的情况：render_graph() 函数在节点上产生了错误的字体颜色，我不明白为什么。
在下面的可重现示例中：
节点字体颜色默认设置为“gray50”（下方全局图形属性中的第 12 行），但使用 render_graph() 函数渲染时字体颜色为黑色（见下图 1） .
然而，当使用 generate_dot() |> grViz() 函数序列渲染时，它可以正确显示（见第二张图片）。
我还没有发现任何其他不准确之处，但我不能排除它们。
我想知道，这是错误还是功能？这是否意味着我不应该信任 render_graph()？有谁知道为什么会出现这种差异？
谢谢！
# Create a minimal graph with just 2 nodes and no edges
nodes <- DiagrammeR::create_node_df(2,label=c("a","b"))
graph <- DiagrammeR::create_graph(nodes_df=nodes,edges_df=NULL)
# Show its global attributes
graph |> DiagrammeR::get_global_graph_attr_info()
| attr | value | attr_type | |
|---|---|---|---|
| 1 | layout | neato | graph |
| 2 | outputorder | edgesfirst | graph |
| 3 | bgcolor | white | graph |
| 4 | fontname | Helvetica | node |
| 5 | fontsize | 10 | node |
| 6 | shape | circle | node |
| 7 | fixedsize | true | node |
| 8 | width | 0.5 | node |
| 9 | style | filled | node |
| 10 | fillcolor | aliceblue | node |
| 11 | color | gray70 | node |
| 12 | fontcolor | gray50 | node |
| 13 | fontname | Helvetica | edge |
| 14 | fontsize | 8 | edge |
| 15 | len | 1.5 | edge |
| 16 | color | gray80 | edge |
| 17 | arrowsize | 0.5 | edge |
# Render it with one method
graph |> DiagrammeR::render_graph()
Graph rendered with render_graph()
# Render it with another method
graph |> DiagrammeR::generate_dot() |> DiagrammeR::grViz()
Graph rendered with generate_dot() |> grViz()
render_graph 尝试设置对比文本颜色。函数的相关部分是
# pseudocode
...
if (!("fontcolor" %in% colnames(graph$nodes_df)) &
"fillcolor" %in% colnames(graph$nodes_df)) {
graph$nodes_df$fontcolor <- tibble::tibble(value = graph$nodes_df$fillcolor) %>%
dplyr::mutate(value_x = DiagrammeR:::contrasting_text_color(background_color = value)) %>%
dplyr::pull(value_x)
}
...
要生成与 post 中替代方法相同的图表，您可以删除此部分，覆盖函数。使用 :::.
DiagrammeR 函数
render_graph <- function (graph, layout = NULL, output = NULL, as_svg = FALSE,
title = NULL, width = NULL, height = NULL)
{
fcn_name <- DiagrammeR:::get_calling_fcn()
if (DiagrammeR:::graph_object_valid(graph) == FALSE) {
emit_error(fcn_name = fcn_name, reasons = "The graph object is not valid")
}
if (is.null(output)) {
output <- "graph"
}
if (output == "graph") {
if (!is.null(title)) {
graph <- DiagrammeR:::add_global_graph_attrs(graph, "label",
title, "graph")
graph <- DiagrammeR:::add_global_graph_attrs(graph, "labelloc",
"t", "graph")
graph <- DiagrammeR:::add_global_graph_attrs(graph, "labeljust",
"c", "graph")
graph <- DiagrammeR:::add_global_graph_attrs(graph, "fontname",
"Helvetica", "graph")
graph <- DiagrammeR:::add_global_graph_attrs(graph, "fontcolor",
"gray30", "graph")
}
if (nrow(graph$nodes_df) > 0) {
if (!("fillcolor" %in% colnames(graph$nodes_df))) {
if ("fillcolor" %in% graph$global_attrs$attr) {
graph$nodes_df$fillcolor <- graph$global_attrs %>%
dplyr::filter(attr == "fillcolor" &
attr_type == "node") %>% dplyr::select(value) %>%
purrr::flatten_chr()
}
else {
graph$nodes_df$fillcolor <- "white"
}
}
}
if (nrow(graph$nodes_df) > 0) {
if ("fillcolor" %in% colnames(graph$nodes_df)) {
if ("fillcolor" %in% graph$global_attrs$attr) {
graph$nodes_df$fillcolor[which(is.na(graph$nodes_df$fillcolor))] <- graph$global_attrs[which(graph$global_attrs$attr ==
"fillcolor"), 2]
}
}
}
if ("fillcolor" %in% colnames(graph$nodes_df)) {
graph$nodes_df <- graph$nodes_df %>% dplyr::left_join(x11_hex() %>%
dplyr::as_tibble() %>% dplyr::mutate(hex = toupper(hex)),
by = c(fillcolor = "x11_name")) %>% dplyr::mutate(new_fillcolor = dplyr::coalesce(hex,
fillcolor)) %>% dplyr::select(-fillcolor, -hex) %>%
dplyr::rename(fillcolor = new_fillcolor)
}
if (!is.null(layout)) {
if (layout %in% c("circle", "tree", "kk",
"fr", "nicely")) {
graph <- graph %>% add_global_graph_attrs(attr = "layout",
value = "neato", attr_type = "graph")
if ("x" %in% colnames(graph$nodes_df)) {
graph$nodes_df <- graph$nodes_df %>% dplyr::select(-x)
}
if ("y" %in% colnames(graph$nodes_df)) {
graph$nodes_df <- graph$nodes_df %>% dplyr::select(-y)
}
if (layout == "circle") {
coords <- graph %>% to_igraph() %>% igraph::layout_in_circle() %>%
dplyr::as_tibble() %>% dplyr::rename(x = V1,
y = V2) %>% dplyr::mutate(x = x * (((count_nodes(graph) +
(0.25 * count_nodes(graph))))/count_nodes(graph))) %>%
dplyr::mutate(y = y * (((count_nodes(graph) +
(0.25 * count_nodes(graph))))/count_nodes(graph)))
}
if (layout == "tree") {
coords <- (graph %>% to_igraph() %>% igraph::layout_with_sugiyama())[[2]] %>%
dplyr::as_tibble() %>% dplyr::rename(x = V1,
y = V2)
}
if (layout == "kk") {
coords <- graph %>% to_igraph() %>% igraph::layout_with_kk() %>%
dplyr::as_tibble() %>% dplyr::rename(x = V1,
y = V2)
}
if (layout == "fr") {
coords <- graph %>% to_igraph() %>% igraph::layout_with_fr() %>%
dplyr::as_tibble() %>% dplyr::rename(x = V1,
y = V2)
}
if (layout == "nicely") {
coords <- graph %>% to_igraph() %>% igraph::layout_nicely() %>%
dplyr::as_tibble() %>% dplyr::rename(x = V1,
y = V2)
}
graph$nodes_df <- graph$nodes_df %>% dplyr::bind_cols(coords)
}
}
if (("image" %in% colnames(graph %>% get_node_df()) ||
"fa_icon" %in% colnames(graph %>% get_node_df()) ||
as_svg) & requireNamespace("DiagrammeRsvg",
quietly = TRUE)) {
if (!("DiagrammeRsvg" %in% rownames(utils::installed.packages()))) {
emit_error(fcn_name = fcn_name, reasons = c("Cannot currently render the graph to an SVG",
"please install the `DiagrammeRsvg` package and retry",
"pkg installed using `install.packages('DiagrammeRsvg')`",
"otherwise, set `as_svg = FALSE`"))
}
dot_code <- generate_dot(graph)
svg_vec <- strsplit(DiagrammeRsvg::export_svg(grViz(diagram = dot_code)),
"\n") %>% unlist()
svg_tbl <- get_svg_tbl(svg_vec)
svg_lines <- "<svg display=\"block\" margin=\"0 auto\" position=\"absolute\" width=\"100%\" height=\"100%\""
svg_line_no <- svg_tbl %>% dplyr::filter(type ==
"svg") %>% dplyr::pull(index)
svg_vec[svg_line_no] <- svg_lines
if ("image" %in% colnames(graph %>% get_node_df())) {
node_id_images <- graph %>% get_node_df() %>%
dplyr::select(id, image) %>% dplyr::filter(image !=
"") %>% dplyr::pull(id)
filter_lines <- graph %>% get_node_df() %>% dplyr::select(id,
image) %>% dplyr::filter(image != "") %>%
dplyr::mutate(filter_lines = as.character(glue::glue("<filter id=\"{id}\" x=\"0%\" y=\"0%\" width=\"100%\" height=\"100%\"><feImage xlink:href=\"{image}\"/></filter>"))) %>%
dplyr::pull(filter_lines) %>% paste(collapse = "\n")
filter_shape_refs <- as.character(glue::glue(" filter=\"url(#{node_id_images})\" "))
svg_shape_nos <- svg_tbl %>% dplyr::filter(node_id %in%
node_id_images) %>% dplyr::filter(type == "node_block") %>%
dplyr::pull(index)
svg_shape_nos <- svg_shape_nos + 3
svg_text_nos <- svg_shape_nos + 1
for (i in seq(node_id_images)) {
svg_vec[svg_shape_nos[i]] <- sub(" ",
paste0(filter_shape_refs[i]), svg_vec[svg_shape_nos[i]])
svg_vec[svg_text_nos[i]] <- ""
}
svg_vec[svg_line_no + 1] <- paste0(svg_vec[svg_line_no +
1], "\n\n", filter_lines, "\n")
}
}
else {
dot_code <- generate_dot(graph)
grVizObject <- grViz(diagram = dot_code, width = width,
height = height)
display <- grVizObject
}
display
}
else if (output == "visNetwork") {
visnetwork(graph)
}
}
然后，两个函数给出相同的结果。
graph |> render_graph()