闪亮:生成可下载报告时将绘图变量传递给 Rmarkdown 文档

Shiny: pass a plot variable to Rmarkdown document when generating a downloadable report

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

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

I know I can put the code in Rmarkdown and generate the plot, but I don't to do it here

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)

)

您可以将生成的 plotly 对象包装在 reactivereactiveVal 中以将其传递给 outputdownloadHandler:

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)

另一种方法是使用 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)

让我们有文件 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
```

和同一目录中的另一个文件app.R

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)

点击按钮后即可下载报告