How to add an arrow to lines in R to indicate the passage of time (CC138)

August 19, 2021 • PD Schloss • 13 min read

If you want to make it super easy for your audience to see the temporal direction of a trend, add an arrow to the lines in the figure! Using the ggplot2 R package this can be done by adding the arrow argument to geom_line, geom_path, and geom_segment. We’ll make our own geom_arrow function! In this episode of Code Club, Pat continues to morph a figure he made that was originally creaed by Ipsos to a more stylized one published by chartr. The data depict the percentage of people in 15 countries who would be willing to receive the COVID-19 vaccine as of August and October of 2020.

Pat uses functions from the tidyverse including functions from the ggplot2, dplyr, ggtext and glue packages in RStudio.

Code

Final R script

library(tidyverse)
library(glue)
library(ggtext)

data <- read_csv("august_october_2020.csv") %>%
  rename(country = X.1,
         percent_august = "Total Agree - August 2020",
         percent_october = "Total Agree - October 2020") %>%
  mutate(bump_august = case_when(percent_august < percent_october ~
                                   percent_august - 2,
                                 percent_august > percent_october ~
                                   percent_august + 2,
                                 TRUE ~ NA_real_),
         bump_october = case_when(percent_august < percent_october ~
                                    percent_october + 2,
                                  percent_august > percent_october ~
                                    percent_october - 2,
                                  TRUE ~ percent_october + 2),
         y_position = rev(1:nrow(.)))

strip_data <- data %>%
  select(country, y_position) %>%
  mutate(xmin = 50, xmax=100,
         ymin = y_position - 0.5,
         ymax = y_position + 0.5,
         fill = c("c", rep(c("a", "b"), length.out=nrow(.)-1))) %>%
  pivot_longer(cols=c(xmin, xmax), values_to="x", names_to="xmin_xmax") %>%
  select(-xmin_xmax)

arrows_data <- data %>%
  filter(abs(percent_august - percent_october) > 1) %>%
  mutate(midpoint = (percent_august + 2*percent_october)/3) %>%
  select(country, y_position, percent_august, midpoint) %>%
  pivot_longer(c(percent_august, midpoint), names_to="type", values_to="x")

data %>%
  pivot_longer(cols = -c(country, y_position),
               names_to=c(".value", "month"),
               names_sep = "_") %>%
  drop_na() %>%
  ggplot(aes(x=percent, y=y_position, color=month, group=y_position)) +
  geom_ribbon(data = strip_data,
              aes(x = x, ymin=ymin, ymax = ymax, group=y_position, fill=fill),
              inherit.aes = FALSE) +
  geom_line(color="#e6e6e6", size=1.75, show.legend = FALSE) +
  geom_path(data=arrows_data, aes(x=x, y=y_position, group=y_position),
            color="red",
            arrow = arrow(angle = 30, length=unit(0.1, "in"), type="open"),
            show.legend = FALSE,
            inherit.aes = FALSE) +
  geom_point(size=2, show.legend = FALSE) +
  geom_text(aes(label=glue("{percent}%"), x=bump),
            size=3,
            show.legend = FALSE) +
  scale_color_manual(name=NULL,
                     breaks=c("august", "october"),
                     values=c("#727272", "#15607a"),
                     labels=c("August", "October")) +
  scale_x_continuous(limits=c(50, 100),
                     breaks=seq(50, 100, by=5),
                     labels=glue("{seq(50, 100, 5)}%"),
                     expand = c(0, 0)) +
  scale_y_continuous(breaks = c(data$y_position, 0.5, data$y_position+0.5),
                     labels = c(data$country, rep("", length(data$y_position)+1)),
                     expand = c(0, 0),
                     limits=c(0.5, 16.5)) +
  labs(x=NULL, y=NULL,
       title="If a vaccine for COVID-19 were available, I would get it",
       caption="<i>Base: 18,526 online adults aged 16-74 across 15 countries</i>
        <br>Source: Ipsos")+
  theme(
    plot.title.position = "plot",
    plot.title = element_text(face="bold", margin= margin(b=20)),
    plot.caption = element_markdown(hjust=0, color="darkgray"),
    plot.caption.position = "plot",
    panel.background = element_blank(),
    axis.ticks.x = element_blank(),
    axis.ticks.y = element_line(color = c(rep(NA, nrow(data)),
                                          rep("darkgray", nrow(data)+1)),
                                size=0.2),
    axis.text.x = element_text(color="darkgray"),
    axis.line = element_line(color="darkgray", size=0.2)
  )


ggsave("august_october_2020_chartr.tiff", width=6, height=4)

Initial R script

library(tidyverse)
library(glue)
library(ggtext)

data <- read_csv("august_october_2020.csv") %>%
  rename(country = X.1,
         percent_august = "Total Agree - August 2020",
         percent_october = "Total Agree - October 2020") %>%
  mutate(bump_august = if_else(percent_august < percent_october,
                               percent_august - 2,
                               percent_august + 2),
         bump_october = if_else(percent_august < percent_october,
                                percent_october + 2,
                                percent_october - 2))

strip_data <- data %>%
  select(country) %>%
  mutate(y_position = 1:nrow(.),
         ymin = y_position - 0.5,
         ymax = y_position + 0.5,
         xmin = 50,
         xmax = 100,
         fill = c(rep(c("a", "b"), length.out=15), "c")
  ) %>%
  pivot_longer(cols=c(xmin, xmax), names_to="min_max", values_to="x")


data %>%
  mutate(index = rev(1:nrow(data))) %>%
  pivot_longer(cols = -c(country, index), names_to=c(".value", "month"),
               names_sep = "_") %>%
  mutate(country = factor(country, levels = rev(data$country))) %>%
  ggplot(aes(x=percent, y=index, color=month, group=index)) +
  geom_ribbon(data=strip_data, aes(x=x, ymin=ymin, ymax=ymax, fill=fill, group=country),
              inherit.aes=FALSE) +
  geom_line(color="#e6e6e6", size=1.75, show.legend = FALSE) +
  geom_point(size=2, show.legend = FALSE) +
  geom_text(aes(label=glue("{percent}%"), x=bump),size=3, show.legend = FALSE) +
  scale_color_manual(name=NULL,
                     breaks=c("august", "october"),
                     values=c("#727272", "#15607a"),
                     labels=c("August", "October")) +
  scale_x_continuous(limits=c(50, 100),
                     breaks=seq(50, 100, by=5),
                     labels=glue("{seq(50, 100, 5)}%"),
                     expand=c(0,0)) +
  scale_y_continuous(limits=c(0.5, 16.5),
                     breaks=c(seq(1, 16, 1), seq(0.5, 16.5, 1)),
                     labels=c(rev(data$country), rep("", 17)),
                     expand=c(0,0)) +
  coord_cartesian(clip="off") +
  labs(x=NULL, y=NULL,
       title="If a vaccine for COVID-19 were available, I would get it",
       caption="<i>Base: 18,526 online adults aged 16-74 across 15 countries</i><br>Source: Ipsos")+
  theme(
    plot.title.position = "plot",
    plot.title = element_text(face="bold", margin= margin(b=20)),
    plot.caption = element_markdown(hjust=0, color="darkgray"),
    plot.caption.position = "plot",
    panel.background = element_blank(),

    axis.text.x = element_text(color="darkgray"),
    axis.ticks.x = element_blank(),
    axis.ticks.y = element_line(color=c(rep(NA, 16), rep("darkgray", 17)), size=0.2),
    axis.line = element_line(color="darkgray", size=0.2),

    panel.grid.major.x = element_blank(),
    panel.grid.major.y = element_blank()
  )

ggsave("august_october_2020_ipsos.tiff", width=6, height=4)

Data

X.1,Total Agree - August 2020,Total Agree - October 2020
Total,77,73
India,87,87
China,97,85
South Korea,84,83
Brazil,88,81
Australia,88,79
United Kingdom,85,79
Mexico,75,78
Canada,76,76
Germany,67,69
Japan,75,69
South Africa,64,68
Italy,67,65
Spain,72,64
United States,67,64
France,59,54
comments powered by Disqus