inst/doc/vayr-vignette.R

In vayr: Extensions for 'ggplot2' to Visualize as You Randomize

## ----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")