R Dataframe 中的多个标头

Question

我有一个返回以下数据框的函数

（下面的玩具示例代码）

df <- data.frame(
      var = c("var1 ------", "mod1", "mod2", "var2 ------","mod1", "mod2", "mod3"),
      X1_Y1 = c(NA,0,1,NA,1,3,5),
      X1_Y2 = c(NA,2,5,NA,2,4,10),
      X2_Y1 = c(NA,8,8,NA,3,3,1),
      X2_Y2 = c(NA,9,3,NA,0,6,2))

就上下文而言，这些只是一个感兴趣变量（

Y

，值为

Y1

和

Y2

）与解释变量（

var1

和

var2

）交叉并由另一个变量（

X

）分层的加权统计数据值为

X1

和

X2

）。

我想要的是有一个双行标题，例如：

我的限制是它必须在特定对象上完成：要么直接在 R

dataframe

上，要么可能在

DT::datatable

上。但我不确定这是否可能，如果是的话，真的不知道如何实现。

我找到了使用

flextable

或原始 html 的解决方案，但它不太适合我的目标。 （编辑：还尝试了

kableExtra::add_header_above

，它可以工作，但阻止我将我的

DT::datatable

对象保留在我的 rmd 中）

编辑：以下解决方案几乎可以完成工作，但在我看来，我需要放弃

DT::datatable

表示。

Answer 1

评论太长了。

您可以稍微重塑一下数据，并研究

container

中的

DT::datatable()

参数，cp。第2.6 自定义表容器部分。进一步细化应该会让您接近预期的输出。

df = data.frame(
  # var name changed from var to mod 
  mod = c("var1 ------", "mod1", "mod2", "var2 ------","mod1", "mod2", "mod3"),
  X1_Y1 = c(NA,0,1,NA,1,3,5),
  X1_Y2 = c(NA,2,5,NA,2,4,10),
  X2_Y1 = c(NA,8,8,NA,3,3,1),
  X2_Y2 = c(NA,9,3,NA,0,6,2))
df = cbind(grp = c(rep("var1", 2), rep("var2", 3)), df[-c(1, 4), ])
spans = c("Grouping", unique(sub("_.*", "", colnames(df)))[3:4])
cnms = sub(".*_", "", colnames(df))

library(DT)
library(htmltools)
sketch = withTags(table(
  class = 'display',
  thead(
    tr(
      lapply(spans, th, colspan = 2, class = "dt-center")
      ),
    tr(
      lapply(cnms, th)
      )
    )
  )
)
datatable(df, container = sketch, rownames = FALSE)

这给出了

Answer 2

感谢@Friede和@Limey的回答，加上this doc的第2.6节，加上我一开始错过的this thread，我想出了这个解决方案，只要列名跟随，它就应该适用于传递的每个df模式

ValueOfStratifyingVariable_ValueOfInterestVariable

f <- function(df) {
  # get names for both rows of header
  values <- matrix(unlist(strsplit(names(df)[-1], "_")),
                 ncol=2,
                 byrow=TRUE)

  head_row1 <- table(values[,1])
  head_row2 <- values[,2]

  # create custom table container
  sketch = htmltools::withTags(table(
    class = 'display',
    thead(
      tr(
        th(rowspan = 2, 'Var'),
        lapply(names(head_row1),
               function(x) {th(colspan = head_row1[[x]],
                               x, class = 'dt-center')})
      ),
      tr(
        lapply(head_row2,  th)
      )
    )
  ))
  
  # apply container to DT::datatable
  DT::datatable(df, container = sketch, rownames = FALSE)
}

f(df)

这会产生预期的输出：