Skip to content

Instantly share code, notes, and snippets.

@stla

stla/DT_childTables.R

Last active January 9, 2023 15:12
Show Gist options
  • Save stla/e3607e3cf87ddbe70b7134d4a1c874d9 to your computer and use it in GitHub Desktop.
Save stla/e3607e3cf87ddbe70b7134d4a1c874d9 to your computer and use it in GitHub Desktop.
Download ZIP
Child tables for DT (R package)
Raw
DT_childTables.R
library(DT)
## data
dat <- data.frame(
Sr = c(1.5, 2.3),
Description = c("A - B", "X - Y")
)
## details of row 1
subdat1 <- data.frame(
Chromosome = "chr18",
SNP = "rs2",
stringsAsFactors = FALSE
)
## details of row 2
subdat2 <- data.frame(
Chromosome = c("chr19","chr20"),
SNP = c("rs3","rs4"),
stringsAsFactors = FALSE
)
## merge the row details
subdats <- lapply(list(subdat1, subdat2), purrr::transpose)
## dataframe for the datatable
Dat <- cbind(" " = "&oplus;", dat, details = I(subdats))
## the callback
callback = JS(
"table.column(1).nodes().to$().css({cursor: 'pointer'});",
"// Format the nested table into another table",
"var childId = function(d){",
" var tail = d.slice(2, d.length - 1);",
" return 'child_' + tail.join('_').replace(/[\\s|\\.|'|,|\\(|\\)]/g, '_');",
"};",
"var format = function (d) {",
" if (d != null) {",
" var id = childId(d);",
" var html = ",
" '<table class=\"display compact\" id=\"' + id + '\"><thead><tr>';",
" for (var key in d[d.length-1][0]) {",
" html += '<th>' + key + '</th>';",
" }",
" html += '</tr></thead></table>'",
" return html;",
" } else {",
" return '';",
" }",
"};",
"var rowCallback = function(row, dat, displayNum, index){",
" if($(row).hasClass('odd')){",
" for(var j=0; j<dat.length; j++){",
" $('td:eq('+j+')', row).css('background-color', 'papayawhip');",
" }",
" } else {",
" for(var j=0; j<dat.length; j++){",
" $('td:eq('+j+')', row).css('background-color', 'lemonchiffon');",
" }",
" }",
"};",
"var headerCallback = function(thead, data, start, end, display){",
" $('th', thead).css({",
" 'border-top': '3px solid indigo',",
" 'color': 'indigo',",
" 'background-color': '#fadadd'",
" });",
"};",
"var format_datatable = function (d) {",
" var dataset = [];",
" var n = d.length - 1;",
" for (var i = 0; i < d[n].length; i++) {",
" var datarow = $.map(d[n][i], function (value, index) {",
" return [value];",
" });",
" dataset.push(datarow);",
" }",
" var id = 'table#' + childId(d);",
" var subtable = $(id).DataTable({",
" 'data': dataset,",
" 'autoWidth': true,",
" 'deferRender': true,",
" 'info': false,",
" 'lengthChange': false,",
" 'ordering': d[n].length > 1,",
" 'order': [],",
" 'paging': false,",
" 'scrollX': false,",
" 'scrollY': false,",
" 'searching': false,",
" 'sortClasses': false,",
" 'rowCallback': rowCallback,",
" 'headerCallback': headerCallback,",
" 'columnDefs': [{targets: '_all', className: 'dt-center'}]",
" });",
"};",
"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('&CircleMinus;');",
" format_datatable(row.data());",
" }",
"});")
## datatable
datatable(Dat, callback = callback, escape = -2,
options = list(
columnDefs = list(
list(visible = FALSE, targets = ncol(Dat)),
list(orderable = FALSE, className = 'details-control', targets = 1),
list(className = "dt-center", targets = "_all")
)
))
Raw
DT_childTables_2020-03-14.R
dat0 <- iris[1:3,]
dat01 <- airquality[1:4,]
dat02 <- cars[1:2,]
dat021 <- mtcars[1:3,]
dat022 <- PlantGrowth[1:4,]
NestedData <- function(dat, children){
stopifnot(length(children) == nrow(dat))
g <- function(d){
if(is.data.frame(d)){
purrr::transpose(d)
}else{
purrr::transpose(NestedData(d[[1]], children = d$children))
}
}
subdats <- lapply(children, g)
oplus <- sapply(subdats, function(x) if(length(x)) "&oplus;" else "")
cbind(" " = oplus, dat, "_details" = I(subdats), stringsAsFactors = FALSE)
}
Dat <- NestedData(
dat = dat0, # dat0 has three rows
children = list(
dat01, # child of first row
list( # child of second row, which has children itself
dat02, # dat02 has two rows
children = list(dat021, dat022)
),
data.frame(NULL) # no child for the third row
)
)
## whether to show row names
rowNames <- FALSE
colIdx <- as.integer(rowNames)
## the callback
parentRows <- which(Dat[,1] != "")
callback = JS(
sprintf("var parentRows = [%s];", toString(parentRows-1)),
sprintf("var j0 = %d;", colIdx),
"var nrows = table.rows().count();",
"for(var i=0; i < nrows; ++i){",
" if(parentRows.indexOf(i) > -1){",
" table.cell(i,j0).nodes().to$().css({cursor: 'pointer'});",
" }else{",
" table.cell(i,j0).nodes().to$().removeClass('details-control');",
" }",
"}",
"",
"// make the table header of the nested table",
"var format = function(d, childId){",
" if(d != null){",
" var html = ",
" '<table class=\"display compact hover\" ' + ",
" 'style=\"padding-left: 30px;\" id=\"' + childId + '\"><thead><tr>';",
" for(var key in d[d.length-1][0]){",
" html += '<th>' + key + '</th>';",
" }",
" html += '</tr></thead></table>'",
" return html;",
" } else {",
" return '';",
" }",
"};",
"",
"// row callback to style the rows of the child tables",
"var rowCallback = function(row, dat, displayNum, index){",
" if($(row).hasClass('odd')){",
" $(row).css('background-color', 'papayawhip');",
" $(row).hover(function(){",
" $(this).css('background-color', '#E6FF99');",
" }, function() {",
" $(this).css('background-color', 'papayawhip');",
" });",
" } else {",
" $(row).css('background-color', 'lemonchiffon');",
" $(row).hover(function(){",
" $(this).css('background-color', '#DDFF75');",
" }, function() {",
" $(this).css('background-color', 'lemonchiffon');",
" });",
" }",
"};",
"",
"// header callback to style the header of the child tables",
"var headerCallback = function(thead, data, start, end, display){",
" $('th', thead).css({",
" 'border-top': '3px solid indigo',",
" 'color': 'indigo',",
" 'background-color': '#fadadd'",
" });",
"};",
"",
"// make the datatable",
"var format_datatable = function(d, childId){",
" var dataset = [];",
" var n = d.length - 1;",
" for(var i = 0; i < d[n].length; i++){",
" var datarow = $.map(d[n][i], function (value, index) {",
" return [value];",
" });",
" dataset.push(datarow);",
" }",
" var id = 'table#' + childId; console.log(d[n]);",
" if (Object.keys(d[n][0]).indexOf('_details') === -1) {",
" var subtable = $(id).DataTable({",
" 'data': dataset,",
" 'autoWidth': true,",
" 'deferRender': true,",
" 'info': false,",
" 'lengthChange': false,",
" 'ordering': d[n].length > 1,",
" 'order': [],",
" 'paging': false,",
" 'scrollX': false,",
" 'scrollY': false,",
" 'searching': false,",
" 'sortClasses': false,",
" 'rowCallback': rowCallback,",
" 'headerCallback': headerCallback,",
" 'columnDefs': [{targets: '_all', className: 'dt-center'}]",
" });",
" } else {",
" var subtable = $(id).DataTable({",
" 'data': dataset,",
" 'autoWidth': true,",
" 'deferRender': true,",
" 'info': false,",
" 'lengthChange': false,",
" 'ordering': d[n].length > 1,",
" 'order': [],",
" 'paging': false,",
" 'scrollX': false,",
" 'scrollY': false,",
" 'searching': false,",
" 'sortClasses': false,",
" 'rowCallback': rowCallback,",
" 'headerCallback': headerCallback,",
" 'columnDefs': [",
" {targets: -1, visible: false},",
" {targets: 0, orderable: false, className: 'details-control'},",
" {targets: '_all', className: 'dt-center'}",
" ]",
" }).column(0).nodes().to$().css({cursor: 'pointer'});",
" }",
"};",
"",
"// display the child table on click",
"table.on('click', 'td.details-control', function(){",
" var tbl = $(this).closest('table'),",
" tblId = tbl.attr('id'),",
" td = $(this),",
" row = $(tbl).DataTable().row(td.closest('tr')),",
" rowIdx = row.index();",
" if(row.child.isShown()){",
" row.child.hide();",
" td.html('&oplus;');",
" } else {",
" var childId = tblId + '-child-' + rowIdx;",
" row.child(format(row.data(), childId)).show();",
" td.html('&CircleMinus;');",
" format_datatable(row.data(), childId);",
" }",
"});")
## datatable
datatable(
Dat, callback = callback, rownames = rowNames, escape = -colIdx-1,
options = list(
columnDefs = list(
list(visible = FALSE, targets = ncol(Dat)-1+colIdx),
list(orderable = FALSE, className = 'details-control', targets = colIdx),
list(className = "dt-center", targets = "_all")
)
)
)
Raw
DT_childTables_MultipleNesting.R
library(DT)
##~~ Multiple levels of nesting ~~##
## data
dat <- data.frame(
Sr = c(1.5, 2.3),
Description = c("A - B", "X - Y")
)
## details of row 1
subsubdat1 <- data.frame(
Ref = c("UVW", "PQR"),
Case = c(99, 999),
stringsAsFactors = FALSE
)
subdat1 <- data.frame(
Chromosome = "chr18",
SNP = "rs2",
details = I(list(purrr::transpose(subsubdat1))),
stringsAsFactors = FALSE
)
subdat1 <- cbind(" " = "&oplus;", subdat1, stringsAsFactors = FALSE)
## details of row 2
subdat2 <- data.frame(
Chromosome = c("chr19","chr20"),
SNP = c("rs3","rs4"),
stringsAsFactors = FALSE
)
## merge the row details
subdats <- lapply(list(subdat1, subdat2), purrr::transpose)
## dataframe for the datatable
Dat <- cbind(" " = "&oplus;", dat, details = I(subdats))
## the callback
callback = JS(
"table.column(1).nodes().to$().css({cursor: 'pointer'});",
"// Format the nested table into another table",
"var childId = function(d){",
" var tail = d.slice(2, d.length - 1);",
" return 'child_' + tail.join('_').replace(/[\\s|\\.|'|,|\\(|\\)]/g, '_');",
"};",
"var format = function (d) {",
" if (d != null) {",
" var id = childId(d);",
" var html = ",
" '<table class=\"display compact\" id=\"' + id + '\"><thead><tr>';",
" for (var key in d[d.length-1][0]) {",
" html += '<th>' + key + '</th>';",
" }",
" html += '</tr></thead></table>'",
" return html;",
" } else {",
" return '';",
" }",
"};",
"var rowCallback = function(row, dat, displayNum, index){",
" if($(row).hasClass('odd')){",
" for(var j=0; j<dat.length; j++){",
" $('td:eq('+j+')', row).css('background-color', 'papayawhip');",
" }",
" } else {",
" for(var j=0; j<dat.length; j++){",
" $('td:eq('+j+')', row).css('background-color', 'lemonchiffon');",
" }",
" }",
"};",
"var headerCallback = function(thead, data, start, end, display){",
" $('th', thead).css({",
" 'border-top': '3px solid indigo',",
" 'color': 'indigo',",
" 'background-color': '#fadadd'",
" });",
"};",
"var format_datatable = function (d) {",
" var dataset = [];",
" var n = d.length - 1;",
" for (var i = 0; i < d[n].length; i++) {",
" var datarow = $.map(d[n][i], function (value, index) {",
" return [value];",
" });",
" dataset.push(datarow);",
" }",
" var id = 'table#' + childId(d);",
"console.log(d);",
" if (Object.keys(d[n][0]).indexOf('details') === -1) {",
" var subtable = $(id).DataTable({",
" 'data': dataset,",
" 'autoWidth': true,",
" 'deferRender': true,",
" 'info': false,",
" 'lengthChange': false,",
" 'ordering': d[n].length > 1,",
" 'paging': false,",
" 'scrollX': false,",
" 'scrollY': false,",
" 'searching': false,",
" 'sortClasses': false,",
" 'rowCallback': rowCallback,",
" 'headerCallback': headerCallback,",
" 'columnDefs': [{targets: '_all', className: 'dt-center'}]",
" });",
" } else {",
" var subtable = $(id).DataTable({",
" 'data': dataset,",
" 'autoWidth': true,",
" 'deferRender': true,",
" 'info': false,",
" 'lengthChange': false,",
" 'ordering': d[n].length > 1,",
" 'paging': false,",
" 'scrollX': false,",
" 'scrollY': false,",
" 'searching': false,",
" 'sortClasses': false,",
" 'rowCallback': rowCallback,",
" 'headerCallback': headerCallback,",
" 'columnDefs': [{targets: -1, visible: false}, {targets: 0, orderable: false, className: 'details-control'}, {targets: '_all', className: 'dt-center'}]",
" }).column(0).nodes().to$().css({cursor: 'pointer'});",
" }",
"};",
"table.on('click', 'td.details-control', function () {",
" var tbl = $(this).closest('table');",
" var td = $(this),",
" row = $(tbl).DataTable().row(td.closest('tr'));",
" if (row.child.isShown()) {",
" row.child.hide();",
" td.html('&oplus;');",
" } else {",
" row.child(format(row.data())).show();",
" td.html('&CircleMinus;');",
" format_datatable(row.data());",
" }",
"});")
## datatable
datatable(Dat, callback = callback, escape = -2,
options = list(
columnDefs = list(
list(visible = FALSE, targets = ncol(Dat)),
list(orderable = FALSE, className = 'details-control', targets = 1),
list(className = "dt-center", targets = "_all")
)
))
Raw
DT_childTables_MultipleNesting2.R
library(DT)
##~~ Multiple levels of nesting ~~##
## data
dat <- data.frame(
Sr = c(1.5, 2.3),
Description = c("A - B", "X - Y")
)
## details of row 1
subsubdat1 <- data.frame(
Ref = c("UVW", "PQR"),
Case = c(99, 999),
stringsAsFactors = FALSE
)
subdat1 <- data.frame(
Chromosome = "chr18",
SNP = "rs2",
"_details" = I(list(purrr::transpose(subsubdat1))),
stringsAsFactors = FALSE,
check.names = FALSE
)
subdat1 <- cbind(" " = "&oplus;", subdat1, stringsAsFactors = FALSE)
## details of row 2
subdat2 <- data.frame(
Chromosome = c("chr19","chr20"),
SNP = c("rs3","rs4"),
stringsAsFactors = FALSE
)
## merge the row details
subdats <- lapply(list(subdat1, subdat2), purrr::transpose)
## dataframe for the datatable
Dat <- cbind(" " = "&oplus;", dat, "_details" = I(subdats))
## the callback
callback = JS(
"table.column(1).nodes().to$().css({cursor: 'pointer'});",
"",
"// make the table header of the nested table",
"var format = function(d, childId){",
" if(d != null){",
" var html = ",
" '<table class=\"display compact hover\" id=\"' + childId + '\"><thead><tr>';",
" for (var key in d[d.length-1][0]) {",
" html += '<th>' + key + '</th>';",
" }",
" html += '</tr></thead></table>'",
" return html;",
" } else {",
" return '';",
" }",
"};",
"",
"// row callback to style the rows of the child tables",
"var rowCallback = function(row, dat, displayNum, index){",
" if($(row).hasClass('odd')){",
" $(row).css('background-color', 'papayawhip');",
" $(row).hover(function(){",
" $(this).css('background-color', '#E6FF99');",
" }, function() {",
" $(this).css('background-color', 'papayawhip');",
" });",
" } else {",
" $(row).css('background-color', 'lemonchiffon');",
" $(row).hover(function(){",
" $(this).css('background-color', '#DDFF75');",
" }, function() {",
" $(this).css('background-color', 'lemonchiffon');",
" });",
" }",
"};",
"",
"// header callback to style the header of the child tables",
"var headerCallback = function(thead, data, start, end, display){",
" $('th', thead).css({",
" 'border-top': '3px solid indigo',",
" 'color': 'indigo',",
" 'background-color': '#fadadd'",
" });",
"};",
"",
"// make the datatable",
"var format_datatable = function(d, childId){",
" var dataset = [];",
" var n = d.length - 1;",
" for(var i = 0; i < d[n].length; i++){",
" var datarow = $.map(d[n][i], function (value, index) {",
" return [value];",
" });",
" dataset.push(datarow);",
" }",
" var id = 'table#' + childId;",
" if (Object.keys(d[n][0]).indexOf('_details') === -1) {",
" var subtable = $(id).DataTable({",
" 'data': dataset,",
" 'autoWidth': true,",
" 'deferRender': true,",
" 'info': false,",
" 'lengthChange': false,",
" 'ordering': d[n].length > 1,",
" 'order': [],",
" 'paging': false,",
" 'scrollX': false,",
" 'scrollY': false,",
" 'searching': false,",
" 'sortClasses': false,",
" 'rowCallback': rowCallback,",
" 'headerCallback': headerCallback,",
" 'columnDefs': [{targets: '_all', className: 'dt-center'}]",
" });",
" } else {",
" var subtable = $(id).DataTable({",
" 'data': dataset,",
" 'autoWidth': true,",
" 'deferRender': true,",
" 'info': false,",
" 'lengthChange': false,",
" 'ordering': d[n].length > 1,",
" 'order': [],",
" 'paging': false,",
" 'scrollX': false,",
" 'scrollY': false,",
" 'searching': false,",
" 'sortClasses': false,",
" 'rowCallback': rowCallback,",
" 'headerCallback': headerCallback,",
" 'columnDefs': [",
" {targets: -1, visible: false},",
" {targets: 0, orderable: false, className: 'details-control'},",
" {targets: '_all', className: 'dt-center'}",
" ]",
" }).column(0).nodes().to$().css({cursor: 'pointer'});",
" }",
"};",
"",
"// display the child table on click",
"table.on('click', 'td.details-control', function(){",
" var tbl = $(this).closest('table'),",
" tblId = tbl.attr('id'),",
" td = $(this),",
" row = $(tbl).DataTable().row(td.closest('tr')),",
" rowIdx = row.index();",
" if(row.child.isShown()){",
" row.child.hide();",
" td.html('&oplus;');",
" } else {",
" var childId = tblId + '-child-' + rowIdx;",
" row.child(format(row.data(), childId)).show();",
" td.html('&CircleMinus;');",
" format_datatable(row.data(), childId);",
" }",
"});")
## datatable
datatable(Dat, callback = callback, escape = -2,
options = list(
columnDefs = list(
list(visible = FALSE, targets = ncol(Dat)),
list(orderable = FALSE, className = 'details-control', targets = 1),
list(className = "dt-center", targets = "_all")
)
))
# other example ####
library(data.table)
mtcars_dt <- data.table(mtcars)
setkey(mtcars_dt, mpg, cyl)
mpg_dt <- unique(mtcars_dt[, list(mpg, cyl)])
setkey(mpg_dt, mpg, cyl)
cyl_dt <- unique(mtcars_dt[, list(cyl)])
setkey(cyl_dt, cyl)
mtcars_dt <-
mtcars_dt[, list("_details" = list(purrr::transpose(.SD))), by = list(mpg,cyl)]
mtcars_dt[, ' ' := '&oplus;']
mpg_dt <- merge(mpg_dt, mtcars_dt, all.x = TRUE)
setkey(mpg_dt, cyl)
setcolorder(mpg_dt, c(length(mpg_dt), c(1:(length(mpg_dt) - 1))))
mpg_dt <- mpg_dt[,list("_details" = list(purrr::transpose(.SD))), by = cyl]
mpg_dt[, ' ' := '&oplus;']
cyl_dt <- merge(cyl_dt, mpg_dt, all.x = TRUE)
setcolorder(cyl_dt, c(length(cyl_dt), c(1:(length(cyl_dt) - 1))))
datatable(cyl_dt, callback = callback, escape = -2,
options = list(
columnDefs = list(
list(visible = FALSE, targets = ncol(cyl_dt)),
list(orderable = FALSE, className = 'details-control', targets = 1),
list(className = "dt-center", targets = "_all")
)
))
Raw
DT_childTables_MultipleNesting3.R
library(DT)
##~~ Multiple levels of nesting ~~##
## data
dat <- data.frame(
Sr = c(1.5, 2.3),
Description = c("A - B", "X - Y")
)
## details of row 1
subsubdat1 <- data.frame(
Ref = c("UVW", "PQR"),
Case = c(99, 999),
stringsAsFactors = FALSE
)
subdat1 <- data.frame(
Chromosome = "chr18",
SNP = "rs2",
"_details" = I(list(purrr::transpose(subsubdat1))),
stringsAsFactors = FALSE,
check.names = FALSE
)
subdat1 <- cbind(" " = "&oplus;", subdat1, stringsAsFactors = FALSE)
## details of row 2
subdat2 <- data.frame(
Chromosome = c("chr19","chr20"),
SNP = c("rs3","rs4"),
stringsAsFactors = FALSE
)
## merge the row details
subdats <- lapply(list(subdat1, subdat2), purrr::transpose)
## dataframe for the datatable
Dat <- cbind(" " = "&oplus;", dat, "_details" = I(subdats))
## whether to show row names
rowNames <- FALSE
colIdx <- as.integer(rowNames)
## the callback
callback = JS(
sprintf("table.column(%d).nodes().to$().css({cursor: 'pointer'});", colIdx),
"",
"// make the table header of the nested table",
"var format = function(d, childId){",
" if(d != null){",
" var html = ",
" '<table class=\"display compact hover\" ' + ",
" 'style=\"padding-left:50px;\" id=\"' + childId + '\"><thead><tr>';",
" for(var key in d[d.length-1][0]){",
" html += '<th>' + key + '</th>';",
" }",
" html += '</tr></thead></table>'",
" return html;",
" } else {",
" return '';",
" }",
"};",
"",
"// row callback to style the rows of the child tables",
"var rowCallback = function(row, dat, displayNum, index){",
" if($(row).hasClass('odd')){",
" $(row).css('background-color', 'papayawhip');",
" $(row).hover(function(){",
" $(this).css('background-color', '#E6FF99');",
" }, function() {",
" $(this).css('background-color', 'papayawhip');",
" });",
" } else {",
" $(row).css('background-color', 'lemonchiffon');",
" $(row).hover(function(){",
" $(this).css('background-color', '#DDFF75');",
" }, function() {",
" $(this).css('background-color', 'lemonchiffon');",
" });",
" }",
"};",
"",
"// header callback to style the header of the child tables",
"var headerCallback = function(thead, data, start, end, display){",
" $('th', thead).css({",
" 'border-top': '3px solid indigo',",
" 'color': 'indigo',",
" 'background-color': '#fadadd'",
" });",
"};",
"",
"// make the datatable",
"var format_datatable = function(d, childId){",
" var dataset = [];",
" var n = d.length - 1;",
" for(var i = 0; i < d[n].length; i++){",
" var datarow = $.map(d[n][i], function (value, index) {",
" return [value];",
" });",
" dataset.push(datarow);",
" }",
" var id = 'table#' + childId;",
" if (Object.keys(d[n][0]).indexOf('_details') === -1) {",
" var subtable = $(id).DataTable({",
" 'data': dataset,",
" 'autoWidth': true,",
" 'deferRender': true,",
" 'info': false,",
" 'lengthChange': false,",
" 'ordering': d[n].length > 1,",
" 'order': [],",
" 'paging': false,",
" 'scrollX': false,",
" 'scrollY': false,",
" 'searching': false,",
" 'sortClasses': false,",
" 'rowCallback': rowCallback,",
" 'headerCallback': headerCallback,",
" 'columnDefs': [{targets: '_all', className: 'dt-center'}]",
" });",
" } else {",
" var subtable = $(id).DataTable({",
" 'data': dataset,",
" 'autoWidth': true,",
" 'deferRender': true,",
" 'info': false,",
" 'lengthChange': false,",
" 'ordering': d[n].length > 1,",
" 'order': [],",
" 'paging': false,",
" 'scrollX': false,",
" 'scrollY': false,",
" 'searching': false,",
" 'sortClasses': false,",
" 'rowCallback': rowCallback,",
" 'headerCallback': headerCallback,",
" 'columnDefs': [",
" {targets: -1, visible: false},",
" {targets: 0, orderable: false, className: 'details-control'},",
" {targets: '_all', className: 'dt-center'}",
" ]",
" }).column(0).nodes().to$().css({cursor: 'pointer'});",
" }",
"};",
"",
"// display the child table on click",
"table.on('click', 'td.details-control', function(){",
" var tbl = $(this).closest('table'),",
" tblId = tbl.attr('id'),",
" td = $(this),",
" row = $(tbl).DataTable().row(td.closest('tr')),",
" rowIdx = row.index();",
" if(row.child.isShown()){",
" row.child.hide();",
" td.html('&oplus;');",
" } else {",
" var childId = tblId + '-child-' + rowIdx;",
" row.child(format(row.data(), childId)).show();",
" td.html('&CircleMinus;');",
" format_datatable(row.data(), childId);",
" }",
"});")
## datatable
datatable(Dat, callback = callback, rownames = rowNames, escape = -colIdx-1,
options = list(
columnDefs = list(
list(visible = FALSE, targets = ncol(Dat)-1+colIdx),
list(orderable = FALSE, className = 'details-control', targets = colIdx),
list(className = "dt-center", targets = "_all")
)
))
Raw
DT_childTables_noChildsForAllRows.R
library(DT)
## data
dat <- data.frame(
Sr = c(1.5, 2.3, 8.9),
Description = c("A - B", "U - V", "X - Y")
)
## details of row 1
subdat1 <- data.frame(
Chromosome = "chr18",
SNP = "rs2",
stringsAsFactors = FALSE
)
## details of row 2 (no details)
subdat2 <- data.frame(NULL)
## details of row 3
subdat3 <- data.frame(
Chromosome = c("chr19","chr20"),
SNP = c("rs3","rs4"),
stringsAsFactors = FALSE
)
## merge the row details
subdats <- lapply(list(subdat1, subdat2, subdat3), purrr::transpose)
## dataframe for the datatable
oplus <- sapply(subdats, function(x) if(length(x)) "&oplus;" else "")
Dat <- cbind(" " = oplus, dat, details = I(subdats))
## the callback
rows <- which(Dat[,1] != "")
callback <- JS(
sprintf("var rows = [%s];", toString(rows-1)),
"var nrows = table.rows().count();",
"for(var i=0; i < nrows; ++i){",
" if(rows.indexOf(i) > -1){",
" table.cell(i,1).nodes().to$().css({cursor: 'pointer'});",
" }else{",
" table.cell(i,1).nodes().to$().removeClass('details-control');",
" }",
"}",
"// Format the nested table into another table",
"var childId = function(d){",
" var tail = d.slice(2, d.length - 1);",
" return 'child_' + tail.join('_').replace(/[\\s|\\.|'|,|\\(|\\)]/g, '_');",
"};",
"var format = function (d) {",
" if (d != null) {",
" var id = childId(d);",
" var html = ",
" '<table class=\"display compact\" id=\"' + id + '\"><thead><tr>';",
" for (var key in d[d.length-1][0]) {",
" html += '<th>' + key + '</th>';",
" }",
" html += '</tr></thead></table>'",
" return html;",
" } else {",
" return '';",
" }",
"};",
"var rowCallback = function(row, dat, displayNum, index){",
" if($(row).hasClass('odd')){",
" for(var j=0; j<dat.length; j++){",
" $('td:eq('+j+')', row).css('background-color', 'papayawhip');",
" }",
" } else {",
" for(var j=0; j<dat.length; j++){",
" $('td:eq('+j+')', row).css('background-color', 'lemonchiffon');",
" }",
" }",
"};",
"var headerCallback = function(thead, data, start, end, display){",
" $('th', thead).css({",
" 'border-top': '3px solid indigo',",
" 'color': 'indigo',",
" 'background-color': '#fadadd'",
" });",
"};",
"var format_datatable = function (d) {",
" var dataset = [];",
" var n = d.length - 1;",
" for (var i = 0; i < d[n].length; i++) {",
" var datarow = $.map(d[n][i], function (value, index) {",
" return [value];",
" });",
" dataset.push(datarow);",
" }",
" var id = 'table#' + childId(d);",
" var subtable = $(id).DataTable({",
" 'data': dataset,",
" 'autoWidth': true,",
" 'deferRender': true,",
" 'info': false,",
" 'lengthChange': false,",
" 'ordering': d[n].length > 1,",
" 'order': [],",
" 'paging': false,",
" 'scrollX': false,",
" 'scrollY': false,",
" 'searching': false,",
" 'sortClasses': false,",
" 'rowCallback': rowCallback,",
" 'headerCallback': headerCallback,",
" 'columnDefs': [{targets: '_all', className: 'dt-center'}]",
" });",
"};",
"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('&CircleMinus;');",
" format_datatable(row.data());",
" }",
"});")
## datatable
datatable(Dat, callback = callback, escape = -2,
options = list(
columnDefs = list(
list(visible = FALSE, targets = ncol(Dat)),
list(orderable = FALSE, className = 'details-control', targets = 1),
list(className = "dt-center", targets = "_all")
)
))
Raw
DT_childTables_Shiny.R
library(shiny)
library(DT)
library(jsonlite)
## data ####
dat <- data.frame(
Sr = c(1.5, 2.3),
Description = c("A - B", "X - Y")
)
## details of row 1
subdat1 <- data.frame(
Chromosome = "chr18",
SNP = "rs2",
stringsAsFactors = FALSE
)
## details of row 2
subdat2 <- data.frame(
Chromosome = c("chr19","chr20"),
SNP = c("rs3","rs4"),
stringsAsFactors = FALSE
)
## merge the row details
subdats <- lapply(list(subdat1, subdat2), purrr::transpose)
## dataframe for the datatable
Dat <- cbind(" " = "&oplus;", dat, details = I(subdats))
## the callback ####
registerInputHandler("x.child", function(x, ...) {
fromJSON(toJSON(x, auto_unbox = TRUE, null = "null"), simplifyDataFrame = FALSE)
}, force = TRUE)
callback = JS(
"var expandColumn = table.column(0).data()[0] === '&oplus;' ? 0 : 1;",
"table.column(expandColumn).nodes().to$().css({cursor: 'pointer'});",
"",
"// send selected columns to Shiny",
"var tbl = table.table().node();",
"var tblId = $(tbl).closest('.datatables').attr('id');",
"table.on('click', 'td:not(:nth-child(' + (expandColumn+1) + '))', function(){",
" setTimeout(function(){",
" var indexes = table.rows({selected:true}).indexes();",
" var indices = Array(indexes.length);",
" for(var i = 0; i < indices.length; ++i){",
" indices[i] = indexes[i];",
" }",
" Shiny.setInputValue(tblId + '_rows_selected', indices);",
" },0);",
"});",
"",
"// Format the nested table into another table",
"var format = function(d, childId){",
" if (d != null) {",
" var html = ",
" '<table class=\"display compact\" id=\"' + childId + '\"><thead><tr>';",
" for (var key in d[d.length-1][0]) {",
" html += '<th>' + key + '</th>';",
" }",
" html += '</tr></thead></table>'",
" return html;",
" } else {",
" return '';",
" }",
"};",
"var rowCallback = function(row, dat, displayNum, index){",
" if($(row).hasClass('odd')){",
" for(var j=0; j<dat.length; j++){",
" $('td:eq('+j+')', row).css('background-color', 'papayawhip');",
" }",
" } else {",
" for(var j=0; j<dat.length; j++){",
" $('td:eq('+j+')', row).css('background-color', 'lemonchiffon');",
" }",
" }",
"};",
"var headerCallback = function(thead, data, start, end, display){",
" $('th', thead).css({",
" 'border-top': '3px solid indigo',",
" 'color': 'indigo',",
" 'background-color': '#fadadd'",
" });",
"};",
"var format_datatable = function(d, childId){",
" var dataset = [];",
" var n = d.length - 1;",
" for (var i = 0; i < d[n].length; i++) {",
" var datarow = $.map(d[n][i], function(value, index){",
" return [value];",
" });",
" dataset.push(datarow);",
" }",
" var id = 'table#' + childId;",
" var subtable = $(id).DataTable({",
" 'data': dataset,",
" 'autoWidth': true,",
" 'deferRender': true,",
" 'info': false,",
" 'lengthChange': false,",
" 'ordering': d[n].length > 1,",
" 'paging': false,",
" 'scrollX': false,",
" 'scrollY': false,",
" 'searching': false,",
" 'sortClasses': false,",
" 'rowCallback': rowCallback,",
" 'headerCallback': headerCallback,",
" 'select': {style: 'multi'},",
" 'columnDefs': [{targets: '_all', className: 'dt-center'}]",
" });",
"};",
"",
"var nrows = table.rows().count();",
"var nullinfo = Array(nrows);",
"for(var i = 0; i < nrows; ++i){",
" nullinfo[i] = {child : 'child-'+i, selected: null};",
"}",
"Shiny.setInputValue(tblId + '_children:x.child', nullinfo);",
"var sendToR = function(){",
" var info = [];",
" setTimeout(function(){",
" for(var i = 0; i < nrows; ++i){",
" var childId = 'child-' + i;",
" var childtbl = $('#'+childId).DataTable();",
" var indexes = childtbl.rows({selected:true}).indexes();",
" var indices;",
" if(indexes.length > 0){",
" indices = Array(indexes.length);",
" for(var j = 0; j < indices.length; ++j){",
" indices[j] = indexes[j];",
" }",
" } else {",
" indices = null;",
" }",
" info.push({child: childId, selected: indices});",
" }",
" Shiny.setInputValue(tblId + '_children:x.child', info);",
" }, 0);",
"}",
"$('body').on('click', '[id^=child-] td', sendToR);",
"",
"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;');",
" sendToR();",
" } else {",
" var childId = 'child-' + row.index();",
" row.child(format(row.data(), childId)).show();",
" row.child.show();",
" td.html('&CircleMinus;');",
" format_datatable(row.data(), childId);",
" }",
"});")
## shiny app ####
ui <- fluidPage(
DTOutput("table"),
verbatimTextOutput("info")
)
server <- function(input, output){
output[["table"]] <- renderDT({
datatable(Dat, callback = callback, escape = -2,
extensions = "Select", selection = "none",
options = list(
select = list(style = "multi", selector = ".selectable"),
autoWidth = FALSE,
columnDefs = list(
list(className = "selectable dt-center",
targets = c(0, 2:ncol(Dat))),
list(visible = FALSE, targets = ncol(Dat)),
list(orderable = FALSE, className = 'details-control',
width = "10px", targets = 1),
list(className = "dt-center", targets = "_all")
)
)
)
}, server = FALSE)
output[["info"]] <- renderText({
text <- sprintf("Selected row(s) of main table: %s\n",
input[["table_rows_selected"]])
text <- c(text, "Selected row(s) of children:\n")
text <- c(text, paste0(input[["table_children"]], collapse="\n"))
text
})
observe({
print("------------------")
print(input[["table_rows_selected"]])
print("------------------")
print(input[["table_children"]])
})
}
shinyApp(ui, server)
Raw
DT_childTables_vertical.R
library(DT)
##~~ vertical subtable ~~##
## data
dat <- data.frame(
Sr = c(1, 2),
Description = c("A - B", "X - Y")
)
## row details
details <- list(list(Chromosome = "chr18", SNP = "rs2"),
list(Chromosome = "chr19", SNP = "rs3"))
# or
details <- data.frame(
Chromosome = c("chr18", "chr19"),
SNP = c("rs2", "rs3"),
stringsAsFactors = FALSE
) %>% purrr::transpose()
## dataframe for datatable
Dat <- cbind(" " = "&oplus;", dat, details = I(details))
## the callback
callback = JS(
"table.column(1).nodes().to$().css({cursor: 'pointer'});",
"var format = function (d) {",
" var result = '<div><table style=\"background-color:#fadadd\">';",
" for(var key in d[d.length-1]){",
" result += '<tr style=\"background-color:#fadadd\"><td><b>' + key +",
" '</b>:</td><td>' + d[4][key] + '</td></tr>';",
" }",
" result += '</table></div>';",
" return result;",
"}",
"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('&CircleMinus;');",
" }",
"});")
## datatable
datatable(Dat, callback = callback, escape = -2,
options = list(
columnDefs = list(
list(className = "dt-center", targets = 2:ncol(Dat)),
list(visible = FALSE, targets = ncol(Dat)),
list(orderable = FALSE, className = 'details-control', targets = 1)
)
))
@GitHunter0
Copy link

GitHunter0 commented Dec 3, 2020 •
edited
Loading

Thank you @stla, awesome gists!
Is there a way to avoid so much vertical blank space in nested tables?
Also, how difficult would it be to implement nested tables in DT to make it as simple as with reactable?
https://glin.github.io/reactable/articles/examples.html#expandable-row-details

@stla
Copy link
Author

stla commented Dec 4, 2020

Hello @GitHunter0,

See my blog for a cleaner solution. What is the blank space you are talking about?

@GitHunter0
Copy link

Hey @stla , thank you, I will definitively check that out.
I saw that the blank space is only appearing in RStudio's viewer. In the browser, the blank space disappears.

@omerrgithub
Copy link

Can anyone kindly help me I have the following code, I require 1 Parent table which then expand to child and further expand to another child.

My code is here:

library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)

ui <- fluidPage(fluidRow(DT::dataTableOutput(width = "100%", "table")))

server <- function(input, output) {

output$table = DT::renderDataTable({
# Sample data

DATA <- data.table(Team = c(3,3, 4, 4, 39, 41, 43), 
                   Workdone = c(2,2, 1, 1, 1, 1), 
                   Q1 = c(0,0, 0, 0, 0, 0), 
                   Q2 = c(1, 1, 1, 1,1,1), 
                   Q3 = c(0,0, 0, 0, 0, 0), 
                   Name = c("A", "B", "C", "D", "E", "F"), 
                   Number = c(1, 1, 1, 1,1,1), 
                   q1 = c(0,0,0,0,0,0), 
                   q2 = c(100, 100, 100, 100, 100, 100),
                   q3 = c(0,0,0,0,0,0),
                   Data = c("2020","2021", "2011", "2021", "2011", "2015"), 
                   Type = c("Normal","Normal","Normal","Normal","Normal","Normal"), 
                   ID = c(0,0, 0, 0, 0, 0), 
                   ID2 = c("A", "B", "C", "D", "E", "F"), 
                   Channel = c(1, 1, 1, 1,1,1), 
                   Topic1 = c(0,0,0,0,0,0), 
                   Topic2 = c(100, 100, 100, 100, 100, 100),
                   Topic3 = c(0,0,0,0,0,0))








DATA <- data.table(DATA)


#breaking 2 child tables
DATA2 <-DATA[,c(6:17)]


DATA2 <- DATA2[,
               list(cars=list(.SD)),
               by = list(Name,Number,q1,q2,q3)]
DATA2 <- cbind(' ' = '&#9658;', DATA2)
#


# Turn data table into a nested data.table by mpg, cyl
DATA <- DATA[,
             list(cars=list(DATA2)),
             by = list(Team, Workdone,Q1,Q2,Q3)]
DATA <- cbind(' ' = '&#9658;', DATA)

callback <-  DT::JS("table.column(1).nodes().to$().css({cursor: 'pointer'});",
                    "// Format the nested table into another table",
                    "var childId = function(d){",
                    "var tail = d.slice(2, d.length - 1);",
                    " return 'child_' + tail.join('_').replace(/[\\s|\\.|'|,|\\(|\\)]/g, '_');",
                    "};",
                    "var format = function (d) {",
                    "  if (d != null) {",
                    "    var id = childId(d);",
                    "    var html = ",
                    "          '<table class=\"display compact\" id=\"' + id + '\"><thead><tr>';",
                    "    for (var key in d[d.length-1][0]) {",
                    "      html += '<th>' + key + '</th>';",
                    "    }",
                    "    html += '</tr></thead></table>'",
                    "    return html;",
                    "  } else {",
                    "    return '';",
                    "  }",
                    "};",
                    "var rowCallback = function(row, dat, displayNum, index){",
                    "  if($(row).hasClass('odd')){",
                    "    for(var j=0; j<dat.length; j++){",
                    "      $('td:eq('+j+')', row).css('background-color', 'white');",
                    "    }",
                    "  } else {",
                    "    for(var j=0; j<dat.length; j++){",
                    "      $('td:eq('+j+')', row).css('background-color', 'white');",
                    "    }",
                    "  }",
                    "};",
                    "var headerCallback = function(thead, data, start, end, display){",
                    "  $('th', thead).css({",
                    "    'border-top': '2px black' ,",
                    "    'color': 'black' ,",
                    "    'background-color': '#ffffff'",
                    "  });",
                    "};",
                    "var format_datatable = function (d) {",
                    "  var dataset = [];",
                    "  var n = d.length - 1;",
                    "  for (var i = 0; i < d[n].length; i++) {",
                    "    var datarow = $.map(d[n][i], function (value, index) {",
                    "      return [value];",
                    "    });",
                    "    dataset.push(datarow);",
                    "  }",
                    "  var id = 'table#' + childId(d);",
                    "  var subtable = $(id).DataTable({",
                    "                     'data': dataset ,",
                    "                     'autoWidth': true ,",
                    "                     'deferRender': true ,",
                    "                     'info': false ,",
                    "                     'lengthChange': false ,",
                    "                     'ordering': d[n].length > 1 ,",
                    "                     'order': [] ,",
                    "                     'paging': false ,",
                    "                     'scrollX': false ,",
                    "                     'scrollY': false ,",
                    "                     'searching': false ,",
                    "                     'sortClasses': false ,",
                    "                     'rowCallback': rowCallback ,",
                    "                     'headerCallback': headerCallback ,",
                    "            'columnDefs': [",
                    "              {targets: 3, width: '50px'},",
                    "              {targets: 4, width: '50px'},",
                    "              {targets: 5, width: '50px'},",
                    "              {targets: 0, width: '100px'},",
                    "              {targets: 1, width: '75px'},",
                    "              {targets: 2, width: '60px'},",
                    "              {targets: 0, className: 'dt-right'}",
                    "             ]",
                    "                   });",
                    "};",
                    "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('&#9658;');",
                    "  } else {",
                    "    row.child(format(row.data())).show();",
                    "    td.html('&CircleMinus;');",
                    "    format_datatable(row.data());",
                    "  }",
                    "});"
)


datatable(
  
  #configure datatable. Hide row number and cars columns [0,4] and enable details control on plus sign column[1]
  #turn rows into child rows and remove from parent
  
  
  DATA,
  escape = TRUE,
  options = list(
    searching = FALSE,
    dom = 't',pageLength = 30,
    columnDefs = list((list(className = 'details-center', targets = c(2:7))),
                      
                      list(orderable = FALSE, className = 'details-control', targets = 1)
                      
    )
  ),
  callback = DT::JS(callback)
)

},server = FALSE)
}

shinyApp (ui = ui, server = server)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment