Skip to content

Instantly share code, notes, and snippets.

@dickoa
Created February 24, 2023 23:06
Show Gist options
  • Save dickoa/d12422eda155a2d2066f767c53106918 to your computer and use it in GitHub Desktop.
Save dickoa/d12422eda155a2d2066f767c53106918 to your computer and use it in GitHub Desktop.
Reproduce (kind of) PBS poll charts with MoE
library(tidyverse)
library(ggpattern)
library(ggtext)
## https://www.pbs.org/newshour/politics/most-americans-want-congress-to-compromise-as-debt-ceiling-looms
## Great chart by Megan McGrew
col <- c("#2aa7ff", "#f93037", "#a44bd2", "#c0c1c0")
bg_col <- "#ecedec"
df <- tibble(party = rep(c("THE DEMOCRATIC PARTY",
"THE REPUBLICAN PARTY",
"BOTH ABOUT THE SAME"), 2),
group = rep(c("A", "B"), each = 3),
order = rep(c(3, 2, 1), 2),
n = c(29, 24, 40, 100 - 29, 100 - 24, 100 - 40)) |>
mutate(party_group = if_else(group %in% "A", paste0(group, "-", party), group))
label_df <- tibble(label = c("29%", "24%", "40%"),
n1 = c(.29, .24, .40),
n2 = 0.2,
party_group = c("A-THE DEMOCRATIC PARTY",
"A-THE REPUBLICAN PARTY",
"A-BOTH ABOUT THE SAME"),
party = c("THE DEMOCRATIC PARTY",
"THE REPUBLICAN PARTY",
"BOTH ABOUT THE SAME"))
moe_df <- tibble(xmin = c(.29, .24, .40) - 0.033,
xmax = c(.29, .24, .40) + 0.033,
ymin = c(2.8, 1.8, 0.8),
ymax = c(3.2, 2.2, 1.2),
party_group = c("A-THE DEMOCRATIC PARTY",
"A-THE REPUBLICAN PARTY",
"A-BOTH ABOUT THE SAME"))
col <- setNames(col, c("A-THE DEMOCRATIC PARTY",
"A-THE REPUBLICAN PARTY",
"A-BOTH ABOUT THE SAME",
"B"))
ggplot(df) +
geom_col(aes(n, reorder(party, order),
fill = party_group),
position = position_fill(reverse = TRUE),
width = 0.4) +
geom_text(data = label_df,
nudge_x = -0.1,
aes(n1, party, label = label),
color = "#FFFFFF",
fontface = "bold",
size = 7) +
geom_text(data = label_df,
nudge_y = 0.35,
aes(n2, party, label = party),
color = "#49586b",
fontface = "bold",
size = 7) +
geom_rect_pattern(data = moe_df,
aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax,
fill = party_group),
pattern = "stripe",
pattern_density = 0.3,
pattern_alpha = 0.5,
pattern_fill = "#FFFFFF",
pattern_color = NA,
pattern_angle = 45,
pattern_frequency = 0.1,
pattern_size = 0,
pattern_spacing = 0.03,
pattern_orientation = 'radial',
color = NA,
alpha = 0.4) +
geom_segment(aes(x = 0.257, xend = 0.323, y = 2.7, yend = 2.7),
color = "#49586b") +
geom_segment(aes(x = 0.257, xend = 0.257, y = 2.7, yend = 2.75),
color = "#49586b") +
geom_segment(aes(x = 0.323, xend = 0.323, y = 2.7, yend = 2.75),
color = "#49586b") +
geom_segment(aes(x = 0.29, xend = 0.29, y = 2.7, yend = 2.6),
color = "#49586b") +
geom_segment(aes(x = 0.29, xend = 0.42, y = 2.6, yend = 2.6),
color = "#49586b") +
geom_text(data = tibble(label = c("Margin of Error:", "±3.3 percentage points"),
x1 = c(0.51, 0.54),
y1 = c(2.64, 2.54)),
aes(x = x1, y = y1, label = label),
fontface = "bold",
color = "#49586b") +
labs(title = paste0("<span style = 'color:#f93037'>Poll:</span> Which party do you think is most",
"<br>",
"responsible for the current level of national debt?")) +
scale_fill_manual(values = col) +
theme_void() +
theme(legend.position = "none",
plot.title = element_markdown(face = "bold", size = 24,
color = "#49586b"),
panel.background = element_rect(fill = bg_col, color = NA),
plot.background = element_rect(fill = bg_col))
ggsave("./chart_moe.png",
width = 9.5,
height = 6,
bg = bg_col)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment