Уникальные точки R ggplot для общих ценностей

Возможно, я упускаю из виду другие варианты, но думаю, что лучше всего использовать отталкивание или изменение масштаба — лучше всего использовать оба варианта.

Я не думаю, что есть идеальное решение вашей проблемы, но многие публикации (NYTimes и тому подобное) подправляют визуализации в фотошопе или других инструментах, чтобы получить изображение того типа, которым вы поделились...

Отталкивать

Вы можете создать метку и использовать параметры geom_text_repel, чтобы расположить текст так, как вам нравится. Размер вывода вашего графика будет иметь значение, поэтому вам нужно будет использовать кнопку экспорта на панели графика, чтобы установить размер вашего графика и продолжать повторять его, пока вы не отформатируете его по своему усмотрению. Например, первое изображение ниже взято из моего репрекса, а второе — это экспортированный мною участок с шириной 800 и высотой 1200.

library(tidyverse)
library(glue)
library(ggrepel)
tax <- tribble(
  ~ Country,     ~ `1970`, ~ `1979`,
  "Sweden",          46.9,     57.4,
  "Netherlands",     44.0,     55.8,
  "Norway",          43.5,     52.2,
  "Britain",         40.7,     39.0,
  "France",          39.0,     43.4,
  "Germany",         37.5,     42.9,
  "Belgium",         35.2,     43.2,
  "Canada",          34.9,     35.8,
  "Finland",         34.9,     38.2,
  "Italy",           30.4,     35.7,
  "United States",   30.3,     32.5,
  "Greece",          26.8,     30.6,
  "Switzerland",     26.5,     33.2,
  "Spain",           22.5,     27.1,
  "Japan",           20.7,     26.6
) %>% 
  pivot_longer(
    cols=c("1970", "1979"),
    names_to = "Year",
    values_to = "Tax"
  ) |> 
  mutate(text = if_else(Year == "1970", glue("{Country} {Tax}"), glue("{Tax} {Country}")))
  
tax |> ggplot(aes(x=Year, y=Tax, group=Country)) +
  geom_line() +
  ggrepel::geom_text_repel(
    data = tax |> filter(Year == "1970"),
    aes(label = text),
    nudge_x = -.2,
    force = 2
  ) + 
  ggrepel::geom_text_repel(
    data = tax |> filter(Year == "1979"),
    aes(label = text),
    nudge_x = .2,
    force = 2
  ) + 
  theme_minimal() +
  theme(panel.grid = element_blank())

^{Created on 2024-05-01 with reprex v2.0.2}

Шкала

Вы можете попробовать использовать преобразование, чтобы масштабировать ось Y настолько, чтобы получить разделение. Этот подход может быть непростым, потому что, создавая разделение между близкими значениями, вы отодвигаете более крупные значения (например, Швеция и Нидерланды) дальше, что объединяет все ваши меньшие данные вместе. В пакете Scales есть несколько функций преобразования, которые вы можете использовать, чтобы попытаться добиться большего, чем я сделал с log2.

library(tidyverse)
library(glue)
library(ggrepel)
tax <- tribble(
  ~ Country,     ~ `1970`, ~ `1979`,
  "Sweden",          46.9,     57.4,
  "Netherlands",     44.0,     55.8,
  "Norway",          43.5,     52.2,
  "Britain",         40.7,     39.0,
  "France",          39.0,     43.4,
  "Germany",         37.5,     42.9,
  "Belgium",         35.2,     43.2,
  "Canada",          34.9,     35.8,
  "Finland",         34.9,     38.2,
  "Italy",           30.4,     35.7,
  "United States",   30.3,     32.5,
  "Greece",          26.8,     30.6,
  "Switzerland",     26.5,     33.2,
  "Spain",           22.5,     27.1,
  "Japan",           20.7,     26.6
) %>% 
  pivot_longer(
    cols=c("1970", "1979"),
    names_to = "Year",
    values_to = "Tax"
  ) |> 
  mutate(text = if_else(Year == "1970", glue("{Country} {Tax}"), glue("{Tax} {Country}")))
  
tax |> ggplot(aes(x=Year, y=Tax, group=Country)) +
  geom_line() +
  geom_text_repel(
    data = tax |> filter(Year == "1970"),
    aes(label = text),
    nudge_x = -.2,
    force = 2
  ) + 
  geom_text_repel(
    data = tax |> filter(Year == "1979"),
    aes(label = text),
    nudge_x = .2,
    force = 2
  ) + 
  theme_minimal() +
  theme(panel.grid = element_blank())

tax |> ggplot(aes(x=Year, y=Tax, group=Country)) +
  geom_line() +
  geom_text(
    data = tax |> filter(Year == "1970"),
    aes(label = text),
    nudge_x = -.2
  ) + 
  geom_text(
    data = tax |> filter(Year == "1979"),
    aes(label = text),
    nudge_x = .2
  ) + 
  scale_y_continuous(trans = scales::log2_trans()) +
  theme_minimal() +
  theme(panel.grid = element_blank())

^{Created on 2024-05-01 with reprex v2.0.2}

Если использовать ggrepel, этот реплекс очень похож на сюжет вашего примера. При смещении надписей всегда приходится идти на компромисс, но я постарался свести это к минимуму, прибегнув к использованию светлых сегментов.

Не рекомендуется создавать уникальные позиции для точек с одинаковым значением, так как это приведет к тому, что линии уклона будут «лгать». Например, рассмотрим Канаду и Финляндию на графике ниже. Оба имеют общую точку в 1970 году, но расходятся в 1979 году. Смещение начальных точек фактически разбавит или преувеличит относительное изменение между ними. Эту проблему в некоторой степени решают путем явного объявления процентных значений, но подобных искажений следует избегать. Дополнительную информацию см. в книге Эдварда Тафта «Визуальное отображение количественной информации».

Вслед за Тафте есть также аргумент в пользу размещения заголовка графика ближе к реальному графику, поскольку его текущее положение создает чрезмерные пробелы. Прокомментируйте ниже, если вы хотите, чтобы заголовок был в другом месте, и я обновлю код.

library(tibble)
library(tidyr)
library(ggplot2)
library(ggrepel)

tax <- tribble(
  ~ Country,     ~ `1970`, ~ `1979`,
  "Sweden",          46.9,     57.4,
  "Netherlands",     44.0,     55.8,
  "Norway",          43.5,     52.2,
  "Britain",         40.7,     39.0,
  "France",          39.0,     43.4,
  "Germany",         37.5,     42.9,
  "Belgium",         35.2,     43.2,
  "Canada",          34.9,     35.8,
  "Finland",         34.9,     38.2,
  "Italy",           30.4,     35.7,
  "United States",   30.3,     32.5,
  "Greece",          26.8,     30.6,
  "Switzerland",     26.5,     33.2,
  "Spain",           22.5,     27.1,
  "Japan",           20.7,     26.6
)

tax <- tax |>
  pivot_longer(cols = c("1970", "1979"),
               names_to = "Year",
               values_to = "Tax")

ggplot(tax) +
  geom_line(aes(x = Year, y = Tax, group = Country)) +
  geom_point(aes(x = Year, y = Tax, group = Country)) +
  geom_text_repel(data = subset(tax, Year == "1970"),
                  aes(x = Year, y = Tax,
                      label = paste0(Country,"  ", sprintf("%.1f", Tax))),
                  direction = "y",
                  hjust = 1,
                  nudge_x = -0.1,
                  max.overlaps = Inf,
                  force_pull = .1,
                  segment.colour = "grey50",
                  segment.size = 0.25,
                  size = 5) +
  geom_text_repel(data = subset(tax, Year == "1979"),
                  aes(x = Year, y = Tax, 
                      label = paste0(sprintf("%.1f", Tax),"  ", Country)),
                  direction = "y",
                  hjust = 0,
                  nudge_x = 0.1,
                  max.overlaps = Inf,
                  force_pull = .1,
                  segment.colour = "grey50",
                  segment.size = 0.25,
                  size = 5) +
  scale_x_discrete(position = "top") +
  annotate("text", x = -0.5, y = 57.4, hjust = 0, size = 4, fontface = 2,
           label = "Current Receipts of Government as a\nPercentage of Gross Domestic\nProduct 1970-1979") +
  coord_cartesian(clip = "off") +
  theme(panel.background = element_blank(),
        axis.title = element_blank(),
        axis.text.y = element_blank(),
        axis.text.x = element_text(size = 16),
        axis.ticks = element_blank(),
        panel.grid = element_blank())

Результат:

Обратите внимание, что для вывода этого графика используются следующие настройки ggsave():

ggsave("plot.jpg",
       width = 11, 
       height = 10,
       dpi = 150)