线标签位于绘图右侧且不重叠
我正在尝试从我们的数据世界中重现此图表。
\n
我正在寻找使行标签看起来尽可能接近原始标签的方法。这是我到目前为止所得到的（显示版本ggrepel()，请参阅注释掉的行以获取替代方案）：
library(tidyverse)\nlibrary(ggrepel)\nkeep <- c("Israel", "United Arab Emirates", "United Kingdom",\n "United States", "Chile", "European Union", "China",\n "Russia", "Brazil", "World", "Mexico", "Indonesia",\n "Bangladesh")\n\nowid <- read_csv("https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/vaccinations/vaccinations.csv") %>%\n filter(location %in% keep) %>%\n filter(date >= "2021-01-01" & date <= "2021-02-12") %>%\n select(location, date, total_vaccinations_per_hundred) %>%\n arrange(location, date) %>%\n group_by(location) %>%\n complete(date = seq.Date(as.Date("2021-01-01"), \n as.Date("2021-02-12"), \n by="day")) %>%\n fill(total_vaccinations_per_hundred) %>%\n ungroup() %>%\n mutate(location = factor(location),\n location = fct_reorder2(location, total_vaccinations_per_hundred,\n total_vaccinations_per_hundred)) %>%\n mutate(label = if_else(date == max(date), \n as.character(location), \n NA_character_))\n\nowid %>%\n ggplot(aes(x=date, y=total_vaccinations_per_hundred, group=location,\n color=location)) +\n geom_point() + \n geom_line() +\n scale_y_continuous(breaks=c(seq(0, 70, 10))) +\n theme_minimal() + \n labs(title = "Cumulative COVID-19 vaccination doses administered per 100 people",\n 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).",\n caption = "Source: Official data collected by Our World in Data \xe2\x80\x94 Last updated 13 February, 11:40 (London time)",\n y="",\n x="") +\n theme(panel.grid.major.x = element_blank(),\n panel.grid.major.y = element_line(linetype = "dashed"),\n panel.grid.minor.y = element_blank(),\n panel.grid.minor.x = element_blank(),\n plot.title.position = "plot",\n plot.title = element_text(face="bold"),\n legend.position = "none") +\n geom_label_repel(aes(label = label),\n nudge_x = 1,\n hjust = "left", direction="y",\n na.rm = TRUE) +\n #geom_label(aes(label = label), hjust=0, nudge_x = 1) +\n scale_x_date(breaks = as.Date(c("2021-01-01",\n "2021-01-10",\n "2021-01-15",\n "2021-01-20",\n "2021-01-25",\n "2021-01-30",\n "2021-02-04",\n "2021-02-12")),\n labels = scales::date_format("%b %d"),\n limits = as.Date(c("2021-01-01",\n "2021-03-01"))) \n这是一个懒惰但一致的技巧：\n绘制两个 geom_text_repel()。\n第一个带有 (a) 文本空格 (" ")，以及 (1) 彩色链接，第二个带有 (b) 实际链接标签文本，以及 (2) 完全透明的链接（即segment.alpha = 0）。这个技巧将迫使链接的最右端朝向第二个标签的第一个字母的位置。
将代码复制到 geom_repels：
\n G01 <- \n owid %>%\n ggplot(aes(x=date, y=total_vaccinations_per_hundred, group=location,\n color=location)) +\n geom_point() + \n geom_line() +\n scale_y_continuous(breaks=c(seq(0, 70, 10))) +\n scale_x_date(limits = as.Date(c("2021-01-01", "2021-02-25"))) +\n theme_minimal() + \n labs(title = "Cumulative COVID-19 vaccination doses administered per 100 people",\n 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).",\n caption = "Source: Official data collected by Our World in Data \xe2\x80\x94 Last updated 13 February, 11:40 (London time)",\n y="",\n x="") +\n theme(panel.grid.major.x = element_blank(),\n panel.grid.major.y = element_line(linetype = "dashed"),\n panel.grid.minor.y = element_blank(),\n panel.grid.minor.x = element_blank(),\n plot.title.position = "plot",\n plot.title = element_text(face="bold"),\n legend.position = "none") +\nscale_x_date(breaks = as.Date(c("2021-01-01",\n "2021-01-10",\n "2021-01-15",\n "2021-01-20",\n "2021-01-25",\n "2021-01-30",\n "2021-02-04",\n "2021-02-12")),\n labels = scales::date_format("%b %d"),\n limits = as.Date(c("2021-01-01",\n "2021-03-01")))\n添加两个自定义 geom_text_repel：
\n G01 +\n geom_text_repel(aes(label = gsub("^.*$", " ", label)), # This will force the correct position of the link\'s right end.\n segment.curvature = -0.1,\n segment.square = TRUE,\n segment.color = \'grey\',\n box.padding = 0.1,\n point.padding = 0.6,\n nudge_x = 0.15,\n nudge_y = 1,\n force = 0.5,\n hjust = 0,\n direction="y",\n na.rm = TRUE, \n xlim = as.Date(c("2021-02-16", "2021-03-01")),\n ylim = c(0,73.75),\n ) +\n geom_text_repel(data = . %>% filter(!is.na(label)),\n aes(label = paste0(" ", label)),\n segment.alpha = 0, ## This will \'hide\' the link\n segment.curvature = -0.1,\n segment.square = TRUE,\n # segment.color = \'grey\',\n box.padding = 0.1,\n point.padding = 0.6,\n nudge_x = 0.15,\n nudge_y = 1,\n force = 0.5,\n hjust = 0,\n direction="y",\n na.rm = TRUE, \n xlim = as.Date(c("2021-02-16", "2021-03-01")),\n ylim = c(0,73.75))\n
| 归档时间： |
|
| 查看次数： |
2239 次 |
| 最近记录： |