如何下载R Shiny中绘制的图表？下载后为空白该如何解决？

核心问题定位 #

• 文件名配置错误：paste(input$plot, ".png", sep = ".")中input$plot不存在，plot是服务端输出的渲染对象，不属于用户输入项，无法通过input调用。
• 下载内容逻辑缺失：content函数中仅执行了返回数据集的plotteddata()，没有实际运行绘图代码，所以生成的png文件没有内容。
• 冗余错误点：原renderPlot中的空值判断is.null(data)逻辑错误，data是reactive响应式对象，需要加括号调用data()才能获取实际数据集，同时plotteddata改为reactive对象更适配Shiny的响应式规则，避免未选变量时的报错。

修正后完整代码 #

library(shiny)
library(ggplot2)
library(shinythemes)

ui <- fluidPage(
  navbarPage("Data Analysis Training:", id="navbar",
             tabPanel("Upload Tab",
                      titlePanel("Upload your file here."),
                      sidebarLayout(
                        sidebarPanel(
                          fileInput("file1", "Choose CSV File",
                                    multiple = TRUE,
                                    accept = c("text/csv",
                                               "text/comma-separated-values,text/plain",
                                               ".csv")),
                          
                          tags$hr(),
                          checkboxInput("header", "Header", TRUE),
                          radioButtons("sep", "Separator",
                                       choices = c(Comma = ",",
                                                   Semicolon = ";",
                                                   Tab = "\t"),
                                       selected = ","),
                          tags$hr(),
                          radioButtons("disp", "Display",
                                       choices = c(Head = "head",
                                                   All = "all"),
                                       selected = "head"),
                          radioButtons("quote", "Quote",
                                       choices = c(None = "",
                                                   "Double Quote" = '"',
                                                   "Single Quote" = "'"),
                                       selected = '"')),
                        mainPanel(
                          verbatimTextOutput("summary"),
                          tableOutput("contents")
                        ))), 
             tabPanel("Graphing",
                      titlePanel("Plotting Graphs"),
                      sidebarLayout(
                        sidebarPanel( uiOutput("X_axis"),
                                      uiOutput("Y_axis"),
                        ),
                        mainPanel(
                          h3(textOutput("caption")),
                          plotOutput("plot"),
                          downloadButton("downloadData", "Download")
                        )
                        
                      )),
             tabPanel(title = "Quit", value = "stop", icon = icon("circle-o-notch"))
  ))

server <- function(input, output, session) {
  onSessionEnded(stopApp)
  data <- reactive({
    req(input$file1)
    df <- read.csv(input$file1$datapath, header = input$header, sep = input$sep, quote = input$quote)
    return(df)
  })
  
  output$contents <- renderTable({
    if (input$disp == "head") {
      return(head(data()))
    }
    else {
      return(data())
    }
  })
  output$summary <- renderPrint({
    summary(data())
  })
  
  output$X_axis <- renderUI({
    selectInput("variableNames_x", label = "X_axis", choices = names(data()))  
  })
  output$Y_axis <- renderUI({
    selectInput("variableNames_y", label = "Y_axis", choices = names(data()) ) 
  })
  plotteddata <- reactive({
    req(input$variableNames_x, input$variableNames_y)
    selecteddata <- data.frame(data()[[input$variableNames_x]], data()[[input$variableNames_y]])
    colnames(selecteddata) <- c("X", "Y")
    return(selecteddata)
  })
  
  observe({
    if (input$navbar == "stop")
      stopApp()
  })
  
  output$plot <- renderPlot({
    req(plotteddata())
    ggplot(plotteddata(),aes(x = X,y = Y)) + geom_point(colour = 'red', pch=1) +
      labs(y = input$variableNames_y,
           x = input$variableNames_x,
           title = "Data Analysis Plotting")
  })
  
  output$downloadData <- downloadHandler(
    filename = function() {
      # 使用选中的XY轴变量名生成文件名，也可自定义为固定名称
      paste0(input$variableNames_x, "_vs_", input$variableNames_y, ".png")
    },
    content = function(file){
      png(file)
      # 将ggplot对象打印到png设备完成绘图输出
      p <- ggplot(plotteddata(),aes(x = X,y = Y)) + 
        geom_point(colour = 'red', pch=1) +
        labs(y = input$variableNames_y,
             x = input$variableNames_x,
             title = "Data Analysis Plotting")
      print(p)
      dev.off()
    }
  )
}

shinyApp(ui, server)

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