R：根据条件隐藏 DT::datatable 中的单元格

Question

我正在尝试创建一个包含子行的数据table：用户将能够单击一个名称并查看与该名称相关的链接列表。但是，每个名称显示的项目数量不同。

> data1 <- data.frame(name = c("John", "Maria", "Afonso"),
                      a = c("abc", "def", "rty"),
                      b=c("ghj","lop",NA),
                      c=c("zxc","cvb",NA),
                      d=c(NA, "mko", NA))
> data1
    name   a    b    c    d
1   John abc  ghj  zxc <NA>
2  Maria def  lop  cvb  mko
3 Afonso rty <NA> <NA> <NA>

我正在使用 varsExplore::datatable2 隐藏特定列：

varsExplore::datatable2(x=data1,  vars=c("a","b","c","d"))

并产生以下结果

是否可以修改 DT::datatable 以便仅呈现非“空”的单元格？因此，例如，如果有人单击“Afonso”，table 将只呈现“rty”，从而隐藏其他列（对于该行）的“空”值，同时如果用户仍然显示这些列单击“Maria”（没有任何“null”）。

（我应该尝试不同的方法来实现这种行为吗？）

Answer 1

`varsExplore::datatable2`

的内部工作一览

根据您的要求，我查看了 varsExplore::datatable2 源代码。我发现 varsExplore::datatable2 调用 varsExplore:::.callback2（3: 表示它不是导出函数）来创建 javascript 代码。此函数还调用 varsExplore:::.child_row_table2 其中 returns 一个 javascript 函数 format(row_data) 将行数据格式化为您看到的 table。

建议的解决方案

我只是用我的 js 知识来改变 varsExplore:::.child_row_table2 的输出，我想出了以下结果：

.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(
      " (  d[{pos[i]}]!==null ? ( '<tr>' +   
          '<td>' + '{names_x[pos[i]]}' + '</td>' +
          '<td>' + d[{pos[i]}] + '</td>' +
        '</tr>' ) : '' ) + " ))
  }

  paste0(text,
         "'</table></div>'
      return text;};"
  )
}

我所做的唯一更改是添加 d[{pos[i]}]!==null ? ....... : ''，它只会在其值 d[pos[i]] 不为空时显示列 pos[i]。

考虑到加载包并将函数添加到全局环境并不能解决问题，我在 github 上进行了分叉并提交了更改，您现在可以通过 [=71 安装它了=]（github repo 是一个 read-only cran mirror 无法提交拉取请求）

devtools::install_github("moutikabdessabour/varsExplore")

编辑

如果您不想重新下载包，我基本上找到了一个解决方案，您需要覆盖 datatable2 函数：

首先将源代码复制到位于 path/to/your/Rfile

# the data.table way
data.table::fwrite(list(capture.output(varsExplore::datatable2)), quote=F, sep='\n', file="path/to/your/Rfile", append=T)

# the baseR way
fileConn<-file("path/to/your/Rfile", open='a')
writeLines(capture.output(varsExplore::datatable2), fileConn)
close(fileConn)

那你就得用最后一根线代替

DT::datatable(
  x, 
  ..., 
  escape = -2, 
  options = opts, 
  callback = DT::JS(.callback2(x = x, pos = c(0, pos))) 
)

与 :

DT::datatable(
  x,
  ...,
  escape = -2,
  options = opts,
  callback = DT::JS(gsub("('<tr>.+?(d\[\d+\]).+?</tr>')" , "(\2==null ? '' : \1)", varsExplore:::.callback2(x = x, pos = c(0, pos))))
)

这段代码主要做的是使用正则表达式添加 js 条件。

R：根据条件隐藏 DT::datatable 中的单元格

R: hide cells in DT::datatable based on condition

r

datatable

dt

`varsExplore::datatable2`

建议的解决方案

编辑

结果