r - 图右侧的线标签不重叠

Question

我正在尝试重现 this chart来自我们的数据世界。

我正在寻找能让线条标签看起来尽可能接近原始标签的方法。这是我到目前为止所得到的(显示 ggrepel() 版本，请参阅备用的注释行):

library(tidyverse)
library(ggrepel)
keep <- c("Israel", "United Arab Emirates", "United Kingdom",
          "United States", "Chile", "European Union", "China",
          "Russia", "Brazil", "World", "Mexico", "Indonesia",
          "Bangladesh")

owid <- read_csv("https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/vaccinations/vaccinations.csv") %>%
  filter(location %in% keep) %>%
  filter(date >= "2021-01-01" & date <= "2021-02-12") %>%
  select(location, date, total_vaccinations_per_hundred) %>%
  arrange(location, date) %>%
  group_by(location) %>%
  complete(date = seq.Date(as.Date("2021-01-01"), 
                           as.Date("2021-02-12"), 
                           by="day")) %>%
  fill(total_vaccinations_per_hundred) %>%
  ungroup() %>%
  mutate(location = factor(location),
         location = fct_reorder2(location, total_vaccinations_per_hundred,
                                 total_vaccinations_per_hundred)) %>%
  mutate(label = if_else(date == max(date), 
                         as.character(location), 
                         NA_character_))

owid %>%
  ggplot(aes(x=date, y=total_vaccinations_per_hundred, group=location,
                 color=location)) +
  geom_point() + 
  geom_line() +
  scale_y_continuous(breaks=c(seq(0, 70, 10))) +
  theme_minimal() + 
  labs(title = "Cumulative COVID-19 vaccination doses administered per 100 people",
       subtitle = "This is counted as a single dose, and may not equal the total number of people vaccinated, depending on the specific dose regime (e.g. people receive multiple doses).",
       caption = "Source: Official data collected by Our World in Data — Last updated 13 February, 11:40 (London time)",
       y="",
       x="") +
  theme(panel.grid.major.x = element_blank(),
        panel.grid.major.y = element_line(linetype = "dashed"),
        panel.grid.minor.y = element_blank(),
        panel.grid.minor.x = element_blank(),
        plot.title.position = "plot",
        plot.title = element_text(face="bold"),
        legend.position = "none") +
  geom_label_repel(aes(label = label),
                   nudge_x = 1,
                   hjust = "left", direction="y",
                   na.rm = TRUE) +
  #geom_label(aes(label = label), hjust=0, nudge_x = 1) +
  scale_x_date(breaks = as.Date(c("2021-01-01",
                                  "2021-01-10",
                                  "2021-01-15",
                                  "2021-01-20",
                                  "2021-01-25",
                                  "2021-01-30",
                                  "2021-02-04",
                                  "2021-02-12")),
               labels = scales::date_format("%b %d"),
               limits = as.Date(c("2021-01-01",
                                  "2021-03-01"))) 

Answer 1

这是一个偷懒但始终如一的技巧:绘制两个 geom_text_repel()。第一个带有 (a) 文本空格 ("")，以及 (1) 彩色链接，第二个带有 (b) 实际标签文本，以及 (2) 完全透明的链接(即 segment.alpha = 0).这个技巧将迫使链接的最右端指向第二个标签的第一个字母的位置。

将您的代码复制到 geom_repels:

 G01 <-  
  owid %>%
  ggplot(aes(x=date, y=total_vaccinations_per_hundred, group=location,
             color=location)) +
  geom_point() + 
  geom_line() +
  scale_y_continuous(breaks=c(seq(0, 70, 10))) +
  scale_x_date(limits = as.Date(c("2021-01-01", "2021-02-25"))) +
  theme_minimal() + 
  labs(title = "Cumulative COVID-19 vaccination doses administered per 100 people",
       subtitle = "This is counted as a single dose, and may not equal the total number of people vaccinated, depending on the specific dose regime (e.g. people receive multiple doses).",
       caption = "Source: Official data collected by Our World in Data — Last updated 13 February, 11:40 (London time)",
       y="",
       x="") +
  theme(panel.grid.major.x = element_blank(),
        panel.grid.major.y = element_line(linetype = "dashed"),
        panel.grid.minor.y = element_blank(),
        panel.grid.minor.x = element_blank(),
        plot.title.position = "plot",
        plot.title = element_text(face="bold"),
        legend.position = "none") +
scale_x_date(breaks = as.Date(c("2021-01-01",
                                "2021-01-10",
                                "2021-01-15",
                                "2021-01-20",
                                "2021-01-25",
                                "2021-01-30",
                                "2021-02-04",
                                "2021-02-12")),
             labels = scales::date_format("%b %d"),
             limits = as.Date(c("2021-01-01",
                                "2021-03-01")))

添加两个自定义 geom_text_repels:

   G01 +
  geom_text_repel(aes(label = gsub("^.*$", " ", label)), # This will force the correct position of the link's right end.
                  segment.curvature = -0.1,
                  segment.square = TRUE,
                  segment.color = 'grey',
                  box.padding = 0.1,
                  point.padding = 0.6,
                  nudge_x = 0.15,
                  nudge_y = 1,
                  force = 0.5,
                  hjust = 0,
                  direction="y",
                  na.rm = TRUE, 
                  xlim = as.Date(c("2021-02-16", "2021-03-01")),
                  ylim = c(0,73.75),
  ) +
  geom_text_repel(data = . %>% filter(!is.na(label)),
                  aes(label = paste0("  ", label)),
                  segment.alpha = 0, ## This will 'hide' the link
                  segment.curvature = -0.1,
                  segment.square = TRUE,
                  # segment.color = 'grey',
                  box.padding = 0.1,
                  point.padding = 0.6,
                  nudge_x = 0.15,
                  nudge_y = 1,
                  force = 0.5,
                  hjust = 0,
                  direction="y",
                  na.rm = TRUE, 
                  xlim = as.Date(c("2021-02-16", "2021-03-01")),
                  ylim = c(0,73.75))