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

Sequential

Are you talking about that issue? github.com/davidgohel/flextable/issues/6 – Ursas

Not really. More about whether there is an out of the box way to replace i=c(3,6) in a more generic way. Alternatively, I have to write a function to determine for each category in the merged cells column the number of observations in each category and construct a vector with indices. It would be nice to be able to use merge_v in a way to determine the location of the border. – Sequential

nice suggestion. I will provide a function for that. – Ursas

Answer 1

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() 

Gynecoid

Answer 2

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

Ursas

nice use of rle – Sequential

Answer 3

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}

Amphimacer