Customizing fonts in R with an installed font and directly from google fonts (CC140)
Sick of looking at the arial font in your ggplot2 R plots? In this episode of Code Club, Pat will show how to use the showtext package to load other fonts that are installed on your computer and how to load them directly from google fonts. He’ll also discuss how to match and find fonts that you see on websites. Here, 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 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,
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)
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 = 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",
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="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),
color="#2E737B"),
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(),
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