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!
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
))
}
)
The below reproducible code allows the user to select either a data table or a plot of the data for viewing (via input$view). I'm trying to create a conditional around the downloadHandler() so that if the user is viewing the data table and chooses to download, then the data is downloaded; otherwise if the user is viewing the plot and chooses to download then a plot in PNG format is downloaded. I'm running into issues around input$view reactivity. How would I modify the code below to conditionally download whichever (data or plot) the user is viewing?
The code as posted below works for viewing either data or plot, but only allows the data table to be downloaded. Offending lines of code that otherwise cause a crash are commented out.
Reproducible code:
library(shiny)
library(ggplot2)
ui <- fluidPage(
radioButtons("view",
label = "View data or plot",
choiceNames = c('Data','Plot'),
choiceValues = c('viewData','viewPlot'),
selected = 'viewData',
inline = TRUE
),
conditionalPanel("input.view == 'viewData'",tableOutput("DF")),
conditionalPanel("input.view == 'viewPlot'",plotOutput("plotDF")),
downloadButton("download","Download",style = "width:20%;")
)
server <- function(input, output, session) {
data <- data.frame(Period = c(1,2,3,4,5,6),Value = c(10,20,15,40,35,30))
data1 <- reactiveValues()
inputView <- reactive(input$view) # attempt to make input$view reactive
observeEvent(input$view,{data1$plot <- ggplot(data, aes(Period,Value)) + geom_line()})
output$DF <- renderTable(data)
output$plotDF <- renderPlot(data1$plot)
output$download <-
# if(inputView() == 'viewData'){
downloadHandler(
filename = function()
paste("dataDownload","csv",sep="."),
content = function(file){
write.table(
data,
na = "",
file,
sep = ",",
col.names = TRUE,
row.names = FALSE)
}
)
# }
# else{
# downloadHandler(
# filename = function(){paste("plotDownload",'.png',sep='')},
# content = function(file){
# ggsave(file,plot=data1$plot)
# }
# )
# }
}
shinyApp(ui, server)
Try this
library(shiny)
library(ggplot2)
ui <- fluidPage(
radioButtons("view",
label = "View data or plot",
choiceNames = c('Data','Plot'),
choiceValues = c('viewData','viewPlot'),
selected = 'viewData',
inline = TRUE
),
conditionalPanel("input.view == 'viewData'",tableOutput("DF")),
conditionalPanel("input.view == 'viewPlot'",plotOutput("plotDF")),
#downloadButton("download","Download",style = "width:20%;")
uiOutput("plotrtable")
)
server <- function(input, output, session) {
data <- data.frame(Period = c(1,2,3,4,5,6),Value = c(10,20,15,40,35,30))
data1 <- reactiveValues()
inputView <- reactive(input$view) # attempt to make input$view reactive
observeEvent(input$view,{data1$plot <- ggplot(data, aes(Period,Value)) + geom_line()})
output$DF <- renderTable(data)
output$plotDF <- renderPlot(data1$plot)
output$plotrtable <- renderUI({
if(input$view == 'viewData'){downloadButton("download","Download",style = "width:20%;") }
else {downloadButton("downloadp","Download",style = "width:20%;") }
})
output$download <- downloadHandler(
filename = function()
paste("dataDownload","csv",sep="."),
content = function(file){
write.table(
data,
na = "",
file,
sep = ",",
col.names = TRUE,
row.names = FALSE)
}
)
output$downloadp <- downloadHandler(
filename = function(){paste("plotDownload",'.png',sep='')},
content = function(file){
ggsave(file,plot=data1$plot)
}
)
}
shinyApp(ui, server)
I am writing a shiny app which:
creates a gt table
saves the gt table as an image (temporary file)
passes that image into a word doc using {officer} package
I am having difficulty with the image creation .... any help appreciated... here is my reprex
library(shiny)
library(gt)
library(dplyr)
ui <- fluidPage(
downloadButton("report", "Generate Report")
)
server <- function(input, output, session) {
my_table <- render_gt(
mtcars[1:5,1:5] %>%
gt()
)
my_image <-reactive({
outfile <- tempfile(fileext='.png')
gtsave(my_table, outfile, width = 400, height = 300)
})
output$report <- downloadHandler(
filename = function() {
"download.docx"
},
content = function(file) {
print(read_docx() %>%
body_add_img(my_image()),
target = file)
},
contentType = "docx"
)
}
shinyApp(ui, server)
There are several issues with your code:
You use render_gt instead of reactive.
Your reactive my_image does not return the name of the temporary file which is needed to add it to the docx. Additionally, as my_table is or should be a reactive use my_table()
In gtsave use vwidth and vheight. See ?webshot::webshot.
In officer::body_add_img you have to set a width and height in inches.
Reproducible code:
library(shiny)
library(gt)
library(dplyr)
library(officer)
ui <- fluidPage(
downloadButton("report", "Generate Report")
)
server <- function(input, output, session) {
my_table <- reactive({
mtcars[1:5, 1:5] %>%
gt()
})
my_image <- reactive({
outfile <- tempfile(fileext = ".png")
gtsave(my_table(), outfile, vwidth = 400, vheight = 300)
outfile
})
output$report <- downloadHandler(
filename = function() {
"download.docx"
},
content = function(file) {
read_docx() %>%
body_add_img(my_image(), width = 4, height = 3) %>%
print(target = file)
},
contentType = "docx"
)
}
shinyApp(ui, server)
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 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