Shiny DownloadHandler unable to save .csv file - r

I'm trying to download my datatable into, a csv. file. Unfortuantely, even though the download starts, it's stuck with calculating and doesn't save the data. The file size is 8mb large and I only could workaround this issue with downloading only the filtered dataset. I also tried setting the donload size to 10 mb with shiny.maxRequestSize=30*1024^2
I really need the option to save the whole dataset. If anyone could provide some insights I would much appreciate it (And yes, I run the App in the Browser)
my ui function looks like this:
tbl <- read.csv(file.choose(new = FALSE), header = TRUE, sep = ",", row.names=1)
ui <- navbarPage(
title = "Data Table Options",
#Tab with the dataset table
tabPanel("Lot Dataset",
div(h3("Download"), style = "color:blue"),
helpText(" Select the download format"),
radioButtons("type", "Format type:",
choices = c("Excel (CSV)", "Text (Space Separated)", "Doc")),
helpText(" Click on the download button to download the Lot Dataset"),
downloadButton("download_filtered", "Download Filtered Data"),
br(),
br(),
br(),
DT::dataTableOutput("dt"), #datatable
),
)
my server function like this:
server <- function(session, input, output) {
#Increasing Downloadsize to 10MB
options(shiny.maxRequestSize=10*1024^2)
#render the datatable
output$dt <- DT::renderDataTable({
datatable(tbl, filter = "top", options = list(
lengthMenu = list(c(25, 50, 100, -1), c("25", "50", "100", "All")),
pageLength = 25))
})
#bottom panel with row indices
output$filtered_row <-
renderPrint({
input[["dt_rows_all"]]
})
#file extension for download
fileext <- reactive({
switch(input$type,
"Excel (CSV)" = "csv", "Text" = "txt", "Doc" = "doc")
})
#downloadHandler() for file download of Lot Dataset
output$download_filtered <- downloadHandler(
filename = function() {
paste("MLdataset_test", fileext(), sep=".") #filename
},
content = function(file) {
#write tbl with filter
write.csv(tbl[input[["dt_rows_all"]], ],
file = file, row.names = F)
}
)
}
Any help appreciated!!!

Related

How to upload a table with a R shiny app in two different excluding processes using the same variable name

I have developed a quite complex Shiny app that helps the user filter an uploaded table of genetics variants. So that, the user can upload a table, apply different filters and see the variants remaining. Now I would like the user to be able to upload the table in two different and excluding ways:
First: the table is straightaway uploaded by the user with fileInput.
Second: the user presses a button that makes the table being applied a series of changes with a python program that works outside shiny, then a processed table is created for the session and uploaded for filtering with another button.
Both options result in an uploaded table that can be filtered with my program, so I would like to conserve same the variable name in both cases. Both processes work perfectly when the other is commented, however I would like to have both uploading options available for the user. Due to the complexity of the program I cannot show a totally reproducible example here, but I can show you the part of the code I want to work in.
library(shiny)
library(DT)
library(shinyWidgets)
library(shinyBS)
library(shinyFiles)
ui = fluidPage(
# Uploading variant table straight away with a file input (way 1):
fileInput("file1", "Upload your SNV File",
multiple = FALSE,
accept = c("text/csv", "text/comma-separated-values,text/plain", ".tsv")),
# User presses a button if changes previous to the upload want to be applied (way 2):
actionBttn(
inputId = "WGS",
label = "Analysis of WGS",
),
# User needs to fill a survey before the python program is launched:
bsModal("survey", "Select WGS data information","WGS",
prettyCheckbox(inputId="canonical_filters", label = "Canonical", value = TRUE),
shinyFilesButton("Btn_GetFile", "Process WGS variant file", title = "WGS variant file:", multiple = FALSE),
actionButton("EnterWGS", "Read file")),
# Table is rendered
DTOutput("contents")
)
server <- function(input, output, session) {
# Datatable is uploaded straight away (WAY 1)
df <- reactive({
req(input$file1)
df <- read.table(input$file1$datapath, fill = TRUE, quote = "", header = TRUE,
sep = '\t', na.strings=c("",".","NA"), colClasses = NA)
})
# The path of the file where the changes are going to be applied can be selected and the python program (process_file.py) is launched with the system function. A processed variant table is created for the session.
observeEvent(input$Btn_GetFile, {
volumes = getVolumes()
shinyFileChoose(input, "Btn_GetFile", roots=volumes, session = session, filetypes = c('', 'txt', "tsv", "csv"))
file_selected<-parseFilePaths(volumes, input$Btn_GetFile)
if (length(file_selected$datapath)!=0){
system('process_file.py', file_selected$datapath )
}
})
# The processed variant table is uploaded when the button is pressed (WAY 2)
df <- eventReactive(input$EnterWGS, {
df <- read.table('temp_file', fill = TRUE, quote = "", header = TRUE,
sep = '\t', na.strings=c("",".","NA"), check.names = FALSE, colClasses = NA)
}, ignoreNULL = T)
# Rest of the functions...
# Table renderization.
output$contents <- renderDT({
req(df())
datatable(
df(),
filter = "top",
class = "display nowrap compact",
escape = FALSE)},
server = FALSE)
}
shinyApp(ui, server)
I really hope this is understandable. Any help would be appreciated.
Thanks a lot,
Rachael
You can define a reactiveValues object to display which is set to table 1 or table 2. Try this
library(shiny)
library(DT)
library(shinyWidgets)
library(shinyBS)
library(shinyFiles)
ui = fluidPage(
# Uploading variant table straight away with a file input (way 1):
fileInput("file1", "Upload your SNV File",
multiple = FALSE,
accept = c("text/csv", "text/comma-separated-values,text/plain", ".tsv")),
# User presses a button if changes previous to the upload want to be applied (way 2):
actionBttn(
inputId = "WGS",
label = "Analysis of WGS",
),
# User needs to fill a survey before the python program is launched:
bsModal("survey", "Select WGS data information","WGS",
prettyCheckbox(inputId="canonical_filters", label = "Canonical", value = TRUE),
shinyFilesButton("Btn_GetFile", "Process WGS variant file", title = "WGS variant file:", multiple = FALSE),
actionButton("EnterWGS", "Read file")),
# Table is rendered
DTOutput("contents")
)
server <- function(input, output, session) {
rv <- reactiveValues(df=NULL)
# Datatable is uploaded straight away (WAY 1)
df1 <- reactive({
req(input$file1)
df <- read.table(input$file1$datapath, fill = TRUE, quote = "", header = TRUE,
sep = '\t', na.strings=c("",".","NA"), colClasses = NA)
})
# The path of the file where the changes are going to be applied can be selected and the python program (process_file.py) is launched with the system function. A processed variant table is created for the session.
observeEvent(input$Btn_GetFile, {
volumes = getVolumes()
shinyFileChoose(input, "Btn_GetFile", roots=volumes, session = session, filetypes = c('', 'txt', "tsv", "csv"))
file_selected<-parseFilePaths(volumes, input$Btn_GetFile)
if (length(file_selected$datapath)!=0){
system('process_file.py', file_selected$datapath )
}
})
# The processed variant table is uploaded when the button is pressed (WAY 2)
df2 <- eventReactive(input$EnterWGS, {
df <- read.table('temp_file', fill = TRUE, quote = "", header = TRUE,
sep = '\t', na.strings=c("",".","NA"), check.names = FALSE, colClasses = NA)
}, ignoreNULL = T)
### condition this observer to display df1()
observeEvent(df1(), {
rv$df <- df1()
})
### condition this observer to display df2()
observeEvent(input$WGS, {
rv$df <- df2()
})
# Rest of the functions...
# Table renderization.
output$contents <- renderDT({
datatable(
rv$df,
filter = "top",
class = "display nowrap compact",
escape = FALSE)},
server = FALSE)
}
shinyApp(ui, server)

Having Trouble Getting Download Handler in Shiny to Work

I am trying to build a shiny platform that can take in an input file, paste the output into a table on display, and then have a download button to download the results of the file back to your computer. I've tried numerous different ways, and it hasn't worked.
UI Code:
tabItem(tabName = "home",
h2("Cancer Publications Compiler"),
sidebarLayout(position = "left",
# File Upload
sidebarPanel(
radioButtons("data_t", "Select the Data Type Here",
c(Excel = ",", "Text = "\t")),
fileInput("data_f", "Upload Your Data Here")),
# Download Input
mainPanel(width = 8,align = "center",
div(style = "border:1px black solid;width:90%;font-size:10px;",tableOutput("out_chart")),
downloadButton("downloadData", "Download")))
),
Server:
fileext = reactive({
switch(input$data_t,
"Excel" = "csv", "Text" = "txt")
})
## Create Output for file selector ##
data_file <- reactive({
if(is.null(input$data_f)){return()}
else{
file_spec <- input$data_f
aa <- read.table(file_spec$datapath, header = TRUE, sep = input$data_t)
return(aa)
}
})
# Connects the input and output to launch the data table
## Create Output for table from tool ##
output$out_chart <- renderTable({
if(is.null(input$data_f)){return()}
else {
data_file()
}
})
output$donwloadData <- downloadHandler(
filename = function(){
paste("data-", fileext(), sep = ".")
},
content = function(file){
sep <- switch(input$data_t, "Excel" = ",", "Text" = "\t")
write.table(data_file(), file, sep = sep,
row.names = FALSE)
})
Can anyone help me with a fix for this problem so that the download handler will work how I want it to?
UPDATE: I have edited the code and have updated it on here. My problem now is that when I click download to download the outputted table, I am getting a .htm download of a very low rendered and weird looking version of my webpage.
You had some typos, and other issues. Try this
ui <- fluidPage(
tabItem(tabName = "home",
h2("Cancer Publications Compiler"),
sidebarLayout(position = "left",
# File Upload
sidebarPanel(
radioButtons("data_t", "Select the Data Type Here", c("Excel" = "csv", "Text" = "txt")) ,
fileInput("data_f", "Upload Your Data Here")
),
# Download Input
mainPanel(width = 8,align = "center",
div(style = "border:1px black solid;width:90%;font-size:10px;",tableOutput("out_chart")),
downloadButton("downloadData", "Download"))
)
)
)
server<- function (input, output, session) {
sep <- reactive({
req(input$data_t)
switch(input$data_t,
"csv" = ",", "txt" = "\t")
})
## Create Output for file selector ##
data_file <- reactive({
if(is.null(input$data_f)){return()}
else{
file_spec <- input$data_f
aa <- read.table(file_spec$datapath, header = TRUE, sep = sep())
return(aa)
}
})
# Connects the input and output to launch the data table
## Create Output for table from tool ##
output$out_chart <- renderTable({
print(input$data_t)
if(is.null(input$data_f)){return()}
else {
data_file()
}
})
output$downloadData <- downloadHandler(
filename = function(){
paste("data-", input$data_t, sep = ".")
},
content = function(file){
write.table(data_file(), file, sep = sep(), row.names = FALSE)
}
)
}
shinyApp(ui = ui, server = server)

R Shiny datatable extension buttons to download complete excel file with format

I have created the following app in R shiny with two download options. One is a conventional downloadhandler option
The second is using An R datatable button extension The App is structured as follows
library(shiny)
library(openxlsx)
library(readxl)
library(DT)
ui <- fluidPage(
titlePanel("Writer App"),
sidebarLayout(sidebarPanel(fileInput(inputId = "file", label = "Read File Here", accept =
c(".xlsx")), downloadLink("downloadData", "Download")),
mainPanel(DTOutput(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$datapath, pattern = ".xlsx" )){data=read_excel(infile$datapath)} else
if(grepl(infile$datapath , pattern = ".csv" )){data=read.csv(infile$datapath )}
#RENAME DATAFRAME WITH UNDERSCORES
names(data)<-gsub(pattern = " ", replacement = "_", x = names(data))
return(data)
})
output$table1 <- renderDT({
datasetInput<-datasetInput()
datatable(datasetInput,extensions = c('Buttons', 'Scroller'),
options = list(
dom = 'tB',
deferRender = TRUE,
scrollY = 400,
scroller = TRUE,
buttons = list(list(extend = 'excel'))) )
})
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".xlsx", sep="")},
content = function(file) {
tf<-tempdir()
Files=list.files(path=tf, pattern=".xlsx", recursive = TRUE)[1]
file.copy(from =paste0(tf, "/",Files ), to= "temp_1.xlsx")
wb2 <- loadWorkbook(file = "temp_1.xlsx")
df_1<-data.frame("DF"= c(1:3))
addWorksheet(wb = wb2,sheetName = "Parameters1")
writeData(wb2, "Parameters1", df_1, startCol = 1, startRow = 2, rowNames = TRUE)
saveWorkbook(wb2, file)
})}
shinyApp(ui = ui, server = server)
When we load an excel file, The download handler retains the excel shete with its format intact, appends a new sheet to the workbook and downloads the excel workbook with a new sheet. Is it possible to do the same with the download button below the datatable- retain the format of the original excel, add a new sheet and download.
I request someone to guide me. I am unable to find a solution for this

Download csv in shiny using inputs as data frame name parts

There are existing data.frames that are called: active_acc_newacc, active_acc_oldacc, inactive_acc_newacc, inactive_acc_oldacc. They all contain a lot of rows and columns. I created a code with Shiny, where the user chooses with a radio button if they want to download active or inactive and old, or new. When they click on Download, a csv file needs to be downloaded. The csv should be the content of the dataframe, for example the user chooses Active and new, then the dataframe called active_acc_newacc should be downloaded as a csv, another example is if they chose Inactive and old, then the dataframe called inactive_acc_oldaccdataframe should be downloaded as csv.
In this example, active_acc_newacc contains this sample data:
structure(list(Alpha = c(0.192491906485068, -1.44670180633351,
-0.323180534047634, 1.62229611652493, -0.689024123596357, 2.04212222261495,
0.94377911190294, 2.0819268787991, 1.91711727878331, -0.414812239592928
), Beta = c(1.03285349943413, -1.67856959219527, 0.157549690345431,
1.48913611644558, -0.0757895625491196, 1.27178094415894, 0.641673407672177,
0.800761254937157, 1.86265922566283, -0.545356026768875), Gamma = c(1.52068837343838,
-3.61004798325456, -1.35857038834863, 3.48938862108709, -3.05109504225968,
6.5047022366346, 2.50727319977214, 5.31673927920108, 3.69096202696173,
-1.03802874828505)), row.names = c(NA, -10L), class = "data.frame")
I have the following in the ui.R, requesting input:
ui = fluidPage(
titlePanel("Account classification"),
sidebarLayout(
sidebarPanel(
radioButtons("account_status","Select account status", choices=c("Active","Inactive","Include both"),selected = "Active"),
br(),
radioButtons("account_age","Select account creation time", choices=c("old","new","Created any time"),selected = "new")
),
mainPanel(
downloadButton('downloadData', 'Download')
)
)
)
I created the following server.R
server = function(input, output) {
datasetInput <- reactive({
switch(input$account_status,
"Active" = active_acc,
"Inactive" = inactive_acc,
"Include both" = NULL)
switch(input$account_age,
"old" = oldacc,
"new" = newacc,
"Created any time" = all)
})
dfname <- reactive({
paste(input$account_status,input$account_age, sep='_')
})
output$downloadData <- downloadHandler(
filename = function() { paste(input$dataset, '.csv', sep='') },
content = function(file) {
write.csv(dfname(), file)
}
)
}
shinyApp(ui, server)
Unfortunately, it does not work, when I hit the "download" button, it downloads a csv that contains this (in case of inactive and old are selected) :
"","x"
"1","Inactive_old”
So only the text is written out.
I modified the code and sometimes what Download does is downloading the ui.R radio button page as an html.
How shall I write the codes in order to get a successful csv download?
How about this:
Activeacc_newacc <- structure(list(Alpha = c(0.192491906485068, -1.44670180633351,
-0.323180534047634, 1.62229611652493, -0.689024123596357, 2.04212222261495,
0.94377911190294, 2.0819268787991, 1.91711727878331, -0.414812239592928
), Beta = c(1.03285349943413, -1.67856959219527, 0.157549690345431,
1.48913611644558, -0.0757895625491196, 1.27178094415894, 0.641673407672177,
0.800761254937157, 1.86265922566283, -0.545356026768875), Gamma = c(1.52068837343838,
-3.61004798325456, -1.35857038834863, 3.48938862108709, -3.05109504225968,
6.5047022366346, 2.50727319977214, 5.31673927920108, 3.69096202696173,
-1.03802874828505)), row.names = c(NA, -10L), class = "data.frame")
ui = fluidPage(
titlePanel("Account classification"),
sidebarLayout(
sidebarPanel(
radioButtons("account_status","Select account status", choices=c("Active","Inactive","Include both"),selected = "Active"),
br(),
radioButtons("account_age","Select account creation time", choices=c("old","new","Created any time"),selected = "new")
),
mainPanel(
downloadButton('downloadData', 'Download')
)
)
)
server = function(input, output) {
datasetInput <- reactive({
switch(input$account_status,
"Active" = active_acc,
"Inactive" = inactive_acc,
"Include both" = NULL)
switch(input$account_age,
"old" = oldacc,
"new" = newacc,
"Created any time" = all)
})
dfname <- reactive({
test <- paste0(input$account_status, "acc_", input$account_age, "acc", sep='')
get(test)
})
output$downloadData <- downloadHandler(
filename = function() { paste(input$dataset, '.csv', sep='') },
content = function(file) {
write.csv(dfname(), file)
}
)
}
shinyApp(ui, server)

R Shiny app working locally but not on shiny server

My shiny app reads in an external csv file, updates it using user inputs in the app and updates the external csv file with these. This works locally however with my app on the shiny server it does not update, any idea why this is? Thanks.
I've added some simplistic code below but not really sure if it makes sense, the function num is meant to take the inputs, search for them in data frame and update and then output updated data frame and another data frame called "numbers" with timestamp.
The stuff with the modals at the bottom is that the num() function only happens when button is pressed, this creates modals with shows user what they have inputted and if they press 'proceed' the csv is updated if not they can go back and change details.
ui <- fluidPage(
useShinyjs(),
selectInput("1", "Pick a number", "1-2","2-3"),
selectInput("2", "Pick another number", "4-5", "5-6"),
actionButton("go", "Go")
)
server <- function(input, output, session){
df <- read.csv(df.csv, header = TRUE, sep = ",")
num <- function(df, num1, num2){
date.stamp <- format(Sys.time(), "%Y-%m-%d-%H-%M-%S")
save.file <- paste0("numbers", date.stamp, ".csv")
write.csv(df, file = save.file, row.names = FALSE)
write.csv(df, file = "df.csv", row.names = FALSE)
return(df)
}
observe({
shinyjs::toggleState("go", condition = isTruthy(input$1)
&& isTruthy(input$2))
})
react <- reactiveValues()
observeEvent(input$go, {
react$colm1 <- input$1
react$colm2 <- input$2
react$df1 <- data.frame("Numbers" = c("Num1", "Num2"),
"Values" = c(react$colm1, react$colm2))
react$review <- datatable(rownames = FALSE,
selection = "none",
options = list(dom = "t",
pageLength = nrow(rv$df.check),
autoWidth = FALSE,
columnDefs = list(list(width =
"20%",
targets = c(1)),
list(className = "dt-center",
targets = c(1)))),
react$df.check)
showModal(
modalDialog(
footer = tagList(modalButton("Change numbers"),
actionButton("click", label = "Proceed")
),
strong(em("Inputs Entered")),
p("Please double check numbers"),
DT::renderDataTable({
react$review
})
))
observeEvent(input$click, {
num(df, input$1, input$2)
shinyjs::reset("1");shinyjs::reset("s2")
removeModal()
})
})}
shinyApp(ui = ui, server = server) #calls shiny app

Resources