R Shiny中森林图PDF下载失败问题求助（附可复现代码）

核心问题 #

下载功能失败主要有两个原因：

• 未定义主题对象tm：downloadHandler代码块中调用forest()时使用theme = tm，但tm仅在renderPlot的局部作用域内定义，downloadHandler无法访问该变量，导致绘图报错。
• 代码重复导致不一致：renderPlot和downloadHandler的绘图逻辑完全重复，参数或数据处理逻辑修改时，极易出现两边不一致的问题，增加调试难度。

修复步骤 #

1. 封装绘图逻辑为Reactive函数：将数据处理、主题创建、绘图的完整逻辑封装到reactive函数中，让UI渲染和下载功能共用同一套逻辑，避免重复且保证一致性。
2. 在封装函数内创建主题：确保主题对象tm在绘图逻辑内部定义，所有调用该函数的地方都能获取到正确的主题配置。
3. 修改downloadHandler调用封装函数：直接使用封装好的函数生成森林图对象，再导出为PDF。

修改后的完整代码 #

library(shiny)
library(DT)
library(grid)
library(forestploter)
library(rhandsontable)
library(tidyverse)
library(colourpicker)

ui <- fluidPage(
  titlePanel("森林图绘制工具"),
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "选择文件 (仅支持逗号分隔的csv文件)"),
      numericInput("ci_column_input", "CI 列", 4),
      numericInput("ref_line", "参考线", 1),
      uiOutput("col_text_ui"),
      uiOutput("b_ui"),
      uiOutput("se_ui"),
      textInput("hr_ci_label", "HR (95% CI) 列标题", "HR (95% CI)"),
      colourInput("refline_col", "参考线颜色", "#FF0000"),
      numericInput("base_size", "基本字体大小", 10),
      numericInput("xlim_min", "X轴最小值", 0),
      numericInput("xlim_max", "X轴最大值", 4),
      textAreaInput("footnote", "脚注", ""),
      actionButton("plot", "绘图"),
      actionButton("reset", "重置"),
      downloadButton("downloadPlot", "DownloadPDF")
    ),
    mainPanel(
      tabsetPanel(
        tabPanel("数据", rHandsontableOutput("editableTable")),
        tabPanel("森林图", plotOutput("forestPlot"))
      )
    )
  )
)

server <- function(input, output, session) {
  
  # 加载示例数据
  dt <- reactiveVal(read.csv(system.file("extdata", "example_data.csv", package = "forestploter")) %>% 
                      mutate(se = (log(hi) - log(est))/1.96,
                             b = log(est)))
  
  # 观察文件上传
  observeEvent(input$file1, {
    file <- input$file1
    ext <- tools::file_ext(file$datapath)
    if (ext == "csv") {
      dt(read.csv(file$datapath))
    } else {
      dt(read.table(file$datapath, header = TRUE))
    }
    updateSelectInput(session, "col_text", choices = names(dt()))
    updateSelectInput(session, "b", choices = names(dt()))
    updateSelectInput(session, "se", choices = names(dt()))
  })
  
  output$editableTable <- renderRHandsontable({
    rhandsontable(dt())
  })
  
  # 更新数据
  observeEvent(input$editableTable, {
    df <- hot_to_r(input$editableTable)
    if (!is.null(df)) {
      dt(df)
    }
  })
  
  output$col_text_ui <- renderUI({
    selectInput("col_text", "文本列", choices = names(dt()), selected = c("Subgroup", "Treatment", "Placebo"), multiple = TRUE)
  })
  
  output$b_ui <- renderUI({
    selectInput("b", "回归系数 b", choices = names(dt()), selected = "b")
  })
  
  output$se_ui <- renderUI({
    selectInput("se", "标准误 se", choices = names(dt()), selected = "se")
  })
  
  # 重置按钮
  observeEvent(input$reset, {
    updateNumericInput(session, "ci_column_input", value = 4)
    updateNumericInput(session, "ref_line", value = 1)
    updateTextInput(session, "hr_ci_label", value = "HR (95% CI)")
    updateColourInput(session, "refline_col", value = "#FF0000")
    updateNumericInput(session, "base_size", value = 10)
    updateNumericInput(session, "xlim_min", value = 0)
    updateNumericInput(session, "xlim_max", value = 4)
    updateTextAreaInput(session, "footnote", value = "")
  })
  
  # 封装森林图生成逻辑为reactive函数
  forest_plot_obj <- reactive({
    input$plot # 依赖绘图按钮点击
    isolate({
      df <- dt()[,c(input$col_text, input$b, input$se)]
      
      df <- df %>% rename(b := !!input$b, se := !!input$se)
      
      df <- df %>% 
        mutate(across(input$col_text, as.character)) %>% 
        mutate(across(input$col_text, replace_na, ""))
      
      df <- df %>% 
        mutate(point = exp(b),
               lo = exp(b-1.96*se),
               hi = exp(b+1.96*se),
               `HR (95% CI)` = ifelse(is.na(se), "",
                                      sprintf("%.2f (%.2f to %.2f)", point,lo, hi))
        )
      
      # 更新HR (95% CI)列标题
      names(df)[which(names(df) == "HR (95% CI)")] <- input$hr_ci_label
      
      df2 = df %>% select(input$col_text, input$hr_ci_label)
      
      new_column <- paste(rep(" ", 20), collapse = " ")
      df3 <- if (input$ci_column_input == 1) {
        cbind(new_column, df2)
      } else if (input$ci_column_input == length(input$col_text)+2) {
        cbind(df2, new_column)
      } else {
        cbind(df2[, 1:(input$ci_column_input-1), drop = FALSE], new_column, df2[, input$ci_column_input:ncol(df2), drop = FALSE])
      }
      
      colnames(df3)[input$ci_column_input] <- " "
      
      # 更新森林图设置
      tm <- forest_theme(base_size = input$base_size,
                         refline_col = input$refline_col,
                         arrow_type = "closed",
                         footnote_col = "blue")
      
      # 生成森林图对象
      forest(df3, 
             est = df$point,
             lower = df$lo, 
             upper = df$hi,
             sizes = 0.5,
             ci_column = input$ci_column_input,
             ref_line = input$ref_line,
             arrow_lab = c("Placebo Better", "Treatment Better"),
             xlim = c(input$xlim_min, input$xlim_max),
             ticks_at = c(0.5, 1, 2, 3),
             footnote = input$footnote,
             theme = tm)
    })
  })
  
  output$forestPlot <- renderPlot({
    plot(forest_plot_obj())
  })
  
  # 导出PDF功能
  output$downloadPlot <- downloadHandler(
    filename = function() {
      "forest_plot.pdf"
    },
    content = function(file) {
      p <- forest_plot_obj()
      # 导出为PDF
      p_wh <- get_wh(p)
      pdf(file, width = p_wh[1], height = p_wh[2])
      plot(p)
      dev.off()
    }
  )
}

shinyApp(ui = ui, server = server)

关键修改说明 #

• 新增forest_plot_obj reactive函数，整合所有数据处理、主题创建、森林图生成逻辑，确保UI渲染和下载使用同一套逻辑。
• downloadHandler直接调用forest_plot_obj()获取森林图对象，解决了tm变量未定义的问题，同时避免代码重复。
• renderPlot简化为直接绘制forest_plot_obj()返回的对象，代码更简洁易维护。

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