You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

Shiny中DiagrammeR无法输出流程图及Alpha分配可视化需求

Shiny中DiagrammeR流程图显示异常及需求实现方案

一、解决流程图显示为表达式的问题

在Shiny中直接返回DiagrammeR的grViz对象会被当成表达式输出,必须匹配对应的渲染与输出函数:

  • UI端用grVizOutput()定义输出容器
  • Server端用renderGrViz()包裹流程图生成代码

二、alpha分配流程图与权重可视化实现

以下是整合两个需求的完整Shiny代码,包含alpha分配流程图、可编辑权重表格及绿色系权重可视化:

library(shiny)
library(DiagrammeR)
library(DT)
library(ggplot2)
library(reshape2)

ui <- fluidPage(
  titlePanel("Alpha分配与权重可视化"),
  sidebarLayout(
    sidebarPanel(
      numericInput("total_alpha", "总I类错误(α)", value = 0.05, min = 0, max = 1, step = 0.01),
      numericInput("n_endpoints", "终点数量", value = 2, min = 1, max = 5, step = 1),
      numericInput("n_subgroups", "单终点亚组数量", value = 2, min = 1, max = 4, step = 1),
      hr(),
      numericInput("matrix_dim", "权重矩阵维度(n*n)", value = 3, min = 2, max = 5, step = 1),
      actionButton("generate_matrix", "生成权重输入表格")
    ),
    mainPanel(
      grVizOutput("alpha_flowchart"),
      hr(),
      DTOutput("weight_matrix"),
      plotOutput("green_weight_plot")
    )
  )
)

server <- function(input, output, session) {
  # 生成alpha分配流程图
  output$alpha_flowchart <- renderGrViz({
    total_alpha <- input$total_alpha
    n_endpoints <- input$n_endpoints
    n_subgroups <- input$n_subgroups
    
    # 自定义alpha分配逻辑(示例为平均分配,可按需修改)
    endpoint_alpha <- total_alpha / n_endpoints
    subgroup_alpha <- endpoint_alpha / n_subgroups
    
    # 构建流程图语法
    flowchart_text <- paste0("
      digraph alpha_allocation {
        graph [rankdir = TB, nodesep = 0.5, ranksep = 0.8]
        node [shape = rectangle, style = filled, fillcolor = #e3f2fd]
        
        total [label = '总I类错误\nα = ", total_alpha, "']
        
        ", paste0("endpoint", 1:n_endpoints, " [label = '终点", 1:n_endpoints, "\nα = ", round(endpoint_alpha, 4), "']"), collapse = "\n        ", "
        
        ", paste0("subgroup", rep(1:n_endpoints, each = n_subgroups), "_", rep(1:n_subgroups, n_endpoints), " [label = '亚组", rep(1:n_subgroups, n_endpoints), "\nα = ", round(subgroup_alpha, 4), "']"), collapse = "\n        ", "
        
        total -> {", paste0("endpoint", 1:n_endpoints, collapse = " "), "}
        
        ", paste0("endpoint", 1:n_endpoints, " -> {", paste0("subgroup", rep(1:n_endpoints, each = n_subgroups), "_", rep(1:n_subgroups, n_endpoints), collapse = " "), "}"), collapse = "\n        ", "
      }
    ")
    
    grViz(flowchart_text)
  })
  
  # 生成可编辑权重表格
  weight_data <- reactiveVal()
  
  observeEvent(input$generate_matrix, {
    dim <- input$matrix_dim
    df <- as.data.frame(matrix(0, nrow = dim, ncol = dim))
    colnames(df) <- paste0("列", 1:dim)
    rownames(df) <- paste0("行", 1:dim)
    weight_data(df)
  })
  
  output$weight_matrix <- renderDT({
    req(weight_data())
    datatable(weight_data(), editable = TRUE, options = list(pageLength = 10))
  })
  
  # 限制权重输入为0-1范围
  observeEvent(input$weight_matrix_cell_edit, {
    info <- input$weight_matrix_cell_edit
    df <- weight_data()
    df[info$row, info$col] <- info$value
    df[df < 0] <- 0
    df[df > 1] <- 1
    weight_data(df)
  })
  
  # 生成绿色系权重可视化图表
  output$green_weight_plot <- renderPlot({
    req(weight_data())
    df <- weight_data()
    df_long <- melt(df)
    colnames(df_long) <- c("行", "列", "权重")
    
    ggplot(df_long, aes(x = 列, y = 行, fill = 权重)) +
      geom_tile(color = "white", size = 1) +
      geom_text(aes(label = round(权重, 2)), color = "#1b5e20", size = 4) +
      scale_fill_gradient(low = "#f1f8e9", high = "#388e3c", limits = c(0, 1)) +
      theme_minimal() +
      theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
      labs(title = "权重矩阵可视化", fill = "权重(0-1)")
  })
}

shinyApp(ui, server)

关键说明

  1. 流程图渲染:通过renderGrViz()和grVizOutput()组合,确保DiagrammeR图表正常渲染,而非输出表达式。
  2. alpha分配逻辑:示例采用平均分配规则,可直接修改endpoint_alpha和subgroup_alpha的计算方式实现自定义分配。
  3. 权重图表:基于ggplot2生成绿色系热力图,支持实时编辑权重并自动限制输入范围,可通过调整scale_fill_gradient参数匹配图2样式。

内容的提问来源于stack exchange,提问作者sina wang

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.05 01:27:32