## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
out.width = "100%"
)
## ----echo = FALSE-------------------------------------------------------------
suppressMessages(library(dplyr))
## ----setup--------------------------------------------------------------------
library(dplyr)
library(estimatr)
library(ggplot2)
library(patchwork)
library(vayr)
dat <- data.frame(
x = c(rep(0, 200)),
y = c(rep(0, 200)),
group = (rep(c("A", "B", "B", "B"), 50)),
size = runif(200, 0, 1)
)
## ----contents_0, dpi = 96, fig.width = 12, fig.height = 6, fig.alt = 'perfect over-plotting and position_jitter()'----
# perfectly over-plotted points
over_plot <- ggplot(dat, aes(x = x, y = y)) +
geom_point() +
coord_equal(xlim = c(-1.1, 1.1),
ylim = c(-1.1, 1.1)) +
theme_bw() +
theme(axis.title = element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold")) +
ggtitle('"perfect over-plotting"')
# position_jitter()
jitter_plot <- ggplot(dat, aes(x = x, y = y)) +
geom_point(position = position_jitter(width = 0.5,
height = 0.5)) +
coord_equal(xlim = c(-1.1, 1.1),
ylim = c(-1.1, 1.1)) +
theme_bw() +
theme(axis.title = element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold")) +
ggtitle("position_jitter()")
over_plot + jitter_plot
## ----contents_1, dpi = 96, fig.width = 12, fig.height = 6, fig.alt = 'position_jitter_ellipse() and position_jitterdodge_ellipse()'----
# position_jitter_ellipse()
jitter_ellipse_plot <- ggplot(dat, aes(x = x, y = y)) +
geom_point(position = position_jitter_ellipse(width = 0.5,
height = 0.5)) +
coord_equal(xlim = c(-1.1, 1.1),
ylim = c(-1.1, 1.1)) +
theme_bw() +
theme(axis.title = element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold")) +
ggtitle("position_jitter_ellipse()")
# position_jitterdodge_ellipse()
jitterdodge_ellipse_plot <- ggplot(dat, aes(x = x, y = y, color = group)) +
geom_point(position = position_jitterdodge_ellipse(dodge.width = 2,
jitter.width = 0.5,
jitter.height = 0.5)) +
coord_equal(xlim = c(-1.1, 1.1),
ylim = c(-1.1, 1.1)) +
theme_bw() +
theme(legend.position = "none",
axis.title = element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold")) +
ggtitle("position_jitterdodge_ellipse()")
jitter_ellipse_plot + jitterdodge_ellipse_plot
## ----contents_2A, dpi = 96, fig.width = 12, fig.height = 6, fig.alt = 'position_sunflower() and position_sunflowerdodge()'----
# position_sunflower()
sunflower_plot <- ggplot(dat, aes(x = x, y = y)) +
geom_point(position = position_sunflower(density = 1,
aspect_ratio = 1)) +
coord_equal(xlim = c(-2.1, 2.1),
ylim = c(-2.1, 2.1)) +
theme_bw() +
theme(axis.title = element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold")) +
ggtitle("position_sunflower()")
# position_sunflowerdodge()
sunflowerdodge_plot <- ggplot(dat, aes(x = x, y = y, color = group)) +
geom_point(position = position_sunflowerdodge(width = 4,
density = 1,
aspect_ratio = 1)) +
coord_equal(xlim = c(-2.1, 2.1),
ylim = c(-2.1, 2.1)) +
theme_bw() +
theme(legend.position = "none",
axis.title = element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold")) +
ggtitle("position_sunflowerdodge()")
sunflower_plot + sunflowerdodge_plot
## ----contents_2B, dpi = 96, fig.width = 12, fig.height = 12, fig.alt = 'density', echo = FALSE----
densities <- rep(c(0.5, 1, 2), each = 3)
ns <- rep(c(50, 100, 200), 3)
density_plots <- list()
for (i in 1:9) {
density_dat <- data.frame(x = c(rep(0, ns[i])), y = c(rep(0, ns[i])))
density_plots[[i]] <- ggplot(density_dat, aes(x, y)) +
geom_point(position = position_sunflower(density = densities[i])) +
coord_equal(xlim = c(-2, 2),
ylim = c(-2, 2)) +
theme_bw() +
labs(title = paste0("n = ", ns[i], ", density = ", densities[i])) +
theme(axis.title = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(face = "bold"))
}
wrap_plots(density_plots, ncol = 3)
## ----contents_2C, dpi = 96, fig.width = 12, fig.height = 12, fig.alt = 'aspect_ratio', echo = FALSE----
flower_ratios <- rep(c(0.5, 1, 2), each = 3)
axis_ratios <- rep(c(2, 1, 0.5), 3)
aspect_ratio_dat <- data.frame(x = c(rep(0, 100)), y = c(rep(0, 100)))
aspect_ratio_plots <- list()
for (i in 1:9) {
aspect_ratio_plots[[i]] <- ggplot(dat, aes(x, y)) +
geom_point(position = position_sunflower(aspect_ratio = flower_ratios[i])) +
coord_fixed(xlim = c(-2, 2),
ylim = c(-2, 2),
ratio = axis_ratios[i]) +
theme_bw() +
labs(title = paste0("aspect_ratio = ", flower_ratios[i], "\ncoord_fixed(ratio = ", axis_ratios[i], ")")) +
theme(axis.title = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(face = "bold", size = 10))
}
wrap_plots(aspect_ratio_plots, ncol = 3)
## ----contents_3A, dpi = 96, fig.width = 12, fig.height = 6, fig.alt = 'position_circlepack() and position_circlepackdodge()'----
# position_circlepack()
circlepack_plot <- ggplot(dat, aes(x = x, y = y, size = size)) +
geom_point(alpha = 0.25,
position = position_circlepack(density = 0.25,
aspect_ratio = 1)) +
coord_equal(xlim = c(-1, 1),
ylim = c(-1.1, 1.1)) +
theme_bw() +
theme(legend.position = "none",
axis.title = element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold")) +
ggtitle("position_circlepack()")
# position_circlepackdodge()
circlepackdodge_plot <- ggplot(dat, aes(x = x, y = y, color = group, size = size)) +
geom_point(alpha = 0.25,
position = position_circlepackdodge(width = 2,
density = 0.25,
aspect_ratio = 1)) +
coord_equal(xlim = c(-1, 1),
ylim = c(-1.1, 1.1)) +
theme_bw() +
theme(legend.position = "none",
axis.title = element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold")) +
ggtitle("position_circlepackdodge()")
circlepack_plot + circlepackdodge_plot
## ----contents_3B, dpi = 96, fig.width = 12, fig.height = 4, fig.alt = 'random, ascending, descending'----
# random size, base plot
random <- ggplot(dat, aes(x = x, y = y, size = size)) +
geom_point(alpha = 0.25,
position = position_circlepack(density = 0.075,
aspect_ratio = 1)) +
coord_equal(xlim = c(-1, 1),
ylim = c(-1.1, 1.1)) +
theme_bw() +
theme(legend.position = "none",
axis.title = element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold")) +
ggtitle("random")
# ascending size
ascending <- random %+%
arrange(dat, size) +
ggtitle("ascending")
# descending size
descending <- random %+%
arrange(dat, desc(size)) +
ggtitle("descending")
random + ascending + descending
## ----patriot_act_visualization, dpi = 96, fig.width = 12, fig.height = 6, fig.alt = "patriot_act"----
# A df for statistical models
summary_df <- patriot_act |>
group_by(T1_content, pid_3, sample_label) |>
reframe(tidy(lm_robust(PA_support ~ 1)))
# A df for direct labels
label_df <- summary_df |>
filter(sample_label == "Original Study", T1_content == "Control") |>
mutate(
PA_support = case_when(
pid_3 == "Democrat" ~ conf.low - 0.15,
pid_3 == "Republican" ~ conf.high + 0.15
)
)
ggplot(patriot_act, aes(T1_content, PA_support, color = pid_3, group = pid_3)) +
# the data
geom_point(position = position_sunflowerdodge(width = 0.5,
density = 50,
aspect_ratio = 0.5),
size = 0.1, alpha = 0.5) +
# the statistical model
geom_line(data = summary_df, aes(x = T1_content, y = estimate),
position = position_dodge(width = 0.5), linewidth = 0.5) +
geom_point(data = summary_df, aes(x = T1_content, y = estimate),
position = position_dodge(width = 0.5), size = 3) +
geom_linerange(data = summary_df, aes(x = T1_content, y = estimate,
ymin = conf.low, ymax = conf.high),
position = position_dodge(width = 0.5)) +
# the direct labels
geom_text(data = label_df, aes(label = pid_3)) +
# the rest
scale_color_manual(values = c("blue4", "red3")) +
scale_y_continuous(breaks = 1:7) +
coord_fixed(ratio = 0.5) + # ratio for coord_fixed is y/x rather than x/y
facet_wrap(~sample_label) +
theme_bw() +
theme(legend.position = "none",
strip.background = element_blank(),
panel.grid.minor = element_blank()) +
labs(y = "Do you oppose or support the Patriot Act?
[1: Oppose very strongly to 7: Support very strongly]",
x = "Randomly assigned information")