Having Trouble Getting Download Handler in Shiny to Work - r

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)

Related

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

How to combine multiple R modules (with submodels and uiOuput) using shinydashboard?

I'm modularizing a Shiny app I developed using shinydashboard packages. Despite it traditionally works when I use it without involving modules, I can't make it work when I try to divide it into modules and submodules. Here I would like to combine two UIs (one for the sidebar, one for the body) in order to upload a dataset from the sidebar and show it into the body.
I'd be very glad if anybody could provide me some help with this.
Here is the code of the general Shiny app:
library(shiny)
library(excelR)
library(vroom)
library(readxl)
library(janitor)
library(dplyr)
library(shinydashboard)
library(shinydashboardPlus)
# # load separate module and function scripts
source("modules.R")
# app_ui
app_ui <- function() {
tagList(
shinydashboardPlus::dashboardPagePlus(
header = shinydashboardPlus::dashboardHeaderPlus(title = "module_test",
enable_rightsidebar = FALSE),
sidebar = shinydashboard::dashboardSidebar(
shinydashboard::sidebarMenu(id = "tabs",
import_sidebar_ui("import"))
),
body = shinydashboard::dashboardBody(shinydashboard::tabItems(
import_body_ui("import"))
),
rightsidebar = NULL,
title = "Module App"
)
)
}
# app_server
app_server <- function(input, output, session) {
shiny::moduleServer(id = "import", module = import_server)
}
####################################################################
run_app <- function(...) {
shiny::shinyApp(
ui = app_ui,
server = app_server)
}
#---------------------------------
run_app()
and here is the modules.R file I wrote containing the UIs for sidebar and body, plus the server:
# Import module ####
#
# Import sidebar UI
import_sidebar_ui <- function(id) {
ns <- NS(id)
shinydashboard::menuItem("Module Testing",
tabName = "tab_testing_mod",
icon = icon("th"),
tagList(
selectInput(ns("input_type"),
"Type of file:",
choices = c("Choose one" = "",".csv" = "csv",
".txt" = "txt", ".xls/.xlsx" = "xlsx"),
selected = NULL),
uiOutput(ns("inputControls")),
fileInput(ns("file"), "Data", buttonLabel = "Upload..."),
checkboxInput(ns("rownames"), "Check if 1st column contains rownames"),
checkboxInput(ns("constant"), "Remove constant columns?"),
checkboxInput(ns("empty"), "Remove empty cols?"),
actionButton(ns("bttn_import"), "Import data")
)
)
}
# Import body UI
import_body_ui <- function(id) {
ns <- NS(id)
shinydashboard::tabItem(tabName = "tab_testing_mod",
fluidRow(
h3("Imported Data"),
excelR::excelOutput(ns("preview")))
)
}
# Import server
import_server <- function(input, output, session) {
ns <- session$ns
output$inputControls <- renderUI({
tagList(
switch(input$input_type,
"csv" = textInput("delim", "Delimiter (leave blank to guess)", ""),
"txt" = textInput("delim", "Delimiter (leave blank to guess)", "")
),
switch(input$input_type,
"xlsx" = numericInput("sheet", "Sheet number", value = 1))
)
})
raw <- reactive({
req(input$file)
if (input$input_type == "csv" || input$input_type == "txt") {
delim <- if (input$delim == "") NULL else input$delim
data <- vroom::vroom(input$file$datapath, delim = delim)
} else if (input$input_type == "xlsx") {
data <- tibble::as.tibble(readxl::read_excel(input$file$datapath, sheet = input$sheet, col_names = TRUE))
} else {
return(NULL)
}
raw <- data
raw
})
tidied <- eventReactive(input$bttn_import,{
out <- raw()
if (input$empty) {
out <- janitor::remove_empty(out, "cols")
}
if (input$constant) {
out <- janitor::remove_constant(out)
}
if (input$rownames) {
out <- tibble::column_to_rownames(out, var = colnames(out[1]))
}
out <- out %>% dplyr::mutate_if(is.character,as.factor)
out
})
output$preview <- excelR::renderExcel({
excelR::excelTable(data = raw(),
colHeaders = toupper(colnames(raw())),
fullscreen = FALSE,
columnDrag = TRUE,
rowDrag = TRUE,
wordWrap = FALSE,
search =TRUE,
showToolbar = TRUE,
minDimensions = c(ncol(raw()),10)
)
})
}
It seems to me I can upload the dataset (.csv, .txt or .xlsx) files but I can't show it into the body.
I'd be very glad if you can help me, thank you very much in advance for your assistance.

External Data storage in Shiny apps

I am developing a shiny application which save the data entered on the user interface. I have refered the url on shiny rstudio page so by using this page, the code i have written is as mentioned below:
outputDir <- "C:\\Users/dell/Desktop/"
saveData <- function(data) {
data <- t(data)
fileName <- sprintf("%s_%s.csv", as.integer(Sys.time()), digest::digest(data))
write.csv(
x = data, sep = ",",
file = file.path(outputDir, fileName),
row.names = FALSE, quote = TRUE
)
}
loadData <- function() {
files <- list.files(outputDir, full.names = TRUE)
data <- lapply(files, read.csv, stringsAsFactors = FALSE)
data <- do.call(rbind, data)
data
}
library(shiny)
fields <- c("name", "staff_name")
shinyApp(
ui = fluidPage(
titlePanel("attendance System"),
DT::dataTableOutput("responses", width = 300), tags$hr(),
textInput("name", "Accession Number", ""),
selectInput("staff_name", "Staff Name",
c("Rajiv" = "RT",
"Arvind " = "AKS",
"Ashutosh " = "AS")),
actionButton("submit", "Submit")
),
server = function(input, output, session) {
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
data
})
observeEvent(input$submit, {
saveData(formData())
})
output$responses <- DT::renderDataTable({
input$submit
loadData()
})
}
)
The above code create a new file for each entry. I am looking for a single file in which all entry to be added.
This will give you a unique file name based on time of save and content of the file:
fileName <- sprintf("%s_%s.csv", as.integer(Sys.time()), digest::digest(data))
You can give it a single name like:
fileName <- 'input_bu.csv'
Like #ismirsehregal, I'd recommend bookmarking for this though.
after looking various solutions. I reached at below code to save the data in a single file as it is entered.
library(shiny)
outputDir <- "C:\\Users/dell/Desktop/"
saveData <- function(data) {
data <- as.data.frame(t(data))
if (exists("responsesiq")) {
responsesiq <<- rbind(responsesiq, data)
} else {
responsesiq <<- data
}
fileName <- "test_igntu.csv"
write.csv(
x = responsesiq, sep = ",",
file = file.path(outputDir, fileName),
row.names = FALSE, quote = TRUE
)
}
fields <- c("acc", "staff_name")
shinyApp(
ui = fluidPage(
titlePanel("Attendance System"),
DT::dataTableOutput("responsesiq", width = 300), tags$hr(),
numericInput("acc", "AccNumber", ""),
selectInput("staff_name", "Staff Name",
c("Rajiv" = "RT",
"Arvind" = "AKS",
"Ashutosh" = "AS")),
actionButton("submit", "Submit")
),
server = function(input, output, session) {
# Whenever a field is filled, aggregate all form data
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
data
})
# When the Submit button is clicked, save the form data
observeEvent(input$submit, {
saveData(formData())
})
}
)

How to exit downloadHandler when file doesn't exist

I have a Shiny app with a downloadButton, which enables the user to download some log files.
As the logfiles are also handled by logrotate, it might be that at a certain time no logfile exists, which currently breaks the app when trying to download it.
How can I prevent that? Or how can I display a modalDialog with the information, that no log-file currently exists?
I tried to include req(F) or return(FALSE) but they don't work.
The current approach works, as I create an empty data.frame which is then exported, but it's not a very nice solution.
library(shiny)
library(data.table)
## Write random log file. Uncomment the next line to make the example work.
#fwrite(x = iris, file = "logs.log")
ui <- fluidPage(
downloadButton("showLogs", label="", title="Logs herunterladen", icon = icon("book-open"))
)
server <- function(input, output, session) {
output$showLogs <- downloadHandler(
filename = function() {
paste('logs-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
logfile <- list.files(path = ".", pattern = basename("logs.log"))
if (length(logfile) != 0) {
logfile <- fread(logfile, sep = ";", header = F)
fwrite(logfile, file, sep = ";", row.names = FALSE)
} else {
## Problem is in here
# req(F)
# return(FALSE)
fwrite(data.frame("No log-Files"), file, sep = ";", row.names = FALSE)
}
}
)
}
shinyApp(ui, server)
Here is a solution without reactiveTimer.
library(shiny)
library(data.table)
library(shinyjs)
## Write random log file. Uncomment the next line to make the example work.
#fwrite(x = iris, file = "logs.log")
ui <- fluidPage(
useShinyjs(),
downloadButton("showLogs", label="", style = "display:none;"),
actionButton("btn", "Download")
)
server <- function(input, output, session) {
observeEvent(input$btn, {
logfile <- list.files(path = ".", pattern = basename("logs.log"))
if(length(logfile)){
runjs("$('#showLogs').click();")
}
})
output$showLogs <- downloadHandler(
filename = function() {
paste('logs-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
logfile <- list.files(path = ".", pattern = basename("logs.log"))
logfile <- fread(logfile, sep = ";", header = F)
fwrite(logfile, file, sep = ";", row.names = FALSE)
}
)
}
shinyApp(ui, server)
This app throws an alert if you click the button while no log file exists, and there's no download.
library(shiny)
library(data.table)
library(shinyjs)
## Write random log file. Uncomment the next line to make the example work.
#fwrite(x = iris, file = "logs.log")
ui <- fluidPage(
useShinyjs(),
downloadButton("showLogs", label="", title="Logs herunterladen", icon = icon("book-open"))
)
server <- function(input, output, session) {
autoInvalidate <- reactiveTimer(1000)
observe({
autoInvalidate()
logfile <- list.files(path = ".", pattern = basename("logs.log"))
if(length(logfile)){
runjs("$('#showLogs').off('click.x')")
}else{
runjs("$('#showLogs').off('click.x').on('click.x', function(e){alert('No log file'); e.preventDefault();})")
}
})
output$showLogs <- downloadHandler(
filename = function() {
paste('logs-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
logfile <- list.files(path = ".", pattern = basename("logs.log"))
logfile <- fread(logfile, sep = ";", header = F)
fwrite(logfile, file, sep = ";", row.names = FALSE)
}
)
}
shinyApp(ui, server)

Shiny DownloadHandler unable to save .csv file

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!!!

Resources