stackdodge hack

[davidhodge931]

library(ggplot2)
library(dplyr)
library(patchwork)
#Sample data
df <- bind_rows(
  data.frame(
    year = rep(2016, 5),
    protocol = rep("M", 5),
    country = c("A", "B", "C", "D", "E"),
    freq = c(100, 50, 30, 40, 11)
  ),
  data.frame(
    year = rep(2016, 4),
    protocol = rep("L", 4),
    country = c("A", "B", "C", "D"),
    freq = c(23, 60, 200, 100)
  ),
  data.frame(
    year = rep(2017, 5),
    protocol = rep("M", 5),
    country = c("A", "B", "C", "D", "E"),
    freq = c(100, 50, 30, 40, 11)
  ),
  data.frame(
    year = rep(2017, 4),
    protocol = rep("L", 4),
    country = c("A", "B", "C", "D"),
    freq = c(23, 60, 200, 100)
  )
)

set_blanket()

df |> 
  mutate(year = factor(year)) |> 
  gg_col(
    x  = protocol,
    y = freq, 
    col = country,
    facet = year,
  ) +
  theme(panel.spacing.x = unit(0, "pt")) +
  scale_x_discrete(expand = expand_scale(add = 1))

Another way is to create a nested x scale

[davidhodge931]

GeomStackDodgeCol <- ggproto(
    "GeomStackDodgeCol", GeomRect,
    required_aes = c("x", "y", "fill", "group"),
    default_aes = aes(
        colour = "black",
        linewidth = 0.5,
        linetype = 1,
        alpha = NA
    ),
    
    setup_data = function(data, params) {
        # Reset stacking for each x value and fill group
        data <- data |>
            group_by(x, fill) |>
            mutate(
                ymin = c(0, head(cumsum(y), -1)),
                ymax = cumsum(y)
            ) |>
            ungroup()
        
        # Compute dodging offsets with width and padding
        fill_groups <- unique(data$fill)
        n_groups <- length(fill_groups)
        width <- params$width %||% 0.9     # width of the bars
        padding <- params$padding %||% 0.1  # padding between bars
        
        # Calculate total width needed for the group
        total_width <- n_groups * width + (n_groups - 1) * padding * width
        
        # Calculate positions with proper spacing
        positions <- seq(-total_width/2, total_width/2, length.out = n_groups)
        
        # Create rectangle coordinates
        data$xmin <- data$x + positions[match(data$fill, fill_groups)] - width/2
        data$xmax <- data$x + positions[match(data$fill, fill_groups)] + width/2
        
        data
    },
    
    draw_panel = function(data, panel_params, coord, width = 0.9, ...) {
        coords <- coord$transform(data, panel_params)
        
        grid::rectGrob(
            x = (coords$xmin + coords$xmax)/2,
            y = (coords$ymin + coords$ymax)/2,
            width = coords$xmax - coords$xmin,
            height = coords$ymax - coords$ymin,
            default.units = "native",
            just = c("center", "center"),
            gp = grid::gpar(
                col = coords$colour,
                fill = alpha(coords$fill, coords$alpha),
                lwd = coords$linewidth * .pt,
                lty = coords$linetype
            )
        )
    },
    
    parameters = function(complete = FALSE) {
        c("na.rm", "width", "padding")
    }
)

geom_stackdodge_col <- function(mapping = NULL, data = NULL,
                            position = "identity", 
                            width = 0.9,
                            padding = 0.1,
                            na.rm = FALSE,
                            show.legend = NA,
                            inherit.aes = TRUE, ...) {
    layer(
        geom = GeomStackDodgeCol,
        mapping = mapping,
        data = data,
        stat = "identity",
        position = position,
        show.legend = show.legend,
        inherit.aes = inherit.aes,
        params = list(
            na.rm = na.rm,
            width = width,
            padding = padding
        )
    )
}