Download table generated independetly in renderTable output in R shiny - r

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"
)

Related

How to create a Shiny-app that selects from multiple dfs, edits one and downloads edited data

I try to create a shiny app in which one can choose from different dfs. Then one can edit values in the table. At last I would like to download the edited table.
Each step for itself , edit and download, select and download is no problem. All three together: great despair.
I don't seem to understand how Shiny updates the reactive values and how you can cut it off with isolate.
library(shiny)
library(DT)
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),
actionButton(inputId = "goButton",
label = "Run Report"),
# downloadbutton
downloadButton("downloadData", "Download")
),
# Main panel for displaying outputs ----
mainPanel(
DTOutput("x1")
)
)
)
#df <- cars #if this is taken instead of the first "eventReactive" it works
server <- function(input, output) {
eventReactive({
# Take a dependency on input$goButton
input$goButton
# Use isolate() to avoid dependency on input$obs
df <- isolate(input$dataset)
})
#render the editable DT
output[["x1"]] <- renderDT({
datatable(
df,
selection = "single",
editable = TRUE
)
})
# Creating a DF with the edited info
aniRoi2 <- reactiveVal(df)
#Creating proxy
proxy <- dataTableProxy("x1")
#storing edited df in proxy
observeEvent(input[["x1_cell_edit"]], {
info <- input[["x1_cell_edit"]]
newAniroi2 <-
editData(aniRoi2(), info, proxy, rownames = TRUE, resetPaging = FALSE)
aniRoi2(newAniroi2)
saveRDS(newAniroi2, "data_entry_form.rds") # save rds
})
#download the proxy
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(aniRoi2(), file)
}
)
}
shinyApp(ui, server)
Here I try to select a dataset, that only gets loaded by press of a button. Then it should behave like a normal data.frame or tibble.
If I take out the possibilty of selection of dataframes and call between "ui" and "server" "df <- cars" then it works as intended.
As of now I get the error message:
Listening on http://127.0.0.1:4060
Warnung: Error in is_quosure: Argument "expr" fehlt (ohne Standardwert)
52: is_quosure
51: exprToQuo
50: eventReactive
49: server [#2]
3: runApp
2: print.shiny.appobj
1:
Error in is_quosure(expr) : Argument "expr" fehlt (ohne Standardwert)
Thank you very much, any help would be much appreciated. It feels as if I am so close (but it feels like that since a week).
I also tried this download edited data table gives warning in shiny app it uses observe to wrap the selection. But in the shiny-app I get the familiar "Error 'data' must be 2-dimensional (e.g. data frame or matrix)"
PS: If you would forgive a bonus question: How do you debug shiny? I mean how can you see inside of what is happening, how the environment looks like and which processes are working?
There are some issues with your code. First, input$dataset is a character string with the name of the chosen dataset, not the dataset itself. To get the dataset use e.g. get(input$dataset). Second, the way you use eventReactive is interesting. (; Overall I would go for an observeEvent to init your reactiveVal aniRoi2 with the chosen dataset. Finally I have set multiple=FALSE in your selectInput as choosing multiple df's breaks your code and allowing the user to select multiple dfs makes no sense to me. (I guess that you have done this to get rid of the pre-selected value?? )
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("Downloading Data"),
sidebarLayout(
sidebarPanel(
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars"), multiple = FALSE
),
actionButton(
inputId = "goButton",
label = "Run Report"
),
downloadButton("downloadData", "Download")
),
mainPanel(
DTOutput("x1")
)
)
)
server <- function(input, output) {
aniRoi2 <- reactiveVal()
observeEvent(input$goButton, {
aniRoi2(get(input$dataset))
})
output[["x1"]] <- renderDT({
datatable(
aniRoi2(),
selection = "single",
editable = TRUE
)
})
proxy <- dataTableProxy("x1")
observeEvent(input[["x1_cell_edit"]], {
info <- input[["x1_cell_edit"]]
newAniroi2 <-
editData(aniRoi2(), info, proxy, rownames = TRUE, resetPaging = FALSE)
aniRoi2(newAniroi2)
})
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep = "")
},
content = function(file) {
write.csv(aniRoi2(), file)
}
)
}
shinyApp(ui, server)

Download a table created in Shiny

I need to give users a set of 60 observations. I have a master table that I want to to subset these 60 observations from. So, (1) I host the master table as a published csv file on google drive. (2) Write a shiny code to subset 60 values in R studio. The user will have to enter a group ID that I use as set.seed and ensure that the user sees the same subset every time he / she attempts to get the 60 observations. And, it also helps me keep track of the observations that the user has.
The code works fine and I am able to show the subset table. But, I am not able to get the download to work. I saw a post that says renderTable create an HTML table that cannot be downloaded and I should create the table outside it. I tried using reactive to do this, but it did not work and kept giving various errors. For example:
"cannot coerce class ‘c("reactiveExpr", "reactive", "function")’ to a data.frame"
Will appreciate any help of this - even if someone can please point out to what I should read and try to make this work.
library(shiny)
db1 <- read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vS94xYLix6bDUNNXAgHejdQ-CcWi-G4t25nfxuhRZF57TloC8NwVgnperBB9-U-IuDvMcOnvdc9iavU/pub?gid=0&single=true&output=csv")
# Define UI
ui <- fluidPage(
# Application title
titlePanel("MnM"),
# Sidebar to take input of group ID
sidebarLayout(
sidebarPanel(
numericInput("seed","Group ID:", value = 100, min = 100, max = 999),
downloadButton("downloadData", "Download")
),
# Show the table
mainPanel(
tableOutput("table")
)
)
)
# Define server logic for the table
server <- function(input, output) {
output$table <- renderTable({
set.seed(input$seed)
zz <- sample(1:nrow(db1), size = 60, replace = TRUE)
data.frame(db1[zz,])})
output$downloadData <- downloadHandler(
filename = "test.csv",
content = function(file) {
write.csv(output$table, file, row.names = FALSE)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
Create your table once, and then use it in your renderTable and downloadHandler. Create it as a reactive, so its available everywhere.
Note that downloadHandler doesn't work in RStudio's preview, view it in a browser instead. There is a button labelled 'Open in Browser' that will do this.
Here is your code with that applied:
library(shiny)
db1 <- read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vS94xYLix6bDUNNXAgHejdQ-CcWi-G4t25nfxuhRZF57TloC8NwVgnperBB9-U-IuDvMcOnvdc9iavU/pub?gid=0&single=true&output=csv")
# Define UI
ui <- fluidPage(
# Application title
titlePanel("MnM"),
# Sidebar to take input of group ID
sidebarLayout(
sidebarPanel(
numericInput("seed","Group ID:", value = 100, min = 100, max = 999),
downloadButton("downloadData", "Download")
),
# Show the table
mainPanel(
tableOutput("table")
)
)
)
# Define server logic for the table
server <- function(input, output) {
#Create dataframe
mytable <- reactive({
set.seed(input$seed)
zz <- sample(1:nrow(db1), size = 60, replace = TRUE)
data.frame(db1[zz,])
})
#Display dataframe in table
output$table <- renderTable({
mytable()
})
#Download dataframe
output$downloadData <- downloadHandler(
filename = "test.csv",
content = function(file) {
write.csv(mytable(), file, row.names = FALSE)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)

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.

How to automatically navigate to another sidebar after data is uploaded in a sidebar within Shinydashboard?

Hello Shiny dashboard experts,
Following reprex works.
i.e. Once the file is uploaded in sidebar: mod1,
we can navigate to sidebar: mod2 and see the uploaded data displayed.
Below is the code:
1. Module to display with its UI
2. Module to read data with its UI
Server and UI for calling modules.
Can we automate this ?
i.e. Once the data is uploaded in sidebar: mod1,
sidebar: mod2 should be seen to the user with uploaded data.
library(shiny)
library(tidyverse)
# Module UI to read content
mod_readUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
fileInput(ns("file1"),
h3("Choose xlsx file"),
accept=c(".xlsx")),
actionButton(ns("ref"), "Refresh")
)
}
# Server modules of reading content
mod_read <- function(input, output, session){
# Uploaded data as reactive element
getData <- reactive({
req(input$file1) # Ensure file is uploaded
if(!is.null(input$file1)){
my_data <- readxl::read_excel(input$file1$datapath)
my_data
}
else{
my_data <- "nothing" %>% as.data.frame()
my_data
}
})
### In order to pass data as reactive elements to other module:
# Created list
reactive({
# browser()
list("excl" = getData())
})
}
# Module UI to display content
mod_displayUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
DT::dataTableOutput(ns("contents"))
)
}
# Server functions
mod_display <- function(input, output, session, file) {
output$contents <- DT::renderDataTable({
req(file())
DT::datatable(file()$excl,
options = list(pageLength = 7,scrollX = TRUE))
})
}
ui <-
shinydashboard::dashboardPage(
shinydashboard::dashboardHeader(),
shinydashboard::dashboardSidebar(
shinydashboard::sidebarMenu(id = "menu1",
shinydashboard::menuItem('mod1',
tabName = 'mod1',
icon = shiny::icon('file')),
shinydashboard::menuItem('mod2',
tabName = 'mod2',
icon = shiny::icon('file'))
)),
shinydashboard::dashboardBody(
shinydashboard::tabItems(
shinydashboard::tabItem("mod1",
mod_readUI("sidemod1")),
shinydashboard::tabItem("mod2",
mod_displayUI("bodymod2")
)
)))
server <- function(input, output) {
# storing mod_read in a variable
readFile1 <- shiny::callModule(mod_read, "sidemod1")
# passing the output of readFile into mod_display module
displayFile <- shiny::callModule(mod_display, "bodymod2", file = readFile1)
}
shinyApp(ui,server)
I suppose you can add an observe to see when the sidemod1-file1 input is not NULL or changes. When that happens, you can use updateTabItems. Note you need to have session as a server function argument as well.
server <- function(input, output, session) {
# storing mod_read in a variable
readFile1 <- shiny::callModule(mod_read, "sidemod1")
# passing the output of readFile into mod_display module
displayFile <- shiny::callModule(mod_display, "bodymod2", file = readFile1)
observe({
req(input$`sidemod1-file1`)
updateTabItems(session, "menu1", "mod2")
})
}

R shiny - having trouble with file download

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.

Resources