R Gallery
L.J Zigerell
2026-08-11
This page contains code for R plots made using ggplot from the tidyverse package. The code often isn’t intended to be ideal, but to instead include more code than needed, because it’s easier to delete code than to add code. A thorough list to theme elements is available here.
Saving plots
You can add at the end of the code a ggsave command to save to your working directory, such as…
ggsave("plot1.svg", width = 10, height = 5)…or you can add the directory to the command, such as…
ggsave("G:/data/plot1.svg", width = 10, height = 5)The command getwd() will return the working directory, and the command setwd() can be used to set the working directory.
Sample theme
theme.z <- theme( axis.text.x.bottom = element_text(size = 15, color = "black", hjust = 0.5, vjust = 1 , margin = margin(t = 5, r = 5, b = 5, l = 5)), axis.text.x.top = element_text(size = 15, color = "black", hjust = 0.5, vjust = 0 , margin = margin(t = 5, r = 5, b = 5, l = 5)), axis.text.y.left = element_text(size = 15, color = "black", hjust = 1 , vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5)), axis.text.y.right = element_text(size = 15, color = "black", hjust = 0 , vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5)), axis.ticks.x = element_blank(), axis.ticks.y = element_blank(), axis.title.x = element_text(size = 15, color = "black", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5)), axis.title.y = element_text(size = 15, color = "black", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5)), axis.title.y.right = element_text(size = 15, color = "black", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5), angle = 0), legend.position = "none", panel.background = element_rect(linewidth = 0.5, color = "black", linetype = "solid", fill = "gray90"), panel.border = element_rect(linewidth = 1.0, color = "black", linetype = "solid", fill = NA), panel.grid.major.x = element_blank(), panel.grid.major.y = element_blank(), panel.grid.minor.x = element_blank(), panel.grid.minor.y = element_blank(), panel.spacing.x = unit(1, "lines"), panel.spacing.y = unit(1, "lines"), plot.background = element_rect(fill = "white"), plot.caption = element_text(size = 12, color = "black", hjust = 0, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5)), plot.margin = unit(c(t = 10, r = 10, b = 10, l = 10), "pt"), plot.subtitle = element_text(size = 15, color = "black", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5)), plot.title = element_text(size = 20, color = "black", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5), face = "bold"), strip.background = element_rect(linewidth = 1, color = "black", linetype = "solid", fill = "black"), strip.text.x = element_text(size = 18, color = "white", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5), face = "bold"), strip.text.y = element_text(size = 18, color = "white", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5), face = "bold") )
Regression plot: Categorical
Code
This next plot is a regression-type plot in which the analysis does not assume a constant association between the predictor and the outcome net of controls. The data for this plot are loaded using a tribble command. But, as used in some plots below, data can be loaded from an external file.
library(tidyverse)
DATA <- tribble(
~X, ~PE , ~CILO, ~CIHI, ~N,
0, 32.4, 26.5, 38.3, 297,
1, 41.4, 33.0, 49.9, 103,
2, 38.6, 29.2, 48.0, 97,
3, 45.8, 37.2, 54.4, 107,
4, 44.8, 37.0, 52.6, 236,
5, 57.3, 45.0, 69.5, 144,
6, 70.6, 55.0, 86.3, 129,
7, 58.0, 49.8, 66.1, 113,
8, 56.8, 47.7, 65.8, 163,
9, 70.6, 62.0, 79.2, 102,
10, 73.9, 66.8, 81.0, 145,
11, 72.0, 58.8, 85.3, 96,
12, 74.4, 64.4, 84.5, 78,
13, 75.9, 63.1, 88.8, 32,
14, 63.2, 40.3, 86.2, 18,
15, 55.1, 16.4, 94.0, 12,
16, 77.8, 46.7, 95.0, 18)
theme.z <- theme(
axis.text.x = element_text(size = 15, color = "black", hjust = 0.5, margin = margin(t = 8, b = 8)),
axis.text.y = element_text(size = 15, color = "black", vjust = 0.5, margin = margin(r = 7, l = 7)),
axis.text.y.right = element_text(size = 15, color = "black", vjust = 0.5, margin = margin(r = 7, l = 7)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(size = 15, color = "black", hjust = 0.5, margin = margin(t = 8, b = 8)),
axis.title.y = element_blank(),
axis.title.y.right = element_blank(),
panel.background = element_rect(linewidth = 0.5, fill = "gray90"),
panel.border = element_rect(linewidth = 1.0, fill = NA ),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12, hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 10, r = 10, b = 10, l = 10),"pt"),
plot.subtitle = element_text(size = 15, hjust = 0.5, margin = margin(t = 0, b = 8)),
plot.title = element_text(size = 20, hjust = 0.5, margin = margin(t = 0, b = 16), face = "bold")
)
CAPTION <- str_wrap(width = 95, "Data source: XXX\nError bars indicate 95% confidence intervals.\nNumbers on the inside bottom (e.g., 297) are sample sizes for that level of the predictor.")
ggplot(data = DATA, mapping = aes(x = X, y = PE)) +
geom_rect(data = DATA, mapping = aes(xmin = -Inf, xmax = Inf, ymin = min(PE), ymax = max(PE)), fill = "lightsteelblue3", col = "black") +
geom_errorbar(mapping = aes(ymin = CILO, ymax = CIHI), width = 0, linewidth = 0.75) +
geom_point(size = 3.5) +
geom_text(x = DATA$X, y = 5, vjust = 0, label = DATA$N, size = 5) +
scale_x_continuous(limits = c(0,16), breaks = seq(0,16,1)) +
scale_y_continuous(limits = c(0,100), breaks = seq(0,100,10), labels = seq(0,100,10), expand = c(0,0), sec.axis = dup_axis()) +
labs(title = "Predicted outcome", x = "x variable", caption = CAPTION) +
theme.zFigure
Estimates plot: Estimates on the right
Code
library(tidyverse)
DATA <- tribble(
~RESPONSE , ~PE , ~CILO , ~CIHI ,
"Cold to Whites but not Blacks" , 0.7733116, 0.7254376, 0.8211857,
"Residual colder to Whites than Blacks", 0.5888966, 0.5624021, 0.615391 ,
"Rated Whites equal to Blacks" , 0.3925516, 0.3580722, 0.427031 ,
"Did not rate Whites and/or Blacks" , 0.3239428, 0.2534674, 0.3944182,
"Residual colder to Blacks than Whites", 0.238854 , 0.2193636, 0.2583444,
"Cold to Blacks but not Whites" , 0.1205505, 0.0998559, 0.1412452)
DATA$RESPONSE <- factor(DATA$RESPONSE, levels = unique(DATA$RESPONSE))
theme.z <- theme(
axis.text.x = element_blank(),
axis.text.x.top = element_text(size = 15, color = "black", hjust = 1 , margin = margin(t = 8,b = 8)),
axis.text.y = element_text(size = 15, color = "black", hjust = 1 , margin = margin(l = 8,r = 8)),
axis.text.y.right = element_blank(),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.background = element_rect(linewidth = 0.5, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA , linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.spacing.x = unit(2, "lines"),
panel.spacing.y = unit(1, "lines"),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12 , hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 10,r = 10,b = 10,l = 10),"pt"),
plot.subtitle = element_text(size = 15 , hjust = 0.5, margin = margin(b = 10)),
plot.title = element_text(size = 20 , hjust = 0.5, margin = margin(t = 0,b = 8), face = "bold")
)
CAPTION <- str_wrap(width = 50, "Note: Predicted probabilities, with the outcome coded 1 for\nstrongly approve and somewhat approve and 0 for\nsomewhat disapprove, strongly disapprove, don't know,\nand skipped. Controls only for participant race. Error bars are\n83.4% confidence intervals. Data source: 2017/8 waves of the\nDemocracy Fund Voter Study Group. 2021.\nViews of the Electorate Research Survey. Washington, D.C.\nhttps://www.voterstudygroup.org/.")
ggplot(DATA, mapping = aes(x = PE, y = RESPONSE)) +
geom_rect(xmin = DATA$CILO[DATA$RESPONSE == "Rated Whites equal to Blacks"], xmax = DATA$CIHI[DATA$RESPONSE == "Rated Whites equal to Blacks"], ymin = -Inf, ymax = Inf, fill = "slategray3", color = NA) +
geom_errorbarh(mapping = aes(xmin = CILO, xmax = CIHI), width = 0) +
geom_point(color = "black", size = 3.5) +
scale_x_continuous(limits = c(0,1), breaks = seq(0,1,by = 0.2), expand = c(0,0)) +
geom_text(x = 0.975, y = DATA$RESPONSE, size = 5, hjust = 1, label = format(round(DATA$PE, 2), nsmall = 2)) +
labs(title = "Approve of anthem protests", caption = CAPTION) +
theme.zFigure
Estimates plot: Facet shading
Code
This next plot plots data across multiple facets. The lines with “filter” are used to make sure that particular elements appear only in certain facets.
Lines in the section that start with “DATA$max” or “DATA$min” are intended to reduce the length of later lines of code.
library(tidyverse)
DATA <- tribble(
~RESPONDENTS , ~TARGET , ~PE, ~CILO, ~CIHI,
"White respondents" , "Mean ratings of Whites" , 71.03, 70.47, 71.59,
"White respondents" , "Mean ratings of Blacks" , 70.14, 69.57, 70.72,
"White respondents" , "Mean ratings of Hispanics", 70.49, 69.93, 71.04,
"White respondents" , "Mean ratings of Asians" , 70.24, 69.68, 70.8 ,
"Black respondents" , "Mean ratings of Whites" , 62.2 , 60.24, 64.17,
"Black respondents" , "Mean ratings of Blacks" , 85.36, 83.93, 86.79,
"Black respondents" , "Mean ratings of Hispanics", 71.07, 69.37, 72.78,
"Black respondents" , "Mean ratings of Asians" , 66.2 , 64.32, 68.07,
"Hispanic respondents", "Mean ratings of Whites" , 65.17, 63.46, 66.89,
"Hispanic respondents", "Mean ratings of Blacks" , 72.47, 70.95, 73.99,
"Hispanic respondents", "Mean ratings of Hispanics", 80.55, 79.04, 82.05,
"Hispanic respondents", "Mean ratings of Asians" , 72.3 , 70.77, 73.84,
"Asian respondents" , "Mean ratings of Whites" , 67.4 , 64.54, 70.27,
"Asian respondents" , "Mean ratings of Blacks" , 70.54, 68.01, 73.07,
"Asian respondents" , "Mean ratings of Hispanics", 69.68, 67.16, 72.21,
"Asian respondents" , "Mean ratings of Asians" , 80.28, 78.1 , 82.46)
DATA$RESPONDENTS <- factor(DATA$RESPONDENTS, levels = unique(DATA$RESPONDENTS))
DATA$TARGET <- factor(DATA$TARGET , levels = rev(unique(DATA$TARGET)))
DATA$max.w <- max(DATA$PE[DATA$RESPONDENTS == "White respondents"] , na.rm = TRUE)
DATA$min.w <- min(DATA$PE[DATA$RESPONDENTS == "White respondents"] , na.rm = TRUE)
DATA$max.b <- max(DATA$PE[DATA$RESPONDENTS == "Black respondents"] , na.rm = TRUE)
DATA$min.b <- min(DATA$PE[DATA$RESPONDENTS == "Black respondents"] , na.rm = TRUE)
DATA$max.h <- max(DATA$PE[DATA$RESPONDENTS == "Hispanic respondents"], na.rm = TRUE)
DATA$min.h <- min(DATA$PE[DATA$RESPONDENTS == "Hispanic respondents"], na.rm = TRUE)
DATA$max.a <- max(DATA$PE[DATA$RESPONDENTS == "Asian respondents"] , na.rm = TRUE)
DATA$min.a <- min(DATA$PE[DATA$RESPONDENTS == "Asian respondents"] , na.rm = TRUE)
CAPTION <- str_wrap(width = 92, "Note: Error bars are 83.4% confidence intervals. Data source: American National Election Studies. 2021. ANES 2020 Time Series Study Preliminary Release: Combined Pre-Election and Post-Election Data [dataset and documentation]. March 24, 2021 version. www.electionstudies.org.")
theme.z <- theme(
axis.text.x = element_text(size = 15, color = "black", margin = margin(t = 8,b = 8)),
axis.text.y = element_text(size = 15, color = "black", margin = margin(l = 8,r = 8)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.background = element_rect(linewidth = 0.5, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA , linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.spacing.x = unit(2, "lines"),
panel.spacing.y = unit(1, "lines"),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 10, hjust = 0, margin = margin(t = 8)),
plot.margin = unit(c(0.5,0.5,0.5,0.5),"cm"),
plot.subtitle = element_text(size = 15, hjust = 0.5, margin = margin(b = 7)),
plot.title = element_text(size = 20, hjust = 0.5, face = "bold", margin = margin(t = 0,b = 12)),
strip.background = element_rect(linewidth = 1, color = "black", fill = "black"),
strip.text.x = element_text(size = 17, color = "white", face = "bold", margin = margin(t = 7.5,b = 7.5))
)
ggplot(data = DATA, mapping = aes(x = PE, y = TARGET)) +
facet_wrap(~RESPONDENTS, nrow = 2, dir = "v") +
geom_rect(data = filter(DATA, RESPONDENTS == "White respondents") ,
mapping = aes(xmin = min.w, xmax = max.w, ymin = -Inf, ymax = Inf), fill = "lightsteelblue3", color = "black", inherit.aes = FALSE) +
geom_rect(data = filter(DATA, RESPONDENTS == "Black respondents") ,
mapping = aes(xmin = min.b, xmax = max.b, ymin = -Inf, ymax = Inf), fill = "lightsteelblue3", color = "black", inherit.aes = FALSE) +
geom_rect(data = filter(DATA, RESPONDENTS == "Hispanic respondents"),
mapping = aes(xmin = min.h, xmax = max.h, ymin = -Inf, ymax = Inf), fill = "lightsteelblue3", color = "black", inherit.aes = FALSE) +
geom_rect(data = filter(DATA, RESPONDENTS == "Asian respondents") ,
mapping = aes(xmin = min.a, xmax = max.a, ymin = -Inf, ymax = Inf), fill = "lightsteelblue3", color = "black", inherit.aes = FALSE) +
geom_point(size = 3.5) +
geom_errorbarh(mapping = aes(xmin = CILO, xmax = CIHI), width = 0, linewidth = 0.75) +
scale_x_continuous(breaks = seq(0,100,25), limits = c(0,100), labels = scales::number_format(accuracy = 1)) +
labs(title = "How racial groups rate each other", caption = CAPTION) +
theme.zFigure
Estimates plot: 83.4% and 95% confidence intervals {#Estimates-83.4%-95%
Code
library(tidyverse)
DATA <- tribble(
~GROUP ,~PE,~CILO83,~CIHI83,~CILO95,~CIHI95,
"Racial resentment of 0 on 0-to-12 index (N = 66)" ,-0.2922794,-0.448513,-0.1360458,-0.515034,-0.0695248,
"Racial resentment of 0 or 1 on a 0-to-12 index (N = 107)" ,-0.2216749,-0.3462494,-0.0971004,-0.3987587,-0.0445911,
"Racial resentment of less than 6 on a 0-to-12 index (N = 298)" ,-0.243315,-0.3211188,-0.1655112,-0.3535838,-0.1330462,
"At least 1 negative stereotype of Whites compared to Blacks (N = 165)",-0.1875,-0.2945985,-0.0804015,-0.3394902,-0.0355098,
"At least 2 negative stereotypes of Whites compared to Blacks (N = 87)",-0.3123679,-0.4537431,-0.1709926,-0.5135549,-0.1111809,
"Three negative stereotypes of Whites compared to Blacks (N = 43)" ,-0.3549784,-0.552015,-0.1579417,-0.6371384,-0.0728183,
"Rated Whites < 50 on 0-to-100 thermo but Blacks 50 or above (N = 39)" ,-0.4603175,-0.6502958,-0.2703391,-0.732731,-0.1879039,
"Rated Whites lower than Blacks on 0-to-100 thermo (N = 205)" ,-0.2152381,-0.3090966,-0.1213796,-0.3483605,-0.0821157)
DATA$GROUP <- factor(DATA$GROUP, levels = DATA$GROUP)
theme.z <- theme(
plot.background = element_rect(fill = "white"),
strip.background = element_rect(linewidth = 1, color = "black", fill = "black"),
strip.text.x = element_text(color = "white", face = "bold", size = 15, margin = margin(t = 7.5, b = 7.5)),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.background = element_rect(fill = "gray90", color = "black", linewidth = 0.5, linetype = "solid"),
panel.border = element_rect(fill = NA, color = "black", linetype = "solid", linewidth = 1.0),
panel.spacing.x = unit(1, "lines"),
panel.spacing.y = unit(1, "lines"),
axis.title.y = element_blank(),
axis.title.x = element_text(size = 12, color = "black"),
axis.ticks.y = element_blank(),
axis.ticks.x = element_blank(),
axis.text.x = element_text(size = 12, color = "black", vjust = -1),
axis.text.y = element_text(size = 12, color = "black", margin = margin(r = 10)),
plot.margin = unit(c(0.5,0.5,0.5,0.5),"cm"),
plot.title = element_text(face = "bold", margin = margin(t = 0, b = 13), size = 15, hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5, size = 12),
plot.caption = element_text(hjust = 0, size = 9)
)
CAPTION <- str_wrap(width = 80, "Thick error bars are 83.4% confidence intervals. Thin error bars are 95% confidence\nintervals. Estimates are from unweighted analyses, indicating percentage point\ndifferences in rating the Black target guilty relative to the White target. Total\nN is 649 Whites with responses for the 'guilty' item. Data source: Rice et al. 2021")
ggplot(DATA, mapping = aes(100*PE, GROUP)) +
geom_rect(mapping = aes(xmin = 0, xmax = Inf, ymin = -Inf, ymax = Inf), linewidth = 1, color = "black", fill = "slategray3") +
geom_errorbarh(mapping = aes(xmin = 100*CILO95, xmax = 100*CIHI95), width = 0, linewidth = 0.5, color = "gray60") +
geom_errorbarh(mapping = aes(xmin = 100*CILO83, xmax = 100*CIHI83), width = 0, linewidth = 1.5) +
geom_point(shape = 21, color = "black", fill = "slategray3", size = 4, stroke = 2) +
scale_x_continuous(name = "", breaks = seq(-80,20,20), limits = c(-80,20), labels = scales::number_format(accuracy = 1)) +
geom_text(mapping = aes(x = 20, label = scales::percent(PE, accuracy = 1L)), position = position_dodge(width = 0.7), hjust = 1, size = 4.5) +
labs(title = "Pro-Black Mock Juror Bias, among Whites", caption = CAPTION) +
theme.zFigure
Estimates plot: Comparison with shaded error bars
Code
library(tidyverse)
DATA <- tribble(
~GROUP , ~RESPONSE , ~PE , ~CILO , ~CIHI ,
"Population A", "Response 1", 0.2487805, 0.2316981, 0.2666853,
"Population A", "Response 2", 0.3466610, 0.3276461, 0.3661784,
"Population B", "Response 1", 0.3337802, 0.3079924, 0.3606019,
"Population B", "Response 2", 0.3705482, 0.3441236, 0.3977713,
"Population C", "Response 1", 0.1463591, 0.1274313, 0.1675585,
"Population C", "Response 2", 0.3190987, 0.2921480, 0.3473157,
"Population D", "Response 1", 0.2456283, 0.2256315, 0.2667868,
"Population D", "Response 2", 0.3202551, 0.2983380, 0.3429953,
"Population E", "Response 1", 0.1215903, 0.0810799, 0.1784114,
"Population E", "Response 2", 0.3515452, 0.2775312, 0.4334554,
"Population F", "Response 1", 0.3167555, 0.2472624, 0.3955174,
"Population F", "Response 2", 0.2819693, 0.2294461, 0.341192,
"Population G", "Response 1", 0.2613607, 0.2113523, 0.3184242,
"Population G", "Response 2", 0.4241733, 0.3645215, 0.4861194)
DATA$RESPONSE <- factor(DATA$RESPONSE, levels = rev(unique(DATA$RESPONSE)))
DATA$GROUP <- factor(DATA$GROUP , levels = rev(unique(DATA$GROUP)))
STR <- str_wrap(width = 75, "Note about the plot. Data source: American National Election Studies. 2022. ANES 2022 Pilot Study [dataset and documentation]. December 14, 2022 version. www.electionstudies.org.")
theme.z <- theme(
axis.text.x = element_text(color = "black", size = 15, margin = margin(t = 8, b = 8)),
axis.text.y = element_text(color = "black", size = 15, margin = margin(r = 8, l = 8)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.background = element_rect(fill = "gray90"),
legend.box.background = element_rect(color = "black", linewidth = 1.5),
legend.key = element_rect(fill = "gray90"),
legend.justification = c("right", "top"),
legend.margin = margin(15,15,15,15),
legend.position = c(0.95,0.9),
legend.spacing.x = unit(10, "pt"),
legend.spacing.y = unit(10, "pt"),
legend.text = element_text(size = 15, margin = margin(t = 0)),
legend.title = element_text(size = 15, face = "bold"),
panel.background = element_rect(fill = "gray90"),
panel.border = element_rect(fill = NA, color = "black", linetype = "solid", linewidth = 1.0),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.caption = element_text(size = 11, hjust = 0, margin = margin(15,0,0,0)),
plot.subtitle = element_text(hjust = 0.5),
plot.margin = unit(c(t = 15,r = 25,b = 15,l = 15),"pt"),
plot.title = element_text(face = "bold", margin = margin(t = 0, b = 6), size = 20, hjust = 0.5)
)
ggplot(DATA, mapping = aes(color = RESPONSE, x = 100*PE, y = GROUP)) +
geom_errorbarh(mapping = aes(xmin = 0 , xmax = 100) , width = 0, linewidth = 10, color = "gray80" , alpha = 0.5) +
geom_errorbarh(mapping = aes(xmin = 100*(CILO), xmax = 100*(CIHI)), width = 0, linewidth = 10, color = "steelblue", alpha = 0.5) +
geom_point(size = 3, shape = 19) +
scale_color_manual(values = c("Response 2" = "black","Response 1" = "white")) +
scale_x_continuous(limits = c(0,100), breaks = seq(0,100,by = 10), expand = c(0,0)) +
labs(title = "Title for the plot", caption = STR) +
theme.zFigure
Column plot
Code
This first plot is a column plot from a draft figure from Zigerell 2022 “Introducing Political Science Students to Data Visualization Strategies” in the Journal of Political Science Education.
library(tidyverse)
DATA <- tribble(
~PID , ~PE , ~CILO , ~CIHI ,
"Strong\nDemocrat" , 0.4445886, 0.4089648, 0.4802125,
"Not strong\nDemocrat" , 0.2726622, 0.2290617, 0.3162628,
"Independent\nDemocrat" , 0.2509012, 0.218784 , 0.2830185,
"Independent" , 0.2135729, 0.1755062, 0.2516396,
"Independent\nRepublican", 0.2633814, 0.218896 , 0.3078668,
"Not strong\nRepublican" , 0.2074255, 0.1671848, 0.2476663,
"Strong\nRepublican" , 0.3374613, 0.308117 , 0.3668057)
DATA$PID <- factor(DATA$PID, levels = DATA$PID)
CAPTION <- str_wrap(width = 125, "Note: Error bars are 83.4% confidence intervals. Estimates are from a logit regression, with weights applied and with categorical controls for gender, race, age group, education, marital status, household income, and gun ownership set at their means. Data source: American National Election Studies 2020 Time Series Study (2021).")
TITLE <- c("Predicted probability of responding\n\"extremely important\" about how important\nthe respondent considers the issue of the federal gun laws")
theme.z <- theme(
axis.text.x = element_text(size = 15, color = "black", hjust = 0.5, margin = margin(t = 8,b = 8)),
axis.text.y = element_blank(),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.background = element_rect(linewidth = 0.5, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA , linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12 , hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 10,r = 10,b = 10,l = 10),"pt"),
plot.subtitle = element_text(size = 15 , hjust = 0.5, margin = margin(b = 10)),
plot.title = element_text(size = 20 , hjust = 0.5, margin = margin(t = 0,b = 15), face = "bold")
)
ggplot(data = DATA, mapping = aes(x = PID, y = PE)) +
geom_col(color = "black", fill = c(rep_len("blue3",2), rep_len("gray50",3), rep_len("red3",2)),
linewidth = 1.1, width = 0.8) +
geom_text(mapping = aes(y = CIHI, label = scales::percent(PE, accuracy = 1L)), size = 5, hjust = 0.5, vjust = -1) +
geom_errorbar(mapping = aes(ymin = CILO, ymax = CIHI), linewidth = 0.75, width = 0.25) +
scale_x_discrete() +
scale_y_continuous(expand = c(0,0), limits = c(0,1), sec.axis = (dup_axis())) +
labs(title = TITLE, y = "Probability", caption = CAPTION) +
theme.zFigure
Column plot: Stacked with confidence intervals
Code
library(tidyverse)
DATA <- tribble(
~RESPONSE, ~GROUP,~PE,~CILO,~CIHI,~CILO.STACK,~CIHI.STACK,
"Rated only men cold","Strong feminist",0.2244495,0.1734468,0.2852736,0.1734468,0.2852736,
"Rated only men cold","Feminist",0.1369234,0.1121956,0.1660818,0.1121956,0.1660818,
"Rated only men cold","Not a feminist",0.0818824,0.0684379,0.0976912,0.0684379,0.0976912,
"Rated only men cold","Anti-feminist",0.1230189,0.0776477,0.189456,0.0776477,0.189456,
"Residual colder to men","Strong feminist",0.4957903,0.4315959,0.5601238,0.6560454,0.7845733,
"Residual colder to men","Feminist",0.548797,0.5072817,0.5896439,0.6442051,0.7265673,
"Residual colder to men","Not a feminist",0.4317206,0.4061719,0.4576378,0.4880543,0.5395202,
"Residual colder to men","Anti-feminist",0.2593538,0.1988233,0.3307057,0.3218422,0.4537246,
"Rated men equal to women","Strong feminist",0.1141982,0.0770669,0.1660018,0.7973067,0.8862416,
"Rated men equal to women","Feminist",0.1583753,0.1292627,0.1925943,0.8149831,0.8783147,
"Rated men equal to women","Not a feminist",0.2650397,0.2426491,0.2887089,0.7562521,0.8023119,
"Rated men equal to women","Anti-feminist",0.2801124,0.2121814,0.3598575,0.5945541,0.7422302,
"Residual colder to women","Strong feminist",0.1357016,0.0968408,0.186929,0.9312788,1.021367,
"Residual colder to women","Feminist",0.1267096,0.099491,0.1600512,0.9435867,1.0041469,
"Residual colder to women","Not a feminist",0.1944195,0.1744745,0.2160478,0.9531172,0.9946905,
"Residual colder to women","Anti-feminist",0.2635357,0.200313,0.338272,0.8627981,1.0007571,
"Rated only women cold","Strong feminist",0.0247997,0.0091943,0.0651505,0.9793339,1.0352901,
"Rated only women cold","Feminist",0.0291947,0.0176643,0.0478848,0.9884696,1.0186901,
"Rated only women cold","Not a feminist",0.0269377,0.0196127,0.0368957,0.9926749,1.0099579,
"Rated only women cold","Anti-feminist",0.0739792,0.0371087,0.142078,0.9631295,1.0680988)
DATA$RESPONSE <- factor(DATA$RESPONSE, levels = rev(unique(DATA$RESPONSE)))
DATA$GROUP <- factor(DATA$GROUP , levels = unique(DATA$GROUP[1:5]))
theme.z <- theme(
axis.text.x = element_text(color = "black", size = 15, margin = margin(t = 0)),
axis.text.y = element_text(color = "black", size = 15, margin = margin(r = 0)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.position = "none",
legend.spacing.x = unit(10, "pt"),
legend.spacing.y = unit(10, "pt"),
legend.text = element_text(size = 15, margin = margin(t = 5)),
legend.title = element_text(size = 15, face = "bold"),
panel.background = element_rect(fill = "white"),
panel.border = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.caption = element_text(size = 11, hjust = 0, margin = margin(15,0,0,0)),
plot.subtitle = element_text(hjust = 0.5),
plot.margin = unit(c(t = 15,r = 210,b = 15,l = 15),"pt"),
plot.title = element_text(face = "bold", margin = margin(t = 0, b = 6), size = 20, hjust = 0.5)
)
CAPTION <- str_wrap(width = 100, "Note: Cold refers to a rating under 50. Colder refers to a lower rating. Estimates are weighted. Sample size 1,498 U.S. adults, 147 strong feminists, 366 feminists,\n889 non-feminists, and 96 anti-feminists, with 2 non-responses for the feminist item and 1 non-response for the feeling thermometer items.\n83.4% confidence intervals are for the uncertainty about the indicated category (e.g., Rated men equal to women, among non-feminists).\nData source: American National Election Studies. 2022. ANES 2022 Pilot Study [dataset and documentation]. December 14, 2022 version. www.electionstudies.org.")
ggplot(DATA, mapping = aes(fill = RESPONSE, y = 100*PE, x = GROUP)) +
geom_col(color = "black", linewidth = 1.1, width = 0.85) +
scale_fill_manual(values = rev(c("Rated only men cold" = "steelblue1","Residual colder to men" = "powderblue","Rated men equal to women" = "white","Residual colder to women" = "lightpink1","Rated only women cold" = "deeppink1")), name = "Category") +
scale_y_continuous(limits = c(0,107), breaks = seq(0,100,by = 10)) +
scale_x_discrete(limits = c("Strong feminist","Feminist","Not a feminist","Anti-feminist")) +
labs(title = "Ratings about men and about women\non 0-to-100 feeling thermometers", caption = CAPTION) +
coord_cartesian(clip = "off") +
geom_errorbar(mapping = aes(ymin = 100*(CILO.STACK), ymax = 100*(CIHI.STACK)), width = 0.5, linewidth = 0.75, position = position_dodge(c(0.75))) +
annotate("text",x = 4.65,y = 96,size = 5.5,hjust = 0,label = "Rated only women cold") +
annotate("text",x = 4.65,y = 79,size = 5.5,hjust = 0,label = "Residual colder to women") +
annotate("text",x = 4.65,y = 52,size = 5.5,hjust = 0,label = "Rated men equal to women") +
annotate("text",x = 4.65,y = 25,size = 5.5,hjust = 0,label = "Residual colder to men") +
annotate("text",x = 4.65,y = 6,size = 5.5,hjust = 0,label = "Rated only men cold") +
theme.zFigure
Regression plot: Categorical with facets and internal arrows
Code
This next plot illustrates why it’s not ideal for an analysis to assume a constant association between the predictor and the outcome net of controls. The plot also includes arrows to emphasize a point of the plot. This plot appeared in Zigerell 2022 “Introducing Political Science Students to Data Visualization Strategies” in the Journal of Political Science Education. Dataset for Figure 9.csv.
library(tidyverse)
DATA <- read_csv("Figure 9.csv")
print(DATA, n = Inf)## # A tibble: 36 × 5
## FACET LEVEL PE CILO CIHI
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Con Uniform 0 -0.172 -0.236 -0.107
## 2 Con Uniform 1 -0.137 -0.191 -0.0844
## 3 Con Uniform 2 -0.103 -0.146 -0.0605
## 4 Con Uniform 3 -0.0690 -0.103 -0.0352
## 5 Con Uniform 4 -0.0348 -0.0627 -0.00690
## 6 Con Uniform 5 -0.000583 -0.0275 0.0263
## 7 Con Uniform 6 0.0336 0.00237 0.0649
## 8 Con Uniform 7 0.0679 0.0285 0.107
## 9 Con Uniform 8 0.102 0.0528 0.151
## 10 Con Relaxed 0 -0.0414 -0.195 0.112
## 11 Con Relaxed 1 -0.0477 -0.156 0.0607
## 12 Con Relaxed 2 -0.175 -0.259 -0.0918
## 13 Con Relaxed 3 -0.112 -0.198 -0.0252
## 14 Con Relaxed 4 0.0803 0.0117 0.149
## 15 Con Relaxed 5 -0.104 -0.166 -0.0416
## 16 Con Relaxed 6 -0.130 -0.194 -0.0666
## 17 Con Relaxed 7 0.196 0.123 0.269
## 18 Con Relaxed 8 0.220 0.133 0.308
## 19 Lib Uniform 0 0.101 0.0395 0.162
## 20 Lib Uniform 1 0.0899 0.0394 0.140
## 21 Lib Uniform 2 0.0793 0.0385 0.120
## 22 Lib Uniform 3 0.0687 0.0362 0.101
## 23 Lib Uniform 4 0.0581 0.0311 0.0852
## 24 Lib Uniform 5 0.0476 0.0212 0.0739
## 25 Lib Uniform 6 0.0370 0.00641 0.0675
## 26 Lib Uniform 7 0.0264 -0.0118 0.0645
## 27 Lib Uniform 8 0.0158 -0.0318 0.0633
## 28 Lib Relaxed 0 0.0426 -0.0992 0.184
## 29 Lib Relaxed 1 0.218 0.112 0.324
## 30 Lib Relaxed 2 0.0411 -0.0413 0.124
## 31 Lib Relaxed 3 -0.0297 -0.104 0.0447
## 32 Lib Relaxed 4 0.0901 0.0238 0.156
## 33 Lib Relaxed 5 -0.00485 -0.0732 0.0635
## 34 Lib Relaxed 6 0.0708 0.00751 0.134
## 35 Lib Relaxed 7 0.0869 0.0144 0.159
## 36 Lib Relaxed 8 -0.0302 -0.109 0.0491DATA$FACET <- factor(DATA$FACET, levels = unique(DATA$FACET))
DATA$LEVEL <- factor(DATA$LEVEL, levels = 0:8)
ANNOTATE <- data.frame(FACET = c("Con Uniform","Con Relaxed","Lib Uniform","Lib Relaxed"),
label = c("p<0.05\nevidence\nof an effect","No p<0.05\nevidence\nof an effect",NA,NA))
ANNOTATE$FACET <- factor(ANNOTATE$FACET, levels = c("Con Uniform","Con Relaxed","Lib Uniform","Lib Relaxed"))
LABELS <- c("Con Uniform" = "Conservative Trump treatment\n\u2013 Uniform model \u2013", "Con Relaxed" = "Conservative Trump treatment\n\u2013 Non-uniform model \u2013", "Lib Uniform" = "Liberal Trump treatment\n\u2013 Uniform model \u2013", "Lib Relaxed" = "Liberal Trump treatment\n\u2013 Non-uniform model \u2013")
CAPTION <- str_wrap(width = 110, "Note: The figure reports point estimates and 95% confidence intervals from a linear regression predicting the estimated effect of a \"conservative Trump\" treatment (top panels) and a \"liberal Trump\" treatment (bottom panels) on participant responses about a policy (with a liberal response coded higher), at levels of political knowledge. Left panels depict results reported in Figure 2 of Barber and Pope (2019), which did not permit a non-uniform association. Right panels depict results that permitted a non-uniform association. Data source: Barber (2019). See Figure A14 of Barber and Pope (2019) for a plot of a different way to permit the treatment effect estimate to not be uniform.")
theme.z <- theme(
axis.text.x = element_text(size = 15, color = "black", hjust = c(0,1), margin = margin(t = 7,r = 0,b = 5,l = 0)),
axis.text.x.top = element_blank(),
axis.text.y = element_text(size = 15, color = "black", margin = margin(r = 7, l = 7)),
axis.text.y.right = element_text(size = 15, color = "black", margin = margin(r = 7, l = 7)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.position = "none",
panel.background = element_rect(linewidth = 1.0, color = "black", fill = "gray95", linetype = "solid"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA , linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.spacing.x = unit(1, "lines"),
panel.spacing.y = unit(1, "lines"),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12, hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 5,r = 5,b = 5,l = 5),"pt"),
plot.subtitle = element_text(size = 15, hjust = 0.5, margin = margin(b = 7)),
plot.title = element_text(size = 20, hjust = 0.5, face = "bold", margin = margin(t = 0,b = 12)),
strip.background = element_rect(linewidth = 1.0, color = "black", fill = "black"),
strip.text.x = element_text(size = 18, color = "white", face = "bold", margin = margin(t = 10,r = 10,b = 10,l = 10))
)
ggplot(data = DATA, mapping = aes(x = LEVEL, y = PE)) +
facet_wrap(vars(FACET), ncol = 2, dir = "h", labeller = as_labeller(LABELS)) +
geom_segment(x = -Inf, y = 0, xend = Inf, yend = 0, color = "gray80") +
geom_rect(xmin = -Inf, xmax = Inf, ymin = 0, ymax = Inf, fill = "gray80") +
geom_errorbar(mapping = aes(ymin = CILO, ymax = CIHI), linewidth = 1.25, width = 0) +
geom_point(data = filter(DATA, FACET == "Con Uniform" | FACET == "Con Relaxed"),
size = 4, shape = 21, stroke = 1.5, color = "black", fill = "red3") +
geom_point(data = filter(DATA, FACET == "Lib Uniform" | FACET == "Lib Relaxed"),
size = 4, shape = 21, stroke = 1.5, color = "black", fill = "blue3") +
geom_text(data = ANNOTATE, mapping = aes(x = 2.25, y = 0.3, label = label), size = 5, hjust = 0, lineheight = 0.9) +
geom_curve(data = filter(DATA, FACET == "Con Uniform"), mapping = aes(x = 2, y = 0.35, xend = 0.9, yend = -0.08),
arrow = arrow(length = unit(0.25, "cm")), size = 0.05, curvature = 0.45) +
geom_curve(data = filter(DATA, FACET == "Con Uniform"), mapping = aes(x = 2, y = 0.30, xend = 1.8, yend = -0.08),
arrow = arrow(length = unit(0.25, "cm")), size = 0.05, curvature = 0.50) +
geom_curve(data = filter(DATA, FACET == "Con Relaxed"), mapping = aes(x = 2, y = 0.35, xend = 1 , yend = 0.18),
arrow = arrow(length = unit(0.25, "cm")), size = 0.05, curvature = 0.40) +
geom_curve(data = filter(DATA, FACET == "Con Relaxed"), mapping = aes(x = 2, y = 0.30, xend = 1.8, yend = 0.10),
arrow = arrow(length = unit(0.25, "cm")), size = 0.05, curvature = 0.50) +
scale_x_discrete(breaks = c(0,8), labels = c("Lowest\nPolitical\nKnowledge", "Highest\nPolitical\nKnowledge")) +
scale_y_continuous(limits = c(-0.5,0.5), breaks = seq(-0.4,0.4,0.2), labels = seq(-0.4,0.4,0.2),
sec.axis = dup_axis()) +
labs(title = "Estimated effect of the...", caption = CAPTION) +
theme.zFigure
Regression plot: Uniform
Code
Below is a regression plot in which the analysis did assume a constant association between the predictor and the outcome net of controls. For an analysis that has that assumption, it does not make much sense to plot individual point predictions, because these points would not be independent predictions. This is a draft of a figure from Zigerell 2022 “Introducing Political Science Students to Data Visualization Strategies” in the Journal of Political Science Education. Dataset for Figure 4.csv.
library(tidyverse)
DATA <- read_csv("Figure 4.CSV")
print(DATA, n = Inf)## # A tibble: 40 × 5
## FACET LEVEL PE CILO CIHI
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Republicans 1 0.367 0.342 0.393
## 2 Republicans 2 0.371 0.350 0.393
## 3 Republicans 3 0.376 0.358 0.393
## 4 Republicans 4 0.380 0.365 0.395
## 5 Republicans 5 0.384 0.370 0.397
## 6 Republicans 6 0.388 0.375 0.402
## 7 Republicans 7 0.392 0.377 0.408
## 8 Republicans 8 0.397 0.378 0.415
## 9 Republicans 9 0.401 0.379 0.423
## 10 Republicans 10 0.405 0.379 0.432
## 11 McConnell 1 0.130 0.115 0.144
## 12 McConnell 2 0.129 0.116 0.141
## 13 McConnell 3 0.128 0.118 0.138
## 14 McConnell 4 0.127 0.118 0.136
## 15 McConnell 5 0.127 0.118 0.135
## 16 McConnell 6 0.126 0.117 0.134
## 17 McConnell 7 0.125 0.116 0.134
## 18 McConnell 8 0.124 0.114 0.135
## 19 McConnell 9 0.124 0.111 0.136
## 20 McConnell 10 0.123 0.109 0.137
## 21 Ryan 1 0.239 0.219 0.258
## 22 Ryan 2 0.242 0.226 0.259
## 23 Ryan 3 0.246 0.232 0.260
## 24 Ryan 4 0.250 0.238 0.261
## 25 Ryan 5 0.253 0.242 0.264
## 26 Ryan 6 0.257 0.246 0.268
## 27 Ryan 7 0.261 0.248 0.273
## 28 Ryan 8 0.265 0.250 0.280
## 29 Ryan 9 0.269 0.250 0.287
## 30 Ryan 10 0.272 0.251 0.294
## 31 Trump 1 0.271 0.246 0.295
## 32 Trump 2 0.296 0.274 0.318
## 33 Trump 3 0.323 0.304 0.342
## 34 Trump 4 0.351 0.334 0.368
## 35 Trump 5 0.380 0.365 0.396
## 36 Trump 6 0.410 0.395 0.426
## 37 Trump 7 0.441 0.424 0.459
## 38 Trump 8 0.472 0.451 0.493
## 39 Trump 9 0.504 0.479 0.529
## 40 Trump 10 0.535 0.505 0.565DATA$FACET <- factor(DATA$FACET, levels = c("Trump", "McConnell", "Ryan", "Republicans"))
LABELS <- c("Republicans" = "Republicans\nin 2017", "McConnell" = "Mitch McConnell\nin 2018", "Ryan" = "Paul Ryan\nin 2018", "Trump" = "Donald Trump\nin 2018")
CAPTION <- str_wrap(width = 120, "Note: The figure reports results from an unweighted logit regression. Each outcome is a favorable rating, about Republicans (above 50 on a 0-to-100 feeling thermometer, with the residual category containing respondents who reported a rating 50 or lower or did not provide a rating) or the indicated Republican (very favorable or somewhat favorable, with the residual category containing respondents who selected very unfavorable or somewhat unfavorable or did not select a response). The main predictor is a measure of animus against Democratic groups, measured as the mean 0-to-100 feeling thermometer rating about Blacks, Latinos, Muslims, and gay and lesbian people. The measure of animus was coded to have ten levels with about an equal number at each level, with sample sizes between 411 and 429 for each of the ten levels. Regressions controlled for gender, race, age, education, family income, partisanship, ideology, religious attendance, and political interest. Estimates were calculated with controls at their means. Sample limited to respondents with substantive responses to all predictors and all four outcomes. Data source: VOTER study (Democracy Fund Voter Study Group 2018). Based on code from Mason et al. (2021b) and an analysis in Mason et al. (2021a), with modifications.")
theme.z <- theme(
axis.text.x = element_text(size = 15, color = "black", hjust = c(0,1), margin = margin(t = 7,b = 7)),
axis.text.x.top = element_blank(),
axis.text.y = element_text(size = 15, color = "black", margin = margin(l = 7,r = 7)),
axis.text.y.right = element_text(size = 15, color = "black", margin = margin(l = 7,r = 7)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(size = 15, color = "black", margin = margin(t = 7,r = 7,b = 7,l = 7)),
axis.title.y = element_blank(),
legend.position = "none",
panel.background = element_rect(linewidth = 1.0, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA, linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.spacing.x = unit(1, "lines"),
panel.spacing.y = unit(1, "lines"),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12, hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 5,r = 5,b = 5,l = 5),"pt"),
plot.subtitle = element_text(size = 15, hjust = 0.5, margin = margin(b = 7)),
plot.title = element_text(size = 20, hjust = 0.5, face = "bold", margin = margin(t = 0,b = 12)),
strip.background = element_rect(linewidth = 1.0, color = "black", fill = "black"),
strip.text.x = element_text(size = 18, color = "white", face = "bold", margin = margin(t = 10,r = 10,b = 10,l = 10))
)
ggplot(data = DATA, mapping = aes(x = LEVEL, y = PE, group = 1)) +
facet_wrap(vars(FACET), ncol = 4, dir = "v", labeller = as_labeller(LABELS)) +
geom_rect(data = filter(DATA, FACET == "Ryan"), mapping = aes(xmin = -Inf, xmax = Inf,
ymin = min(DATA$PE[DATA$FACET == "Ryan"]), ymax = max(DATA$PE[DATA$FACET == "Ryan"])), fill = "lightsteelblue3", inherit.aes = FALSE) +
geom_rect(data = filter(DATA, FACET == "McConnell"), mapping = aes(xmin = -Inf, xmax = Inf,
ymin = min(DATA$PE[DATA$FACET == "McConnell"]), ymax = max(DATA$PE[DATA$FACET == "McConnell"])), fill = "lightsteelblue3", inherit.aes = FALSE) +
geom_rect(data = filter(DATA, FACET == "Republicans"), mapping = aes(xmin = -Inf, xmax = Inf, ymin = min(DATA$PE[DATA$FACET == "Republicans"]), ymax = max(DATA$PE[DATA$FACET == "Republicans"])), fill = "lightsteelblue3", inherit.aes = FALSE) +
geom_rect(data = filter(DATA, FACET == "Trump"), mapping = aes(xmin = -Inf, xmax = Inf,
ymin = min(DATA$PE[DATA$FACET == "Trump"]), ymax = max(DATA$PE[DATA$FACET == "Trump"])), fill = "lightsteelblue3", inherit.aes = FALSE) +
geom_line(linewidth = 1.25, color = "red3") +
scale_x_continuous(name = "Animus toward Democratic groups in 2011", expand = c(0,0), breaks = c(1,10),
labels = c("Low\nanimus","High\nanimus")) +
scale_y_continuous(expand = c(0,0), limits = c(0,1), breaks = seq(0,1),
labels = scales::number_format(accuracy = 1), sec.axis = dup_axis()) +
labs(title = "Predicted probability of a favorable rating about...", caption = CAPTION) +
theme.zFigure
Estimates plot: Combined with Patchwork
Code
Dataset for Rights of Man Means.csv.
library(patchwork)
library(tidyverse)
DATA <- read_csv("Rights of Man Means.csv")
print(DATA, n = Inf)## # A tibble: 63 × 9
## LIBERT STUDY GENDER ITEM ORIGINAL PE SE CILO CIHI
## <dbl> <chr> <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 6 Study 1 Women's reproductive … Low … ABscale… 0.521 0.107 0.365 0.677
## 2 6 Study 1 Women's reproductive … Sing… ABscale… 0.546 0.099 0.403 0.69
## 3 6 Study 1 Women's reproductive … Marr… ABscale… 0.521 0.105 0.369 0.673
## 4 6 Study 1 Men's reproductive au… Fair… FinAb_2x 0.624 0.084 0.502 0.745
## 5 6 Study 1 Men's reproductive au… Men … FinAb_4x 0.624 0.089 0.494 0.753
## 6 6 Study 1 Men's reproductive au… Man … FinAb_3x 0.588 0.079 0.473 0.704
## 7 6 Study 1 Men's reproductive au… Fath… FinAb_1x 0.471 0.094 0.334 0.607
## 8 6 Study 2 Women's reproductive … Low … ABscale… 0.508 0.108 0.351 0.665
## 9 6 Study 2 Women's reproductive … Sing… ABscale… 0.452 0.11 0.294 0.611
## 10 6 Study 2 Women's reproductive … Marr… ABscale… 0.468 0.112 0.305 0.631
## 11 6 Study 2 Men's reproductive au… Fair… FinAb_2x 0.611 0.078 0.498 0.724
## 12 6 Study 2 Men's reproductive au… Men … FinAb_4x 0.467 0.078 0.354 0.579
## 13 6 Study 2 Men's reproductive au… Man … FinAb_3x 0.489 0.093 0.354 0.624
## 14 6 Study 2 Men's reproductive au… Fath… FinAb_1x 0.544 0.085 0.421 0.668
## 15 6 Pooled Women's reproductive … Low … ABscale… 0.514 0.075 0.408 0.621
## 16 6 Pooled Women's reproductive … Sing… ABscale… 0.498 0.073 0.394 0.602
## 17 6 Pooled Women's reproductive … Marr… ABscale… 0.494 0.076 0.386 0.601
## 18 6 Pooled Men's reproductive au… Fair… FinAb_2x 0.617 0.056 0.537 0.697
## 19 6 Pooled Men's reproductive au… Men … FinAb_4x 0.543 0.059 0.459 0.627
## 20 6 Pooled Men's reproductive au… Man … FinAb_3x 0.537 0.061 0.45 0.624
## 21 6 Pooled Men's reproductive au… Fath… FinAb_1x 0.509 0.063 0.42 0.597
## 22 56 Study 1 Women's reproductive … Low … ABscale… 0.602 0.0567 0.523 0.682
## 23 56 Study 1 Women's reproductive … Sing… ABscale… 0.627 0.0576 0.546 0.708
## 24 56 Study 1 Women's reproductive … Marr… ABscale… 0.615 0.0544 0.538 0.691
## 25 56 Study 1 Men's reproductive au… Fair… FinAb_2x 0.609 0.0452 0.545 0.672
## 26 56 Study 1 Men's reproductive au… Men … FinAb_4x 0.7 0.0468 0.634 0.766
## 27 56 Study 1 Men's reproductive au… Man … FinAb_3x 0.657 0.0447 0.594 0.719
## 28 56 Study 1 Men's reproductive au… Fath… FinAb_1x 0.513 0.0500 0.443 0.583
## 29 56 Study 2 Women's reproductive … Low … ABscale… 0.584 0.0654 0.492 0.676
## 30 56 Study 2 Women's reproductive … Sing… ABscale… 0.528 0.0679 0.432 0.624
## 31 56 Study 2 Women's reproductive … Marr… ABscale… 0.553 0.0692 0.455 0.650
## 32 56 Study 2 Men's reproductive au… Fair… FinAb_2x 0.535 0.0513 0.463 0.607
## 33 56 Study 2 Men's reproductive au… Men … FinAb_4x 0.448 0.0506 0.377 0.519
## 34 56 Study 2 Men's reproductive au… Man … FinAb_3x 0.417 0.0579 0.336 0.499
## 35 56 Study 2 Men's reproductive au… Fath… FinAb_1x 0.478 0.0544 0.402 0.555
## 36 56 Pooled Women's reproductive … Low … ABscale… 0.593 0.0430 0.533 0.653
## 37 56 Pooled Women's reproductive … Sing… ABscale… 0.578 0.0446 0.515 0.640
## 38 56 Pooled Women's reproductive … Marr… ABscale… 0.584 0.0439 0.523 0.645
## 39 56 Pooled Men's reproductive au… Fair… FinAb_2x 0.572 0.0342 0.524 0.620
## 40 56 Pooled Men's reproductive au… Men … FinAb_4x 0.574 0.0367 0.523 0.625
## 41 56 Pooled Men's reproductive au… Man … FinAb_3x 0.537 0.0385 0.483 0.591
## 42 56 Pooled Men's reproductive au… Fath… FinAb_1x 0.496 0.0368 0.444 0.547
## 43 456 Study 1 Women's reproductive … Low … ABscale… 0.649 0.0386 0.595 0.703
## 44 456 Study 1 Women's reproductive … Sing… ABscale… 0.637 0.0405 0.580 0.693
## 45 456 Study 1 Women's reproductive … Marr… ABscale… 0.637 0.0382 0.583 0.690
## 46 456 Study 1 Men's reproductive au… Fair… FinAb_2x 0.554 0.0342 0.507 0.602
## 47 456 Study 1 Men's reproductive au… Men … FinAb_4x 0.633 0.0368 0.581 0.684
## 48 456 Study 1 Men's reproductive au… Man … FinAb_3x 0.577 0.0369 0.526 0.629
## 49 456 Study 1 Men's reproductive au… Fath… FinAb_1x 0.504 0.0369 0.452 0.555
## 50 456 Study 2 Women's reproductive … Low … ABscale… 0.645 0.0447 0.583 0.708
## 51 456 Study 2 Women's reproductive … Sing… ABscale… 0.601 0.0466 0.536 0.666
## 52 456 Study 2 Women's reproductive … Marr… ABscale… 0.619 0.0467 0.553 0.684
## 53 456 Study 2 Men's reproductive au… Fair… FinAb_2x 0.479 0.0367 0.428 0.530
## 54 456 Study 2 Men's reproductive au… Men … FinAb_4x 0.360 0.0373 0.308 0.412
## 55 456 Study 2 Men's reproductive au… Man … FinAb_3x 0.354 0.0402 0.298 0.410
## 56 456 Study 2 Men's reproductive au… Fath… FinAb_1x 0.462 0.0379 0.409 0.514
## 57 456 Pooled Women's reproductive … Low … ABscale… 0.647 0.0298 0.606 0.689
## 58 456 Pooled Women's reproductive … Sing… ABscale… 0.618 0.0312 0.574 0.661
## 59 456 Pooled Women's reproductive … Marr… ABscale… 0.627 0.0306 0.584 0.669
## 60 456 Pooled Men's reproductive au… Fair… FinAb_2x 0.514 0.0254 0.479 0.549
## 61 456 Pooled Men's reproductive au… Men … FinAb_4x 0.487 0.0282 0.448 0.526
## 62 456 Pooled Men's reproductive au… Man … FinAb_3x 0.458 0.0287 0.418 0.498
## 63 456 Pooled Men's reproductive au… Fath… FinAb_1x 0.481 0.0265 0.444 0.518theme.z <- theme(
axis.text.x = element_text(size = 15, color = "black", margin = margin(t = 5,b = 5), hjust = c(0,1)),
axis.text.y = element_text(size = 15, color = "black", margin = margin(l = 5,r = 5)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.background = element_rect(linewidth = 1.0, color = "black", fill = "gray80", linetype = "solid"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA , linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.spacing.x = unit(1, "lines"),
panel.spacing.y = unit(1, "lines"),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 10, hjust = 0, margin = margin(t = 8)),
plot.margin = unit(c(0.5,0.05,0,0.05),"cm"),
plot.subtitle = element_text(size = 15, hjust = 0.5, margin = margin(b = 7)),
plot.title = element_text(size = 18, hjust = 0.5, face = "bold", margin = margin(t = 0,b = 8)),
strip.background = element_rect(linewidth = 1.0, color = "black", fill = "black"),
strip.text.x = element_text(size = 15, color = "white", face = "bold", margin = margin(t = 5,b = 5)),
strip.text.y = element_blank()
)
DATA$ITEM <- factor(DATA$ITEM , levels = rev(unique(DATA$ITEM)))
DATA$STUDY <- factor(DATA$STUDY, levels = unique(DATA$STUDY))
DATA$GENDER <- factor(DATA$GENDER, levels = unique(DATA$GENDER))
DATA.6 <- filter(DATA, LIBERT == 6)
DATA.56 <- filter(DATA, LIBERT == 56)
DATA.456 <- filter(DATA, LIBERT == 456)
PLOT.6 <- ggplot(data = DATA.6, mapping = aes(x = PE, y = ITEM)) +
facet_grid(GENDER ~ STUDY, space = "free_y", scales = "free_y") +
geom_rect(data = NULL, mapping = aes(xmin = 0,xmax = 0.5, ymin = -Inf, ymax = Inf), fill = "gray90") +
geom_point(size = 3.5) +
geom_errorbarh(mapping = aes(xmin = CILO, xmax = CIHI), width = 0, linewidth = 0.75) +
scale_x_continuous(breaks = c(0,1), limits = c(0,1), labels = c("Least\nSupport", "Most\nSupport"), expand = c(0,0)) +
labs(title = "Libertarian identification of 6") +
theme.z +
theme(axis.text.x = element_blank())
PLOT.56 <- ggplot(data = DATA.56, mapping = aes(x = PE, y = ITEM)) +
facet_grid(GENDER ~ STUDY, space = "free_y", scales = "free_y") +
geom_rect(data = NULL, mapping = aes(xmin = 0,xmax = 0.5, ymin = -Inf, ymax = Inf), fill = "gray90") +
geom_point(size = 3.5) +
geom_errorbarh(mapping = aes(xmin = CILO, xmax = CIHI), width = 0, linewidth = 0.75) +
scale_x_continuous(breaks = c(0,1), limits = c(0,1), labels = c("Least\nSupport", "Most\nSupport"), expand = c(0,0)) +
labs(title = "Libertarian identification of 5 or 6") +
theme.z +
theme(axis.text.x = element_blank(),
strip.text.x = element_blank())
PLOT.456 <- ggplot(data = DATA.456, mapping = aes(x = PE, y = ITEM)) +
facet_grid(GENDER ~ STUDY, space = "free_y", scales = "free_y") +
geom_rect(data = NULL, mapping = aes(xmin = 0,xmax = 0.5, ymin = -Inf, ymax = Inf), fill = "gray90") +
geom_point(size = 3.5) +
geom_errorbarh(mapping = aes(xmin = CILO, xmax = CIHI), width = 0, linewidth = 0.75) +
scale_x_continuous(breaks = c(0,1), limits = c(0,1), labels = c("Least\nSupport", "Most\nSupport"), expand = c(0,0)) +
labs(title = "Libertarian identification of 4, 5, or 6") +
theme.z +
theme(strip.text.x = element_blank())
PLOT.6 + PLOT.56 + PLOT.456 + plot_layout(ncol = 1)Figure
Column plot: Stacked without legend
Code
library(tidyverse)
DATA <- tribble(
~RESPONSE ,~GROUP , ~PE ,
"Rated only men cold" ,"U.S. adults" , 0.111665 ,
"Rated only men cold" ,"Biden voters", 0.1721875,
"Rated only men cold" ,"Trump voters", 0.0515194,
"Residual colder to men" ,"U.S. adults" , 0.4547139,
"Residual colder to men" ,"Biden voters", 0.5282067,
"Residual colder to men" ,"Trump voters", 0.410322,
"Rated men equal to women","U.S. adults" , 0.2260411,
"Rated men equal to women","Biden voters", 0.1299536,
"Rated men equal to women","Trump voters", 0.3142311,
"Residual colder to women","U.S. adults" , 0.176867,
"Residual colder to women","Biden voters", 0.1426348,
"Residual colder to women","Trump voters", 0.198812,
"Rated only women cold" ,"U.S. adults" , 0.0301996,
"Rated only women cold" ,"Biden voters", 0.0255463,
"Rated only women cold" ,"Trump voters", 0.0251155)
DATA$RESPONSE <- factor(DATA$RESPONSE, levels = rev(unique(DATA$RESPONSE)))
DATA$GROUP <- factor(DATA$GROUP , levels = unique(DATA$GROUP[1:3]))
theme.z <- theme(
axis.text.x = element_text(color = "black", size = 15, margin = margin(t = 0)),
axis.text.y = element_text(color = "black", size = 15, margin = margin(l = 0, r = 0)),
axis.text.y.right = element_text(color = "black", size = 15, margin = margin(l = 0, r = 0)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.position = "none",
legend.spacing.x = unit(10, "pt"),
legend.spacing.y = unit(10, "pt"),
legend.text = element_text(size = 15, margin = margin(t = 5)),
legend.title = element_text(size = 15, face = "bold"),
panel.background = element_rect(fill = "white"),
panel.border = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.caption = element_text(size = 11, hjust = 0, margin = margin(15,0,0,0)),
plot.subtitle = element_text(hjust = 0.5),
plot.margin = unit(c(t = 10,r = 10,b = 10,l = 10),"pt"),
plot.title = element_text(face = "bold", margin = margin(t = 0, b = 6), size = 20, hjust = 0.5)
)
CAPTION <- str_wrap(width = 100, "Note: Cold refers to a rating under 50. Colder refers to a lower rating. Estimates are weighted. \nSample size 1,500 U.S. adults, 607 Biden voters, 508 Democrats, 428 Independents, and 430 Republicans, with a non-response from 1 Democrat / Biden voter.\nData source: American National Election Studies. 2022. ANES 2022 Pilot Study [dataset and documentation].\nDecember 14, 2022 version. www.electionstudies.org. Used presvote20post for the vote variable.")
ggplot(DATA, mapping = aes(fill = RESPONSE, y = 100*PE, x = GROUP)) +
geom_col(color = "black", linewidth = 1.1, width = 0.85) +
scale_fill_manual(values = rev(c("Rated only men cold" = "steelblue1","Residual colder to men" = "powderblue","Rated men equal to women" = "white","Residual colder to women" = "lightpink1","Rated only women cold" = "deeppink1")), name = "Category") +
scale_y_continuous(limits = c(0,100.01), breaks = seq(0,100,by = 10), sec.axis = sec_axis(~.,breaks = c(3,27,62,86,98), label = c("Rated only men cold","Residual colder to men","Rated men equal to women","Residual colder to women","Rated only women cold"))) +
labs(title = "Ratings about men and women\non 0-to-100 feeling thermometers", caption = CAPTION) +
theme.zFigure
Column plot: Stacked with legend
Code
This next plot is a column plot but with categories stacked on top of each other.
library(tidyverse)
DATA <- tribble(
~GROUP , ~ITEM , ~PE ,
"Democrats" , "Not at all" , 0.775,
"Democrats" , "A little" , 0.098,
"Democrats" , "A moderate amount", 0.077,
"Democrats" , "A lot" , 0.026,
"Democrats" , "A great deal" , 0.018,
"Republicans" , "Not at all" , 0.893,
"Republicans" , "A little" , 0.03 ,
"Republicans" , "A moderate amount", 0.047,
"Republicans" , "A lot" , 0.012,
"Republicans" , "A great deal" , 0.015,
"Independents", "Not at all" , 0.829,
"Independents", "A little" , 0.072,
"Independents", "A moderate amount", 0.064,
"Independents", "A lot" , 0.01 ,
"Independents", "A great deal" , 0.013)
DATA$ITEM <- factor(DATA$ITEM, levels = c("Not at all", "A little", "A moderate amount", "A lot", "A great deal"))
CAPTION <- str_wrap(width = 97, "Data source: American National Election Studies. 2021.\nANES 2020 Time Series Study Preliminary Release:\nPre-Election Data [dataset and documentation]. February 11, 2021\nversion. www.electionstudies.org.\n\nSample sizes: Democrats 2,683. Independents 2,525. Republicans 2,563.")
theme.z <- theme(
axis.text.x = element_text(size = 15, color = "black", hjust = 0.5, margin = margin(t = 8,b = 8)),
axis.text.y = element_text(size = 15, color = "black", vjust = 0.5, margin = margin(r = 8,l = 8)),
axis.text.y.right = element_text(size = 15, color = "black", vjust = 0.5, margin = margin(r = 8,l = 8)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_text(size = 15, color = "black", vjust = 0.5, margin = margin(r = 4), angle = 0),
axis.title.y.right = element_text(size = 15, color = "black", vjust = 0.5, margin = margin(l = 4), angle = 0),
legend.position = "right",
legend.spacing.x = unit(10, "pt"),
legend.spacing.y = unit(10, "pt"),
legend.text = element_text(size = 15, margin = margin(t = 5, r = 5, b = 5, l = 5)),
legend.title = element_text(size = 15, face = "bold"),
panel.background = element_rect(fill = "gray90"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(linewidth = 0.1, color = "gray70", linetype = "solid"),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.caption = element_text(size = 12, hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 10,r = 10,b = 10,l = 10), "pt"),
plot.subtitle = element_text(size = 15, hjust = 0.5, margin = margin(b = 7)),
plot.title = element_text(size = 19, hjust = 0.5, face = "bold", margin = margin(t = 0,b = 15))
)
ggplot(DATA, mapping = aes(fill = ITEM, y = 100*PE, x = GROUP)) +
geom_col(color = "black", linewidth = 1.1, width = 0.85) +
scale_fill_manual(values = rev(c("red4","red3","red","pink","white")), name = "Response") +
scale_x_discrete(limits = c("Democrats","Independents","Republicans")) +
scale_y_continuous(limits = c(0,100), breaks = seq(0,100,by = 10), sec.axis = dup_axis()) +
labs(title = "How much do you feel it is justified\nfor people to use violence to pursue\ntheir political goals in this country?", y = "%", caption = CAPTION) +
theme.zFigure
Column plot: Back-to-back
Code
This plot provides an example of data loaded from an external file. The line “DATA <- read_csv(”Figure 6.CSV”)” gets the CSV file from the working directory, but the line “DATA <- read_csv(file.choose())” can be used to open a dialog box so that you can navigate to a folder to select the file. This is a figure from Zigerell 2022 “Introducing Political Science Students to Data Visualization Strategies” in the Journal of Political Science Education. Dataset for Figure 6.csv.
library(grid)
library(tidyverse)
DATA <- read_csv("Figure 6.CSV")
print(DATA, n = Inf)## # A tibble: 22 × 5
## EVENT DATE FACET PE N
## <chr> <chr> <chr> <dbl> <dbl>
## 1 Launches campaign 2015 Jun 16 Serious -7 57
## 2 First GOP debate 2015 Aug 6 Serious -5 89
## 3 Call for Muslim ban 2015 Dec 7 Serious -16 99
## 4 Loses Iowa 2016 Feb 1 Serious -10 115
## 5 Super Tuesday 2016 Mar 15 Serious -28 155
## 6 Cruz and Kasich exit 2016 May 3 Serious -45 170
## 7 Delegate threshold 2016 May 26 Serious -16 125
## 8 Attacks Gold Star family 2016 Aug 1 Serious -36 144
## 9 First presidential debate 2016 Sep 26 Serious -46 268
## 10 Hot mic tape released 2016 Oct 7 Serious -47 180
## 11 Comey's letter 2016 Oct 28 Serious -11 115
## 12 Launches campaign 2015 Jun 16 Clown 16 57
## 13 First GOP debate 2015 Aug 6 Clown 11 89
## 14 Call for Muslim ban 2015 Dec 7 Clown 9 99
## 15 Loses Iowa 2016 Feb 1 Clown 17 115
## 16 Super Tuesday 2016 Mar 15 Clown 16 155
## 17 Cruz and Kasich exit 2016 May 3 Clown 22 170
## 18 Delegate threshold 2016 May 26 Clown 26 125
## 19 Attacks Gold Star family 2016 Aug 1 Clown 21 144
## 20 First presidential debate 2016 Sep 26 Clown 69 268
## 21 Hot mic tape released 2016 Oct 7 Clown 20 180
## 22 Comey's letter 2016 Oct 28 Clown 12 115DATA$PCT <- DATA$PE / DATA$N
DATA$EVENT <- factor(DATA$EVENT, levels = DATA$EVENT[1:11])
DATA$FACET <- factor(DATA$FACET, levels = c("Serious","Clown"))
TEXT.SERIOUS <- textGrob(expression(bold("Serious")), gp = gpar(fontsize = 21))
TEXT.CLOWN <- textGrob(expression(bold("Clown" )), gp = gpar(fontsize = 21))
CAPTION <- str_wrap( width = 50, "Note: Respective samples sizes were 57, 89, 99, 115, 155, 170, 125, 144, 268, 180, and 115. Data source: Boydstun and Lawrence (2019).")
theme.z <- theme(
axis.text.x = element_text(size = 15, color = "black", margin = margin(t = 10,r = 10,b = 10,l = 10)),
axis.text.x.top = element_blank(),
axis.text.x.bottom = element_text(size = 15, color = "black", margin = margin(t = 10,r = 10,b = 10,l = 10)),
axis.text.y = element_text(size = 15, color = "black", margin = margin(t = 10,r = 10,b = 10,l = 10)),
axis.text.y.right = element_text(size = 15, color = "black", margin = margin(t = 10,r = 10,b = 10,l = 10)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(size = 15, color = "black", margin = margin(t = 0,r = 10,b = 10,l = 10)),
axis.title.y = element_blank(),
legend.position = "none",
panel.background = element_rect(linewidth = 0.5, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA , linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12, hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 50,r = 5,b = 5,l = 5),"pt"),
plot.subtitle = element_text(size = 15, hjust = 0.5, margin = margin(b = 7)),
plot.title = element_text(size = 20, hjust = 0.5, face = "bold", margin = margin(t = 0,b = 35)),
strip.background = element_rect(linewidth = 1, color = "black", fill = "black"),
strip.text.x = element_text(size = 18, color = "white", face = "bold", margin = margin(t = 7.5,b = 7.5))
)
ggplot(data = DATA, mapping = aes(x = rev(as.numeric(EVENT)), y = 100*PCT, fill = FACET)) +
coord_flip(clip = "off") +
scale_fill_manual(values = c("purple","orange"), breaks = c("Serious","Clown"), labels = c("Serious","Clown")) +
geom_col(linewidth = 0.85, width = 0.7, color = "black") +
scale_x_continuous(breaks = 1:11, labels = rev(DATA$EVENT[1:11]),
sec.axis = sec_axis(~.,breaks = 1:11, labels = rev(DATA$DATE[1:11]))) +
scale_y_continuous(limits = c(-30,30), breaks = seq(-30,30,10), labels = c("30%","20%","10%","0%","10%","20%","30%")) +
labs(y = "Percentage of all articles", caption = CAPTION) +
annotation_custom(TEXT.SERIOUS, xmin = 12.75, xmax = 12.75, ymin = -15, ymax = -15) +
annotation_custom(TEXT.CLOWN , xmin = 12.75, xmax = 12.75, ymin = 15, ymax = 15) +
theme.zFigure
Column plot: Back-to-back with estimates
Code
This is a figure from Zigerell 2022 “Introducing Political Science Students to Data Visualization Strategies” in the Journal of Political Science Education.
library(grid)
library(tidyverse)
DATA <- tribble(
~EVENT , ~DATE , ~PE.SERIOUS, ~PE.CLOWN, ~N ,
"Launches campaign" , "2015 Jun 16", -7, 16, 57,
"First GOP debate" , "2015 Aug 6" , -5, 11, 89,
"Call for Muslim ban" , "2015 Dec 7" , -16, 9, 99,
"Loses Iowa" , "2016 Feb 1" , -10, 17, 115,
"Super Tuesday" , "2016 Mar 15", -28, 16, 155,
"Cruz and Kasich exit" , "2016 May 3" , -45, 22, 170,
"Delegate threshold" , "2016 May 26", -16, 26, 125,
"Attacks Gold Star family" , "2016 Aug 1" , -36, 21, 144,
"First presidential debate", "2016 Sep 26", -46, 69, 268,
"Hot mic tape released" , "2016 Oct 7" , -47, 20, 180,
"Comey's letter" , "2016 Oct 28", -11, 12, 115)
DATA$PCT <- DATA$PE.SERIOUS / DATA$N
DATA$EVENT <- factor(DATA$EVENT, levels = DATA$EVENT[1:11])
EVENT.AN <- as.numeric(DATA$EVENT)
TEXT.SERIOUS <- textGrob(expression(bold("Serious")), gp = gpar(fontsize = 21))
TEXT.CLOWN <- textGrob(expression(bold("Clown" )), gp = gpar(fontsize = 21))
CAPTION <- str_wrap(width = 50, "Note: Respective samples sizes were 57, 89, 99, 115, 155, 170, 125, 144, 268, 180, and 115. Data source: Boydstun and Lawrence (2019).")
theme.z <- theme(
axis.text.x = element_blank(),
axis.text.x.top = element_blank(),
axis.text.y = element_text(size = 15 , color = "black", margin = margin(t = 10,r = 10,b = 10,l = 10)),
axis.text.y.right = element_text(size = 15 , color = "black", margin = margin(t = 10,r = 10,b = 10,l = 10)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(size = 15 , color = "black", margin = margin(t = 10,r = 10,b = 10,l = 10)),
axis.title.y = element_blank(),
legend.position = "none",
panel.background = element_rect(linewidth = 0.5, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA , linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12 , hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 50,r = 5,b = 5,l = 5),"pt"),
plot.subtitle = element_text(size = 15 , hjust = 0.5),
plot.title = element_text(size = 20 , hjust = 0.5, margin = margin(t = 0,b = 35), face = "bold"),
strip.background = element_rect(linewidth = 1, color = "black", fill = "black"),
strip.text.x = element_text(size = 18, color = "white", face = "bold", margin = margin(t = 7.5,b = 7.5))
)
ggplot(data = DATA, mapping = aes(x = rev(EVENT.AN), y = 100*PCT)) +
coord_flip(clip = "off") +
scale_fill_manual(values = c("purple")) +
geom_col(color = "black", linewidth = 0.85, width = 0.7, fill = "purple") +
geom_segment(x = rev(EVENT.AN), xend = rev(EVENT.AN), y = 0, yend = 100*DATA$PE.CLOWN/DATA$N) +
geom_point(y = 100*DATA$PE.CLOWN/DATA$N, x = rev(EVENT.AN), shape = 21, size = 4.5, color = "black", fill = "orange", stroke = 1.25) +
geom_text(mapping = aes(x = rev(EVENT.AN), y = c(100*PCT), label = scales::percent(abs(PCT), accuracy = 1L)) , hjust = 1, size = c(rep_len(5,11)), nudge_y = c(rep_len(-3,11))) +
geom_text(mapping = aes(x = rev(EVENT.AN), y = 45 , label = scales::percent(abs(PE.CLOWN/N), accuracy = 1L)), hjust = 1, size = c(rep_len(5,11))) +
scale_x_continuous(breaks = 1:11, labels = rev(DATA$EVENT[1:11]), sec.axis = sec_axis(~.,breaks = 1:11, labels = rev(DATA$DATE[1:11]))) +
scale_y_continuous(limits = c(-45,45)) +
annotation_custom(TEXT.SERIOUS, xmin = 12.75, xmax = 12.75, ymin = -22.5, ymax = -22.5) +
annotation_custom(TEXT.CLOWN , xmin = 12.75, xmax = 12.75, ymin = 22.5, ymax = 22.5) +
labs(y = "Percentage of all articles", caption = CAPTION) +
theme.zFigure
Histogram 1
Code
Dataset for VOTER immig.csv.
library(tidyverse)
DATA <- read_csv("VOTER immig.csv")
DATA$ft_immig_2020Sep[DATA$ft_immig_2020Sep > 100] <- NA
theme.z <- theme(
axis.text.x = element_text(color = "black", size = 15),
axis.text.y = element_text(color = "black", size = 15),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.position = "none",
panel.background = element_rect(fill = "gray90"),
panel.border = element_rect(color = "black", fill = NA, linewidth = 1.0),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(linewidth = 0.1, color = "white"),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.caption = element_text(size = 12 , hjust = 0, margin = margin(t = 10)),
plot.margin = unit(c(0.5,0.5,0.5,0.5), "cm"),
plot.title = element_text(face = "bold", size = 20, hjust = 0.5,margin = margin(b = 10)))
ggplot(data = DATA, mapping = aes(DATA$ft_immig_2020Sep)) +
geom_histogram(breaks = seq(-0.5,100.5, by = 1), mapping = aes(y = after_stat(density)), col = "black", fill = "slategray4") +
labs(title = "Feeling thermometer ratings about immigrants\nall participants, unweighted", caption = "Data source: Sept 2020 wave of the Democracy Fund Voter Study Group. 2021.\nViews of the Electorate Research Survey. Washington, D.C. https://www.voterstudygroup.org/.") +
scale_x_continuous(name = "Animus toward Democratic groups in 2011", expand = c(0,0), breaks = c(1,10), labels = c("Low\nanimus","High\nanimus")) +
scale_y_continuous(expand = c(0,0), limits = c(0,1), breaks = seq(0,1), labels = scales::number_format(accuracy = 1), sec.axis = dup_axis()) +
theme.z Figure
Histogram 2
Code
library(tidyverse)
set.seed(1234)
X <- rnorm(800, mean = 12, sd = 3)
DATA <- data.frame(X)
theme.z <- theme(
axis.text.x = element_text(size = 12, color = "black", hjust = 0.5, margin = margin(t = 8, b = 8)),
axis.text.y = element_text(size = 12, color = "black", vjust = 0.5, margin = margin(r = 7, l = 7)),
axis.text.y.right = element_text(size = 12, color = "black", vjust = 0.5, margin = margin(r = 7, l = 7)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_text(color = "black", size = 12),
legend.position = "none",
panel.background = element_rect(fill = "gray90"),
panel.border = element_rect(color = "black", fill = NA, linewidth = 1),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(linewidth = 0.1, color = "gray80"),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.caption = element_text(size = 12 , hjust = 0, margin = margin(t = 10)),
plot.margin = unit(c(0.5,0.5,0.5,0.5), "cm"),
plot.title = element_text(face = "bold", size = 14, hjust = 0.5,margin = margin(b = 10)))
ggplot(data = DATA, aes(X)) +
geom_histogram(breaks = seq(-0.5,25.5, by = 1), aes(y = ..count..), col = "black", fill = "dodgerblue", linewidth = 1) +
scale_y_continuous(limits = c(0,130), expand = c(0,0), breaks = seq(0,130,10), sec.axis = sec_axis(transform = ~. /length(X), label = scales::percent_format(accuracy = 1), name = "Frequency")) +
scale_x_continuous(expand = c(0,0), breaks = seq(0,26,1)) +
coord_cartesian(xlim = c(0, 25)) +
labs(x = "X", y = "Count") +
theme.zFigure
Scatterplot with regression line
Code
Dataset for states.csv.
library(tidyverse)
DATA <- read_csv("states.csv")
theme.z <- theme(
axis.text.x = element_text(size = 15, color = "black", hjust = 0.5, margin = margin(t = 8, b = 8)),
axis.text.y = element_text(size = 15, color = "black", vjust = 0.5, margin = margin(r = 7, l = 7)),
axis.text.y.right = element_text(size = 15, color = "black", vjust = 0.5, margin = margin(r = 7, l = 7)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(size = 15, color = "black", hjust = 0.5, margin = margin(t = 8, b = 8)),
axis.title.y = element_text(size = 15, color = "black", hjust = 1 , vjust = 0.5, margin = margin(l = 8, r = 8), angl = ),
axis.title.y.right = element_blank(),
panel.background = element_rect(linewidth = 0.5, fill = "gray90"),
panel.border = element_rect(linewidth = 1.0, fill = NA ),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12, hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 10, r = 10, b = 10, l = 10),"pt"),
plot.subtitle = element_text(size = 15, hjust = 0.5, margin = margin(t = 0, b = 8)),
plot.title = element_text(size = 20, hjust = 0.5, margin = margin(t = 0, b = 16), face = "bold")
)
ggplot(data = DATA, mapping = aes(y = PctReligVery, x = PctEatProduceFreq)) +
geom_smooth(method = "lm", color = "blue", se = FALSE, fullrange = TRUE) +
geom_point(size = 3.5) +
scale_x_continuous(limits = c(50,70), breaks = seq(50,70,5)) +
scale_y_continuous(limits = c(0,100), breaks = seq(0,100,10), labels = seq(0,100,10), expand = c(0,0),
sec.axis = dup_axis()) +
labs(x = "Percentage of state residents that\neat produce frequently", y = "Percentage of\nstate residents\nthat are\nvery religious") +
annotate("text", x = 70, y = 88, size = 4, hjust = 1, family = "mono", label = " Estimate p-value") +
annotate("text", x = 70, y = 80, size = 4, hjust = 1, family = "mono", label = " Intercept 143.89 <0.01") +
annotate("text", x = 70, y = 72, size = 4, hjust = 1, family = "mono", label = "% eat produce freq -1.86 <0.01") +
theme.zsummary(DATA$PctReligVery)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 16.00 31.00 36.50 37.16 43.75 59.00summary(DATA$PctEatProduceFreq)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 52.10 55.73 57.35 57.50 59.45 64.60summary(lm(DATA$PctReligVery ~ DATA$PctEatProduceFreq))##
## Call:
## lm(formula = DATA$PctReligVery ~ DATA$PctEatProduceFreq)
##
## Residuals:
## Min 1Q Median 3Q Max
## -10.998 -5.091 -1.438 4.140 19.056
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 143.8881 19.8256 7.258 2.96e-09 ***
## DATA$PctEatProduceFreq -1.8561 0.3443 -5.390 2.11e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.213 on 48 degrees of freedom
## Multiple R-squared: 0.3771, Adjusted R-squared: 0.3641
## F-statistic: 29.06 on 1 and 48 DF, p-value: 2.107e-06Figure
Map: United States
Code
library(tidyverse)
library(usmap)
DATA <- tribble(
~state, ~PCTBLACK,
"Alabama" , 26.2, "Alaska" , 3.3, "Arizona" , 4.1, "Arkansas" , 15.4,
"California" , 6.2, "Colorado" , 4 , "Connecticut" , 10.1, "Delaware" , 21.4,
"Florida" , 16 , "Georgia" , 30.5, "Hawaii" , 1.6, "Idaho" , 0.6,
"Illinois" , 14.5, "Indiana" , 9.1, "Iowa" , 2.9, "Kansas" , 5.9,
"Kentucky" , 7.8, "Louisiana" , 32 , "Maine" , 1.2, "Maryland" , 29.4,
"Massachusetts" , 6.6, "Michigan" , 14.2, "Minnesota" , 5.2, "Mississippi" , 37 ,
"Missouri" , 11.6, "Montana" , 0.4, "Nebraska" , 4.5, "Nevada" , 8.1,
"New Hampshire" , 1.1, "New Jersey" , 13.7, "New Mexico" , 2.1, "New York" , 15.9,
"North Carolina", 21.5, "North Dakota" , 1.2, "Ohio" , 12.2, "Oklahoma" , 7.4,
"Oregon" , 1.8, "Pennsylvania" , 10.8, "Rhode Island" , 5.7, "South Carolina", 27.9,
"South Dakota" , 1.3, "Tennessee" , 16.7, "Texas" , 11.8, "Utah" , 1.1,
"Vermont" , 1 , "Virginia" , 19.4, "Washington" , 3.6, "West Virginia" , 3.4,
"Wisconsin" , 6.3, "Wyoming" , 1 )
theme.z <- theme(
legend.position = "right",
legend.text = element_text(size = 15),
legend.title = element_text(size = 15, face = "bold"),
plot.margin = unit(c(t = 10,r = 10,b = 10,l = 10),"pt"),
plot.title = element_text(size = 20, hjust = 0.5, face = "bold", margin = margin(t = 0,b = 0))
)
plot_usmap(data = DATA, values = "PCTBLACK", color = "black", lwd = 0.75) +
scale_fill_continuous(low = "lightblue1", high = "darkblue", breaks = c(0,5,10,20,30,35)) +
guides(fill = guide_legend("Percent\nBlack")) +
labs(title = "Title") +
theme.zFigure
Map: World
Code
Dataset for world map SAMPLE.csv.
library(tidyverse)
library(maps)
library(rnaturalearth, rnaturalearthdata)
library(sf)
DATA <- read_csv("world map SAMPLE.csv")
print(DATA, n = Inf)## # A tibble: 222 × 3
## region CountryCode DATA.AVAILABILITY
## <chr> <chr> <chr>
## 1 Afghanistan AFG No data
## 2 Albania ALB No data
## 3 Algeria DZA No data
## 4 American Samoa ASM No data
## 5 Andorra AND No data
## 6 Angola AGO No data
## 7 Antigua ATG No data
## 8 Argentina ARG No data
## 9 Armenia ARM No data
## 10 Aruba ABW No data
## 11 Australia AUS No data
## 12 Austria AUT No data
## 13 Azerbaijan AZE No data
## 14 Bahamas BHS No data
## 15 Bahrain BHR No data
## 16 Bangladesh BGD No data
## 17 Barbados BRB No data
## 18 Belarus BLR No data
## 19 Belgium BEL No data
## 20 Belize BLZ No data
## 21 Benin BEN No data
## 22 Bermuda BMU No data
## 23 Bhutan BTN No data
## 24 Bolivia BOL No data
## 25 Bosnia and Herzegovina BIH No data
## 26 Botswana BWA No data
## 27 Brazil BRA Partial data
## 28 Virgin Islands VGB No data
## 29 Brunei BRN No data
## 30 Bulgaria BGR No data
## 31 Burkina Faso BFA No data
## 32 Burundi BDI No data
## 33 Cabo Verde CPV No data
## 34 Cambodia KHM No data
## 35 Cameroon CMR No data
## 36 Canada CAN Full data
## 37 Cayman Islands CYM No data
## 38 Central African Republic CAF No data
## 39 Central Europe and the Baltics CEB No data
## 40 Chad TCD No data
## 41 Channel Islands CHI No data
## 42 Chile CHL No data
## 43 China CHN Partial data
## 44 Colombia COL No data
## 45 Comoros COM No data
## 46 Democratic Republic of the Congo COD No data
## 47 Republic of Congo COG No data
## 48 Costa Rica CRI No data
## 49 Cote d'Ivoire CIV No data
## 50 Croatia HRV No data
## 51 Cuba CUB No data
## 52 Curacao CUW No data
## 53 Cyprus CYP No data
## 54 Czech Republic CZE No data
## 55 Denmark DNK No data
## 56 Djibouti DJI No data
## 57 Dominica DMA No data
## 58 Dominican Republic DOM No data
## 59 Ecuador ECU No data
## 60 Egypt EGY No data
## 61 El Salvador SLV No data
## 62 Equatorial Guinea GNQ No data
## 63 Eritrea ERI No data
## 64 Estonia EST No data
## 65 Eswatini SWZ No data
## 66 Ethiopia ETH No data
## 67 Faroe Islands FRO No data
## 68 Fiji FJI No data
## 69 Finland FIN No data
## 70 France FRA No data
## 71 French Polynesia PYF No data
## 72 Gabon GAB No data
## 73 Gambia GMB No data
## 74 Georgia GEO No data
## 75 Germany DEU No data
## 76 Ghana GHA No data
## 77 Gibraltar GIB No data
## 78 Greece GRC No data
## 79 Greenland GRL No data
## 80 Grenada GRD No data
## 81 Guam GUM No data
## 82 Guatemala GTM No data
## 83 Guinea GIN No data
## 84 Guinea-Bissau GNB No data
## 85 Guyana GUY No data
## 86 Haiti HTI No data
## 87 Honduras HND No data
## 88 Hong Kong SAR, China HKG No data
## 89 Hungary HUN No data
## 90 Iceland ISL No data
## 91 India IND Full data
## 92 Indonesia IDN No data
## 93 Iran IRN No data
## 94 Iraq IRQ No data
## 95 Ireland IRL No data
## 96 Isle of Man IMN No data
## 97 Israel ISR No data
## 98 Italy ITA No data
## 99 Jamaica JAM No data
## 100 Japan JPN No data
## 101 Jordan JOR No data
## 102 Kazakhstan KAZ No data
## 103 Kenya KEN No data
## 104 Kiribati KIR No data
## 105 North Korea PRK No data
## 106 South Korea KOR No data
## 107 Kosovo XKX No data
## 108 Kuwait KWT No data
## 109 Kyrgyz Republic KGZ No data
## 110 Lao PDR LAO No data
## 111 Latvia LVA No data
## 112 Least developed countries: UN classification LDC No data
## 113 Lebanon LBN No data
## 114 Lesotho LSO No data
## 115 Liberia LBR No data
## 116 Libya LBY No data
## 117 Liechtenstein LIE No data
## 118 Lithuania LTU No data
## 119 Luxembourg LUX No data
## 120 Macao SAR, China MAC No data
## 121 Madagascar MDG No data
## 122 Malawi MWI No data
## 123 Malaysia MYS No data
## 124 Maldives MDV No data
## 125 Mali MLI No data
## 126 Malta MLT No data
## 127 Marshall Islands MHL No data
## 128 Mauritania MRT No data
## 129 Mauritius MUS No data
## 130 Mexico MEX No data
## 131 Micronesia FSM No data
## 132 Moldova MDA No data
## 133 Monaco MCO No data
## 134 Mongolia MNG No data
## 135 Montenegro MNE No data
## 136 Morocco MAR No data
## 137 Mozambique MOZ No data
## 138 Myanmar MMR No data
## 139 Namibia NAM No data
## 140 Nauru NRU No data
## 141 Nepal NPL No data
## 142 Netherlands NLD No data
## 143 New Caledonia NCL No data
## 144 New Zealand NZL No data
## 145 Nicaragua NIC No data
## 146 Niger NER No data
## 147 Nigeria NGA No data
## 148 North America NAC No data
## 149 North Macedonia MKD No data
## 150 Northern Mariana Islands MNP No data
## 151 Norway NOR No data
## 152 Not classified INX No data
## 153 Oman OMN No data
## 154 Pakistan PAK No data
## 155 Palau PLW No data
## 156 Panama PAN No data
## 157 Papua New Guinea PNG No data
## 158 Paraguay PRY No data
## 159 Peru PER No data
## 160 Philippines PHL No data
## 161 Poland POL No data
## 162 Portugal PRT No data
## 163 Puerto Rico PRI No data
## 164 Qatar QAT No data
## 165 Romania ROU No data
## 166 Russian Federation RUS No data
## 167 Rwanda RWA No data
## 168 Samoa WSM No data
## 169 San Marino SMR No data
## 170 Sao Tome and Principe STP No data
## 171 Saudi Arabia SAU No data
## 172 Senegal SEN No data
## 173 Serbia SRB No data
## 174 Seychelles SYC No data
## 175 Sierra Leone SLE No data
## 176 Singapore SGP No data
## 177 Sint Maarten SXM No data
## 178 Slovak Republic SVK No data
## 179 Slovenia SVN No data
## 180 Solomon Islands SLB No data
## 181 Somalia SOM No data
## 182 South Africa ZAF No data
## 183 South Sudan SSD No data
## 184 Spain ESP No data
## 185 Sri Lanka LKA No data
## 186 St. Kitts and Nevis KNA No data
## 187 St. Lucia LCA No data
## 188 St. Martin MAF No data
## 189 St. Vincent and the Grenadines VCT No data
## 190 Sudan SDN No data
## 191 Suriname SUR No data
## 192 Sweden SWE No data
## 193 Switzerland CHE No data
## 194 Syrian Arab Republic SYR No data
## 195 Tajikistan TJK No data
## 196 Tanzania TZA No data
## 197 Thailand THA No data
## 198 Timor-Leste TLS No data
## 199 Togo TGO No data
## 200 Tonga TON No data
## 201 Trinidad and Tobago TTO No data
## 202 Tunisia TUN No data
## 203 Turkey TUR No data
## 204 Turkmenistan TKM No data
## 205 Turks and Caicos Islands TCA No data
## 206 Tuvalu TUV No data
## 207 Uganda UGA No data
## 208 Ukraine UKR No data
## 209 United Arab Emirates ARE No data
## 210 United Kingdom GBR No data
## 211 Uruguay URY No data
## 212 USA USA No data
## 213 Uzbekistan UZB No data
## 214 Vanuatu VUT No data
## 215 Venezuela VEN No data
## 216 Vietnam VNM No data
## 217 Virgin Islands (U.S.) VIR No data
## 218 West Bank and Gaza PSE No data
## 219 World WLD No data
## 220 Yemen YEM No data
## 221 Zambia ZMB No data
## 222 Zimbabwe ZWE No dataWORLD <- st_as_sf(map("world", plot = FALSE, fill = TRUE))
SUM <- merge(WORLD, DATA, by.x = c("ID"), by.y = c("region"))
DATA$DATA.AVAILABILITY <- factor(DATA$DATA.AVAILABILITY, levels = c("No data", "Partial data", "Full data"))
theme.z <- theme(
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
legend.box = "horizontal",
legend.position = "bottom",
panel.border = element_blank(),
panel.background = element_rect(fill = "#F0F8FF"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
rect = element_blank()
)
ggplot(data = SUM) +
geom_sf(mapping = aes(fill = DATA.AVAILABILITY), color = "black", linewidth = 0.5) +
scale_fill_manual(values=c("No data" = "white", "Partial data" = "gray", "Full data" = "dodgerblue"), breaks = c("No data", "Partial data", "Full data")) +
guides(fill = guide_legend("Data availability")) +
theme.zFigure
Map: Region
Code
library(maps)
library(rnaturalearth)
library(rnaturalearthdata)
library(tidyverse)
WORLD <- ne_countries(scale = "medium", returnclass = "sf")
IRAN <- ne_countries(country = "iran", type = "countries", scale = "medium", returnclass = "sf")
ggplot() +
geom_sf(data = WORLD) +
geom_sf(data = IRAN, linewidth = 1.2, color = "black", fill = "darkolivegreen3") +
coord_sf(xlim = c(40,68), ylim = c(22,46), expand = FALSE, datum = NA) +
geom_point(data = NULL, mapping = aes(x = 50.99155, y = 35.83266), shape = 21, color = "black", fill = "red", size = 4, stroke = 1.2) +
annotate("text", x = 50.99155, y = 35.2, label = "Karaj", size = 5 , color = "black", vjust = "top") +
annotate("text", x = 54 , y = 32 , label = "Iran" , size = 10, color = "black") +
theme(
axis.title = element_blank(),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA)
)Figure
Waffle plot
Code
library(patchwork)
library(waffle)
theme.z <- theme(
legend.text = element_text(size = 15),
plot.caption = element_blank(),
plot.subtitle = element_text(face = "bold", margin = margin(t = 0, b = 6), size = 16, hjust = 0),
plot.title = element_text(face = "bold", margin = margin(t = 0, b = 6), size = 20, hjust = 0))
BIO.BWA <- c("Category 1 only (14%)" = 14, "Category 1 and 2 (11%)" = 11, "Category 2 only (24%)" = 24, "Neither 1 nor 2 (51%)" = 51)
BIO.BWA.BIO <- c("Category 1 only (20%)" = 20, "Category 1 and 2 (14%)" = 14, "Category 1 only (23%)" = 23, "Neither 1 nor 2 (43%)" = 43)
p1 <- waffle(BIO.BWA, rows = 5, size = 2, colors = c("slategray1","purple4","lightpink1","gray70")) +
labs(title = "Title of the first plot", subtitle = "Subtitle of the first plot") +
theme.z
p2 <- waffle(BIO.BWA.BIO, rows = 5, size = 2, colors = c("slategray1","purple4","lightpink1","gray70")) +
labs(title = "Title of the second plot", subtitle = "Subtitle of the second plot", caption = "Sample size 1,500 U.S. adults. Estimates are weighted.\nData source:") +
theme.z +
theme(plot.caption = element_text(size = 11, hjust = 0, margin = margin(10,0,0,0)),
plot.title = element_text(face = "bold", margin = margin(t = 10, b = 6), size = 20, hjust = 0)
)
p1 / p2Figure
Multiple waffle plots
Code
library(showtext)
library(tidyverse)
library(waffle)
showtext_auto()
font_add_google("Roboto Mono")
FONT <- "Roboto Mono"
TITLE <- str_wrap(width = 50, "Percentages indicating that the factor should be\na major or minor factor\nin college admissions")
CAPTION <- str_wrap(width = 75, "Data source: Pew Research Center's American Trends Panel. Wave 43. Jan 22 to Feb 5, 2019. Disclaimer: The opinions expressed herein, including any implications for policy, are those of the author and not of Pew Research Center.")
theme.z <- theme(
axis.text.x.bottom = element_blank(),
axis.text.x.top = element_blank(),
axis.text.y.left = element_blank(),
axis.text.y.right = element_blank(),,
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(size = 12, color = "black", hjust = 0.5, vjust = 0.0, margin = margin(t = 10, r = 5, b = 5, l = 5), face = "bold"),
axis.title.y = element_text(size = 12, color = "black", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5)),
axis.title.y.right = element_text(size = 12, color = "black", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5), angle = 0),
legend.position = "none",
panel.background = element_rect(linewidth = 0, color = "black", linetype = "solid", fill = "white"),
panel.border = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.spacing.x = unit(0, "lines"),
panel.spacing.y = unit(0, "lines"),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 9, color = "black", hjust = 0, vjust = 0.5, margin = margin(t = 10, r = 5, b = 5, l = 5)),
plot.margin = unit(c(t = 10, r = 10, b = 10, l = 10), "pt"),
plot.subtitle = element_text(size = 15, color = "black", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5)),
plot.title = element_text(size = 13, color = "black", hjust = 0.0, vjust = 0.0, margin = margin(t = 5, r = 5, b = 10, l = 5), face = "bold"),
plot.title.position = "plot",
strip.background = element_rect(linewidth = 1, color = "white", linetype = "solid", fill = "white"),
strip.text.x = element_text(size = 12, color = "black", hjust = 0.5, vjust = 1 , margin = margin(t = 5, r = 5, b = 5, l = 5)),
strip.text.y = element_text(size = 12, color = "black", hjust = 0 , vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5), angle = 0),
text = element_text(family = FONT, lineheight = 0.9),
)
DATA <- tribble(~VARIABLE , ~GROUP, ~STATUS, ~VALUE,
"High school grades" , "White", "Present", 95,
"High school grades" , "Black", "Present", 85,
"High school grades" , "Hispanic", "Present", 88,
"High school grades" , "Asian", "Present", 91,
"Standardized test scores", "White", "Present", 91,
"Standardized test scores", "Black", "Present", 80,
"Standardized test scores", "Hispanic", "Present", 82,
"Standardized test scores", "Asian", "Present", 92,
"Community service" , "White", "Present", 71,
"Community service" , "Black", "Present", 60,
"Community service" , "Hispanic", "Present", 68,
"Community service" , "Asian", "Present", 85,
"First generation" , "White", "Present", 43,
"First generation" , "Black", "Present", 50,
"First generation" , "Hispanic", "Present", 55,
"First generation" , "Asian", "Present", 62,
"Athletic ability" , "White", "Present", 39,
"Athletic ability" , "Black", "Present", 48,
"Athletic ability" , "Hispanic", "Present", 50,
"Athletic ability" , "Asian", "Present", 56,
"Relative attended school", "White", "Present", 27,
"Relative attended school", "Black", "Present", 39,
"Relative attended school", "Hispanic", "Present", 40,
"Relative attended school", "Asian", "Present", 47,
"Race or ethnicity" , "White", "Present", 22,
"Race or ethnicity" , "Black", "Present", 38,
"Race or ethnicity" , "Hispanic", "Present", 33,
"Race or ethnicity" , "Asian", "Present", 42,
"Gender" , "White", "Present", 14,
"Gender" , "Black", "Present", 27,
"Gender" , "Hispanic", "Present", 24,
"Gender" , "Asian", "Present", 32)
DATA <- mutate(DATA, VARIABLE = factor(VARIABLE, levels = unique(DATA$VARIABLE)))
DATA <- group_by(DATA, VARIABLE, GROUP)
DATA <- reframe(DATA, STATUS = c(STATUS, "Absent"), VALUE = c(VALUE, 100 - VALUE))
ggplot(DATA, aes(fill = STATUS, values = VALUE)) +
geom_waffle(n_rows = 10, size = 0.25, color = "white", flip = TRUE) +
facet_grid(rows = vars(VARIABLE), cols = vars(GROUP)) +
scale_fill_manual(values = c("Present" = "black", "Absent" = "gray90")) +
coord_equal() +
labs(title = TITLE, caption = CAPTION) +
theme.zFigure
Rotated text and external arrows
Code
library(tidyverse)
DATA <- tribble(
~MOD, ~X, ~Y,
0, 0, 30,
0, 1, 55,
1, 0, 50,
1, 1, 70)
theme.z <- theme(
plot.background = element_rect(fill = "white"),
plot.margin = unit(c(0.5,0.9,0.5,4.2),"cm"),
plot.title = element_text(face = "bold", margin = margin(t = 0, b = 12), size = 18, hjust = 0.5),
plot.subtitle = element_text(size = 12, hjust = 0.5),
plot.caption = element_text(size = 9, hjust = 1),
strip.background = element_rect(linewidth = 1.0, color = "black", fill = "black"),
strip.text.x = element_text(size = 14, color = "white", face = "bold"),
panel.background = element_rect(fill = "gray90", color = "black", linewidth = 0.5, linetype = "solid"),
panel.border = element_rect(fill = NA, color = "black", linetype = "solid", linewidth = 1.0),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.spacing.x = unit(2, "lines"),
panel.spacing.y = unit(1, "lines"),
axis.text.x = element_text(size = 15, color = "black", margin = margin(t = 7, b = 5)),
axis.text.y = element_text(size = 15, color = "black", margin = margin(r = 7)),
axis.ticks.y = element_blank(),
axis.ticks.x = element_blank(),
axis.title.y = element_text(size = 15, color = "black", angle = 0, vjust = 1),
axis.title.y.right = element_text(size = 15, color = "black", angle = 0, vjust = 1),
axis.title.x = element_text(size = 15, color = "black")
)
ggplot(DATA, mapping = aes(x = X, y = Y, group = MOD)) +
geom_smooth(data = subset(DATA, MOD == 0), method = "lm", formula = y~x, se = F, linewidth = 1, color = "blue") +
geom_smooth(data = subset(DATA, MOD == 1), method = "lm", formula = y~x, se = F, linewidth = 2, color = "pink") +
geom_point(pch = 21, size = 4, stroke = 1.5, color = "black", bg = "white") +
scale_x_continuous(name = "X", breaks = seq(0,1,1), expand = c(0,0), limits = c(-0.05,1.05)) +
scale_y_continuous(name = "Y", breaks = c(0,30,50), expand = c(0,0), limits = c(0,76), sec.axis = sec_axis(~., name = "Y", breaks = c(55,70))) +
annotate("text", x = 0.3, y = 26, label = "OLS Coefficients", hjust = 0, vjust = 1, size = 6, lineheight = 0.9, family = "mono", fontface = "bold") +
annotate("text", x = 0.3, y = 21, label = " 30 Intercept\n 20 Female\n 25 X\n -5 Female * X", hjust = 0, vjust = 1, size = 6, lineheight = 0.9, family = "mono") +
geom_text(x = 0.5, y = 41, label = "Slope for males of 25" , hjust = 0.5, vjust = 1, size = 5.6, angle = 19.5) +
geom_text(x = 0.5, y = 66, label = "Slope for females of 20", hjust = 0.5, vjust = 1, size = 5.6, angle = 16) +
geom_text(x = -0.25, y = 15, label = "Intercept\nof 30", hjust = 1, vjust = 0.5, size = 5.6) +
geom_text(x = -0.25, y = 40, label = "\"Female\"\ncoefficient\nof 20", hjust = 1, vjust = 0.5, size = 5.6) +
geom_segment(x = -0.2, y = 0, xend = -0.2, yend = 30, arrow = arrow(length = unit(10, "pt"), ends = "both")) +
geom_segment(x = -0.2, y = 50, xend = -0.2, yend = 30, arrow = arrow(length = unit(10, "pt"), ends = "both")) +
coord_cartesian(clip = "off") +
theme.zsummary(lm(Y ~ X*MOD, data = DATA))##
## Call:
## lm(formula = Y ~ X * MOD, data = DATA)
##
## Residuals:
## ALL 4 residuals are 0: no residual degrees of freedom!
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 30 NaN NaN NaN
## X 25 NaN NaN NaN
## MOD 20 NaN NaN NaN
## X:MOD -5 NaN NaN NaN
##
## Residual standard error: NaN on 0 degrees of freedom
## Multiple R-squared: 1, Adjusted R-squared: NaN
## F-statistic: NaN on 3 and 0 DF, p-value: NAFigure
Brackets
Code
library(ggpubr)
library(tidyverse)
DATA <- tribble(
~HEALTH, ~VEGGIE, ~EXERCISE,
6, 0, 0,
5, 1, 0,
4, 2, 0,
51, 3, 1,
65, 4, 1,
65, 5, 1,
75, 6, 1,
66, 7, 1)
theme.z <- theme(
axis.text.x = element_text(size = 15, color = "black", margin = margin(t = 7,b = 7)),
axis.text.y = element_text(size = 15, color = "black", margin = margin(l = 7,r = 7)),
axis.text.y.right = element_text(size = 15, color = "black", margin = margin(l = 7,r = 7)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(size = 15, color = "black", margin = margin(t = 7,r = 7,b = 7,l = 7)),
axis.title.y = element_text(size = 15, color = "black", margin = margin(t = 7,r = 7,b = 7,l = 7)),
legend.position = "none",
panel.background = element_rect(linewidth = 1.0, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA, linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.spacing.x = unit(1, "lines"),
panel.spacing.y = unit(1, "lines"),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12, hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 5,r = 5,b = 5,l = 5),"pt"),
plot.subtitle = element_text(size = 15, hjust = 0.5, margin = margin(b = 7)),
plot.title = element_text(size = 20, hjust = 0.5, face = "bold", margin = margin(t = 0,b = 12))
)
ggplot(data = DATA, mapping = aes(x = VEGGIE, y = HEALTH)) +
geom_smooth(data = subset(DATA, EXERCISE == 1), formula = y ~ x, method = "lm", se = FALSE, fullrange = TRUE, color = "green2", linewidth = 1.2) +
geom_smooth(data = subset(DATA, EXERCISE == 0), formula = y ~ x, method = "lm", se = FALSE, fullrange = TRUE, color = "red", linewidth = 1.2) +
geom_point(size = 4) +
geom_point(data = subset(DATA, EXERCISE==0), size = 4, pch=21, stroke = 1.2, fill = "red") +
geom_point(data = subset(DATA, EXERCISE==1), size = 4, pch=21, stroke = 1.2, fill = "green2") +
scale_x_continuous(name = "VEGGIE\n(Number of days per week eating vegetables)", expand=c(0,0), limits = c(-0.5,7.5) , breaks = seq(0,7,1)) +
scale_y_continuous(name = "HEALTH", limits = c(-5,100), breaks = seq(0,100,20)) +
geom_bracket(xmin = 0, xmax = 2, label = "No exercise\nEXERCISE=0", y.position=15, label.size = 5.5, vjust = -0.2, tip.length=c(0.05 ,0.1)) +
geom_bracket(xmin = 3, xmax = 7, label = "Exercises\nEXERCISE=1" , y.position=35, label.size = 5.5, vjust = 2.8, tip.length=c(-0.15, -0.35)) +
labs(title = "Health rating") +
theme.zFigure
Emphasis 1
Code
library(tidyverse)
DATA <- tribble(
~AGE, ~ITEM, ~RACE, ~PCT, ~CILO, ~CIHI,
"Age 18-29","0 to 24","Whites",0.1686075,0.125517,0.2227235,
"Age 18-29","25 to 49","Whites",0.2258218,0.1745539,0.2869135,
"Age 18-29","50","Whites",0.0491381,0.027793,0.0854356,
"Age 18-29","51 to 75","Whites",0.2707414,0.2160958,0.3333297,
"Age 18-29","76 to 100","Whites",0.2841337,0.2276716,0.3482837,
"Age 18-29","0 to 24","Blacks",0.4298258,0.2903636,0.5813931,
"Age 18-29","25 to 49","Blacks",0.3173413,0.1963695,0.4693152,
"Age 18-29","50","Blacks",0.048522,0.0089412,0.2237587,
"Age 18-29","51 to 75","Blacks",0.1696017,0.0965342,0.2807865,
"Age 18-29","76 to 100","Blacks",0.0347092,0.0093621,0.1203453,
"Age 18-29","0 to 24","Hispanics",0.2210459,0.1426287,0.3261748,
"Age 18-29","25 to 49","Hispanics",0.1639248,0.1095114,0.2381445,
"Age 18-29","50","Hispanics",0.1007021,0.0496316,0.1936177,
"Age 18-29","51 to 75","Hispanics",0.2340969,0.1579551,0.3324516,
"Age 18-29","76 to 100","Hispanics",0.2802302,0.1932706,0.3875214,
"Age 18-29","0 to 24","Other",0.1799807,0.1005913,0.3010538,
"Age 18-29","25 to 49","Other",0.2835058,0.1587469,0.4534617,
"Age 18-29","50","Other",0.0279455,0.0065446,0.111475,
"Age 18-29","51 to 75","Other",0.3626855,0.2336636,0.5150665,
"Age 18-29","76 to 100","Other",0.1458826,0.0655658,0.2936658,
"Age 30-45","0 to 24","Whites",0.0880538,0.0688471,0.1119744,
"Age 30-45","25 to 49","Whites",0.1490723,0.1252224,0.1765479,
"Age 30-45","50","Whites",0.0528802,0.0363371,0.0763582,
"Age 30-45","51 to 75","Whites",0.2651047,0.2341556,0.2985497,
"Age 30-45","76 to 100","Whites",0.444889,0.4087117,0.48166,
"Age 30-45","0 to 24","Blacks",0.2473897,0.1837595,0.3242992,
"Age 30-45","25 to 49","Blacks",0.3215109,0.2441783,0.4100479,
"Age 30-45","50","Blacks",0.0686421,0.0413368,0.1118792,
"Age 30-45","51 to 75","Blacks",0.2180175,0.1547748,0.2979913,
"Age 30-45","76 to 100","Blacks",0.1178969,0.0727645,0.1854246,
"Age 30-45","0 to 24","Hispanics",0.1405747,0.0891829,0.2146035,
"Age 30-45","25 to 49","Hispanics",0.1712986,0.1257236,0.229066,
"Age 30-45","50","Hispanics",0.060349,0.0333786,0.1067063,
"Age 30-45","51 to 75","Hispanics",0.3072251,0.2453594,0.3768989,
"Age 30-45","76 to 100","Hispanics",0.3205526,0.2582513,0.3899815,
"Age 30-45","0 to 24","Other",0.1252955,0.0775243,0.1962415,
"Age 30-45","25 to 49","Other",0.1951634,0.1266456,0.2885051,
"Age 30-45","50","Other",0.0762974,0.0382879,0.1463,
"Age 30-45","51 to 75","Other",0.3186173,0.2348634,0.4159998,
"Age 30-45","76 to 100","Other",0.2846264,0.2003887,0.3871309,
"Age 46-59","0 to 24","Whites",0.0289146,0.0183031,0.045394,
"Age 46-59","25 to 49","Whites",0.0765872,0.0587539,0.0992624,
"Age 46-59","50","Whites",0.031878,0.0207482,0.0486813,
"Age 46-59","51 to 75","Whites",0.2623021,0.2280894,0.2996544,
"Age 46-59","76 to 100","Whites",0.6003181,0.5594169,0.6398667,
"Age 46-59","0 to 24","Blacks",0.2029044,0.1311466,0.3003523,
"Age 46-59","25 to 49","Blacks",0.2460165,0.171898,0.3390102,
"Age 46-59","50","Blacks",0.0785931,0.0413865,0.1442167,
"Age 46-59","51 to 75","Blacks",0.2879665,0.2003525,0.3949698,
"Age 46-59","76 to 100","Blacks",0.1845194,0.1238305,0.2659244,
"Age 46-59","0 to 24","Hispanics",0.0790971,0.0343998,0.1715537,
"Age 46-59","25 to 49","Hispanics",0.1759927,0.1123977,0.2648339,
"Age 46-59","50","Hispanics",0.0705534,0.0347834,0.1378541,
"Age 46-59","51 to 75","Hispanics",0.2658014,0.184284,0.3671479,
"Age 46-59","76 to 100","Hispanics",0.4085554,0.3102326,0.5147835,
"Age 46-59","0 to 24","Other",0.0394191,0.0110365,0.1311161,
"Age 46-59","25 to 49","Other",0.1522902,0.0886397,0.2491515,
"Age 46-59","50","Other",0.0303505,0.0095767,0.0920012,
"Age 46-59","51 to 75","Other",0.4064893,0.2907918,0.5335858,
"Age 46-59","76 to 100","Other",0.371451,0.2611008,0.4970653,
"Age 60+","0 to 24","Whites",0.0101233,0.0053504,0.0190725,
"Age 60+","25 to 49","Whites",0.0534469,0.0415213,0.0685529,
"Age 60+","50","Whites",0.013854,0.008874,0.0215679,
"Age 60+","51 to 75","Whites",0.2511503,0.2264746,0.2775499,
"Age 60+","76 to 100","Whites",0.6714254,0.6426687,0.698952,
"Age 60+","0 to 24","Blacks",0.0897313,0.0426382,0.1791068,
"Age 60+","25 to 49","Blacks",0.1742434,0.1083386,0.2681815,
"Age 60+","50","Blacks",0.043537,0.0206152,0.0896133,
"Age 60+","51 to 75","Blacks",0.4234502,0.3277676,0.5252404,
"Age 60+","76 to 100","Blacks",0.2562281,0.1733786,0.3613605,
"Age 60+","0 to 24","Hispanics",0.0609062,0.0219529,0.157825,
"Age 60+","25 to 49","Hispanics",0.0339614,0.0126179,0.0881835,
"Age 60+","50","Hispanics",0.0365783,0.013317,0.0964974,
"Age 60+","51 to 75","Hispanics",0.2722974,0.1807325,0.3882669,
"Age 60+","76 to 100","Hispanics",0.5962568,0.4774693,0.7047391,
"Age 60+","0 to 24","Other",0.0201068,0.0059742,0.0654697,
"Age 60+","25 to 49","Other",0.074297,0.0319437,0.1633308,
"Age 60+","50","Other",0.028154,0.0082708,0.0914298,
"Age 60+","51 to 75","Other",0.1951647,0.1240613,0.293371,
"Age 60+","76 to 100","Other",0.6822776,0.5659573,0.7795664)
theme.z <- theme(
panel.background = element_rect(fill = "black"),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.border = element_rect(color = "black", linewidth = 1, fill = NA),
panel.spacing.x = unit(1, "lines"),
panel.spacing.y = unit(0.5, "lines"),
strip.background = element_rect(linewidth = 1, color = "black", fill = "black"),
strip.text.x = element_text(color = "white", face = "bold", size = 15),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_text(color = "black", size = 12, margin = margin(l = 8, r = 8)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
plot.title = element_text(face = "bold", margin = margin(t = 0, b = 13), size = 16, hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5),
plot.caption = element_text(size = 10, hjust = 0, margin = margin(10,0,0,0)),
legend.text = element_text(size = 12),
legend.position = "bottom"
)
DATA$AGE <- factor(DATA$AGE , levels = c("Age 18-29", "Age 30-45", "Age 46-59", "Age 60+"))
DATA$ITEM <- factor(DATA$ITEM, levels = rev(c("0 to 24", "25 to 49", "50", "51 to 75", "76 to 100")))
DATA$RACE <- factor(DATA$RACE, levels = c("Whites", "Blacks", "Hispanics", "Other"))
AGE.ORDER <- rev(c("Age 18-29", "Age 30-45", "Age 46-59", "Age 60+"))
RACE.ORDER <- c("Other", "Hispanics", "Blacks", "Whites")
CAPTION <- str_wrap(width = 100, "Plot indicates percentages in each group. Overall sample sizes: Whites 3,701. Blacks 539. Hispanics 647. Other 384.\nData source: American National Election Studies. 2021.\nANES 2020 Social Media Study: Pre-Election Data [dataset and documentation]. March 8, 2021 version. www.electionstudies.org")
ggplot(DATA, mapping = aes(x = AGE, y = 100*PCT, fill = ITEM)) +
geom_col(color = "black", linewidth = 1.1, width = 0.8) +
scale_fill_manual(values = rev(c("red3", "red1", "white", "green1", "green3")), name = "Rating") +
coord_flip() +
facet_wrap(~RACE, ncol = 4, dir = "h") +
scale_x_discrete(limits = AGE.ORDER, labels = AGE.ORDER, name = "") +
scale_y_continuous(limits = c(0, 100.01)) +
labs(title = "Ratings of Police on 0-to-100 Feeling Thermometers", caption = CAPTION) +
theme.z + guides(fill = guide_legend(reverse = T))ggplot(DATA, mapping = aes(x = RACE, y = 100*PCT, fill = ITEM)) +
geom_col(color = "black", linewidth = 1.1, width = 0.8) +
scale_fill_manual(values = rev(c("red3", "red1", "white", "green1", "green3")), name = "Rating") +
coord_flip() +
facet_wrap(~AGE, ncol = 4, dir = "h") +
scale_x_discrete(limits = RACE.ORDER, labels = RACE.ORDER, name = "") +
scale_y_continuous(limits = c(0, 100.01)) +
labs(title = "Ratings of Police on 0-to-100 Feeling Thermometers", caption = CAPTION) +
theme.z + guides(fill = guide_legend(reverse = T))Figure
Emphasis 2
Code
library(patchwork)
library(tidyverse)
DATA <- tribble(
~CONTROLS,~GROUP,~LEVEL,~PE,~CILO,~CIHI,
"Small controls","Ratings about Blacks","0 to 24",0.0461706,0.0270992,0.0652419,
"Small controls","Ratings about Blacks","25 to 49",0.0982854,0.0768214,0.1197495,
"Small controls","Ratings about Blacks","at 50",0.0754165,0.0575844,0.0932486,
"Small controls","Ratings about Blacks","51 to 85",0.1596652,0.146106,0.1732243,
"Small controls","Ratings about Blacks","86 to 99",0.2926404,0.2711568,0.3141241,
"Small controls","Ratings about Blacks","at 100",0.4549532,0.4144586,0.4954477,
"Small controls","Ratings about Whites","0 to 24",0.4226789,0.3650292,0.4803286,
"Small controls","Ratings about Whites","25 to 49",0.4011842,0.3655237,0.4368447,
"Small controls","Ratings about Whites","at 50",0.2425766,0.211447,0.2737062,
"Small controls","Ratings about Whites","51 to 85",0.2040362,0.1888231,0.2192493,
"Small controls","Ratings about Whites","86 to 99",0.1029744,0.0892483,0.1167005,
"Small controls","Ratings about Whites","at 100",0.0746247,0.057398,0.0918514,
"Full controls","Ratings about Blacks","0 to 24",0.0608033,0.0342018,0.0874048,
"Full controls","Ratings about Blacks","25 to 49",0.1260736,0.0973548,0.1547924,
"Full controls","Ratings about Blacks","at 50",0.0828104,0.0633727,0.102248,
"Full controls","Ratings about Blacks","51 to 85",0.1395332,0.1258388,0.1532275,
"Full controls","Ratings about Blacks","86 to 99",0.2051881,0.1857102,0.224666,
"Full controls","Ratings about Blacks","at 100",0.2983555,0.2607479,0.3359632,
"Full controls","Ratings about Whites","0 to 24",0.2897018,0.236501,0.3429027,
"Full controls","Ratings about Whites","25 to 49",0.2769997,0.2438245,0.3101748,
"Full controls","Ratings about Whites","at 50",0.1591508,0.1342149,0.1840868,
"Full controls","Ratings about Whites","51 to 85",0.1683675,0.1535977,0.1831373,
"Full controls","Ratings about Whites","86 to 99",0.1099687,0.0934504,0.126487,
"Full controls","Ratings about Whites","at 100",0.1013468,0.0774212,0.1252723)
DATA$GROUP <- factor(DATA$GROUP, levels = unique(DATA$GROUP))
DATA$LEVEL <- factor(DATA$LEVEL, levels = unique(DATA$LEVEL))
DATA.SMALL <- filter(DATA, DATA$CONTROLS == "Small controls")
DATA.FULL <- filter(DATA, DATA$CONTROLS == "Full controls")
theme.z <- theme(
axis.text.x = element_text(size = 15, color = "black", hjust = 0.5 , margin = margin(t = 10,b = 0)),
axis.text.x.top = element_blank(),
axis.text.y = element_text(size = 15, color = "black", hjust = 1 , margin = margin(l = 8,r = 8)),
axis.text.y.right = element_text(size = 15, color = "black", hjust = 0 , margin = margin(l = 8,r = 8)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.background = element_rect(linewidth = 0.5, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA , linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.spacing.x = unit(1, "lines"),
panel.spacing.y = unit(1, "lines"),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12 , hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 10,r = 10,b = 10,l = 10),"pt"),
plot.subtitle = element_text(size = 15 , hjust = 0.5, margin = margin(b = 10)),
plot.title = element_text(size = 18 , hjust = 0.5, margin = margin(t = 0,b = 10), face = "bold"),
strip.background = element_rect(linewidth = 1, color = "black", fill = "black"),
strip.text.x = element_text(size = 16, color = "white", face = "bold", margin = margin(t = 7.5,b = 7.5))
)
plot.SMALL <- ggplot(DATA.SMALL, mapping = aes(x = PE, y = LEVEL)) +
facet_wrap(~GROUP, dir = "v", ncol = 1, scales = "free_y") +
geom_rect(data = filter(DATA.SMALL, GROUP == "Ratings about Blacks") , mapping = aes(xmin = DATA.SMALL$PE[DATA.SMALL$GROUP == "Ratings about Blacks" & DATA.SMALL$LEVEL == "0 to 24"], xmax = DATA.SMALL$PE[DATA.SMALL$GROUP == "Ratings about Blacks" & DATA.SMALL$LEVEL == "at 50"] , ymin = -Inf, ymax = Inf), fill = "red3" , color = "black", inherit.aes = FALSE) +
geom_rect(data = filter(DATA.SMALL, GROUP == "Ratings about Blacks") , mapping = aes(xmin = DATA.SMALL$PE[DATA.SMALL$GROUP == "Ratings about Blacks" & DATA.SMALL$LEVEL == "at 50"] , xmax = DATA.SMALL$PE[DATA.SMALL$GROUP == "Ratings about Blacks" & DATA.SMALL$LEVEL == "at 100"], ymin = -Inf, ymax = Inf), fill = "green3" , color = "black", inherit.aes = FALSE) +
geom_rect(data = filter(DATA.SMALL, GROUP == "Ratings about Whites") , mapping = aes(xmin = DATA.SMALL$PE[DATA.SMALL$GROUP == "Ratings about Whites" & DATA.SMALL$LEVEL == "0 to 24"], xmax = DATA.SMALL$PE[DATA.SMALL$GROUP == "Ratings about Whites" & DATA.SMALL$LEVEL == "at 50"] , ymin = -Inf, ymax = Inf), fill = "red3" , color = "black", inherit.aes = FALSE) +
geom_rect(data = filter(DATA.SMALL, GROUP == "Ratings about Whites") , mapping = aes(xmin = DATA.SMALL$PE[DATA.SMALL$GROUP == "Ratings about Whites" & DATA.SMALL$LEVEL == "at 50"] , xmax = DATA.SMALL$PE[DATA.SMALL$GROUP == "Ratings about Whites" & DATA.SMALL$LEVEL == "at 100"], ymin = -Inf, ymax = Inf), fill = "green3" , color = "black", inherit.aes = FALSE) +
geom_errorbarh(mapping = aes(xmin = CILO, xmax = CIHI), width = 0) +
geom_point(color = "black", size = 3.5) +
scale_x_continuous(limits = c(0,1), expand = c(0,0), breaks = 0.5, labels = "Controls for\ndemographics only") +
scale_y_discrete(position = "left") +
geom_text(x = 0.97, y = DATA.SMALL$LEVEL, size = 5, hjust = 1, label = format(round(DATA.SMALL$PE, 2), nsmall = 0)) +
theme.z
plot.FULL <- ggplot(DATA.FULL, mapping = aes(x = PE, y = LEVEL)) +
facet_wrap(~GROUP, dir = "v", ncol = 1, scales = "free_y") +
geom_rect(data = filter(DATA.FULL, GROUP == "Ratings about Blacks") , mapping = aes(xmin = DATA.FULL$PE[DATA.FULL$GROUP == "Ratings about Blacks" & DATA.FULL$LEVEL == "0 to 24"], xmax = DATA.FULL$PE[DATA.FULL$GROUP == "Ratings about Blacks" & DATA.FULL$LEVEL == "at 50"] , ymin = -Inf, ymax = Inf), fill = "red3" , color = "black", inherit.aes = FALSE) +
geom_rect(data = filter(DATA.FULL, GROUP == "Ratings about Blacks") , mapping = aes(xmin = DATA.FULL$PE[DATA.FULL$GROUP == "Ratings about Blacks" & DATA.FULL$LEVEL == "at 50"] , xmax = DATA.FULL$PE[DATA.FULL$GROUP == "Ratings about Blacks" & DATA.FULL$LEVEL == "at 100"], ymin = -Inf, ymax = Inf), fill = "green3" , color = "black", inherit.aes = FALSE) +
geom_rect(data = filter(DATA.FULL, GROUP == "Ratings about Whites") , mapping = aes(xmin = DATA.FULL$PE[DATA.FULL$GROUP == "Ratings about Whites" & DATA.FULL$LEVEL == "0 to 24"], xmax = DATA.FULL$PE[DATA.FULL$GROUP == "Ratings about Whites" & DATA.FULL$LEVEL == "at 50"] , ymin = -Inf, ymax = Inf), fill = "red3" , color = "black", inherit.aes = FALSE) +
geom_rect(data = filter(DATA.FULL, GROUP == "Ratings about Whites") , mapping = aes(xmin = DATA.FULL$PE[DATA.FULL$GROUP == "Ratings about Whites" & DATA.FULL$LEVEL == "at 50"] , xmax = DATA.FULL$PE[DATA.FULL$GROUP == "Ratings about Whites" & DATA.FULL$LEVEL == "at 100"], ymin = -Inf, ymax = Inf), fill = "green3" , color = "black", inherit.aes = FALSE) +
geom_errorbarh(mapping = aes(xmin = CILO, xmax = CIHI), width = 0) +
geom_point(color = "black", size = 3.5) +
scale_x_continuous(limits = c(0,1), expand = c(0,0), breaks = 0.5, labels = "Controls for demographics,\npartisanship, and ideology") +
scale_y_discrete(position = "right") +
geom_text(x = 0.97, y = DATA.FULL$LEVEL, size = 5, hjust = 1, label = format(round(DATA.FULL$PE, 2), nFULL = 0)) +
theme.z
plot.SMALL + plot.FULL +
plot_annotation(title = "Support for Reparations") & theme(plot.title = element_text(face = "bold", size = 18, hjust = 0.5))Figure
Double plot
Code
library(patchwork)
library(tidyverse)
DATA <- tribble(
~GENDERFAVOR,~GROUP,~PE,~CILO,~CIHI,
"Cold only to women","U.S. residents",0.0385036,0.0340647,0.0434949,
"Cold only to women","Believed Blasey Ford",0.1641699,0.1020244,0.2263155,
"Residual colder to women","U.S. residents",0.1580191,0.1496165,0.166801,
"Residual colder to women","Believed Blasey Ford",0.1979061,0.16163,0.2341823,
"Rated men equal to women","U.S. residents",0.1869231,0.1777329,0.1964749,
"Rated men equal to women","Believed Blasey Ford",0.308813,0.2644603,0.3531658,
"Did not rate men and/or women","U.S. residents",0.1068526,0.097831,0.1165985,
"Did not rate men and/or women","Believed Blasey Ford",0.311967,0.2394761,0.3844578,
"Residual colder to men","U.S. residents",0.3991769,0.3872212,0.4112541,
"Residual colder to men","Believed Blasey Ford",0.3985176,0.3594298,0.4376055,
"Cold only to men","U.S. residents",0.1105247,0.1030948,0.1184195,
"Cold only to men","Believed Blasey Ford",0.5188692,0.4589192,0.5788192)
theme.z <- theme(
axis.text.x = element_text(color = "black", size = 15, margin = margin(t = 5, b = 5)),
axis.text.y = element_text(color = "black", size = 15, margin = margin(l = 0, r = 0)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.position = "none",
panel.background = element_blank(),
panel.border = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.margin = unit(c(t = 10,r = 0,b = 10,l = 0), "pt"))
DATA.DIST <- filter(DATA, GROUP == "U.S. residents")
DATA.DIST$GENDERFAVOR <- factor(DATA.DIST$GENDERFAVOR, levels = unique(DATA.DIST$GENDERFAVOR))
UCM <- DATA$PE[DATA$GROUP == "U.S. residents" & DATA$GENDERFAVOR == "Cold only to men"]
URM <- DATA$PE[DATA$GROUP == "U.S. residents" & DATA$GENDERFAVOR == "Residual colder to men"]
UDN <- DATA$PE[DATA$GROUP == "U.S. residents" & DATA$GENDERFAVOR == "Did not rate men and/or women"]
UEQ <- DATA$PE[DATA$GROUP == "U.S. residents" & DATA$GENDERFAVOR == "Rated men equal to women"]
URW <- DATA$PE[DATA$GROUP == "U.S. residents" & DATA$GENDERFAVOR == "Residual colder to women"]
UCW <- DATA$PE[DATA$GROUP == "U.S. residents" & DATA$GENDERFAVOR == "Cold only to women"]
BREAKS <- c(UCM/2, UCM+URM/2, UCM+URM+UDN/2, UCM+URM+UDN+UEQ/2, UCM+URM+UDN+UEQ+URW/2, UCM+URM+UDN+UEQ+URW+UCW/2)
p1 <- ggplot(DATA.DIST, mapping = aes(y = 100*PE, x = GROUP, fill = GENDERFAVOR)) +
geom_col(color = "black", linewidth = 1.1, width = 1) +
scale_fill_manual(values = c("Cold only to men" = "lightskyblue3", "Residual colder to men" = "powderblue", "Did not rate men and/or women" = "gray90", "Rated men equal to women" = "white", "Residual colder to women" = "lightpink1", "Cold only to women" = "lightpink3"), name = "Category") +
scale_y_continuous(limits = c(0,100.01), breaks = 100*BREAKS, labels=unique(rev(DATA$GENDERFAVOR))) +
scale_x_discrete(position = "top") +
coord_cartesian(clip = "off") +
theme.z
DATA.KF <- filter(DATA, GROUP == "Believed Blasey Ford")
RCM <- DATA$PE[DATA$GROUP == "Republicans" & DATA$GENDERFAVOR == "Cold only to men"]
RRM <- DATA$PE[DATA$GROUP == "Republicans" & DATA$GENDERFAVOR == "Residual colder to men"]
RDN <- DATA$PE[DATA$GROUP == "Republicans" & DATA$GENDERFAVOR == "Did not rate men and/or women"]
REQ <- DATA$PE[DATA$GROUP == "Republicans" & DATA$GENDERFAVOR == "Rated men equal to women"]
RRW <- DATA$PE[DATA$GROUP == "Republicans" & DATA$GENDERFAVOR == "Residual colder to women"]
RCW <- DATA$PE[DATA$GROUP == "Republicans" & DATA$GENDERFAVOR == "Cold only to women"]
p2 <- ggplot(data = DATA.KF, mapping = aes(x = PE, y = rev(BREAKS))) +
geom_segment(mapping = aes(x = 0, y = rev(BREAKS), xend = 1, yend = rev(BREAKS)), color = "gray80") +
geom_point(color = "black", size = 5) +
geom_errorbarh(mapping = aes(xmin = CILO, xmax = CIHI), linewidth = 1.25, height = 0) +
scale_x_continuous(expand = c(0,0), limits = c(0,1), breaks = c(0.5), labels = c("Predicted probability of believing\nBlasey Ford, net of controls"), position = "top") +
scale_y_continuous(limits = c(0,1)) +
theme.z +
theme(
axis.text.y = element_blank(),
plot.margin = unit(c(t = 10, r = 15, b = 10, l = 0), "pt"))
p1 + p2 + plot_layout(ncol = 2, widths = c(1, 1.5))Figure
Grid
Code
Dataset for Grid.csv.
library(patchwork)
library(tidyverse)
DATA <- read_csv("Grid.csv")
print(DATA, n = Inf)## # A tibble: 24 × 10
## FACET THERMO OUTCOME ...4 PE ...6 ...7 ...8 CILO CIHI
## <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 No controls Text … Outcom… 1 0.415 0.219 1.9 0.058 0.112 0.718
## 2 No controls Text … Outcom… 2 0.414 0.0615 6.74 0 0.329 0.499
## 3 No controls Text … Outcom… 3 0.540 0.0622 8.68 0 0.453 0.626
## 4 No controls Text … Outcom… 1 0.0814 0.0315 2.58 0.01 0.0377 0.125
## 5 No controls Text … Outcom… 2 0.500 0.0465 10.8 0 0.436 0.565
## 6 No controls Text … Outcom… 3 0.419 0.0455 9.2 0 0.355 0.482
## 7 No controls Text … Outcom… 1 0.140 0.0180 7.77 0 0.115 0.165
## 8 No controls Text … Outcom… 2 0.0743 0.0447 1.66 0.097 0.0124 0.136
## 9 No controls Text … Outcom… 3 0.481 0.167 2.89 0.004 0.250 0.712
## 10 No controls Text … Outcom… 1 0.163 0.0177 9.24 0 0.139 0.188
## 11 No controls Text … Outcom… 2 0.131 0.0692 1.89 0.059 0.0347 0.226
## 12 No controls Text … Outcom… 3 0.513 0.168 3.06 0.002 0.281 0.746
## 13 Demographic con… Text … Outcom… 1 0.0666 0.0156 4.27 0 0.0450 0.0883
## 14 Demographic con… Text … Outcom… 2 0.583 0.0278 21.0 0 0.545 0.622
## 15 Demographic con… Text … Outcom… 3 0.350 0.0265 13.2 0 0.313 0.387
## 16 Demographic con… Text … Outcom… 1 0.548 0.0760 7.21 0 0.443 0.654
## 17 Demographic con… Text … Outcom… 2 0.531 0.0422 12.6 0 0.472 0.589
## 18 Demographic con… Text … Outcom… 3 0.412 0.0413 9.98 0 0.355 0.469
## 19 Demographic con… Text … Outcom… 1 0.150 0.0761 1.97 0.049 0.0446 0.255
## 20 Demographic con… Text … Outcom… 2 0.199 0.0950 2.1 0.036 0.0674 0.331
## 21 Demographic con… Text … Outcom… 3 0.106 0.0641 1.65 0.098 0.0172 0.195
## 22 Demographic con… Text … Outcom… 1 0.147 0.0236 6.24 0 0.114 0.180
## 23 Demographic con… Text … Outcom… 2 0.106 0.0641 1.65 0.098 0.0172 0.195
## 24 Demographic con… Text … Outcom… 3 0.199 0.0950 2.1 0.036 0.0674 0.331theme.z <- theme(
axis.text.x = element_blank(),
axis.text.x.top = element_blank(),
axis.text.y = element_text(size = 15, color = "black", hjust = 1 , margin = margin(l = 8, r = 8)),
axis.text.y.right = element_text(size = 15, color = "black", hjust = 0 , margin = margin(l = 8, r = 8)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(size = 15, color = "black", hjust = 0.5, margin = margin(t = 8,b = 0)),
axis.title.y = element_blank(),
legend.position = "none",
panel.background = element_rect(linewidth = 0.5, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA , linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.spacing.x = unit(1, "lines"),
panel.spacing.y = unit(1, "lines"),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12 , hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 10,r = 0,b = 10,l = 0),"pt"),
plot.subtitle = element_text(size = 15 , hjust = 0.5, margin = margin(b = 10)),
plot.title = element_text(size = 17 , hjust = 0.5, margin = margin(t = 0,b = 10), face = "bold"),
strip.background = element_rect(linewidth = 1.0, color = "black", fill = "black"),
strip.text.x = element_text(size = 18, color = "white", face = "bold", margin = margin(t = 7.5, b = 7.5, l = 25, r = 25)),
strip.text.y = element_text(size = 18, color = "white", face = "bold", margin = margin(t = 7.5, b = 7.5, l = 7.5, r = 7.5))
)
DATA$FACET <- factor(DATA$FACET , levels = unique(DATA$FACET))
DATA$OUTCOME <- factor(DATA$OUTCOME, levels = unique(DATA$OUTCOME))
DATA$THERMO <- factor(DATA$THERMO , levels = rev(unique(DATA$THERMO)))
DATA.NEGNC <- filter(DATA, OUTCOME == "Outcome 1" & DATA$FACET == "No controls")
DATA.POSNC <- filter(DATA, OUTCOME == "Outcome 2" & DATA$FACET == "No controls")
DATA.NEGPC <- filter(DATA, OUTCOME == "Outcome 1" & DATA$FACET == "Demographic controls")
DATA.POSPC <- filter(DATA, OUTCOME == "Outcome 2" & DATA$FACET == "Demographic controls")
ggplot(DATA, mapping = aes(PE, THERMO)) +
facet_grid(FACET ~ OUTCOME, switch = "y", space = "free_y", scales = "free_y", labeller = labeller(FACET = label_wrap_gen(width = 15), OUTCOME = label_wrap_gen(width = 15))) +
geom_rect(data = DATA.NEGNC, mapping = aes(xmin = min(DATA.NEGNC$PE), xmax = max(DATA.NEGNC$PE), ymin = -Inf, ymax = Inf), color = "black", fill = "lightsteelblue3", inherit.aes = FALSE) +
geom_rect(data = DATA.POSNC, mapping = aes(xmin = min(DATA.POSNC$PE), xmax = max(DATA.POSNC$PE), ymin = -Inf, ymax = Inf), color = "black", fill = "lightsteelblue3", inherit.aes = FALSE) +
geom_rect(data = DATA.NEGPC, mapping = aes(xmin = min(DATA.NEGPC$PE), xmax = max(DATA.NEGPC$PE), ymin = -Inf, ymax = Inf), color = "black", fill = "lightsteelblue3", inherit.aes = FALSE) +
geom_rect(data = DATA.POSPC, mapping = aes(xmin = min(DATA.POSPC$PE), xmax = max(DATA.POSPC$PE), ymin = -Inf, ymax = Inf), color = "black", fill = "lightsteelblue3", inherit.aes = FALSE) +
geom_errorbarh(mapping = aes(xmin = CILO, xmax = CIHI), width = 0, linewidth = 0.5) +
geom_point(size = 4) +
geom_text(x = 0.95, y = DATA$THERMO, size = 5, hjust = 1, label = format(round(DATA$PE, 2), nsmall = 2)) +
scale_x_continuous(breaks = seq(0,1), limits = c(0,1), expand = c(0,0)) +
scale_y_discrete(position = "right") +
labs(x = "Predicted probability") +
theme.zFigure
Ticks
Code
Dataset for Ticks.csv.
library(patchwork)
library(tidyverse)
theme.z <- theme(
axis.text.x = element_text(size = 15, color = "black", hjust = 0.5, margin = margin(t = 8, b = 0)),
axis.text.x.top = element_text(size = 15, color = "black", hjust = 0.5, margin = margin(t = 8, b = 0)),
axis.text.y = element_text(size = 15, color = "black", hjust = 1 , margin = margin(l = 8, r = 8)),
axis.text.y.right = element_text(size = 15, color = "black", hjust = 0 , margin = margin(l = 8, r = 8)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.position = "none",
panel.background = element_blank(),
panel.border = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.spacing.x = unit(2, "lines"),
panel.spacing.y = unit(1, "lines"),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12 , hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 10, r = 5, b = 10, l = 5),"pt"),
plot.subtitle = element_text(size = 15 , hjust = 0.5, margin = margin(b = 10)),
plot.title = element_text(size = 17 , hjust = 0.5, margin = margin(t = 0, b = 10), face = "bold"),
)
DATA <- read_csv("Ticks.csv")
print(DATA, n = Inf)## # A tibble: 35 × 8
## SECTION LABELY GROUP ...4 PE ...6 CILO CIHI
## <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Rated immigrants 0 to 25 Rated 0 t… Rati… 0 0.0841 0.00433 0.0783 0.0903
## 2 Rated immigrants 26 to 49 Rated 26 … Rati… 1 0.104 0.00466 0.0973 0.110
## 3 Rated immigrants at 50 Rated at … Rati… 2 0.0899 0.00420 0.0843 0.0959
## 4 Did not rate immigrants Did not r… Rati… 3 0.0556 0.00384 0.0505 0.0612
## 5 Rated immigrants 51 to 75 Rated 51 … Rati… 4 0.258 0.00641 0.249 0.267
## 6 Rated immigrants 76 to 99 Rated 76 … Rati… 5 0.331 0.00679 0.322 0.341
## 7 Rated immigrants at 100 Rated at … Rati… 6 0.0776 0.00400 0.0722 0.0833
## 8 Rated Whites 0 to 25 Rated 0 t… Rati… 0 0.0550 0.00371 0.0501 0.0604
## 9 Rated Whites 26 to 49 Rated 26 … Rati… 1 0.108 0.00481 0.101 0.115
## 10 Rated Whites at 50 Rated at … Rati… 2 0.107 0.00461 0.101 0.114
## 11 Did not rate Whites Did not r… Rati… 3 0.0390 0.00333 0.0346 0.0439
## 12 Rated Whites 51 to 75 Rated 51 … Rati… 4 0.251 0.00642 0.242 0.260
## 13 Rated Whites 76 to 99 Rated 76 … Rati… 5 0.361 0.00690 0.352 0.371
## 14 Rated Whites at 100 Rated at … Rati… 6 0.0788 0.00396 0.0735 0.0845
## 15 Rated Blacks 0 to 25 Rated 0 t… Rati… 0 0.0562 0.00365 0.0514 0.0615
## 16 Rated Blacks 26 to 49 Rated 26 … Rati… 1 0.0808 0.00421 0.0751 0.0868
## 17 Rated Blacks at 50 Rated at … Rati… 2 0.0846 0.00408 0.0792 0.0905
## 18 Did not rate Blacks Did not r… Rati… 3 0.0383 0.00320 0.0341 0.0430
## 19 Rated Blacks 51 to 75 Rated 51 … Rati… 4 0.239 0.00629 0.230 0.247
## 20 Rated Blacks 76 to 99 Rated 76 … Rati… 5 0.386 0.00710 0.376 0.396
## 21 Rated Blacks at 100 Rated at … Rati… 6 0.115 0.00471 0.109 0.122
## 22 Rated Hispanics 0 to 25 Rated 0 t… Rati… 0 0.0428 0.00310 0.0387 0.0473
## 23 Rated Hispanics 26 to 49 Rated 26 … Rati… 1 0.0755 0.00403 0.0701 0.0812
## 24 Rated Hispanics at 50 Rated at … Rati… 2 0.0859 0.00412 0.0804 0.0918
## 25 Did not rate Hispanics Did not r… Rati… 3 0.0514 0.00369 0.0465 0.0567
## 26 Rated Hispanics 51 to 75 Rated 51 … Rati… 4 0.254 0.00643 0.245 0.263
## 27 Rated Hispanics 76 to 99 Rated 76 … Rati… 5 0.384 0.00709 0.374 0.394
## 28 Rated Hispanics at 100 Rated at … Rati… 6 0.107 0.00460 0.100 0.113
## 29 Rated Asians 0 to 25 Rated 0 t… Rati… 0 0.0403 0.00332 0.0360 0.0452
## 30 Rated Asians 26 to 49 Rated 26 … Rati… 1 0.0738 0.00420 0.0682 0.0799
## 31 Rated Asians at 50 Rated at … Rati… 2 0.0903 0.00417 0.0846 0.0962
## 32 Did not rate Asians Did not r… Rati… 3 0.0594 0.00391 0.0542 0.0651
## 33 Rated Asians 51 to 75 Rated 51 … Rati… 4 0.245 0.00643 0.236 0.254
## 34 Rated Asians 76 to 99 Rated 76 … Rati… 5 0.391 0.00705 0.382 0.401
## 35 Rated Asians at 100 Rated at … Rati… 6 0.0996 0.00435 0.0937 0.106DATA$GROUP <- factor(DATA$GROUP , levels = unique(DATA$GROUP))
DATA$SECTION <- factor(DATA$SECTION, levels = rev(unique(DATA$SECTION)))
LABELS <- c("Ratings about immigrants" = "Ratings\nabout\nimmigrants", "Ratings about Whites" = "Ratings\nabout\nWhites", "Ratings about Blacks" = "Ratings\nabout\nBlacks", "Ratings about Hispanics" = "Ratings\nabout\nHispanics", "Ratings about Asians" = "Ratings\nabout\nAsians")
ggplot(DATA, aes(fill = SECTION, y = 100*PE, x = GROUP)) +
geom_col(color = "black", linewidth = 1, width = 1) +
geom_rect(aes(xmin = 0.5, xmax = 5.5, ymin = 0, ymax = 100), fill = NA, col = "black", linewidth = 1.1) +
scale_fill_manual(values = rep.int(c("green3", "green1", "lightgreen", "white", "gray90", "pink2", "red3"), 8)) +
scale_y_continuous(limits = c(0,100.1), position = "left", breaks = c(4.2,13.6,23.3,30.5,46.2,75.7,96.1), label = unique(DATA$LABELY), expand = c(0,0), sec.axis = sec_axis(~.,breaks = seq(0,100,10), label = c("\u2014", rep.int("\u2013",4),"\u2014", rep.int("\u2013",4),"\u2014"))) +
scale_x_discrete(label = LABELS, expand = c(0,0)) +
theme.z +
theme(plot.margin = unit(c(t = 10, r = 5, b = 15, l = 5), "pt"))Figure
Array
Code
Dataset for Array.csv.
library(patchwork)
library(tidyverse)
DATA <- read_csv("Array.csv")
print(DATA, n = Inf)## # A tibble: 8 × 7
## GROUP PE ...3 ...4 ...5 CILO CIHI
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Rated immigrants cold and at least 25 u… 0.137 0.0554 2.47 0.014 0.0600 0.214
## 2 Rated immigrants cold and at least 5 un… 0.301 0.0594 5.07 0 0.219 0.383
## 3 Rated immigrants cold and colder than e… 0.294 0.0537 5.48 0 0.220 0.369
## 4 Rated immigrants colder than each of WB… 0.370 0.0404 9.16 0 0.314 0.426
## 5 Rated immigrants equal to each of WBHA 0.514 0.0662 7.77 0 0.422 0.605
## 6 Rated immigrants within 5 or fewer unit… 0.552 0.0432 12.8 0 0.492 0.611
## 7 Rated immigrants warm and at least 5 un… 0.768 0.0780 9.84 0 0.660 0.876
## 8 Rated immigrants at 100 but did not rat… 0.763 0.0887 8.6 0 0.640 0.886theme.z <- theme(
axis.text.x = element_blank(),
axis.text.x.top = element_text(size = 15, color = "black", hjust = 1 , margin = margin(t = 8,b = 0)),
axis.text.y = element_text(size = 15, color = "black", hjust = 1 , margin = margin(l = 8,r = 8)),
axis.text.y.right = element_text(size = 15, color = "black", hjust = 0 , margin = margin(l = 8,r = 8)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(size = 15, color = "black", hjust = 0.5, margin = margin(t = 8,b = 0)),
axis.title.y = element_blank(),
legend.position = "none",
panel.background = element_rect(linewidth = 0.5, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA , linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.spacing.x = unit(1, "lines"),
panel.spacing.y = unit(1, "lines"),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12 , hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 10,r = 40,b = 10,l = 0),"pt"),
plot.subtitle = element_text(size = 15 , hjust = 0.5, margin = margin(b = 10)),
plot.title = element_text(size = 17 , hjust = 0.5, margin = margin(t = 0,b = 10), face = "bold"),
strip.background = element_rect(color = "black", fill = "black"),
strip.text.x = element_text(size = 18, color = "white", face = "bold", margin = margin(t = 7.5, b = 7.5))
)
DATA$GROUP <- factor(DATA$GROUP, levels = unique(rev(DATA$GROUP)))
ggplot(DATA, aes(PE, GROUP)) +
geom_rect(data = DATA, aes(xmin = min(DATA$PE), xmax = DATA$PE[DATA$GROUP == "Rated immigrants equal to each of WBHA"], ymin = -Inf, ymax = Inf), color = "black", fill = "red3" , inherit.aes = FALSE) +
geom_rect(data = DATA, aes(xmax = max(DATA$PE), xmin = DATA$PE[DATA$GROUP == "Rated immigrants within 5 or fewer units of each of WBHA"], ymin = -Inf, ymax = Inf), color = "black", fill = "green3", inherit.aes = FALSE) +
geom_errorbarh(aes(xmin = CILO, xmax = CIHI), width = 0, linewidth = 0.5) +
geom_point(size = 4) +
geom_text(x = 1.05, y = DATA$GROUP, size = 5, hjust = 0, label = format(round(DATA$PE, 2), nsmall = 2)) +
coord_cartesian(clip = "off") +
scale_x_continuous(limits = c(0,1), expand = c(0,0)) +
labs(x = "Predicted probability of\nan intended vote\nfor Joe Biden\nover Donald Trump") +
theme.zFigure
DAG
Code
library(ggdag)
library(patchwork)
library(tidyverse)
TOL <- 0.25
theme.z <- theme(
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.title.y.right = element_blank(),
panel.background = element_rect(linewidth = 0.5, color = "black", fill = "gray95", linetype = "solid"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA , linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 14, hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 10,r = 10,b = 10,l = 10),"pt"),
plot.subtitle = element_text(size = 15, hjust = 0.5, margin = margin(t = 0,b = 8)),
plot.title = element_text(size = 20, hjust = 0.5, face = "bold", margin = margin(t = 0,b = 12)))
DAG.COORDS <- list(
x = c(X = 0 , Z = 0.5, Y = 1),
y = c(X = 0 , Z = 1 , Y = 0))
CAPTION.CNF <- str_wrap(width = 42, "Control for Z to help isolate the effect of the \"treatment\" X on Y. Controlling for Z helps get all-else-equal before the \"treatment\" X and the outcome Y.")
CAPTION.COL <- str_wrap(width = 42, "Do not control for Z. Controlling for Z would help get all-else-equal *after* the \"treatment\" X and the outcome Y, but there's no need to do that.")
CAPTION.MED <- str_wrap(width = 42, "To estimate the total effect of X on Y, do not control for Z. Control for Z to isolate the effect of X on Y that does not run through Z.")
CNF <- ggdag(dagify(
Y ~ X,
X ~ Z,
Y ~ Z,
coords = DAG.COORDS
)) +
geom_dag_point(shape = 21, color = "black", fill = "slategray3", stroke = 1.2) +
geom_dag_edges(edge_color = "black", edge_width = 1) +
geom_dag_text(color = "black") +
scale_x_continuous(limits = c(0 - TOL, 1 + TOL)) +
scale_y_continuous(limits = c(0 - TOL, 1 + TOL)) +
labs(title = "Confounder", caption = CAPTION.CNF) + theme.z
COL <- ggdag(dagify(
Y ~ X,
Z ~ X,
Z ~ Y,
coords = DAG.COORDS
)) +
geom_dag_point(shape = 21, color = "black", fill = "slategray3", stroke = 1.2) +
geom_dag_edges(edge_color = "black", edge_width = 1) +
geom_dag_text(color = "black") +
scale_x_continuous(limits = c(0 - TOL, 1 + TOL)) +
scale_y_continuous(limits = c(0 - TOL, 1 + TOL)) +
labs(title = "Collider", caption = CAPTION.COL) + theme.z
MED <- ggdag(dagify(
Y ~ X,
Z ~ X,
Y ~ Z,
coords = DAG.COORDS
)) +
geom_dag_point(shape = 21, color = "black", fill = "slategray3", stroke = 1.2) +
geom_dag_edges(edge_color = "black", edge_width = 1) +
geom_dag_text(color = "black") +
scale_x_continuous(limits = c(0 - TOL, 1 + TOL)) +
scale_y_continuous(limits = c(0 - TOL, 1 + TOL)) +
labs(title = "Mediator", caption = CAPTION.MED) + theme.z
CNF + COL + plot_layout(nrow = 1)Figure
Bars
Code
library(tidyverse)
theme.z <- theme(
axis.text.x = element_text(color = "black", size = 15, margin = margin(t = 8, b = 8)),
axis.text.y = element_text(color = "black", size = 15, margin = margin(l = 8, r = 8)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(color = "black", size = 15),
axis.title.y = element_text(color = "black", size = 15),
legend.position = "none",
panel.background = element_rect(fill = "gray90"),
panel.border = element_rect(color = "black", fill = NA, linewidth = 1.1),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.caption = element_text(size = 12 , hjust = 0, margin = margin(t = 10)),
plot.margin = unit(c(0.5, 0.5, 0.5, 0.5), "cm"),
plot.title = element_text(face = "bold", size = 18, hjust = 0.5,margin = margin(b = 10)))
SAMPLE <- seq(10, 600, 1)
QT <- qt(0.975, SAMPLE - 1)
DATA <- data.frame(SAMPLE, QT)
ggplot(dat = DATA, aes(x = SAMPLE,y = QT)) +
geom_rect(data = DATA, aes(xmin = -Inf, xmax = Inf, ymin = 1.95, ymax = 1.96), fill = "gray85") +
geom_rect(data = DATA, aes(xmin = -Inf, xmax = Inf, ymin = 1.97, ymax = 1.98), fill = "gray85") +
geom_rect(data = DATA, aes(xmin = -Inf, xmax = Inf, ymin = 1.99, ymax = 2.00), fill = "gray85") +
geom_rect(data = DATA, aes(xmin = -Inf, xmax = Inf, ymin = 2.01, ymax = 2.02), fill = "gray85") +
geom_rect(data = DATA, aes(xmin = -Inf, xmax = Inf, ymin = 2.03, ymax = 2.04), fill = "gray85") +
geom_rect(data = DATA, aes(xmin = -Inf, xmax = Inf, ymin = 2.05, ymax = 2.06), fill = "gray85") +
geom_rect(data = DATA, aes(xmin = -Inf, xmax = Inf, ymin = 2.07, ymax = 2.08), fill = "gray85") +
geom_rect(data = DATA, aes(xmin = -Inf, xmax = Inf, ymin = 2.09, ymax = 2.10), fill = "gray85") +
geom_point(size = 1) +
scale_x_continuous(limits = c(0,600), expand = c(0,0), breaks = seq(0,600,50)) +
scale_y_continuous(limits = c(1.95,2.1), breaks = seq(1.95,2.1,0.01), sec.axis = dup_axis()) +
labs(y = "Multiplier", x = "Sample size", title = "Multiplier in a formula for\nthe margin of error for a measurement\nfrom a random sample, at the 95% confidence level") +
theme.zFigure
Arrows
Code
library(patchwork)
library(tidyverse)
theme.z <- theme(
axis.text.x = element_text(size = 15, color = "black", margin = margin(t = 8, b = 8)),
axis.text.y = element_blank(),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.background = element_rect(linewidth = 0.5, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA , linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.spacing.x = unit(2, "lines"),
panel.spacing.y = unit(0, "lines"),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 10, hjust = 0, margin = margin(t = 8)),
plot.margin = unit(c(0.15,0.5,0.15,0.5), "cm"),
plot.subtitle = element_text(size = 15, hjust = 0.5, margin = margin(b = 7)),
plot.title = element_text(size = 20, hjust = 0.5, face = "bold", margin = margin(t = 0, b = 12)),
strip.background = element_rect(linewidth = 1, color = "black", fill = "black"),
strip.text.x = element_text(size = 17, color = "white", face = "bold", margin = margin(t = 7.5, b = 7.5))
)
DATA <- tribble(
~FACET,~X, ~Y,
"Standard deviation of 2.12", -5,1,
"Standard deviation of 2.12", -2,1)
ggplot(data = DATA, aes(x = X, y = Y)) +
facet_wrap(~FACET, ncol = 1, dir = "v", scales = "free") +
geom_curve(data = filter(DATA, FACET == "Standard deviation of 1.41"), aes(x = -5, y = 1, xend = -3.5, yend = 1), size = 1, curvature = -0.30, color = "slategray3") +
geom_curve(data = filter(DATA, FACET == "Standard deviation of 1.41"), aes(x = -3.5, y = 1, xend = -2, yend = 1), size = 1, curvature = -0.30, color = "slategray3") +
geom_point(size = 3.5) +
scale_y_continuous(limits = c(0.5,2.5)) +
scale_x_continuous(breaks = seq(-5,-2,1), limits = c(-5.2,-1.8), labels = scales::number_format(accuracy = 1)) +
theme.zFigure
Back-to-back mixed labels
Code
library(tidyverse)
DATA <- tribble(
~GROUP , ~RESPONSE , ~PE , ~CILO , ~CIHI ,
"Population percentage among Whites" , "Positive", 0.155079 , 0.1383244, 0.1734544,
"Population percentage among Whites" , "Negative", 0.2589341, 0.2385512, 0.2804173,
"Population percentage among Non-Whites", "Positive", 0.2804672, 0.2496833, 0.313461 ,
"Population percentage among Non-Whites", "Negative", 0.0891725, 0.071506 , 0.1106834,
"Predicted probability among Whites" , "Positive", 0.1431506, 0.1234329, 0.1628683,
"Predicted probability among Whites" , "Negative", 0.1780014, 0.1559038, 0.200099 ,
"Predicted probability among Non-Whites", "Positive", 0.2450179, 0.2118295, 0.2782063,
"Predicted probability among Non-Whites", "Negative", 0.0948505, 0.0735427, 0.1161582)
DATA$PE <- ifelse(str_detect(DATA$RESPONSE, "Negative|negative"), DATA$PE * -1, DATA$PE)
DATA$CILO <- ifelse(str_detect(DATA$RESPONSE, "Negative|negative"), DATA$CILO * -1, DATA$CILO)
DATA$CIHI <- ifelse(str_detect(DATA$RESPONSE, "Negative|negative"), DATA$CIHI * -1, DATA$CIHI)
DATA$RESPONSE <- factor(DATA$RESPONSE, levels = unique(DATA$RESPONSE))
DATA$GROUP <- factor(DATA$GROUP , levels = unique(DATA$GROUP))
DATA.NEG <- filter(DATA, DATA$RESPONSE == "Negative")
DATA.POS <- filter(DATA, DATA$RESPONSE == "Positive")
BACKGROUND <- "white"
theme.z <- theme(
axis.text.x = element_text(color = "black", size = 15, margin = margin(t = 0)),
axis.text.y = element_text(color = "black", size = 15, margin = margin(r = -10)),
axis.text.y.right = element_text(color = "black", size = 15, margin = margin(l = 0)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.position = "none",
panel.background = element_rect(fill = BACKGROUND),
panel.border = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.background = element_rect(fill = BACKGROUND),
plot.caption = element_text(size = 11, hjust = 0, margin = margin(15,0,0,0)),
plot.subtitle = element_text(size = 14, hjust = 0.5),
plot.margin = unit(c(t = 0,r = 50,b = 0,l = 15),"pt"),
plot.title = element_text(face = "bold", margin = margin(t = 0, b = 6), size = 20, hjust = 0.5),
plot.title.position = "plot"
)
TOL <- 2
COLOR1 <- "darkseagreen4"
COLOR2 <- "darkseagreen3"
COLOR3 <- "darkseagreen1"
COLOR4 <- "white"
COLOR5 <- "gray90"
COLOR6 <- "indianred2"
COLOR7 <- "indianred4"
DATA.POS <- mutate(DATA.POS, LABELS = ifelse(row_number() <= 2, scales::percent(abs(PE), accuracy = 1L), format(round(abs(PE), 2), nsmall = 2)))
DATA.NEG <- mutate(DATA.NEG, LABELS = ifelse(row_number() <= 2, scales::percent(abs(PE), accuracy = 1L), format(round(abs(PE), 2), nsmall = 2)))
ggplot(DATA, aes(fill = RESPONSE, y = 100*PE, x = GROUP)) +
geom_col( color = "black", linewidth = 0.1 , width = 0.85) +
geom_col(data = DATA.POS, color = "black", fill = NA, linewidth = 1.25, width = 0.85) +
geom_col(data = DATA.NEG, color = "black", fill = NA, linewidth = 1.25, width = 0.85) +
geom_text(data = DATA.POS, mapping = aes(x = GROUP, y = 100*CIHI + TOL, label = LABELS), size = 5, hjust = 0.5, vjust = 0, check_overlap = T) +
geom_text(data = DATA.NEG, mapping = aes(x = GROUP, y = 100*CIHI - TOL, label = LABELS), size = 5, hjust = 0.5, vjust = 1, check_overlap = T) +
geom_errorbar(data = DATA.NEG, aes(ymin = 100*CILO, ymax = 100*CIHI), width = 0.25, linewidth = 0.25) +
geom_errorbar(data = DATA.POS, aes(ymin = 100*CILO, ymax = 100*CIHI), width = 0.25, linewidth = 0.25) +
scale_fill_manual(values = c("Negative" = COLOR6, "Positive" = COLOR1)) +
scale_x_discrete(label = str_wrap(width = 15, unique(DATA$GROUP))) +
scale_y_continuous(limits = c(-32,40), breaks = 100 * c(DATA$PE[DATA$GROUP == "Population percentage among Whites" & DATA$RESPONSE == "Positive"] / 2, DATA$PE[DATA$GROUP == "Population percentage among Whites" & DATA$RESPONSE == "Negative"] / 2), label = c("Positive", "Negative")) +
coord_cartesian(clip = "off") +
theme.zFigure
Illustration of statistical control
Code
library(tidyverse)
library(patchwork)
DATA <- tribble(
~CONSERVATIVE, ~GOTMARRIED, ~AGE,
5, 1, "Old" ,
5, 0, "Old" ,
4.5, 0, "Old" ,
4, 0, "Old" ,
1, 0, "Young",
1, 1, "Young",
1.5, 1, "Young",
2, 1, "Young")
theme.z <- theme(
axis.text.x = element_text(size = 15 , color = "black", margin = margin(t = 7, b = 7)),
axis.text.y = element_text(size = 15 , color = "black", margin = margin(l = 7, r = 7)),
axis.text.y.right = element_text(size = 15 , color = "black", margin = margin(l = 7, r = 7)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(size = 15 , color = "black", margin = margin(t = 7, r = 7, b = 7, l = 7)),
axis.title.y = element_text(size = 15 , color = "black", margin = margin(t = 7, r = 7, b = 7, l = 7)),
axis.title.y.right = element_text(size = 15 , color = "black", margin = margin(t = 7, r = 7, b = 7, l = 7)),
legend.position = "none",
panel.background = element_rect(size = 0.5, color = "black", fill = "white", linetype = "solid"),
panel.border = element_rect(size = 1.0, color = "black", fill = NA , linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.background = element_rect(fill = "white"),
plot.margin = unit(c(t = 5, r = 5, b = 5, l = 5),"pt"),
plot.title = element_text(size = 20, hjust = 0.5, face = "bold", margin = margin(t = 0,b = 12))
)
p1 <- ggplot(data = DATA, aes(x = GOTMARRIED, y = CONSERVATIVE)) +
scale_x_continuous(name = "Recently married?" , limits = c(-0.1,1.1), breaks = seq(0,1,1), labels = c("No", "Yes")) +
scale_y_continuous(name = "Conservatism", limits = c( 0.9,5.1), breaks = seq(1,5,1), sec.axis = dup_axis()) +
geom_smooth(data = DATA, formula = y ~ x, method = "lm", se = FALSE, fullrange = TRUE, color = "lightblue", linewidth = 1.2) +
annotate("text", x = DATA$GOTMARRIED, y = DATA$CONSERVATIVE, size = 6, hjust = 0.5, vjust = 0.5, label = DATA$AGE) +
labs(title = "Not controlling for age") +
theme.z + theme(axis.text.y.right = element_blank(), axis.title.y.right = element_blank())
p2 <- ggplot(data = DATA, aes(x = GOTMARRIED, y = CONSERVATIVE)) +
scale_x_continuous(name = "Recently married?" , limits = c(-0.1,1.1), breaks = seq(0,1,1), labels = c("No", "Yes")) +
scale_y_continuous(name = "Conservatism", limits = c( 0.9,5.1), breaks = seq(1,5,1), sec.axis = dup_axis()) +
geom_smooth(data = subset(DATA, AGE == "Old"), formula = y ~ x, method = "lm", se = FALSE, fullrange = TRUE, color = "lightblue", linewidth = 1.2) +
geom_smooth(data = subset(DATA, AGE == "Young"), formula = y ~ x, method = "lm", se = FALSE, fullrange = TRUE, color = "lightblue", linewidth = 1.2) +
annotate("text", x = DATA$GOTMARRIED, y = DATA$CONSERVATIVE, size = 6, hjust = 0.5, vjust = 0.5, label = DATA$AGE) +
labs(title = "Controlling for age") +
theme.z + theme(axis.text.y = element_blank(), axis.title.y = element_blank())
p1 + p2summary(lm(data = DATA, CONSERVATIVE ~ GOTMARRIED))##
## Call:
## lm(formula = CONSERVATIVE ~ GOTMARRIED, data = DATA)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.625 -1.000 0.000 1.000 2.625
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.6250 0.8985 4.035 0.00685 **
## GOTMARRIED -1.2500 1.2707 -0.984 0.36323
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.797 on 6 degrees of freedom
## Multiple R-squared: 0.1389, Adjusted R-squared: -0.00463
## F-statistic: 0.9677 on 1 and 6 DF, p-value: 0.3632summary(lm(data = DATA, CONSERVATIVE ~ GOTMARRIED + AGE))##
## Call:
## lm(formula = CONSERVATIVE ~ GOTMARRIED + AGE, data = DATA)
##
## Residuals:
## 1 2 3 4 5 6 7
## -1.166e-15 5.000e-01 1.083e-15 -5.000e-01 -1.054e-15 -5.000e-01 3.894e-16
## 8
## 5.000e-01
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.5000 0.2415 18.632 8.2e-06 ***
## GOTMARRIED 0.5000 0.3651 1.369 0.229205
## AGEYoung -3.5000 0.3651 -9.585 0.000209 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4472 on 5 degrees of freedom
## Multiple R-squared: 0.9556, Adjusted R-squared: 0.9378
## F-statistic: 53.75 on 2 and 5 DF, p-value: 0.0004164Figure
Scatterplot with an outlier
Code
library(tidyverse)
DATA <- tribble(
~COUNTRY,~GDPPC,~POLITY,
"UZB",6998.71,-9,
"CHN",16116.7,-7,
"DRV",8041.18,-7,
"BNG",4753.73,-6,
"KZK",26351.44,-6,
"EGY",11763.25,-4,
"MOR",7514.72,-4,
"TUR",28167.4,-4,
"JOR",9906.05,-3,
"TAJ",3379.75,-3,
"THI",18463.09,-3,
"SIN",97341.47,-2,
"ETH",2219.71,1,
"RUS",27043.94,4,
"UKR",12810.29,4,
"ZIM",2835.95,4,
"ECU",11375.33,5,
"IRQ",10881.17,6,
"LEB",14717.35,6,
"NIC",5407.1,6,
"ARM",13653.75,7,
"BOL",8724.48,7,
"COL",14730.88,7,
"MAL",28350.59,7,
"NIG",5135.5,7,
"PAK",4690.48,7,
"TUN",10755.58,7,
"BRA",14651.62,8,
"GUA",8637.56,8,
"KYR",5253.1,8,
"MEX",19746.44,8,
"MYA",5142.15,8,
"PHI",8908.18,8,
"ROK",42661.17,8,
"SRB",18179.77,8,
"UKG",46699.3,8,
"USA",62682.8,8,
"ARG",22033.95,9,
"CZR",40314.23,9,
"IND",6754.29,9,
"INS",11812.2,9,
"KEN",4329.87,9,
"PER",12847.89,9,
"ROM",29908.98,9,
"AUL",49756.31,10,
"CAN",49031.38,10,
"CHL",24226.15,10,
"CYP",39544.68,10,
"GMY",53815.37,10,
"GRC",30314.57,10,
"JPN",41429.29,10,
"MNG",12309.77,10,
"NEW",42887.52,10,
"NTH",57141.37,10,
"SLO",32792.56,10,
"URU",21561.06,10
)
theme.z <- theme(
axis.text.x = element_text(size = 15, color = "black", hjust = 0.5, margin = margin(t = 8, b = 0)),
axis.text.y = element_text(size = 15, color = "black", vjust = 0.5, margin = margin(r = 7, l = 7)),
axis.text.y.right = element_text(size = 15, color = "black", vjust = 0.5, margin = margin(r = 7, l = 7)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(size = 15, color = "black", hjust = 0.5, margin = margin(t = 8, b = 8)),
axis.title.y = element_text(size = 15, color = "black", hjust = 1 , vjust = 0.5, margin = margin(l = 8, r = 8), angle = 0),
axis.title.y.right = element_blank(),
panel.background = element_rect(linewidth = 0.5, fill = "gray90"),
panel.border = element_rect(linewidth = 1.0, fill = NA ),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12, hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 10, r = 10, b = 10, l = 10),"pt"),
plot.subtitle = element_text(size = 15, hjust = 0.5, margin = margin(t = 0, b = 8)),
plot.title = element_text(size = 20, hjust = 0.5, margin = margin(t = 0, b = 16), face = "bold")
)
ggplot(data = DATA, mapping = aes(y = GDPPC, x = POLITY)) +
geom_point(size = 3, color = "dodgerblue") +
geom_smooth(method = "lm", color = "black", se = FALSE, fullrange = TRUE) +
scale_x_continuous(limits = c(-10,10), breaks = seq(-10,10,5)) +
scale_y_continuous(limits = c(-5000,105000), breaks = seq(0,100000,20000), labels = scales::dollar_format(prefix = "$"), expand = c(0,0)) +
labs(x = "Polity score", y = "GDP per capita") +
theme.zFigure
Change font
Code
library(showtext)
library(tidyverse)
showtext_auto()
font_add_google("Roboto Mono")
FONT <- "Roboto Mono"
DATA <- tribble (~POLINT,~VOTE,
0,0.1,
0,0.2,
0,0.3,
1,0.1,
1,0.2,
1,0.3,
2,0.1,
2,0.2,
2,0.3,
3,0.8,
3,0.7,
3,0.9,
4,0.7,
4,0.8,
4,0.9,
5,0.7,
5,0.8,
5,0.9,
)
theme.z <- theme(
axis.text.x = element_text(size = 15, color = "black", hjust = 0.5, margin = margin(t = 8, b = 2)),
axis.text.y = element_text(size = 15, color = "black", vjust = 0.5, margin = margin(r = 7, l = 7)),
axis.text.y.right = element_text(size = 15, color = "black", vjust = 0.5, margin = margin(r = 7, l = 7)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(size = 15, color = "black", hjust = 0.5, margin = margin(t = 2, b = 2)),
axis.title.y = element_text(size = 15, color = "black", vjust = 0.5, margin = margin(r = 6, l = 6), angle = 0),
axis.title.y.right = element_blank(),
panel.background = element_rect(linewidth = 0.5, fill = "white"),
panel.border = element_rect(linewidth = 1.0, fill = NA ),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12, hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 10, r = 10, b = 10, l = 10),"pt"),
plot.subtitle = element_text(size = 15, hjust = 0.5, margin = margin(t = 0, b = 8)),
plot.title = element_text(size = 20, hjust = 0.5, margin = margin(t = 0, b = 16), face = "bold"),
text = element_text(family = FONT, lineheight = 0.9)
)
summary(lm(VOTE ~ POLINT, data = DATA))##
## Call:
## lm(formula = VOTE ~ POLINT, data = DATA)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.3229 -0.1136 0.0000 0.1136 0.3229
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.11429 0.07315 1.562 0.138
## POLINT 0.15429 0.02416 6.386 9.02e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1751 on 16 degrees of freedom
## Multiple R-squared: 0.7182, Adjusted R-squared: 0.7006
## F-statistic: 40.78 on 1 and 16 DF, p-value: 9.018e-06ggplot(data = DATA, mapping = aes(x = POLINT, y = VOTE)) +
geom_point(size = 3, color = "gray70") +
geom_smooth(method = "lm", color = "black", se = FALSE, fullrange = TRUE) +
scale_x_continuous(limits = c(0,5), breaks = seq(0,5,1), labels = c("0\nVery\nLow","1","2","3","4","5\nVery\nhigh")) +
scale_y_continuous(limits = c(-0.1,1.1), breaks = seq(0,1,0.25), expand = c(0,0), sec.axis = dup_axis()) +
labs(x = "Political interest", y = "Probability\nof voting") +
theme.z Figure
Dot plot
Code
library(tidyverse)
DATA <- tribble(
~PID , ~PE , ~CILO , ~CIHI ,
"Strong Democrat" , 0.4445886, 0.4089648, 0.4802125,
"Not strong Democrat" , 0.2726622, 0.2290617, 0.3162628,
"Independent Democrat" , 0.2509012, 0.218784 , 0.2830185,
"Independent" , 0.2135729, 0.1755062, 0.2516396,
"Independent Republican", 0.2633814, 0.218896 , 0.3078668,
"Not strong Republican" , 0.2074255, 0.1671848, 0.2476663,
"Strong Republican" , 0.3374613, 0.308117 , 0.3668057)
DATA$PID <- factor(DATA$PID, levels = rev(DATA$PID))
CAPTION <- str_wrap(width = 60, "Note: Error bars are 83.4% confidence intervals. Estimates are from a logit regression, with weights applied and with categorical controls for gender, race, age group, education, marital status, household income, and gun ownership set at their means. Data source: American National Election Studies 2020 Time Series Study (2021).")
TITLE <- str_wrap(width = 40, "Predicted probability of responding \"extremely important\" about how important the respondent considers the issue of the federal gun laws")
theme.z <- theme(
axis.text.x = element_blank(),
axis.text.y = element_text(size = 15, color = "black", hjust = 1, margin = margin(l = 8,r = 8)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.background = element_rect(linewidth = 0.5, color = "black", fill = "white", linetype = "solid"),
panel.border = element_rect(linewidth = 1.0, color = "black", fill = NA , linetype = "solid"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(color = "grey90"),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12 , hjust = 0 , margin = margin(t = 10)),
plot.margin = unit(c(t = 10,r = 50,b = 10,l = 10),"pt"),
plot.subtitle = element_text(size = 15 , hjust = 0.5, margin = margin(b = 10)),
plot.title = element_text(size = 17 , hjust = 0.5, margin = margin(t = 0,b = 15), face = "bold")
)
ggplot(data = DATA, mapping = aes(x = PE, y = reorder(PID, -PE))) +
coord_cartesian(clip = "off") +
geom_point(color = "black", size = 4) +
geom_errorbarh(mapping = aes(xmin = CILO, xmax = CIHI), linewidth = 1.25, width = 0) +
scale_x_continuous(expand = c(0,0), limits = c(0,1), sec.axis = (dup_axis())) +
scale_y_discrete() +
geom_text(x = 1.025, y = DATA$PID, size = 5, hjust = 0, label = format(round(DATA$PE, 2), nsmall = 2)) +
labs(title = TITLE, caption = CAPTION) +
theme.zFigure
Ridge plot
Code
library(ggridges)
library(haven)
library(tidyverse)
DATA <- read_dta("anes_timeseries_cdf_stata_20260205.dta")
DATA <- mutate(DATA, FTSCOTUS = replace(VCF9005, VCF9005 < 0, NA))
DATA <- mutate(DATA, YEAR = factor(replace(VCF0004, VCF0004 < 2000, NA)))
DATA <- filter(DATA, !is.na(FTSCOTUS), !is.na(YEAR))
theme.z <- theme(
axis.text.x.bottom = element_text(size = 15, color = "black", hjust = 0.5, vjust = 1 , margin = margin(t = 8, r = 5, b = 5, l = 5)),
axis.text.x.top = element_text(size = 15, color = "black", hjust = 0.5, vjust = 0 , margin = margin(t = 5, r = 5, b = 5, l = 5)),
axis.text.y.left = element_text(size = 15, color = "black", hjust = 1 , vjust = 0.5, margin = margin(t = 5, r = 8, b = 5, l = 5)),
axis.text.y.right = element_text(size = 15, color = "black", hjust = 0 , vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5)),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(size = 15, color = "black", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5)),
axis.title.y = element_blank(),
axis.title.y.right = element_text(size = 15, color = "black", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5), angle = 0),
legend.position = "none",
panel.background = element_rect(linewidth = 0.5, color = "black", linetype = "solid", fill = "gray90"),
panel.border = element_rect(linewidth = 1.0, color = "black", linetype = "solid", fill = NA),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.spacing.x = unit(1, "lines"),
panel.spacing.y = unit(1, "lines"),
plot.background = element_rect(fill = "white"),
plot.caption = element_text(size = 12, color = "black", hjust = 0, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5)),
plot.margin = unit(c(t = 10, r = 10, b = 10, l = 10), "pt"),
plot.subtitle = element_text(size = 15, color = "black", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5)),
plot.title = element_text(size = 20, color = "black", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5), face = "bold"),
strip.background = element_rect(linewidth = 1, color = "black", linetype = "solid", fill = "black"),
strip.text.x = element_text(size = 18, color = "white", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5), face = "bold"),
strip.text.y = element_text(size = 18, color = "white", hjust = 0.5, vjust = 0.5, margin = margin(t = 5, r = 5, b = 5, l = 5), face = "bold")
)
ggplot(DATA, aes(x = FTSCOTUS, y = YEAR, fill = after_stat(x >= 50 ))) +
stat_density_ridges(geom = "density_ridges_gradient", calc_ecdf = TRUE, scale = 1.6, linewidth = 1, rel_min_height = 0.01) +
scale_fill_manual(values = c("red3", "green4")) +
scale_x_continuous(expand = c(0, 0)) +
scale_y_discrete(limits = rev, expand = expansion(mult = c(0.05, 0.22))) +
labs(x = "Ratings about the U.S. Supreme Court") +
theme.zFigure
