DiagrammeR 绘制流程图

R语言
可视化
作者

不止BI

发布于

2024年9月19日

DiagrammeR 是一个 R 语言的包，它允许用户在 R 环境中创建和呈现各种类型的图表。这个包利用了 JavaScript 图表库 viz.js 和 mermaid.js 的能力，使得用户可以轻松地绘制流程图、序列图、甘特图、思维导图、时间轴、桑基图等

mermaid

可以使用DiagrammeR()或者mermaid()绘制mermaid图表，mermaid官网也提供了大量的图表案例

代码 
library(DiagrammeR)
# DiagrammeR(diagram = "", type = "mermaid", ...)
# mermaid(diagram = "")

布局

流程图布局的方向共有如下四种：

  • TB，Top –> Bottom，从上到下。

  • BT，Bottom –> Top，从下到上。

  • RL，Right –> Left，从右到左。

  • LR，Left –> Right，从左到右。

mermaid(diagram = "
graph TB
  A --> B
  ")
A
B
mermaid(diagram = "
graph BT
  A --> B
  ")
A
B
mermaid(diagram = "
graph RL
  A --> B
  ")
A
B
mermaid(diagram = "
graph LR
  A --> B
  ")
A
B

节点形状

  • 在节点较少或者节点内容简单的情况下，定义节点可以直接写节点1 --> 节点2

  • 在节点较多的情况下，可以先定义节点，再定义节点之间的指向关系

  • 使用分号或换行符来分隔不同定义

  • mermaid中用%%符号添加注释。

代码 
mermaid(diagram = "
graph LR

%% 定义节点形状及文本
  A(圆角方框);
  B[方框]
  C((圆形))
  D{菱形}
  E>折角方框]

%% 定义节点关系
  A --> B; B --> C; C --> D; D --> E
  ")
圆角方框
方框
圆形
菱形
折角方框

边的样式

代码 
mermaid(diagram = '
graph LR
%% 增加线上的文字，文字支持UNICODE 编码及特殊字符
  A1 --- B1; B1 ---|文字|B2
  A2 --> B3; B3 -- "\u2764" --> B4
  A3 -.-> B5; B5 -."&#10084".-> B6
  A4 ==> B7; B7 == "<U+2714>" ==> B8
')
graph LR %% 增加线上的文字，文字支持UNICODE 编码及特殊字符 A1 --- B1; B1 ---|文字|B2 A2 --> B3; B3 -- "❤" --> B4 A3 -.-> B5; B5 -."❤".-> B6 A4 ==> B7; B7 == "" ==> B8
文字
❤
❤
A1
B1
B2
A2
B3
B4
A3
B5
B6
A4
B7
B8

子图

subgraph定义子图

代码 
mermaid(diagram = "
graph TB
   A1 --> C2

%% 定义第一个子图
    subgraph 子图名称1
    A1 --> A2
    end

%% 定义第二个子图
    subgraph 子图名称2
    B1 --> B2
    end

%% 定义第三个子图
    subgraph 子图名称3
    C1 --> C2
    end
    ")
 子图名称3
 子图名称2
 子图名称1
C1
C2
B1
B2
A1
A2

引入HTML及css

不支持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
  ")
节点1
第一行
第二行
第三行
加粗 斜体
改变字号

表格转树图

自定义一个函数将表格转为树图

代码 
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)
根节点: 315 (100.0%)
一级A: 184 (58.4%)
一级B: 131 (41.6%)
二级A: 89 (28.2%)
二级B: 95 (30.2%)
二级c: 131 (41.6%)

补充

ggdag

代码 
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)"
    )
  )

回到顶部