R Gallery
L.J Zigerell
2024-01-14
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.
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)
ggplot(data = DATA, aes(x = X, y = PE)) +
geom_rect(data = DATA, aes(xmin = -Inf, xmax = Inf, ymin = min(PE), ymax = max(PE)), fill = "lightsteelblue3", col = "black") +
geom_errorbar(aes(ymin = CILO, ymax = CIHI), width = 0, size = 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 = "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.") +
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(size = 0.5, fill = "gray90"),
panel.border = element_rect(size = 1.8, 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")
)Figure
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))
ggplot(DATA, 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(aes(xmin = CILO, xmax = CIHI), height = 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 = "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/.") +
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(size = 0.5, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(size = 1.8, 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")
)Figure
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("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.", width = 97)
ggplot(data = DATA, aes(x = PE, y = TARGET)) +
facet_wrap(~RESPONDENTS, nrow = 2, dir = "v") +
geom_rect(data = filter(DATA, RESPONDENTS == "White respondents") ,
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") ,
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"),
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") ,
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(aes(xmin = CILO, xmax = CIHI), height = 0, size = 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(
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(size = 0.5, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(size = 1.5, 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(color = "black", fill = "black"),
strip.text.x = element_text(size = 17, color = "white", face = "bold", margin = margin(t = 7.5,b = 7.5))
)Figure
Estimates plot: 83.4% and 95% confidence intervals
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 >50 lower than Blacks on 0-to-100 thermo (N = 13)" ,-0.5,-0.7851077,-0.2148923,-0.9229777,-0.0770223,
"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)
ggplot(DATA, aes(100*PE, GROUP)) +
geom_rect(aes(xmin = 0, xmax = Inf, ymin = -Inf, ymax = Inf), color = "black", fill = "slategray3") +
geom_errorbarh(aes(xmin = 100*CILO95, xmax = 100*CIHI95), height = 0, size = 0.5, color = "gray60") +
geom_errorbarh(aes(xmin = 100*CILO83, xmax = 100*CIHI83), height = 0, size = 1.5) +
geom_point(shape = 21, color = "black", fill = "slategray3", size = 4, stroke = 2) +
scale_x_continuous(name = "", breaks = seq(-100,20,20), limits = c(-100,20), labels = scales::number_format(accuracy = 1)) +
geom_text(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 = "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") +
theme(
plot.background = element_rect(fill = "white"),
strip.background = element_rect(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", size = 0.5, linetype = "solid"),
panel.border = element_rect(fill = NA, color = "black", linetype = "solid", size = 1.5),
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)
)Figure
Estimates plot: Comparison with shaded error bars
Code
library(tidyverse)
library(stringr)
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("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.", width = 95, indent = 0, exdent = 0)
ggplot(DATA, aes(color = RESPONSE, x = 100*PE, y = GROUP)) +
geom_errorbarh(aes(xmin = 0, xmax = 100), height = 0, size = 10, color = "gray80", alpha = 0.5) +
geom_errorbarh(aes(xmin = 100*(CILO), xmax = 100*(CIHI)), height = 0, size = 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(
axis.text.x = element_text(color = "black", size = 15, margin = margin(t = 5)),
axis.text.y = element_text(color = "black", size = 15, margin = margin(r = 5)),
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", size = 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", size = 1.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(),
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)
)Figure
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("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).", width = 135)
TITLE <- c("Predicted probability of responding \"extremely important\" about\nhow important the respondent considers the issue of the federal gun laws")
ggplot(data = DATA, aes(x = PID, y = PE)) +
geom_col(color = "black", fill = c(rep_len("blue3",2), rep_len("gray50",3), rep_len("red3",2)),
size = 1.1, width = 0.8) +
geom_text(aes(y = CIHI, label = scales::percent(PE, accuracy = 1L)), size = 5, hjust = 0.5, vjust = -1) +
geom_errorbar(aes(ymin = CILO, ymax = CIHI), size = 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(
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(size = 0.5, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(size = 1.8, 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")
)Figure
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]))
ggplot(DATA, aes(fill = RESPONSE, y = 100*PE, x = GROUP)) +
geom_col(color = "black", size = 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 = "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.") +
coord_cartesian(clip = "off") +
geom_errorbar(aes(ymin = 100*(CILO.STACK), ymax = 100*(CIHI.STACK)), width = 0.5, size = 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(
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)
)Figure
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.
library(tidyverse)
DATA <- read.csv("Figure 9.csv", header = TRUE)
print.data.frame(DATA)## FACET LEVEL PE CILO CIHI
## 1 Con Uniform 0 -0.1716701 -0.2358646 -0.1074756
## 2 Con Uniform 1 -0.1374527 -0.1905335 -0.0843719
## 3 Con Uniform 2 -0.1032353 -0.1459668 -0.0605037
## 4 Con Uniform 3 -0.0690179 -0.1028733 -0.0351624
## 5 Con Uniform 4 -0.0348004 -0.0626964 -0.0069045
## 6 Con Uniform 5 -0.0005830 -0.0274524 0.0262864
## 7 Con Uniform 6 0.0336344 0.0023689 0.0648999
## 8 Con Uniform 7 0.0678518 0.0285468 0.1071569
## 9 Con Uniform 8 0.1020692 0.0528348 0.1513037
## 10 Con Relaxed 0 -0.0413856 -0.1948849 0.1121136
## 11 Con Relaxed 1 -0.0476503 -0.1560208 0.0607201
## 12 Con Relaxed 2 -0.1752731 -0.2587704 -0.0917758
## 13 Con Relaxed 3 -0.1116394 -0.1980303 -0.0252486
## 14 Con Relaxed 4 0.0803306 0.0116931 0.1489681
## 15 Con Relaxed 5 -0.1039068 -0.1662022 -0.0416114
## 16 Con Relaxed 6 -0.1302278 -0.1938939 -0.0665616
## 17 Con Relaxed 7 0.1961307 0.1233010 0.2689605
## 18 Con Relaxed 8 0.2203642 0.1330209 0.3077075
## 19 Lib Uniform 0 0.1005311 0.0394699 0.1615924
## 20 Lib Uniform 1 0.0899358 0.0393815 0.1404902
## 21 Lib Uniform 2 0.0793405 0.0385271 0.1201539
## 22 Lib Uniform 3 0.0687452 0.0362113 0.1012792
## 23 Lib Uniform 4 0.0581499 0.0310591 0.0852408
## 24 Lib Uniform 5 0.0475546 0.0212468 0.0738625
## 25 Lib Uniform 6 0.0369593 0.0064139 0.0675048
## 26 Lib Uniform 7 0.0263640 -0.0118024 0.0645304
## 27 Lib Uniform 8 0.0157687 -0.0318029 0.0633404
## 28 Lib Relaxed 0 0.0425576 -0.0991554 0.1842707
## 29 Lib Relaxed 1 0.2178386 0.1118309 0.3238463
## 30 Lib Relaxed 2 0.0411394 -0.0413242 0.1236030
## 31 Lib Relaxed 3 -0.0296913 -0.1040937 0.0447112
## 32 Lib Relaxed 4 0.0901442 0.0238180 0.1564705
## 33 Lib Relaxed 5 -0.0048506 -0.0732166 0.0635155
## 34 Lib Relaxed 6 0.0707968 0.0075095 0.1340841
## 35 Lib Relaxed 7 0.0869220 0.0143717 0.1594723
## 36 Lib Relaxed 8 -0.0301864 -0.1094644 0.0490915DATA$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("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.", width = 110)
ggplot(data = DATA, 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(aes(ymin = CILO, ymax = CIHI), size = 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, aes(x = 2.25, y = 0.3, label = label), size = 5, hjust = 0, lineheight = 0.9) +
geom_curve(data = filter(DATA, FACET == "Con Uniform"), 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"), 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"), 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"), 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(
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(size = 0.5, color = "black", fill = "gray95", linetype = "solid"),
panel.border = element_rect(size = 1.8, 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(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))
)Figure
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.
library(tidyverse)
DATA <- read.csv("Figure 4.CSV", header = TRUE)
print.data.frame(DATA)## FACET LEVEL PE CILO CIHI
## 1 Republicans 1 0.3672160 0.3419082 0.3925238
## 2 Republicans 2 0.3713766 0.3499915 0.3927618
## 3 Republicans 3 0.3755564 0.3576995 0.3934134
## 4 Republicans 4 0.3797549 0.3647044 0.3948054
## 5 Republicans 5 0.3839714 0.3704956 0.3974472
## 6 Republicans 6 0.3882054 0.3745900 0.4018209
## 7 Republicans 7 0.3924564 0.3769948 0.4079181
## 8 Republicans 8 0.3967238 0.3781825 0.4152650
## 9 Republicans 9 0.4010069 0.3786333 0.4233804
## 10 Republicans 10 0.4053052 0.3786512 0.4319591
## 11 McConnell 1 0.1295117 0.1150420 0.1439814
## 12 McConnell 2 0.1287535 0.1164570 0.1410500
## 13 McConnell 3 0.1279991 0.1175854 0.1384129
## 14 McConnell 4 0.1272485 0.1182675 0.1362295
## 15 McConnell 5 0.1265016 0.1182915 0.1347118
## 16 McConnell 6 0.1257585 0.1174965 0.1340206
## 17 McConnell 7 0.1250192 0.1159195 0.1341188
## 18 McConnell 8 0.1242835 0.1137659 0.1348011
## 19 McConnell 9 0.1235516 0.1112512 0.1358520
## 20 McConnell 10 0.1228234 0.1085249 0.1371219
## 21 Ryan 1 0.2385250 0.2192505 0.2577996
## 22 Ryan 2 0.2421514 0.2257130 0.2585898
## 23 Ryan 3 0.2458152 0.2319196 0.2597107
## 24 Ryan 4 0.2495161 0.2376083 0.2614238
## 25 Ryan 5 0.2532540 0.2423883 0.2641197
## 26 Ryan 6 0.2570287 0.2459099 0.2681476
## 27 Ryan 7 0.2608401 0.2481814 0.2734987
## 28 Ryan 8 0.2646878 0.2495331 0.2798425
## 29 Ryan 9 0.2685717 0.2503050 0.2868384
## 30 Ryan 10 0.2724914 0.2507190 0.2942638
## 31 Trump 1 0.2705398 0.2458661 0.2952134
## 32 Trump 2 0.2960968 0.2740953 0.3180983
## 33 Trump 3 0.3229991 0.3037549 0.3422433
## 34 Trump 4 0.3511265 0.3343271 0.3679258
## 35 Trump 5 0.3803271 0.3650196 0.3956346
## 36 Trump 6 0.4104202 0.3949442 0.4258963
## 37 Trump 7 0.4411991 0.4236746 0.4587236
## 38 Trump 8 0.4724366 0.4514285 0.4934447
## 39 Trump 9 0.5038914 0.4785865 0.5291963
## 40 Trump 10 0.5353154 0.5053835 0.5652474DATA$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("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.", width = 137)
ggplot(data = DATA, 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"), 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"), 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"), 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"), 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(size = 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,0.25),
labels = scales::number_format(accuracy = 0.01), sec.axis = dup_axis()) +
labs(title = "Predicted probability of a favorable rating about...", caption = CAPTION) +
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 = 18, color = "black", margin = margin(t = 7,r = 7,b = 7,l = 7)),
axis.title.y = element_blank(),
legend.position = "none",
panel.background = element_rect(size = 0.5, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(size = 1.8, 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(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))
)Figure
Estimates plot: Combined with Patchwork
Code
DATA <- read.csv("Rights of Man Means.csv")
print.data.frame(DATA)## LIBERT STUDY GENDER
## 1 6 Study 1 Women's reproductive autonomy
## 2 6 Study 1 Women's reproductive autonomy
## 3 6 Study 1 Women's reproductive autonomy
## 4 6 Study 1 Men's reproductive autonomy
## 5 6 Study 1 Men's reproductive autonomy
## 6 6 Study 1 Men's reproductive autonomy
## 7 6 Study 1 Men's reproductive autonomy
## 8 6 Study 2 Women's reproductive autonomy
## 9 6 Study 2 Women's reproductive autonomy
## 10 6 Study 2 Women's reproductive autonomy
## 11 6 Study 2 Men's reproductive autonomy
## 12 6 Study 2 Men's reproductive autonomy
## 13 6 Study 2 Men's reproductive autonomy
## 14 6 Study 2 Men's reproductive autonomy
## 15 6 Pooled Women's reproductive autonomy
## 16 6 Pooled Women's reproductive autonomy
## 17 6 Pooled Women's reproductive autonomy
## 18 6 Pooled Men's reproductive autonomy
## 19 6 Pooled Men's reproductive autonomy
## 20 6 Pooled Men's reproductive autonomy
## 21 6 Pooled Men's reproductive autonomy
## 22 56 Study 1 Women's reproductive autonomy
## 23 56 Study 1 Women's reproductive autonomy
## 24 56 Study 1 Women's reproductive autonomy
## 25 56 Study 1 Men's reproductive autonomy
## 26 56 Study 1 Men's reproductive autonomy
## 27 56 Study 1 Men's reproductive autonomy
## 28 56 Study 1 Men's reproductive autonomy
## 29 56 Study 2 Women's reproductive autonomy
## 30 56 Study 2 Women's reproductive autonomy
## 31 56 Study 2 Women's reproductive autonomy
## 32 56 Study 2 Men's reproductive autonomy
## 33 56 Study 2 Men's reproductive autonomy
## 34 56 Study 2 Men's reproductive autonomy
## 35 56 Study 2 Men's reproductive autonomy
## 36 56 Pooled Women's reproductive autonomy
## 37 56 Pooled Women's reproductive autonomy
## 38 56 Pooled Women's reproductive autonomy
## 39 56 Pooled Men's reproductive autonomy
## 40 56 Pooled Men's reproductive autonomy
## 41 56 Pooled Men's reproductive autonomy
## 42 56 Pooled Men's reproductive autonomy
## 43 456 Study 1 Women's reproductive autonomy
## 44 456 Study 1 Women's reproductive autonomy
## 45 456 Study 1 Women's reproductive autonomy
## 46 456 Study 1 Men's reproductive autonomy
## 47 456 Study 1 Men's reproductive autonomy
## 48 456 Study 1 Men's reproductive autonomy
## 49 456 Study 1 Men's reproductive autonomy
## 50 456 Study 2 Women's reproductive autonomy
## 51 456 Study 2 Women's reproductive autonomy
## 52 456 Study 2 Women's reproductive autonomy
## 53 456 Study 2 Men's reproductive autonomy
## 54 456 Study 2 Men's reproductive autonomy
## 55 456 Study 2 Men's reproductive autonomy
## 56 456 Study 2 Men's reproductive autonomy
## 57 456 Pooled Women's reproductive autonomy
## 58 456 Pooled Women's reproductive autonomy
## 59 456 Pooled Women's reproductive autonomy
## 60 456 Pooled Men's reproductive autonomy
## 61 456 Pooled Men's reproductive autonomy
## 62 456 Pooled Men's reproductive autonomy
## 63 456 Pooled Men's reproductive autonomy
## ITEM ORIGINAL PE
## 1 Low income family can't afford any more children ABscale_5x 0.5210000
## 2 Single woman doesn't want to marry the man ABscale_7x 0.5460000
## 3 Married woman doesn't want any more children ABscale_3x 0.5210000
## 4 Fairer if men needed to consent to abortion FinAb_2x 0.6240000
## 5 Men don't have enough say during pregnancy FinAb_4x 0.6240000
## 6 Man involved should have a veto over the abortion FinAb_3x 0.5880000
## 7 Father's financial support shouldn't be obligated FinAb_1x 0.4710000
## 8 Low income family can't afford any more children ABscale_5x 0.5080000
## 9 Single woman doesn't want to marry the man ABscale_7x 0.4520000
## 10 Married woman doesn't want any more children ABscale_3x 0.4680000
## 11 Fairer if men needed to consent to abortion FinAb_2x 0.6110000
## 12 Men don't have enough say during pregnancy FinAb_4x 0.4670000
## 13 Man involved should have a veto over the abortion FinAb_3x 0.4890000
## 14 Father's financial support shouldn't be obligated FinAb_1x 0.5440000
## 15 Low income family can't afford any more children ABscale_5x 0.5140000
## 16 Single woman doesn't want to marry the man ABscale_7x 0.4980000
## 17 Married woman doesn't want any more children ABscale_3x 0.4940000
## 18 Fairer if men needed to consent to abortion FinAb_2x 0.6170000
## 19 Men don't have enough say during pregnancy FinAb_4x 0.5430000
## 20 Man involved should have a veto over the abortion FinAb_3x 0.5370000
## 21 Father's financial support shouldn't be obligated FinAb_1x 0.5090000
## 22 Low income family can't afford any more children ABscale_5x 0.6024845
## 23 Single woman doesn't want to marry the man ABscale_7x 0.6273292
## 24 Married woman doesn't want any more children ABscale_3x 0.6149068
## 25 Fairer if men needed to consent to abortion FinAb_2x 0.6086957
## 26 Men don't have enough say during pregnancy FinAb_4x 0.7000000
## 27 Man involved should have a veto over the abortion FinAb_3x 0.6565217
## 28 Father's financial support shouldn't be obligated FinAb_1x 0.5130435
## 29 Low income family can't afford any more children ABscale_5x 0.5838509
## 30 Single woman doesn't want to marry the man ABscale_7x 0.5279503
## 31 Married woman doesn't want any more children ABscale_3x 0.5527950
## 32 Fairer if men needed to consent to abortion FinAb_2x 0.5347826
## 33 Men don't have enough say during pregnancy FinAb_4x 0.4478261
## 34 Man involved should have a veto over the abortion FinAb_3x 0.4173913
## 35 Father's financial support shouldn't be obligated FinAb_1x 0.4782609
## 36 Low income family can't afford any more children ABscale_5x 0.5931677
## 37 Single woman doesn't want to marry the man ABscale_7x 0.5776398
## 38 Married woman doesn't want any more children ABscale_3x 0.5838509
## 39 Fairer if men needed to consent to abortion FinAb_2x 0.5717391
## 40 Men don't have enough say during pregnancy FinAb_4x 0.5739131
## 41 Man involved should have a veto over the abortion FinAb_3x 0.5369565
## 42 Father's financial support shouldn't be obligated FinAb_1x 0.4956522
## 43 Low income family can't afford any more children ABscale_5x 0.6491863
## 44 Single woman doesn't want to marry the man ABscale_7x 0.6365280
## 45 Married woman doesn't want any more children ABscale_3x 0.6365280
## 46 Fairer if men needed to consent to abortion FinAb_2x 0.5544304
## 47 Men don't have enough say during pregnancy FinAb_4x 0.6329114
## 48 Man involved should have a veto over the abortion FinAb_3x 0.5772152
## 49 Father's financial support shouldn't be obligated FinAb_1x 0.5037975
## 50 Low income family can't afford any more children ABscale_5x 0.6452119
## 51 Single woman doesn't want to marry the man ABscale_7x 0.6012559
## 52 Married woman doesn't want any more children ABscale_3x 0.6185243
## 53 Fairer if men needed to consent to abortion FinAb_2x 0.4791209
## 54 Men don't have enough say during pregnancy FinAb_4x 0.3604396
## 55 Man involved should have a veto over the abortion FinAb_3x 0.3538462
## 56 Father's financial support shouldn't be obligated FinAb_1x 0.4615385
## 57 Low income family can't afford any more children ABscale_5x 0.6470588
## 58 Single woman doesn't want to marry the man ABscale_7x 0.6176471
## 59 Married woman doesn't want any more children ABscale_3x 0.6268908
## 60 Fairer if men needed to consent to abortion FinAb_2x 0.5141177
## 61 Men don't have enough say during pregnancy FinAb_4x 0.4870588
## 62 Man involved should have a veto over the abortion FinAb_3x 0.4576471
## 63 Father's financial support shouldn't be obligated FinAb_1x 0.4811765
## SE CILO CIHI
## 1 0.1070000 0.3650000 0.6770000
## 2 0.0990000 0.4030000 0.6900000
## 3 0.1050000 0.3690000 0.6730000
## 4 0.0840000 0.5020000 0.7450000
## 5 0.0890000 0.4940000 0.7530000
## 6 0.0790000 0.4730000 0.7040000
## 7 0.0940000 0.3340000 0.6070000
## 8 0.1080000 0.3510000 0.6650000
## 9 0.1100000 0.2940000 0.6110000
## 10 0.1120000 0.3050000 0.6310000
## 11 0.0780000 0.4980000 0.7240000
## 12 0.0780000 0.3540000 0.5790000
## 13 0.0930000 0.3540000 0.6240000
## 14 0.0850000 0.4210000 0.6680000
## 15 0.0750000 0.4080000 0.6210000
## 16 0.0730000 0.3940000 0.6020000
## 17 0.0760000 0.3860000 0.6010000
## 18 0.0560000 0.5370000 0.6970000
## 19 0.0590000 0.4590000 0.6270000
## 20 0.0610000 0.4500000 0.6240000
## 21 0.0630000 0.4200000 0.5970000
## 22 0.0566774 0.5226823 0.6822867
## 23 0.0576373 0.5461754 0.7084830
## 24 0.0543611 0.5383659 0.6914477
## 25 0.0452397 0.5449978 0.6723935
## 26 0.0468320 0.6340602 0.7659398
## 27 0.0446838 0.5936067 0.7194368
## 28 0.0499863 0.4426623 0.5834247
## 29 0.0653864 0.4917863 0.6759155
## 30 0.0679076 0.4323358 0.6235648
## 31 0.0691648 0.4554105 0.6501796
## 32 0.0512847 0.4625734 0.6069919
## 33 0.0505754 0.3766156 0.5190366
## 34 0.0579275 0.3358289 0.4989537
## 35 0.0543662 0.4017129 0.5548089
## 36 0.0430385 0.5330701 0.6532653
## 37 0.0445950 0.5153686 0.6399109
## 38 0.0438641 0.5226004 0.6451015
## 39 0.0342250 0.5239484 0.6195298
## 40 0.0367345 0.5226181 0.6252080
## 41 0.0384766 0.4832289 0.5906842
## 42 0.0367684 0.4443098 0.5469945
## 43 0.0385880 0.5952305 0.7031420
## 44 0.0405139 0.5798792 0.6931768
## 45 0.0381564 0.5831757 0.6898804
## 46 0.0341730 0.5066478 0.6022129
## 47 0.0368212 0.5814261 0.6843967
## 48 0.0369192 0.5255927 0.6288377
## 49 0.0368970 0.4522061 0.5553888
## 50 0.0447243 0.5827547 0.7076692
## 51 0.0465883 0.5361955 0.6663163
## 52 0.0466706 0.5533491 0.6836996
## 53 0.0366988 0.4278711 0.5303706
## 54 0.0372720 0.3083894 0.4124898
## 55 0.0401556 0.2977690 0.4099233
## 56 0.0378536 0.4086762 0.5144008
## 57 0.0298262 0.6055653 0.6885524
## 58 0.0311866 0.5742609 0.6610332
## 59 0.0305558 0.5843821 0.6693994
## 60 0.0253525 0.4788479 0.5493874
## 61 0.0282150 0.4478067 0.5263109
## 62 0.0287306 0.4176777 0.4976164
## 63 0.0265158 0.4442882 0.5180647theme.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(size = 0.5, color = "black", fill = "gray80", linetype = "solid"),
panel.border = element_rect(size = 1.5, 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(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, aes(x = PE, y = ITEM)) +
facet_grid(GENDER ~ STUDY, space = "free_y", scales = "free_y") +
geom_rect(data = NULL, aes(xmin = 0,xmax = 0.5, ymin = -Inf, ymax = Inf), fill = "gray90") +
geom_point(size = 3.5) +
geom_errorbarh(aes(xmin = CILO, xmax = CIHI), height = 0, size = 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, aes(x = PE, y = ITEM)) +
facet_grid(GENDER ~ STUDY, space = "free_y", scales = "free_y") +
geom_rect(data = NULL, aes(xmin = 0,xmax = 0.5, ymin = -Inf, ymax = Inf), fill = "gray90") +
geom_point(size = 3.5) +
geom_errorbarh(aes(xmin = CILO, xmax = CIHI), height = 0, size = 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, aes(x = PE, y = ITEM)) +
facet_grid(GENDER ~ STUDY, space = "free_y", scales = "free_y") +
geom_rect(data = NULL, aes(xmin = 0,xmax = 0.5, ymin = -Inf, ymax = Inf), fill = "gray90") +
geom_point(size = 3.5) +
geom_errorbarh(aes(xmin = CILO, xmax = CIHI), height = 0, size = 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())
library(patchwork)
PLOT.6 + PLOT.56 + PLOT.456 + plot_layout(ncol = 1)Figure
Estimates plot: Comparison with thin 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 = unique(DATA$RESPONSE))
DATA$GROUP <- factor(DATA$GROUP , levels = rev(unique(DATA$GROUP)))
STR <- str_wrap("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.", width = 95, indent = 0, exdent = 0)
ggplot(DATA, aes(fill = RESPONSE, x = 100*PE, y = GROUP)) +
geom_errorbarh(aes(xmin = 100*(CILO), xmax = 100*(CIHI)), height = 0, size = 0.5, position = position_dodge(0.35)) +
geom_point(color = "black", size = 3, shape = 21, position = position_dodge(0.35)) +
scale_fill_manual(values = c("Response 2" = "black","Response 1" = "white"), name = "Responses") +
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(
axis.text.x = element_text(color = "black", size = 15, margin = margin(t = 5)),
axis.text.y = element_text(color = "black", size = 15, margin = margin(r = 5)),
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.key = element_rect(fill = "gray90"),
legend.justification = c("right", "top"),
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 = 5)),
legend.title = element_text(size = 15, face = "bold"),
panel.background = element_rect(fill = "gray90"),
panel.border = element_rect(fill = NA, color = "black", linetype = "solid", size = 1.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(),
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)
)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,
"Rated only men cold" ,"Democrats" , 0.1487001,
"Rated only men cold" ,"Independents", 0.0873871,
"Rated only men cold" ,"Republicans" , 0.0665733,
"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,
"Residual colder to men" ,"Democrats" , 0.5294804,
"Residual colder to men" ,"Independents", 0.4376021,
"Residual colder to men" ,"Republicans" , 0.4120129,
"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,
"Rated men equal to women","Democrats" , 0.118916,
"Rated men equal to women","Independents", 0.2951913,
"Rated men equal to women","Republicans" , 0.277497,
"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,
"Residual colder to women","Democrats" , 0.1631697,
"Residual colder to women","Independents", 0.1628303,
"Residual colder to women","Republicans" , 0.2037092,
"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,
"Rated only women cold" ,"Democrats" , 0.038096,
"Rated only women cold" ,"Independents", 0.0169891,
"Rated only women cold" ,"Republicans" , 0.0402076)
DATA$RESPONSE <- factor(DATA$RESPONSE, levels = rev(unique(DATA$RESPONSE)))
DATA$PID <- factor(DATA$GROUP , levels = unique(DATA$GROUP[1:6]))
ggplot(DATA, aes(fill = RESPONSE, y = 100*PE, x = GROUP)) +
geom_col(color = "black", size = 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)) +
scale_x_discrete(limits = c("U.S. adults","Biden voters","Trump voters","Democrats","Independents","Republicans")) +
labs(title = "Ratings about men and women\non 0-to-100 feeling thermometers", caption = "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.") +
coord_cartesian(clip = "off") +
annotate("text",x = 6.65,y = 98,size = 5.5,hjust = 0,label = "Rated only women cold") +
annotate("text",x = 6.65,y = 86,size = 5.5,hjust = 0,label = "Residual colder to women") +
annotate("text",x = 6.65,y = 62,size = 5.5,hjust = 0,label = "Rated men equal to women") +
annotate("text",x = 6.65,y = 27,size = 5.5,hjust = 0,label = "Residual colder to men") +
annotate("text",x = 6.65,y = 3,size = 5.5,hjust = 0,label = "Rated only men cold") +
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)
)Figure
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("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.", width = 97)
ggplot(DATA, aes(fill = ITEM, y = 100*PE, x = GROUP)) +
geom_col(color = "black", size = 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(
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)),
legend.title = element_text(size = 15, face = "bold"),
panel.background = element_rect(fill = "gray90"),
panel.border = element_rect(size = 2, color = "black", fill = NA),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(size = 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))
)Figure
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.
library(tidyverse)
library(grid)
DATA <- read.csv("Figure 6.CSV")
print.data.frame(DATA)## EVENT DATE FACET PE N
## 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("Note: Respective samples sizes were 57, 89, 99, 115, 155, 170, 125, 144, 268, 180, and 115. Data source: Boydstun and Lawrence (2019).", width = 50)
ggplot(data = DATA, 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(size = 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(
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(size = 0.5, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(size = 1.2, 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(color = "black", fill = "black"),
strip.text.x = element_text(size = 18, color = "white", face = "bold", margin = margin(t = 7.5,b = 7.5))
)Figure
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(tidyverse)
library(grid)
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("Note: Respective samples sizes were 57, 89, 99, 115, 155, 170, 125, 144, 268, 180, and 115. Data source: Boydstun and Lawrence (2019).", width = 50)
ggplot(data = DATA, aes(x = rev(EVENT.AN), y = 100*PCT)) +
coord_flip(clip = "off") +
scale_fill_manual(values = c("purple")) +
geom_col(color = "black", size = 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(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(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(
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(size = 0.5, color = "black", fill = "gray90", linetype = "solid"),
panel.border = element_rect(size = 1.2, 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(color = "black", fill = "black"),
strip.text.x = element_text(size = 18, color = "white", face = "bold", margin = margin(t = 7.5,b = 7.5))
)Figure
Histogram
Code
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=12),
axis.text.y = element_text(color="black", size=12),
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, size=1.1),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(size=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=14, hjust=0.5,margin = margin(b = 10)))
ggplot(data=DATA, aes(DATA$ft_immig_2020Sep)) +
geom_histogram(breaks=seq(-0.5,100.5, by=1), aes(y = ..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_y_continuous(labels=scales::percent_format(accuracy=1), limits=c(-0.005,0.10), expand=c(0,0), breaks=seq(0,.10,.05), sec.axis=dup_axis()) +
scale_x_continuous(limits=c(-2.5,102.5), expand=c(0,0), breaks=seq(0,100,25)) +
theme.z Figure
Scatterplot with regression line
Code
library(tidyverse)
DATA <- read.csv("states.csv", header = TRUE)
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), angle=0),
axis.title.y.right = element_blank(),
panel.background = element_rect(size = 0.5, fill = "gray90"),
panel.border = element_rect(size = 1.8, 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")
)
summary(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-06ggplot(data = DATA, 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 = 5, hjust = 1, family = "mono", label = " Estimate p-value") +
annotate("text", x = 70, y = 80, size = 5, hjust = 1, family = "mono", label = " Intercept 143.89 <0.01") +
annotate("text", x = 70, y = 72, size = 5, hjust = 1, family = "mono", label = "% eat produce freq -1.86 <0.01") +
theme.zFigure
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 )
plot_usmap(data = DATA, values = "PCTBLACK", color = "black", lwd = 0.75) +
scale_fill_continuous(low = "lightblue", high = "darkblue", breaks = c(0,5,10,20,30,35)) +
guides(fill = guide_legend("Percent\nBlack")) +
labs(title = "Title") +
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))
)Figure
Map: World
Code
library(ggplot2)
library(maps)
library(sf)
library(rnaturalearth, rnaturalearthdata)
DATA <- read_csv("world map.csv")
print(DATA, n = Inf)## # A tibble: 222 × 3
## region CountryCode NUMBERS
## <chr> <chr> <dbl>
## 1 Afghanistan AFG 8
## 2 Albania ALB 6
## 3 Algeria DZA 6
## 4 American Samoa ASM 6
## 5 Andorra AND 8
## 6 Angola AGO 2
## 7 Antigua ATG 4
## 8 Argentina ARG 5
## 9 Armenia ARM 9
## 10 Aruba ABW 7
## 11 Australia AUS 5
## 12 Austria AUT 3
## 13 Azerbaijan AZE 1
## 14 Bahamas BHS 4
## 15 Bahrain BHR 3
## 16 Bangladesh BGD 9
## 17 Barbados BRB 0
## 18 Belarus BLR 9
## 19 Belgium BEL 3
## 20 Belize BLZ 4
## 21 Benin BEN 2
## 22 Bermuda BMU 4
## 23 Bhutan BTN 9
## 24 Bolivia BOL 9
## 25 Bosnia and Herzegovina BIH 4
## 26 Botswana BWA 3
## 27 Brazil BRA 6
## 28 Virgin Islands VGB 1
## 29 Brunei BRN 4
## 30 Bulgaria BGR 5
## 31 Burkina Faso BFA 5
## 32 Burundi BDI 0
## 33 Cabo Verde CPV 2
## 34 Cambodia KHM 0
## 35 Cameroon CMR 2
## 36 Canada CAN 2
## 37 Cayman Islands CYM 3
## 38 Central African Republic CAF 6
## 39 Central Europe and the Baltics CEB 2
## 40 Chad TCD 3
## 41 Channel Islands CHI 8
## 42 Chile CHL 2
## 43 China CHN 3
## 44 Colombia COL 1
## 45 Comoros COM 6
## 46 Democratic Republic of the Congo COD 0
## 47 Republic of Congo COG 1
## 48 Costa Rica CRI 8
## 49 Cote d'Ivoire CIV 1
## 50 Croatia HRV 9
## 51 Cuba CUB 5
## 52 Curacao CUW 3
## 53 Cyprus CYP 1
## 54 Czech Republic CZE 6
## 55 Denmark DNK 9
## 56 Djibouti DJI 8
## 57 Dominica DMA 6
## 58 Dominican Republic DOM 6
## 59 Ecuador ECU 4
## 60 Egypt EGY 8
## 61 El Salvador SLV 3
## 62 Equatorial Guinea GNQ 1
## 63 Eritrea ERI 6
## 64 Estonia EST 3
## 65 Eswatini SWZ 4
## 66 Ethiopia ETH 3
## 67 Faroe Islands FRO 5
## 68 Fiji FJI 0
## 69 Finland FIN 6
## 70 France FRA 9
## 71 French Polynesia PYF 9
## 72 Gabon GAB 3
## 73 Gambia GMB 2
## 74 Georgia GEO 2
## 75 Germany DEU 5
## 76 Ghana GHA 4
## 77 Gibraltar GIB 2
## 78 Greece GRC 4
## 79 Greenland GRL NA
## 80 Grenada GRD 2
## 81 Guam GUM 2
## 82 Guatemala GTM 0
## 83 Guinea GIN 3
## 84 Guinea-Bissau GNB 4
## 85 Guyana GUY 5
## 86 Haiti HTI 1
## 87 Honduras HND 7
## 88 Hong Kong SAR, China HKG 5
## 89 Hungary HUN 0
## 90 Iceland ISL 1
## 91 India IND 7
## 92 Indonesia IDN 7
## 93 Iran IRN 3
## 94 Iraq IRQ 3
## 95 Ireland IRL 5
## 96 Isle of Man IMN 6
## 97 Israel ISR 7
## 98 Italy ITA 7
## 99 Jamaica JAM 2
## 100 Japan JPN 8
## 101 Jordan JOR 4
## 102 Kazakhstan KAZ 7
## 103 Kenya KEN 0
## 104 Kiribati KIR 8
## 105 North Korea PRK 3
## 106 South Korea KOR 8
## 107 Kosovo XKX 0
## 108 Kuwait KWT 2
## 109 Kyrgyz Republic KGZ 5
## 110 Lao PDR LAO 9
## 111 Latvia LVA 8
## 112 Least developed countries: UN classification LDC 4
## 113 Lebanon LBN 9
## 114 Lesotho LSO 6
## 115 Liberia LBR 2
## 116 Libya LBY 2
## 117 Liechtenstein LIE 8
## 118 Lithuania LTU 1
## 119 Luxembourg LUX 6
## 120 Macao SAR, China MAC 4
## 121 Madagascar MDG 6
## 122 Malawi MWI 5
## 123 Malaysia MYS 0
## 124 Maldives MDV 2
## 125 Mali MLI 1
## 126 Malta MLT 4
## 127 Marshall Islands MHL 6
## 128 Mauritania MRT 4
## 129 Mauritius MUS 2
## 130 Mexico MEX 4
## 131 Micronesia FSM 6
## 132 Moldova MDA 7
## 133 Monaco MCO 7
## 134 Mongolia MNG 8
## 135 Montenegro MNE 9
## 136 Morocco MAR 9
## 137 Mozambique MOZ 0
## 138 Myanmar MMR 2
## 139 Namibia NAM 5
## 140 Nauru NRU 1
## 141 Nepal NPL 6
## 142 Netherlands NLD 6
## 143 New Caledonia NCL 8
## 144 New Zealand NZL 6
## 145 Nicaragua NIC 6
## 146 Niger NER 6
## 147 Nigeria NGA 7
## 148 North America NAC 0
## 149 North Macedonia MKD 2
## 150 Northern Mariana Islands MNP 6
## 151 Norway NOR 0
## 152 Not classified INX 2
## 153 Oman OMN 9
## 154 Pakistan PAK 1
## 155 Palau PLW 3
## 156 Panama PAN 5
## 157 Papua New Guinea PNG 5
## 158 Paraguay PRY 2
## 159 Peru PER 8
## 160 Philippines PHL 0
## 161 Poland POL 2
## 162 Portugal PRT 2
## 163 Puerto Rico PRI 1
## 164 Qatar QAT 6
## 165 Romania ROU 5
## 166 Russian Federation RUS 0
## 167 Rwanda RWA 8
## 168 Samoa WSM 3
## 169 San Marino SMR 4
## 170 Sao Tome and Principe STP 3
## 171 Saudi Arabia SAU 4
## 172 Senegal SEN 2
## 173 Serbia SRB 6
## 174 Seychelles SYC 2
## 175 Sierra Leone SLE 5
## 176 Singapore SGP 9
## 177 Sint Maarten SXM 3
## 178 Slovak Republic SVK 4
## 179 Slovenia SVN 9
## 180 Solomon Islands SLB 0
## 181 Somalia SOM 4
## 182 South Africa ZAF 5
## 183 South Sudan SSD 7
## 184 Spain ESP 5
## 185 Sri Lanka LKA 7
## 186 St. Kitts and Nevis KNA 6
## 187 St. Lucia LCA 0
## 188 St. Martin MAF 1
## 189 St. Vincent and the Grenadines VCT 9
## 190 Sudan SDN 5
## 191 Suriname SUR 7
## 192 Sweden SWE 2
## 193 Switzerland CHE 2
## 194 Syrian Arab Republic SYR 2
## 195 Tajikistan TJK 7
## 196 Tanzania TZA 8
## 197 Thailand THA 0
## 198 Timor-Leste TLS 7
## 199 Togo TGO 4
## 200 Tonga TON 9
## 201 Trinidad and Tobago TTO 6
## 202 Tunisia TUN 5
## 203 Turkey TUR 6
## 204 Turkmenistan TKM 7
## 205 Turks and Caicos Islands TCA 8
## 206 Tuvalu TUV 2
## 207 Uganda UGA 3
## 208 Ukraine UKR 8
## 209 United Arab Emirates ARE 2
## 210 United Kingdom GBR 2
## 211 Uruguay URY 1
## 212 USA USA 9
## 213 Uzbekistan UZB 2
## 214 Vanuatu VUT 0
## 215 Venezuela VEN 6
## 216 Vietnam VNM 1
## 217 Virgin Islands (U.S.) VIR 8
## 218 West Bank and Gaza PSE 7
## 219 World WLD 5
## 220 Yemen YEM 8
## 221 Zambia ZMB 7
## 222 Zimbabwe ZWE 5WORLD <- st_as_sf(map("world", plot = FALSE, fill = TRUE))
SUM <- merge(WORLD, DATA, by.x = c("ID"), by.y = c("region"))
ggplot(data = SUM) +
geom_sf(aes(fill = NUMBERS),color = "black", linewidth = 0.5) +
scale_fill_continuous(low = "lightsteelblue1", high = "royalblue4", limits = c(0,9), breaks = c(0,3,6,9)) +
guides(fill = guide_legend("Some data")) +
# coord_sf(xlim = c(60,100), ylim = c(0,50)) +
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_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
rect = element_blank()
) Figure
Map: Region
Code
library(tidyverse)
library(maps)
library(rnaturalearth)
library(rnaturalearthdata)
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, 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(size = 2, color = "black", fill = NA)
)Figure
Waffle plot
Code
sort of as a pie chart (colors better in grayscale)
library(waffle)
library(patchwork)
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
Likert plot
Code
library(tidyverse)
DATA <- tribble(
~ITEM, ~RESPONSE, ~PCT,
"Likert item 1", "Strongly agree", 50,
"Likert item 1", "Agree", 20,
"Likert item 1", "Neither agree nor disagree", 10,
"Likert item 1", "Disagree", 10,
"Likert item 1", "Strongly disagree", 10,
"Likert item 1", "Missing", 0,
"Likert item 2\nthat has two lines", "Strongly agree", 40,
"Likert item 2\nthat has two lines", "Agree", 25,
"Likert item 2\nthat has two lines", "Neither agree nor disagree", 10,
"Likert item 2\nthat has two lines", "Disagree", 15,
"Likert item 2\nthat has two lines", "Strongly disagree", 10,
"Likert item 2\nthat has two lines", "Missing", 0,
"Likert item 3", "Strongly agree", 35,
"Likert item 3", "Agree", 25,
"Likert item 3", "Neither agree nor disagree", 15,
"Likert item 3", "Disagree", 15,
"Likert item 3", "Strongly disagree", 5,
"Likert item 3", "Missing", 5,
"Likert item 4", "Strongly agree", 15,
"Likert item 4", "Agree", 10,
"Likert item 4", "Neither agree nor disagree", 20,
"Likert item 4", "Disagree", 20,
"Likert item 4", "Strongly disagree", 30,
"Likert item 4", "Missing", 5)
theme.z <- theme(
axis.text.x = element_text(color = "black", size = 18, hjust = 1, margin = margin(r = 0)),
axis.text.y = element_text(color = "black", size = 18, hjust = 1, 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.justification = "center",
legend.position = "bottom",
legend.text = element_text(size = 18),
panel.background = element_rect(fill = "white"),
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(0.5, "lines"),
plot.margin = unit(c(0.5,50,0.5,30),"pt")
)
DATA$ITEM <- factor(DATA$ITEM , levels = rev(unique(DATA$ITEM)))
DATA$RESPONSE <- factor(DATA$RESPONSE, levels = rev(DATA$RESPONSE[1:6]))
AGREE <- DATA$PCT[DATA$RESPONSE == "Strongly agree"] + DATA$PCT[DATA$RESPONSE == "Agree"]
ggplot(DATA, aes(x = PCT, y = ITEM, fill = RESPONSE)) +
coord_cartesian(clip = "off") +
geom_col(color = "black", linewidth = 1.5, width = 0.8) +
scale_fill_manual(values = c("Missing" = "gray80", "Strongly disagree" = "red3", "Disagree" = "red1", "Neither agree nor disagree" = "white", "Agree" = "green1", "Strongly agree" = "green3"), name = "") +
scale_x_continuous(limits = c(0, 110.01), breaks = seq(0, 100, by = 25)) +
guides(fill = guide_legend(reverse = T, nrow = 1, byrow = TRUE)) +
annotate("text", x = 105, y = rev(levels(DATA$ITEM)), label = paste0("Agree ", round(AGREE,0),"%"), size = 6.5, hjust = 0) +
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)
ggplot(DATA, aes(x = X, y = Y, group = MOD)) +
geom_smooth(data = subset(DATA, MOD == 0), method = "lm", formula = y~x, se = F, size = 1, color = "blue") +
geom_smooth(data = subset(DATA, MOD == 1), method = "lm", formula = y~x, se = F, size = 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))) +
geom_text(x = 0.3, y = 26, label = "OLS Coefficients", hjust = 0, vjust = 1, size = 6, lineheight = 0.9, family = "mono", fontface = "bold") +
geom_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(
plot.background = element_rect(fill = "white"),
plot.margin = unit(c(0.5,0.5,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(color = "black", fill = "black"),
strip.text.x = element_text(size = 14, color = "white", face = "bold"),
panel.background = element_rect(fill = "gray90", color = "black", size = 0.5, linetype = "solid"),
panel.border = element_rect(fill = NA, color = "black", linetype = "solid", size = 1.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.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")
)summary(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(tidyverse)
library(ggpubr)
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)
ggplot(data=DATA, 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(
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(size=0.5, color="black", fill="gray90", linetype="solid"),
panel.border = element_rect(size=1.8, 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)))Figure
Emphasis example 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", size = 2, fill = NA),
panel.spacing.x = unit(1, "lines"),
panel.spacing.y = unit(0.5, "lines"),
strip.background = element_rect(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_text(color = "black", size = 12),
axis.text.y = element_text(color = "black", size = 12),
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")
ggplot(DATA, aes(x = AGE, y = 100*PCT, fill = ITEM)) +
geom_col(color = "black", size = 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), breaks = seq(0, 100, by = 25)) +
labs(title = "Ratings of Police on 0-to-100 Feeling Thermometers", caption = "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") +
theme.z + guides(fill = guide_legend(reverse = T))ggplot(DATA, aes(x = RACE, y = 100*PCT, fill = ITEM)) +
geom_col(color = "black", size = 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), breaks = seq(0, 100, by = 25)) +
labs(title = "Ratings of Police on 0-to-100 Feeling Thermometers", caption = "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") +
theme.z + guides(fill = guide_legend(reverse = T))Figure
Emphasis example 2
Code
library(tidyverse)
library(patchwork)
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.8, 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(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, 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") , 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") , 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") , 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") , 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(aes(xmin = CILO, xmax = CIHI), height = 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, 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") , 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") , 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") , 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") , 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(aes(xmin = CILO, xmax = CIHI), height = 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
