代码
library(DiagrammeR)
# DiagrammeR(diagram = "", type = "mermaid", ...)
# mermaid(diagram = "")
不止BI
2024年9月19日
DiagrammeR
是一个 R 语言的包,它允许用户在 R 环境中创建和呈现各种类型的图表。这个包利用了 JavaScript
图表库 viz.js
和 mermaid.js
的能力,使得用户可以轻松地绘制流程图、序列图、甘特图、思维导图、时间轴、桑基图等
可以使用DiagrammeR()
或者mermaid()
绘制mermaid图表,mermaid官网也提供了大量的图表案例
流程图布局的方向共有如下四种:
TB,Top –> Bottom,从上到下。
BT,Bottom –> Top,从下到上。
RL,Right –> Left,从右到左。
LR,Left –> Right,从左到右。
在节点较少或者节点内容简单的情况下,定义节点可以直接写节点1 --> 节点2
在节点较多的情况下,可以先定义节点,再定义节点之间的指向关系
使用分号或换行符来分隔不同定义
mermaid中用%%符号添加注释。
subgraph
定义子图
不支持markdown语法,但是可以引入HTML及css
mermaid(diagram = "
graph LR
%% 定义节点内容
A[节点1]
B[第一行<br>第二行</br>第三行]
C[<b>加粗</b> <i>斜体</i>]
D[<D>改变字号</D>]
%% 定义节点之间的连线
A --> B; B --> C; B --> D
%% 定义节点的样式
style A fill:pink, stroke:black, stroke-width:4px
style B fill:lightgreen, stroke:red, stroke-width:2px, stroke-dasharray: 5 5
style C fill:lightblue
")
自定义一个函数将表格转为树图
plotTree <- function(data, value, ..., treetype = "LR") {
columns <- dplyr::enquos(...)
value <- dplyr::enquo(value)
mermaid <- stringr::str_glue("graph {treetype}")
for (col in seq_along(columns)) {
if (col < length(columns)) {
df_col <- data %>%
dplyr::group_by(!!columns[[col]], !!columns[[col + 1]]) %>%
dplyr::summarise(valueSumChildren = sum(!!value), .groups = "drop") %>%
dplyr::ungroup() %>%
dplyr::mutate(pctChildren = valueSumChildren / sum(valueSumChildren)) %>%
dplyr::group_by(!!columns[[col]]) %>%
dplyr::mutate(valueSumParent = sum(valueSumChildren)) %>%
dplyr::ungroup() %>%
dplyr::mutate(
valueSumTotal = sum(valueSumChildren),
pctParent = valueSumParent / valueSumTotal
) %>%
tidyr::replace_na(list(pctChildren = 0, pctParent = 0)) %>%
dplyr::mutate(
parentId = stringr::str_c(col, dplyr::dense_rank(!!columns[[col]])),
childrenId = stringr::str_c(col + 1, dplyr::dense_rank(!!columns[[col + 1]]))
) %>%
dplyr::filter(!!columns[[col]] != !!columns[[col + 1]]) %>%
dplyr::transmute(des = stringr::str_c(
"A", parentId, '("', !!columns[[col]], ": ",
scales::comma(valueSumParent, accuracy = 1),
" (", scales::percent(pctParent, accuracy = 0.1), ')")',
"-->",
"A", childrenId, '("', !!columns[[col + 1]], ": ",
scales::comma(valueSumChildren, accuracy = 1),
" (", scales::percent(pctChildren, accuracy = 0.1), ')")'
))
mermaid <- stringr::str_c(mermaid, df_col$des %>% purrr::reduce(stringr::str_c, sep = " \n "), sep = " \n ")
}
}
# print(mermaid)
DiagrammeR::DiagrammeR(mermaid)
}
set.seed(123)
df <- data.frame(
l1 = c("根节点", "根节点", "根节点"),
l2 = c("一级A", "一级A", "一级B"),
l3 = c("二级A", "二级B", "二级c"),
value = rnorm(3, 100, 20)
)
df %>%
plotTree(value = value, l1, l2, l3)
library(tidyverse)
library(ggdag)
library(ggokabeito)
options(
tidyverse.quiet = TRUE,
propensity.quiet = TRUE,
tipr.verbose = FALSE,
htmltools.dir.version = FALSE,
width = 55,
digits = 4,
ggplot2.discrete.colour = ggokabeito::palette_okabe_ito(),
ggplot2.discrete.fill = ggokabeito::palette_okabe_ito(),
ggplot2.continuous.colour = "viridis",
ggplot2.continuous.fill = "viridis",
book.base_family = "sans",
book.base_size = 14
)
theme_set(
theme_minimal(
base_size = getOption("book.base_size"),
base_family = getOption("book.base_family")
) %+replace%
theme(
panel.grid.minor = element_blank(),
legend.position = "bottom"
)
)
theme_dag <- function() {
ggdag::theme_dag(base_family = getOption("book.base_family"))
}
ggdag_geom_dag_label_repel <- function(
mapping = NULL, data = NULL, parse = FALSE, ...,
box.padding = grid::unit(0.35, "lines"), label.padding = grid::unit(0.25, "lines"),
point.padding = grid::unit(1.5, "lines"), label.r = grid::unit(0.15, "lines"),
label.size = 0.25, segment.color = "grey50", segment.size = 0.5, arrow = NULL,
force = 1, max.iter = 2000, nudge_x = 0, nudge_y = 0, na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE) {
ggplot2::layer(
data = data, mapping = mapping, stat = ggdag:::StatNodesRepel,
geom = ggrepel::GeomLabelRepel, position = "identity",
show.legend = show.legend, inherit.aes = inherit.aes,
params = list(
parse = parse, box.padding = box.padding,
label.padding = label.padding, point.padding = point.padding,
label.r = label.r, label.size = label.size, segment.colour = segment.color %||%
segment.colour, segment.size = segment.size,
arrow = arrow, na.rm = na.rm, force = force, max.iter = max.iter,
nudge_x = nudge_x, nudge_y = nudge_y, segment.alpha = 1, ...
)
)
}
geom_dag_label_repel_internal <- function(..., seed = 10) {
ggdag_geom_dag_label_repel(
mapping = aes(x, y, label = label),
box.padding = 2,
max.overlaps = Inf,
inherit.aes = FALSE,
family = getOption("book.base_family"),
seed = seed,
label.size = NA,
label.padding = 0.01
)
}
assignInNamespace("geom_dag_label_repel", geom_dag_label_repel_internal, ns = "ggdag")
assignInNamespace("scale_color_hue", ggplot2::scale_color_discrete, ns = "ggplot2")
assignInNamespace("scale_edge_colour_hue", \(...) ggraph::scale_edge_colour_manual(..., values = ggokabeito::palette_okabe_ito()), ns = "ggraph")
geom_dag_label_repel <- function(..., seed = 10) {
ggdag_geom_dag_label_repel(
aes(x, y, label = label),
box.padding = 3.5,
inherit.aes = FALSE,
max.overlaps = Inf,
family = getOption("book.base_family"),
seed = seed,
label.size = NA,
label.padding = 0.1,
size = getOption("book.base_size") / 3,
...
)
}
coord_dag <- list(
x = c(Season = 0, close = 0, weather = -1, x = 1, y = 2),
y = c(Season = -1, close = 1, weather = 0, x = 0, y = 0)
)
labels <- c(
x = "Extra Magic Morning",
y = "Average wait",
Season = "Ticket Season",
weather = "Historic high temperature",
close = "Time park closed"
)
dagify(
y ~ x + close + Season + weather,
x ~ weather + close + Season,
coords = coord_dag,
labels = labels,
exposure = "x",
outcome = "y"
) |>
tidy_dagitty() |>
node_status() |>
ggplot(
aes(x, y, xend = xend, yend = yend, color = status)
) +
geom_dag_edges_arc(curvature = c(rep(0, 5), .3)) +
geom_dag_point() +
geom_dag_label_repel(seed = 1630) +
scale_color_okabe_ito(na.value = "grey90") +
theme_dag() +
theme(
legend.position = "none",
axis.text.x = element_text()
) +
coord_cartesian(clip = "off") +
scale_x_continuous(
limits = c(-1.25, 2.25),
breaks = c(-1, 0, 1, 2),
labels = c(
"\n(one year ago)",
"\n(6 months ago)",
"\n(3 months ago)",
"9am - 10am\n(Today)"
)
)