Есть ли способ сделать линейный график, который соединяет эмперические пары слов с ggplot2?

Question

Я не уверен, какое имя будет правильным для этого типа сюжета, но допустим, у нас есть список имен (или букв здесь): data <- data.frame(letters[1:10]) Допустим также, что мы хотим проиллюстрировать, какие из этих имен связаны основанный на некотором эмпирическом решении, поэтому у нас есть список наблюдений, которые мы хотим объединить в график, подобный следующему (выполненный в PowerPoint):

введите описание изображения здесь

Можно ли это сделать в ggplot?

Answer 1

Да, это можно сделать в ggplot.

Начнем с настройки фрейма данных из букв с соответствующими позициями по осям x и y графика. Мы сделаем значения x 1 и 2 (хотя это произвольно) и значения y 1:10 (также произвольными, если они равномерно распределены).

labels <- data.frame(x    = c(rep(1, 10), rep(2, 10)), 
                     y    = rep(1:10, 2), 
                     labs = rep(LETTERS[10:1], 2),
                     stringsAsFactors = FALSE)

Теперь нам также нужны способ решить, какие буквы будут соединены. Давайте сделаем это, имея простой фрейм данных с «левым» и «правым» значениями, где каждая строка описывает, какие две буквы будут соединены:

set.seed(69)

joins <- data.frame(left  = sample(LETTERS[1:10], 6, TRUE),
                    right = sample(LETTERS[1:10], 6, TRUE),
                    stringsAsFactors = FALSE)
joins
#>   left right
#> 1    A     G
#> 2    B     B
#> 3    H     J
#> 4    G     D
#> 5    G     J
#> 6    F     B

Теперь мы можем назначить начало и конец x и y co -координаты для строк путем сопоставления букв в этих двух столбцах со столбцами в нашем labels фрейме данных:

joins$x    <- rep(1.05, nrow(joins))
joins$xend <- rep(1.9, nrow(joins))
joins$y    <- labels$y[match(joins$left, labels$labs)]
joins$yend <- labels$y[match(joins$right, labels$labs)]

Это просто оставляет график. Мы хотим избавиться от всех осей, заголовков и легенд, поэтому используем theme_void:

library(ggplot2)

ggplot(labels, aes(x, y)) + 
  geom_text(aes(label = labs), size = 8) +
  geom_segment(data = joins, aes(xend = xend, yend = yend, color = left),
               arrow = arrow(type = "closed", length = unit(0.02, "npc"))) +
  coord_cartesian(xlim = c(0.5, 2.5)) +
  theme_void() + 
  theme(legend.position = "none")

^{Created on 2020-07-10 by the пакет реплекс (v0.3.0)}

Answer 2

Это решение можно было бы привести в порядок, но для начала можно использовать geom_segment

library(tidyverse)
tibble(x0 = 0, x1 = 1, y0 = sample(letters[1:10]), y1 = sample(letters[1:10])) %>% 
  mutate(y0 = factor(y0, levels = rev(letters[1:10])),
         y1 = factor(y1, levels = rev(letters[1:10]))) %>% 
  ggplot(aes(x = x0, xend = x1, y = y0, yend = y1)) +
  geom_segment(arrow = arrow(length = unit(0.03, "npc"))) +
  geom_text(aes(x = x1, y = y1, label = y1), nudge_x = 0.01)