The extensions Buttons works great for shiny application, from library(DT). However it export the data without formatting. Is there a way to export data with format (e.g. percentage, or currency)? Similar question left unsolved.
Reproducible code
library(DT)
data.frame(a = c(1,2),
b = c(2,3)) %>%
datatable(extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print')) )%>%
formatPercentage('a') %>%
formatCurrency('b')
Instead of using the Buttons extension, you can use the TableExport library.
library(shiny)
library(DT)
library(shinyjs)
js_export <-
"
var $table = $('#DTtable').find('table');
var instance = $table.tableExport({
formats: ['xlsx'],
exportButtons: false,
filename: 'myTable',
sheetname: 'Sheet1'
});
var exportData0 = instance.getExportData();
var exportData = exportData0[Object.keys(exportData0)[0]]['xlsx'];
instance.export2file(exportData.data, exportData.mimeType, exportData.filename,
exportData.fileExtension, exportData.merges,
exportData.RTL, exportData.sheetname);
"
ui <- fluidPage(
useShinyjs(),
tags$head(
# put these files in the www subfolder
tags$script(src = "xlsx.core.min.js"),
tags$script(src = "FileSaver.min.js"),
tags$script(src = "tableexport.min.js")
),
DTOutput("DTtable"),
actionButton("export", "Export table")
)
server <- function(input, output, session){
output$DTtable <- renderDT({
data.frame(
a = c(1,2),
b = c(2,3)
) %>%
datatable() %>%
formatPercentage('a') %>%
formatCurrency('b')
})
observeEvent(input$export, {
runjs(js_export)
})
}
shinyApp(ui, server)
Related
I want to create a button that downloads the filtered data of a dataTable, so I read these two posts and tried to do like them but I got an error and it didn't show the table rows. (please see the attachment)
R - Download Filtered Datatable
and
Download filtered data from renderDataTable() in Shiny
The error is: 'data' must be 2-dimensional (e.g. data frame or matrix)
This is a part of my code:
#UI SECTION
downloadButton("download_filtered", "Download filtered dataset"),
verbatimTextOutput("filtered_row"),
DT::dataTableOutput("fancyTable"),
tags$hr(),
plotOutput("fancyPlot")
#SERVER SECTION
server <- function(input, output) {
output$fancyTable<- renderDataTable ({
my_data = data_filter()
DT::datatable(my_data, extensions = "Buttons",
options = list(paging = TRUE,
scrollX=TRUE,
searching = TRUE,
ordering = TRUE,
dom = 'l<"sep">Bfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf'),
pageLength=10,
lengthMenu=c(10,20,50,100) )
)
output$filtered_row <- renderPrint({
input[["fancyTable_rows_all"]]
})
output$download_filtered <- downloadHandler(
filename = "Filtered Data.csv",
content = function(file){
write.csv(my_data[input[["fancyTable_rows_all"]], ],
file)
}
)
})
}
I would be happy if you have any suggestions.
Thank you :)
I have tweaked the code minimally. First I used mtcars instead of my_data.
I think the main issue is to Set server = FALSE in the renderDT function (learned here #Stéphane Laurent) R shiny datatable extension "Buttons" - how to export the whole table to excel?:
library(shiny)
library(DT)
ui <- fluidPage(
downloadButton("download_filtered", "Download filtered dataset"),
verbatimTextOutput("filtered_row"),
DT::dataTableOutput("fancyTable"),
tags$hr(),
plotOutput("fancyPlot")
)
server <- function(input, output, session) {
output$fancyTable <-
DT::renderDT({
datatable(mtcars,
filter = "top",
extensions = "Buttons",
options = list(paging = TRUE,
scrollX=TRUE,
searching = TRUE,
ordering = TRUE,
dom = 'l<"sep">Bfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf'),
pageLength=10,
lengthMenu=c(10,20,50,100)
)
)
}, server = FALSE
)
output$filtered_row <- renderPrint({
input[["fancyTable_rows_all"]]
})
output$download_filtered <- downloadHandler(
filename = "Filtered Data.csv",
content = function(file){
write.csv(my_data[input[["fancyTable_rows_all"]], ],
file)
}
)
}
shinyApp(ui, server)
I am trying to place a button inside the datatable where if the user wants to reset the sorted column they can hit the button and table gets reset or changed to it's original order. At the moment, when I press the button, it is not triggering any event on click. The event should replace the data in the server part.
I am currently following these posts:
shiny DT datatable - reset filters
https://github.com/rstudio/DT/issues/76
Reset a DT table to the original sort order
However, in the last two posts above, even though they get the job done, the button is not part of the datatable.
Here is my reprex:
library(DT)
library(shiny)
library(shinyjs)
# function placed in the global.R
clearSorting <- function(proxy) {
shinyjs::runjs(paste0("$('#' + document.getElementById('", proxy$id,"').getElementsByTagName('table')[0].id).dataTable().fnSort([]);"))
}
# ui.R
ui <- fluidPage(
DT::DTOutput(outputId = "table"),
shinyjs::useShinyjs()
)
# servcer.R
server <- function(input, output) {
output$table <- renderDT({
DT::datatable(data = iris,
filter = 'top',
extensions = c('Buttons'),
options = list(scrollY = 600,
scrollX = TRUE,
autoWidth = TRUE,
dom = '<"float-left"l><"float-right"f>rt<"row"<"col-sm-4"B><"col-sm-4"i><"col-sm-4"p>>',
buttons = list(
list(
extend = '',
text = 'Reset Table',
action = JS("function() {document.getElementById('reset_sort').click();}")
)
),
scrollCollapse= TRUE,
lengthChange = TRUE,
widthChange= TRUE))
})
observeEvent(input$reset_sort, {
data <- iris
clearSorting(proxy = DT::dataTableProxy(outputId = "table"))
DT::replaceData(proxy = DT::dataTableProxy(outputId = "table"),
data = data,
rownames = FALSE)
})
}
shinyApp(ui = ui, server = server)
Here is a way:
library(DT)
js <- c(
"function(e, dt, node, config){",
" dt.iterator('table', function(s){",
" s.aaSorting.length = 0;",
" s.aiDisplay.sort(function(a,b){",
" return a-b;",
" });",
" s.aiDisplayMaster.sort(function(a,b){",
" return a-b;",
" });",
" }).draw();",
"}"
)
datatable(
iris,
extensions = "Buttons",
options = list(
dom = "Bfrtip",
buttons = list(
list(
extend = "collection",
text = "Reset columns order",
action = JS(js)
)
)
)
)
To use it in Shiny, you may need to set server = FALSE in renderDT:
output$table <- renderDT({
......
}, server = FALSE)
I recently started using rPivotTable to produce some impressive charts and tables. I am using rPivotTable in a Shiny application. I was wondering if it is possible to export the output of the rPivotTable(Table, Bar chart, line chart etc) as image from the web browser. In RStudio(without Shiny), it can be done as the viewer has an option for Export->Save as Image. Is there any way to save the charts and tables.
A pivotTable is a htmlwidget, so you can use htmlwidgets::saveWidget to save the table in a html file and webshot::webshot to export it to png (or pdf).
library(shiny)
library(rpivotTable)
library(htmlwidgets)
library(webshot)
ui <- fluidPage(
br(),
rpivotTableOutput("pivotbl"),
br(),
downloadButton("export", "Export")
)
server <- function(input, output, session){
pivotTable <- rpivotTable(
Titanic,
rows = "Survived",
cols = c("Class","Sex"),
aggregatorName = "Sum as Fraction of Columns",
inclusions = list( Survived = list("Yes")),
exclusions= list( Class = list( "Crew")),
vals = "Freq",
rendererName = "Table Barchart"
)
output[["pivotbl"]] <- renderRpivotTable({
pivotTable
})
output[["export"]] <- downloadHandler(
filename = function(){
"pivotTable.png"
},
content = function(file){
tmphtml <- tempfile(fileext = ".html")
saveWidget(pivotTable, file = tmphtml)
webshot(tmphtml, file = file)
}
)
}
shinyApp(ui, server)
EDIT
Here is a way to export only the graph, using the dom-to-image JavaScript library.
Download the file dom-to-image.min.js and put it in the www subfolder of the app.
Here is the app:
library(shiny)
library(rpivotTable)
js <- "
function filter(node){
return (node.tagName !== 'i');
}
function exportPlot(filename){
var plot = document.getElementsByClassName('pvtRendererArea');
domtoimage.toPng(plot[0], {filter: filter, bgcolor: 'white'})
.then(function (dataUrl) {
var link = document.createElement('a');
link.download = filename;
link.href = dataUrl;
link.click();
});
}
Shiny.addCustomMessageHandler('export', exportPlot);
"
ui <- fluidPage(
tags$head(
tags$script(src = "dom-to-image.min.js"),
tags$script(HTML(js))
),
br(),
rpivotTableOutput("pivotbl"),
br(),
actionButton("export", "Export")
)
server <- function(input, output, session){
pivotTable <- rpivotTable(
Titanic,
rows = "Survived",
cols = c("Class","Sex"),
aggregatorName = "Sum as Fraction of Columns",
inclusions = list( Survived = list("Yes")),
exclusions= list( Class = list( "Crew")),
vals = "Freq",
rendererName = "Table Barchart"
)
output[["pivotbl"]] <- renderRpivotTable({
pivotTable
})
observeEvent(input[["export"]], {
session$sendCustomMessage("export", "plot.png")
})
}
shinyApp(ui, server)
I have a shiny app like this:
library(shiny)
library(data.table)
tabledata <- data.table(a=1:4, b= 5:8)
ui <- fluidPage(
dataTableOutput("currenttable")
)
server <- function(input,output, session){
output$currenttable <- renderDataTable({tabledata},rownames = FALSE, extensions = 'Buttons',
options = list(dom = 'Bfrtip', buttons = c('copy', 'pdf'),
filename = "CurrentTable", header= "My Header", pageLength = nrow(tabledata))
)
}
shinyApp(ui, server)
The pdf button works, but only saves the file as "pdf.pdf" not "CurrentTable" and header is missing.
You'll need to bind the options to the pdf button. You can include filename and header options in this way.
From the DataTable pdf reference, header indicates whether the table header (i.e. column names) should be included in the exported table or not -- this can only be TRUE or FALSE, not a string. If you're looking for a title above the table, you could use the title option.
Here's your example:
library(shiny)
library(data.table)
library(DT)
tabledata <- data.table(a=1:4, b= 5:8)
ui <- fluidPage(
DT::dataTableOutput("currenttable")
)
server <- function(input,output, session){
output$currenttable <- renderDT({tabledata},
rownames = FALSE,
extensions = 'Buttons',
options = list(dom = 'Bfrtip',
pageLength = nrow(tabledata),
buttons = list(
list(extend = 'copy'),
list(extend = 'pdf',
filename = 'CurrentTable',
title = "My Title",
header = FALSE)
)
)
)
}
shinyApp(ui, server)
Dear Shiny and DT masters!
I'm trying to use natural sorting plugin in my shiny app, but it doesn't seem to work. I think it was working with previous version of Shiny or/and before DT package. Can anybody help me? See my example below (I'm trying to sort the last column):
server.R
library(shiny)
require(DT)
shinyServer(function(input, output) {
output$example <- DT::renderDataTable({
table = cbind(LETTERS[1:5],matrix(1:20,nrow=5),c(1,2,3,10,"a"))
table = rbind(c("filtered",round(rnorm(5),3)),table)
DT::datatable(table,
rownames = FALSE,
extensions = list(FixedColumns = list(leftColumns = 1)),
options = list(
columnDefs = list(list(type = "natural", targets = "_all"))))
})
})
ui.R
library(shiny)
require(DT)
shinyUI(
fluidPage(
tags$head(
tags$script(src = "http://cdn.datatables.net/1.10.6/js/jquery.dataTables.min.js", type = "text/javascript"),
tags$script(src = "http://cdn.datatables.net/plug-ins/1.10.7/sorting/natural.js", type = "text/javascript")
),
DT::dataTableOutput('example')
)
)
In the current development version of DT (>= 0.1.16), you can enable this plug-in using datatable(..., plugins = 'natural'), e.g.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DT::dataTableOutput('example')
),
server = function(input, output) {
output$example <- DT::renderDataTable({
table = cbind(LETTERS[1:5],matrix(1:20,nrow=5),c(1,2,3,10,"a"))
table = rbind(c("filtered",round(rnorm(5),3)),table)
table
}, server = FALSE, plugins = 'natural', options = list(
columnDefs = list(list(type = "natural", targets = "_all"))
))
}
)
See the documentation for more information.