ggplot2绘制水平堆叠条形图如何将长标签放置在对应条形上方

绘制水平堆叠条形图时，分类标签文本过长，若将标签放置在条形左侧会大幅浪费页面横向空间，导致图表有效显示尺寸过小。目标是将Zivildienst、Katastrophenschutz两个分类标签移动到对应条形的垂直上方，不再显示在左侧纵轴位置。

原有实现代码 #

library(plyr)
library(ggplot2)

data3 <- data.frame(System=rep(c('Zivildienst', 'Katastrophenschutz'), each=5),
                    Einstellung=rep(c('Sehr unwahrscheinich','Eher unwahrscheinlich','Weiss nicht','Eher wahrscheinlich','Sehr wahrscheinlich'), times=2),
                    Anzahl=c(131, 142, 283, 421, 981, 54, 140, 490, 418, 856))
level_order <- c('Zivildienst', 'Katastrophenschutz') 

data3$Einstellung = factor(data3$Einstellung, levels = c('Weiss nicht','Sehr unwahrscheinich','Eher unwahrscheinlich','Eher wahrscheinlich','Sehr wahrscheinlich'))
data3 = arrange(data3, System, desc(Einstellung))
data3 = ddply(data3, .(System), transform, percent = Anzahl/sum(Anzahl) * 100)
data3 = ddply(data3, .(System), transform, pos = (cumsum(Anzahl) - 0.5 * Anzahl))
data3$label = paste0(sprintf("%.0f", data3$percent), "%")

cbPalette <- c("#999999", "#2A7AD4", "#5C96D7", "#D3A253", "#D48F1D")

ggplot(data3, aes(x = factor(System), y = Anzahl, fill = Einstellung)) +
  geom_bar(stat = "identity", width = .3) +
  geom_text(aes(y = pos, label = label), size = 4) +
  theme(panel.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        axis.title.y = element_blank(),
        aspect.ratio = .3) +
  scale_fill_manual(values=cbPalette)+
  coord_flip()+
  ggtitle("Werden Sie sich für die Alternative entscheiden?", subtitle = "2000 Männer befragt") + labs(x = NULL)

不需要调整数据结构，只需要做3处修改即可实现标签置顶、释放横向空间的效果：

• 隐藏左侧纵轴的刻度、标签、轴线，取消左侧预留的长文本显示空间
• 提前计算每个分类对应的条形总长度，作为标签水平居中的位置依据
• 新增独立文本图层，将分类标签放置在对应条形的垂直上方居中位置，适当调整纵轴范围避免标签被裁切

修改后的可运行代码如下：

library(plyr)
library(ggplot2)

data3 <- data.frame(System=rep(c('Zivildienst', 'Katastrophenschutz'), each=5),
                    Einstellung=rep(c('Sehr unwahrscheinich','Eher unwahrscheinlich','Weiss nicht','Eher wahrscheinlich','Sehr wahrscheinlich'), times=2),
                    Anzahl=c(131, 142, 283, 421, 981, 54, 140, 490, 418, 856))

data3$Einstellung = factor(data3$Einstellung, levels = c('Weiss nicht','Sehr unwahrscheinich','Eher unwahrscheinlich','Eher wahrscheinlich','Sehr wahrscheinlich'))
data3$System = factor(data3$System, levels = c('Zivildienst', 'Katastrophenschutz'))
data3 = arrange(data3, System, desc(Einstellung))
data3 = ddply(data3, .(System), transform, percent = Anzahl/sum(Anzahl) * 100)
data3 = ddply(data3, .(System), transform, pos = (cumsum(Anzahl) - 0.5 * Anzahl))
data3$label = paste0(sprintf("%.0f", data3$percent), "%")

# 计算每个分类的条形总宽度，用于标签定位
system_label <- ddply(data3, .(System), summarise, 
                      total = sum(Anzahl),
                      mid_pos = sum(Anzahl)/2)

cbPalette <- c("#999999", "#2A7AD4", "#5C96D7", "#D3A253", "#D48F1D")

ggplot(data3, aes(y = System, x = Anzahl, fill = Einstellung)) +
  geom_col(width = .3) +
  # 堆叠块内的百分比标签
  geom_text(aes(x = pos, label = label), size = 4) +
  # 条形上方的分类标签
  geom_text(data = system_label,
            aes(y = as.numeric(System) + 0.22, x = mid_pos, label = System),
            size = 4.5, fontface = "bold") +
  theme(panel.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        # 隐藏左侧分类轴的所有元素
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        axis.line.y = element_blank(),
        axis.title = element_blank(),
        aspect.ratio = .3) +
  scale_fill_manual(values=cbPalette) +
  # 调整纵轴范围，给上方标签留出显示空间
  scale_y_discrete(expand = expansion(add = c(0.2, 0.5))) +
  ggtitle("Werden Sie sich für die Alternative entscheiden?", subtitle = "2000 Männer befragt")

运行后分类标签会显示在对应水平条形的正上方居中位置，横向空间全部用于绘制条形，空间利用率明显提升。

内容的提问来源于stack exchange，提问作者E_H