R Shiny downloadHandler 返回应用程序 html 而不是绘图或数据

Question

我只是想从模块和绘图辅助函数构建的应用程序中返回用户生成的绘图（内置 ggplot）或数据表。我已经看到很多关于 downloadHandler 非常挑剔的帖子，甚至一些 downloadHandler 的行为似乎存在未解决的问题。我得到的奇怪行为（我还没有看到过相关帖子）是它返回我的应用程序的 html 页面而不是绘图，无论我如何尝试保存绘图（即，使用 pdf/png 设备， ggsave() 等），或者我是否使用 suspendWhenHidden。我可以在 Shiny 外部运行绘图保存代码，它工作正常。我在 Mac 上从浏览器（Firefox，虽然 Chrome 也这样做）运行所有这些，最近更新了所有内容。下面的示例代码。

模块：

library(shiny)
library(ggplot2)
# UI module
modUI <- function(id, label="inputvalues") {
  ns <- NS(id)
  tagList(
    numericInput(ns("mean"), "Mean",value = NULL),
    numericInput(ns("sd"),"Std. Dev.",value = NULL),
    actionButton(ns("draw"),"Draw plot"),
    downloadButton(ns("dlPlot"), "Download Plot")
  )
}

# Server Logic module
mod <- function(input, output, session) {
  x <- reactiveValues(data=NULL)
  observeEvent(input$draw, {
    x$data <- rnorm(100,input$mean,input$sd)
  })

  return(list(dat = reactive({x$data}),
          m = reactive({input$mean}),
          s = reactive({input$sd})
          )
     )
}

绘图辅助函数：

showPlot <- function(data, m, s) {
  d <- data.frame(data)
  p <- ggplot(d, aes(x=d, y=d)) +
    geom_point() +
    geom_vline(xintercept=m)
  p
}

UI 和服务器调用：

ui <- navbarPage("Fancy Title",id = "tabs",
                 tabPanel("Panel1",value = 1,
                          sidebarPanel(
                            modUI("input1")
                          ),
                          mainPanel(plotOutput("plot1"))
                 )
)

server <- function(input, output, session) {
  y <- callModule(mod, "input1")
  output$plot1 <- renderPlot({ 
    if (is.null(y$dat())) return()
    showPlot(data.frame(y$dat()), y$m(), y$s())
  })

  output$dlPlot <- downloadHandler(
    filename="~Plot_Download.pdf",
    content=function(file){
      pdf(filename, file)
      p
      dev.off()
    }
  )
}

shinyApp(ui, server)

一如既往地感谢您的帮助！

Answer 1

终于找到了这个问题的答案，很大程度上基于这篇文章。答案是创建一个专门用于下载的服务器模块（可以获取会话和命名空间信息），然后在服务器中调用该模块。下面是附加和更新的代码：

新的下载模块：

dlmodule <- function(input, output, session) {
  output$dlPlot <- downloadHandler(
    filename="Plot_Download.pdf",
    content=function(file){
      ggsave(file, device = pdf, width = 7,height = 5,units = "in",dpi = 200)
    }
  )
}

更新后的服务器调用：

server <- function(input, output, session) {
  y <- callModule(mod, "input1")
  output$plot1 <- renderPlot({
    if (is.null(y$dat())) return()
    showPlot(data.frame(y$dat()), y$m(), y$s())
  })

  dl.y <- callModule(dlmodule, "input1")
}

其他一切都保持不变。