How to create two headers table with expss

Question

I have been reading about two headers table here and here with expss package, but the online code didn't work for me. My idea is to create a very similar table to this image:

The dataframe is:

df <- data.frame(Categoria = c("gender", "gender" , "gender", "gender", "gender", "gender", 
                                 "religion", "religion", "religion", "religion", "religion",
                                 "religion", "religion", "religion", "religion", "religion", 
                                 "religion", "religion"),
                 Opcoes_da_categoria = c("Mulher", "Homem", "Mulher", "Homem", "Mulher", 
                                           "Homem", "Outra religião", "Católico", "Agnóstico ou ateu",
                                           "Evangélico", "Outra religião", "Católico", 
                                           "Agnóstico ou ateu", "Evangélico", "Outra religião",
                                           "Católico", "Agnóstico ou ateu", "Evangélico"),
                 Resposta = c("A Favor", "A Favor", "Contra",  "Contra",  "Não sei", "Não sei",
                              "A Favor", "A Favor", "A Favor", "A Favor", "Contra", "Contra",
                              "Contra", "Contra", "Não sei", "Não sei", "Não sei", "Não sei"),
                 value_perc = c(65, 50, 33, 43, 2, 7, 67, 64, 56, 28, 31, 34, 35, 66, 2, 2, 10, 5))

My code to create the two headers table is below, but it didn't work properly because of the following problems:

• The table should have two headers
• The columns' name should not appear in the table
• The value is not supposed to have decimal cases

library(expss)

my_table <- df %>%
  tab_cells(Resposta) %>%
  tab_weight(value_perc) %>% 
  tab_cols(Opcoes_da_categoria, Categoria) %>%
  tab_stat_cpct(total_label = NULL) %>%
  tab_pivot()

library(gridExtra)

png("my_table.png", height = 50*nrow(my_table), width = 200*ncol(my_table))
grid.table(my_table)
dev.off()
  

Answer 1

I don't know expssbut have used flextable recently and found it nice. Being far from an expert in it, I managed to make a good looking table which comes close to what you want. Starting from your DF some changes have to be made, to bring the DF in the format needed for your table. Renaming the col-names follows, by extracting the part of the name before _. A DF typology describing the dependencies of col and header-names is built. (Can be found in the link above). Then the flextable part comes, which builds a flextable first and then applies typology and other formating commands.

What comes out of this, shows the attached picture.

library(tidyverse)
library(flextable)
#> 
#> Attache Paket: 'flextable'
#> The following object is masked from 'package:purrr':
#> 
#>     compose
df <- data.frame(
  Categoria = c(
    "gender", "gender", "gender", "gender", "gender", "gender",
    "religion", "religion", "religion", "religion", "religion",
    "religion", "religion", "religion", "religion", "religion",
    "religion", "religion"
  ),
  Opcoes_da_categoria = c(
    "Mulher", "Homem", "Mulher", "Homem", "Mulher",
    "Homem", "Outra religião", "Católico", "Agnóstico ou ateu",
    "Evangélico", "Outra religião", "Católico",
    "Agnóstico ou ateu", "Evangélico", "Outra religião",
    "Católico", "Agnóstico ou ateu", "Evangélico"
  ),
  Resposta = c(
    "A Favor", "A Favor", "Contra", "Contra", "Não sei", "Não sei",
    "A Favor", "A Favor", "A Favor", "A Favor", "Contra", "Contra",
    "Contra", "Contra", "Não sei", "Não sei", "Não sei", "Não sei"
  ),
  value_perc = c(65, 50, 33, 43, 2, 7, 67, 64, 56, 28, 31, 34, 35, 66, 2, 2, 10, 5)
)


# adjust your df to match cols and names with tidyvers
dfa <- df %>%
  pivot_wider(names_from =c('Opcoes_da_categoria', 'Categoria'), values_from = 'value_perc')
nam <- str_extract(colnames(dfa),'^[^_]+')
colnames(dfa) <- nam

typology <- data.frame(
  col_keys = c( "Resposta",
                "Mulher", "Homem",
                "Outra religião", "Católico",
                "Agnóstico ou ateu", "Evangélico"),
  what = c("", "Genero", "Genero", "Religio",
           "Religio", "Religio", 'Religio'),
  measure = c( "Resposta", 
               "Mulher", "Homem",
               "Outra religião", "Católico",
               "Agnóstico ou ateu", "Evangélico"),
  stringsAsFactors = FALSE )

library(officer) # needed for making border
dftab <- flextable::flextable(dfa)

border_v = fp_border(color="gray")
dftab <- dftab %>% 
  set_header_df(mapping = typology, key = "col_keys" ) %>% 
  merge_h(part = "header") %>% 
  merge_v(part = "header") %>% 
  theme_booktabs() %>% 
  vline(border = border_v, j =3, part = 'body') %>% 
  vline(border = border_v, j =3, part = 'header')
print(dftab)
#> a flextable object.
#> col_keys: `Resposta`, `Mulher`, `Homem`, `Outra religião`, `Católico`, `Agnóstico ou ateu`, `Evangélico` 
#> header has 2 row(s) 
#> body has 3 row(s) 
#> original dataset sample: 
#>   Resposta Mulher Homem Outra religião Católico Agnóstico ou ateu Evangélico
#> 1  A Favor     65    50             67       64                56         28
#> 2   Contra     33    43             31       34                35         66
#> 3  Não sei      2     7              2        2                10          5