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

Question

我想使用 geom_text_repel 让我的标签尽可能靠近饼图的边缘，除非百分比低于某个值，在这种情况下标签应该被推得更远并且用一条线连接。我采用了的解决方案，但将组的 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, 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,0,0,30))) +
    labs(fill = "Age") +
    scale_fill_manual(values = c("#2B83BA", "#FDAE61", "#FFFF99", "#ABDDA4", "#D7191C"))

低于阈值的值符合预期，但高于阈值的值似乎在距离边缘的距离上有所不同。我相信有两件事在起作用：

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

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

Answer 1

我会提供以下技巧：

为了克服第一个问题，对所有数据同时使用geom_text_repel()和geom_text()，但只在geom_text_repel()中显示label小于 threshold 的值，并且仅在 geom_text() 中显示 label 的值大于 threshold.
为了克服第二个问题，在geom_text()中使用hjust = 'outward'，并在geom_text()和[=12中调整nudge_x的值=].
使用 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,0,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, y = ypos, label = ifelse(percent>threshold,percent(percent, accuracy = 0.1),"")), hjust = "outward", nudge_x  = 0.2, size = 7.5) + 
    geom_text_repel(aes(x = xpos, y = ypos, label = ifelse(percent<threshold, percent(percent, accuracy = 0.1), "")), nudge_x  = 0.2, size = 7.5)+ 
    coord_polar("y")

我已经通过调整 nudge_x 尝试将此代码用于多个小于 threshold 的值，并且有效。例如：

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(50, 44, 1, 2, 3))
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,0,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, y = ypos, label = ifelse(percent>threshold,percent(percent, accuracy = 0.1),"")), hjust = "outward", nudge_x  = 0.2, size = 7.5) + geom_text_repel(aes(x = xpos, y = ypos, label = ifelse(percent<threshold, percent(percent, accuracy = 0.1), "")), nudge_x  = 0.5, size = 7.5)+ 
    coord_polar("y")

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

R - nudge only selected values and keep others static with geom_text_repel

r

graph

geom-text