Possible Reactive function for PDF download in Shiny - r

Question

I'm wondering if it's possible to have a shiny app being able to download a PDF of selected table content.
For example, if I have two tables, and I select one table to be downloaded via PDF, it will download a PDF that has the title content I want and the specified table in a PDF format. Not sure how I can change the downloadHandler portion so that the PDF download works and not give me the following error:
Warning: Error in FUN: non-numeric argument to binary operator [No
stack trace available]
.
The code is as follows:
df1<- data.frame(c(1:4),c("Z","Y","X","A"))
df2<- data.frame(c("Apple","Orange"),c(6.99,4.99))
colnames(df1)<-c("Col1","Col2")
colnames(df2)<-c("ColA","ColB")
library(shiny)
library(Cairo)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title="Test"),
dashboardSidebar(sidebarMenu(
menuItem("Data Table", tabName = "dashboard", icon = icon("th")))),
dashboardBody(tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
box(downloadButton("download", "PDF Download"),
radioButtons(inputId="filter1", label="Table", choiceNames = c("One","Two"), choiceValues = c("df1","df2"),inline= TRUE))),
fluidRow(box(
column(8, align="center", offset = 2,tags$b(textOutput("text1"))),
br(),br(),br(),br(),
textOutput("text2"),
tableOutput("static1"),
width=12))
)))
)
server <- function(input, output) {
output$text1 <- renderText({ "This Table" })
output$text2 <- renderText({"PR"})
df02 <- reactive({
get(input$filter1)
})
output$static1 <- renderTable({
df02()
})
output$download <- downloadHandler(
filename = 'report.pdf',
content = function(file) {
cairo_pdf(filename = "file123.pdf",
df02())
}, contentType = "application/pdf"
)
}
shinyApp(ui, server)
It seems that the PDF download does not work. I want the downloaded PDF to look like this when I select Table One and click on the PDF download button:
I want the downloaded PDF to look like this when I select Table Two to be downloaded:

Answer 1

df1 <- data.frame(c(1:4), c("Z", "Y", "X", "A"))
df2 <- data.frame(c("Apple", "Orange"), c(6.99, 4.99))
colnames(df1) <- c("Col1", "Col2")
colnames(df2) <- c("ColA", "ColB")
library(shiny)
library(shinydashboard)
library(xtable)
library(withr)
library(shinybusy)
ui <- dashboardPage(
dashboardHeader(title = "Test"),
dashboardSidebar(sidebarMenu(
menuItem("Data Table", tabName = "dashboard", icon = icon("th"))
)),
dashboardBody(
add_busy_spinner(spin = "cube-grid", onstart = FALSE),
tabItems(
# First tab content
tabItem(
tabName = "dashboard",
fluidRow(
box(
downloadButton("download", "PDF Download"),
radioButtons(
inputId = "filter1", label = "Table", inline = TRUE,
choiceNames = c("One", "Two"), choiceValues = c("df1", "df2")
)
)
),
fluidRow(box(
column(8, align = "center", offset = 2, tags$b(textOutput("text1"))),
br(), br(), br(), br(),
textOutput("text2"),
tableOutput("static1"),
width = 12
))
)
)
)
)
server <- function(input, output) {
output$text1 <- renderText({
"This Table"
})
output$text2 <- renderText({
"PR"
})
df02 <- reactive({
get(input$filter1)
})
output$static1 <- renderTable({
df02()
})
output[["download"]] <- downloadHandler(
filename = "results_from_shiny.pdf",
content = function(file){
texfile <- paste0(tools::file_path_sans_ext(file), ".tex")
latex <- print.xtable(
xtable(df02()), print.results = FALSE,
floating = FALSE, scalebox = "0.9"
)
writeLines(
c(
"\\documentclass[12pt]{standalone}",
"\\usepackage{graphics}",
"\\usepackage{caption}",
"\\begin{document}",
"{\\large\\bf This table.}",
"",
"\\newline",
"",
"\\minipage{\\textwidth}",
"\\centering",
latex,
"\\captionof{table}{My caption}",
"\\endminipage",
"\\end{document}"
),
texfile
)
with_dir(
dirname(texfile),
tools::texi2pdf(texfile, clean = TRUE)
)
}, contentType = "application/pdf"
)
}
shinyApp(ui, server)
EDIT
Or you can use the capture package:
tabItem(
tabName = "dashboard",
fluidRow(
box(
capture::capture_pdf(
selector = "#table-container",
filename = "table.pdf",
icon("camera"), "Take screenshot of table."
),
radioButtons(
inputId = "filter1", label = "Table", , inline = TRUE,
choiceNames = c("One", "Two"), choiceValues = c("df1", "df2")
)
)
),
fluidRow(box(
id = "table-container",
column(8, align = "center", offset = 2, tags$b(textOutput("text1"))),
br(), br(), br(), br(),
textOutput("text2"),
tableOutput("static1"),
width = 12
))
)