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

Question

我想使用 geom_text_repel 使我的标签尽可能靠近饼图的边缘，除非百分比低于某个值，在这种情况下，标签应该被推得更远并用一条线连接。我从ggplot2 饼图中的移动标签中调整了一个解决方案，但增加了高于阈值的组的 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"))

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

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

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

Answer 1

我会提供以下技巧：

1. 要解决第一个问题，请对所有数据使用 ofgeom_text_repel()和，但仅对小于 的值显示in ，仅对大于 的值显示in 。geom_text()labelgeom_text_repel()thresholdlabelgeom_text()threshold

2. 要解决第二个问题，请使用hjust = 'outward'in ，并调整in和geom_text()的值。nudge_xgeom_text()geom_text_repel()

3. 用于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")

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

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")