Nest shinyDownloadHandler() within a function - r

I have a code block like so:
output$downloadTransactions <- downloadHandler(
filename = function() {
paste('transactions', Sys.Date(), '.csv', sep='')
},
content = function(file) {
write.csv(transactions_table, file)
}
)
This creates a download button on one of my tables shown by my shiny app and it works as is. In this case it's for downloading transaction data, but I have other metrics I would like the user to be able to download, including sessions and revenue.
Since I make several calls to downloadHandler(), each with minimal variation (metric name and the data frame to be downloaded), I wanted to attempt to write it as a function.
Tried:
# for download button
downloadTable <- function(metric, table) {
file = function(m) paste(m, Sys.Date(), '.csv', sep = '')
cont = function(table) write.csv(table, file)
downloadHandler(
filename = file(metric),
content = cont(table)
)
}
But when I run this as a Shiny app:
output$downloadRevenue <- downloadTable("revenue", revenue_table)
(Note revenue_table is a data frame)
Warning: Error in ==: comparison (1) is possible only for atomic and list types
86: force
85: map$set
84: self$downloads$set
83: shinysession$registerDownload
82: origRenderFunc
81: output$downloadRevenue
1: runApp
Something I struggle to follow in downloadHandler() is where it gets the variable 'file' from. It's not defined when I call it above in my first code block, yet it magically works. I think it's this piece that is causing my issues.
How can I make shiny::downloadHandler a custom function that takes two arguments, one 'metric', a string defining the name of the metric that the download table is for and then 2, the part that I think is tripping me up, the file?

The content argument to downloadHandler has to be a function which takes a file parameter. In your example, you could use
downloadTable <- function(metric, table) {
file = function(m) paste(m, Sys.Date(), '.csv', sep = '')
downloadHandler(
filename = file(metric),
content = function(file) write.csv(table, file)
)
}

Related

How to generate several reports with one button using Shiny

I have a Shiny app that generates reports about people. I would like to have a single button that generates all the reports as at the moment I am generating them one by one.
The names of the people is generated from RV4$data[,input$Map_EndoscopistIn] and the report takes a bunch of parameters as shown. How can I generate the reports in a loop for each element of the list RV4$data[,input$Map_EndoscopistIn] (preferably with element name as part of the generated filename?
output$Allreports <- downloadHandler(
k<-RV4$data[,input$Map_EndoscopistIn]
for ( i in k){
filename = "report.docx",
content = function(file) {
tempReport <- file.path(tempdir(), "report.Rmd")
file.copy("report.Rmd", tempReport, overwrite = TRUE)
# Set up parameters to pass to Rmd document
params <- list(EndoscopistChooserIn = RV4$data[,input$Map_EndoscopistIn][i],
Map_EndoscopistIn=input$Map_EndoscopistIn,
BarrEQPerformFinalTable=BarrEQPerformFinalTable(),
EndoscopyTypesDonePre=EndoscopyTypesDonePre(),
performanceTable=data(),
IndicsVsBiopsiesPre=IndicsVsBiopsiesPre(),
GRS_perEndoscopist_TablePrep=GRS_perEndoscopist_TablePrep()
)
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
}
)
The attempt above doesn't work.

Write checkBoxGroup to file and read from it

I created a Shiny App which includes a checkBoxGroup. When called, this element returns a vector with the selected choices. I can write this to file using write.table()and it creates a CSV-file in which a line looks like this:
Jota 5 5 nature3 5 5 FALSE c("choice1", "choice2", "choice4") property c("choiceA", "choiceB", "ChoiceD", "choiceE", "choiceK") 5 5
But reading this file back using read.table() seems to be tricky as it returns in
Error in scan(file = file, what = what, sep = sep, quote = quote, dec = dec, :
Line 9 doesn't have 12 arguments
I assume that read.table() has difficulties to parse the vectors in the CSV file. Is there any workaround besides flattening the structure and turning every choice into a separate, TRUE/FALSE value with a unique column?
EDIT: Example App
As suggested, I put together a dummy app which replicated the problem. It is built on this article by Shiny. Unlike described above it uses write.csv() and creates a new file for every form submit but the problem is the same.
library(shiny)
fields <- c("name", "groupInput")
shinyApp(
ui = fluidPage(
textInput("name", "Name", ""),
checkboxGroupInput("groupInput", "Select from list", choices = c('abc', 'def', 'ghi')),
actionButton("submit", "Submit"),
DT::dataTableOutput("responses", width = 300)
),
server = function(input, output, session) {
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
data
})
observeEvent(input$submit, {
saveData(formData())
})
output$responses <- DT::renderDataTable({
input$submit
loadData()
})
outputDir <- "responses"
saveData <- function(data) {
data <- t(data)
# Create a unique file name
fileName <- sprintf("%s_%s.csv", as.integer(Sys.time()), digest::digest(data))
# Write the file to the local system
write.csv(
x = data,
file = file.path(outputDir, fileName),
row.names = FALSE, quote = TRUE
)
}
loadData <- function() {
# Read all the files into a list
files <- list.files(outputDir, full.names = TRUE)
data <- lapply(files, read.csv, stringsAsFactors = FALSE)
# Concatenate all data together into one data.frame
data <- do.call(rbind, data)
data
}
}
)
When you run it and check more than one box in the checkBoxGroup the CSV that will be stored looks like this:
"name","groupInput"
somename,c("abc", "def", "ghi")
The existence of the vector in the CSV seems to cause an error in read.csv, namely:
Warning: Error in read.table: more columns than column names
Stack trace (innermost first):
87: read.table
86: FUN
85: lapply
84: loadData [/Users/alexanderjulmer/Code/test-storage/app.R#45]
83: exprFunc [/Users/alexanderjulmer/Code/test-storage/app.R#25]
82: widgetFunc
81: func
80: origRenderFunc
79: renderFunc
78: origRenderFunc
77: output$responses
1: runApp
I think this is because the vector is not properly parsed within the data.frame which I doubt is possible. So I think it would be best to split the data from checkBoxGroup into several columns. But then, how to do that?
It sounds like what you're trying to avoid is having a separate column for each possible checkBoxGroup input - the alternative to this that I see is to treat any combination of them as an element of length 1 so that it can be read by read.csv as such. In your example app, if more than one is checked, the checks are a list with length 3, and read.csv understandably doesn't really know how to handle that.
To address this problem, my approach is to first unlist the elements of checkBoxGroup and then collapse the elements into a character vector, and stick that to the "Name" text input. All of this is done in your assignment to formData:
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
chks <- unlist(data[[2]])
data <- c(data[[1]], paste0(chks, collapse=", "))
data
})
This gives you a table of two columns, where the second is a comma-separated set of checkbox inputs. (Here, I've broken that process into two steps for clarity, but there's no reason you couldn't put them into one line of code if you want to.)
However, I'm still not clear how you intend to use your data, and therefore whether a character string will be useful to you and solve your ultimate problem...

Download Handler with reactive datatable (R Shiny)

I have simplified a lot the shiny app I'm trying to build, but, in the idea, I have two functions :
choose_input <- function(n1,n2,n3){
x1 <<- n1+n2
x2 <<- n2+n3
x3 <<- (n1*n2)/n3
}
createmydata <- function(n){
c1 <- c(1:n)
c2 <- c1+(x2*x3)
c3 <- c2+x1
df <- data.frame("column1"=c1,"column2"=c2,"column3"=c3)
return(df)
}
You'll tell me that I can do simply one function with these two because they are very simple, but in my app there are a lot of lines and I have to separate the two. Anyway, here is my simulated code :
ui <- fluidPage(
numericInput("n1",label="Choose the first parameter",min=0,max=100,value=3),
numericInput("n2",label="Choose the second parameter",min=0,max=100,value=4),
numericInput("n3",label="Choose the third parameter",min=0,max=100,value=5),
numericInput("n",label="Choose dataframe length",min=1,max=10000,value=100),
radioButtons("filetype", "File type:",
choices = c("csv", "tsv")),
downloadButton('downloadData', 'Download'),
tableOutput("data")
)
server <- function(input,output){
RE <- reactive({
choose_input(input$n1,input$n2,input$n3)
createmydata(input$n)
})
output$data <- renderTable({
RE()
})
output$downloadData <- downloadHandler(
filename = function() {
paste(name, input$filetype, sep = ".")
},
content = function(file) {
sep <- switch(input$filetype, "csv" = ",", "tsv" = "\t")
write.table(RE(), file, sep = sep,
row.names = FALSE)
}
)
}
shinyApp(ui = ui, server=server)
As you can see, I'd like to download the output table to a csv or excel file... I let you try the code and then try to click on the download button, it does not work...
Debugging
When I run the code up above and attempted to download the data set, I received the following warning and error message in the Console Pane within RStudio.
Warning: Error in paste: object 'name' not found
Stack trace (innermost first):
1: runApp
Error : object 'name' not found
This led me to examine the paste() function used within the filename argument in shiny::downloadHandler(). In your code, you use the object name without ever assigning it a value.
I replaced name with the text "customTable" within the filename argument inside of downloadHandler().
output$downloadData <- downloadHandler(
filename = function() {
paste( "customTable", input$filetype, sep = ".")
},
content = function(file) {
sep <- switch(input$filetype, "csv" = ",", "tsv" = "\t")
write.table(RE(), file, sep = sep,
row.names = FALSE)
}
)
Downloading Data in Browser
After running the app.R script, I clicked on the Open in Browser button to view the Shiny app in a new tab on Chrome. Once there, I was successfully able to download both a .csv and .tsv file after hitting the download button.
Note: I'm looking for a better reason as to why this action needs to occur, but for now, I came across this relevant SO post Shiny app: downloadHandler does not produce a file.

Shiny inputs for Rmd files : Reading objects from shinyoutput object not allowed

I have seen in several examples that the input for .Rmd files are coming from input objects.
I have checked the similar questions (also this one)
I have the following problem:
ui <- fluidPage(
fileInput(inputId = "File",label = "Upload file...",accept=c("zip","text")),
radioButtons('format', 'Document format', c('PDF', 'HTML', 'Word'),
inline = TRUE),
downloadButton('downloadReport'),
tableOutput("AEP")
)
)
The input object is a zip file. contains different folders. I extract the suitable folders and picking up my files in server function.
server <- function(input, output){
options(shiny.maxRequestSize=50*1024^2)
output$AEP <- renderTable({
infile=input$File
if (is.null(infile))
return(NULL)
report_list <- c("Park result.txt",
"Park result minus",
"Park result plus")
temp_files <- unzip(infile$datapath)
temp_files <- temp_files[grepl(paste(report_list, collapse = "|"), temp_files)]
T=length(temp_files)
t1=3*c(1:(T/3))
t2=c(1:T)
t2=t2[-t1]
p=c();for(i in 1:T){p[[i]]=c()}
for(i in 1:(length(t1))){p[[t1[i]]]=read.table(temp_files[t1[i]],skip=1,sep=";")}
for(i in 1:(length(t2))){p[[t2[i]]]=read.table(temp_files[t2[i]],skip=2,sep=";")}
...
And finally I have my files as p[[i]]. I do calculations on those p[[i]], at the end my output called AEP (which is a table). I wanna use that table in markdown report. now for having proper input for my Rmd file I need to add this function to server :
output$downloadReport <- downloadHandler(
filename = function() {
paste('my-report', sep = '.', switch(
input$format, PDF = 'pdf', HTML = 'html', Word = 'docx'
))
},
content = function(file) {
# Copy the report file to a temporary directory before processing it, in
# case we don't have write permissions to the current working dir (which
# can happen when deployed).
tempReport <- file.path(tempdir(), "report.Rmd")
file.copy("report.Rmd", tempReport, overwrite = TRUE)
# Set up parameters to pass to Rmd document
params <- list(n = output$AEP)
# Knit the document, passing in the `params` list, and eval it in a
# child of the global environment (this isolates the code in the document
# from the code in this app).
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
Which I could not compile it because :
params <- list(n = output$AEP)
and Error : Reading objects from shinyoutput object not allowed.
Any Idea of how I should define params would be very much appreciated. (I have tried n=input$File and it did not worked)
I do not know also how should I proceed with reactive() function in this case.

Shiny Download File based on File Path

I have a file which i generate in shiny
The user clicks a button and the file should download. However nothing happens
The function export_report generates the excel file and saves it to a location. The function then passes back the file location to the download handler so it will download the file. The problem seems to be that it isnt being returned correctly. I have tested the function (export_report) outside of shiny and it returns everything perfectly so I'm clearly doing something wrong from the shiny perspective.
The file itself is created where it is supposed to be on the server because i can download it within RStudio and see it in the file explorer. Can anyone help
# UI Section
downloadButton("downloadRpt", "Download Report")
# Server Section
output$downloadRpt <- downloadHandler(
filename = function() {
mydf <- report()
dateRange <- input$dates_report
selection <- input$selection
myfile <- export_report (mydf, selection, dateRange)
},
content = function(file) {
file.copy(myfile, file)
}
)
I have seen other examples R Shiny: Download existing file which is what my code is based on
EDIT 1: Adding the export_report function with some fake data to run it
export_report <- function(mydf,selection,dateRange) {
# Template for where the template excel file is stored
myoutputTemplate <- '/home/shiny_tutorials/Save to Database/templates/output_template.xlsx'
start_date <- dateRange[1]
end_date <- dateRange[2]
date_range <- paste(start_date ,end_date, sep = " - " )
# Load workbook the template workbook
wb <- loadWorkbook(myoutputTemplate)
# write to the workbook the data frame
writeWorksheet(wb, mydf, sheet="Details",
startRow=8, startCol=2,
header=FALSE)
# add the the customer the user selected
writeWorksheet(wb, selection, sheet="Details",
startRow=3, startCol=3,
header=FALSE)
# date
writeWorksheet(wb, date_range, sheet="Details",
startRow=5, startCol=3,
header=FALSE)
# Create The file Name
filename <- paste(selection, Sys.Date(), sep = " - ") %>%
paste(.,"xlsx", sep = ".")
# removes the % sign and extra qoutes
filename <- gsub (pattern = '\'|%','', x = filename)
# output directory
myoutput <- paste('/home/shiny_tutorials/Save to Database/output/',
filename, sep = '')
# Save workbook
saveWorkbook(wb, myoutput)
# Return File Path
myoutput
}
To call the function you can use the data below
dateRange <- c("2011-09-23","2016-09-23")
selection = "COMPANY_A"
mydf <- iris
myfile <- export_report(mydf,selection,dateRange)
EDIT 2 I have now managed to get an error out of it. When i cat(myfile) in the filename = function() { section of the code i get the error after the correct file path has been returned
Warning in rep(yes, length.out = length(ans)) :
'x' is NULL so the result will be NULL
Warning: Error in ifelse: replacement has length zero
Stack trace (innermost first):
1: runApp
Error : replacement has length zero
This error is basically because my file path does not get passed to the segment myfile so
if someone can tell me how to get the filepath generated by my function to the server section of the code below, that should fix my problem
content = function(file) {
file.copy(myfile, file)
}
Thank you to everyone who commented and clarified my thinking a bit on how the download handler works.
In the end, i created a new function which split up the export function above
The new function i used is called generate_file() which simply returns the file name
generate_file_name <- function(selection) {
# Create The file Name
filename <- paste(selection, Sys.Date(), sep = " - ") %>%
paste(.,"xlsx", sep = ".")
# removes the % sign and extra qoutes
filename <- gsub (pattern = '\'|%','', x = filename)
# output directory
myoutput <- paste('/home/shiny_tutorials/Save to Database/output/',
filename, sep = '')
# Return File Path
myoutput
}
Then in the server side
output$downloadRpt <- downloadHandler(
filename = function() {
selection <- input$company
generate_file_name(selection)
},
content = function(file) {
mydf <- report()
dateRange <- input$dates_report
selection <- input$company
export_report(mydf,selection,dateRange)
myfile <- generate_file_name(selection)
file.copy(myfile, file)
}
)
This then finds the newly created file and exports it for the user
I just checked your problem with this example code and it worked:
output$downloadData <- downloadHandler(
filename = function() {
data <- mtcars
myfile <- "data.csv"
write.csv(data, myfile)
myfile
},
content = function(file) {
print(file) //prints: [...]\\Local\\Temp\\RtmpEBYDXT\\fileab8c003878.csv
file.copy(file, file)
}
)
myfile is the filename of the downloaded file. You cannot use it in file.copy as input, this variable is out of scope. It seems that R creates a temp file name (see the print()).
Try to use the filename function to define your path or a custom file name, and the write.csv in the content part. Example code:
output$downloadData <- downloadHandler(
filename = function() {
paste(<user_name or date for eg>, ".csv", sep="")
},
content = function(file) {
write.csv(data, file)
}
)
I noticed in your comment above, you have asked how the application would generate the correct file when used by multiple users. For this part, you need to use the session.
So if your business logic functions were to come from an R file called foo.R, the server code should look something like:
shinyServer(func = function(input, output, session) {
source("./foo.R", local=TRUE)
......
And this would separate out the session for each user, thereby generating files specific to each, when downloading. Hope this gives you some pointers.

Resources