我正在使用 davlee1972 在 GitHub 上发布的一些代码。这段代码已经在 mtcars 文件上进行了训练,然后更改为我自己的数据。
这里的问题是,虽然代码适用于前两个子/父关系,但它似乎只发布最后一个子的列标题。
代码:
library(data.table)
library(DT)
library(shiny)
ui <- fluidPage(fluidRow(DT::dataTableOutput(width = "100%", "table")))
server <- function(input, output) {
output$table = DT::renderDataTable({
# 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(mtcars=list(.SD)), by = list(mpg,cyl)]
# mtcars_dt[, ' ' := '►']
#
# 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(mpg=list(.SD)), by = cyl]
# mpg_dt[, ' ' := '►']
#
# cyl_dt = merge(cyl_dt,mpg_dt, all.x = TRUE )
# setcolorder(cyl_dt, c(length(cyl_dt),c(1:(length(cyl_dt) - 1))))
DT::datatable(
data = child_1lvl,
rownames = FALSE,
escape = -1,
extensions = c( 'Scroller'),
options = list(
dom = 'Bfrti',
autoWidth = TRUE,
stripeClasses = list(),
deferRender = TRUE,
scrollX = TRUE,
scrollY = "51vh",
scroller = TRUE,
scollCollapse = TRUE,
columnDefs = list(
list(orderable = FALSE, className = 'details-control', targets = 0),
list(visible = FALSE, targets = -1 )
)
),
callback = JS("
table.column(1).nodes().to$().css({cursor: 'pointer'})
// Format child object into another table
var format = function(d) {
if(d != null){
var result = ('<table id=\"' + d[1] + '\"><thead><tr>').replace('.','_')
for (var col in d[d.length - 1][0]){
result += '<th>' + col + '</th>'
}
result += '</tr></thead></table>'
return result
}else{
return ''
}
}
var format_datatable = function(d) {
if(d != null){
if ('SOME CHECK' == 'LAST SET OF CHILD TABLES') {
var subtable = $(('table#' + d[1]).replace('.','_')).DataTable({
'data': d[d.length - 1].map(Object.values),
'autoWidth': true,
'deferRender': true,
'stripeClasses': [],
'info': false,
'lengthChange': false,
'ordering': false,
'paging': false,
'scrollX': false,
'scrollY': false,
'searching': false
}).draw()
}else{
var subtable = $(('table#' + d[1]).replace('.','_')).DataTable({
'data': d[d.length - 1].map(Object.values),
'autoWidth': true,
'deferRender': true,
'stripeClasses': [],
'info': false,
'lengthChange': false,
'ordering': false,
'paging': false,
'scrollX': false,
'scrollY': false,
'searching': false,
'columnDefs': [{'orderable': false, 'className': 'details-control', 'targets': 0},
{'visible': false, 'targets': -1}]
}).draw()
}
}
}
//var sub_tbl_id = 0;
table.on('click', 'td.details-control', function() {
var table = $(this).closest('table')
var td = $(this)
var row = $(table).DataTable().row(td.closest('tr'))
if (row.child.isShown()) {
row.child.hide()
td.html('►')
} else {
row.child(format(row.data())).show()
format_datatable(row.data())
td.html('▼')
}
})
")
)
},server = TRUE)
}
shinyApp (ui = ui, server = server)
生成的网页如下所示,仅显示 AccounReffullname 和 Fullamount 标题,而不是每个财务类别下方应有的多行。
此外,对于 COGS 组件,它似乎只显示 AccountReffullname 列,而缺少 Fullamount 列。
我的问题是,它在 javascript 中的哪个位置控制子/父关系的层数,是否有人知道为什么这在 mtcars 文件上有效,但在我自己的数据的相同格式上却失败了。
我使用的代码已发布在以下链接上:
https://github.com/rstudio/DT/issues/525 https://github.com/rstudio/shiny-examples/issues/9#issuecomment-362000334
这段代码的问题在于,它使用行的内容来构建子表的标识符,并且禁止在标识符中使用点和空格。正如您所看到的,包含空格的行不会出现子表。
代码通过执行
replace('.','_')
来替换点。一般来说,这还不够,因为这仅替换第一次出现的点(带下划线)。在下面的代码中,我通过执行 replace(/[\\s|\\.]/g, '_')
将点和空格替换为下划线。 g
表示“全局”:这会替换所有出现的情况。
要使用我的代码,子表必须包含在名为
"details"
的列中,并且这必须是最后一列。此代码允许多层嵌套:您还可以为子表的一行定义子表。在此示例中,第一行有两层嵌套。
library(DT)
## 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(" " = "⊕", 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(" " = "⊕", 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);",
" 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('⊕');",
" } else {",
" row.child(format(row.data())).show();",
" td.html('⊖');",
" 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")
)
))
这是一个更好的解决方案。这个不使用行内容来构建标识符。代码更简单,这允许具有相同的行。我已将
details
更改为 _details
,以防用户在其数据集中有一列名为 details
。
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(" " = "⊕", 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(" " = "⊕", 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('⊕');",
" } else {",
" var childId = tblId + '-child-' + rowIdx;",
" row.child(format(row.data(), childId)).show();",
" td.html('⊖');",
" 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")
)
))
这是分层数据的示例:
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[, ' ' := '⊕']
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[, ' ' := '⊕']
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")
)
))