Extending DT child rows example

[This article was first published on reigo.eu, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

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

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(' ' = '⊕', 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('⊕');
    } else {
      row.child(format(row.data())).show();
      td.html('⊖');
    }
  });"
  
  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;};"
  )
}

To leave a comment for the author, please follow the link and comment on their blog: reigo.eu.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)