Recreating a sentiment analysis visualization from the Pew Research Center in R with ggplot2 (CC351)
Pat uses R to show how to recreate a stacked bar plot positioned next to a bar plot that was posted by the Pew Research Center describing people’s sense of how different groups will fare under the Trump Administration. To pull this off he uses the ggplot2, showtext, and ggtext packages. The functions he uses from these packages include abs, aes, annotate, as.character, case_when, coord_cartesian, element_blank, element_markdown, element_text, factor, font_add_google, function, geom_col, geom_crossbar, geom_text, geom_text, geom_vline, ggplot, ggsave, if_else, labs, library, margin, max, mutate, mutate, mutate, mutate, pivot_longer, rev, scale_fill_manual, select, select, showtext_auto, showtext_opts, theme, and tribble. The newsletter describing this visualization at a 30,000 ft view can be found here. You can find the original Pew Research Center article here.
Code
library(tidyverse)
library(showtext)
library(ggtext)
font_add_google("Libre Franklin", "franklin")
font_add_google("Gelasio", "gelasio")
showtext_opts(dpi = 300)
showtext_auto()
get_label <- function(x){
if_else(x == 0, "", as.character(abs(x)))
}
data <- tribble(
~category,~lose,~gain,~none,
"Business corporation",11,70,18,
"Wealthy people",9,65,26,
"White people",5,60,33,
"Men",8,55,36,
"The military",21,57,21,
"Evangelical Christians",14,48,36,
"<span style='color:white'>Dummy1</span>", 0, 0, 0,
"Older people",37,28,33,
"Younger people",39,27,33,
"Children",41,22,36,
"Asian people",46,14,39,
"<span style='color:white'>Dummy2</span>", 0, 0, 0,
"Women",51,19,29,
"Poor people",56,23,20,
"Unions",50,16,32,
"Black people",53,16,31,
"Hispanic people",62,14,24,
"Gay and lesbian people",76,4,19,
"Transgender people",84,3,12,
"<span style='color:white'>Dummy3</span>", 0, 0, 0,
"People like yourself",41,21,37) %>%
mutate(category = factor(category, levels = rev(category)))
offset <- 5
right <- data %>%
select(category, none) %>%
mutate(xmin = max(data$gain) + offset,
xmax = xmin + none,
x = (xmin + xmax) / 2)
data %>%
select(-none) %>%
mutate(lose = -lose) %>%
pivot_longer(-category, names_to = "effect", values_to = "percent") %>%
mutate(x_label = case_when(category == "White people" & effect == "lose" ~ -10,
category == "Men" & effect == "lose" ~ -13,
category == "Gay and lesbian people" & effect == "gain" ~ 9,
category == "Transgender people" & effect == "gain" ~ 7,
TRUE ~ percent / 2)
) %>%
ggplot(aes(x = percent, y = category, fill = effect, label = get_label(percent))) +
geom_col(width = 0.7) +
geom_text(aes(x = x_label), family = "franklin",
size = 10, size.unit = "pt") +
geom_crossbar(data = right,
mapping = aes(x = x, xmin = xmin, xmax = xmax, y = category,
fill = "none"),
inherit.aes = FALSE, width = 0.7,
color = NA) +
geom_text(data = right, family = "franklin",
mapping = aes(x = x, y = category, label = get_label(none)),
inherit.aes = FALSE,
size = 10, size.unit = "pt") +
geom_vline(xintercept = 0, color = "#858686") +
annotate(geom = "segment",
x = -180, xend = 118,
y = c(1.7, 9.7, 14.7),
color = "#858686",
linetype = c("solid", "11", "11")) +
annotate(geom = "text",
x = c(-23, 35, 95),
y = 22.3,
label = c("Lose\ninfluence", "Gain\ninfluence", "Not be\naffected"),
fontface = "bold", family = "franklin", lineheight = 1,
size = 9, size.unit = "pt") +
scale_fill_manual(
breaks = c("lose", "gain", "none"),
values = c("#E3CA82", "#CFA72F", "#C1BB9D")
) +
coord_cartesian(clip = "off", xlim = c(-90, 115), ylim = c(1.1, 21)) +
labs(
title = "Which groups do Americans expect to gain influence<br>— and lose it — in Trump's second term?",
subtitle = "% of U.S. adults who say each group will ____ in Washington with Donald<br>Trump taking office",
caption = "Note: No answer responses are not shown.<br>Source: Survey of U.S. adults conducted Jan. 27-Feb. 2, 2025.<br>**<span style='color:black'>PEW RESEARCH CENTER</span>**"
) +
theme(
text = element_text(family = "franklin"),
legend.position = "none",
axis.text.y = element_markdown(color = "black"),
axis.text.x = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank(),
panel.background = element_blank(),
plot.title.position = "plot",
plot.title = element_markdown(face = "bold", lineheight = 1.3),
plot.subtitle = element_markdown(family = "gelasio", face = "italic",
size = 10, lineheight = 1.4,
color = "gray40",
margin = margin(t = 4, b = 34)),
plot.caption.position = "plot",
plot.caption = element_markdown(hjust = 0, color = "gray40",
size = 8.5, lineheight = 1.5),
plot.margin = margin(t = 15, l = 2, b = 20)
)
ggsave("gainers_losers.png", width = 5, height = 7.4)