r - 在水平条形图中的刻度标签之间添加部分标题

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

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

如果您想要跨面的 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 创建于 2018-10-02 (v0.2.1.9000)}