R shiny - having trouble with file download - r

So I want to have a Shiny page which:
A) Allows the user to upload a .xls file;
B) Offers that file back to the user for download as a .csv file;
C) Prints the head of the file in the Shiny app to ensure that it was properly read.
Here is the code I am using:
# Want to read xls files with readxl package
library(readxl)
library(shiny)
## Only run examples in interactive R sessions
if (interactive()) {
ui <- fluidPage(
fileInput("file1", "Choose File", accept = ".xls"),
tags$hr(),
uiOutput("downloader"),
htmlOutput("confirmText", container = tags$h3),
tableOutput("listContents")
)
server <- function(input, output) {
theOutput <- reactiveValues(temp = NULL, df = NULL, msg = NULL, fn = NULL)
observeEvent(input$file1, {
theOutput$fn <- paste('data-', Sys.Date(), '.csv', sep='')
theOutput$temp <- read_xls(input$file1$datapath)
theOutput$msg <- paste("File Contents:")
theOutput$df <- write.csv(theOutput$temp,
file = theOutput$fn,
row.names = FALSE)
})
output$confirmText <- renderText({
theOutput$msg
})
output$listContents <- renderTable({
head(theOutput$temp)
})
output$downloader <- renderUI({
if(!is.null(input$file1)) {
downloadButton("theDownload", label = "Download")
}
})
output$theDownload <- downloadHandler(
filename = theOutput$fn,
content = theOutput$df
)
}
shinyApp(ui, server)
}
The Shiny page renders correctly, it accepts the upload with no problems, it prints out the head of the .csv with no problems, and it creates a properly formatted "data-{today's date}.csv" file in the same directory as the app.R file.
Problem is, when I hit the download button I get the error message:
Warning: Error in download$func: attempt to apply non-function
[No stack trace available]
Can someone tell me what I am doing wrong?

Thanks to the comments above, this is the solution I found (with my comments added, to show where the code changed):
library(readxl)
library(shiny)
if (interactive()) {
ui <- fluidPage(
fileInput("file1", "Choose File", accept = ".xls"),
tags$hr(),
uiOutput("downloader"),
htmlOutput("confirmText", container = tags$h3),
tableOutput("listContents")
)
server <- function(input, output) {
theOutput <- reactiveValues(temp = NULL, msg = NULL)
observeEvent(input$file1, {
# Do not try to automate filename and the write.csv output here!
theOutput$temp <- read_xls(input$file1$datapath)
theOutput$msg <- paste("File Contents:")
})
output$confirmText <- renderText({
theOutput$msg
})
output$listContents <- renderTable({
head(theOutput$temp)
})
output$downloader <- renderUI({
if(!is.null(input$file1)) {
downloadButton("theDownload", label = "Download")
}
})
output$theDownload <- downloadHandler(
# Filename and content need to be defined as functions
# (even if, as with filename here, there are no inputs to those functions)
filename = function() {paste('data-', Sys.Date(), '.csv', sep='')},
content = function(theFile) {write.csv(theOutput$temp, theFile, row.names = FALSE)}
) }
shinyApp(ui, server) }
The fact that content takes an argument (named here "theFile"), which is not called anywhere else, is what was throwing me off.

Related

Downloading the outputs of a reactive table in R shiny

I have an R shiny app that gets a .csv import from a user and searches the imported data across a built-in data frame, then gives the % match in the output. The UI is very simple, with a few different inputs (import .csv, a slider, and some radio buttons). What I want is to be able to take the reactive table output and print this to a .csv that the user can download to their machine. The server side of the app looks something like this:
server <- function(input, output){
rvals <- reactiveValues()
observeEvent(input$file_1,{
req(input$file_1)
rvals$csv <<- read.csv(input$file_1$datapath, header = TRUE)
#some data processing here
})
output$contents <- renderTable({
if(input$select == 1){
x <- function
}else if(input$select == 2){
x <- function
}else if(input$select == 3){x <- function}
#some more data processing and formatting here
return(x)
},digits = 4)
}
I would like to have the data table x be able to become a .csv that can be downloaded by clicking a download button. In the server, I added the following code, but when I try to download the data it just downloads a blank file and says "SERVER ERROR" in my downloads manager on my machine.
output$downloadData <- downloadHandler(
filename = "thename.csv",
content = function(file){
write.csv(x, file)
}
In the console I also get the error message:
Warning: Error in is.data.frame: object 'x' not found [No stack trace available]
The object you create inside the expression of renderTable is not available outside of it. Instead you could assign it to the reactive values you set up. Below is a working example (note that I have tried to replicate your code so the data will not be available until you click on "Upload CSV", which here just calls mtcars).
library(shiny)
ui = fluidPage(
sidebarPanel(
actionButton(inputId = "uploadCsv", label = "Upload CSV:", icon = icon("upload")),
selectInput(inputId = "preProc", label = "Pre-processing", choices = c("Mean"=1,"Sum"=2)),
downloadButton("downloadData", label = "Download table")
),
mainPanel(
h4("My table:"),
tableOutput("contents")
)
)
server <- function(input, output) {
rvals <- reactiveValues(
csv=NULL,
x=NULL
)
observeEvent(input$uploadCsv,{
rvals$csv <- mtcars # using example data since I don't have your .csv
# rvals$csv <- read.csv(input$file_1$datapath, header = TRUE)
#some data processing here
})
output$contents <- renderTable({
# Assuing the below are functions applied to your data
req(
input$preProc,
!is.null(rvals$csv)
)
if(input$preProc == 1){
rvals$x <- data.frame(t(colMeans(mtcars)))
}else {
rvals$x <- data.frame(t(colSums(mtcars)))
}
return(rvals$x)
},digits = 4)
output$downloadData <- downloadHandler(
filename = "myFile.csv",
content = function(file){
write.csv(rvals$x, file)
}
)
}
shinyApp(ui,server)
EventReactive already outputs a reactive value, you don't need to create an extra reactiveVal, see example below :
library(shiny)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Test"),
mainPanel(
actionButton("show", "Download"),
textOutput("result")
)
)
server <- function(input, output) {
csvfile <- eventReactive(req(input$show), ignoreNULL = T, {
"Content of file"
})
output$result <- reactive(
paste("result : ",csvfile()))
}
# Run the application
shinyApp(ui = ui, server = server)
I would also avoid to use <<-operator in a reactive expression.

Display the select file

I have written a code to read csv or excel file in shiny app. But what is happening is that, whatever I select first (say Excel file), the output is displayed. But once I switch to other (csv) the excel is still there and csv is not displayed. Not sure what wrong is there in the code. Could anyone please help me?
library(shinydashboard)
library(readxl)
ui <- dashboardPage(
dashboardHeader(title = "Loading data"),
dashboardSidebar(fileInput("datafile","Choose the csv file",multiple = TRUE,
accept = c("text/csv","text/comma-separated-values,text/plain",".csv")),
("Or"),
fileInput("datafile1","Choose the excel file",multiple = TRUE,
accept = c(".xlsx"))),
dashboardBody(
fluidRow(box(uiOutput("filter_70"),width = 5000))
))
server <- function(input,output){
output$contents <- renderTable({
file_to_read <- input$datafile
if(is.null(file_to_read))
return(NULL)
read.csv(file_to_read$datapath)
})
output$contents1 <- renderTable({
file_to_read1 <- input$datafile1
if(is.null(file_to_read1))
return(NULL)
read_excel(file_to_read1$datapath)
})
output$filter_70 <- renderUI(
if (!is.null(input$datafile)) {
tableOutput("contents")
} else if (!is.null(input$datafile1)) {
tableOutput("contents1")
}
)
}
shinyApp(ui, server)
as pointed out by #Rohit, reactive value once gets selected, it won't go back to null.
Keep your main structure unchanged, all you need is to monitor which file last changed. This requires creating a reactiveVal (last_selected) and then use observeEvent to track.
last_selected <- reactiveVal(NA)
observeEvent(input$datafile, {
last_selected("csv")
})
observeEvent(input$datafile1, {
last_selected("excel")
})
output$filter_70 <- renderUI({
req(last_selected())
if (last_selected()=="csv") {
tableOutput("contents")
} else if (last_selected()=="excel") {
tableOutput("contents1")
}
})

shiny download csv or excel depending on radioButton

Download as excel or csv based on user input. The code works only for the pre-selected value in radioButtons. As below it works for csv, because selected = "csv". If it is changed to xlsx it only works for xlsx. The user should be able to select and both options should be possible.
Maybe the value is cached and I need to force an update somehow.
library(shiny)
ui <- fluidPage(
h4("Download data"),
wellPanel(
fluidRow(
column(4, radioButtons("dl_data_file_type", "Format",
choices = c(excel = "xlsx",
csv = "csv"),
selected = "csv")),
column(5),
column(3, downloadButton("dl_data_dwnld_bttn"))
)))
server <- function(input, output) {
output$dl_data_dwnld_bttn <- {
downloadHandler(
filename = stringr::str_c(Sys.Date(), " Palim.", input$dl_data_file_type),
content = function(file){
x <- iris
if ( input$dl_data_file_type == "xlsx") {
writexl::write_xlsx(x, file)}
else if ( input$dl_data_file_type == "csv") {
readr::write_csv(x, file)}
})}}
shinyApp(ui = ui, server = server)
The error is that the excel file still ends with .csv and cannot be opened by excel.
You are using a reactive value in the filename argument. In this case, you have to set filename as a function:
filename = function(){
stringr::str_c(Sys.Date(), " Palim.", input$dl_data_file_type)
}

Download table generated independetly in renderTable output in R shiny

I am trying to generate a table using the renderTable function in R shiny and then use the downloadHandler function to download that table/data.frame as a csv file. Somehow I keep getting the following error:
An error occured during download:
Error downloading http://127:0:0.1:3001/session/
0303bd426fce88837ae277aa3b406dd/download/downloadData?w= - server
replied: Internal Server Error
Below is an example code where I generate a simple data frame and try to download it using downloadHander:
library(shiny)
# Define UI for data download app ----
ui <- fluidPage(
# App title ----
titlePanel("Downloading Data"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Button
downloadButton("downloadData", "Download")
),
# Main panel for displaying outputs ----
mainPanel(
tableOutput("table")
)
)
)
# Define server logic to display and download selected file ----
server <- function(input, output) {
# Table of selected dataset ----
output$table <- renderTable({
data.frame(a =c(1,2,3),b=c("q","s","f"))
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
paste("test.csv")
},
content = function(file) {
write.csv(output$table, file, row.names = FALSE)
}
)
}
shinyApp(ui,server)
There are a few things that need to be done here:
If your app is going to render data dynamically, then your data should be assigned to some reactive expression.
Now the downloading of the data becomes easy, as you just call the reactive expression written in (1).
Points (1) and (2) above will ensure that the user is downloading the same data that is seen on the screen.
Try the following:
library(shiny)
ui <- fluidPage(
titlePanel("Downloading Data"),
sidebarLayout(
sidebarPanel(downloadButton("downloadData", "Download")),
mainPanel(tableOutput("table"))
)
)
server <- function(input, output) {
data <- shiny::reactive(data.frame(a = c(1, 2, 3), b = c("q", "s", "f")))
output$table <- renderTable(data())
output$downloadData <- downloadHandler(
filename = function() {
paste("test.csv")
},
content = function(file) {
write.csv(data(), file, row.names = FALSE)
}
)
}
shinyApp(ui,server)
You cannot export a renderTable{} as this puts many of the elements into HTML,
you need to previously save the data going into the table and export it
seperately.
dataTable<-data.frame(a =c(1,2,3),b=c("q","s","f"))
output$downloadData <- downloadHandler(
filename = function() {
('test.csv')
},
content = function(con) {
write.table(dataTable,row.names = FALSE,col.names=T, sep=",",con)
},
contentType="csv"
)

r shiny: How to print a message in the app after the user forgets to upload a file?

I am building a rudimentary shiny app.
First, I created a data frame 'x' and saved it in my working directory:
x <- data.frame(a = 1:4, b = 2:5)
write.csv(x, 'x.csv', row.names = F)
In my shiny I'd like to:
Upload file 'x.csv'
Click my action button 'Click Here' and run a few commands upon clicking it.
Get a message printed in the Shiny app itself: "Load a file!" if I click on my button "Click here" after forgetting to upload the file first.
My code works, but I can't figure out how to make my message appear.
My code:
library(shiny)
ui <- fluidPage(
br(),
# User should upload file x here:
fileInput("file_x", label = h5("Upload file 'x'!")),
br(),
# Users clicks the button:
actionButton("do_it", "Click Here"),
br(),
# Print last value of the button 'do_it':
verbatimTextOutput("print_action")
)
server <- function(input, output, session) {
observeEvent(input$do_it, {
# Just a check of my button's actions:
output$print_action <- renderPrint({input$do_it})
# Validating the input - next 5 lines are not working:
# validate(
# need(
# try(is.null(input$file_x), "Load a file!")
# )
# )
# Reading in the file:
fileData <- reactive({
infile <- input$file_x
if (is.null(infile)) {
return(NULL)
}
read.csv(infile$datapath)
})
x <- fileData()
# Writing out the same file - but under a different name:
filename <- paste0("x", input$do_it, ".csv")
write.csv(x, file = filename, row.names = FALSE)
})
}
shinyApp(ui, server)
I think rather than displaying text, maybe modalDialog is better suited for what you are trying to achieve. I have implemented both solutions below, so you can compare.
Note that I also modified the reading of the csv slightly. It is bad practice to set a reactive from inside an observer. In those cases, it is better to use a reactiveVal, and update that from an observer.
Hope this helps!
library(shiny)
ui <- fluidPage(
br(),
# User should upload file x here:
fileInput("file_x", label = h5("Upload file 'x'!")),
br(),
# Users clicks the button:
actionButton("do_it", "Click Here"),
br(),
br(),
# Print last value of the button 'do_it':
verbatimTextOutput("print_action")
)
server <- function(input, output, session) {
observeEvent(input$do_it, {
if(is.null(input$file_x))
{
# show pop-up ...
showModal(modalDialog(
title = "Oh no!",
paste0("You have not uploaded a file, silly person!"),
easyClose = TRUE,
footer = NULL
))
# ... or update the text
my_text('Please upload a file.')
}
else
{
# Reading in the file:
infile <- input$file_x
if (is.null(infile)) {
return(NULL)
}
x <- read.csv(infile$datapath)
fileData(x) # set the reactiveVal called fileData to the file inputs.
# Writing out the same file - but under a different name:
filename <- paste0("x", input$do_it, ".csv")
write.csv(x, file = filename, row.names = FALSE)
my_text('Succes!')
}
})
fileData <- reactiveVal()
my_text <- reactiveVal('')
output$print_action <- renderText({my_text()})
}
shinyApp(ui, server)

Resources