R闪亮包装中的父/子行
我在Javascript中的背景不存在，因此诉诸于使用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
任何帮助将不胜感激！
谢谢 piyuw
1 个答案:
答案 0 :(得分：2)
此代码的问题在于，它使用行的内容来构建子表的标识符，并且禁止在标识符中使用点和空格。如您所见，子表不会出现在包含空格的行中。
该代码通过执行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")
)
))
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？