How to wrap graphs by categories while keeping the same width of bars with ggplot in R?

Question

I am struggling with using facet_grid() and facet wrap() with ggplot(). I would like to be able to wrap the different stacked barcharts for every two categories (of the variable Department here) but at the same time have the same width of bars. The first action can be achieved with facet wrap() while the second one can be achieved with facet_grid(). I would like to combine the advantages of both functions. Do you have any idea on how to solve the problem please?

The data is:

ID<-c("001","002","003","004","005","006","007","008","009","010","NA","012","013")
Name<-c("Damon Bell","Royce Sellers",NA,"Cali Wall","Alan Marshall","Amari Santos","Evelyn Frye","Kierra Osborne","Mohammed Jenkins","Kara Beltran","Davon Harmon","Kaitlin Hammond","Jovany Newman")
Sex<-c("Male","Male","Male",NA,"Male","Male",NA,"Female","Male","Female","Male","Female","Male")
Age<-c(33,27,29,26,27,35,29,32,NA,25,34,29,26)
UKCountry<-c("Scotland","Wales","Scotland","Wales","Northern Ireland","Wales","Northern Ireland","Scotland","England","Northern Ireland","England","England","Wales")
Department<-c("Sports and travel","Sports and travel","Sports and travel","Health and Beauty Care","Sports and travel","Home and lifestyle","Sports and travel","Fashion accessories","Electronic accessories","Electronic accessories","Health and Beauty Care","Electronic accessories",NA)

The code is:

data<-data.frame(ID,Name,Sex,Age,UKCountry,Department)

## Frequency Table
dDepartmentSexUKCountry <- data %>% 
  filter(!is.na(Department) & !is.na(Sex) & !is.na(UKCountry)) %>%
  group_by(Department,Sex,UKCountry) %>% 
  summarise(Count = n()) %>%
  mutate(Total = sum(Count), Percentage = round(Count/Total,3)) 

## Graph
dSexDepartmentUKCountry %>% 
  ggplot(aes(x=Sex,
             y=Percentage,
             fill=UKCountry)) + 
  geom_bar(stat="identity",
           position="fill") + 
  geom_text(aes(label = paste0(round(Percentage*100,0),"%\n(", Count, ")")), 
            position=position_fill(vjust=0.5), color="white") + 
  theme(axis.ticks.x = element_blank(), 
       axis.text.x = element_text(angle = 45,hjust = 1)) + 
  #facet_grid(cols = vars(Department),scales = "free", space = "free")
  facet_wrap(. ~ Department, scales = "free", ncol = 2)

When using facet_wrap(), I get:

When using facet_grid(), I get:

Ideally, I would like to have (edited on Paint):

I have researched my issue and often I would find one or the other solution but not a combination of both.

Answer 1

Here's an approach with splitting the data into a set number of rows and assembling a grid of plots with patchwork. This is necessary because facet_grid won't break data in multiple ways along the same dimension, i.e. it won't break data into groups along the x-axis but also wrap them around into multiple rows, and facet_wrap doesn't have the flexibility of free spacing. This is definitely more complex than its worth for something small, but it's a process I've used for graphics that need to get a bunch of information together for publishing. Depends on your situation.

The basic idea here is to divvy up what will become bars into 2 rows of panels. It's a bit tricky because each bar is a combination of department and sex (hence using interaction), and you're not splitting by the number of observations, you're splitting by unique identifiers. You could do this different ways, but the way that made sense to me was with rleid to get group numbers, then scale that based on how many rows you need. After that, split and make the same type of plot for what will become each row. You need country to be a factor and for the fill scale to not drop missing factor levels so you can make sure all the plots have the same legend.

rows <- 2

# only difference between data here & OP is I ungrouped it
dept_ids <- dDepartmentSexUKCountry %>%
  mutate(UKCountry = as.factor(UKCountry),
         id = data.table::rleid(interaction(Department, Sex)),
         row = ceiling(id / max(id) * rows))
dept_ids
#> # A tibble: 9 × 8
#>   Department             Sex    UKCountry     Count Total Percentage    id   row
#>   <chr>                  <chr>  <fct>         <int> <int>      <dbl> <int> <dbl>
#> 1 Electronic accessories Female England           1     2       0.5      1     1
#> 2 Electronic accessories Female Northern Ire…     1     2       0.5      1     1
#> 3 Electronic accessories Male   England           1     1       1        2     1
#> 4 Fashion accessories    Female Scotland          1     1       1        3     1
#> 5 Health and Beauty Care Male   England           1     1       1        4     2

plots <- dept_ids %>%
  split(.$row) %>%
  purrr::map(function(df) {
    ggplot(df, aes(x=Sex,
               y=Percentage,
               fill=UKCountry)) + 
      geom_bar(stat="identity",
               position="fill") + 
      geom_text(aes(label = paste0(round(Percentage*100,0),"%\n(", Count, ")")), 
                position=position_fill(vjust=0.5), color="white") + 
      theme(axis.ticks.x = element_blank()) + 
      facet_grid(cols = vars(Department),scales = "free", space = "free") +
      scale_fill_discrete(drop = FALSE)
  })

patchwork::wrap_plots(plots, nrow = rows, guides = "collect")

One issue with this is that you have duplicate x-axis titles. Since the title in this case is pretty self-explanatory, you could just drop it altogether, or you can turn it off in all the plots' themes, patch them together, and then turn it back on for the last plot. Whatever is last in line going into patchwork's assembly functions is what receives the theme setting.

plots %>%
  purrr::map(~. + theme(axis.title.x = element_blank())) %>%
  patchwork::wrap_plots(nrow = rows, guides = "collect") +
  theme(axis.title.x = element_text())

Like I said, in many cases this will be more work than it's worth, but I tried to keep it flexible enough for larger-scale projects where it does make sense.