Last active
July 10, 2018 17:21
-
-
Save conjugateprior/e46d22936b5849be697c2eda5235c0f6 to your computer and use it in GitHub Desktop.
Fourfold plot function but with boxes and an example in Pew report style
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
fourfold_box <- function(bl_br_tl_tr, # values for bottom left, top right, etc. | |
cols = rep(rgb(0.8, 0.8, 0.8), 4), # default to grey fill | |
labels = NULL, # use these instead of bl, br, tl, and tr values | |
label.cols = rep("black", 4), # value colors | |
quadrant.labels = NULL, # default: don't label quadrants | |
quadrant.label.col = NULL, # default: "black" | |
small.min = 5, # center label in box unless it's smaller than this | |
small.label.mult = 1.5, # label this multiple of box side length further out | |
axis.lwd = 1, # crossbar thickness | |
axis.col = NULL, # default: "black" | |
...){ # main etc. | |
if (sum(bl_br_tl_tr) == 1.0) | |
bl_br_tl_tr <- bl_br_tl_tr * 100 # convert proportions to percentages | |
if (is.null(labels)) | |
labels <- bl_br_tl_tr | |
s <- sqrt(bl_br_tl_tr) | |
if (length(cols) == 1) | |
cols <- rep(cols, 4) | |
if (length(label.cols) == 1) | |
label.cols <- rep(label.cols, 4) | |
plot(0, 0, asp = 1, xlim = c(-10, 10), ylim = c(-10, 10), | |
axes = FALSE, xlab = "", ylab = "", type = "n", ...) | |
rect(xleft = 0, ybottom = 0, xright = -s[1], ytop = -s[1], | |
border = NA, col = cols[1]) | |
rect(xleft = 0, ybottom = 0, xright = s[2], ytop = -s[2], | |
border = NA, col = cols[2]) | |
rect(xleft = 0, ybottom = 0, xright = -s[3], ytop = s[3], | |
border = NA, col = cols[3]) | |
rect(xleft = 0, ybottom = 0, xright = s[4], ytop = s[4], | |
border = NA, col = cols[4]) | |
segments(x0 = c(-10, 0), x1 = c(10, 0), y0 = c(0, -10), y1 = c(0, 10), | |
lwd = axis.lwd, col = axis.col) | |
plot_outside <- s**2 < small.min | |
tloc <- ifelse(plot_outside, s * small.label.mult, s/2) | |
if (is.null(labels)) | |
tlabs <- s**2 | |
else | |
tlabs <- labels | |
label.cols <- ifelse(!plot_outside, label.cols, | |
ifelse(!is.null(axis.col), axis.col, "black")) | |
text(x = c(-tloc[1], tloc[2], -tloc[3], tloc[4]), | |
y = c(-tloc[1], -tloc[2], tloc[3], tloc[4]), | |
labels = tlabs, | |
col = label.cols) | |
if (!is.null(quadrant.labels)){ | |
qcol <- ifelse(!is.null(quadrant.label.col), quadrant.label.col, "black") | |
text(x = c(-10, 1, -10, 1), | |
y = c(-10, -10, 9, 9), | |
labels = quadrant.labels, | |
pos = 4, | |
offset = 0, | |
col = qcol) | |
} | |
} | |
col_dem <- "#83A7BF" | |
col_rep <- "#E47F73" | |
near_black <- "#888888" | |
greyish <- "#A6A7AB" | |
pdf("support.pdf", width = 9, height = 3) | |
old_mar <- par("mar") | |
par(mfrow = c(1,3), mar = c(1,1,2,1)) | |
fourfold_box(c(5, 15, 54, 18), cols = greyish, label.cols = "white", | |
axis.lwd = 2, axis.col = near_black, | |
main = "Total", col.main = near_black, | |
quadrant.labels = c("Oppose both", | |
"Oppose legal status\nFavor border wall", | |
"Favor legal status\nOppose border wall", | |
"Favor both"), | |
quadrant.label.col = near_black) | |
fourfold_box(c(6, 34, 17, 30), cols = col_rep, label.cols = "white", small.min = 4, | |
axis.lwd = 2, axis.col = near_black, | |
main = "Rep/Lean Rep", col.main = col_rep) | |
fourfold_box(c(4, 2, 80, 11), cols = col_dem, label.cols = "white", small.min = 4, | |
small.label.mult = 1.5, axis.lwd = 2, axis.col = near_black, | |
main = "Dem/Lean Dem", col.main = col_dem) | |
par(mfrow = c(1,1), mar = old_mar) | |
dev.off() | |
# Compare to http://www.pewresearch.org/fact-tank/2018/01/19/public-backs-legal-status-for-immigrants-brought-to-u-s-illegally-as-children-but-not-a-bigger-border-wall/ft_18-01-19_partisanimmigration/ |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Snippet of the original graph from Pew:
(From the report here).
From the gist, without too much concern for sizing: