I am building a shiny app where I am trying to put a download button which will ask user to choose name while saving the file. In below example, when user clicks on download button, it automatically downloads the file without asking user for the filename.
ui <- fluidPage(
# App title ----
titlePanel("Downloading Data"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Choose dataset ----
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars")),
# Button
downloadButton("downloadData", "Download")
),
# Main panel for displaying outputs ----
mainPanel(
tableOutput("table")
)
)
)
server
server <- function(input, output) {
# Reactive value for selected dataset ----
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
# Table of selected dataset ----
output$table <- renderTable({
datasetInput()
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
paste(input$dataset, ".csv", sep = "")
},
content = function(file) {
write.csv(datasetInput(), file, row.names = FALSE)
}
)
}
shinyApp(ui,server)
Let me know if anyone has some idea.
A simplistic way to take in file name. It does need another TextInput
ui <- fluidPage(
# App title ----
titlePanel("Downloading Data"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Choose dataset ----
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars")),
textInput("file_name_input", "enter file name",placeholder = "Default"),
# Button
downloadButton("downloadData", "Download")
),
# Main panel for displaying outputs ----
mainPanel(
tableOutput("table")
)
)
)
server
server <- function(input, output) {
# Reactive value for selected dataset ----
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
# Table of selected dataset ----
output$table <- renderTable({
datasetInput()
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
paste(input$file_name_input, ".csv", sep = "")
},
content = function(file) {
write.csv(datasetInput(), file, row.names = FALSE)
}
)
}
shinyApp(ui,server)
Related
This is my code:
library(shiny)
ui <- fluidPage(
data<- iris[1,] %>% mutate(download = 1),
reactable(data,
columns = list(
download = colDef(cell = icon_assign(data, icon = "download"))))
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
How can I make this table downloadable by clicking on the download icon ?
You need to have some stuff in your server function. Below is a template you can take from. Main takeaways: download button in ui, add server info for the download button
ui <- fluidPage(
# App title ----
titlePanel("Downloading Data"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Choose dataset ----
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars")),
# Button
downloadButton("downloadData", "Download")
),
# Main panel for displaying outputs ----
mainPanel(
tableOutput("table")
)
)
)
server <- function(input, output) {
# Reactive value for selected dataset ----
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
# Table of selected dataset ----
output$table <- renderTable({
datasetInput()
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
paste(input$dataset, ".csv", sep = "")
},
content = function(file) {
write.csv(datasetInput(), file, row.names = FALSE)
}
)
}
I am new to R shiny and I hope someone can please guide me in the right direction.
I want the user to be able to select one or multiple datasets to download.
Code works when I put the multiple=F in selectInput but when I change it to TRUE, I get the error below:
"Warning: Error in switch: EXPR must be a length 1 vector"
Any help will be greatly appreciated as I am stuck on this for days.
Thank you
library(shiny)
library(openxlsx)
# 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(
# Input: Choose dataset ----
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars"), multiple=T),
# 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) {
# Reactive value for selected dataset ----
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
# Table of selected dataset ----
output$table <- renderTable({
datasetInput()
})
# Downloadable xlsx of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
"selected.xlsx"
},
content = function(filename) {
write.xlsx(datasetInput(), file = filename, rowNames = FALSE)
}
)
}
# Create Shiny app ----
shinyApp(ui, server)
In order to display several datasets, you can create a module (it is like creating a smaller shiny app inside your shiny app that you can call with parameters, just like a function). Here I created a module to display a table, with a dataframe as parameter.
For the download, I followed the link I gave you previously.
library(shiny)
#Using module
mod_export_table_ui <- function(id){
ns <- NS(id)
tagList(
tableOutput(ns("table_export"))
)
}
mod_export_table_server <- function(input, output, session, df_export){
ns <- session$ns
output$table_export <- renderTable({
df_export
})
}
# 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(
# Input: Choose dataset ----
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars"), multiple=T),
# Button
downloadButton("downloadData", "Download")
),
# Main panel for displaying outputs ----
mainPanel(
uiOutput("tables")
)
)
)
# Define server logic to display and download selected file ----
server <- function(input, output, session) {
rv <- reactiveValues()
#List of datasets
observeEvent(input$dataset, {
req(input$dataset)
rv$lst_datasets <- lapply(
1:length(input$dataset),
function(i) {
head(eval(parse(text =input$dataset[i])))
}
)
})
# Module UIs
output$tables <- renderUI({
req(rv$lst_datasets)
lapply(
1:length(rv$lst_datasets),
function(i) {
mod_export_table_ui(id = paste0("table", i))
}
)
})
# Module Servers
observeEvent(rv$lst_datasets, {
req(rv$lst_datasets)
lapply(
1:length(rv$lst_datasets),
function(i) {
callModule(
module = mod_export_table_server,
session = session,
id = paste0("table", i),
df_export = rv$lst_datasets[[i]]
)
}
)
})
output$downloadData <-downloadHandler(
filename = "Downloads.zip",
content = function(file){
withProgress(message = "Writing Files to Disk. Please wait...", {
temp <- setwd(tempdir())
on.exit(setwd(temp))
files <- c()
for(i in 1:length(rv$lst_datasets)){
writexl::write_xlsx(rv$lst_datasets[[i]],
path = paste0("dataset",i, ".xlsx")
)
files <- c(files, paste0("dataset",i, ".xlsx"))
}
zip(zipfile = file, files = files)
})
}
)
}
# Create Shiny app ----
shinyApp(ui, server)
I'm trying to download a data frame as a .csv format into a particular folder. But in my case whenevver I click on download button the data get downloaded into 'download' folder of C drive.
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(
# Input: Choose dataset ----
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars")),
# 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) {
# Reactive value for selected dataset ----
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
# Table of selected dataset ----
output$table <- renderTable({
datasetInput()
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
paste(input$dataset, ".csv", sep = "")
},
content = function(file) {
write.csv(datasetInput(), file, row.names = FALSE)
}
)
}
# Create Shiny app ----
shinyApp(ui, server)
I also tried the same for a plot. I used file.copy() to save the file into the desired location but it's also not working.
If you want to save your file into a desired location, I think this command should work:
output$downloadData <- downloadHandler(
filename = function() {
paste(setwd(),input$dataset, ".csv", sep = "")
The function setwd() allows you to write a path. So put your folder between (), and pay attention about your actual working directory, by using getwd().
Hope it will help.
I would like to ask if there is a way to display a loading message before the file is finally downloaded in my shiny app. My original dataset is big and I guess this is the reason for this delay. Below I attach a toy example in case someone can apply the reuested solution on this.
#ui.r
ui <- fluidPage(
# App title ----
titlePanel("Downloading Data"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Choose dataset ----
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars")),
# Button
downloadButton("downloadData", "Download")
),
# Main panel for displaying outputs ----
mainPanel(
tableOutput("table")
)
)
)
#server.r
server <- function(input, output) {
# Reactive value for selected dataset ----
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
# Table of selected dataset ----
output$table <- renderTable({
datasetInput()
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
paste(input$dataset, ".csv", sep = "")
},
content = function(file) {
write.csv(datasetInput(), file, row.names = FALSE)
}
)
}
I have implemented a solution based on your code. What you need to do is add a progress bar inside your downloadhandler().
library(shiny)
ui <- fluidPage(
# App title ----
titlePanel("Downloading Data"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Choose dataset ----
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars")),
# Button
downloadButton("downloadData", "Download")
),
# Main panel for displaying outputs ----
mainPanel(
tableOutput("table")
)
)
)
#server.r
server <- function(input, output) {
# Reactive value for selected dataset ----
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
# Table of selected dataset ----
output$table <- renderTable({
datasetInput()
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
paste(input$dataset, ".csv", sep = "")
},
content = function(file) {
shiny::withProgress(
message = paste0("Downloading", input$dataset, " Data"),
value = 0,
{
shiny::incProgress(1/10)
Sys.sleep(1)
shiny::incProgress(5/10)
write.csv(datasetInput(), file, row.names = FALSE)
}
)
}
)
}
shiny::shinyApp(ui = ui, server = server)
You can tailor this solution to your requirements (customize message, add loop etc). I hope this helps :-)
I have a simple shiny app below. In this app I want the user to be able to upload his own csv and then automatically this will be added as a choice in the checkbox group below the other dataset "D.B" (which I create in my original app).
#ui.r
ui <- fluidPage(
# App title ----
titlePanel("Uploading Files"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select a file ----
fileInput("file1", "Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
uiOutput("checkbox"),
textInput("filename","Set Filename")
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
tableOutput("contents")
)
)
)
#server.r
server <- function(input, output) {
output$contents <- renderTable({
req(input$file1)
df <- read.csv(input$file1$datapath)
})
D.B <- reactive({
#some code that creates the dataset D.B.
})
output$checkbox<-renderUI({
checkboxGroupInput("datasetSelector","Specify the datasets to compare:", choices = c("D.B")
)
})
}
You could use a reactive value to store choices then add a choice everytime a file is uploaded. Use an observer to watch for file uploads (I also used the library rlist which gives me the append method).
library(rlist)
#ui.r
ui <- fluidPage(
# App title ----
titlePanel("Uploading Files"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select a file ----
fileInput("file1", "Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
uiOutput("checkbox"),
textInput("filename","Set Filename")
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
tableOutput("contents")
)
)
)
#server.r
#fileOptions = list("D.B.")
server <- function(input, output, session) {
output$contents <- renderTable({
req(input$file1)
df <- read.csv(input$file1$datapath)
head(df)
})
fileOptions <- reactiveValues(currentOptions=c("D.B."))
observeEvent(input$file1, {
fileOptions$currentOptions = list.append(fileOptions$currentOptions, input$file1$datapath)
})
D.B <- reactive({
#some code that creates the dataset D.B.
})
output$checkbox<-renderUI({
checkboxGroupInput("datasetSelector","Specify the datasets to compare:", choices = fileOptions$currentOptions
)
})
}