在Shiny应用中创建带自定义文本与颜色的层级树状图

问题说明 #

现有Shiny应用，需创建层级树状图：

• 层级结构：总节点 → Header Name分组 → Sub Header 1分组
• 核心需求：显示每个节点的计数与百分比，保留文本和颜色样式，无需框体，用箭头连接各层级
• 当前用box()组件无法实现箭头连接，需更换合适的树状图工具

解决方案：使用DiagrammeR包实现 #

DiagrammeR支持自定义节点样式、文本内容和层级连接，完美适配需求。以下是完整实现代码：

步骤1：安装并加载所需包 #

library(shiny)
library(shinydashboard)
library(DiagrammeR)
library(dplyr)

步骤2：数据预处理 #

先统计各层级的计数与百分比：

d2 <- structure(list(`Header Name` = c("Trodelvy LOT received first", 
                                       "Trodelvy LOT received first", "Trodelvy LOT received first", 
                                       "EV LOT received first", "EV LOT received first", "EV LOT received first", 
                                       "Trodelvy LOT received first", "Trodelvy LOT received first", 
                                       "Trodelvy LOT received first", "EV LOT received first", "EV LOT received first", 
                                       "EV LOT received first", "Trodelvy LOT received first", "Trodelvy LOT received first", 
                                       "Trodelvy LOT received first", "EV LOT received first", "EV LOT received first", 
                                       "EV LOT received first", "Trodelvy LOT received first", "Trodelvy LOT received first", 
                                       "Trodelvy LOT received first", "EV LOT received first", "EV LOT received first", 
                                       "EV LOT received first"), `Sub Header 1` = c(NA, "EV after Trodelvy", 
                                                                                    "No EV after Trodelvy", NA, "Trodelvy after EV", "Trodelvy after EV", 
                                                                                    NA, "EV after Trodelvy", "No EV after Trodelvy", NA, "Trodelvy after EV", 
                                                                                    "Trodelvy after EV", NA, "EV after Trodelvy", "No EV after Trodelvy", 
                                                                                    NA, "Trodelvy after EV", "Trodelvy after EV", NA, "EV after Trodelvy", 
                                                                                    "No EV after Trodelvy", NA, "Trodelvy after EV", "Trodelvy after EV"
                                       )), row.names = c(NA, -24L), class = c("tbl_df", "tbl", "data.frame"
                                       ))

# 统计各层级数据
total_count <- nrow(d2)
header_stats <- d2 %>% 
  group_by(`Header Name`) %>% 
  summarise(count = n(), pct = round(n()/total_count*100, 1)) %>% 
  ungroup()

sub_stats <- d2 %>% 
  filter(!is.na(`Sub Header 1`)) %>% 
  group_by(`Header Name`, `Sub Header 1`) %>% 
  summarise(count = n(), pct = round(n()/total_count*100, 1)) %>% 
  ungroup()

步骤3：构建Shiny应用 #

ui <- dashboardPage(
  dashboardHeader(title = "层级树状图展示"),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      column(width = 12,
             grVizOutput("tree_plot", height = "500px")
      )
    )
  )
)

server <- function(input, output) {
  output$tree_plot <- renderGrViz({
    # 初始化节点和边的字符串
    nodes <- paste0('"Total" [label = "Bladder (', total_count, ')", style="filled", fillcolor="#f0f8ff"];')
    edges <- ""
    
    # 添加Header层级节点和边
    for(i in 1:nrow(header_stats)){
      header_id <- paste0("header_", i)
      header_label <- paste0(header_stats$`Header Name`[i], "\\n(", header_stats$count[i], ", ", header_stats$pct[i], "%)")
      nodes <- paste0(nodes, '\n"', header_id, '" [label = "', header_label, '", style="filled", fillcolor="#cce5ff"];')
      edges <- paste0(edges, '\n"Total" -> "', header_id, '";')
      
      # 添加Sub Header层级节点和边
      sub_rows <- sub_stats %>% filter(`Header Name` == header_stats$`Header Name`[i])
      for(j in 1:nrow(sub_rows)){
        sub_id <- paste0("sub_", i, "_", j)
        sub_label <- paste0(sub_rows$`Sub Header 1`[j], "\\n(", sub_rows$count[j], ", ", sub_rows$pct[j], "%)")
        nodes <- paste0(nodes, '\n"', sub_id, '" [label = "', sub_label, '", style="filled", fillcolor="#e6f2ff"];')
        edges <- paste0(edges, '\n"', header_id, '" -> "', sub_id, '";')
      }
    }
    
    # 构建Graphviz语法
    diagram <- paste0("digraph tree {
      graph [rankdir=LR, splines=ortho];
      node [shape=rectangle, fontname='Arial'];
      edge [arrowhead=vee];
      ", nodes, "\n", edges, "
    }")
    
    grViz(diagram)
  })
}

shinyApp(ui = ui, server = server)

代码说明 #

• 节点样式：通过fillcolor设置不同层级的背景色，总节点、Header、Sub Header使用渐变色区分
• 文本内容：每个节点标签包含名称、计数和百分比，用\\n实现换行
• 层级连接：用Graphviz的digraph语法创建箭头连接，rankdir=LR设置横向布局（可改为TB切换为纵向），splines=ortho使用直角箭头
• 动态生成：通过循环自动生成所有节点和边，适配数据变化

内容的提问来源于stack exchange，提问作者firmo23