Изменение графика в виде столбца между значениями с помощью ggplot

Question

Я бы хотел построить график изменения значений в виде одного столбца между значениями, как это делает Economist:

Этот график называется dumbbell, поэтому вопрос, скорее всего, будет дубликатом, если вы знаете, что искать.

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

library(ggplot2)
library(ggthemes)
Animals <- read.table(
  header=TRUE, text='Year        Reason Species
1   2018       Genuine      24
2   2019      Genuine      16
3   2019 Misclassified      85
4   2018 Misclassified      41
5   2018     Taxonomic       2
6   2019     Taxonomic       7
7   2018       Unclear      41
8   2019       Unclear     117')

Animals$Year <- as.character(Animals$Year)

ggplot(Animals, aes(factor(Reason), Species, fill = Year)) + 
  geom_bar(stat="identity", position = "dodge") + 
  scale_fill_brewer(palette = "Set1") + 
  theme_economist() + 
  coord_flip()

Способность уменьшать цвет до розового (например) будет бонусом.

Answer 1

Я нашел функцию geom в пакете ggalt , который выполняет что-то вроде этого:

library(ggalt)
library(data.table)
Animals <- data.table(Animals)
Animals.wide <- dcast(Animals, Reason ~ Year, value.var = "Species")
colnames(Animals.wide) <- c("Reason", "species.2018", "species.2019")
p <- ggplot(
  Animals.wide,
  aes(
    y = Reason,
    x = species.2018,
    xend = species.2019
  )
)

# > Animals.wide
#          Reason species.2018 species.2019
# 1:       Genuine           24           16
# 2: Misclassified           41           85
# 3:     Taxonomic            2            7
# 4:       Unclear           41          117

p <- p + geom_dumbbell(
    size = 10,
    color = "#C1D9E4",
    colour_x = "#39C1D1",
    colour_xend = "#953D4D",
    dot_guide = TRUE, 
    dot_guide_size = 0.25,
    position = position_dodgev(height = 0.4),
    show.legend = TRUE
)
p <- p + scale_x_continuous(position = "top") 
p <- p + theme_economist()
p <- p + xlab("Species")
p <- p + ylab(NA)
p <- p + theme(
  legend.position = "top",
  axis.text.y = element_text(size = 20),
  axis.title.y = element_blank(),
  axis.title.x = element_blank(),
  axis.line.x = element_blank(),
  axis.ticks.x = element_blank(),
  axis.text.x = element_text(size = 20, margin = margin(-0.4, unit = "cm"))
)
p

Это не так гибко, как решение от @bdemarest, но почти выполняет свою работу.

Answer 2

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

# Auxiliary data.frame to draw segments.
adat = reshape2::dcast(data=Animals, 
                       formula=Reason ~ Year, 
                       value.var="Species")
adat
#          Reason 2018 2019
# 1       Genuine   24   16
# 2 Misclassified   41   85
# 3     Taxonomic    2    7
# 4       Unclear   41  117

# Colors selected from 
# https://yutannihilation.github.io/allYourFigureAreBelongToUs/ggthemes/economist_pal/
year_colors = c("2018"="#D7D29E", "2019"="#82C0E9")

p1 = ggplot() +
    theme_economist() +
    geom_point(data=Animals, 
               aes(y=Reason, x=Species, fill=Year),
               size=6, shape=21, color="grey30") +
    geom_segment(data=adat, 
                 aes(y=Reason, yend=Reason, x=`2018`, xend=`2019`),
                 size=1.8, color="grey30",
                 lineend="butt", linejoin="mitre",
                 arrow=arrow(length = unit(0.02, "npc"), type="closed")) +
    scale_fill_manual(values=year_colors)

p2 = ggplot() +
     theme_economist() +
     geom_segment(data=adat, 
                  aes(y=Reason, yend=Reason, x=`2018`, xend=`2019`),
                  size=6, color="#82C0E9", alpha=0.6, lineend="butt") +
     geom_point(data=Animals, 
                aes(y=Reason, x=Species, color=Year),
                size=6) +
     xlab("Species") +
     scale_color_manual(values=c("2018"="#C10534", "2019"="#008BBC"))

ggsave("segment_plot_1.png", plot=p1, width=8, height=2.5, dpi=150)
ggsave("segment_plot_2.png", plot=p2, width=8, height=2.5, dpi=150)

# Basic version.
p3 = ggplot() +
     geom_point(data=Animals, aes(y=Reason, x=Species, color=Year)) +
     geom_segment(data=adat, aes(y=Reason, yend=Reason, x=`2018`, xend=`2019`))

ggsave("segment_plot_3.png", plot=p3, width=8, height=2.5, dpi=150)