将多个情节图下载到 PDF Shiny多个、情节、Shiny、PDF

2023-09-06 08:07:39 作者：吣疼了、誰会在乎

My Shiny App 为用户选择的任何输入显示一个情节图.我想要一个下载按钮，将所有绘图保存在用户系统上的 PDF 文件中.我正在使用 R markdown 编写 PDF 报告，然后使用 Shiny 中的 downloadHandler 下载它.到目前为止，我可以在我的 Shiny 代码中单独创建每个图，然后将它们作为参数列表传递给我的 r markdown 文件.由于我的实际项目中有大量地块(> 25)，因此我想循环进行.这是迄今为止我所拥有的一个可重复的示例:

My Shiny App displays a plotly plot for whatever input the user selects. I want a download button that saves ALL the plots inside a PDF file on the user's system. I'm using R markdown for knitting a PDF report and then donwloading it using downloadHandler in Shiny. As of now, I can create each plot individually in my Shiny code and then pass them as a list of parameters to my r markdown file. Since I have a large number of plots (>25) in my actual project, I want to do it in a loop. Here's a reprodcuible example of what I have so far:

library(shiny)

dummy.df <- structure(list(
  Tid = structure(
    1:24, .Label = c("20180321-032-000001", 
                     "20180321-032-000003", "20180321-032-000004", "20180321-032-000005", 
                     "20180321-032-000006", "20180321-032-000007", "20180321-032-000008", 
                     "20180321-032-000009", "20180321-032-000010", "20180321-032-000011", 
                     "20180321-032-000012", "20180321-032-000013", "20180321-032-000014", 
                     "20180321-032-000015", "20180321-032-000016", "20180321-032-000017", 
                     "20180321-032-000018", "20180321-032-000020", "20180321-032-000021", 
                     "20180321-032-000022", "20180321-032-000024", "20180321-032-000025", 
                     "20180321-032-000026", "20180321-032-000027"), class = "factor"), 
  Measurand1 = c(4.1938661428, 4.2866076398, 4.2527368322, 
                 4.1653403962, 4.27242291066667, 4.16539040846667, 4.34047710253333, 
                 4.22442363773333, 4.19234076866667, 4.2468291332, 3.9844897884, 
                 4.22141039866667, 4.20227445513333, 4.33310654473333, 4.1927596214, 
                 4.15925140273333, 4.11148968806667, 4.08674611913333, 4.18821475666667, 
                 4.2206477116, 3.48470470453333, 4.2483107466, 4.209376197, 
                 4.04040350253333), 
  Measurand2 = c(240.457556634854, 248.218468503733, 
                 251.064523520989, 255.454918894609, 250.780599536337, 258.342398843477, 
                 252.343710644105, 249.881670507113, 254.937548700795, 257.252509533017, 
                 258.10699153634, 252.191362744656, 246.944795528771, 247.527116069484, 
                 261.060987461132, 257.770850218767, 259.844790397474, 243.046373553637, 
                 247.026385356368, 254.288899315579, 233.51454714355, 250.556819253509, 
                 255.8242909112, 254.938735944406), 
  Measurand3 = c(70.0613216684803, 
                 70.5004961457819, 70.8382322052776, 69.9282599322167, 68.3045749634227, 
                 71.5636835352475, 69.1173532716941, 71.3604764318073, 69.5045949393461, 
                 71.2211656142532, 72.5716638087178, 69.2085312787522, 70.7872214372161, 
                 70.7247180047809, 69.9466984209057, 71.8433220247599, 72.2055956743742, 
                 71.0348320947071, 69.3848050049961, 69.9884660785462, 73.160638501285, 
                 69.7524898841488, 71.1958302879424, 72.6060886025082)), 
  class = "data.frame", row.names = c(NA, 24L)
)

# Define UI for application
ui <- fluidPage(
   titlePanel("Download Demo"),
   sidebarLayout(
      sidebarPanel(
        selectInput(inputId = "variable",
                    label = "Plot Measurand",
                    choices = colnames(dummy.df)[2:11]
        ),
        hr(),
        downloadButton("downloadplot1", label = "Download plots")
      ),
      mainPanel(
         plotlyOutput("myplot1")
      )
   )
)

# Define server logic
server <- function(input, output) {

  # Output graph
  output$myplot1 <- renderPlotly({
    plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = ~get(input$variable), type = 'scatter',
            mode = 'markers') %>%
      layout(title = 'Values',
             xaxis = list(title = "Points", showgrid = TRUE, zeroline = FALSE),
             yaxis = list(title = input$variable, showgrid = TRUE, zeroline = FALSE))
  })

  # Creating plots individually and passing them as a list of parameters to RMD
  # Example for the first two measurands
  test.plot1 <- reactive({
    plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = ~Measurand1, type = 'scatter', mode = 'markers')
  })

  test.plot2 <- reactive({
    plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = ~Measurand2, type = 'scatter', mode = 'markers')
  }) 

  output$downloadplot1 <-  downloadHandler(
    filename = "plots.pdf",
    content = function(file){

      tempReport <- file.path(tempdir(), "report1.Rmd")
      file.copy("download_content.Rmd", tempReport, overwrite = TRUE)

      # Set up parameters to pass to Rmd document
      params <- list(n = test.plot1(), k = test.plot2())

      rmarkdown::render(tempReport, output_file = file,
                        params = params,
                        envir = new.env(parent = globalenv())
      )
    }
  )
}

# Run the application 
shinyApp(ui = ui, server = server)

还有我的 RMD 文件:

And my RMD file:

---
title: "Report"
output: pdf_document
always_allow_html: yes
params:
  n: NA
  k: NA
---

```{r,echo=FALSE}
library(plotly)
tmpFile <- tempfile(fileext = ".png")
export(params$n, file = tmpFile)
export(params$k, file = tmpFile)
```

我想要做的是将所有图作为参数化列表传递给 rmd，其中每个图都将绘制在针织 PDF 文档中，然后下载.

What I want to do is pass ALL the plots as a parameterized list to rmd, where each of the plot will be plotted in the knitted PDF document and then downloaded.

类似的东西:

  # IN server
  # Generate plots in a loop
  list.of.measurands <- c("Measurand1", "Measurand2") #....all my measurands

  plots.gen <- lapply(list.of.measurands, function(msrnd){
    plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = ~msrnd, type = 'scatter', mode = 'markers')
  })

将此列表作为参数传递给 Rmd:

Pass this list as the parameters to Rmd:

# Inside downloadHandler
params <- list(n = plots.gen)

并在 rmd 文件中循环绘制所有图:

And plot all plots in a loop in the rmd file:

---
title: "Report"
output: pdf_document
always_allow_html: yes
params:
  n: NA
  k: NA
---

```{r,echo=FALSE}
library(plotly)
tmpFile <- tempfile(fileext = ".png")

for (item in params$n){
  export(item, file = tmpFile)  
}
```

这会创建一个空白报告.我错过了什么?

This creates a blank report. What am I missing?

更新

根据 Gregor de Cillia 的评论，我将 plot_ly 函数更改为具有 y = dummy.df[[msrnd]].我也尝试过 as_widget() 但没有成功在我的报告中获取图表.

Following Gregor de Cillia's comment, I changed my plot_ly function to have y = dummy.df[[msrnd]]. I have also tried as_widget() but no success in getting plots in my report.

plots.gen <- lapply(list.of.measurands, function(msrnd){

as_widget(plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = dummy.df[[msrnd]], 
                  type = 'scatter', mode = 'markers'))
})

推荐答案

问题

好的，所以在花了相当多的时间玩 plotly 和 knitr 之后，我很确定在循环中打印 plotly 图形存在问题在 knitr 报告中.我将在 plotly 存储库中提交一个问题，因为肯定存在某种错误.即使将图形导出为 .png，然后再次导入并在 knitr 报告中显示，一次也只能显示一个图形.很奇怪.

Okay, so after spending a decent amount of time playing around with plotly and knitr, I'm pretty sure that there's a problem with printing plotly graphs in a loop while inside a knitr report. I will file an issue at the plotly repository, because there must be some kind of bug. Even when exporting the graph as .png, then importing it again and displaying it in the knitr report, only one graph at a time can be shown. Weird.

解决方案

无论如何，我找到了一个解决方案，无需使用 knitr 来获取在您的 Shiny 应用程序中生成的所有图形的 pdf.它依赖 staplr 包来组合 PDF 文件，因此您必须安装该包并安装 pdftk 工具包.

Anyhow, I found a solution without using knitr to get a pdf of all graphs that are produced in your Shiny Application. It relies on the staplr package to combine PDF files, so you have to install that package and also install the pdftk toolkit.

之后，使用我在改编您的 Shiny 应用时编写的以下代码:

Afterwards, use the following code I wrote while adapting your Shiny App:

library(shiny)
library(plotly)
library(staplr)

dummy.df <- structure(list(
  Tid = structure(
    1:24, .Label = c("20180321-032-000001", 
                     "20180321-032-000003", "20180321-032-000004", "20180321-032-000005", 
                     "20180321-032-000006", "20180321-032-000007", "20180321-032-000008", 
                     "20180321-032-000009", "20180321-032-000010", "20180321-032-000011", 
                     "20180321-032-000012", "20180321-032-000013", "20180321-032-000014", 
                     "20180321-032-000015", "20180321-032-000016", "20180321-032-000017", 
                     "20180321-032-000018", "20180321-032-000020", "20180321-032-000021", 
                     "20180321-032-000022", "20180321-032-000024", "20180321-032-000025", 
                     "20180321-032-000026", "20180321-032-000027"), class = "factor"), 
  Measurand1 = c(4.1938661428, 4.2866076398, 4.2527368322, 
                 4.1653403962, 4.27242291066667, 4.16539040846667, 4.34047710253333, 
                 4.22442363773333, 4.19234076866667, 4.2468291332, 3.9844897884, 
                 4.22141039866667, 4.20227445513333, 4.33310654473333, 4.1927596214, 
                 4.15925140273333, 4.11148968806667, 4.08674611913333, 4.18821475666667, 
                 4.2206477116, 3.48470470453333, 4.2483107466, 4.209376197, 
                 4.04040350253333), 
  Measurand2 = c(240.457556634854, 248.218468503733, 
                 251.064523520989, 255.454918894609, 250.780599536337, 258.342398843477, 
                 252.343710644105, 249.881670507113, 254.937548700795, 257.252509533017, 
                 258.10699153634, 252.191362744656, 246.944795528771, 247.527116069484, 
                 261.060987461132, 257.770850218767, 259.844790397474, 243.046373553637, 
                 247.026385356368, 254.288899315579, 233.51454714355, 250.556819253509, 
                 255.8242909112, 254.938735944406), 
  Measurand3 = c(70.0613216684803, 
                 70.5004961457819, 70.8382322052776, 69.9282599322167, 68.3045749634227, 
                 71.5636835352475, 69.1173532716941, 71.3604764318073, 69.5045949393461, 
                 71.2211656142532, 72.5716638087178, 69.2085312787522, 70.7872214372161, 
                 70.7247180047809, 69.9466984209057, 71.8433220247599, 72.2055956743742, 
                 71.0348320947071, 69.3848050049961, 69.9884660785462, 73.160638501285, 
                 69.7524898841488, 71.1958302879424, 72.6060886025082)), 
  class = "data.frame", row.names = c(NA, 24L)
)

# Define UI for application
ui <- fluidPage(
  titlePanel("Download Demo"),
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "variable",
                  label = "Plot Measurand",
                  choices = colnames(dummy.df)[2:11]
      ),
      hr(),
      downloadButton("downloadplot1", label = "Download plots")
    ),
    mainPanel(
      plotlyOutput("myplot1")
    )
  )
)

# Define server logic
server <- function(input, output) {

  # Output graph
  output$myplot1 <- renderPlotly({
    plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = ~get(input$variable), type = 'scatter',
            mode = 'markers') %>%
      layout(title = 'Values',
             xaxis = list(title = "Points", showgrid = TRUE, zeroline = FALSE),
             yaxis = list(title = input$variable, showgrid = TRUE, zeroline = FALSE))
  })

  # Creating plots individually and passing them as a list of parameters to RMD
  # Example for the first two measurands
  test.plot1 <- reactive({
    plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = ~Measurand1, type = 'scatter', mode = 'markers')
  })

  test.plot2 <- reactive({
    plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = ~Measurand2, type = 'scatter', mode = 'markers')
  }) 

  output$downloadplot1 <-  downloadHandler(
    filename = "plots.pdf",
    content = function(file){

      # Set up parameters to pass to Rmd document
      plots <- list(test.plot1(), test.plot2())

      # Plot indices
      ind_vec <- seq_along(plots)

      # Create tempfiles for all plots
      tfiles <- sapply(ind_vec, FUN = function(x)
        return(tempfile(fileext = ".pdf")))

      # create tempfiles for the plots with the second page deleted
      tfiles_repl <- sapply(ind_vec, FUN = function(x)
        return(tempfile(fileext = ".pdf")))

      # Save the objects as .pdf files
      for (i in ind_vec) {
        # Export files
        export(plots[[i]], tfiles[[i]])

        # Remove second page bc for some reason it is whitespace
        staplr::remove_pages(2, input_filepath = tfiles[[i]], 
                             output_filepath = tfiles_repl[[i]])
      }

      # Combine the plots into one pdf
      staplr::staple_pdf(input_files = tfiles_repl, output_filepath = file)

      # Remove .pdf files
      lapply(tfiles, FUN = file.remove)
      lapply(tfiles_repl, FUN = file.remove)
    }
  )
}

# Run the application 
shinyApp(ui = ui, server = server)

我只修改了 downloadHandler() 函数内的代码.这段代码基本上会生成 plots 列表中所有图的 .pdf 文件(稍后您必须指定所有 25 个图，我会在循环中执行此操作).然后，它将所有绘图合并到一个 .pdf 中，然后删除每个 .pdf 的第二页，这是必要的，因为出于某种原因 export() 会生成一个带有第二页完全空白.

I only adapted the code inside the downloadHandler() function. This code basically produces .pdf files of all plots that are inside the plots list (where you later have to specify all your 25 plots, I would do this in a loop). Then, it combines all plots into one .pdf, before deleting the second page of each .pdf, which is necessary because for some reason export() produces a PDF with the second page being completely blank.

我的建议

如果我是你，我会想完全摆脱 plotly，并用 ggplot2 图表代替它.完全按照您的意愿去做会更容易(包括 knitr 解决方案).使用 plotly 创建的图表会产生额外的复杂性，因为它们是首先必须转换为静态文件的 Web 对象.

If I were you, I would want to get rid of plotly at all, and replace it with ggplot2 graphs. It would be way easier to do exactly what you want (including the knitr solution). Graphs created with plotly create an extra layer of complexity, because they are web objects that first have to be converted to static files.