如何使用 ggplot2 在条形图中绘制后续条形

Question

我有以下名为 df1 的数据框

定义数据框

df1 <- data.frame(
  trait = c("CRP", "CRP", "CRP", "TotChol", "TotChol", "TotChol", "RBC", "RBC", "RBC", "glucose", "glucose", "glucose"),
  Variable = c("PRSeur_r2_PGScatalog", "PRSeur_r2_mol", "moliPRS_eurPRS", 
               "PRSeur_r2_PGScatalog", "PRSeur_r2_mol", "moliPRS_eurPRS", 
               "PRSeur_r2_PGScatalog", "PRSeur_r2_mol", "moliPRS_eurPRS", 
               "PRSeur_r2_PGScatalog", "PRSeur_r2_mol", "moliPRS_eurPRS"),
  Value = c(14, 3.5, 3.9, 11, 9, 9.4, 15, 7, 8.11, 3, 1.3, 1.4)
)

打印数据框

打印（df）

我编写了以下代码来绘制条形图：

ggplot(df1, aes(x = trait, y = Value, fill = Variable)) +
  geom_bar(stat = "identity", position = position_dodge(width = 0.9), col = "black") +
  geom_text(aes(label = paste0(Value, "%")), 
            position = position_dodge(width = 0.8), 
            vjust = -0.5, size = 3) + # Add percentages upon each bar
  scale_x_discrete(labels = c("CRP", 
                              "TotChol",
                              "RBC")) +
  scale_fill_manual(values = c("#39568CFF",
                               "#20A387FF", 
                               "#FDE725FF"),
                    labels = c("PRSeur_r2_moli" = "X",
                               "PRSeur_r2_PGScatalog" = "Y",
                               "moliPRS_eurPRS" = "Z")) +
  theme_bw() +
  theme(
    axis.text.y = element_text(size = 10),
    axis.text.x = element_text(size = 10),
    axis.title = element_text(size = 10, face = "bold"),
    legend.text = element_text(size = 10),
    panel.border = element_blank(),
    text = element_text(family = "Times New Roman")
  ) +
  labs(title = "",
       x = "",
       y = "r2",
       fill = NULL)

我有以下情节：

我想创建后续的条形图，保持每个条形的相同大小和位置，如下所示：

如何在 R 中使用 ggplot2 来完成此操作？

Answer 1

将绘图代码放入函数中，将不需要的类别的

Value

设置为

NA

并在

na.rm=TRUE

中静音有关已删除缺失集

geom

的警告：

library(ggplot2)

plot_fun <- function(include = NULL) {
  if (!is.null(include)) {
    df1 <- df1 |>
      transform(
        Value = ifelse(Variable %in% include, Value, NA)
      )
  }

  ggplot(df1, aes(x = trait, y = Value, fill = Variable)) +
    geom_bar(
      stat = "identity",
      position = position_dodge(width = 0.9),
      col = "black",
      na.rm = TRUE
    ) +
    geom_text(aes(label = paste0(Value, "%")),
      position = position_dodge(width = 0.8),
      vjust = -0.5, size = 3,
      na.rm = TRUE
    ) +
    scale_x_discrete(labels = c(
      "CRP",
      "TotChol",
      "RBC"
    )) +
    theme_bw() +
    theme(
      axis.text.y = element_text(size = 10),
      axis.text.x = element_text(size = 10),
      axis.title = element_text(size = 10, face = "bold"),
      legend.text = element_text(size = 10),
      panel.border = element_blank(),
      text = element_text(family = "Times New Roman")
    ) +
    labs(
      title = "",
      x = "",
      y = "r2",
      fill = NULL
    ) +
    scale_fill_manual(
      values = c(
        "#39568CFF",
        "#20A387FF",
        "#FDE725FF"
      ),
      labels = c(
        "PRSeur_r2_mol" = "X",
        "PRSeur_r2_PGScatalog" = "Y",
        "moliPRS_eurPRS" = "Z"
      )
    )
}

df1$Variable <- factor(
  df1$Variable,
  levels = c("PRSeur_r2_PGScatalog", "PRSeur_r2_mol", "moliPRS_eurPRS")
)

plot_fun("PRSeur_r2_PGScatalog")

plot_fun(c("PRSeur_r2_mol", "PRSeur_r2_PGScatalog"))

plot_fun()

Answer 2

使用“省略”值和标签设置为

0

和

""

来累积数据帧的版本，将它们绑定到带有索引列的单个 df 中，然后按索引进行分面：

library(ggplot2)
library(dplyr)

# change to factor with levels matching OP's plots
df1$Variable <- factor(
  df1$Variable,
  levels = c("PRSeur_r2_PGScatalog", "PRSeur_r2_mol", "moliPRS_eurPRS")
)

included <- Reduce(\(x, y) c(x, y), levels(df1$Variable), accumulate = TRUE)

dfs <- lapply(included, \(incl) {
  mutate(
    df1, 
    Value = if_else(Variable %in% incl, Value, 0),
    Label = if_else(Variable %in% incl, paste0(Value, "%"), "")
  )
})

df2 <- bind_rows(dfs, .id = "Step")

ggplot(df2, aes(x = trait, y = Value, fill = Variable)) +
  geom_bar(stat = "identity", position = position_dodge(width = 0.9), col = "black") +
  geom_text(aes(label = Label), 
            position = position_dodge(width = 0.8), 
            vjust = -0.5, size = 3) + # Add percentages upon each bar
  scale_x_discrete(labels = c("CRP", 
                              "TotChol",
                              "RBC")) +
  scale_fill_manual(values = c("#39568CFF",
                               "#20A387FF", 
                               "#FDE725FF"),
                    labels = c("PRSeur_r2_mol" = "X",    # fixed typo
                               "PRSeur_r2_PGScatalog" = "Y",
                               "moliPRS_eurPRS" = "Z")) +
  theme_bw() +
  facet_wrap(vars(Step), ncol = 1) +
  theme(
    axis.text.y = element_text(size = 10),
    axis.text.x = element_text(size = 10),
    axis.title = element_text(size = 10, face = "bold"),
    legend.text = element_text(size = 10),
    panel.border = element_blank(),
    strip.text = element_blank()
  ) +
  labs(title = "",
       x = "",
       y = "r2",
       fill = NULL)