Positioning and formatting a legend in the ggplot2 R package (CC141)
In this Code Club, Pat goes over everything you’d want to know about positioning and formatting a legend using the ggplot2 R package. Sick of looking at the default legend in your R plots? This is the episode for you! Pat will use a variety of theme arguments to format a legend and show how to use the guides and guide_legend functions. He’ll also spend time completing his effort to convert a version of a figure he made that was originally published by Ipsos into 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 showtext package and the tidyverse including functions from the ggplot2, dplyr, ggtext and glue packages in RStudio.
Code
Final R script
library(tidyverse)
library(glue)
library(ggtext)
library(showtext)
font_add_google(family="josefin-slab", "Josefin Slab")
font_add_google(family="josefin-sans", "Josefin Sans")
showtext_auto()
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.5,
percent_august > percent_october ~
percent_august + 2.5,
TRUE ~ NA_real_),
bump_october = case_when(percent_august < percent_october ~
percent_october + 2.5,
percent_august > percent_october ~
percent_october - 2.5,
TRUE ~ percent_october + 2.5),
y_position = rev(1:nrow(.))) %>%
mutate(country = recode(country,
"South Korea" = "S. Korea",
"South Africa" = "S. Africa",
"United Kingdom" = "UK",
"United States" = "USA")) %>%
filter(country != "Total")
strip_data <- data %>%
select(country, y_position) %>%
mutate(xmin = 50, xmax=100,
ymin = y_position - 0.5,
ymax = y_position + 0.5,
fill = c(rep(c("a", "b"), length.out=nrow(.)))) %>%
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,
show.legend=FALSE) +
geom_line(color="#153744", size=0.75, show.legend = FALSE) +
geom_path(data=arrows_data, aes(x=x, y=y_position, group=y_position),
color="#153744",
size=0.75,
arrow = arrow(angle = 45, length=unit(0.1, "in"), type="open"),
show.legend = FALSE,
inherit.aes = FALSE) +
geom_point(size=3, show.legend = TRUE) +
geom_text(aes(label=glue("{percent}%"), x=bump),
size=3,
color="#686868", family="josefin-sans",
show.legend = FALSE) +
scale_color_manual(name="If a vaccine for COVID-19 were\navailable, I totally argree I would get it...",
breaks=c("october", "august"),
values=c("#59AC74", "#153744"),
labels=c("<span style='color:#59AC74'>October '20</span>",
"<span style='color:#153744'>August '20</span>"),
guide = guide_legend(override.aes = list(size=4))) +
scale_fill_manual(name=NULL,
breaks=c("a", "b", "c"),
values=c("#DFEAF9", "#EDF4F7", "#F3FAFE"),
labels=c("a", "b", "c")) +
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,
length(data$y_position) + 1.5),
labels = c(data$country, rep("", length(data$y_position)+2)),
expand = c(0, 0),
limits=c(0.5, 16.5)) +
labs(x="<span style='color:#4DA6BE;'>chart</span><span style='color:#E9B388;'>r</span>", y=NULL,
title="Vaccine Skepticism by Country",
caption="Source: Ipsos")+
theme(
text = element_text(family = "josefin-sans"),
plot.title.position = "plot",
plot.title = element_text(face="bold", margin= margin(b=25, t=15), size=26,
color="#2E737B", family = "josefin-slab"),
plot.caption = element_markdown(hjust=0, color="darkgray",
margin = margin(t=-10)),
plot.caption.position = "plot",
plot.background = element_rect(fill="#F3FAFE"),
plot.margin = margin(l=5, r=15),
panel.background = element_blank(),
panel.grid = element_blank(),
axis.ticks.x = element_blank(),
axis.ticks.y = element_line(color = c(rep(NA, nrow(data)),
rep("darkgray", nrow(data)+2)),
size=0.2),
axis.text.x = element_text(color="#686868", size=6),
axis.text.y = element_text(face="bold"),
axis.title.x = element_markdown(family="josefin-slab", face="bold", size=25),
axis.line = element_line(color="darkgray", size=0.2),
legend.background = element_blank(),
legend.position = c(0, 1.0),
legend.direction = "horizontal",
legend.title = element_text(size=9, lineheight = 1.3),
legend.justification = "left",
legend.key = element_blank(),
legend.key.width = unit(3, "pt"),
legend.text = element_markdown(margin = margin(r=10))
) +
guides(fill="none") +
coord_cartesian(clip="off")
ggsave("august_october_2020_chartr.tiff", width=5, height=5)
Initial R script
library(tidyverse)
library(glue)
library(ggtext)
library(showtext)
font_add_google(family="josefin-slab", "Josefin Slab")
font_add_google(family="josefin-sans", "Josefin Sans")
showtext_auto()
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,
show.legend=FALSE) +
geom_line(color="#153744", size=0.75, show.legend = FALSE) +
geom_path(data=arrows_data, aes(x=x, y=y_position, group=y_position),
color="#153744",
size=0.75,
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=2,
color="#686868", family="josefin-sans",
show.legend = FALSE) +
scale_color_manual(name=NULL,
breaks=c("august", "october"),
values=c("#153744", "#59AC74"),
labels=c("August", "October")) +
scale_fill_manual(name=NULL,
breaks=c("a", "b", "c"),
values=c("#DFEAF9", "#EDF4F7", "#F3FAFE"),
labels=c("a", "b", "c")) +
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="<span style='color:#4DA6BE;'>chart</span><span style='color:#E9B388;'>r</span>", y=NULL,
title="Vaccine Skepticism by Country",
caption="<i>Base: 18,526 online adults aged 16-74 across 15 countries</i>
<br>Source: Ipsos")+
theme(
text = element_text(family = "josefin-sans"),
plot.title.position = "plot",
plot.title = element_text(face="bold", margin= margin(b=20),
color="#2E737B", family = "josefin-slab"),
plot.caption = element_markdown(hjust=0, color="darkgray"),
plot.caption.position = "plot",
plot.background = element_rect(fill="#F3FAFE"),
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="#686868", size=6),
axis.title.x = element_markdown(family="josefin-slab", face="bold"),
axis.line = element_line(color="darkgray", size=0.2)
)
ggsave("august_october_2020_chartr.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