将多个地块下载到PDF Shiny [英] Download multiple plotly plots to PDF Shiny

查看:217
本文介绍了将多个地块下载到PDF Shiny的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我的闪亮应用程序"显示用户选择的任何输入的绘图.我想要一个下载按钮,将所有绘图保存在用户系统上的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文件:

---
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之后,我很确定在knitr报告中循环打印plotly图形时存在问题.我将在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 Application中生成的所有图形的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 App时编写的以下代码:

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()会生成第二页完全为空白的PDF.

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.

这篇关于将多个地块下载到PDF Shiny的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆