在水平條形圖中的刻度標簽之間添加節標題

Question

我試圖制作一個水平分組條形圖，顯示人們如何回答不同的問題。

有沒有辦法可以將問題分成幾個部分，在每個部分上面加上一個大膽的標題，說明它是什么？ 最好沒有它會產生單獨的繪圖區域，就像我使用面板時那樣。

對於下面的示例，假設我要插入的標題是“元音”和“輔音”（ 在本例中圖片中用手繪紅色 ）

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軸，請參閱此答案

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包創建於2018-10-02（v0.2.1.9000）}

Answer 2

使用facet怎么樣？

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)