多分类变量无分面可视化：自定义ggplot2 geom函数开发问询

需求说明 #

针对3个（最多支持5个）各含10+水平的分类变量，需要实现如下可视化：

• 为每一组var2与var3的组合，绘制展示var1各水平加权占比的堆叠条形图
• 最终形成的网格单元格数为 length(levels(var2)) x length(levels(var3))
• 颜色映射对应var1的水平数量

常规方案的局限 #

常规做法是用ggplot2的facet_grid实现，示例代码如下：

data <- tibble(
  a = c(5, 6, 7, 12, 5, 6, 7),
  fct1 = paste0('type',c("a","b","c","d", "a","b","c")),
  fct2 = paste0('lvl',c(1,1,1,1,2,2,2)),
  fct3 = paste0('system', c(1,2,2,2,1,2,2)),
) %>% 
  crossing(fct2_suffix = 0:4, fct3_suffix = 0:9) %>% 
  mutate(
    fct2 = paste0(fct2, fct2_suffix),
    fct3 = paste0(fct3, fct3_suffix)
  ) %>% 
  select(-c(fct2_suffix, fct3_suffix)) %>% 
  uncount(a)

data %>% 
  ggplot() +
  geom_bar(aes(y = 0, fill=fct1), position = "fill") +
  facet_grid(fct3~fct2)

但当变量水平较多时，分面操作速度极慢。我们希望完全避免使用分面（预留分面功能给第4、5个分类变量），并开发一款灵活的自定义geom_*()函数，理想调用方式如下：

data %>% 
  ggplot() +
  geom_col_grid(aes(x=fct1, y=fct2, fill=fct3), position = "fill")# +
  #facet_grid(fct4~fct5) # 可用于第4、5个变量的分面

现有手动实现方案 #

目前已编写手动计算条形位置并结合geom_rect实现的函数，示例代码如下：

plot_crosstab <- function(data, var1, var2, var3, var4, var5, padding = 0.1){
  
  if(!("weight" %in% names(data))){
    data <- data %>% mutate(weight = 1) 
    cli::cli_alert_info("No variable 'weight' in data: assumed equal weights")
  }
  if(missing(var4)) {
    var4 <- quo(var4)
    data <- data %>% mutate(var4 = "total") 
  }
  if(missing(var5)){
    var5 <- quo(var5)
    data <- data %>% mutate(var5 = "total") 
  } 

  build_data = 
    data %>%
    mutate(across(c({{var5}}, {{var4}}, {{var3}}, {{var2}}, {{var1}}), as.factor)) %>% 
    group_by(across(c({{var5}}, {{var4}}, {{var3}}, {{var2}}, {{var1}}))) %>% 
    summarise(
      n = sum(weight, na.rm = T)
    ) %>% 
    mutate(
      frac = n/sum(n, na.rm = T)*(1-padding) # 控制条形宽度，预留间距
    ) %>% 
    arrange(desc(frac)) %>% 
    ungroup() %>% 
    complete({{var5}}, {{var4}}, {{var3}}, {{var2}}, fill = list(n=0, frac=1-padding)) %>% 
    group_by(across(c({{var5}}, {{var4}}, {{var3}}, {{var2}}))) %>%
    mutate(
      v_padding = if_else(row_number()==1, padding, 0)
    ) %>% 
    group_by(across(c({{var5}}, {{var4}}, {{var3}}))) %>% 
    mutate(
      pos_left = -0.5 -(padding/2) + lag(cumsum(frac), default = 0) + cumsum(v_padding),
      pos_right = -0.5 -(padding/2) + cumsum(frac) + cumsum(v_padding)
    ) %>% 
    ungroup() %>% 
    mutate(
      pos_low = as.numeric(factor({{var3}})) + (padding/2),
      pos_high = pos_low + (1-padding)
    )

  build_data %>% 
    ggplot() +
    geom_rect(aes(xmin = pos_left, xmax = pos_right, ymin = pos_low, ymax = pos_high, fill = {{var1}})) +
    facet_grid(rows = vars({{var4}}), cols = vars({{var5}})) +
    scale_x_continuous(breaks = 1:length(levels(build_data %>% pull({{var2}})))-1, labels = levels(build_data %>% pull({{var2}}))) +
    scale_y_continuous(breaks = 1:(length(levels(build_data %>% pull({{var3}}))))+0.5, labels = levels(build_data %>% pull({{var3}})))
}

data %>% 
  plot_crosstab(fct2, fct1, fct3)

该方案效果与原分面方案类似且速度更快，但未融入ggplot2原生工作流，灵活性不足。现寻求指导，如何开发符合需求的自定义geom函数。

内容的提问来源于stack exchange，提问作者rmc