Downloading file from a datatable and pdf graph with 2 download buttons - r

I need to export the graph and the xls from 2 SQL queries
My graph is linked with the datatable by clicking on a row
I placed the 2 download buttons but I don't know how to trig the exports with buttons (maybe with another reactive function ?)
Thank you for your help
Here my UI.R :
mainPanel(
DT::dataTableOutput("table"), #My Table
plotOutput("plot")) # My graph
downloadButton("plot_export", "PDF"),
# Button
downloadButton("downloadData", "XLS")
))
Here the server.R :
cpk_total <- reactive({
data_testeur <- odbcConnect(input$base, uid="uid")
SQL query to feed my dataTable
Close connexion data_testeur
return result created from the SQL query
})
output$Table <- DT::renderDataTable({
DT::datatable(cpk_total(),...) # Formating table
})
output$plot <- renderPlot({
dta <- cpk_total()
data_testeur <- odbcConnect(input$base, uid="uid")
another SQL query to trace the graph for 1 item selected
#This SQL query use a variable from the created cpk_total table
Close connexion data_testeur
graph <- ....
)

you need to add some thing like this for the table
output$downloadData <- downloadHandler (
filename = function() {
#some function to generate your file name
},
content = function(file) {
dta <- cpk_total()
write.csv2(dta, file, row.names = FALSE, fileEncoding = "UTF-8", quote = FALSE, na = "")
}
)
and for the chart I would pull the code out from the renderPlot into a seperate reactive just like you have done with cpk_total()
and the add something like this for the download of the plot
output$downloadData <- downloadHandler (
filename = function() {
#some function to generate your file name
},
content = function(file) {
p <- reactive_plot()
export(p, file = file)
}
)

Related

Shiny download dynamically made files using downloadHandler() based on user choices on radioButtons()

I have a shiny app that creates a data frame based on user inputs. I want to make a dynamic download button that takes user choices (radioButton) to download dynamically made data frame. The data frames are returned from a function as a list
When I create functions for two different download buttons the downloading works fine
library(shiny)
library(DT)
temp_func <- function(){
x <- mtcars
y = x[,1]
return(list(complete_df = as.data.frame(x), column1 = as.data.frame(y)))
}
# UI
ui <- shinyUI({
fluidPage(
actionButton("fetch", label = "Fetch data first"),
mainPanel(DT::dataTableOutput("table")),
downloadButton("down_all", "Download all"),
downloadButton("down_c1", "Download c1")
)})
# Server
server <- Main_Server <- function(input,output,session){
# Reactive Values
values <- reactiveValues(table = NULL)
# fetchEvent (Consider temp_func() is fetching data from website)
observeEvent(input$fetch, {values$table <- temp_func()})
# Rendering table for display
output$table <- renderDT({datatable(values$table$complete_df)})
# Download 1
output$down_all <- downloadHandler(
filename = function() { paste("All columns","csv", sep=".")},
content = function(file) {write.csv(values$table$complete_df, file)})
# Download 2
output$down_c1 <- downloadHandler(
filename = function() { paste("Columns1","csv", sep=".")},
content = function(file) {write.csv(values$table$column1, file)})
}
# Run-app
shinyApp(ui, server)
Once I merge the two functions and pass input$choice from radio button I get an empty file
library(shiny)
library(DT)
temp_func <- function(){
x <- mtcars
y = x[,1]
return(list(complete_df = as.data.frame(x), column1 = as.data.frame(y)))
}
# UI
ui <- shinyUI({
fluidPage(
actionButton("fetch", label = "Fetch data first"),
mainPanel(DT::dataTableOutput("table")),
radioButtons("rd", c("Select"), choices = c("All Columns" = "complete_df","Column 1" = "column1"),
selected = "complete_df"),
downloadButton("down", "Download")
)})
# Server
server <- Main_Server <- function(input,output,session){
# Reactive Values
values <- reactiveValues(table = NULL)
# fetchEvent (Consider temp_func() is fetching data from website)
observeEvent(input$fetch, {values$table <- temp_func()})
# Rendering table for display
output$table <- renderDT({datatable(values$table$complete_df)})
# Combined Download
output$down <- downloadHandler(
filename = function() { paste("File","csv", sep=".")},
content = function(file) {write.csv(values$table$input$rd, file)})
}
# Run-app
shinyApp(ui, server)
Consider temp_func() is fetching data from other website
Try to use :
# Combined Download
output$down <- downloadHandler(
filename = function() { paste("File","csv", sep=".")},
content = function(file) {write.csv(values$table[[input$rd]], file)})
The syntax you used returns NULL because values$table doesn't have an input field.
With the updated syntax, the downloaded file isn't empty anymore.

Use multiple reactive datasets to write to an excel workbook under downloadHandler shiny

Good afternoon, thank you in advance for taking the time to read my question. In my Shiny app, I am trying to create a list of the reactive objects to write to a single excel workbook for the user to download. I was able to use parts of responses from other posts to replicate my issue and I get pretty close to a resolution. However, while the example below uses a list of dataframes, such as mtcars, iris, etc, I am trying to use reactive datasets, such as datasetInput1(), datasetInput2(), etc.
shinyApp(
ui = fluidPage(
downloadButton("downloadExcelSheet", "Download Excel Workbook with Multiple Sheets")
),
server = function(input, output) {
#### Write an Excel workbook with one sheet per dataframe ####
output$downloadExcelSheet <- downloadHandler(
filename = function() {
"excelWorkbook.xlsx"
},
content = function(file) {
# write workbook and first sheet
write.xlsx(mtcars, file, sheetName = "mtcars", append = FALSE)
# add other sheets for each dataframe
listOtherFiles <- list(iris = iris,
airquality = airquality,
sleep = sleep)
for(i in 1:length(listOtherFiles)) {
write.xlsx(listOtherFiles[i], file,
sheetName = names(listOtherFiles)[i], append = TRUE)
}
}
)
When I try to use these reactive objects in the example below, I am able to successfully download the data when there is just one dataset in the list. For example, the below works, but once I start adding more to the list listOtherFiles such as listOtherFiles <- list(datasetInput2(), datasetInput3()), I get an error.
shinyApp(
ui = fluidPage(
downloadButton("downloadExcelSheet", "Download Excel Workbook with Multiple Sheets")
),
server = function(input, output) {
datasetInput1 <- reactive({
data %>%
filter(sub_date == input$date, app_type == input$type)
})
datasetInput2 <- reactive({
data2 %>%
filter(sub_date == input$date, app_type == input$type)
})
output$downloadExcelSheet <- downloadHandler(
filename = function() {
"datasetOutput.xlsx"
},
content = function(file) {
# write workbook and first sheet
write.xlsx(datasetInput1(), file, sheetName = "dataset1", append = FALSE)
# add other sheets for each dataframe
listOtherFiles <- list(datasetInput2())
for(i in 1:length(listOtherFiles)) {
write.xlsx(listOtherFiles[i], file,
sheetName = names(listOtherFiles)[i], append = TRUE)
}
}
)
I'm not sure I can reproduce the problem. Here is my example below. This seems to work and uses two reactive expressions. Does it work for you?
If not, please edit your question and describe further. Perhaps include example data and ui with inputs to reproduce. What was your error?
library(xlsx)
library(shiny)
library(tidyverse)
shinyApp(
ui = fluidPage(
downloadButton("downloadExcelSheet", "Download Excel Workbook with Multiple Sheets")
),
server = function(input, output) {
datasetInput1 <- reactive({
iris %>%
filter(Species == "setosa")
})
datasetInput2 <- reactive({
iris %>%
filter(Species == "versicolor")
})
#### Write an Excel workbook with one sheet per dataframe ####
output$downloadExcelSheet <- downloadHandler(
filename = function() {
"excelWorkbook.xlsx"
},
content = function(file) {
# write workbook and first sheet
write.xlsx(mtcars, file, sheetName = "mtcars", append = FALSE)
# add other sheets for each dataframe
listOtherFiles <- list(setosa = datasetInput1(), versicolor = datasetInput2())
for(i in 1:length(listOtherFiles)) {
write.xlsx(listOtherFiles[[i]], file,
sheetName = names(listOtherFiles)[i], append = TRUE)
}
}
)
}
)
datasetInput1() is a reactive value not defined within the server logic. This needs to be assigned a value first or a function created to update values.
The following are some useful articles to understand shiny's reactive elements:
https://shiny.rstudio.com/articles/understanding-reactivity.html
https://shiny.rstudio.com/articles/reactivity-overview.html

Passing reactive data to global environment

I want to use Shiny within RMarkdown for users to upload data (xlsx file).
Then I want to pass all the worksheets as R data frames (w/o reactivity) to run rest of the RMarkdown file.
I mainly want to convert them into data frames so I can use reticulate to run Python code as well.
I've tried this, and it doesn't seem to quite work:
library(dplyr)
library(miniUI)
library(shiny)
library(XLConnect)
launch_shiny <- function() {
ui <- miniPage(
gadgetTitleBar("Input Data"),
miniContentPanel(
fileInput(inputId = "my.file", label = NULL, multiple = FALSE)
)
)
server <- function(input, output, session) {
wb <- reactive({
new.file <- input$my.file
loadWorkbook(
filename = new.file$datapath,
create = FALSE,
password = NULL
)
})
observeEvent(input$done, {
stopApp(c(wb()))
})
}
runGadget(ui, server)
}
test <- launch_shiny()
df1 <- readWorksheet(object = test, sheet = "sheet1")
df2 <- readWorksheet(object = test, sheet = "sheet2")
It throws this error:
Error in (function (classes, fdef, mtable) :
unable to find an inherited method for function ‘readWorksheet’ for signature ‘"list", "character"’
I can return one sheet at a time using stopApp(readWorksheet(object = wb(), sheet = "sheet1")), but I can't seem to return an entire workbook or multiple data frames at the same time.
I don't really want to read in xlsx, save each sheet as csv in working directory, then read those files in again.
Would anyone have a good suggestion on how to get around this?
The documentation of fileInput() states in the details:
datapath
The path to a temp file that contains the data that was
uploaded. This file may be deleted if the user performs another upload
operation.
Meaning that the datapath given in the input variable is a temporary file that is no longer accessible after you close the App, which is what the function readWorksheet will try to do.
So you'll have to read the sheets in the server and return the dataframes somehow.
I did that by defining a second reactive value which is basically a list of dataframes returned by applying lapply on all the sheets in wb, in this case test will be this list of data frames.
There might be other ways (more efficient, or suits your purpose better) to do this, but here it is:
library(dplyr)
library(miniUI)
library(shiny)
library(XLConnect)
launch_shiny <- function() {
ui <- miniPage(
gadgetTitleBar("Input Data"),
miniContentPanel(
fileInput(inputId = "my.file", label = NULL,
multiple = FALSE)
)
)
server <- function(input, output, session) {
wb <- reactive({
new.file <- input$my.file
loadWorkbook(
filename = new.file$datapath,
create = FALSE,
password = NULL
)
})
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
df_lst <- reactive({
# read all sheets into a list
lapply(getSheets(wb()),
function(sheet){
readWorksheet(object = wb(),
sheet = sheet)
})
})
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
observeEvent(input$done, {
# get the list of dfs from the app
stopApp(c(df_lst()))
})
}
runGadget(ui, server)
}
test <- launch_shiny()

Save dataframe in Shiny to access it later and download it?

I'm new to shiny.
I have a very basic question but I can't find a solution here on stackoverflow.
I am using directory Input function created by wleepang (https://github.com/wleepang/shiny-directory-input).
I wrote a function read_files that rbind all files in the directory selected.
I can display this table with renderTable, this works perfectly. But I do not manage to save this table to work with later (check for missing data, add columns, draw ggplots..) and to download is with write.xlsx
ui <- fluidPage(
directoryInput('directory', label = 'select a directory'),
actionButton("upload", label="Hochladen"),
downloadButton("download", label="Runterladen")
)
server <- function(input, output, session) {
#this part is to set the directory
observeEvent(
ignoreNULL = TRUE,
eventExpr = {
input$directory
},
handlerExpr = {
if (input$directory > 0) {
path = choose.dir(default = readDirectoryInput(session, 'directory'))
updateDirectoryInput(session, 'directory', value = path)
}})
#now comes the actual code
observeEvent(input$upload,{
df <- read_files(readDirectoryInput(session, 'directory'))
})
How can I access this df later?
output$downloadData <- downloadHandler(
filename = function() {
paste('tabelle', '.csv', sep="") },
content = function(file) {
write.xlsx(df, file)
}
)
}
And my second question how can I download it as a xlsx file in the set directory?
my global.r with the read_files function
source('directoryInput.R')
read_files = function(inDir, pat="*.csv", readMe=read.csv2){
files = list.files(inDir, pattern=pat)
files = lapply(files, function(x) file.path(inDir, x))
df = do.call(rbind, lapply(files, readMe))
return(df)
}
I have saved the element using a reactive function
upload_data <- eventReactive(input$upload, {
read_files(readDirectoryInput(session, 'directory')) })
and can access it through upload_data() this works for me

Add row to shinyTable

I created an app with shiny and shinyTable. It reads a csv file as data.frame and saves changes or new rows.
If I add a new row, it is saved but not shown in the table. I can only see the row in the table when I restart the app. How can I make sure that the submit button adds the row without restarting the app?
EDIT: I can generate this functionality with shiny and a "normal" table with renderTable, but I can't manage to get this working with shinyTable.
What I basically want to achieve is this functionality with shinyTable to have an editable table where I can add rows.
app.R
require(shiny)
datafile<-read.csv("data.csv", header=TRUE, sep=",", quote="")
runApp(
list(
ui = fluidPage(
headerPanel('Title'),
sidebarPanel(
textInput("fielda", label="fielda", value=""),
textInput("fieldb", label="fieldb", value=""),
actionButton("addButton", "insert data")
),
mainPanel(
tableOutput("table"))
),
server = function(input, output) {
datafile_sample <- datafile[sample(nrow(datafile)),]
row.names(datafile_sample) <- NULL
values <- reactiveValues()
values$df <- datafile_sample
addData <- observe({
if(input$addButton > 0) {
newLine <- isolate(c(input$fielda, input$fieldb))
isolate(values$df <- rbind(as.matrix(values$df), unlist(newLine)))
write.csv(values$df, file = "data.csv", row.names=F, quote=F)
}
})
output$table <- renderTable({values$df}, include.rownames=F)
}
)
)
data.csv
fielda,fieldb
1,2
3,4
I think I would approach this a little bit differently. As you've written your example, your data frame resulting from the read.csv shouldn't be called outside of the server. It should, itself, be reactive. In the code below, I've put it in a reactive values call, and initialized it with read.csv.
Then, when you add data to it, you can use write.table to add it to the existing file, and then update the reactive object. This should set all the pieces in motion to update automatically, regardless of what table type you use? (I'm not familiar with shinyTable, so didn't experiment with it much).
There are a few variants you can take on this. For starters, is it really necessary to write the new data to the file? Perhaps you could just append the new data to the existing data frame using rbind. (The write/read combination is going to be slow in comparison).
Even if it is necessary to write the new data, it's probably better to write the new data and use rbind to update the data frame in your app.
library(shiny)
D <- "fielda,fieldb\n1,2\n3,4"
write(D, file = "data.csv")
runApp(
list(
ui = fluidPage(
headerPanel('Title'),
sidebarPanel(
textInput("fielda", label="fielda", value=""),
textInput("fieldb", label="fieldb", value=""),
actionButton("addButton", "insert data")
),
mainPanel(
tableOutput("table"))
),
server = function(input, output) {
data <- reactiveValues(
file = read.csv("data.csv",
header=TRUE,
sep=",",
quote="")
)
addData <- observeEvent(
input$addButton,
{
newLine <- data.frame(fielda = input$fielda,
fieldb = input$fieldb)
write.table(newLine,
file = "data.csv",
col.names = FALSE,
row.names=FALSE,
quote=FALSE,
append = TRUE,
sep = ",")
data$file <- read.csv("data.csv",
header=TRUE,
sep=",",
quote="")
}
)
output$table <-
renderTable(data$file, include.rownames=FALSE)
}
)
)

Resources