Search code examples
rflextable

How to merge cells in flextable multirow header in flextable in R?

below here, there is my flextable table:

library(flextable)
library(tidyverse)
library(officer)
library(magrittr)


M <- as.table(rbind(c(762, 327, 468), c(484, 239, 477)))

dimnames(M) <- list(
  gender = c("F", "M"),
  party = c("Democrat", "Independent", "Republican"))

M

f <- ftable(M,
            row.vars = "gender",
            col.vars = c("party"))


ftable_to_flextable <- function( x ){

  row.vars = attr( x, "row.vars" )
  col.vars = attr( x, "col.vars" )
  rows <- rev( expand.grid( rev(row.vars), stringsAsFactors = FALSE ) )
  cols <- rev(expand.grid( rev(col.vars), stringsAsFactors = FALSE ))

  xmat <- as.matrix(x)
  cols$col_keys = dimnames(xmat)[[2]]
  xdata <- cbind(
    data.frame(rows, stringsAsFactors = FALSE),
    data.frame(xmat, stringsAsFactors = FALSE)
  )
  names(xdata) <- c(names(row.vars), cols$col_keys)

  ft <- flextable(xdata)
  ft <- set_header_df(ft, cols)
  ft <- theme_booktabs(ft)
  ft <- merge_v(ft, j = names(row.vars))
  ft
}



final <- ftable(M) %>% ftable_to_flextable()

ft_2 <- add_header_row(final, values = c("Party"), colwidths = c(4), top = TRUE)

ft_2 <- add_header_row(final, values = c("Gender", "Party"), colwidths = c(1, 3), top = TRUE)

ft_2 <- width(ft_2, j=1, 3/2.54)

ft_2 <- align(ft_2, align = "center", part = "header")

ft_2 <- border_outer(ft_2, fp_border(color="black", width=1.5))

ft_2 <- border_inner(ft_2, fp_border(color="gray"))

ft_2 <- fix_border_issues(ft_2)

ft_2 %<>% bold(part = "header")

ft_2 %<>% bold (i = c(1,2),
               j = 1, bold = TRUE)

ft_2

It looks like this:

enter image description here

I would like to ask how do we refer to cells in multirow header in order to properly merge them, meaning to remove some borders between certain cells. I know that for rows we refer as i= , and for columns as j= , but how to refer to cells in the extended header ? My desired results would be:
1. variant:

enter image description here

2. variant:

enter image description here

How do I do it, please. Any help would be much appreciated. Additionally I want to ask how to center Gender when the line below has been removed.

I have tried so far code that is placed above and my expecting results are described as well.

Solution

  • This should answer:

    1. how to merge
    2. how to add specific borders
    ft_2 |> 
  merge_at(i = 1:2, j = "gender", part = "header") |> 
  hline_bottom(border = fp_border(color = "red"), part = "header") |> 
  vline(j = "gender", border = fp_border(color = "red"), part = "all") |> 
  fix_border_issues() # fix side effects of cell merging

    enter image description here

    Note you could also use proc_freq that is producing a similar result:

    library(flextable)
library(officer)
library(tidyverse)

M <- as.table(rbind(c(762, 327, 468), c(484, 239, 477)))
dimnames(M) <- list(
  gender = c("F", "M"),
  party = c("Democrat", "Independent", "Republican"))

M <- as.data.frame(M) |> uncount(Freq)

proc_freq(M, row = "gender", "party",
          include.row_percent = FALSE, 
          include.column_percent = FALSE,
          include.table_percent = TRUE,
          )

    enter image description here