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)
}
Related
I'm building an app that takes excel files as an input. To protect against errors, I first check if the file is an .xls or .xslx, and then I check if it contains the right content based on the sheet names.
I'm encountering that the first time I upload the right file, the app works as expected:
But when I hit 'browse' and try to upload again, I get this:
It only shows the right label on the first time.
This doesn't happen if I upload an excel file with the wrong info multiple times
If I then try to upload a different type of file, I get this:
Here's the simple code
library(shiny)
library(readxl)
library(tools)
library(shinyFeedback)
ui <- fluidPage(
useShinyFeedback(),
fileInput("file", "upload file", multiple = FALSE),
tableOutput("data")
)
server <- function(input, output, session) {
data <- reactive({
req(input$file)
path <- input$file$datapath
good_file <- file_ext(path) == "xls" || file_ext(path) == "xlsx"
feedbackDanger(inputId = "file",
show=!good_file,
color = "orange",
text = "Upload only .xls or .xlsx files")
req(good_file)
good_sheet <- "Special Sheet" %in% excel_sheets(path)
feedbackDanger(inputId = "file",
show=!good_sheet,
color = "#E6007E",
text = "File must contain the special sheet'")
req(good_sheet)
read_excel(path)
})
output$data = renderTable(data())
}
shinyApp(ui, server)
Not sure, but perhaps this is due to the fact that the two feedbacks are the same.
Here is a solution:
server <- function(input, output, session) {
data <- reactive({
req(input$file)
hideFeedback("file") # hide feedback, if any
path <- input$file$datapath
good_file <- file_ext(path) == "xls" || file_ext(path) == "xlsx"
if(!good_file){
showFeedbackDanger(inputId = "file",
color = "orange",
text = "Upload only .xls or .xlsx files")
}
req(good_file)
good_sheet <- "Special Sheet" %in% excel_sheets(path)
if(!good_sheet){
showFeedbackDanger(inputId = "file",
color = "#E6007E",
text = "File must contain the special sheet'")
}
req(good_sheet)
read_excel(path)
})
output$data = renderTable(data())
}
I have an excel file called testfile.xlsx. the first sheet of this file is called sheet1.
I have written appended a new sheet called New_Sheet using xlsx package as follows
library(xlsx)
setwd()##set the file path to where testfile.xlsx is located
write.xlsx('new_data', "testfile.xlsx", sheetName="New_Sheet", append=TRUE)
This adds the required sheet.
I have created the following shiny app to write the sheet to the file
library(shiny)
library(xlsx)
library(openxlsx)
library(readxl)
ui <- fluidPage(
titlePanel("Writer App"),
sidebarLayout(sidebarPanel(fileInput(inputId = "file", label = "Read File Here", accept =
c(".xlsx")),actionButton(inputId = "Run", label = "Write Data to Table")),
mainPanel(dataTableOutput(outputId = "table1"))))
server <- function(input, output) {
datasetInput <- reactive({
infile<- input$file
if (is.null(infile))
return(NULL)
#READ .XLSX AND .CSV FILES
if(grepl(infile, pattern = ".xlsx" )==T){
data=read_excel(infile$datapath)
} else if(grepl(infile , pattern = ".csv" )==T)
{data=read.csv(infile$datapath )}
#RENAME DATAFRAME WITH UNDERSCORES
names(data)<-gsub(pattern = " ", replacement = "_", x = names(data))
return(data) })
output$table1 <- renderDataTable({
datasetInput()})
observeEvent(input$Run,{
infile<-input$file
testfile<-(infile[1])
filepath<-(input$file)
filepath<-gsub(pattern = "0.xlsx", replacement ="" , x = filepath)
# print(infile$datapath[1])
print(filepath)
print(testfile)
setwd(dir = filepath)
write.xlsx('new_data', testfile, sheetName="New_Sheet3", append=TRUE)})
}
shinyApp(ui = ui, server = server)
The app renders the data in the excel sheet as a table without any problems
.When we push the run app button, the print commands generate the name of the file and the filepath. The write excel function doesnt work. Is there a way to insert the new_data sheet using the action button. I request someone to guide me here.
I recommend using downloadHandler instead. See here for an example.
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.
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.
I wanted to create a shiny app that gets data from user and saves it in .csv formats. But each time the user enters the data past data is not removed so when appending all the previous data(not necessarily for same user) gets appended with the new data that has been entered. I wanted to create a new "new" button which deletes past input data and gives a new table for input.
library(shiny)
ui <- fluidPage(
titlePanel("Creating a database"),
sidebarLayout(
sidebarPanel(
textInput("name", "Company Name"),
textInput("income", "Income"),
textInput("expenditure", "Expenditure"),
dateInput("date", h3("Date input"),value = Sys.Date() ,min = "0000-01-01",
max = Sys.Date(), format = "dd/mm/yy"),
actionButton("Action", "Submit"),#Submit Button
actionButton("new", "New")),
mainPanel(
tableOutput("table"), #Table showing what is there in the data frame
textInput("filename", "Enter Filename for download"), #filename
helpText(strong("Warning: Append if want to update existing data.")),
downloadButton('downloadData', 'Download'), #Button to save the file
downloadButton('Appenddata', 'Append') #Button to update a file
)
)
)
# Define server logic
server <- function(input, output){
#Global variable to save the data
Data <- data.frame()
Results <- reactive(data.frame(input$name, input$income, input$expenditure,
as.character(input$date),
as.character(Sys.Date())))
#To append the row and display in the table when the submit button is clicked
observeEvent(input$Action,{
#Append the row in the dataframe
Data <<- rbind(Data,Results())
#Display the output in the table
output$table <- renderTable(Data)
})
observeEvent(input$new, {
UpdateInputs(CreateDefaultRecord(), session)
})
output$downloadData <- downloadHandler(
# Create the download file name
filename = function() {
paste(input$filename , ".csv", sep="")
},
content = function(file) {
write.csv(Data, file,row.names = FALSE) # put Data() into the download file
})
output$Appenddata <- downloadHandler(
# Append data
filename = function() {
paste(input$filename, ".csv", sep="")
},
content = function(file) {
write.table( Data, file=file.choose(),append = T, sep=',',
row.names = FALSE, col.names = FALSE)
})
}`enter code here`
# Run the application
shinyApp(ui = ui, server = server)
The code works perfectly and i can enter new data as and when i want fine but when i press the "new" button so as to clear the data so that i want to enter new set of details the app closes down giving the following error
Warning: Error in UpdateInputs: could not find function "UpdateInputs"
The warning does not close the app until the new button is pressed. What is it that i am missing? Please help. Thank You.
If you just want to clear the data you could substitute
observeEvent(input$new, {
UpdateInputs(CreateDefaultRecord(), session)
})
with
observeEvent(input$new, {
#Append the row in the dataframe
Data <<- NULL
#Display the output in the table
output$table <- renderTable(Data)
})
although I'm not sure why you are saving Data globally using <<- and this method would obviously clear it.