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)
}
)
Related
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 have a Shiny app with a downloadButton, which enables the user to download some log files.
As the logfiles are also handled by logrotate, it might be that at a certain time no logfile exists, which currently breaks the app when trying to download it.
How can I prevent that? Or how can I display a modalDialog with the information, that no log-file currently exists?
I tried to include req(F) or return(FALSE) but they don't work.
The current approach works, as I create an empty data.frame which is then exported, but it's not a very nice solution.
library(shiny)
library(data.table)
## Write random log file. Uncomment the next line to make the example work.
#fwrite(x = iris, file = "logs.log")
ui <- fluidPage(
downloadButton("showLogs", label="", title="Logs herunterladen", icon = icon("book-open"))
)
server <- function(input, output, session) {
output$showLogs <- downloadHandler(
filename = function() {
paste('logs-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
logfile <- list.files(path = ".", pattern = basename("logs.log"))
if (length(logfile) != 0) {
logfile <- fread(logfile, sep = ";", header = F)
fwrite(logfile, file, sep = ";", row.names = FALSE)
} else {
## Problem is in here
# req(F)
# return(FALSE)
fwrite(data.frame("No log-Files"), file, sep = ";", row.names = FALSE)
}
}
)
}
shinyApp(ui, server)
Here is a solution without reactiveTimer.
library(shiny)
library(data.table)
library(shinyjs)
## Write random log file. Uncomment the next line to make the example work.
#fwrite(x = iris, file = "logs.log")
ui <- fluidPage(
useShinyjs(),
downloadButton("showLogs", label="", style = "display:none;"),
actionButton("btn", "Download")
)
server <- function(input, output, session) {
observeEvent(input$btn, {
logfile <- list.files(path = ".", pattern = basename("logs.log"))
if(length(logfile)){
runjs("$('#showLogs').click();")
}
})
output$showLogs <- downloadHandler(
filename = function() {
paste('logs-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
logfile <- list.files(path = ".", pattern = basename("logs.log"))
logfile <- fread(logfile, sep = ";", header = F)
fwrite(logfile, file, sep = ";", row.names = FALSE)
}
)
}
shinyApp(ui, server)
This app throws an alert if you click the button while no log file exists, and there's no download.
library(shiny)
library(data.table)
library(shinyjs)
## Write random log file. Uncomment the next line to make the example work.
#fwrite(x = iris, file = "logs.log")
ui <- fluidPage(
useShinyjs(),
downloadButton("showLogs", label="", title="Logs herunterladen", icon = icon("book-open"))
)
server <- function(input, output, session) {
autoInvalidate <- reactiveTimer(1000)
observe({
autoInvalidate()
logfile <- list.files(path = ".", pattern = basename("logs.log"))
if(length(logfile)){
runjs("$('#showLogs').off('click.x')")
}else{
runjs("$('#showLogs').off('click.x').on('click.x', function(e){alert('No log file'); e.preventDefault();})")
}
})
output$showLogs <- downloadHandler(
filename = function() {
paste('logs-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
logfile <- list.files(path = ".", pattern = basename("logs.log"))
logfile <- fread(logfile, sep = ";", header = F)
fwrite(logfile, file, sep = ";", row.names = FALSE)
}
)
}
shinyApp(ui, server)
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
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!
in the ui.R nothing is different
shinyUI(fluidPage(
downloadButton('downloadData','Save Results')
)
)
in the server.R
output$downloadData <- downloadHandler(
filename = function () { paste0("output", ".xlsx", sep='') },
content = function (file) {
fname <- paste(file,"xlsx",sep=".")
write.xlsx2(Correlation.df,fname ,"Correlation",row.names = FALSE)
write.xlsx2(Covariance.df, fname, "Covariance",row.names = FALSE,append = TRUE)
file.rename(fname, file)
}
)
The problem is there can launch a save window with the correct file name, but nothing is saved.
Thanks in advance.
Your downloadHandler does not provide a content function. This works for me:
library(shiny)
library(xlsx)
app <- shinyApp(
ui = fluidPage(
downloadLink('downloadData', 'Download')
),
server = function(input, output) {
df1 <- data.frame(
A = 1:5, Source = "df1",
stringsAsFactors = FALSE
)
df2 <- data.frame(
A = 6:10, Source = "df2",
stringsAsFactors = FALSE
)
output$downloadData <- downloadHandler(
filename = function(file) {
paste0("samplefile", ".xlsx")
},
content = function(con) {
write.xlsx2(df1, con, sheetName = "df1", row.names = FALSE)
write.xlsx2(df2, con, sheetName = "df2", row.names = FALSE, append = TRUE)
}
)
}
)
runApp(app)