Four ways to set a color in R using ggplot2 and how to read hexadecimal (CC139)
If you want the figures you generrate in R to really stand out from the rest, you can modify the color you are using to help tell your data story and reflect your own personality. In this episode of Code Club, Pat will share with you four different ways to set a color as well as several approaches for matching the color schemes you find elsewhere. He also spends a little time describing what those hexadecimal codes are all about. 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 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,
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)
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) +
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)
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