下载多个情节图到PDF Shiny

Question

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

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档案:

---
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文档中,然后下载.

有点像:

  # 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:

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

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

---
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)  
}
```

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

更新

根据Gregor de Cillia的评论,我改变了我的plot_ly函数y = dummy.df[[msrnd]].我也尝试了as_widget(),但在我的报告中获取情节却没有成功.

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'))
})

Answer 1

问题

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

解决方案

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

之后，使用我在调整您的 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()函数内部的代码。此代码基本上生成列表.pdf中所有图的文件plots（稍后您必须指定所有 25 个图，我将在循环中执行此操作）。然后，.pdf在删除每个 .pdf 的第二页之前，它将所有图合并为一个，这是必要的，因为由于某种原因export()生成第二页完全空白的 PDF。

我的建议

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