Shiny：生成可下载报告时将绘图变量传递给 Rmarkdown 文档

Question

我想知道在使用闪亮生成可下载报告时是否可以将绘图对象传递到 Rmarkdown 文档？

例如，我有一个 P2 plotly 对象，我想将它传递给 Rmarkdown 文档。

我知道我可以将代码放入 Rmarkdown 并生成绘图，但我不在这里这样做

output$Plot <- plotly::renderPlotly({
p <- ggplot(data=iris, aes(x = Sepal.Length, y = Sepal.Width)) +
      geom_point(aes(color=Species, shape=Species)) +
      labs(title = "Iris sepal width vs length")
P2 <- ggplotly(p)
})

如何在 downloadHandler() 中传递它？

output$report <- downloadHandler(

 params <- list(myPlot = p2)

)

Answer 1

reactiveVal 中，以将其传递给 output 和 downloadHandler：

library(shiny)
library(plotly)

writeLines(con = "report.Rmd", text = "---
title: 'Plotly report'
output: html_document
params:
  plotly_object: NA
---

```{r plotlyout, echo=FALSE, message=FALSE, out.width='100%'}
params$plotly_object
```")

ui = fluidPage(
  plotlyOutput("Plot"),
  downloadButton("report_button", "Generate report")
)

server = function(input, output, session) {
  irisPlot <- reactive({
    p <- ggplot(data=iris, aes(x = Sepal.Length, y = Sepal.Width)) +
      geom_point(aes(color=Species, shape=Species)) +
      labs(title = "Iris sepal width vs length")
    ggplotly(p)
  })

  output$Plot <- plotly::renderPlotly({
    irisPlot()
  })

  output$report_button <- downloadHandler(
    filename = "report.html",
    content = function(file) {
      tempReport <- tempfile(fileext = ".Rmd") # make sure to avoid conflicts with other shiny sessions if more params are used
      file.copy("report.Rmd", tempReport, overwrite = TRUE)
      rmarkdown::render(tempReport, output_format = "html_document", output_file = file, output_options = list(self_contained = TRUE),
                        params = list(plotly_object = irisPlot())
      )
    }
  )
}

shinyApp(ui, server)

---

您可以将生成的绘图对象包装在 reactive 或方法是使用 htmlwidgets::saveWidget （如果您只需要 html 图）：

library(shiny)
library(plotly)

ui = fluidPage(
  plotlyOutput("Plot"),
  downloadButton("report_button", "Generate report") 
)

server = function(input, output, session) {
  irisPlot <- reactive({
    p <- ggplot(data=iris, aes(x = Sepal.Length, y = Sepal.Width)) +
      geom_point(aes(color=Species, shape=Species)) +
      labs(title = "Iris sepal width vs length")
    ggplotly(p)
  })
  
  output$Plot <- plotly::renderPlotly({
    irisPlot()
  })
  
  output$report_button <- downloadHandler(
    filename = "report.html",
    content = function(file) {
      htmlwidgets::saveWidget(widget = partial_bundle(irisPlot()), file = file, selfcontained = TRUE)
    }
  )
}

shinyApp(ui, server)

Answer 2

拥有文件doc.Rmd：

---
title: "Untitled"
author: "danlooo"
date: "2/22/2022"
params:
  plot:
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

## Plot

```{r}
params$plot
```

让我们在同一目录中

library(shiny)
library(plotly)
library(tidyverse)
library(rmarkdown)

ui <- fluidPage(
  plotlyOutput("plot"),
  downloadButton("download")
)

server <- function(input, output, session) {
  plot <- reactive({
    p <- ggplot(data = iris, aes(x = Sepal.Length, y = Sepal.Width)) +
      geom_point(aes(color = Species, shape = Species)) +
      labs(title = "Iris sepal width vs length")

    ggplotly(p)
  })

  output$plot <- renderPlotly(plot())

  output$download <- downloadHandler(
    filename = "report.html",
    content = function(file) {
      render(input = "doc.Rmd", output_dir = dirname(file), 
       output_file = basename(file), params = list(plot = plot()))
    }
  )
}


shinyApp(ui, server)

和另一个文件app.R：然后您可以在单击按钮后下载报告。