Datatable Embedded Tables
Here’s an example of how to embed subtables in a datatable. It’s an enhancement of the child rows example found at https://rstudio.github.io/DT/002-rowdetails.html and works by storing JSON versions of subtables as a column in the main table dataframe. The current release of the DT library converts the JSON format into a javascript array which can simply be rendered to an HTML table (DT version 1.x returned a JSON string which must be converted using JSON.parse).
1##
2## EmbeddedTable
3##
4## Shiny app demonstrating how to embed subtables into a datatable
5##
6
7library(shiny)
8library(DT)
9library(jsonlite)
10
11server <- function(input, output) {
12
13 ## Generate a data frame containing grouped data
14 ## Subtable is included, formatted as JSON
15 df.start <- data.frame(car = row.names(mtcars), mtcars, row.names = NULL, stringsAsFactors = FALSE)
16 l.df <- split(df.start, df.start$carb)
17 l.cars <- lapply(l.df, function(x) list(num = nrow(x),
18 max_hp = max(x$hp),
19 cyl_range = ifelse(min(x$cyl) == max(x$cyl), min(x$cyl), paste(range(x$cyl), collapse = '-')),
20 subTable = toJSON(x)))
21 df <- data.frame(carb = names(l.cars), do.call('rbind', l.cars), stringsAsFactors = FALSE)
22
23
24 output$dt1 <- DT::renderDataTable({
25 DT::datatable(mtcars)
26 })
27
28 ## shiny table output
29 ## datatable with expand/collapse buttons
30 ## on expanding, subtable is rendered from JSON to HTML
31 output$dt <- DT::renderDataTable({
32 df <- cbind(' ' = '⊕', df)
33 datatable(
34 df,
35 escape = -2,
36 options = list(
37 dom = 't',
38 columnDefs = list(
39 list(visible = FALSE, targets = c(0, 6)),
40 list(orderable = FALSE, className = 'details-control', targets = 1)
41 )
42 ),
43
44 callback = JS("
45 var format = function(d) {
46 var table = document.createElement('table');
47 var tableBody = document.createElement('tbody');
48 var embeddedTableRows = d[6]; // JSON automatically converted to array
49 var subtable = [];
50 var arr = [];
51 $.each(embeddedTableRows, function (index, item) {
52 arr = [];
53 $.each(item, function(k, v) {
54 arr.push(v);
55 })
56 subtable.push(arr);
57 });
58
59 // Add table headers
60 headers = [];
61 $.each(embeddedTableRows[0], function(k, v) {
62 headers.push(k);
63 })
64 for(var i=0; i<headers.length; i++){
65 table.appendChild(document.createElement('th')).
66 appendChild(document.createTextNode(headers[i]));
67 }
68
69 // Add table body
70 for (var i = 0; i < subtable.length; i++) {
71 var row = document.createElement('tr');
72 for (var j = 0; j < subtable[i].length; j++) {
73 var cell = document.createElement('td');
74 cell.appendChild(document.createTextNode(subtable[i][j]));
75 cell.style.backgroundColor = 'lightblue';
76 row.appendChild(cell);
77 }
78 tableBody.appendChild(row);
79 }
80 table.appendChild(tableBody);
81 return(table);
82 };
83
84 // Event handler - expand inner table
85 table.on('click', 'td.details-control', function() {
86 var td = $(this), row = table.row(td.closest('tr'));
87 if (row.child.isShown()) {
88 row.child.hide();
89 td.html('⊕').css('color', 'green');
90 } else {
91 row.child(format(row.data())).show();
92 td.html('⊖').css('color', 'red');
93 }
94 });"
95 ),
96 selection = 'none') %>%
97 formatStyle(1, color = 'green', fontWeight = 'bold', fontSize = '150%', cursor = 'pointer')
98 })
99}
100
101ui <- fluidPage(
102 br(),
103 h4('Example of embedding subtables in a datatable'),
104 br(),
105 DT::dataTableOutput('dt')
106)
107
108shinyApp(server = server, ui = ui)