How to flexibly add header row names in flextable in R?-CodePudding

I'm trying to make a function that will automatically generate a flextable depending on users input, and I want the headers to be as non-repetitive as possible. For example, the current column names are:

raw_names <- c("name", "V1_avg", "V1_median", "V2_avg", "V2_median", "V3_avg", "V3_median")

For this table, I want the top header to have the variable name (V1, V2, V3) and the sub-header to be Avg and Med underneath the appropriate variable. There will be nothing over name in the top header (see below code)

I know how to do this if I were to explicitly state that manually, but I want this function to be flexible because sometimes the dataset may have V4 or V5. The input will always look like the above, but it may have varying numbers of variables.

What's tripping me up is that for these main headers, you need to specify the length of the header rows, but I'm not sure how many variables there will be:

library(flextable)
    add_header_row(colwidths = c(1, 2, 2, 2),
                   values = c(NA_character_, "V1", "V2", "V3"))

Any thoughts?

CodePudding user response：

If your raw_names will always follow the same pattern, perhaps something like this to prepare add_header_row() arguments:

col_widths_vect <- function(names_vect) c(1, rep(2, (length(names_vect) - 1) / 2))

col_vals_vect <- function(names_vect) {
  return(
    c(
      NA_character_,
      names_vect[2:length(names_vect)] |>
        sub("_.*", "", x = _) |>
        unique()
    )
  )
}

raw_names <- c("name", "V1_avg", "V1_median", "V2_avg", "V2_median", "V3_avg", "V3_median")
col_widths_vect(raw_names)
#> [1] 1 2 2 2
col_vals_vect(raw_names)
#> [1] NA   "V1" "V2" "V3"

CodePudding user response：

I have created a function (only available on github for now) named separate_header. It uses data.table::tstrsplit() that is doing exactly what you were trying to do.

x <- data.frame(
  Species = as.factor(c("setosa", "versicolor", "virginica")),
  Sepal.Length_mean = c(5.006, 5.936, 6.588),
  Sepal.Length_sd = c(0.35249, 0.51617, 0.63588),
  Sepal.Width_mean = c(3.428, 2.77, 2.974),
  Sepal.Width_sd = c(0.37906, 0.3138, 0.3225),
  Petal.Length_mean = c(1.462, 4.26, 5.552),
  Petal.Length_sd = c(0.17366, 0.46991, 0.55189),
  Petal.Width_mean = c(0.246, 1.326, 2.026),
  Petal.Width_sd = c(0.10539, 0.19775, 0.27465)
)

ft_1 <- flextable(x)
ft_1 <- colformat_double(ft_1, digits = 2)
ft_1 <- theme_box(ft_1)
ft_1 <- separate_header(
  x = ft_1,
  opts = c("span-top", "bottom-vspan")
)
ft_1