I want to export multiple tables with a multi row caption or header to the same document using the officer package.
Background: In my company docx template a table or plot has a caption which consists of a title and a subtitle, both with their own styles. While the title corresponds to the caption in docx or officer, the subtitle is simply added as a paragraph.
Thanks to officer this is not a big deal and works great when exporting (gg)plots or just one table to docx.
However, when I export multiple tables the subtitle is placed at the right position only for the first table, while for all subsequent tables the subtitle is placed after the table:
The issue arises both with officer::body_add_table and flexible::body_add_flextable.
I already did some trial and error with changing the order in which I add the elements and had a look at the docs but wasn't able to figure out a solution. Maybe I missed the right argument to fix my issue.
A minimal reproducible example based on the default docx template shipped with officer:
library(officer)
to_docx <- function(docx, value, title, subtitle) {
# Add table or plot
if (inherits(value, "ggplot")) {
pre_label <- seq_id <- "Figure"
docx <- body_add_gg(docx, value = value)
} else {
pre_label <- seq_id <- "Table"
docx <- body_add_table(docx, value = value, align_table = "center")
}
# Add title above table
run_num <- run_autonum(seq_id = seq_id, pre_label = pre_label)
title <- block_caption(title, style = "Image Caption", autonum = run_num)
docx <- body_add_caption(docx, title, pos = "before")
# Add subtitle above table
subtitle <- fpar(ftext(subtitle, prop = fp_text(color = "red")))
docx <- body_add_fpar(docx, subtitle, style = "Normal", pos = "after")
docx <- cursor_end(docx)
# Add a page breaks
docx <- body_add_break(docx, pos = "after")
invisible(docx)
}
docx <- read_docx()
tab <- head(mtcars[1:3])
to_docx(docx, tab, "Title 1", "Subtitle 1")
to_docx(docx, tab, "Title 2", "Subtitle 2")
fn <- tempfile(fileext = ".docx")
print(docx, fn)
show <- FALSE # Setting to TRUE will open the docx
if (show) fs::file_show(fn)
And as a reference, using the function to export multiple ggplots works as intended:
library(ggplot2)
docx <- read_docx()
gg <- ggplot(mtcars, aes(hp, mpg)) +
geom_point()
to_docx(docx, gg, "Title 1", "Subtitle 1")
to_docx(docx, gg, "Title 2", "Subtitle 2")
fn <- tempfile(fileext = ".docx")
print(docx, fn)
show <- FALSE
if (show) fs::file_show(fn)
This was a bug and is now fixed in the dev version (or >= 0.4.5).
With the update, it's important to assign the result of to_docx to docx (there was an internal change with the cursor management):
library(officer)
to_docx <- function(docx, value, title, subtitle) {
# Add table or plot
if (inherits(value, "ggplot")) {
pre_label <- seq_id <- "Figure"
docx <- body_add_gg(docx, value = value)
} else {
pre_label <- seq_id <- "Table"
docx <- body_add_table(docx, value = value, align_table = "center")
}
# Add title above table
run_num <- run_autonum(seq_id = seq_id, pre_label = pre_label)
title <- block_caption(title, style = "Image Caption", autonum = run_num)
docx <- body_add_caption(docx, title, pos = "before")
# Add subtitle above table
subtitle <- fpar(ftext(subtitle, prop = fp_text(color = "red")))
docx <- body_add_fpar(docx, subtitle, style = "Normal", pos = "after")
docx <- cursor_end(docx)
# Add a page breaks
docx <- body_add_break(docx, pos = "after")
invisible(docx)
}
docx <- read_docx()
tab <- head(mtcars[1:3])
docx <- to_docx(docx, tab, "Title 1", "Subtitle 1")
docx <- to_docx(docx, tab, "Title 2", "Subtitle 2")
fn <- tempfile(fileext = ".docx")
print(docx, fn)
show <- FALSE # Setting to TRUE will open the docx
if (show) fs::file_show(fn)
As an alternative solution, you could also use block_list(), below an illustration (only with the table):
library(officer)
library(ggplot2)
to_docx <- function(docx, value, title, subtitle) {
# Add table
pre_label <- seq_id <- "Table"
run_num <- run_autonum(seq_id = seq_id, pre_label = pre_label)
bl <- block_list(
block_caption(title, style = "Image Caption", autonum = run_num),
fpar(subtitle, fp_p = fp_par(word_style = "Normal")),
block_table(x = value, header = TRUE,
properties = prop_table(
tcf = table_conditional_formatting(
first_row = TRUE, first_column = TRUE)
))
)
docx <- body_add_blocks(docx, bl, pos = "after")
invisible(docx)
}
docx <- read_docx()
tab <- head(mtcars[1:3])
docx <- to_docx(docx, tab, "title-1", "subtitle")
docx <- to_docx(docx, tab, "title-2", "subtitle")
fn <- tempfile(fileext = ".docx")
print(docx, fn)
show <- FALSE # Setting to TRUE will open the docx
if (show) fs::file_show(fn)
I'm trying to export a ggsurvplot-object to powerpoint with officer-package with no success. I was able to find a lot of instructions on how to use now obsolute ReporterS-package for this and a few mentions that officer should work as well. There seems to be nothing in the documentation mentioning this. So should this work at all? Is it possible to get a vectorized survival plot to a pptx-slide with these tools?
totsur <- ggsurvplot(yhd1,
data = sappivertailu,
combine=TRUE,
xlab = "Time, months",
ylab="Survival",
title="Overall survival",
lwd=2,
palette="jco",
xscale = "d_m",
xlim = c(0,730.5),
break.x.by = 91.3,
risk.table = TRUE,
pval = TRUE,
fontsize = 3)
totsur
my_vec_graph <- dml(code = totsur)
doc <- read_pptx()
doc <- add_slide(doc, layout = "Overall survival", master = "Office Theme")
doc <- ph_with(doc, my_vec_graph, location = ph_location_fullsize() )
print(doc, target = "Sappitutkimus/Charts/survi1.pptx")
Changing the dml(ggobj = totsur) neither works. What am I doing wrong?
Edit: Thanks for all the comments below! And another update. There was nothing wrong with the data. After a little debugging, my original data produces the intended result.
One problem remains. Package does not seem to able to add risk table and survival curve in the same slide. Yes, you can pass this by making two separate plots on separate slides but I don't think that's good practice.
If I'm not totally mistaken, officer and ReporteRs have some code in common and this issue was present there as well. https://github.com/kassambara/survminer/issues/314
Does anyone know a way around this? Here's a bit more compact chunk I'm currently using. This works fine otherwise.
yhd1 <- survfit(Surv(sappivertailu$Survi, sappivertailu$Kuolema) ~ Arm, data=koe)
totsur <-
ggsurvplot(yhd1,
combine = TRUE,
data = sappivertailu,
# risk.table = TRUE,
pval = TRUE,
fontsize = 3
)
totsur
my_vec_graph <- rvg::dml(ggobj = last_plot())
doc <- read_pptx()
doc <- add_slide(doc, layout = "Title and Content", master = "Office Theme")
doc <- ph_with(doc, my_vec_graph, location = ph_location_fullsize() )
print(doc, target = "Sappitutkimus/Charts/survi1.pptx")
Edit n:o 2: And a tip about the desired result.
Sure could you export ggsurvplots. to pptx via officer. There are two issues with your code. First you have to make use of rvg::dml(ggobj = ...) . Second you set layout = "Overall survival". But there is no layout with this name in the default pptx shipped with officer, i.e. you could only use layouts which are present in the pptx template. Fixing both issues and making use of the basic example from the docs of ggsurvplot:
require("survival")
#> Loading required package: survival
library(survminer)
#> Loading required package: ggplot2
#> Loading required package: ggpubr
library(officer)
fit<- survfit(Surv(time, status) ~ sex, data = lung)
# Basic survival curves
ggsurvplot(fit, data = lung)
my_vec_graph <- rvg::dml(ggobj = last_plot())
doc <- read_pptx()
doc <- add_slide(doc, layout = "Title and Content", master = "Office Theme")
doc <- ph_with(doc, my_vec_graph, location = ph_location_fullsize() )
print(doc, target = "survi2.pptx")
EDIT If you want to have multiple contents on the same slide you could change the layout to Two Content and make use of ph_location_left/right:
doc <- read_pptx()
doc <- add_slide(doc, layout = "Two Content", master = "Office Theme")
doc <- ph_with(doc, my_vec_graph, location = ph_location_left() )
doc <- ph_with(doc, my_vec_graph, location = ph_location_right() )
print(doc, target = "survi2.pptx")
Somewhat to my amazement, you can use the code = argument within dml() if you embed your suvival plot in a print() statement. Be sure to include newpage = FALSE:
require("survival")
# Loading required package: survival
library(survminer)
#> Loading required package: ggplot2
#> Loading required package: ggpubr
library(officer)
fit<- survfit(Surv(time, status) ~ sex, data = lung)
# Basic survival curves
p = ggsurvplot(fit, data = lung, risk.table = TRUE)
my_vec_graph <- rvg::dml(code = print(p, newpage = FALSE))
doc <- read_pptx()
doc <- add_slide(doc, layout = "Title and Content", master = "Office Theme")
doc <- ph_with(doc, my_vec_graph, location = ph_location_fullsize() )
print(doc, target = "survi2.pptx")
I am trying to create a shiny flexdashboard within R Markdown that will display different tables based on user input. Some tables are formattable, others are just regular tables. The following code will do the rendering of the table if the tables in a list are all Formattables.
num <- reactive(as.integer(input$qualityDataNum))
renderFormattable(qualityData[[num()]])
But since some are not formattables, I want to check before doing the render. Instead of putting the tables in a list I created the following code to pick the table based on user input. It doesn't work, I get a warning: "Error in if: argument is of length zero".
num <- reactive(as.integer(input$qualityDataNum))
observe({
if (num() == 1) {
renderFormattable(qualityData1)
} else {
renderTable(qualityData2)
}
})
The complete code is below (since this is RMarkdown code it was reformated when
the three ticks were used for code marking. Sorry.):
title: "Dashboard Prototype"
output: flexdashboard::flex_dashboard
runtime: shiny
# allow sharing of dashboard
library(datasets)
library(flextable)
library(formattable)
library(dplyr)
options(stringsAsFactors = FALSE)
qData <- data.frame(Name = "AAA", Releases = 10, Coverage = 23.0)
qData <- bind_rows(qData, data.frame(Name = "BBB", Releases = 35, Coverage = 88.0))
#Using Formattable
data_formatter_dd <-
formattable::formatter("span", style = x ~ style( font.weight = "bold",
color = ifelse(x > 80.0 & x <= 100.0, "green", ifelse(x > 50.0 & x <= 80.0, "orange", "red"))))
qualityData1 <- formattable::formattable(qData, align = c("l", rep("r", ncol(qData) - 1)),
list('Name' = formattable::formatter("span", style = ~ style(color = "grey", font.weight = "bold")),
'Coverage' = data_formatter_dd))
#Using flextable
qualityData2 <- flextable(head(qData, col_keys = c("Name", "Releases", "Coverage")))
Sidebar {.sidebar}
# shiny inputs
selectInput("qualityDataNum", label = h3("Quality Number Set"), choice = list("1" = 1, "2" = 2),
selected = 1)
Quality Statistics
Quality
num <- reactive(as.integer(input$qualityDataNum))
observe({
req(num())
if (num() == 1) {
renderFormattable(qualityData1)
} else {
renderTable(qualityData2)
}
})
For Standalone Shiny Applications:
In order to achieve what you desire easily i would recommend to generate an output for each plottype and only populate it when the corresponding input is selected.
Down below you can find a complete example of this.
Generally speaking it is not advised to mix outputTypes (different render functions on the server side) into one output function (on the UI side)
# allow sharing of dashboard
library(datasets)
library(flextable)
library(formattable)
library(dplyr)
library(shiny)
options(stringsAsFactors = FALSE)
qData <- data.frame(Name = "AAA", Releases = 10, Coverage = 23.0)
qData <- bind_rows(qData, data.frame(Name = "BBB", Releases = 35, Coverage = 88.0))
data_formatter_dd <-
formattable::formatter("span", style = x ~ style( font.weight = "bold",
color = ifelse(x > 80.0 & x <= 100.0, "green", ifelse(x > 50.0 & x <= 80.0, "orange", "red"))))
qualityData1 <- formattable::formattable(qData, align = c("l", rep("r", ncol(qData) - 1)),
list('Name' = formattable::formatter("span", style = ~ style(color = "grey", font.weight = "bold")),
'Coverage' = data_formatter_dd))
qualityData2 <- flextable(head(qData, col_keys = c("Name", "Releases", "Coverage")))
ui <- fluidPage(
fluidRow(
selectInput("qualityDataNum", label = h3("Quality Number Set"), choice = list("1" = 1, "2" = 2),
selected = 1)
,
tableOutput("table2"),
formattableOutput("table1")
)
)
server <- function(input, output, session) {
output$table1 <- renderFormattable({
req(as.integer(input$qualityDataNum) == 1)
qualityData1
})
output$table2 <- renderTable({
req(as.integer(input$qualityDataNum) != 1)
qualityData2$body$dataset
})
}
shiny::shinyApp(ui,server)
EDIT:
For RMarkdown Code
I just rechecked your question and noticed that you were specifically asking how to handle the problem in an RMarkdown document and not in a standalone shiny Application. So here is an Update answer:
For RMarkdown it is enough that you update the code in your Quality Statistics section to the following:
renderFormattable({
req(as.integer(input$qualityDataNum) == 1)
qualityData1
})
renderTable({
req(as.integer(input$qualityDataNum) != 1)
qualityData2$body$dataset
})
Here you render the table according to the select input, it would be possible to render also multiple tables using this approach at the same time. This works since the req() functions checks if the requirement is fullfilled and only proceeds with the procession (aka the rendering of the plot) when it does. If it doesn't just an empty object is returned. Since we are using an reactive input inside the render function the expression get evaluate every time the Input value changes. If you do not want that consider wrapping it with an isolate() function, which tells the encapsulation function to not revaluate the function every time the encapsulate reactive Values/Inputs changes.
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)
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)
```
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.
Something along the lines of:
# 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')
})
Pass this list as the parameters to Rmd:
# Inside downloadHandler
params <- list(n = plots.gen)
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?
Update
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'))
})
The Problem
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.
The Solution
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.
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)
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.
My Suggestion
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.
I think #Stanislaus Stadlmann is on point. For some reason, plotly::export does not work inside a loop of a rmarkdown file. I suspect it is for the same reason knitr::include_graphic does not work inside a loop. A workaround is to use the markdown syntax to insert your images. Here is the rmarkdown file that works:
---
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")
}
```
And this is my downloadplot1 function:
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())
)
}
)