Search code examples
rdataframeexpss

How to create two headers table with expss


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:

enter image description here

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

enter image description here


Solution

  • Here is a flexible kable solution that should adapt to different tables as long as you can get the data into wide format. Hope it helps--let me know if you have questions!

    library(dplyr)
    library(tidyr)
    library(knitr)
    library(kableExtra)
    
    df_wide <- df %>% # transform data to wide format, "drop" name for Resposta
      pivot_wider(names_from = c(Categoria, Opcoes_da_categoria), 
                  values_from = value_perc, names_sep = "_") %>%
      rename(" " = Resposta)
    
    cols <- sub("(.*?)_(.*)", "\\2", names(df_wide)) # grab everything after the _
    grps <- sub("(.*?)_(.*)", "\\1", names(df_wide)) # grab everything before the _
    
    df_wide %>%
      kable(col.names = cols) %>% 
      kable_styling(c("striped"), full_width = FALSE) %>% # check out ?kable_styling for other options
      add_header_above(table(grps)[unique(grps)]) # unique makes sure it is the correct order