将多个地块下载到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之后，我很确定在knitr报告中循环打印plotly图时存在问题。我将在plotly存储库中提交问题，因为必须存在某种错误。即使将图形导出为.png，然后再次将其导入并显示在knitr报告中，一次也只能显示一个图形。很奇怪。

解决方案

无论如何，我找到了一个解决方案，而没有使用knitr来获取Shiny Application中生成的所有图形的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对象。

Answer 2

我认为@Stanislaus Stadlmann是正确的。由于某些原因，plotly::export在rmarkdown文件的循环内不起作用。我怀疑是出于同样的原因knitr::include_graphic does not work inside a loop。一种解决方法是使用markdown语法插入图像。这是有效的rmarkdown文件：

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

```{r,echo=FALSE,warning=FALSE, results="asis"}
library(plotly)

for (item in params$n) {
  tmpFile <- tempfile(fileext = ".png")
  export(item, file = tmpFile)
  cat("![](",tmpFile,")\n")
}
```

这是我的downloadplot1函数：

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

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

      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 = ~get(msrnd), type = 'scatter', mode = 'markers')
      })

      params <- list(n = plots.gen)

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