r - Adding Total/Subtotal to the bottom of a DataTable in Shiny

Question

I would like to be able to add a Total/Subtotal at the bottom of the dataframe created below, displayed as a DataTable. I would like the Total/Subtotal to be updated with every DataTable filter applied. Let's say if the user filters the first 10 records, I would like the total to calculate the sum of the first 10 records or if the user filters 20 records, I would like the total to reflect the sum of the 20 records and so on.

I have thought of a way to achieve this in R by binding a new row to the existing dataframe to carry out the desired calculation. But I was wondering if there's an easy way to attain this through DataTables options. Something similar to this example using the Footer Callback feature.

Also, please click here and here to help out with similar questions.

 #Load required packages

require(shiny)

#Create a dataframe
df <- data.frame(random=1:25)

server <- function(input,output,session){

    #Display df using DataTable and apply desired options
    output$display <- renderDataTable({df})
}

ui <- shinyUI(fluidPage(

    #Add a title
    h1('Testing TableTools'),

        mainPanel(
           #Display results
           dataTableOutput('display')
                 )      


))

shinyApp(ui = ui, server = server)

Answer 1

Here is an example how to do the SubTotal of the given page. To get the total you can pre-compute it and then maybe paste it into the JS output?

library(shiny)
library(DT)

ui <- shinyUI(fluidPage(
  h1('Testing TableTools'),
  mainPanel(
    dataTableOutput('display')
  )      
))

Names <- c("",names(mtcars))
FooterNames <- c(rep("",4),Names[5:6],rep("",6))

server <- function(input, output, session) {

  sketch <- htmltools::withTags(table(
    tableHeader(Names),tableFooter(FooterNames)
  ))

  opts <- list(
    dom = 'Bfrtip', buttons = list('colvis','print',list(extend='collection',text='Download',buttons = list('copy','csv','excel','pdf'))),
               footerCallback = JS(
                 "function( tfoot, data, start, end, display ) {",
                 "var api = this.api(), data;",
                 "$( api.column(5).footer()).html('SubTotal:  '+",
                 "api.column(5).data().reduce( function ( a, b ) {",
                 "return a + b;",
                 "} )",
                 ");",
                 "$( api.column(4).footer()).html('SubTotal: '+",
                 "api.column(4).data().reduce( function ( a, b ) {",
                 "return a + b;",
                 "} )",
                 ");","}")
  )

  output$display <- DT::renderDataTable(container = sketch,extensions = 'Buttons',options = opts,{
    mtcars
  })
}

shinyApp(ui = ui, server = server)