在ggplot2中自定义条形图

Question

我希望能够绘制出与以下图A类似的图形：

我使用了以下代码，但需要一些帮助来自定义我的图形。

欢迎提供任何帮助。

先行谢过。

groupe2<-rep(c(rep("P",4),rep("I",4)),3)
groupe<-rep(c("PPP","PPI","PII","PIP","III","IIP","IPP","IPI"),3)
OR_A<-c(1.00,0.86,0.90,0.88,0.70,0.77,0.77,0.68)
ICinf_A<-c(NA,0.70,0.76,0.72,0.61,0.61,0.60,0.50)
ICsup_A<-c(NA,1.06,1.06,1.07,0.81,0.96,1.00,0.92)
OR_B<-c(1.00,0.97,0.81,1.01,0.58,0.61,0.73,0.69)
ICinf_B<-c(NA,0.78,0.62,0.77,0.52,0.50,0.61,0.57)
ICsup_B<-c(NA,1.20,1.05,1.28,0.65,0.71,0.81,0.82)
OR_C<-c(1.00,1.03,0.65,0.86,0.37,0.47,0.68,0.58)
ICinf_C<-c(NA,0.84,0.50,0.67,0.33,0.40,0.59,0.49)
ICsup_C<-c(NA,1.27,0.86,1.10,0.41,0.56,0.78,0.69)
outcome<-c(rep("PC M",8), rep("RIC M",8), rep("RIC C",8))

OR<-c(OR_A,OR_B,OR_C)
ICinf<-c(ICinf_A,ICinf_B,ICinf_C)
ICsup<-c(ICsup_A,ICsup_B,ICsup_C)

dataOR<-data.frame(OR,groupe,outcome,groupe2,ICinf,ICsup)

#pour mettre l'ordre qu'on veut pour la légende (par défaut : ordre alphabétique)
dataOR[, "groupe"] <- factor(dataOR[, "groupe"] , 
                             levels = c("PPP","PPI","PII","PIP","III","IIP","IPP","IPI"))

##########
##########


ggplot(dataOR, aes(fill=outcome, y=OR, x=groupe)) +
  geom_bar(position="dodge", stat="identity") + 
  scale_fill_brewer(palette="Blues")+
  geom_errorbar(aes(ymin=ICinf, ymax=ICsup), width=.2,position=position_dodge(.9))+
  #theme(panel.background = element_rect(fill="lightgreen"))+
  geom_hline(yintercept=1)

关于图 A 的标签:

例如:

PPP，等等...

应该放在

基本活动水平，等等...

- Peter

Answer 1

看起来您想使用 ggplot 的分面功能。对您的代码进行一些小修改即可实现分面，删除 x 轴，并添加点：

ggplot(dataOR, aes(fill=outcome, y=OR, x=factor(1))) + #Reset x-axis
  geom_bar(position="dodge", stat="identity") + 
  scale_fill_brewer(palette="Blues")+
  geom_errorbar(aes(ymin=ICinf, ymax=ICsup), width=.2,position=position_dodge(.9))+
  geom_point(position=position_dodge(.9)) + #Add points
  geom_hline(yintercept=1) + 
  facet_wrap(~groupe, nrow = 1) +  #Add facets
  scale_x_discrete(name = NULL, labels = NULL, breaks = NULL) #Remove labels

根据下面的评论，要更改特定组的颜色，您可以执行以下操作：

---

colors = c(brewer.pal(3, "Blues"), rep(brewer.pal(3,"Reds"), 3), rep(brewer.pal(3, "Blues"), 4))

ggplot(dataOR, aes(fill=interaction(outcome, groupe), y=OR, x=factor(1))) +
  geom_bar(position="dodge", stat="identity") + 
  scale_fill_manual(values = colors, guide = FALSE) +
  geom_errorbar(aes(ymin=ICinf, ymax=ICsup), width=.2,position=position_dodge(.9))+
  geom_point(position=position_dodge(.9)) +
  geom_hline(yintercept=1) + 
  facet_wrap(~groupe, nrow = 1) + 
  scale_x_discrete(name = NULL, labels = NULL, breaks = NULL)

- Mike H.

---

哇，非常感谢你，Mike！最后一个问题？我该如何将前三列（PPI、PIP、PII）标记为红色，然后将另外四列（III、IPP、IPI、IPP）标记为绿色？当然，第一列PPP仍然保持灰色。谢谢，谢谢。 - Peter

嗨，Mike！谢谢你的更新。不过我的意思是只给顶部上色并保留标签。然而，为了这样做，我最好使用Scratch进行标注（而不是3种蓝色），并使用颜色将A组和B组二分。如果你能帮忙，我已经更新了（更新图表）我的消息。谢谢。 - Peter

@Peter，这会更难。最好不要不断更新你的问题…… - Mike H.

没错！你有什么想法可以实现这个吗？ - Peter

@Peter，我认为你可能需要将其转换为“gtable”，并通过添加这三个盒子作为“grobs”进行修改 - Mike H.

Answer 2

我想我已经理解了您对第一个图的所有要求。我做了一些微调，其中一些是使用theme参数，一些则有点hacky：

• 在条形图周围添加了一条细线，颜色与面板背景大致相同，这样条形图就不会全部挤在一起了。
• 更改了填充方式，跳过了调色板中最浅的颜色，只是因为浅蓝色在浅灰色背景上很难看到（可以随意放弃此项）。
• 添加了一个geom_point，但设置为不显示在图例中。
• 扩展了y轴比例尺，以消除条形底部的间隙。
• 分面在单行上，并具有自由的x缩放。
• 删除了图例标题。
• 将图例放在顶部，并带有边框和矩形键。
• 在x轴和y轴上都添加了黑色坐标轴线。
• 删除了坐标轴刻度和x轴刻度标签。
• 删除了x网格。
• 将坐标轴标题加粗。

我想这就是两者之间的所有区别了！

ggplot(dataOR, aes(fill=outcome, y=OR, x=groupe)) +
    geom_bar(position="dodge", stat="identity", color = "gray95", size = 0.25) + 
    # scale_fill_brewer(palette="Blues")+
    scale_fill_manual(values = RColorBrewer::brewer.pal(5, "Blues")[3:5]) +
    geom_errorbar(aes(ymin=ICinf, ymax=ICsup), width=.4, position=position_dodge(.9))+
    geom_hline(yintercept=1) +
    geom_point(position = position_dodge(0.9), size = 0.5, show.legend = F) +
    scale_y_continuous(expand = expand_scale(mult = c(0, 0.05))) +
    facet_wrap(~groupe, nrow = 1, scales = "free_x") +
    labs(fill = NULL) +
    theme(legend.position = "top", 
                legend.key.height = unit(0.2, "cm"), 
                legend.background = element_rect(color = "black", size = 0.4), 
                axis.line = element_line(color = "black"),
                axis.text.x = element_blank(),
                axis.ticks = element_blank(),
                panel.grid.major.x = element_blank(),
                axis.title = element_text(face = "bold"))
#> Warning: Removed 3 rows containing missing values (geom_errorbar).

这段内容是由 reprex包（v0.2.0）在2018-05-04创建的。

- camille