用于多级分组条形图的堆叠条形图

Question

library(ggplot2)
library(ggpattern)
library(tidyverse)

mydata <- structure(list(Metric = structure(c(2L, 1L, 3L, 2L, 1L, 3L, 2L, 
                                              1L, 3L, 2L, 1L, 3L, 2L, 1L, 3L, 2L, 1L, 3L, 2L, 1L, 3L, 2L, 1L, 
                                              3L, 2L, 1L, 3L, 2L, 1L, 3L), 
                                            levels = c("Median", "Average", "Copula"), class = "factor"), 
                         Model = structure(c(1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 2L, 2L, 
                                             2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L), 
                                           levels = c("Model1", "Model2", "Model3"), class = "factor"), 
                         Strategy = c("Exact", "Exact", "Exact", "Exact", "Exact", "Exact", "Exact", "Exact", 
                                      "Exact", "Exact", "Exact", "Exact", "Relaxed", "Relaxed", "Relaxed", "Relaxed", 
                                      "Relaxed", "Relaxed", "Relaxed", "Relaxed", "Relaxed", "Relaxed", "Relaxed", 
                                      "Relaxed", "Exact", "Exact", "Exact", "Relaxed", "Relaxed", "Relaxed"), 
                         Size = structure(c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 4L, 4L, 4L, 1L, 1L, 1L, 2L, 2L, 
                                            2L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L), 
                                          levels = c("Model1", "Small", "Medium", "Large"), class = "factor"), 
                         Score = c(0.168041526339948, 0.5572494356893, 0.384942351374775, 0.327734317164868, 
                                   0.11144915339537, 0.604394054040313, 0.124633444240317, 0.279732553754002, 
                                   0.228201881283894, 0.0153298925142735, 0.128981558606029, 0.0933819285128266, 
                                   0.534035353455693, 0.807516399072483, 0.86791948764585, 0.829708693316206, 
                                   0.602100674761459, 0.70368835888803, 0.897488264366984, 0.29460092424415, 
                                   0.577609919011593, 0.630979274399579, 0.512015897547826, 0.505023914156482, 
                                   0.236885007470846, 0.560424553928897, 0.599731565685943, 0.910147710936144, 
                                   0.791147409472615, 0.755704769166186)), row.names = c(NA, -30L), 
                    class = c("tbl_df", "tbl", "data.frame"))


# Reorder Parameter and Metric within each Parameter
mydata$Size <- factor(mydata$Size, levels = c("Model1", "Small", "Medium", "Large"))
mydata$Metric <- factor(mydata$Metric, levels = c("Median", "Average", "Copula"))
mydata$Model <- factor(mydata$Model, levels = c("Model1", "Model2", "Model3"))



palette <- c("Model1" = "darkgreen", "Small" = "lightblue", "Medium" = "blue", "Large" = "darkblue")
pattern_map <- c("Median" = "none", "Average" = "circle", "Copula" = "stripe")
density_map <- c("Median" = 0, "Average" = 0.05, "Copula" = 0.05)
angle_map <- c("Median" = 0, "Average" = 45, "Copula" = 90)


# Create the bar plot with improved aesthetics, customized patterns, densities, and bar outlines
ggplot(mydata, aes(x = Model, y = Score, fill = Size, pattern = Metric, pattern_density = Metric)) +
  geom_bar_pattern(stat = "identity", 
                   position = position_dodge2(padding = 0.15, preserve = "single"), 
                   width = 1,
                   color = "black",  # Adds black outline around each bar
                   pattern_fill = "white", pattern_spacing = 0.05,
                   pattern_color = "white", pattern_angle = 45) +
  scale_pattern_manual(values = pattern_map) +  # Apply custom patterns
  scale_pattern_density_manual(values = density_map) +  # Apply custom densities
  labs(x = "Model", y = "", fill = "Size", pattern = "Metric") +
  scale_fill_manual(values = palette) +
  theme_classic() +
  theme(axis.text.x = element_text(hjust = 1),
        legend.position = "right",
        legend.box = "vertical",
        strip.text = element_text(size = 12, face = "bold"),  # Enhances facet labels
        panel.spacing = unit(1, "lines"),  # Adds more spacing between panels
        panel.border = element_rect(color = "black", fill = NA, size = 0.5)) +  # Adds a border to panels
  guides(pattern = guide_legend(override.aes = list(fill = NA)))

我有一个多级并排条形图，如下所示。它有 3 个级别：

• x 轴对应于

  Model

  。共有3款。
  • 在每个

    Model

    中，颜色对应于模型的

    Size

    。例如，Model2 有 3 种尺寸。
    • 在每个

      Size

      中，图案对应于

      Metric

      。有 3 个指标（用实线、点线和条纹表示）。
      • 每个

        Metric

        内，有2个

        Strategy

        （精确和宽松）。

对于最内层，

Strategy

的条当前并排放置。我怎样才能改变它，使它变成一个堆叠条？

请注意，我已经查看了here提供的答案，但由于多层分组结构，我认为我的设置有点复杂。

Answer 1

与引用的帖子类似，您可以使用分面来获取堆叠条形图，但您可以按两个分面，而不是仅按一个变量分面，例如

Model

和

Size

。我不使用

facet_wrap

，而是使用

ggh4x::facet_nested_wrap

：

library(ggplot2)
library(ggpattern)
library(ggh4x)

ggplot(mydata, aes(
  x = Metric, y = Score, fill = Size,
  pattern = Metric, pattern_density = Strategy
)) +
  geom_col_pattern(
    width = 1,
    color = "black",
    pattern_fill = "white", pattern_spacing = 0.05,
    pattern_color = "white", pattern_angle = 45
  ) +
  ggh4x::facet_nested_wrap(
    . ~ Model + Size,
    scales = "free_x",
    nrow = 1,
    strip.position = "bottom"
  ) +
  ## Fake the panel borders
  geom_hline(
    yintercept = c(-Inf, Inf),
    linewidth = .5
  ) +
  geom_vline(
    data = data.frame(
      Model = c("Model1", "Model3"),
      Size = c("Model1", "Large"),
      xintercept = c(-Inf, Inf)
    ),
    aes(xintercept = xintercept),
    linewidth = .5
  ) +
  ##
  scale_x_discrete(
    expand = c(0, .8),
    breaks = NULL
  ) +
  # scale_pattern_manual(values = pattern_map) + # Apply custom patterns
  # scale_pattern_density_manual(values = density_map) + # Apply custom densities
  scale_fill_manual(values = palette) +
  theme_classic() +
  theme(
    legend.position = "right",
    legend.box = "vertical",
    strip.text = element_text(size = 12, face = "bold"),
    panel.spacing.x = unit(0, "lines"),
    panel.border = element_blank(),
    strip.background = element_rect(linewidth = .25),
    strip.placement = "outside",
    axis.line = element_line(linewidth = .25),
  ) +
  labs(x = "Model", y = "", fill = "Size", pattern = "Metric")