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

简介

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)] + 1
  rownames(x) <- NULL
  if (nrow(x) > 0) x <- cbind(' ' = '&oplus;', x)
  # options
  opts <- 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)] + 1
  rownames(x) <- NULL
  if (nrow(x) > 0) x <- cbind(' ' = '<img src=\"https://raw.githubusercontent.com/DataTables/DataTables/master/examples/resources/details_open.png\"/>', x)
  
  # options
  opts <- 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中，部署好之后，用浏览器才能看到图片按钮 )