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