Collapse rowGroup Shiny

Question

I have rather simple application (below) where I try to output grouped table using DataTable with the ability to collapse the groups. I found solution in that is implemented in jQuery here but I have no idea how such complex implementation could be moved into R.

Currently, I am able to collapse within a group but not the whole group itself. Any hints how this could be implemented in Shiny?

My application:

library(shiny)
library(DT)
library(shinyjs)

ui <- fluidPage(

   # Application title
   titlePanel("Collapse/Expand table"),

            mainPanel(
          DTOutput("my_table")

      )
   )


server <- function(input, output) {

    output$my_table<-DT::renderDataTable({

        datatable(mtcars[1:15,1:5],
                  extensions = 'RowGroup', 
                  options = list(rowGroup = list(dataSrc=c(3)),
                                 pageLength = 20),
                  callback = JS("
                                table.on('click', 'tr', function () {
                                    var rowsCollapse = $(this).nextUntil('.group');
                                    $(rowsCollapse).toggleClass('hidden');
                                 });"))
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

EDIT

Given AEF comment one can adjust the code to specify that even has to take place once table body is clicked. This indeed collapses any rows until next group. The remaining part is to restrict the clicks only onto group rows. The callback should be now:

callback = JS("$('#DataTables_Table_0 tbody').on('click', 'tr', function () {
 $(this).nextUntil('.group').toggleClass('hidden');});"))

Answer 1

Just one other note on this. I noticed that in a standard fluidPage etc, this worked as expected. However, it stopped working when I started using it in an htmlTemplate.

Somewhere along the way, it loses the .hidden class and I had to manually add it.

.hidden {
  display: none !important;
}

Then it worked as expected.

Answer 2

It turns out to be a bug of DT's javascript code. There's a click event listener that will record all the info of the clicked cells. However, the RowGroup extension creates a new row that doesn't belong to the original datasets and leads to an error. This error stops the further javascript executions.

In your cases, the tr.group event doesn't work because of the error thrown from the previous cell-click event.

We've fixed this bug and the dev version of DT should work with the below code:

library(shiny)
library(DT)
ui <- fluidPage(# Application title
  titlePanel("Collapse/Expand table"),
  mainPanel(DTOutput("my_table")))

callback_js <- JS(
  "table.on('click', 'tr.dtrg-group', function () {",
  "  var rowsCollapse = $(this).nextUntil('.dtrg-group');",
  "  $(rowsCollapse).toggleClass('hidden');",
  "});"
)

server <- function(input, output) {
  output$my_table <- DT::renderDT({
    datatable(
      mtcars[1:15, 1:5],
      extensions = 'RowGroup',
      options = list(rowGroup = list(dataSrc = 3), pageLength = 20),
      callback = callback_js,
      selection = 'none'
    )
  })
}

# Run the application
shinyApp(ui = ui, server = server)

Thanks again for you reports!

Ticker to the Github issue of DT: https://github.com/rstudio/DT/issues/759

Answer 3

As mentioned by @David Joequera in the comments this is a JavaScript error, where one of the default event Handlers of Datatable throws an Error because the row porperty doesn't exist in the Group row.

As a work around we can remove this event handler so that the one for hiding will work.

Also i would recommend you to only target the group rows with the event handler so that you can only fully close and open the groups and can not semi hide groups. You can achieve this by simply adding a ".group" to your event Listener Target. Resulting in this code:

table.on('click', 'tr.group', function () {
   var rowsCollapse = $(this).nextUntil('.group');
   $(rowsCollapse).toggleClass('hidden');
})

In order to remove the event Handler we will need to wait until the table is properly loaded and the problematic event handler is atached so I would recommend working with a small timeout. 1000 ms worked fine for me and should not bring any usability issues. so adding this code to the Callbacks should fix the issue:

setTimeout(function(){$('#DataTables_Table_0').off('click.dt','tbody td')},1000);

Be aware that the the ID of the DataTable to delete might change in your final/real solution

Resulting in this code for the demo:

library(shiny)
library(DT)
library(shinyjs)

ui <- fluidPage(

  # Application title
  titlePanel("Collapse/Expand table"),

  mainPanel(
    DTOutput("my_table")

  ),
)


server <- function(input, output) {

output$my_table<-DT::renderDataTable({

datatable(mtcars[1:15,1:5],
          extensions = 'RowGroup', 
          options = list(rowGroup = list(dataSrc=c(3)),
                         pageLength = 20),
          callback = JS("
                           setTimeout(function(){$('#DataTables_Table_0').off('click.dt','tbody td')},1000);
                           table.on('click', 'tr.group', function () {
                                var rowsCollapse = $(this).nextUntil('.group');
                                $(rowsCollapse).toggleClass('hidden');
                             });"))
})



}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 4

Thanks to the AEF comment I was able to boil down the problem. The event has to occur one user clicks on the body $('#DataTables_Table_0 tbody') and only on rows with group identifier 'tr.group'.

The final callback has to be adjusted to take both of those conditions into account.

Therefore application with collapsable rows looks as follows:

library(shiny)
library(DT)
library(shinyjs)

ui <- fluidPage(

   # Application title
   titlePanel("Collapse/Expand table"),

            mainPanel(
          DTOutput("my_table")

      )
   )


server <- function(input, output) {

    output$my_table<-DT::renderDataTable({

        datatable(mtcars[1:15,1:5],
                  extensions = 'RowGroup', 
                  options = list(rowGroup = list(dataSrc=c(3)),
                                 pageLength = 20),
                  callback = JS("
                                $('#DataTables_Table_0 tbody').on('click', 'tr.group', function () {
                                    var rowsCollapse = $(this).nextUntil('.group');
                                    $(rowsCollapse).toggleClass('hidden');
                                 });"))
    })
}

# Run the application 
shinyApp(ui = ui, server = server)