R中的父/子行
Posted
技术标签:
【中文标题】R中的父/子行【英文标题】：Parent/Child Rows in R 【发布时间】：2020-06-25 00:20:28 【问题描述】：我正在尝试使用一些 javascript 来创建带有父/子嵌套的漂亮表格布局。我每个父母只需要一个孩子。我有两个数据框。这里的目标是制作一个组合这两个数据框的表格。到目前为止，我能够做到这一点。但是，这里的问题是我只能让代码在 df1 中为一行工作。当我将另一行添加到 df1 时，我得到Error in data.frame: arguments imply differing number of rows: 1, 2。例如，当我在 df1 中只有一行时达到了预期的结果，但当有多行时，我可以上面的错误。
df #1
structure(list(Market = c("ALBANY-SCHENECTADY-TROY, NY", "ALBANY, GA",
"ALBUQUERQUE-SANTA FE"), Gross = c("$0", "$0", "$0"), Net = c("$0",
"$0", "$0"), GRP = c(100, 100, 100), `Demo Impressions` = c("957,776",
"238,792", "1,259,307"), `Gross CPP` = c("$0", "$0", "$0"), `Gross CPM` = c("$0",
"$0", "$0")), .Names = c("Market", "Gross", "Net", "GRP", "Demo Impressions",
"Gross CPP", "Gross CPM"), row.names = c(NA, -3L), class = "data.frame")
Market Gross Net GRP Demo Impressions Gross CPP Gross CPM
1 ALBANY-SCHENECTADY-TROY, NY $0 $0 100 957,776 $0 $0
2 ALBANY, GA $0 $0 100 238,792 $0 $0
3 ALBUQUERQUE-SANTA FE $0 $0 100 1,259,307 $0 $0
df #2
structure(list(Daypart = c("Daytime", "Early Fringe", "Early Morning",
"Early News", "Late Fringe", "Late News", "Prime Access", "Prime Time",
"Total"), `Share (%)` = c(15L, 10L, 15L, 10L, 10L, 10L, 15L,
15L, 100L), `Spot:30 (%)` = c(0, 0, 0, 0, 0, 0, 0, 0, 0), `Spot:15 (%)` = c(0,
0, 0, 0, 0, 0, 0, 0, 0), `Demo Impressions` = c("368,381", "245,588",
"368,381", "245,588", "245,588", "245,588", "368,381", "368,381",
"2,455,876"), Gross = c("$0", "$0", "$0", "$0", "$0", "$0", "$0",
"$0", "$0"), Net = c("$0", "$0", "$0", "$0", "$0", "$0", "$0",
"$0", "$0"), `Gross CPM` = c("$0", "$0", "$0", "$0", "$0", "$0",
"$0", "$0", "$-")), .Names = c("Daypart", "Share (%)", "Spot:30 (%)",
"Spot:15 (%)", "Demo Impressions", "Gross", "Net", "Gross CPM"
), row.names = c(NA, -9L), class = "data.frame")
Daypart Share (%) Spot:30 (%) Spot:15 (%) Demo Impressions Gross Net Gross CPM
1 Daytime 15 0 0 368,381 $0 $0 $0
2 Early Fringe 10 0 0 245,588 $0 $0 $0
3 Early Morning 15 0 0 368,381 $0 $0 $0
4 Early News 10 0 0 245,588 $0 $0 $0
5 Late Fringe 10 0 0 245,588 $0 $0 $0
6 Late News 10 0 0 245,588 $0 $0 $0
7 Prime Access 15 0 0 368,381 $0 $0 $0
8 Prime Time 15 0 0 368,381 $0 $0 $0
9 Total 100 0 0 2,455,876 $0 $0 $-
# Merge the row details
subdats <- lapply(
list(df2),
purrr::transpose
)
# Dataframe for the datatable
Dat <- cbind(
" " = "⊕",
df1,
details = I(subdats)
)
callback_js = 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', 'white');",
" $(row).hover(function()",
" $(this).css('background-color', 'white');",
" , function() ",
" $(this).css('background-color', 'white');",
" );",
" else ",
" $(row).css('background-color', 'white');",
" $(row).hover(function()",
" $(this).css('background-color', 'white');",
" , function() ",
" $(this).css('background-color', 'white');",
" );",
" ",
";",
"",
"// 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': 'white',",
" 'background-color': 'white'",
" );",
";",
"",
"// 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;",
" 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);",
" ",
");")
# Render the table
output$daypartTable <- DT::renderDataTable(
Dat <- Dat
DT::datatable(Dat, callback = callback_js, escape = -2, editable = TRUE,
options = list(
columnDefs = list(
list(visible = FALSE, targets = ncol(Dat)),
list(orderable = FALSE, className = 'details-control', targets = 1),
list(className = "dt-center", targets = "_all")
)
)
)
)
结果应如下所示，但有多个父行，每行来自 df1，子行来自 df2。
【问题讨论】：
您定义了subdats，但您不使用它。另外，我不明白你想要什么；你想让df2 成为df1 每一行的孩子吗？您能否将df1 和df2 包含在dput 中。
@StéphaneLaurent ，这是一个错字，请参阅编辑。是的，我希望 df2 成为 df1 每一行的子元素。 dput 是什么？
@StéphaneLaurent，我将为每个df1 和df2 添加dput。
【参考方案1】：
请在下面找到完整的代码。
我创建了一个函数NestedData，它为带有子行的数据表构造了所需的数据框。
在您的情况下，主表df1 有三行，df1 的每一行都有df2 作为子表，因此您必须这样做：
Dat <- NestedData(
dat = df1,
children = list(df2, df2, df2)
)
函数NestedData也可以在想要任意深度的嵌套时使用：子行的子行、子行的子行的子行等。此外，还可以在需要一些嵌套时使用没有孩子的行。下面是一个使用示例：
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
)
)
这是应用于您的示例的代码：
# function to make the required dataframe
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)) "⊕" else "")
cbind(" " = oplus, dat, "_details" = I(subdats), stringsAsFactors = FALSE)
# make the required dataframe
# one must have: length(children) == nrow(dat)
# EDIT: need to use replicate() on df2 for cases when there is an arbitrary
# number of rows in df1
n <- nrow(df1)
children_list <- replicate(n, df2, simplify = FALSE)
Dat <- NestedData(
dat = df1,
children = children_list
)
## whether to show row names (set TRUE or FALSE)
rowNames <- FALSE
colIdx <- as.integer(rowNames)
## make 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;",
" 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);",
" ",
");")
## the 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")
)
)
)
【讨论】：
非常感谢。我会试试这个。快速提问，这是否适用于df1 中的任意数量的行？假设我有超过三行，这仍然有效吗？
忽略这个问题。我想出了那个。如果有兴趣，请参阅编辑。再次非常感谢。打算研究一下你的解决方案中的废话，以便我完全理解它
在此盘旋。我注意到每次向 DataTable 添加父行时，它都会复制df2。但是，df2 对于每个父行都是唯一的。我尝试使用 for 循环，但在 NestedData 函数中不断出现错误。有什么想法吗？？
这项工作很棒！是否可以向嵌套数据添加其他按钮？谢谢
这是否也可以调整以解决this problem？让子行完全集成到父表中？以上是关于R中的父/子行的主要内容，如果未能解决你的问题，请参考以下文章
如何使用 StringAgg 或 ArrayAgg 连接多个子行中的一列来注释 django 查询集？