Making a a four quadrant proportional area chart in R
You can try working with this function.
four_quadrant <- function(x, col_quad="gray65", col_text="white") {
nx <- length(x)
sqx <- sqrt(x)
df <- data.frame(x=c(sqx[1],-sqx[2],-sqx[3],sqx[4])/2,
y=c(sqx[1],sqx[2],-sqx[3],-sqx[4])/2,
size=sqx, label=x)
mm <- max(df$size)*1.1
ggplot(data=df, aes(x=x, y=y, width=size, height=size,
group=factor(size))) +
geom_tile(fill=col_quad) +
geom_text(aes(label=label), col=col_text, size=5) +
geom_hline(aes(yintercept=0), size=0.8) +
geom_vline(aes(xintercept=0), size=0.8) +
coord_fixed() +
xlim(c(-mm,mm)) + ylim(c(-mm,mm)) +
theme_void() +
theme(legend.position = "none")
}
x <- c(18, 54, 5, 15)
p1 <- four_quadrant(x)
x <- c(30, 17, 6, 34)
p2 <- four_quadrant(x, col_quad="salmon")
gridExtra::grid.arrange(p1, p2, nrow=1)
You can rather easily do it with ggplot
using geom_rect
. I've created a mock up data of the first chart to show you how to create one plot. You can reuse this to create the others and put them together using grid
(there are loads of examples on SO how to do this).
library(tidyverse)
df <- data.frame(perc = c(54, 18, 5, 15),
wall_policy = c("oppose", "favor", "oppose", "favor"),
dreamer_policy = c("favor", "favor", "oppose", "oppose"),
stringsAsFactors = FALSE)
df <- df %>%
mutate(xmin = if_else(wall_policy == "oppose", -sqrt(perc), 0),
xmax = if_else(wall_policy == "favor", sqrt(perc), 0),
ymin = if_else(dreamer_policy == "oppose", -sqrt(perc), 0),
ymax = if_else(dreamer_policy == "favor", sqrt(perc), 0))
ggplot(df) +
geom_rect(aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax), fill = "grey") +
geom_text(aes(x = xmin + 0.5*sqrt(perc),
y = ymin + 0.5*sqrt(perc),
label = perc),
color = "white", size = 10) +
coord_equal() +
geom_hline(yintercept = 0) +
geom_vline(xintercept = 0) +
labs(title = "Total") +
theme_minimal() +
theme(axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank(),
plot.title = element_text(color="grey40", face="bold",
size=20, hjust = 0.5))