将多个情节图下载到 PDF Shiny
Posted
技术标签:
【中文标题】将多个情节图下载到 PDF Shiny【英文标题】：Download multiple plotly plots to PDF Shiny 【发布时间】：2019-02-03 14:20:39 【问题描述】：My Shiny App 为用户选择的任何输入显示一个情节图。我想要一个下载按钮，将所有绘图保存在用户系统上的 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'))
)
【问题讨论】：
我的猜测是plot_ly的公式接口不能处理字符串所以y = ~msrnd在lapply中不起作用。
确实如此。我将其更改为y = dummy.df[[msrnd]]。还在 lapply 中围绕我的 plot_ly() 函数尝试了as_widget()。仍然得到一个空白报告。
如果问题出在字符串上，您可以尝试通过eval(parse(text = ...)) 运行它？
【参考方案1】：
问题
好的，所以在花了相当多的时间玩plotly 和 knitr 之后，我很确定在 knitr 报告中循环打印 plotly 图表存在问题。我将在 plotly 存储库中提出问题，因为肯定存在某种错误。即使将图表导出为 .png，然后再次导入并在knitr 报告中显示，一次也只能显示一个图表。很奇怪。
解决方案
无论如何，我找到了一个解决方案，无需使用knitr 来获取在您的 Shiny 应用程序中生成的所有图形的 pdf。它依赖staplr 包来组合PDF 文件，因此您必须安装该包并安装pdftk 工具包。
之后，使用我在改编您的 Shiny 应用时编写的以下代码：
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。
我的建议
如果我是你，我想完全摆脱 plotly，并用 ggplot2 图表替换它。完全按照您的意愿去做会更容易（包括knitr 解决方案）。使用plotly 创建的图表增加了一层复杂性，因为它们是首先必须转换为静态文件的 Web 对象。
【讨论】：
【参考方案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())
)
)
【讨论】：
以上是关于将多个情节图下载到 PDF Shiny的主要内容，如果未能解决你的问题，请参考以下文章