R - 仅微调选定的值并使用 geom_text_repel 保持其他值不变

问题描述

我想使用 geom_text_repel 使我的标签尽可能靠近饼图的边缘，除非百分比低于某个值，在这种情况下，标签应该被推得更远并用一条线连接。我改编了 Move labels in ggplot2 pie graph 的解决方案，但增加了高于阈值的组的 xpos 值。

library(dplyr)
library(ggplot2)
library(ggrepel)
library(scales)
threshold = 0.05    
age <- data.frame(Age = c("20 - 29","30 - 39","40 - 49","50 - 59","60 - 69"),count = c(27,29,26,16,2))
age <- age %>% mutate(percent = count/sum(count),cs = rev(cumsum(rev(percent))),ypos = percent/2 + lead(cs,1),ypos = ifelse(is.na(ypos),percent/2,ypos),xpos = ifelse(percent > threshold,1.8,1.3),xn = ifelse(percent > threshold,0.5))
ggplot(age,aes_string(x = 1,y = "percent",fill = "Age")) +
    geom_bar(width = 1,stat = "identity",colour = "black") +
    geom_text_repel(aes(label = percent(percent,accuracy = 0.1),x = xpos,y = ypos),size = 7.5,nudge_x = age$xn,segment.size = .5,direction = "x",force = 0.5,hjust = 1) +
    coord_polar("y",start = 0,clip = "off") + 
    theme_minimal() +
    theme(axis.text.x = element_blank(),axis.title.x = element_blank(),axis.text.y = element_blank(),axis.title.y = element_blank(),panel.border = element_blank(),panel.grid = element_blank(),legend.title = element_text(size = 22.5),legend.text = element_text(size = 19.5),legend.Box.margin=margin(c(0,30))) +
    labs(fill = "Age") +
    scale_fill_manual(values = c("#2B83BA","#FDAE61","#FFFF99","#ABDDA4","#D7191C"))

低于阈值的值与预期一致，但高于阈值的值似乎与它们离边缘的距离不同。我相信有两件事在起作用：

1. 尽管与任何其他标签不那么接近，但这些标签仍然被“排斥”。这在 16.0% 标签中最为明显。
2. xpos 指示标签中心的位置，但由于标签是水平的，如果标签的位置靠近水平轴，它们可能会切入图形。

我该如何解释这两个问题？或者，如果有任何其他问题，我很感激帮助识别它们。如果其他人可以遵循这种格式，我会认为 29.0% 的标签就足够了。

解决方法

我会提供以下技巧：

1. 为了解决第一个问题，对所有数据同时使用geom_text_repel()和geom_text()，但仅对小于{的值在label中显示geom_text_repel() {1}}，并仅对大于 threshold 的值在 label 中显示 geom_text()。

2. 为了解决第二个问题，在threshold中使用hjust = 'outward'，并在geom_text()和nudge_x中调整geom_text()的值。

3. 使用 geom_text_repel() 创建连接饼图区域和标签的线。

完整代码如下：

geom_segment()

我已经通过调整 library(dplyr) library(ggplot2) library(ggrepel) library(scales) threshold = 0.05 age <- data.frame(Age = c("20 - 29","30 - 39","40 - 49","50 - 59","60 - 69"),count = c(27,29,26,16,2)) age <- age %>% mutate(percent = count/sum(count),cs = rev(cumsum(rev(percent))),ypos = percent/2 + lead(cs,1),ypos = ifelse(is.na(ypos),percent/2,ypos),xpos = ifelse(percent > threshold,1.4,1.8)) ggplot(age,aes_string(x = 1,y = "percent",fill = "Age")) + geom_bar(width = 1,stat = "identity",colour = "black") + theme_minimal() + theme(axis.text.x = element_blank(),axis.title.x = element_blank(),axis.text.y = element_blank(),axis.title.y = element_blank(),panel.border = element_blank(),panel.grid = element_blank(),legend.title = element_text(size = 22.5),legend.text = element_text(size = 19.5),legend.box.margin=margin(c(0,30))) + labs(fill = "Age") + scale_fill_manual(values = c("#2B83BA","#FDAE61","#FFFF99","#ABDDA4","#D7191C")) + geom_segment(aes(x = ifelse(percent<threshold,1,xpos),xend = xpos,y = ypos,yend = ypos)) + geom_text(aes(x = xpos,label = ifelse(percent>threshold,percent(percent,accuracy = 0.1),"")),hjust = "outward",nudge_x = 0.2,size = 7.5) + geom_text_repel(aes(x = xpos,label = ifelse(percent<threshold,size = 7.5)+ coord_polar("y") 尝试了此代码小于 threshold 的多个值，并且它有效。 例如：

nudge_x