R flextable - How to add a table-wide horizontal border under a merged cell

Question

Is there a smart way to have a horizontal border table wide when you have merged cells? (In the example below, it is not yet table wide).

Or should I write a function to calculate the correct index?

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

Flextable stores information about the size of merged cells in my_table$body$spans, and you can use that information to do stuff. For example, here is a simple table followed by the contents of its $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 stores how many rows each merged span consists of. unique(cumsum(...))[,x], where x is the column number you want to use to decide where the lines go, gives you the row locations of where to draw the lines.

unique(cumsum(tbl0$body$spans$columns[,1]))
#> [1]  6 13

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

tbl1

You can draw even more lines, but the catch is that newer lines will replace older ones if they are drawn onto the same location. You therefore either need to draw the lines in reverse order (so that more prominent ones overwrite minor ones), or you need to draw the new lines only in places where there aren't existing ones.

# 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

^{Created on 2024-10-04 with reprex v2.1.1}

Answer 2

A much simpler solution is to add a column that indicates which rows need a bottom border and then add an hline() with a row selection that uses that value. That helper selection can be kept out of the table by only selecting the columns you want to show in the original flextable specification using 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

Here is a code for what you want. It needs more work to be generic - the example is only adapted when column 1 is the only that has merged cells.

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