Short description of R package DT from its website:

The R package DT provides an R interface to the JavaScript library DataTables. R data objects (matrices or data frames) can be displayed as tables on HTML pages, and DataTables provides filtering, pagination, sorting, and many other features in the tables. 

In practice it means that we can easily publish interactable HTML tables to our reports, dashboards, blog posts etc. To learn more about DT visit https://rstudio.github.io/DT/. As you can imagine, there is lot of stuff you can do with your datatable, so even if you have used datatable() function for a while, I’ll highly recommend to take a look to the DT website. I found it to be full of useful examples.

Child Rows

There is an example of datatable with child rows published in DT website. The example, in turn, is adapted from DataTables website. In this post I will extend DT child rows example such that it will look more similar to the original. I start by downloading example data from DataTables website and save it as dt-export-ex.csv. Next I will load necessary packages, read data to R and add Employee ID variable to data.

library(tidyverse)
library(DT)
x <- readr::read_csv("dt-export-ex.csv")
x[["Employee ID"]] <- round(runif(nrow(x)) * 10000)

I use datatable2() function (see full code below) to embed datatable with child rows to this document:

datatable2(
  x = x, 
  vars = c("Employee ID", "Age", "Start date"),
  opts = list(pageLength = 5)
)

Show 5102550100 entriesSearch:

Showing 1 to 5 of 57 entries

Previous12345…12Next

When clicking on the + sign we can see additional information about any given row. I think that datatable produced with databale2() function looks quite similar to original example. Also, the benefit of making a function out of it allows us to specify other options available for DT::datatable() functions, which hopefully makes datatable2() to fit better in my (or yours) workflow.

FUNS

Code for datatable2():

# datatable2 - datatable with child rows
datatable2 <- function(x, vars = NULL, opts = NULL, ...) {
  
  names_x <- names(x)
  if (is.null(vars)) stop("'vars' must be specified!")
  pos <- match(vars, names_x)
  if (any(map_chr(x[, pos], typeof) == "list"))
    stop("list columns are not supported in datatable2()")
  
  pos <- pos[pos <= ncol(x)] + 1
  rownames(x) <- NULL
  if (nrow(x) > 0) x <- cbind(' ' = '&oplus;', x)

  # options
  opts <- c(
    opts, 
    list(
      columnDefs = list(
        list(visible = FALSE, targets = c(0, pos)),
        list(orderable = FALSE, className = 'details-control', targets = 1),
        list(className = 'dt-left', targets = 1:3),
        list(className = 'dt-right', targets = 4:ncol(x))
      )
  ))
  
  datatable(
    x, 
    ...,
    escape = -2,
    options = opts,
    callback = JS(.callback2(x = x, pos = c(0, pos)))
  )
}

.callback2 <- function(x, pos = NULL) {
  
  part1 <- "table.column(1).nodes().to$().css({cursor: 'pointer'});"
  
  part2 <- .child_row_table2(x, pos = pos)
  
  part3 <- 
  "
   table.on('click', 'td.details-control', function() {
    var td = $(this), row = table.row(td.closest('tr'));
    if (row.child.isShown()) {
      row.child.hide();
      td.html('&oplus;');
    } else {
      row.child(format(row.data())).show();
      td.html('&ominus;');
    }
  });"
  
  paste(part1, part2, part3)
} 

.child_row_table2 <- function(x, pos = NULL) {
  
  names_x <- paste0(names(x), ":")
  text <- "
  var format = function(d) {
    text = '<div><table >' + 
  "

  for (i in seq_along(pos)) {
    text <- paste(text, glue::glue(
        "'<tr>' +
          '<td>' + '{names_x[pos[i]]}' + '</td>' +
          '<td>' + d[{pos[i]}] + '</td>' +
        '</tr>' + " ))
  }

  paste0(text,
    "'</table></div>'
      return text;};"
  )
}