I am trying to export ggplots in my Shiny App into a single PDF file using the download handler but it is not working. The PDF file is getting saved but it gives me only the last ggplot instead of all three. Any help would be appreciated!
Below is the code of the server:
shinyServer(function(input, output, session) {
plotinput()
{
df<-data.frame(q=c(1,3,5,7,9),w=c(2,4,6,8,10),z=c(1,2,3,4,5))
ggplot(df,aes(x=q,y=w))+geom_point()
ggplot(df,aes(x=z,y=w))+geom_point()
ggplot(df,aes(x=q,y=z))+geom_point()
}
output$allgraphs <- downloadHandler(
filename = function(){paste0("graphs.pdf")},
content = function(file){
pdf(file,onefile = TRUE)
print(plotinput())
dev.off()
}
)
})
We could do this with
library(shiny)
library(grid)
library(gridExtra)
runApp(list(
ui = fluidPage(downloadButton('allgraphs')),
server = function(input, output) {
plotinput <- function() {
df<-data.frame(q=c(1,3,5,7,9),w=c(2,4,6,8,10),z=c(1,2,3,4,5))
list(p1 = ggplot(df,aes(x=q,y=w))+geom_point(),
p2 = ggplot(df,aes(x=z,y=w))+geom_point(),
p3 = ggplot(df,aes(x=q,y=z))+geom_point())
}
output$allgraphs = downloadHandler(
filename = 'graphs.pdf',
content = function(file) {
pdf(file)
arrangeGrob(print(plotinput()[['p1']]),
print(plotinput()[['p2']]),
print(plotinput()[['p3']]), ncol = 3)
dev.off()
})
}
))
-output
allgraphs.pdf
1
2
3
Related
I have developed app to allow users to download all the plots in the app to PDF file. The code somewhat works, but not as I expected.
The number of plots are dynamic (as it depends on the data). I have use marrangeGrob function but all my plots are still on the same page, instead of seeing one on each page
Is there a setting I have missed? Also, I would like to adjust the height and the width for each chart as well (make the width shorter and the height longer), is there an option to do so?
Here is my code:
library(shiny)
library(data.table)
library(tidyverse)
library(shinydashboard)
### UI & Module -------------------
plotUI <- function(id) {
ns <- NS(id)
plotOutput(ns("myplot"))
}
plotServer <- function(id,groups) {
moduleServer(
id,
function(input, output, session) {
filtered.data <- reactive(iris %>% filter(Species == groups))
create_graph <- reactive(filtered.data() %>% ggplot(aes(x = Sepal.Length, y = Sepal.Width)) +geom_col())
output$myplot <- renderPlot(create_graph())
return(list(graph = create_graph))
}
)
}
### UI part -----------------------
ui <- dashboardPage(
title="test",
dashboardHeader(),
dashboardSidebar(downloadButton('download')),
dashboardBody(uiOutput('tablist'))
)
### Server part ----------------------------
server = function(input, output) {
groups <- reactive(unique(iris$Species))
ntabs <- reactive(length(groups()))
allplots <- reactiveVal()
observeEvent(ntabs(),{
plot <- lapply(1:ntabs(), function (i) {
plotServer(paste0("plot",i),groups()[i])
})
allplots(plot)
})
output$tablist = renderUI({
addtabs <- lapply(1:ntabs(),function (i) {
tabPanel(
groups()[i],
plotUI(paste0("plot",i)),
)
})
do.call(tabsetPanel, addtabs)
})
output$download <- downloadHandler(
filename = function() {
paste0("plots-", Sys.Date(), ".pdf")
}, content = function(file) {
plot.list <- allplots()
ggsave(file,marrangeGrob(lapply(plot.list, function(x) x$graph()),
ncol = 1, nrow = length(plot.list)))
}
)
}
### Running part ----------------------------
shinyApp(ui, server,enableBookmarking = "server")
If we specify ncol = 1 and nrow = 1, every plot goes in a separate page because the layout gets "recycled".
output$download <- downloadHandler(
filename = function() {
paste0("plots-", Sys.Date(), ".pdf")
}, content = function(file) {
plot.list <- allplots()
ggsave(file, marrangeGrob(
grobs = plot.list |> lapply(\(x) x$graph()),
ncol = 1,
nrow = 1
))
}
)
Could you please give an insight of why my future-promised data table object causes a failure when trying to save it with downloadHandler and write.xlsx2?
I have working everything else in such fashion:
## Server processing
shinyServer(
function(input, output, session)
{
options(java.parameters = "- Xmx1024m")
library(DT)
library(data.table)
library(magrittr)
library(ggplot2)
library(highcharter)
library(lubridate)
library(future)
library(promises)
library(xlsx)
dt_materials <- eventReactive(
input$run_materials,
{
plan(multiprocess)
## reactive values
dat_func <- function()
{
## Data processing
## Return
list(
output_tbl
, plo1
, paste0('Время обработки: ', round(Sys.time() - start_time), ' сек.')
, output_tbl_private
, dat_full
)
}
## launch future
future({
dat_func()
})
})
## Output
output$downloadDataMaterials <-
downloadHandler(
filename = "tass_ru_materials.xlsx",
content = function(file)
{
dat_full <- dt_materials() %...>% `[[`(5)
write.xlsx2(x = dat_full, file = file, sheetName = 'materials', row.names = FALSE)
}
)
})
I get a server fault:
However, a simple example works fine when I change the content function:
content = function(file)
{
dat_full <- data.table(x=1:10)
write.xlsx2(x = dat_full, file = file, sheetName = 'materials', row.names = FALSE)
}
I made this work using a blocking resolution, looks enough for now.
output$downloadDataMaterials <-
downloadHandler(
filename = "tass_ru_materials.xlsx",
content = function(file)
{
dat_full <- value(dt_materials())[[5]]
write.xlsx2(x = dat_full, file = file, sheetName = 'materials', row.names = FALSE)
}
)
I want to create several wordclouds, using wordcloud and wordcloud2 packages.
I can create a download for the wordcloud created by the wordcloud package, but as soon as I render a wordcloud2-wordcloud, the download button breaks (only allows to download .html instead of .png).
I've added an example to reproduce it:
library("shiny")
library("wordcloud")
library("wordcloud2")
library("tm")
ui <- fluidPage(plotOutput("plot1"), downloadButton('plot1download'))
server <- function(input, output, session) {
output$plot1 <- renderPlot({
wordcloud(data(crude))
})
output$plot2 <- renderWordcloud2({
wordcloud2(demoFreq)
})
output$plot1download <- downloadHandler(
filename = function() {
paste('wordcloud', '.png', sep='')
},
content = function(file) {
device <- function(..., width, height) grDevices::png(...)
ggsave(file, plot = wordcloud(data(crude)), device = device)
}
)
}
shinyApp(ui, server)
The code above works, but if I add another plot (plotOutput("plot2")), it breaks:
library("shiny")
library("wordcloud")
library("wordcloud2")
library("tm")
ui <- fluidPage(plotOutput("plot1"), downloadButton('plot1download'), wordcloud2Output("plot2"))
server <- function(input, output, session) {
output$plot1 <- renderPlot({
wordcloud(data(crude))
})
output$plot2 <- renderWordcloud2({
wordcloud2(demoFreq)
})
output$plot1download <- downloadHandler(
filename = function() {
paste('wordcloud', '.png', sep='')
},
content = function(file) {
device <- function(..., width, height) grDevices::png(...)
ggsave(file, plot = wordcloud(data(crude)), device = device)
}
)
}
shinyApp(ui, server)
Anyone has an idea why this happens and how to resolve the issue?
This seems to be a bug in the CRAN version of wordcloud2. Install the development version from GitHub with
remotes::install_github("lchiffon/wordcloud2")
for a fix.
I've made an shiny app where I'm filtering a dataset using some values and then I would like to be able to download that filtered dataset. However, I'm struggling to understand how I can pass the filtered dataset to the csv downloader. It is a very large dataset so can't use the buttons available in renderDataTable (I think?) Does anyone have any ideas of how I can do this?
Example app:
### data ###
egDf <- data.frame(col1 = sample(letters,10000,replace=T), col2 = sample(letters,10000, replace=T))
### modules ###
chooseCol1UI <- function(id){
ns <- NS(id)
uiOutput(ns('chooserCol1'))
}
chooseCol1 <- function(input, output, session, data){
output$chooserCol1 <- renderUI({
ns <- session$ns
pickerInput(inputId = ns('chosenCol1'),
label = 'Col1',
choices = paste(sort(unique(egDf$col1))),
options = list(`actions-box` = TRUE),
multiple = TRUE)
})
return(reactive(input$chosenCol1))
}
csvDownloadUI <- function(id, label = "Download CSV") {
ns <- NS(id)
downloadButton(ns("downloadData"), label)
}
csvDownload <- function(input, output, session, data) {
output$downloadData <- downloadHandler(
filename = function() {
paste(names(data), Sys.Date(), '.csv', sep='')
},
content = function(file) {
write.csv(data, file, row.names = FALSE)
}
)
}
displayTableUI <- function(id){
ns <- NS(id)
DT::dataTableOutput(ns('displayer'))
}
displayTable <- function(input, output, session, data, col1Input){
output$displayer <- DT::renderDataTable(egDf %>% filter(col1 %in% col1Input()))
}
### server ###
server <- function(input,output){
chosenCol1 <- callModule(chooseCol1,
id = 'appChooseCol1', data = egDf)
callModule(module = displayTable, id = "appDisplayTable",
col1Input = chosenCol1)
}
### ui ###
ui <- fluidPage(
sidebarPanel(
chooseCol1UI("appChooseCol1")),
mainPanel(displayTableUI("appDisplayTable")))
### app ###
shinyApp(ui = ui, server = server)
A few years ago I made an app with such a button. In my case I created a reactive expression in the server.R file that is being passed to the downloadHandler.
Here's the app and here's the github code. Head to the server.R file and search for the "download" string.
In the app you'll find a blue download button in the "Data" tab. The app let's you apply filters that applies in the datatable, that you can download via the button.
Edit: here's the server portion of code of interest:
#data download button
output$idDwn <- downloadHandler(
filename = function() {
paste('uCount ', format(Sys.time(), "%Y-%m-%d %H.%M.%S"), '.csv', sep='')
},
content = function(file) {
write.csv(datasetInputFilters(), file)
}
)
I would create eventReactive function that allows your col1Input.
# Reactive function based on input
react_df <- eventReactive(input$chosenCol1, {
return(egDf %>% filter(col1 %in% input$chosenCol1))
})
output$displayer <- renderDataTable(react_df())
# Download box
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
output_d <- react_df()
write.csv(output_d, file, row.names = FALSE)
}
)
I dealt with this issue recently and unfortunately that solution didn't work for me. But simply using writexl::write_xlsx() instead of write.csv() was enough.
I want to be able to download a table as an image(PNG or JPEG). Let's assume that my dataframe is df
output$statsTable <- renderTable({
#Printing the table
df
})
output$downloadStatsTable <- downloadHunter(
filename = function() {
paste(getwd(), '/test.png', sep = '')
},
content = function(con) {
p <- grid.table(df)
device <- function(..., width, height) grDevices::png(..., width = 12, height = 9, res = 300, units = "in")
ggsave(file, plot = p, device = device)
}
)
To download table as image you can use grid.table function from library gridExtra. Here is a code which you could use as a template:
library(gridExtra)
library(shiny)
df <- head(datasets::iris)
ui <- fluidPage(
tableOutput("statsTable"),
downloadButton('downloadStatsTable ', 'Download')
)
server <- function(input, output) {
output$statsTable <- renderTable({
#Printing the table
df
})
output$downloadStatsTable <- downloadHandler(
# Create the download file name
filename = function() {
paste("data-", Sys.Date(), ".jpeg", sep="")
},
content = function(file) {
grid.table(df)
jpeg(file=file)
grid.table(df) #Create image of the data frame
dev.off()
})
}
runApp(list(ui = ui, server = server), launch.browser = TRUE)
Hope it helps!