如何将每个类别的百分比添加到堆积条形图（ggplot2）（对于“非百分比”堆积图）

Question

如何将每个类别的百分比添加到轴的堆积条形图中，而不是填充。例如，我有以下数据集：

df<-structure(list(age_group = structure(c(3L, 3L, 5L, 3L, 5L, 5L, 
5L, 3L, 5L, 5L, 4L, 4L, 4L, 3L, 5L), .Label = c("65+", "55-64", 
"45-54", "35-44", "25-34", "18-24"), class = "factor"), Gender = c("F", 
"M", "M", "M", "F", "M", "M", "M", "F", "M", "M", "F", "M", "F", 
"M")), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
-15L), .Names = c("age_group", "Gender"))

dat <- aggregate(list(value = 1:NROW(df)), df[c("age_group", "Gender")], length)
dat$proportion <- ave(dat$value, dat$age_group, FUN = function(x) (x/sum(x)*100))
dat$proportionR <- round(dat$proportion, digits =0)

dat<-dat %>%
  group_by(age_group) %>%
  mutate(age_per = sum(value)) %>%
  ungroup() %>%
  mutate(age_per = round((age_per/sum(value))*100))

ggplot(dat, aes(x = age_group, y = value, fill = Gender)) +
  geom_col() + coord_flip() + ylab("Visits 2018-2019") +xlab("") +
  scale_fill_manual(values= c("#740404", "#AB6868", "#D5B3B3"), labels = c("Females", "Males", "N/A")) +
  theme(legend.title=element_blank()) +
  geom_text(aes(label = paste0(age_per, "%")), hjust = 2.7, position = "stack", color = "white", size =5)

我想要的是一种自动方式，可以从 y 轴为每个组添加 总百分比，同时忽略每个组内的百分比。我的工作流程确定了正确的百分比，但将其复制到堆栈中的每个子组。我希望geom_text 在栏结束后立即放置在空白处。

请注意，该问题与以下 SO Q -Adding percentage labels to a bar chart in ggplot2 并非重复，因为此问题涉及每个条形图内有堆叠组时的百分比（前者仅用于条形图）。

另外，强调自动化。我可以执行以下操作，但在我的真实数据集中，我有更多的年龄组间隔，这使得下面的方法站不住脚。

ggplot(dat, aes(x = age_group, y = value, fill = Gender)) +
  geom_col() + coord_flip() + ylab("Visits 2018-2019") +xlab("") +
  scale_fill_manual(values= c("#740404", "#AB6868", "#D5B3B3"), labels = c("Females", "Males", "N/A")) +
  theme(legend.title=element_blank()) +
  geom_text(aes(y= 5.2, x=1, label = "33%"), color = "#740404", size =5) +
  geom_text(aes(y= 3.2, x=2, label = "20%"), color = "#740404", size =5) +
  geom_text(aes(y= 7.2, x=3, label = "47%"), color = "#740404", size =5) 

Answer 1

考虑使用分组百分比计算进行注释。由于您需要将三个数字与一系列六相加，annotate 可能会偏离分组系列。此外，使用适当的性别和年龄组百分比。而在另一个base::ave 电话下方替换您的dplyr::group_by：

agg_df <- aggregate(list(value = 1:NROW(df)), df[c("age_group", "Gender")], length)

dat <- within(agg_df, {
  proportion <- ave(value, age_group, FUN = function(x) (x/sum(x)*100))
  proportionR <- round(proportion, digits=0)

  age_per <- round((ave(value, age_group, Gender, FUN=sum) / sum(value)) * 100)      
  grp_pct <- round((ave(value, age_group, FUN=sum) / sum(value)) * 100)
})

dat
#   age_group Gender value grp_pct age_per proportionR proportion
# 1     45-54      F     2      33      13          40   40.00000
# 2     35-44      F     1      20       7          33   33.33333
# 3     25-34      F     2      47      13          29   28.57143
# 4     45-54      M     3      33      20          60   60.00000
# 5     35-44      M     2      20      13          67   66.66667
# 6     25-34      M     5      47      33          71   71.42857



ggplot(dat, aes(x = age_group, y = value, fill = Gender)) +
  geom_col() + coord_flip() + ylab("Visits 2018-2019") +xlab("") +
  scale_fill_manual(values= c("#740404", "#AB6868", "#D5B3B3"), 
                    labels = c("Females", "Males", "N/A")) +
  theme(legend.title=element_blank()) +
  geom_text(aes(label = paste0(age_per, "%")), hjust = 2.7, 
            position = "stack", color = "white", size =5) + 
  annotate("text", x=1, y=5.25, label = paste0(dat$grp_pct[[1]], "%")) +
  annotate("text", x=2, y=3.25, label = paste0(dat$grp_pct[[2]], "%")) +
  annotate("text", x=3, y=7.25, label = paste0(dat$grp_pct[[3]], "%"))

---

对于动态注释，您可能必须使用Reduce 的函数形式ggplot，其中+（实际上不是加算术运算符）公开为+.gg() 运算符。然后，调用mapply，遍历unique(grp_pct)，传入x坐标位置，标注label。剩下的挑战是最好的 y 坐标是未知的。

Reduce(ggplot2:::`+.gg`, 

       c(list(ggplot(dat, aes(x = age_group, y = value, fill = Gender)),
              geom_col(), coord_flip(), ylab("Visits 2018-2019"), xlab(""),
              scale_fill_manual(values= c("#740404", "#AB6868", "#D5B3B3"),
                              labels = c("Females", "Males", "N/A")),
              theme(legend.title=element_blank()),
              geom_text(aes(label = paste0(age_per, "%")), hjust = 2.7, 
                        position = "stack", color = "white", size =5) 
         ),
         Map(function(x_loc, g_lab) annotate("text", x=x_loc, y=7.25,
                                                label = paste0(g_lab, "%")),
             seq(length(unique(dat$grp_pct))), unique(dat$grp_pct)
         )
       )
)