'How to have a single download button for all datatables in R shiny webpage
I am working with a shiny app where it is desired to have a single downloadButton in the header of the application that downloads the data table present in the current/active page/tab.
Below is a simple app that has two data tables in page1 and one in page 2. Each data table has the csv , excel buttons on top of each data table.
Could these csv, excel buttons be removed and place a single downloadButton in a fixed position in the header bar that offers to download csv/excel options of the active table in the current page or tab.
The idea is to have a single fixed downloadButton for the entire app in the header bar. Any possible solutions within shiny to do this or if anyone has attempted this before.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Header",
dropdownMenuOutput("updatedTimeOutput"),
dropdownMenu(type = "notifications",
badgeStatus = "warning",
icon = icon("bullhorn", "fa-lg"),
notificationItem(icon = icon("bullhorn", "fa-1x"),
status = "info",
text = tags$span(
tags$b("Please notice!")
)
))),
dashboardSidebar( sidebarMenu(id = "tabs",
menuItem("Page1", tabName = "page1"),
menuItem("Page2", tabName = "page2"))),
dashboardBody(
tabItems(
tabItem(
tabName = "page1",
tabBox(id="tabs",
tabPanel("tab1",
column(12,
DT::dataTableOutput("table1")
)),
tabPanel( "tab2",
column(12,
DT::dataTableOutput("table2")
))
)
)
,
tabItem(
tabName = "page2",
fluidRow(
column(12,
DT::dataTableOutput("table3")
))
)
)
)
)
server <- function(input, output) {
output$table1 <- DT::renderDataTable({
datatable( data = mtcars,
options = DToptions,
extensions = 'Buttons',
rownames = TRUE,
selection = 'none'
)
})
output$table2 <- DT::renderDataTable({
datatable( data = mtcars,
options = DToptions,
extensions = 'Buttons',
rownames = TRUE,
selection = 'none'
)
})
output$table3 <- DT::renderDataTable({
datatable( data = mtcars,
options = DToptions,
extensions = 'Buttons',
rownames = TRUE,
selection = 'none'
)
})
}
shinyApp(ui, server)
Solution 1:[1]
(a) If you only want "one downloadButton visible in the header common to all pages that downloads the table in the active page or tab", it needs firstly to know the active page and tab based on the page / tab IDs. (b) If you only need a single button to download all the tables, you can download them into a .xlsx file (see download data onto multiple sheets from shiny). (c)If you need a button for each tab, place the button in each tab and you can simply save table as .csv. Here is the code for situation (a).
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Header",
dropdownMenuOutput("updatedTimeOutput"),
dropdownMenu(type = "notifications",
badgeStatus = "warning",
icon = icon("bullhorn", "fa-lg"),
notificationItem(icon = icon("bullhorn", "fa-1x"),
status = "info",
text = tags$span(
tags$b("Please notice!")
)
))),
dashboardSidebar( sidebarMenu(id = "pages", # use unique id for pages
menuItem("Page1", tabName = "page1"),
menuItem("Page2", tabName = "page2"))),
dashboardBody(
# Add download button
downloadButton('downloadData', 'Download Table',
style="font-weight:bold;"
),
helpText(
hr(style = "border-top: 1px solid #000000;"),
),
tabItems(
tabItem(
tabName = "page1",
tabsetPanel(id="tabs",
tabPanel("tab1",
column(12,
DT::dataTableOutput("table1")
)),
tabPanel( "tab2",
column(12,
DT::dataTableOutput("table2")
))
)
)
,
tabItem(
tabName = "page2",
fluidRow(
column(12,
DT::dataTableOutput("table3")
))
)
)
)
)
server <- function(input, output) {
# table1
tbl1 <- mtcars[1:30, ] # tables 1, 2, 3 use different rows of mtcars to differentiate tables
output$table1 <- DT::renderDataTable({
datatable( tbl1,
# options = DToptions, # no such object called "DToptions"
extensions = 'Buttons',
rownames = TRUE,
selection = 'none'
)
})
# table2
tbl2 <- mtcars[5:45, ]
output$table2 <- DT::renderDataTable({
datatable( tbl2,
# options = DToptions,
extensions = 'Buttons',
rownames = TRUE,
selection = 'none'
)
})
# table3
tbl3 <- mtcars[11:35, ]
output$table3 <- DT::renderDataTable({
datatable( tbl3,
# options = DToptions,
extensions = 'Buttons',
rownames = TRUE,
selection = 'none'
)
})
page_name <- reactive({
input$pages
})
# select table on the active page / tab
selected_table <- reactive({
if(page_name() == "page1"){
tbl.list <- list("tab1" = tbl1, "tab2" = tbl2)
select_tbl <- tbl.list[input$tabs]
}else{
select_tbl <- tbl3
}
return(select_tbl)
})
# download table
output$downloadData <- downloadHandler(
filename = function() {"table.csv"},
content = function(file) {write.csv(selected_table(), file, row.names=TRUE)}
)
}
shinyApp(ui, server)
Solution 2:[2]
library(shiny)
library(shinydashboard)
library(DT)
library(writexl)
ui <- dashboardPage(
dashboardHeader(title = "Header",
dropdownMenuOutput("updatedTimeOutput"),
dropdownMenu(type = "notifications",
badgeStatus = "warning",
icon = icon("bullhorn", "fa-lg"),
notificationItem(icon = icon("bullhorn", "fa-1x"),
status = "info",
text = tags$span(
tags$b("Please notice!")
)
))),
dashboardSidebar(sidebarMenu(id = "pages", # use unique id for pages
menuItem("Page1", tabName = "page1"),
menuItem("Page2", tabName = "page2"))),
dashboardBody(
# Add download button and radioButton
fluidRow(
column(3,
downloadButton('downloadData', 'Download Table',
style="font-weight:bold;"
),
helpText(
hr(style = "border-top: 1px solid #000000;"),
)),
column(3,
radioButtons("f", "Download format:",
c("csv" = "csv",
"Excel" = "xlsx"), inline=T)
)),
tabItems(
tabItem(
tabName = "page1",
tabsetPanel(id="tabs",
tabPanel("tab1",
column(12,
DT::dataTableOutput("table1")
)),
tabPanel( "tab2",
column(12,
DT::dataTableOutput("table2")
))
)
)),
tabItem(
tabName = "page2",
fluidRow(
column(12,
DT::dataTableOutput("table3")
))
)
)
)
server <- function(input, output) {
# table1
tbl1 <- mtcars[1:30, ] # tables 1, 2, 3 use different rows of mtcars to differentiate tables
output$table1 <- DT::renderDataTable({
datatable( tbl1,
# options = DToptions, # no such object called "DToptions"
extensions = 'Buttons',
rownames = TRUE,
selection = 'none'
)
})
# table2
tbl2 <- mtcars[5:45, ]
output$table2 <- DT::renderDataTable({
datatable( tbl2,
# options = DToptions,
extensions = 'Buttons',
rownames = TRUE,
selection = 'none'
)
})
# table3
tbl3 <- mtcars[11:35, ]
output$table3 <- DT::renderDataTable({
datatable( tbl3,
# options = DToptions,
extensions = 'Buttons',
rownames = TRUE,
selection = 'none'
)
})
page_name <- reactive({
input$pages
})
# select table on the active page / tab
selected_table <- reactive({
if(page_name() == "page1"){
tbl.list <- list("tab1" = tbl1, "tab2" = tbl2)
select_tbl <- tbl.list[input$tabs]
}else{
select_tbl <- tbl3
}
return(select_tbl)
})
# select download format
select_format <- reactive(input$f)
# download table
output$downloadData <- downloadHandler(
filename = function(){
if(select_format() == "csv"){
{"table.csv"}
}else{
{"table.xlsx"}
}
} ,
content = function(file){
if(select_format() == "csv"){
{write.csv(selected_table(), file, row.names=TRUE)}
}else{
{write_xlsx(selected_table(), file)}
}
}
)
}
shinyApp(ui, server)
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|---|
| Solution 1 | |
| Solution 2 | bdedu |