shiny datatable child row：shiny表格二级子行的展开与折叠

文章目录

简介
代码示例
child row按钮的样式
- 具有样式的childTable代码如下:

简介

Rshiny中的datatable可用于我们展示表格数据，但是总会遇到表格内容太多，需要折叠的情况，类似于下面图片所示：
绿色按钮点开之后，可以展示每一行折叠的详细信息。

表格每行内容的二级子行信息，就叫做 Child Row

代码示例

我参考了一位外国博主的代码 , 来 shiny 中实现这样具有子信息的表格

childTable 是封装好的函数

childTable <- function(x, vars = NULL, opts = NULL, ...) {names_x <- names(x)if (is.null(vars)) stop("'vars' must be specified!")pos <- match(vars, names_x)pos <- pos[pos <= ncol(x)] + 1rownames(x) <- NULLif (nrow(x) > 0) x <- cbind(' ' = '&oplus;', x)# optionsopts <- c(opts,scrollX = TRUE,list(columnDefs = list(list(visible = FALSE, targets = c(0, pos)),list(orderable = FALSE, className = 'details-control', targets = 1),list(className = 'dt-left', targets = 1:3),list(className = 'dt-right', targets = 4:ncol(x)))))datatable(x,...,escape = F,options = opts,callback = JS(.callback2(x = x, pos = c(0, pos))))
}
.callback2 <- function(x, pos = NULL) {part1 <- "table.column(1).nodes().to$().css({cursor: 'pointer'});"part2 <- .child_row_table2(x, pos = pos)part3 <-"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('&ominus;');}});"paste(part1, part2, part3)
}
.child_row_table2 <- function(x, pos = NULL) {names_x <- paste0(names(x), ":")text <- "var format = function(d) {text = '<div><table>' +"for (i in seq_along(pos)) {text <- paste(text, glue::glue("'<tr>' +'<td>' + '{names_x[pos[i]]}' + '</td>' +'<td style=\"background-color:#eee; word-wrap:break-word;word-break:break-all; \">' + d[{pos[i]}] + '</td>' +'</tr>' + " ))}paste0(text,"'</table></div>'return text;};")
}

调用 childTable 函数，即可实现表格中插入子行
childTable 函数具有3个主要参数

x 即，我们data.frame的数据
vars 指x表格中，我们需要放在子行的那些数据的列名（本例中，我们想把 Age和 Employee ID列的数据放入子行）
opts 可以设置 pageLength 这些信息
其它，可以使用datatable的参数

注： dt.csv文件是从这个网址下载的示例文件

library(DT)
x <- read.csv("C:/Users/Administrator/Desktop/dt.csv")
x[["Employee ID"]] <- round(runif(nrow(x)) * 10000)
childTable(x = x,vars = c("Employee ID", "Age"),opts = list(pageLength = 5)
)

上述代码运行之后，得到的结果如图所示
点击圆圈里面带个+号的按钮，就可以直接展示二级子行的信息

child row按钮的样式

上面的代码虽然实现了二级子行信息的展示，但是按钮和二级表格颜色太朴素了，此时我们可以通过为 childTable 函数中的 td 和 相关语句 添加CSS样式实现从朴素表格到华丽表格的转身

添加了按钮样式和二级表格信息背景颜色的 childTable 函数代码：
（1）首先是按钮的样式，我们直接用图片替代

（2）然后是二级表格的 Background，这个用CSS的style内置于HTML元素中即可

具有样式的childTable代码如下:


childTable <- function(x, vars = NULL, opts = NULL, ...) {names_x <- names(x)if (is.null(vars)) stop("'vars' must be specified!")pos <- match(vars, names_x)#if (any(map_chr(x[, pos], typeof) == "list"))#  stop("list columns are not supported in datatable2()")pos <- pos[pos <= ncol(x)] + 1rownames(x) <- NULLif (nrow(x) > 0) x <- cbind(' ' = '<img src=\"https://raw.githubusercontent.com/DataTables/DataTables/master/examples/resources/details_open.png\"/>', x)# optionsopts <- c(opts,scrollX = TRUE,list(columnDefs = list(list(visible = FALSE, targets = c(0, pos)),list(orderable = FALSE, className = 'details-control', targets = 1),list(className = 'dt-left', targets = 1:3),list(className = 'dt-right', targets = 4:ncol(x)))))datatable(x, ...,escape = F,options = opts,callback = JS(.callback2(x = x, pos = c(0, pos))))
}
.callback2 <- function(x, pos = NULL) {part1 <- "table.column(1).nodes().to$().css({cursor: 'pointer'});"part2 <- .child_row_table2(x, pos = pos)part3 <- "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('<img src=\"https://raw.githubusercontent.com/DataTables/DataTables/master/examples/resources/details_open.png\"/>');} else {row.child(format(row.data())).show();td.html('<img src=\"https://raw.githubusercontent.com/DataTables/DataTables/master/examples/resources/details_close.png\" />');}});"paste(part1, part2, part3)
}
.child_row_table2 <- function(x, pos = NULL) {names_x <- paste0(names(x), ":")text <- "var format = function(d) {text = '<div><table>' + "for (i in seq_along(pos)) {text <- paste(text, glue::glue("'<tr>' +'<td style=\"background-color:#ADD8E6; font-weight:bold\">' + '{names_x[pos[i]]}' + '</td>' +'<td style=\"background-color:#F8F8FF; word-wrap:break-word;word-break:break-all; \">' + d[{pos[i]}] + '</td>' +'</tr>' + " ))}paste0(text,"'</table></div>'return text;};")
}

此时我们把加入了样式的代码放入 shinyApp中实现之后，通过浏览器打开就是这样的：(注：Rstudio的viewer看不到图片按钮的效果，只有你把它放在ShinyApp中，部署好之后，用浏览器才能看到图片按钮 )