Flextable: repeat headers without changing column class

Question

For very long tables, it can be useful to repeat headers for better visibility. One could do it manually beforehand on the dataframe by using names() and making that new column with tibble::add_row for example.

However, the issue is that columns need to be of the same class, so if you want to add the column names, you have to transform your columns to character, which in turn prevents flextable from properly formatting numbers.

Function add_body() is the closest thing to my needs (https://davidgohel.github.io/flextable/reference/add_body.html). It precisely allows you to add new rows in the body of the table. However, it doesn't allow you to choose on which row you want it added exactly (like tibble::add_row does); there are only two options: top or bottom. Additionally, for the new row, one must specify each cell/column individually, so we cannot rely on names().

Is there any way to accomplish what I am describing? Thank you.

Edit: Even with add_body() I am getting an error adding a new row with different class, in this case with dates:

Error in as.POSIXlt.character(x, tz, ...) : 
  character string is not in a standard unambiguous format

Indeed, as written in the documentation:

It is important to insert data of the same type as the original data, otherwise it will be transformed (probably into strings if you add a character' where a double' is expected). This keeps the ability to format cell contents with the colformat_* functions, for example colformat_num().

Edit: my best workaround is this:

library(dplyr)
library(flextable)
ft <- flextable(head(iris))
ft %>%
    add_footer_row(values = names(iris),
                   colwidths = rep(1, length(names(iris))))

Although the extra row lies at the bottom, it is still better than not having this information show again.

Edit 2022-01-06:

It seems @jrcalabrese's solution works well for the sample data I provided (iris dataset). Here is a demonstration that it works even with different column classes (such as date, numeric) and conditional formatting.

library(dplyr)
library(flextable)
iris2 <- cbind(iris, date = as.Date("2021-01-06"))
head(iris2) %>%
    mutate(across(everything(), as.character)) %>%
    add_row(Sepal.Length = "Sepal.Length", 
            Sepal.Width = "Sepal.Width",
            Petal.Length = "Petal.Length",
            Petal.Width = "Petal.Width",
            Species = "Species",
            date = "date", .before = 4) %>%
    flextable() -> ft2
ft2
ft2 %>%
    bg(i = ~ Petal.Length < 1.5,
       j = ft2$col_keys,
       bg = "grey")

Unfortunately, as mentioned by @jrcalabrese, it is not possible to automatize this process using names(), so we have to define each row name manually.

Edit 2022-01-07:

@romainfrancois has provided a tidiverse fix to avoid defining row names manually through a custom add_row2() function. Here's a slightly adapted version:

library(dplyr, warn.conflicts = FALSE)
library(flextable, warn.conflicts = FALSE)

# Define our new custom function
add_row2 <- function(.data, x, ...) {
  add_row(
    .data, 
    tibble(!!!setNames(x, names(.data))),
    ...
  )
}

# Add a date column
iris2 <- cbind(iris, date = as.Date("2021-01-06"))

# Add the header row
head(iris2) %>%
  mutate(across(everything(),
                as.character)) %>%
  add_row2(names(iris2),
           .before = 4) -> iris2
iris2
#>   Sepal.Length Sepal.Width Petal.Length Petal.Width Species       date
#> 1          5.1         3.5          1.4         0.2  setosa 2021-01-06
#> 2          4.9           3          1.4         0.2  setosa 2021-01-06
#> 3          4.7         3.2          1.3         0.2  setosa 2021-01-06
#> 4 Sepal.Length Sepal.Width Petal.Length Petal.Width Species       date
#> 5          4.6         3.1          1.5         0.2  setosa 2021-01-06
#> 6            5         3.6          1.4         0.2  setosa 2021-01-06
#> 7          5.4         3.9          1.7         0.4  setosa 2021-01-06

# Make the flextable
ft2 <- flextable(iris2)
ft2 %>%
  bg(i = ~ Petal.Length < 1.5,
     j = ft2$col_keys,
     bg = "grey")

^{Created on 2022-01-07 by the reprex package (v2.0.1)}

Edit 2022-01-15:

Unfortunately the solution above does not work for numeric formatting like formatting decimals:

library(dplyr, warn.conflicts = FALSE)
library(flextable, warn.conflicts = FALSE)
    
# Multiply by a thousand to experiment with digit separators
iris2 <- iris*1000

# Make the flextable
ft2 <- flextable(iris2)
ft2 %>%
  colformat_double()    
# This works

# Define our new custom function
add_row2 <- function(.data, x, ...) {
  add_row(
    .data, 
    tibble(!!!setNames(x, names(.data))),
    ...
  )
}

# Add the header row
head(iris2) %>%
  mutate(across(everything(),
                as.character)) %>%
  add_row2(names(iris2),
           .before = 4) -> iris2

# Make the flextable again
ft2 <- flextable(iris2)
ft2 %>%
  colformat_double()
# This doesn't work (i.e., it doesn't format digits with the comma after thousands)

<sup>Created on 2022-01-15 by the [reprex package](https://reprex.tidyverse.org) (v2.0.1)</sup>

Answer 1

There is probably a better way to do this, but I think it satisfies your requirements. It involves converting it to a huxtable and then a flextable but unfortunately the title rows have to be manually added for every nth row. You could also suggest this as a potential feature on the flextable Github.

library(tidyverse, warn.conflicts = FALSE)
library(flextable, warn.conflicts = FALSE)
library(huxtable, warn.conflicts = FALSE)

head(iris, 15) %>% 
  mutate(across(everything(), as.character)) %>%
  add_row(Sepal.Length = "Sepal.Length", 
          Sepal.Width = "Sepal.Width",
          Petal.Length = "Petal.Length",
          Petal.Width = "Petal.Width",
          Species = "Species", .before = 6) %>%
  add_row(Sepal.Length = "Sepal.Length", 
          Sepal.Width = "Sepal.Width",
          Petal.Length = "Petal.Length",
          Petal.Width = "Petal.Width",
          Species = "Species", .before = 11) %>%
  as_huxtable() %>%
  set_bold(row = 1, col = everywhere) %>% 
  set_bold(row = 7, col = everywhere) %>% 
  set_bold(row = 12, col = everywhere) %>%
  as_flextable() %>% 
  border_outer() %>% 
  border_inner_h()