R flextable - 如何在合并单元格下添加表格宽的水平边框

Question

合并单元格时，是否有一种聪明的方法可以使水平边框表格变宽？ （在下面的示例中，它还不是表宽）。

或者我应该编写一个函数来计算正确的索引？

library(flextable)
library(officer)
library(dplyr)

myft <- flextable(head(mtcars), 
                  col_keys = c("am", "carb", "gear", "mpg", "drat" ))%>% 
  theme_vanilla()%>%
  merge_v(j = c("am"))%>%border(border.bottom = fp_border(style = "solid", width=2), i=c(3,6), part="body")

myft

Answer 1

这是您想要的代码。它需要更多的工作才能通用 - 该示例仅在第 1 列是唯一合并单元格的情况下进行调整。

library(flextable)
library(officer)
library(dplyr)

bigborder <- fp_border(style = "solid", width=2)
myft <- flextable(head(mtcars), 
                  col_keys = c("am", "carb", "gear", "mpg", "drat" ))%>% 
  theme_vanilla()%>%
  merge_v(j = c("am")) 

# here starts the trick
row_loc <- rle(cumsum( myft$body$spans$columns[,1] ))$values
myft <- myft %>% 
  border(border.bottom = bigborder, i=row_loc, j = 2:5, part="body") 
myft <- myft %>% 
  border(border.bottom = bigborder, 
         i = myft$body$spans$columns[,1] > 1, j = 1, part="body") %>% 


  border(border.bottom = bigborder, border.top = bigborder, part = "header")
myft

Answer 2

一个更简单的解决方案是添加一列来指示哪些行需要底部边框，然后添加一个

hline()

以及使用该值的行选择。通过仅使用

col_keys

选择要在原始弹性表规范中显示的列，可以将该辅助选择保留在表之外。

library(tidyverse)
library(flextable)

your_flextable = tibble(
  col_group = rep(letters[1:3], each = 3),
  the_value = rnorm(length(col_group))
) %>%
  group_by(col_group) %>%
  mutate(
    is_last_val_in_group = row_number() == max(row_number())
  ) %>%
  flextable(col_keys = c('col_group', 'the_value')) %>%
  merge_v(j = 'col_group') %>%
  hline(i = ~is_last_val_in_group == TRUE, border = fp_border()) %>%
  fix_border_issues() 

Answer 3

Flextable 在

my_table$body$spans

中存储有关合并单元格大小的信息，您可以使用该信息来做一些事情。例如，这是一个简单的表格，后面是其内容

$body$spans$columns

:

library(flextable)
library(dplyr)
library(officer)

set.seed(123456)

# Input data
my_mtcars <- 
    mtcars %>% 
    mutate(
        vs  = factor(vs, labels = c("V-shaped engine", "Straight engine")),
        am  = factor(am, labels = c("Automatic", "Manual")),
        car = factor(rownames(mtcars))
    ) %>% 
    group_by(vs, am, gear) %>% 
    slice_sample(n = 2) %>% 
    ungroup() %>% 
    arrange(vs, am, gear)

# Basic table.
tbl0 <- 
    my_mtcars %>% 
    flextable(col_keys = c("vs", "am", "gear", "car", "mpg", "hp")) %>% 
    merge_v(j = c("vs", "am")) %>% 
    valign(j = 1:2, valign = "top")

tbl0

tbl0$body$spans$columns
#>       [,1] [,2] [,3] [,4] [,5] [,6]
#>  [1,]    6    2    1    1    1    1
#>  [2,]    0    0    1    1    1    1
#>  [3,]    0    4    1    1    1    1
#>  [4,]    0    0    1    1    1    1
#>  [5,]    0    0    1    1    1    1
#>  [6,]    0    0    1    1    1    1
#>  [7,]    7    4    1    1    1    1
#>  [8,]    0    0    1    1    1    1
#>  [9,]    0    0    1    1    1    1
#> [10,]    0    0    1    1    1    1
#> [11,]    0    3    1    1    1    1
#> [12,]    0    0    1    1    1    1
#> [13,]    0    0    1    1    1    1

.$body$spans$columns

存储每个合并范围包含多少行。

unique(cumsum(...))[,x]

，其中

x

是您要用来决定线条走向的列号，为您提供绘制线条的行位置。

tbl1 <- 
    tbl0 %>% 
    hline(i = unique(cumsum(.$body$spans$columns[,1])), 
          border = fp_border(width = 2)) %>% 
    fix_border_issues()

tbl1

您可以绘制更多线条，但问题是，如果将新线条绘制到同一位置，则新线条将替换旧线条。因此，您要么需要以相反的顺序绘制线条（以便更突出的线条覆盖次要的线条），要么只需要在不存在现有线条的地方绘制新线条。

# This is a function that returns non-duplicated values in two vectors.
remove_dupes <- function(x, y) {
    c(setdiff(x, y), setdiff(y, x))
}

remove_dupes(1:4, 3:6)
#> [1] 1 2 5 6

tbl2 <-
    tbl1 %>% 
    merge_v(j = c("am", "gear"), target = "gear", combine = TRUE) %>% 
    valign(j = 3, valign = "top") %>% 
    # The existing lines I want to keep were drawn based on column 1 values (`vs`).
    # The new lines I want to draw are based on column 3 values (`gear`).
    hline(i = remove_dupes(unique(cumsum(.$body$spans$columns[,1])),
                           unique(cumsum(.$body$spans$columns[,3]))),
          border = fp_border(style = "dotted", width = 1)) %>% 
    fix_border_issues()
        
tbl2

^{创建于 2024-10-04，使用 reprex v2.1.1}