在弹性表中添加表头 IN 表

Gab*_*lla 9 r flextable knitr

我正在尝试使用 flextable 制作一个漂亮的表格,该表格可以编织成单词,并带有描述性横幅/标题

示例数据:

trialdata<-structure(list(` ` = c("Number per team", "Average height", "vegetarian", 
"meat", "carrot", "cucumber", "orange", 
"banana", "pepper", "tangerine", "Average Score", 
"Range Score", "Number of children", "Number of parents", 
"Number of grandparents"), `year 1` = c("20", "2", 
"25", "12", "4", "7", 
"7", "37", "21", "3", 
"-0.3", "78 : 1", "61", "19", 
"39"), `Year 2` = c("98", "28.2", "23", 
"1", "8", "6", "1", 
"36", "2", "29", "-0.2", "3 : 2", 
"6", "18", "9"), `Year 3` = c("88", 
"28.2", "24", "1", "1", "4", 
"91", "3", "24 ", "2", 
"-0.2", "7 : 2", "58", "1", 
"8")), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
-15L))
Run Code Online (Sandbox Code Playgroud)

做一个表:

  install.packages("flextable")
library(flextable)
table1<-flextable(trialdata)
Run Code Online (Sandbox Code Playgroud)

这使得表格如下图所示,只有一个标题 桌子看起来像

不过,我想添加某种描述性标题,例如“最喜欢的食物”。这不是数据中已有的“分组”,而是添加的文本,我想让表格更清晰,例如如下所示:

理想的塔布克

Flex 表有添加页眉和页脚的方法,但我看不到在表中添加页眉类型对象的方法。

Z.L*_*Lin 0

我不认为 flextable 接受不在页眉/页脚位置的页眉/页脚,但这并不是说我们不能以编程方式将类似的行添加到表中。

第 1 步:定义新标题(我将其称为子标题)以及它们应插入的位置:

sub.headers <- c("favourite foods", "other details")
insert.after <- c(4, 10)
Run Code Online (Sandbox Code Playgroud)

步骤 2:定义一个函数,将它们作为新行插入到输入表中,并输出结果:

process.data <- function(df, lab, pos) {
  lab <- rev(lab)
  pos <- rev(pos)
  for(i in seq_along(pos)) {
    # split data frame at insert location
    df1 <- df[seq(1, pos[i]), ]
    df2 <- df[seq(pos[i] + 1, nrow(df)), ]

    # create new data frame with same column names, but with the sub-header
    # as the value for 1st column
    df.add <- df %>% slice(1)
    df.add[1, 1] <- lab[i]

    # combine the result
    df <- rbind(df1, df.add, df2)
  }
  return(df)
}
Run Code Online (Sandbox Code Playgroud)

步骤 3:将原始数据帧传递给函数并美化结果:

header.pos <- insert.after + seq.int(length(insert.after))
border.format <- officer::fp_border(width = 2)

trialdata %>%
  process.data(lab = sub.header,
               pos = insert.after) %>%
  flextable() %>%
  merge_h_range(i = header.pos, 
                j1 = 1, j2 = ncol(trialdata)) %>%
  bold(i = header.pos) %>%                            # bold
  hline(i = header.pos, border = border.format) %>%   # add line below
  hline(i = header.pos - 1, border = border.format)   # add line above
Run Code Online (Sandbox Code Playgroud)

结果:

灵活输出的屏幕截图

更改步骤 1 中的值将使您能够针对其他数据帧进行调整。