在水平条形图中的刻度标签之间添加节标题

Question

我正在尝试制作一个水平分组条形图，显示人们如何回答不同的问题。

有没有办法可以将问题分成几个部分，在每个部分上方加上一个粗体标题，说明它是什么？如果没有它，最好不要像我使用面板那样产生单独的绘图区域。

对于下面的示例，假设我要插入的标题是“元音”和“辅音”（hand-drawn in red in the picture in this example）

library('ggplot2')
library('stringr')
set.seed(5)

questions <- str_wrap(c('Blah blah blah blah blah blah B?',
                        'Blbbity blah blibbity blah C?',
                        'Blah blah blibbity blah blah blah D?',
                        'Blah blah blah A?',
                        'Blah blah blah blibbity E?',
                        'Blah blah blibbity blah I?'),15)

status <- data.frame(matrix(data=NA, nrow=18,ncol=3))
names(status) <- c('varname','type','percent')
status['varname'] <- factor(c(rep(1,3),rep(2,3),rep(3,3),rep(4,3),rep(5,3),rep(6,3)),labels=questions)
status['type'] <- c(rep(c('Cohabiting','Married','Divorced'),6))
status['percent'] <- c(rnorm(18,.5,.2))
ggplot(status, aes(varname, percent)) +   
  theme(axis.title.y = element_blank(), legend.title = element_blank(), plot.title = element_text(hjust = 0.5), legend.position = "top") +
  geom_bar(aes(fill = type), position = "dodge", stat="identity") + coord_flip() + scale_fill_manual(values=c('cadetblue1','cadetblue3','darkcyan')) +
  ggtitle('By couple type') + labs(y='Percent') + ylim(0,1)

Answer 1

如何使用构面？

library(tidyverse)
status %>%
    mutate_if(is.factor, as.character) %>%
    mutate(Group = if_else(str_detect(varname, "(I|E|A)\\?$"), "Vowels", "Consontants")) %>%
    ggplot(aes(varname, percent)) +
    theme(
        axis.title.y = element_blank(),
        legend.title = element_blank(),
        plot.title = element_text(hjust = 0.5),
        legend.position = "top") +
  geom_bar(aes(fill = type), position = "dodge", stat = "identity") +
  facet_wrap(~Group, ncol = 1, scales = "free_y") +
  coord_flip() +
  scale_fill_manual(values = c('cadetblue1', 'cadetblue3', 'darkcyan')) +
  ggtitle('By couple type') +
  labs(y = 'Percent') +
  ylim(0, 1)

或者您可以将条形标签向左移动：

library(tidyverse)
status %>%
    mutate_if(is.factor, as.character) %>%
    mutate(Group = if_else(str_detect(varname, "(I|E|A)\\?$"), "Vowels", "Consontants")) %>%
    ggplot(aes(varname, percent)) +
    theme(
        axis.title.y = element_blank(),
        legend.title = element_blank(),
        plot.title = element_text(hjust = 0.5),
        legend.position = "top") +
  geom_bar(aes(fill = type), position = "dodge", stat = "identity") +
  facet_wrap(~Group, ncol = 1, scales = "free_y", strip.position = "left") +
  coord_flip() +
  scale_fill_manual(values = c('cadetblue1', 'cadetblue3', 'darkcyan')) +
  ggtitle('By couple type') +
  labs(y = 'Percent') +
  ylim(0, 1)

Answer 2

您可以调整facet_grid() plot 以根据自己的喜好删除所有面板。

如果您想要跨平面的 y 轴，请参阅answer

library(dplyr)
library("ggplot2")
library("stringr")

# create new alp variable
status <- status %>% 
  # edit: shamelessly steal from Maurits's answer :-)
  mutate(alp = if_else(str_detect(varname, "(I|E|A)\\?$"), "Vowels", "Consontants"))

p2 <- ggplot(status, aes(varname, percent)) +
  geom_col(aes(fill = type), position = "dodge") + 
  facet_grid(alp ~ ., scales = 'free_y', space = 'free_y', switch = 'y') +
  coord_flip() + 
  scale_fill_manual(values = c("cadetblue1", "cadetblue3", "darkcyan"),
                    # increase the spacing between legend key text
                    labels = stringr::str_pad(status$type, 5, "right"),) +
  ggtitle("By couple type") + 
  labs(y = "Percent") + 
  scale_x_discrete(expand = c(0, 0)) +
  scale_y_continuous(expand = c(0, 0), limits = c(0, 1)) +
  theme_classic(base_size = 14, base_family = 'mono') +
  theme(axis.title.y = element_blank(), 
        legend.spacing.x = unit(0.25, unit = "cm"),
        legend.title = element_blank(), 
        plot.title = element_text(hjust = 0.5), 
        legend.position = "top") +
  theme(panel.grid.minor.x = element_blank()) + 
  # switch the facet strip label to outside 
  theme(strip.placement = 'outside',
        strip.text.y = element_text(face = 'bold'),
        strip.background.y = element_rect(colour = NA, fill = 'grey80'))
p2

p3 <- ggplot(status, aes(varname, percent)) +
  geom_col(aes(fill = type), position = "dodge") + 
  facet_grid(alp ~ ., scales = 'free_y', space = 'free_y', switch = 'y') +
  coord_flip() + 
  scale_fill_manual(values = c("cadetblue1", "cadetblue3", "darkcyan"),
                    # increase the spacing between legend key text
                    labels = stringr::str_pad(status$type, 5, "right"),) +
  ggtitle("By couple type") + 
  labs(y = "Percent") + 
  scale_x_discrete(expand = c(0, 0)) +
  scale_y_continuous(expand = c(0, 0), limits = c(0, 1)) +
  theme_classic(base_size = 14, base_family = 'mono') +
  theme(axis.title.y = element_blank(), 
        legend.spacing.x = unit(0.25, unit = "cm"),
        legend.title = element_blank(), 
        plot.title = element_text(hjust = 0.5), 
        legend.position = "top") +
  theme(panel.grid.minor.x = element_blank()) + 
  # switch the facet strip label to outside 
  # remove background color
  theme(strip.placement = 'outside',
        strip.text.y = element_text(face = 'bold'),
        strip.background.y = element_blank())
p3

^{由reprex package (v0.2.1.9000) 于 2018 年 10 月 2 日创建}