align geom_col to the "bottom" doesn't work

Question

I have a problem regarding alignment when using geom_col. I attach a reproducible example and the plot. What I would like to get are bars on top of each other on different weapons but aligned to the bottom without empty space, to make the plot more compact, even if this ignore some kind of ordering of y-axis. Solutions like transforming missing or 0 values to NA didn't work (ggplot2 does ignore NA automatically), I think the problem is some kind of conflict with facet_grid2, since specifying one particular year and room, there is not this problem.

   library(dplyr)
   library(ggplot2)
   library(ggiraph)
   library(ggh4x)

    # Data with Cluedo theme
    set.seed(123)
    cluedo_data <- data.frame(
      SUSPECT_ID = 1:100,
      YEAR = sample(2018:2020, 100, replace = TRUE),
      ROOM = sample(c("Library", "Kitchen", "Conservatory"), 100, replace = TRUE),
      GENDER = sample(c("M", "F"), 100, replace = TRUE),
      CLUEDO_PATH = sample(c("New", "Old"), 100, replace = TRUE),
      WEAPON_ID = paste0("weapon_", sample(1:10, 100, replace = TRUE)),
      CLUE_TYPE = sample(c("OPEN", "MCQ"), 100, replace = TRUE),
      EVIDENCE = sample(c(-1, 0, 1), 100, replace = TRUE),
      SCORE = sample(0:10, 100, replace = TRUE)
    )
    
    # Filter and transform data
    open_scores <- cluedo_data %>%
      filter(CLUE_TYPE == "OPEN", CLUEDO_PATH == "New") %>%
      group_by(YEAR, SUSPECT_ID, ROOM, WEAPON_ID) %>%
      filter(sum(abs(EVIDENCE)) != 0) %>%
      distinct(SUSPECT_ID, .keep_all = TRUE) %>% 
      mutate(TOTAL = max(sum(SCORE), 0)) %>%
      ungroup() %>%
      group_by(YEAR, ROOM, WEAPON_ID) %>%
      top_n(1, TOTAL) %>%
      distinct(YEAR, WEAPON_ID, ROOM, GENDER, TOTAL) %>%
      ungroup()
    
    open_scores$WEAPON_ID <- gsub('weapon_', 'w', open_scores$WEAPON_ID)
    
    color_table <- tibble(gender = c("M", "F"), Color = c("#795695", "#00868b"))
    open_scores$GENDER <- factor(open_scores$GENDER, levels = color_table$gender)
    
    plt <- ggplot(open_scores) +
      geom_col(aes(TOTAL, WEAPON_ID, fill = GENDER), width = 0.6, position = "stack") +
      geom_text(data = open_scores, aes(x = 1, y = WEAPON_ID, label = WEAPON_ID), hjust = "inward", nudge_x = -0.5, colour = "white", size = 4) +
      geom_text(data = open_scores, aes(x = TOTAL, y = WEAPON_ID, label = ifelse(TOTAL == 0, NA, TOTAL), fill = GENDER), position = position_stack(vjust = 0.6), colour = "white", size = 4) + 
      facet_grid2(vars(ROOM), vars(YEAR), render_empty = FALSE, axes = "all", scales = "free", space = "free") +
      scale_fill_manual(values = color_table$Color) +
      theme(axis.text.x = element_blank(), axis.text.y = element_blank(), axis.ticks.x = element_blank(), axis.ticks.y = element_blank()) +
      scale_x_continuous(breaks = NULL) +
      scale_y_discrete(breaks = NULL) +
      theme(axis.title.x = element_text(size = 15), axis.title.y = element_text(size = 15), strip.text.x = element_text(size = 13), strip.text.y = element_text(size = 13), legend.text = element_text(size = 20), legend.title = element_text(size = 20)) + 
      theme(legend.position = "top", plot.title = element_text(hjust = 0.5)) +
      xlab("Mean SCORE of Clues per WEAPON through YEAR") +
      ylab("WEAPON") +
      theme(text = element_text(family = "mono"))
    
    plt <- girafe(ggobj = plt, width_svg = 18, height_svg = 11,
      options = list(
        opts_hover_inv(css = "opacity:0.7;"),
        opts_hover(css = "stroke-width:2;")
      ))
    
    # Print plot
    print(plt)

Answer 1

If I understand you correctly, the issue is that when using facet_grid or facet_grid2 with scales="free" the scales are freed per row (or column), i.e. for each row any category present in one of the panels will be shown in all panels and you end up with some empty space in panels where the category is not present.

One option to get rid of the empty space would be to use a helper column which could be mapped on y. But even that option will leave some empty space when the number of categories differ per panel:

library(ggplot2)
library(ggh4x)
library(dplyr, warn = FALSE)

plt <- open_scores |>
  filter(TOTAL > 0) |>
  mutate(
    weapon_id = row_number(),
    .by = c(ROOM, YEAR)
  ) |>
  ggplot(aes(x = TOTAL, y = weapon_id)) +
  geom_col(aes(fill = GENDER), width = 0.6, position = "stack") +
  geom_text(aes(x = 1, label = WEAPON_ID),
    hjust = "inward",
    nudge_x = -0.5, colour = "white", size = 4
  ) +
  geom_text(aes(label = ifelse(TOTAL == 0, NA, TOTAL), group = GENDER),
    position = position_stack(vjust = 0.6),
    colour = "white", size = 4
  ) +
  facet_grid2(vars(ROOM), vars(YEAR),
    render_empty = FALSE, axes = "all",
    scales = "free", space = "free"
  ) +
  scale_fill_manual(values = color_table$Color) +
  scale_x_continuous(breaks = NULL) +
  scale_y_discrete(breaks = NULL) +
  theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    axis.title = element_text(size = 15),
    strip.text = element_text(size = 13),
    legend.text = element_text(size = 20),
    legend.title = element_text(size = 20)
  ) +
  theme(legend.position = "top", plot.title = element_text(hjust = 0.5)) +
  xlab("Mean SCORE of Clues per WEAPON through YEAR") +
  ylab("WEAPON") +
  theme(text = element_text(family = "mono"))

plt

UPDATE To make sure that we have the same weapon_id for both genders you could do:

weapon_id <- open_scores |>
  filter(TOTAL > 0) |>
  distinct(ROOM, YEAR, WEAPON_ID) |> 
  mutate(
    weapon_id = row_number(),
    .by = c(ROOM, YEAR)
  )
  
plt <- open_scores |>
  filter(TOTAL > 0) |>
  left_join(weapon_id, join_by(YEAR, WEAPON_ID, ROOM))  |> 
  ggplot(...) + 
  ...