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)
)

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;};"
  )
}